Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-20 22:29:16 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Renaming dynamic-wind point routines to avoid likely user names.

Browse source
This commit is contained in:
Alex Shinn 2013-05-29 23:32:54 +09:00
parent 5ba723333f
commit 9c622fef67
1 changed files with 12 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
lib/init-7.scm
View file

@ -579,14 +579,14 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; dynamic-wind ;; dynamic-wind
(define make-point vector) (define %make-point vector)
(define (point-depth point) (vector-ref point 0)) (define (%point-depth point) (vector-ref point 0))
(define (point-in point) (vector-ref point 1)) (define (%point-in point) (vector-ref point 1))
(define (point-out point) (vector-ref point 2)) (define (%point-out point) (vector-ref point 2))
(define (point-parent point) (vector-ref point 3)) (define (%point-parent point) (vector-ref point 3))
(define root-point ; Shared among all state spaces (define root-point ; Shared among all state spaces
(make-point 0 (%make-point 0
(lambda () (error "winding in to root!")) (lambda () (error "winding in to root!"))
(lambda () (error "winding out of root!")) (lambda () (error "winding out of root!"))
#f)) #f))
@ -603,7 +603,7 @@
(define (dynamic-wind in body out) (define (dynamic-wind in body out)
(in) (in)
(let ((here (%dk))) (let ((here (%dk)))
(%dk (make-point (+ (point-depth here) 1) (%dk (%make-point (+ (%point-depth here) 1)
in in
out out
here)) here))
@ -616,12 +616,12 @@
(cond (cond
((eq? here target) ((eq? here target)
'done) 'done)
((< (point-depth here) (point-depth target)) ((< (%point-depth here) (%point-depth target))
(travel-to-point! here (point-parent target)) (travel-to-point! here (%point-parent target))
((point-in target))) ((%point-in target)))
(else (else
((point-out here)) ((%point-out here))
(travel-to-point! (point-parent here) target)))) (travel-to-point! (%point-parent here) target))))
(define (continuation->procedure cont point) (define (continuation->procedure cont point)
(lambda res (lambda res