;; Creating our zipper abstraction
(define (make-zipper l p r)
 "Create a zipper with what's to come left of point,
 what's at point and what's right of the point."
 (list l p r))
(define (zipper-point z)
 "Get the point of the zipper."
 (cadr z))
(define (zipper-left z)
 "Get what's left of the zipper, in the order as if
 the point moved to the left."
 (car z))
(define (zipper-right z)
 "Get what's right of the zipper."
 (caddr z))


;; Conversion into our new data type
(define (zipper-from-list l)
 "Create a zipper from a (non empty) list, and
 place the point at the first element."
 (make-zipper '() (car l) (cdr l)))


;; Movement on zippers.
;; (2 1) 3 (4 5)
;; move-right => (3 2 1) 4 (5)
;; move-left => (1) 2 (3 4 5)
(define (zipper-move-right z)
 "Return a zipper with the point moved one to the
 right."
 (make-zipper
  (cons (zipper-point z) (zipper-left z))
  (car (zipper-right z))
  (cdr (zipper-right z))))
(define (zipper-move-left z)
 "Return a zipper with the point moved one to the
 left."
 (make-zipper
  (cdr (zipper-left z))
  (car (zipper-left z))
  (cons (zipper-point z) (zipper-right z))))


;; A special kind of moving, destructing the value at point.
;; (2 1) 3 (4 5)
;; zipper-squash-left => (1) 2 (4 5)
;; zipper-squash-right => (2 1) 4 (5)
(define (zipper-squash-right z)
 "Squash the value at point and close the gap
 with a value from right."
 (make-zipper
  (zipper-left z)
  (car (zipper-right z))
  (cdr (zipper-right z))))
(define (zipper-squash-left z)
 "Squash the value at point and close the gap
 with a value from left."
 (make-zipper
  (cdr (zipper-left z))
  (car (zipper-left z))
  (zipper-right z)))

;; Testing for the end points of the zipper.
(define (zipper-left-end? z)
 "Check whether the zipper is at the left end."
 (eq? '() (zipper-left z)))
(define (zipper-right-end? z)
 "Check whether the zipper is at the right end."
 (eq? '() (zipper-right z)))


;; Pull out a list from the current position of the
;; point.
(define (pull-list-from-zipper z)
 "Pull out a list from the current point of the
 zipper. The list will have the point as first value, followed
 by the one right to it, then the one left of it, then another
 one from the right and so on."
 (cond
  ((zipper-left-end? z) (cons (zipper-point z) (zipper-right z)))
  ((zipper-right-end? z) (cons (zipper-point z) (zipper-left z)))
  (else
   (let* ((p1 (zipper-point z))
             (z1 (zipper-squash-right z))
             (p2 (zipper-point z1))
             (z2 (zipper-squash-left z1)))
    (cons p1 (cons p2 (pull-list-from-zipper z2)))))))


;; Utility function
(define (repeated f n)
 "Return a function that repeatedly applies the
 given function."
 (cond
  ((= 0 n) (lambda (o) o))
  (else (lambda (o) ((repeated f (- n 1)) (f o))))))


;; What we wanted to to.
(define (unwind l)
 "Move to the mid and pull a list out of the list."
 (let ((steps (quotient (- (length l) 1) 2)))
  (pull-list-from-zipper
   ((repeated zipper-move-right steps) (zipper-from-list l)))))


;; Demos
(display (unwind '(1 2 3 4 5 6)))
(newline)
(display (unwind '(7 8 2 9 5 6)))
(newline)
(newline)


;; Other examples
(display ((repeated zipper-move-right 5) (zipper-from-list '(1 2 3 4 5 6 7 8 9))))
(newline)

(display (pull-list-from-zipper (zipper-move-right
                (zipper-move-right (zipper-from-list '(1 2 3 4))))))
(newline)