bf: group ops

~13s mandelbrot

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
+  (eval
+   `(lambda (&key (in *standard-input*) (out *standard-output*))
+      (begin
         (declare (optimize (speed 3) (safety 0)))
-     (= mem (make-array '(65536) :element-type 'cell))
+        (= 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 minc (&optional (n 1)) (setf mp   (mod (+ mp n) 65536)))
-     (=f mdec () (minc -1))
 
-     (=f get-byte () (setf cell (mod (char-code (read-char *standard-input* nil #\null)) 256)))
-     (=f put-byte () (write-char (code-char cell)))
+                                        ; 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))
 
         (=m bf-loop (&body body)
             `(loop until (zerop cell)
                    do (progn ,@body)))
         ,@(comp-part port)
-     t))
+        t))))

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)))