fix bug in lazy stepper handling of cyclic lists
This commit is contained in:
Stephen Chang
parent
291ee08736
commit
b4ab1bb093
|
|
@ -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 "<DelayedEvaluation#" (number->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)
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
|
|
|
|||
|
|
@ -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 {,(<delay#> 0)}) (+ (second {,(<delay#> 0)}) (third ones))
|
||||
:: ,def (+ {(second (cons 1 ,(<delay#> 0)))} (third ones))
|
||||
-> ,def (+ {1} (third ones))
|
||||
:: ,def (+ 1 (third {ones}))
|
||||
-> ,def (+ 1 (third {(cons 1 ,(<delay#> 0))}))
|
||||
:: ,def (+ 1 {(third (cons 1 ,(<delay#> 0)))})
|
||||
-> ,def (+ 1 {1})
|
||||
:: ,def {(+ 1 1)} -> ,def {2}))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user