mbk/lisp
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

bf: zeroing and zeroing add optimization

Browse source 
~13s mandelbrot :(
This commit is contained in:
mehbark 2024-12-17 18:38:09 -05:00
parent 704ff740e0
commit 9784d97607
1 changed files with 43 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

55
bf.lisp
View file

@ -1,5 +1,28 @@
(load "utils.lisp") (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*)) (defun comp-part (&optional (port *standard-input*))
(begin (begin
(= out nil) (= out nil)
@ -24,29 +47,37 @@
(#\. (put) (push '(put-byte) out)) (#\. (put) (push '(put-byte) out))
(#\, (put) (push '(get-byte) out)) (#\, (put) (push '(get-byte) out))
(#\[ (put) (push `(loop until (zerop cell) do (progn ,@(comp-part port))) out))) (#\[ (put)
finally (progn (let1 inner (comp-part port)
(put) (push (or (optimize-loop inner)
(return (nreverse out)))))) `(loop until (zerop cell) do (progn ,@inner)))
out))))
finally (put)
finally (return (nreverse out)))))
(defun comp (&optional (port *standard-input*)) (defun comp (&optional (port *standard-input*))
(eval (eval
`(lambda (&key (in *standard-input*) (out *standard-output*)) `(lambda (&key (in *standard-input*) (out *standard-output*))
(declare (optimize (speed 3) (safety 0)))
(begin (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) (= mp 0)
(=sm cell (aref mem mp)) (=sm cell (aref mem mp))
(=f inc (&optional (n 1)) (setf cell (mod (+ cell n) 256))) (=f inc (n) (setf cell (mod (+ cell n) 256)))
(=f minc (&optional (n 1)) (setf mp (mod (+ mp n) 65536))) (=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 get-byte () (setf cell (mod (char-code (read-char in nil #\null)) 256)))
(=f put-byte () (write-char (code-char cell) out)) (=f put-byte () (write-char (code-char cell) out))
(=m bf-loop (&body body) (=f zeroing-add (rmove)
`(loop until (zerop cell) (incmodf (aref mem (mod (+ mp rmove) 65536)) 256 cell)
do (progn ,@body))) (setf cell 0))
,@(comp-part port) ,@(comp-part port)
t)))) t))))
(defun main ()
(funcall (comp)))