utils: l$

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
+  (values 
-   (block nil
+   (loop for exp across signature
-     (loop for exp across signature
+         for got = (read-byte stream nil nil)
-           for got = (read-byte stream nil nil)
+         do (unless (and got (= exp got))
-           do (unless (and got (= exp got))
+              (return))
-                (return)))
+         finally (return t)) 
-     t)
    nil))

spreadsheet.lisp

@@ -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))

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)))