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

- add if tests for lazy stepper

Browse Source 
in stepper/private/reconstruct.rkt
- in recon-inner, in called app case, add "take" to lazy fn case and fix to
  handle more than unary fns
This commit is contained in:
Stephen Chang 2011-04-04 16:37:11 -04:00
parent 49fd1fb0e0
commit d04d3fadc3
5 changed files with 62 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/stepper/private/annotate.rkt
View File

@ -1176,7 +1176,7 @@
(define/contract annotate/top-level
(syntax? . -> . syntax?)
(lambda (exp)
(syntax-case exp (module #%plain-module-begin let-values dynamic-wind #%plain-lambda #%plain-app)
(syntax-case exp (module #%plain-module-begin let-values dynamic-wind #%plain-lambda #%plain-app define-values)
[(module name lang
(#%plain-module-begin . bodies))
#`(module name lang (#%plain-module-begin #,@(map annotate/module-top-level (syntax->list #`bodies))))]
@ -1189,10 +1189,10 @@
(#%plain-lambda () . rest2)
(#%plain-lambda () . rest3)))
exp]
; STC: for lazy
[(#%plain-app . terms) (annotate/module-top-level exp)]
; STC: for lazy, handle defines
[(define-values (ids ...) bodies) (annotate/module-top-level exp)]
; STC: for lazy
[(#%plain-app . terms) (annotate/module-top-level exp)]
[else
(error `annotate/top-level "unexpected top-level expression: ~a\n"
(syntax->datum exp))

3
collects/stepper/private/lazy-highlighting.rkt
View File

@ -7,7 +7,8 @@
(define
table
(make-immutable-hasheq
'((caar . 1)
'((take . 0)
(caar . 1)
(cadr . 0)
(cdar . 1)
(cddr . 0)

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

@ -850,12 +850,12 @@
(case (mark-label (car mark-list))
((not-yet-called)
(if (null? unevaluated)
#`(#%plain-app . #,rectified-evaluated)
#`(#%plain-app
#,@rectified-evaluated
#,so-far
#,@(map recon-source-current-marks (cdr (map car unevaluated))))))
((called)
#`(#%plain-app . #,rectified-evaluated)
#`(#%plain-app
#,@rectified-evaluated
#,so-far
#,@(map recon-source-current-marks (cdr (map car unevaluated))))))
((called) ; unevaluated = null
(stepper-syntax-property
(if (eq? so-far nothing-so-far)
(datum->syntax #'here `(,#'#%plain-app ...)) ; in unannotated code ... can this occur?
@ -870,6 +870,7 @@
cdadar cdaddr cddaar cddadr cdddar cddddr
second third fourth fifth sixth seventh eighth))
#`(#%plain-app #,(datum->syntax #'here obj-name) #,so-far)]
[(eq? obj-name 'take) #`(#%plain-app . #,rectified-evaluated)]
[else
(datum->syntax #'here `(,#'#%plain-app ... ,so-far ...))])))
'stepper-args-of-call

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

@ -12,7 +12,8 @@
lazy-caaadr lazy-caadar lazy-caaddr lazy-cadaar lazy-cadadr lazy-caddar
lazy-cadddr lazy-cdaaar lazy-cdaadr lazy-cdadar lazy-cdaddr lazy-cddaar
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))
(let ((outer-namespace (current-namespace)))
(parameterize ([display-only-errors #t]

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

@ -1709,7 +1709,55 @@
-> ,def (+ 3 {,subarg3}) -> ,def (+ 3 {7})
:: ,def {(+ 3 7)} -> ,def {10}))
; lazy-if1
; (define (f x) (if x (/ 1 0) (not x)))
; (f (< 1 0))
(let* ([make-body (λ (x) `(if ,x ,err (not ,x)))]
[body (make-body 'x)]
[def `(define (f x) ,body)]
[lam `(lambda (x) ,body)]
[arg '(< 1 0)]
[body-subst (make-body arg)])
(t 'lazy-if1 m:lazy
,def (f ,arg)
:: ,def ({f} ,arg) -> ,def ({,lam} ,arg)
:: ,def {(,lam ,arg)} -> ,def {,body-subst}
:: ,def (if {,arg} ,err (not {,arg})) -> ,def (if {false} ,err (not {false}))
:: ,def {(if false ,err (not false))} -> ,def {(not false)} -> ,def {true}))
; lazy-if2
; (define (f x) (if x (not x) (/ 1 0)))
; (f (> 1 0))
(let* ([make-body (λ (x) `(if ,x (not ,x) ,err))]
[body (make-body 'x)]
[def `(define (f x) ,body)]
[lam `(lambda (x) ,body)]
[arg '(> 1 0)]
[body-subst (make-body arg)])
(t 'lazy-if2 m:lazy
,def (f ,arg)
:: ,def ({f} ,arg) -> ,def ({,lam} ,arg)
:: ,def {(,lam ,arg)} -> ,def {,body-subst}
:: ,def (if {,arg} (not {,arg}) ,err) -> ,def (if {true} (not {true}) ,err)
:: ,def {(if true (not true) ,err)} -> ,def {(not true)} -> ,def {false}))
; lazy-take-0
(let ([e '(take 0 (list 1 2))])
(t 'lazy-take-0 m:lazy
,e :: {,e} -> {empty}))
; lazy-take
; FIXME: when unknown promises implemented
(t 'lazy-take m:lazy
(take (+ 0 2) (list (+ 1 2) (+ 3 4) (/ 1 0)))
:: (take {(+ 0 2)} (list (+ 1 2) (+ 3 4) (/ 1 0)))
-> (take {2} (list (+ 1 2) (+ 3 4) (/ 1 0)))
:: {(take 2 (list (+ 1 2) (+ 3 4) (/ 1 0)))}
-> {(cons (+ 1 2) promise)})
#;
(t1 'teachpack-callbacks
(test-teachpack-sequence