utils: l$
This commit is contained in:
parent
504b82a11b
commit
6cd8d7a339
3 changed files with 75 additions and 10 deletions
42
png.lisp
42
png.lisp
|
@ -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
25
spreadsheet.lisp
Normal 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))
|
18
utils.lisp
18
utils.lisp
|
@ -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)))
|
||||
|
|
Loading…
Reference in a new issue