Commits

Moritz Heidkamp committed f481156

Add skip, find-first, find-parent

  • Participants
  • Parent commits 12dd844

Comments (0)

Files changed (2)

 ;;
 ;; You must not remove this notice, or any other, from this software.
 
-(use (only srfi-1 last))
+(import chicken scheme)
+(use (only srfi-1 last)
+     (only data-structures butlast))
 
 (define-record-type zipper
   (make-zipper impl node path)
 (define (end? loc)
   (eqv? 'end (loc-path loc)))
 
-(define (next loc)
-  (or (and (branch? loc) (down loc))
-      (right loc)
+(define (skip loc)
+  (or (right loc)
       (let loop ((loc loc))
         (let ((p (up loc)))
           (if p
               (or (right p) (loop p))
               (copy-loc loc path: 'end))))))
 
+(define (next loc)
+  (or (and (branch? loc) (down loc))
+      (skip loc)))
+
 (define (root loc)
   (let ((p (up loc)))
     (if p (root p) loc)))
         (if (pred? loc)
             (cons loc (loop (next loc)))
             (loop (next loc))))))
+
+(define (find-first loc pred?)
+  (let loop ((loc (scoped loc)))
+    (and (not (end? loc))
+         (if (pred? loc)
+             loc
+             (loop (next loc))))))
+
+(define (find-parent loc pred?)
+  (let loop ((loc (up loc)))
+    (and loc
+         (if (pred? loc)
+             loc
+             (loop (up loc))))))
 (module zipper
 
-()
-
-(import chicken scheme)
+(zipper
+ list-zipper
+ scoped
+ node
+ branch?
+ end?
+ next
+ right
+ left
+ up
+ skip
+ find-all
+ find-first
+ find-parent)
 
 "zipper-impl.scm"