suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

...

Browse Source 
svn: r3715
This commit is contained in:
John Clements 2006-07-15 21:22:08 +00:00
parent aaa35b6c37
commit 08ef0f366c
2 changed files with 12 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/stepper/private/model.ss
View File

@ -298,6 +298,7 @@
#;(void) #;(void)
) )
(lambda (expanded continue-thunk) ; iter (lambda (expanded continue-thunk) ; iter
(r:reset-special-values)
(if (eof-object? expanded) (if (eof-object? expanded)
(begin (begin
(receive-result (make-finished-stepping))) (receive-result (make-finished-stepping)))

14
collects/stepper/private/reconstruct.ss
View File

@ -39,7 +39,9 @@
[final-mark-list? (-> mark-list? boolean?)] [final-mark-list? (-> mark-list? boolean?)]
[skip-step? (-> break-kind? (or/c mark-list? false/c) render-settings? boolean?)] [skip-step? (-> break-kind? (or/c mark-list? false/c) render-settings? boolean?)]
[step-was-app? (-> mark-list? boolean?)]) [step-was-app? (-> mark-list? boolean?)]
[reset-special-values (-> any)])
(define nothing-so-far (gensym "nothing-so-far-")) (define nothing-so-far (gensym "nothing-so-far-"))
@ -217,8 +219,14 @@
[else (error 'find-special-name "couldn't find expanded name for ~a" name)])]) [else (error 'find-special-name "couldn't find expanded name for ~a" name)])])
(eval just-the-fn))) (eval just-the-fn)))
(define special-list-value (find-special-value 'list '(3))) ;; these are delayed so that they use the userspace expander. I'm sure
(define special-cons-value (find-special-value 'cons '(3 empty))) ;; there's a more robust & elegant way to do this.
(define special-list-value #f)
(define special-cons-value #f)
(define (reset-special-values)
(set! special-list-value (find-special-value 'list '(3)))
(set! special-cons-value (find-special-value 'cons '(3 empty))))
(define (second-arg-is-list? mark-list) (define (second-arg-is-list? mark-list)
(let ([arg-val (lookup-binding mark-list (get-arg-var 2))]) (let ([arg-val (lookup-binding mark-list (get-arg-var 2))])