=m, =sm, bf v1

~70s mandelbrot

bf.lisp

@@ -0,0 +1,46 @@
+(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)
+          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)))))
+
+(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))
+
+     (=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)))
+
+     (=m bf-loop (&body body)
+         `(loop until (zerop cell)
+                do (progn ,@body)))
+     ,@(comp-part port)
+     t))

utils.lisp

@@ -694,5 +694,13 @@
         `(flet ((,name ,args (begin ,@body)))
            (begin ,@rest)))
 
-       (_ `(progn ,stmt (begin ,@rest)))))
+       ((structure ('=m name args . body))
+        `(macrolet ((,name ,args (begin ,@body)))
+           (begin ,@rest)))
+
+       ((structure ('=sm sym val))
+        `(symbol-macrolet ((,sym ,val))
+           (begin ,@rest)))
+
+       (_ `(locally ,stmt (begin ,@rest)))))
     (_ nil)))