diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-07-11 19:48:47 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-07-11 19:48:47 +0200 |
commit | f743e08220883eef86effdac8a5e7c94deddc302 (patch) | |
tree | 053da1a51b7262721e1fcb1324994122ce427bc6 /module/c/zipper.scm | |
parent | Fix whitespace for rest args. (diff) | |
download | calp-f743e08220883eef86effdac8a5e7c94deddc302.tar.gz calp-f743e08220883eef86effdac8a5e7c94deddc302.tar.xz |
Cleanup + fix __LINE__.
Diffstat (limited to 'module/c/zipper.scm')
-rw-r--r-- | module/c/zipper.scm | 60 |
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)))) |