From f743e08220883eef86effdac8a5e7c94deddc302 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 11 Jul 2022 19:48:47 +0200 Subject: Cleanup + fix __LINE__. --- module/c/zipper.scm | 60 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 60 insertions(+) create mode 100644 module/c/zipper.scm (limited to 'module/c/zipper.scm') 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)))) -- cgit v1.2.3