utils: l$

This commit is contained in:
mehbark 2025-01-02 19:01:34 -05:00
parent 504b82a11b
commit 6cd8d7a339
3 changed files with 75 additions and 10 deletions

View file

@ -8,19 +8,41 @@
(defmacro hexbytes (&rest bytes)
(map '(vector flex:octet) (λ (x) (reread "#x" x)) bytes))
(defparameter signature
(hexbytes 89 50 4E 47 0D 0A 1A 0A))
(defgeneric bmatch (obj stream)
(:documentation "attempt to match OBJ with the binary input stream STREAM.
returns (VALUES BOOLEAN T)"))
(defmacro bor (&body opts)
(with-gensyms (ok? val)
(match opts
((list a b)
`(mvbind (,ok? ,val) ,a
(if ,ok? ,val ,b)))
((cons a b*)
`(bor ,a (bor ,@b*)))
(nil '(values nil nil)))))
(defmacro band (&body opts)
(with-gensyms (a-ok? a-val b-ok? b-val)
(match opts
((cons a b*)
`(mvbind (,a-ok? ,a-val) ,a
(if ,a-ok?
(mvbind (,b-ok? ,b-val) (band ,@b*)
(if ,b-ok?
(values t (cons ,a-val ,b-val))
(bor)))
(bor))))
(nil '(values t nil)))))
(defparameter signature
(hexbytes 89 50 4E 47 0D 0A 1A 0A))
(defmethod bmatch ((obj vector) stream)
(values
(block nil
(loop for exp across signature
for got = (read-byte stream nil nil)
do (unless (and got (= exp got))
(return)))
t)
(values
(loop for exp across signature
for got = (read-byte stream nil nil)
do (unless (and got (= exp got))
(return))
finally (return t))
nil))

25
spreadsheet.lisp Normal file
View file

@ -0,0 +1,25 @@
(load "utils.lisp")
;; n-dimensional, why not
(defclass sheet ()
((cells :initarg :cells :type (simple-array function))))
;; todo: identify dependencies and lazily recompute
;; (i would use promises, but)
;; having everything be a thunk is advantageous
(defmacro sheet (&body rows)
(begin
(= width (length (car rows)))
(assert (apply #'= (mapcar #'length rows)))
(= cells-name (gensym "CELLS"))
(= cells `(list ,@(mapcar )))
(= cells `(make-array (list width (length rows))
:element-type 'function
:initial-contents
(macrolet ((cell (&rest subscripts) `(aref ,cells-name ,@subscripts)))
,cells)))
))
(sheet
(1 2 3 4 5)
(6 7 8 9 10))

View file

@ -720,3 +720,21 @@
(_ `(locally ,stmt (begin ,@rest)))))
(_ nil)))
(defmacro l$ (&body body)
(begin
(=f $? (sym) (and (symbolp sym) (starts-with #\$ (symbol-name sym))))
(=f $-value (sym) (or (parse-integer (string-trim "$" (symbol-name sym))
:junk-allowed t)
-1))
(= money (remove-duplicates (remove-if-not #'$? (flatten body))))
(= highest (apply #'max (cons 0 (mapcar #'$-value money))))
`(lambda (,@(loop for i from 1 to highest
collecting (symb '$ i))
,@(when (member '$@ money)
'(&rest $@)))
,@body)))
(begin (=f x2 (n) (+ n n)) (fpromote x2) (mapcar x2 '(1 2 3)))