From 704ff740e04cd50e4d6813a132458cf20441f5c1 Mon Sep 17 00:00:00 2001
From: mehbark <terezi@pyrope.net>
Date: Tue, 17 Dec 2024 16:27:04 -0500
Subject: [PATCH] bf: group ops

~13s mandelbrot
---
 bf.lisp    | 76 +++++++++++++++++++++++++++++-------------------------
 utils.lisp |  1 +
 2 files changed, 42 insertions(+), 35 deletions(-)

diff --git a/bf.lisp b/bf.lisp
index 1225373..2b67459 100644
--- a/bf.lisp
+++ b/bf.lisp
@@ -1,46 +1,52 @@
 (load "utils.lisp")
-; i've done this before
 
-(deftype cell () '(mod 256))
-
-; TODO: group ops
 (defun comp-part (&optional (port *standard-input*))
   (begin
-    (loop with out
-          for c = (read-char port nil nil)
+    (= out nil)
+    (= op 'inc)
+    (= val 0)
+    (=f put (&optional (next 'inc))
+        (unless (zerop val) (push (list op val) out))
+        (setf op next)
+        (setf val 0))
+
+    (loop for c = (read-char port nil nil)
           while (and c (not (eql c #\])))
           when (in c #\+ #\- #\> #\< #\. #\, #\[)
-            do (push
-                (ecase c
-                  (#\+ '(inc))
-                  (#\- '(dec))
-                  (#\> '(minc))
-                  (#\< '(mdec))
-                  ; TODO: fix
-                  (#\. '(put-byte))
-                  (#\, '(get-byte))
-                  (#\[ `(loop until (zerop cell) do (progn ,@(comp-part port)))))
-                out)
-          finally (return (nreverse out)))))
+            do (ecase c
+                 ((#\+ #\-)
+                  (unless (eq op 'inc) (put 'inc))
+                  (incf val (if (eql c #\+) 1 -1)))
+
+                 ((#\> #\<)
+                  (unless (eq op 'minc) (put 'minc))
+                  (incf val (if (eql c #\>) 1 -1)))
+
+                 (#\. (put) (push '(put-byte) out))
+                 (#\, (put) (push '(get-byte) out))
+                 (#\[ (put) (push `(loop until (zerop cell) do (progn ,@(comp-part port))) out)))
+          finally (progn
+                    (put)
+                    (return (nreverse out))))))
 
 (defun comp (&optional (port *standard-input*))
-  `(begin
-     (declare (optimize (speed 3) (safety 0)))
-     (= mem (make-array '(65536) :element-type 'cell))
-     (= mp 0)
-     (=sm cell (aref mem mp))
+  (eval
+   `(lambda (&key (in *standard-input*) (out *standard-output*))
+      (begin
+        (declare (optimize (speed 3) (safety 0)))
+        (= mem (make-array '(65536) :element-type '(unsigned-byte 8)))
+        (= mp 0)
+        (=sm cell (aref mem mp))
 
-     (=f inc (&optional (n 1)) (setf cell (mod (+ cell n) 256)))
-     (=f dec () (inc -1))
+        (=f inc  (&optional (n 1)) (setf cell (mod (+ cell n) 256)))
+        (=f minc (&optional (n 1)) (setf mp   (mod (+ mp n) 65536)))
 
-     (=f minc (&optional (n 1)) (setf mp (mod (+ mp n) 65536)))
-     (=f mdec () (minc -1))
+                                        ; TODO: fix
+        (=f get-byte () (setf cell (mod (char-code (read-char in nil #\null)) 256)))
+        (=f put-byte () (write-char (code-char cell) out))
 
-     (=f get-byte () (setf cell (mod (char-code (read-char *standard-input* nil #\null)) 256)))
-     (=f put-byte () (write-char (code-char cell)))
-
-     (=m bf-loop (&body body)
-         `(loop until (zerop cell)
-                do (progn ,@body)))
-     ,@(comp-part port)
-     t))
+        (=m bf-loop (&body body)
+            `(loop until (zerop cell)
+                   do (progn ,@body)))
+        ,@(comp-part port)
+        t))))
diff --git a/utils.lisp b/utils.lisp
index 360458d..205fcc3 100644
--- a/utils.lisp
+++ b/utils.lisp
@@ -690,6 +690,7 @@
         `(let-match1 ,pattern (progn ,@body)
            (begin ,@rest)))
 
+       ;; consider LABELS
        ((structure ('=f name args . body))
         `(flet ((,name ,args (begin ,@body)))
            (begin ,@rest)))