png.lisp

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

spreadsheet.lisp

@@ -1,36 +0,0 @@
-(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"))
-    (= current-index (gensym "CURRENT-INDEX"))
-    (= cells
-       `(list
-         ,@(loop for row in rows
-               for y from 0
-               collecting
-               `(list
-                 ,@(loop for cell in row
-                         for x from 0
-                         collecting `(lambda () (let1 ,current-index '(,x ,y) ,cell)))))))
-    (= cells
-       `(progn
-          (defvar ,current-index nil)
-          (labels ((,cells-name ()
-                     (make-array '(,(length rows) ,width)
-                                 :element-type 'function
-                                 :initial-contents ,cells))
-                   (cell (x y)
-                     (assert (not (equal (list x y) ,current-index)))
-                     (funcall (aref (,cells-name) y x))))
-            (,cells-name))))
-    cells))

utils.lisp

@@ -686,12 +686,6 @@
       `(loop for ,(first (car binds)) in ,(second (car binds))
              do (doprod ,(cdr binds) ,@body))))
 
-(defmacro mapprod ((&rest binds) &body body)
-  (if (null binds)
-      `(progn ,@body)
-      `(loop for ,(first (car binds)) in ,(second (car binds))
-             collect (mapprod ,(cdr binds) ,@body))))
-
 (defpattern structure (expr)
   (match expr
     ((list 'quote x) `',x)
@@ -726,21 +720,3 @@
 
        (_ `(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)))