From 9784d9760752ac738c272bdc85353e3de0af969d Mon Sep 17 00:00:00 2001
From: mehbark <terezi@pyrope.net>
Date: Tue, 17 Dec 2024 18:38:09 -0500
Subject: [PATCH] bf: zeroing and zeroing add optimization

~13s mandelbrot :(
---
 bf.lisp | 55 +++++++++++++++++++++++++++++++++++++++++++------------
 1 file changed, 43 insertions(+), 12 deletions(-)

diff --git a/bf.lisp b/bf.lisp
index 2b67459..abfd68a 100644
--- a/bf.lisp
+++ b/bf.lisp
@@ -1,5 +1,28 @@
 (load "utils.lisp")
 
+(defmacro incmodf (place mod &optional (delta 1))
+  `(setf ,place (mod (+ ,place ,delta) ,mod)))
+
+; TODO: ooo could totally gen from sym (e.g. '++-[]>)
+; then i'd need some sort of var syntax ugh
+(defpattern cmd (op val)
+  `(list ',op ,val))
+
+; mandelbrot is about 5kb shorter with this :P
+(defun optimize-loop (ins)
+  (match ins
+    ((list (cmd inc _)) '(setf cell 0))
+    ((guard
+      (list (cmd inc -1)
+            (cmd minc rmove)
+            (cmd inc  1)
+            (cmd minc lmove))
+      (= lmove (- rmove))) ; [->{n}+<{n}]
+     `(zeroing-add ,rmove))
+    ; maybe warn here?
+    ((list) '(unless (zerop cell) (loop)))
+    (_ nil)))
+
 (defun comp-part (&optional (port *standard-input*))
   (begin
     (= out nil)
@@ -24,29 +47,37 @@
 
                  (#\. (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))))))
+                 (#\[ (put)
+                  (let1 inner (comp-part port)
+                    (push (or (optimize-loop inner)
+                              `(loop until (zerop cell) do (progn ,@inner)))
+                          out))))
+          finally (put)
+          finally (return (nreverse out)))))
 
 (defun comp (&optional (port *standard-input*))
   (eval
    `(lambda (&key (in *standard-input*) (out *standard-output*))
+      (declare (optimize (speed 3) (safety 0)))
       (begin
-        (declare (optimize (speed 3) (safety 0)))
-        (= mem (make-array '(65536) :element-type '(unsigned-byte 8)))
+        (= 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 minc (&optional (n 1)) (setf mp   (mod (+ mp n) 65536)))
+        (=f inc  (n) (setf cell (mod (+ cell n) 256)))
+        (=f minc (n) (setf mp (mod (+ mp n) 65536)))
 
-                                        ; TODO: fix
+        ; 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)))
+        (=f zeroing-add (rmove)
+            (incmodf (aref mem (mod (+ mp rmove) 65536)) 256 cell)
+            (setf cell 0))
+
         ,@(comp-part port)
+
         t))))
+
+(defun main ()
+  (funcall (comp)))