b6ef3040c692

--- a/.lispwords	Wed Jun 01 18:17:59 2016 +0000
+++ b/.lispwords	Wed Jun 01 19:10:49 2016 +0000
@@ -1,3 +1,4 @@
 (1 scancode-case)
 (1 make-sketch)
 (2 grid-loop-cells grid-loop-rows)
+(1 recursively)

--- a/make-quickutils.lisp	Wed Jun 01 18:17:59 2016 +0000
+++ b/make-quickutils.lisp	Wed Jun 01 19:10:49 2016 +0000
@@ -12,6 +12,7 @@
                ; :iota
                :curry
                :rcurry
+               ; :zip
                ; :compose
                ; :n-grams
                )

--- a/package.lisp	Wed Jun 01 18:17:59 2016 +0000
+++ b/package.lisp	Wed Jun 01 19:10:49 2016 +0000
@@ -12,6 +12,8 @@
     #:full-list
     #:smallest
     #:largest
+    #:recursively
+    #:recur
     #:%))
 
 (defpackage #:mazes.fps

--- a/quickutils.lisp	Wed Jun 01 18:17:59 2016 +0000
+++ b/quickutils.lisp	Wed Jun 01 19:10:49 2016 +0000
@@ -2,7 +2,7 @@
 ;;;; See http://quickutil.org for details.
 
 ;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:WHILE :WITH-GENSYMS :ONCE-ONLY :CURRY :RCURRY) :ensure-package T :package "MAZES.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:WHILE :WITH-GENSYMS :ONCE-ONLY :CURRY :RCURRY :ZIP) :ensure-package T :package "MAZES.QUICKUTILS")
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (unless (find-package "MAZES.QUICKUTILS")
@@ -16,7 +16,7 @@
   (setf *utilities* (union *utilities* '(:UNTIL :WHILE :STRING-DESIGNATOR
                                          :WITH-GENSYMS :MAKE-GENSYM-LIST
                                          :ONCE-ONLY :ENSURE-FUNCTION :CURRY
-                                         :RCURRY))))
+                                         :RCURRY :TRANSPOSE :ZIP))))
 
   (defmacro until (expression &body body)
     "Executes `body` until `expression` is true."
@@ -166,7 +166,18 @@
         (declare (dynamic-extent more))
         (multiple-value-call fn (values-list more) (values-list arguments)))))
   
+
+  (defun transpose (lists)
+    "Analog to matrix transpose for a list of lists given by `lists`."
+    (apply #'mapcar #'list lists))
+  
+
+  (defun zip (&rest lists)
+    "Take a tuple of lists and turn them into a list of
+tuples. Equivalent to `unzip`."
+    (transpose lists))
+  
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (export '(while with-gensyms with-unique-names once-only curry rcurry)))
+  (export '(while with-gensyms with-unique-names once-only curry rcurry zip)))
 
 ;;;; END OF quickutils.lisp ;;;;

--- a/src/grid.lisp	Wed Jun 01 18:17:59 2016 +0000
+++ b/src/grid.lisp	Wed Jun 01 19:10:49 2016 +0000
@@ -207,14 +207,11 @@
 
 ;;;; Path Finding
 (defun dijkstra (distances target)
-  (let ((root (dm-root distances)))
-    (labels
-        ((recur (cell path)
-           (when cell
-             (if (eql cell root)
-               (cons root path)
-               (recur
-                 (smallest (cell-links cell)
-                           :key (curry #'dm-distance distances))
-                 (cons cell path))))))
-      (recur target nil))))
+  (let ((root (dm-root distances))
+        (dist (curry #'dm-distance distances)))
+    (recursively ((cell target) path)
+      (cond
+        ((not cell) nil) ; maze is fucked
+        ((eql cell root) (cons root path)) ; done
+        (t (recur (smallest (cell-links cell) :key dist) ; loop
+                  (cons cell path)))))))

--- a/src/utils.lisp	Wed Jun 01 18:17:59 2016 +0000
+++ b/src/utils.lisp	Wed Jun 01 19:10:49 2016 +0000
@@ -56,3 +56,27 @@
 
 (defun largest (list &key (key #'identity))
   (first (sort (copy-list list) #'> :key key)))
+
+(defmacro recursively (bindings &body body)
+  "Execute body recursively, like Clojure's `loop`/`recur`.
+
+  `bindings` should contain a list of symbols and (optional) default values.
+
+  In `body`, `recur` will be bound to the function for recurring.
+
+  Example:
+
+      (defun length (some-list)
+        (recursively ((list some-list) (n 0))
+          (if (null list)
+            n
+            (recur (cdr list) (1+ n)))))
+
+  "
+  (flet ((extract-var (binding)
+           (if (atom binding) binding (first binding)))
+         (extract-val (binding)
+           (if (atom binding) nil (second binding))))
+    `(labels ((recur ,(mapcar #'extract-var bindings)
+                ,@body))
+      (recur ,@(mapcar #'extract-val bindings)))))