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

fix user-position stepper-property bug in lazy cond stepper unwinding

Browse Source 
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:
Stephen Chang 2011-04-06 22:27:28 -04:00
parent 3bf0f800a7
commit c8dd95b3cf
4 changed files with 19 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/stepper/private/macro-unwind.rkt
View File

@ -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)))

9
collects/stepper/private/reconstruct.rkt
View File

@ -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

2
collects/tests/stepper/automatic-tests.rkt
View File

@ -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

7
collects/tests/stepper/through-tests.rkt
View File

@ -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)