spreadsheet tinkering

spreadsheet.lisp

@@ -12,14 +12,25 @@
     (= width (length (car rows)))
     (assert (apply #'= (mapcar #'length rows)))
     (= cells-name (gensym "CELLS"))
-    (= cells `(list ,@(mapcar )))
+    (= current-index (gensym "CURRENT-INDEX"))
-    (= cells `(make-array (list width (length rows))
+    (= cells
-                          :element-type 'function
+       `(list
-                          :initial-contents
+         ,@(loop for row in rows
-                          (macrolet ((cell (&rest subscripts) `(aref ,cells-name ,@subscripts)))
+               for y from 0
-                            ,cells)))
+               collecting
-    ))
+               `(list
-
+                 ,@(loop for cell in row
-(sheet
+                         for x from 0
- (1 2 3 4 5)
+                         collecting `(lambda () (let1 ,current-index '(,x ,y) ,cell)))))))
- (6 7 8 9 10))
+    (= 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,6 +686,12 @@
       `(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)