fix user-position stepper-property bug in lazy cond stepper unwinding
in stepper/private/macro-unwind.rkt - in fall-through, add special #%app case for force in stepper/private/reconstruct.rkt - in recon-inner, in called app case, combine force case with other lazy fns in tests/stepper/ - add test for lazy cond unwinding problem
This commit is contained in:
parent
3bf0f800a7
commit
c8dd95b3cf
|
@ -64,6 +64,14 @@
|
|||
[(#%plain-app proc-extract p)
|
||||
(eq? (syntax->datum #'proc-extract) 'procedure-extract-target)
|
||||
(unwind #'p settings)]
|
||||
; lazy #%app special case: force
|
||||
[(#%plain-app force arg)
|
||||
(let ([force-fn (syntax->datum #'force)])
|
||||
(or (eq? force-fn 'force)
|
||||
(eq? force-fn '!) (eq? force-fn '!!)
|
||||
(eq? force-fn '!list) (eq? force-fn '!!list)
|
||||
(equal? force-fn '(#%plain-app parameter-procedure))))
|
||||
(unwind #'arg settings)]
|
||||
; general lazy application
|
||||
[(#%plain-app
|
||||
(#%plain-lambda args1 (#%plain-app (#%plain-app proc p) . args2))
|
||||
|
@ -257,10 +265,7 @@
|
|||
(with-syntax
|
||||
([clauses
|
||||
(let loop ([stx stx])
|
||||
; STC: I'm disabling this check because the user-position on some
|
||||
; lazy conds are not correct, but I can't figure out where.
|
||||
; Disabling this check does not break any existing stepper tests.
|
||||
(if #t #;(and (eq? user-source
|
||||
(if (and (eq? user-source
|
||||
(syntax-property stx 'user-source))
|
||||
(eq? user-position
|
||||
(syntax-property stx 'user-position)))
|
||||
|
|
|
@ -899,13 +899,10 @@
|
|||
; dont show ellipses for force (and other lazy fns)
|
||||
; object-name is good enough here, so dont need to add another "special val"
|
||||
(let ([obj-name (object-name (car arg-vals))])
|
||||
(cond [(ormap
|
||||
(lx (eq? obj-name _))
|
||||
'(force ! !! !list !!list))
|
||||
so-far]
|
||||
[(ormap
|
||||
(cond [(ormap
|
||||
(lx (eq? obj-name _))
|
||||
'(caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr cddar
|
||||
'(force ! !! !list !!list
|
||||
caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr cddar
|
||||
cdddr caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
|
||||
cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr
|
||||
first second third fourth fifth sixth seventh eighth take
|
||||
|
|
|
@ -14,7 +14,7 @@
|
|||
lazy-cddadr lazy-cdddar lazy-cddddr lazy-second lazy-third lazy-fourth
|
||||
lazy-fifth lazy-sixth lazy-seventh lazy-eighth
|
||||
lazy-if1 lazy-if2 lazy-take-0 lazy-take lazy-take-impl
|
||||
lazy-unknown1 lazy-unknown2 lazy-inf-list1 lazy-cond1 lazy-cond2
|
||||
lazy-unknown1 lazy-unknown2 lazy-inf-list1 lazy-cond1 lazy-cond2 lazy-cond3
|
||||
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
|
||||
|
|
|
@ -1453,7 +1453,7 @@
|
|||
|
||||
(t 'lazy1 m:lazy
|
||||
(! (+ 3 4))
|
||||
:: {(force (+ 3 4))} -> {(+ 3 4)} -> {7})
|
||||
:: {(+ 3 4)} -> {7})
|
||||
|
||||
(t 'lazy2 m:lazy
|
||||
(+ (+ 3 4) 5)
|
||||
|
@ -1994,6 +1994,11 @@
|
|||
-> ,def {,clause12} -> ,def {20})
|
||||
)
|
||||
|
||||
; lazy-cond3
|
||||
(t 'lazy-cond3 m:lazy
|
||||
(! (cond [false 1] [else 2]))
|
||||
:: {(cond [false 1] [else 2])} -> {(cond [else 2])} -> {2})
|
||||
|
||||
|
||||
(t 'lazy-eq? m:lazy
|
||||
(eq? 'a 'a)
|
||||
|
|
Loading…
Reference in New Issue
Block a user