bf: zeroing and zeroing add optimization

~13s mandelbrot :(
This commit is contained in:
mehbark 2024-12-17 18:38:09 -05:00
parent 704ff740e0
commit 9784d97607

53
bf.lisp
View file

@ -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*))
(begin
(declare (optimize (speed 3) (safety 0)))
(= mem (make-array '(65536) :element-type '(unsigned-byte 8)))
(begin
(= 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
(=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)))