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

bf: rePUT, 3.5x perf with mp type decl

Browse source 
~3.6s mandelbrot
This commit is contained in:
mehbark 2024-12-18 14:01:36 -05:00
parent 64b5785bcc
commit 765c4ecacc
2 changed files with 14 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
bf.lisp
View file

@ -54,6 +54,8 @@
`(loop until (zerop cell) `(loop until (zerop cell)
do (progn ,@inner))) do (progn ,@inner)))
out)))) out))))
;; WE NEED TO PUT BECAUSE LOOPS IDOIT!
finally (put)
finally (return (nreverse out))))) finally (return (nreverse out)))))
(defparameter mem-size 32768) (defparameter mem-size 32768)
@ -65,6 +67,8 @@
(begin (begin
(= mem (make-array ,mem-size :element-type '(unsigned-byte 8))) (= mem (make-array ,mem-size :element-type '(unsigned-byte 8)))
(= mp 0) (= mp 0)
(declare (type (mod ,mem-size) mp))
(=sm cell (aref mem mp)) (=sm cell (aref mem mp))
(=f inc (n) (incmodf cell 256 n)) (=f inc (n) (incmodf cell 256 n))

12
utils.lisp
View file

@ -664,6 +664,15 @@
;; (defmacro <>-> (val &body body) ;; (defmacro <>-> (val &body body)
;; `(as-> ,val <> ,@body)) ;; `(as-> ,val <> ,@body))
;; the value of this is that (-> x car) is (car x) instead of (let1 it x (car x)), enabling setf
(defmacro -> (x &body body)
(match body
((cons (cons f xs) rest)
`(-> (,f ,x ,@xs) ,@rest))
((cons f rest)
`(-> (,f ,x) ,@rest))
(nil x)))
(defmacro doprod ((&rest binds) &body body) (defmacro doprod ((&rest binds) &body body)
(if (null binds) (if (null binds)
`(progn ,@body) `(progn ,@body)
@ -690,9 +699,8 @@
`(let-match1 ,pattern (progn ,@body) `(let-match1 ,pattern (progn ,@body)
(begin ,@rest))) (begin ,@rest)))
;; consider LABELS
((structure ('=f name args . body)) ((structure ('=f name args . body))
`(flet ((,name ,args (begin ,@body))) `(labels ((,name ,args (begin ,@body)))
(begin ,@rest))) (begin ,@rest)))
((structure ('=m name args . body)) ((structure ('=m name args . body))