in lazy/lazy.rkt

- modify cond for stepper
- add support for multiple values in stepper
  - add inspector to multiple-values struct
  - hide split-values call in ~define-values

in tests/stepper/
- add tests for cond

in stepper/private/annotate.rkt
- in annotate/top-level, allow arbitrary top-level terms
  (no error in else case), otherwise exprs like let throws error

in stepper/private/
   reconstruct.rkt
   lazy-highlighting.rkt
- add support for eq? eqv? equal? lazy fns

collects/lazy/lazy.rkt

@@ -192,10 +192,14 @@
   ;; used (spceifically, students never use them).  So `values' is redefined to
   ;; produce a first-class tuple-holding struct, and `split-values' turns that
   ;; into multiple values.
-  (define-struct multiple-values (values))
+  ;; STC: add inspector for lazy stepper
+  (define-struct multiple-values (values) (make-inspector))
   (define (split-values x)
     (let ([x (! x)])
       (if (multiple-values? x) (apply values (multiple-values-values x)) x)))
+  (define-syntax (hidden-split-values stx)
+    (syntax-case stx ()
+      [(_ arg) (stepper-hide-operator (syntax/loc stx (split-values arg)))]))
   ;; Force and split resulting values.
   (define (!values x)
     (split-values (! x)))
@@ -211,7 +215,7 @@
 
   ;; Redefine multiple-value constructs so they split the results
   (defsubst (~define-values (v ...) body)
-    (define-values (v ...) (split-values body)))
+    (define-values (v ...) (hidden-split-values body)))
   (defsubst (~let-values ([(x ...) v] ...) body ...)
     (let-values ([(x ...) (split-values v)] ...) (~begin body ...)))
   (defsubst (~let*-values ([(x ...) v] ...) body ...)
@@ -382,16 +386,29 @@
   (define* (~set-box! box val) (~ (set-box! (! box) val)))
 
   ;; not much to do with these besides inserting strictness points and ~begin
+  ; for stepper: change else to #t test, add new error else branch
   (define-syntax (~cond stx)
     (syntax-case stx ()
-      [(_ [test body ...] ...)
+      [(_ clause ...) ; stepper needs the loc of the full clause
-       (with-syntax ([(test ...)
+       (with-syntax
-                      ;; avoid forcing an `else' keyword
+           ([(new-clause ...)
-                      (map (lambda (stx)
+             (map 
-                             (syntax-case stx (else)
+              (λ (c)
-                               [else stx] [x #'(hidden-! x)]))
+                (with-syntax ([(test body ...) c])
-                           (syntax->list #'(test ...)))])
+                  (with-syntax
-         #'(hidden-~ (cond [test (~begin body ...)] ...)))]))
+                      ([new-test
+                        (syntax-case #'test (else)
+                          [else ; for stepper
+                           (stepper-syntax-property #'#t 'stepper-else #t)]
+                          [x (syntax/loc #'x (hidden-! x))])])
+                    (syntax/loc c (new-test (~begin body ...))))))
+              (syntax->list #'(clause ...)))]
+            [new-else-body (syntax/loc stx (error 'cond "should not get here"))])
+         #`(hidden-~ 
+            #,(syntax/loc stx
+                (cond
+                  new-clause ...
+                  [else new-else-body]))))]))
   (defsubst (~case v [keys body ...] ...)
     (hidden-~ (case (hidden-! v) [keys (~begin body ...)] ...)))
 

collects/stepper/private/annotate.rkt

@@ -1191,9 +1191,8 @@
          exp]
         ; STC: for lazy, handle defines
         [(define-values (ids ...) bodies) (annotate/module-top-level exp)]
-        ; STC: for lazy
+        [else (annotate/module-top-level exp)]
-        [(#%plain-app . terms) (annotate/module-top-level exp)]
+        #;[else
-        [else
          (error `annotate/top-level "unexpected top-level expression: ~a\n"
                 (syntax->datum exp))
          #;(annotate/module-top-level exp)])))

collects/stepper/private/lazy-highlighting.rkt

@@ -44,4 +44,7 @@
      (sixth  . 0)
      (seventh . 0)
      (eighth  . 0)
+     (eq?    . 0)
+     (eqv?   . 0)
+     (equal? . 0)
     )))

collects/stepper/private/reconstruct.rkt

@@ -902,10 +902,11 @@
                                                           (cond [(eq? obj-name 'force) so-far]
                                                                 [(ormap 
                                                                   (lx (eq? obj-name _)) 
-                                                                  '(caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr cddar cdddr 
+                                                                  '(caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr cddar 
-                                                                    caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr cdaaar cdaadr 
+                                                                    cdddr caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr 
-                                                                    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 
+                                                                    eq? eqv? equal?))
                                                                  #`(#%plain-app . #,rectified-evaluated)]
                                                                 [else
                                                                  (datum->syntax #'here `(,#'#%plain-app ... ,so-far ...))])))

collects/tests/stepper/automatic-tests.rkt

@@ -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-unknown1 lazy-unknown2 lazy-inf-list1 lazy-cond1 lazy-cond2))
 
 (let ((outer-namespace (current-namespace)))
   (parameterize ([display-only-errors #t]

collects/tests/stepper/through-tests.rkt

@@ -1922,6 +1922,78 @@
         -> ,add1-def ,nats-def-expanded {5}
         ))
    
+   ; lazy-cond1, lazy-cond2
+;   (define (f x)
+;     (cond ((> 0 x) (/ 1 0))
+;           ((< 0 x) (* x 10))
+;           (else (+ x 10))))
+;   (f 0)
+;   (f 1)
+   (let* ([make-test1 (λ (x) `(> 0 ,x))]
+          [make-test2 (λ (x) `(< 0 ,x))]
+          [test1 (make-test1 0)]
+          [test2 (make-test2 0)]
+          [test12 (make-test1 2)]
+          [test22 (make-test2 2)]
+          [make-clause1 (λ (x) `(* ,x 10))]
+          [make-clause2 (λ (x) `(+ ,x 10))]
+          [clause1 (make-clause1 0)]
+          [clause2 (make-clause2 0)]
+          [clause12 (make-clause1 2)]
+          [clause22 (make-clause2 2)]
+          [cnd (λ (x) `(cond (,(make-test1 x) ,err)
+                             (,(make-test2 x) ,(make-clause1 x))
+                             (else ,(make-clause2 x))))]
+          [make-def (λ (x) `(define (f x) ,(cnd x)))]
+          [def (make-def 'x)]
+          [lam (λ (x) `(lambda (x) ,(cnd x)))])
+     (t 'lazy-cond1 m:lazy
+        ,def (f 0)
+        :: ,def ({f} 0) -> ,def ({,(lam 'x)} 0)
+        :: ,def {(,(lam 'x ) 0)} -> ,def {,(cnd 0)}
+        :: ,def (cond ({,test1} ,err)
+                      (,test2 ,clause1)
+                      (else ,clause2))
+        -> ,def (cond ({false} ,err)
+                      (,test2 ,clause1)
+                      (else ,clause2))
+        :: ,def {(cond (false ,err)
+                       (,test2 ,clause1)
+                       (else ,clause2))}
+        -> ,def {(cond (,test2 ,clause1)
+                       (else ,clause2))}
+        :: ,def (cond ({,test2} ,clause1)
+                      (else ,clause2))
+        -> ,def (cond ({false} ,clause1)
+                      (else ,clause2))
+        :: ,def {(cond (false ,clause1)
+                       (else ,clause2))}
+        -> ,def {(cond (else ,clause2))} 
+        -> ,def {,clause2} -> ,def {10})
+     (t 'lazy-cond2 m:lazy
+        ,def (f 2)
+        :: ,def ({f} 2) -> ,def ({,(lam 'x)} 2)
+        :: ,def {(,(lam 'x ) 2)} -> ,def {,(cnd 2)}
+        :: ,def (cond ({,test12} ,err)
+                      (,test22 ,clause12)
+                      (else ,clause22))
+        -> ,def (cond ({false} ,err)
+                      (,test22 ,clause12)
+                      (else ,clause22))
+        :: ,def {(cond (false ,err)
+                       (,test22 ,clause12)
+                       (else ,clause22))}
+        -> ,def {(cond (,test22 ,clause12)
+                       (else ,clause22))}
+        :: ,def (cond ({,test22} ,clause12)
+                      (else ,clause22))
+        -> ,def (cond ({true} ,clause12)
+                      (else ,clause22))
+        :: ,def {(cond (true ,clause12)
+                       (else ,clause22))}
+        -> ,def {,clause12} -> ,def {20})
+     )
+   
   #;
   (t1 'teachpack-callbacks
      (test-teachpack-sequence