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)
|
[(#%plain-app proc-extract p)
|
||||||
(eq? (syntax->datum #'proc-extract) 'procedure-extract-target)
|
(eq? (syntax->datum #'proc-extract) 'procedure-extract-target)
|
||||||
(unwind #'p settings)]
|
(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
|
; general lazy application
|
||||||
[(#%plain-app
|
[(#%plain-app
|
||||||
(#%plain-lambda args1 (#%plain-app (#%plain-app proc p) . args2))
|
(#%plain-lambda args1 (#%plain-app (#%plain-app proc p) . args2))
|
||||||
|
@ -257,10 +265,7 @@
|
||||||
(with-syntax
|
(with-syntax
|
||||||
([clauses
|
([clauses
|
||||||
(let loop ([stx stx])
|
(let loop ([stx stx])
|
||||||
; STC: I'm disabling this check because the user-position on some
|
(if (and (eq? user-source
|
||||||
; 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
|
|
||||||
(syntax-property stx 'user-source))
|
(syntax-property stx 'user-source))
|
||||||
(eq? user-position
|
(eq? user-position
|
||||||
(syntax-property stx 'user-position)))
|
(syntax-property stx 'user-position)))
|
||||||
|
|
|
@ -899,13 +899,10 @@
|
||||||
; dont show ellipses for force (and other lazy fns)
|
; dont show ellipses for force (and other lazy fns)
|
||||||
; object-name is good enough here, so dont need to add another "special val"
|
; object-name is good enough here, so dont need to add another "special val"
|
||||||
(let ([obj-name (object-name (car arg-vals))])
|
(let ([obj-name (object-name (car arg-vals))])
|
||||||
(cond [(ormap
|
(cond [(ormap
|
||||||
(lx (eq? obj-name _))
|
|
||||||
'(force ! !! !list !!list))
|
|
||||||
so-far]
|
|
||||||
[(ormap
|
|
||||||
(lx (eq? obj-name _))
|
(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
|
cdddr caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
|
||||||
cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr
|
cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr
|
||||||
first second third fourth fifth sixth seventh eighth take
|
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-cddadr lazy-cdddar lazy-cddddr lazy-second lazy-third lazy-fourth
|
||||||
lazy-fifth lazy-sixth lazy-seventh lazy-eighth
|
lazy-fifth lazy-sixth lazy-seventh lazy-eighth
|
||||||
lazy-if1 lazy-if2 lazy-take-0 lazy-take lazy-take-impl
|
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-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-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-assoc lazy-assq lazy-assv lazy-cons? lazy-remove lazy-remq lazy-remv
|
||||||
|
|
|
@ -1453,7 +1453,7 @@
|
||||||
|
|
||||||
(t 'lazy1 m:lazy
|
(t 'lazy1 m:lazy
|
||||||
(! (+ 3 4))
|
(! (+ 3 4))
|
||||||
:: {(force (+ 3 4))} -> {(+ 3 4)} -> {7})
|
:: {(+ 3 4)} -> {7})
|
||||||
|
|
||||||
(t 'lazy2 m:lazy
|
(t 'lazy2 m:lazy
|
||||||
(+ (+ 3 4) 5)
|
(+ (+ 3 4) 5)
|
||||||
|
@ -1994,6 +1994,11 @@
|
||||||
-> ,def {,clause12} -> ,def {20})
|
-> ,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
|
(t 'lazy-eq? m:lazy
|
||||||
(eq? 'a 'a)
|
(eq? 'a 'a)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user