diff --git a/collects/stepper/private/reconstruct.rkt b/collects/stepper/private/reconstruct.rkt index 6e6417f209..beb8469c8d 100644 --- a/collects/stepper/private/reconstruct.rkt +++ b/collects/stepper/private/reconstruct.rkt @@ -107,7 +107,8 @@ ; of a let, or unless there _is_ no name. (define recon-value - (opt-lambda (val render-settings [assigned-name #f] [current-so-far nothing-so-far]) + (opt-lambda (val render-settings [assigned-name #f] + [current-so-far nothing-so-far] [seen-promises null]) (if (hash-ref finished-xml-box-table val (lambda () #f)) (stepper-syntax-property #`(quote #,val) 'stepper-xml-value-hint 'from-xml-box) (let* ([extracted-proc (unwrap-proc val)] @@ -133,55 +134,63 @@ (mark-source mark) (list mark) null null render-settings)))] ; promise does not have annotation info, ; must be from library code, or it's a running promise + ; or it's a nested promise? [(promise? val) - (let ([partial-eval-promise - (or (hash-ref partially-evaluated-promises-table - val (λ () #f)) - ; can be an extra promise layer when dealing with lists - (hash-ref partially-evaluated-promises-table - (pref val) (λ () #f)))]) - (cond [partial-eval-promise partial-eval-promise] - ; running promise not found by search in recon-inner - ; must be a nested running promise - [(and (nested-promise-running? val) - (not (eq? current-so-far nothing-so-far))) - (hash-set! partially-evaluated-promises-table - val current-so-far) - current-so-far] - ; promise is not running if we get here - [(and (promise-forced? val) - (not (nested-promise-running? val))) - (recon-value (force val) render-settings assigned-name current-so-far)] - ; unknown promise: promise not in src code, created in library fn - [else - (let ([unknown-promise - (hash-ref unknown-promises-table - val (λ () #f))]) - (if unknown-promise - (render-unknown-promise unknown-promise) - ; else generate a fresh unknown promise - (begin0 - (render-unknown-promise next-unknown-promise) - (hash-set! unknown-promises-table - val next-unknown-promise) - (set! next-unknown-promise - (add1 next-unknown-promise)))))]))] + (cond + ; running promise cached by recon-inner + [(or (hash-ref partially-evaluated-promises-table val (λ () #f)) + ; can be an extra promise layer when dealing with lists + (hash-ref partially-evaluated-promises-table (pref val) (λ () #f)))] + ; running promise not found by search in recon-inner + ; must be a nested running promise + [(and (nested-promise-running? val) + (not (eq? current-so-far nothing-so-far))) + (hash-set! partially-evaluated-promises-table val current-so-far) + current-so-far] + #;[(and (nested-promise-running? val) + (not (null? last-so-far))) + last-so-far] + ; promise is not running if we get here + [(and (promise-forced? val) + (not (nested-promise-running? val)) + (not (assq val seen-promises))) + (recon-value (force val) render-settings + assigned-name current-so-far + (cons (list val assigned-name) seen-promises))] + ; for cyclic lists, use assigned name if it's available + [(let ([v (assq val seen-promises)]) + (and v (second v)))] + ; unknown promise: promise not in src code, created in library fn + [(hash-ref unknown-promises-table val (λ () #f)) + => + render-unknown-promise] + [else ; else generate a fresh unknown promise + (begin0 + (render-unknown-promise next-unknown-promise) + (hash-set! unknown-promises-table + val next-unknown-promise) + (set! next-unknown-promise + (add1 next-unknown-promise)))])] ; STC: handle lists here, instead of deferring to render-to-sexp fn ; because there may be nested promises [(null? val) #'empty] [(list? val) (with-syntax ([(reconed-vals ...) - (map (lx (recon-value _ render-settings assigned-name current-so-far)) val)]) + (map + (lx (recon-value _ render-settings #f current-so-far seen-promises)) + val)]) (if (render-settings-constructor-style-printing? render-settings) #'(#%plain-app list reconed-vals ...) #'`(reconed-vals ...)))] [(pair? val) (with-syntax ([reconed-car - (recon-value (car val) render-settings assigned-name current-so-far)] + (recon-value (car val) render-settings + #f current-so-far seen-promises)] [reconed-cdr - (recon-value (cdr val) render-settings assigned-name current-so-far)]) + (recon-value (cdr val) render-settings + #f current-so-far seen-promises)]) #'(#%plain-app cons reconed-car reconed-cdr))] [else (let* ([rendered @@ -235,6 +244,18 @@ #`(quote #,(string->symbol (string-append "string x) ">")))) + ; This is used when we need the exp associated with a running promise, but the promise is at top-level, + ; so it never gets added to partially-evaluated-promises-table + ; This is a huge hack and I dont know if it the assumptions I'm making always hold + ; (ie - that the exp associated with any running promise not in partially-evaluated-promises-table is the last so-far), + ; but it's working for all test cases so far 10/29/2010. + ; Another solution is to wrap all lazy programs in a dummy top-level expression??? + ; Update 11/1/2010: needed to add the following guards in the code to make the assumptions hold + ; (guards are mainly triggered when there are infinite lists) + ; - in recon-inner, dont add running promise to partially-evaluated-promises-table if so-far = nothing-so-far + ; - in recon, dont set last-so-far when so-far = nothing-so-far + ; - in recon-value, dont use last-so-far if it hasnt been set (ie - if it's still null) + (define last-so-far null) ; ; ;;; ; ; ; ;;; ; ; ; ; ;;; ; ; ; ; ; ; ;;; ;;;; ;;; ; ;;; ; @@ -1030,6 +1051,8 @@ (define (recon so-far mark-list first) (cond [(null? mark-list) ; now taken to indicate a callback: + (unless (eq? so-far nothing-so-far) + (set! last-so-far so-far)) so-far ;(error `recon "expcted a top-level mark at the end of the mark list.") ] @@ -1059,6 +1082,7 @@ (begin ; STC: reset partial-eval-promise table on each call to recon (set! partially-evaluated-promises-table (make-weak-hash)) + (set! last-so-far null) (case break-kind ((left-side) diff --git a/collects/tests/stepper/automatic-tests.rkt b/collects/tests/stepper/automatic-tests.rkt index 3d6bc9d14f..4580d82bfe 100644 --- a/collects/tests/stepper/automatic-tests.rkt +++ b/collects/tests/stepper/automatic-tests.rkt @@ -17,7 +17,8 @@ lazy-eq? lazy-eqv? lazy-equal? lazy-list?1 lazy-list?2 lazy-list?3 lazy-length lazy-list-ref lazy-list-tail lazy-append lazy-reverse lazy-empty? lazy-assoc lazy-assq lazy-assv lazy-cons? lazy-remove lazy-remq lazy-remv - lazy-member lazy-memq lazy-memv lazy-filter1 lazy-filter2 lazy-fold)) + lazy-member lazy-memq lazy-memv lazy-filter1 lazy-filter2 lazy-fold + lazy-cyclic1)) (let ((outer-namespace (current-namespace))) (parameterize ([display-only-errors #t] diff --git a/collects/tests/stepper/through-tests.rkt b/collects/tests/stepper/through-tests.rkt index c449764c02..e0b97828b0 100755 --- a/collects/tests/stepper/through-tests.rkt +++ b/collects/tests/stepper/through-tests.rkt @@ -2121,6 +2121,22 @@ -> (+ {6} 1000) :: {(+ 6 1000)} -> {1006}) + (let ([def '(define ones (cons 1 ones))]) + (t 'lazy-cyclic1 m:lazy + ,def (+ (second ones) (third ones)) + :: ,def (+ (second {ones}) (third ones)) + -> ,def (+ (second {(cons 1 ones)}) (third ones)) + :: (define ones {ones}) (+ (second {ones}) (third ones)) ; extra step + -> (define ones {,( 0)}) (+ (second {,( 0)}) (third ones)) + :: ,def (+ {(second (cons 1 ,( 0)))} (third ones)) + -> ,def (+ {1} (third ones)) + :: ,def (+ 1 (third {ones})) + -> ,def (+ 1 (third {(cons 1 ,( 0))})) + :: ,def (+ 1 {(third (cons 1 ,( 0)))}) + -> ,def (+ 1 {1}) + :: ,def {(+ 1 1)} -> ,def {2})) + +