Cleanup + fix __LINE__.

1 files changed, 60 insertions, 0 deletions

diff --git a/module/c/zipper.scm b/module/c/zipper.scm
new file mode 100644
index 00000000..65cea211
--- /dev/null
+++ b/module/c/zipper.scm
@@ -0,0 +1,60 @@
+;;; Commentary:
+;; Zipper data structure. Could be moved to (hnh util), but would then need to
+;; be at least slightly more thorough.
+;;; Code:
+
+(define-module (c zipper)
+  :use-module (srfi srfi-88)
+  :use-module (hnh util object)
+  :export (list-zipper
+           list-zipper?
+           left focused right
+           zip-left
+           zip-right
+           zip-find-right
+           list->zipper
+           zipper->list
+           rezip))
+
+(define-type (list-zipper)
+  (left type: list?)
+  focused
+  (right type: list?))
+
+;; Move zipper one step to the left
+(define (zip-left zipper)
+  (if (null? (left zipper))
+      zipper
+      (list-zipper left: (cdr (left zipper))
+                   right: (cons (focused zipper) (right zipper))
+                   focused: (car (left zipper)))))
+
+;; Move zipper one step to the right
+(define (zip-right zipper)
+  (if (null? (right zipper))
+      zipper
+      (list-zipper left: (cons (focused zipper) (left zipper))
+                   right: (cdr (right zipper))
+                   focused: (car (right zipper)))))
+
+;; find first element matching predicate, going right
+(define (zip-find-right predicate zipper)
+  (cond ((null? (right zipper)) zipper)
+        ((predicate (focused zipper)) zipper)
+        (else (zip-find-right predicate (zip-right zipper)))))
+
+(define (list->zipper list)
+  (list-zipper left: '()
+               focused: (car list)
+               right: (cdr list)))
+
+
+(define (rezip zipper)
+  (if (null? (left zipper))
+      zipper
+      (rezip (zip-left zipper))))
+
+(define (zipper->list zipper)
+  (let ((z (rezip zipper)))
+    (cons (focused z)
+          (right z))))