This program is based on my vague recollection of an ancient manuscript by Chris Hanson and John Lamping. I apologize for the lack of data abstraction, but the code is more concise this way.
A state space is a tree with the current state at the root. Each node other than the root is a triple , represented in this implementation as two pairs ((before . after) . parent). Navigating between states requires re-rooting the tree by reversing parent-child links.
Since dynamic-wind interacts with call-with-current-continuation, this implementation must replace the usual definition of the latter.
=0pt=0pt=0pt =0pt (define *here* (list #f))
(define original-cwcc call-with-current-continuation)
(define (call-with-current-continuation proc) (let ((here *here*)) (original-cwcc (lambda (cont) (proc (lambda results (reroot! here) (apply cont results)))))))
(define (dynamic-wind before during after) (let ((here *here*)) (reroot! (cons (cons before after) here)) (call-with-values during (lambda results (reroot! here) (apply values results)))))
(define (reroot! there) (if (not (eq? *here* there)) (begin (reroot! (cdr there)) (let ((before (caar there)) (after (cdar there))) (set-car! *here* (cons after before)) (set-cdr! *here* there) (set-car! there #f) (set-cdr! there '()) (set! *here* there) (before)))))