From 1ba3d1cf97b9f671c7e0572fad7c57d691e69444 Mon Sep 17 00:00:00 2001
From: Vincent Ambo <tazjin@google.com>
Date: Tue, 28 Jan 2020 21:06:35 +0000
Subject: feat(fun/wcl): Add a simple 'wc' clone in Lisp

Prompted by this thread:
https://lobste.rs/s/zntyeq/wc_d_712_characters_without_single_branch
---
 fun/wcl/default.nix | 13 +++++++++++++
 fun/wcl/wc.lisp     | 33 +++++++++++++++++++++++++++++++++
 2 files changed, 46 insertions(+)
 create mode 100644 fun/wcl/default.nix
 create mode 100644 fun/wcl/wc.lisp

(limited to 'fun/wcl')

diff --git a/fun/wcl/default.nix b/fun/wcl/default.nix
new file mode 100644
index 000000000000..17367f3d8072
--- /dev/null
+++ b/fun/wcl/default.nix
@@ -0,0 +1,13 @@
+{ pkgs, ... }:
+
+pkgs.nix.buildLisp.program {
+  name = "wc";
+
+  srcs = [
+    ./wc.lisp
+  ];
+
+  deps = with pkgs.third_party.lisp; [
+    iterate
+  ];
+}
diff --git a/fun/wcl/wc.lisp b/fun/wcl/wc.lisp
new file mode 100644
index 000000000000..f443125a85b4
--- /dev/null
+++ b/fun/wcl/wc.lisp
@@ -0,0 +1,33 @@
+(defpackage wc
+  (:use #:cl #:iterate)
+  (:export :main))
+(in-package :wc)
+(declaim (optimize (speed 3) (safety 0)))
+
+(defun main ()
+  (let ((filename (cadr sb-ext:*posix-argv*))
+        (space (char-code #\Space))
+        (newline (char-code #\Newline)))
+    (with-open-file (file-stream filename :element-type '(unsigned-byte 8))
+      (iter
+        (for byte in-stream file-stream using #'read-byte)
+        (for previous-byte previous byte)
+        (for is-newline = (eq newline byte))
+
+        ;; Count each byte
+        (sum 1 into bytes)
+
+        ;; Count every newline
+        (counting is-newline into newlines)
+
+        ;; Count every "word", unless the preceding character already
+        ;; was a space.
+        (when (or (eq space previous-byte)
+                  (eq newline previous-byte))
+          (next-iteration))
+
+        (counting (or is-newline (eq space byte))
+                  into words)
+
+        (declare (fixnum bytes newlines words))
+        (finally (format t "  ~A ~A ~A ~A~%" newlines words bytes filename))))))
-- 
cgit 1.4.1