(require (prefix annotate: (lib "annotate.ss" "stepper" "private")))
(require (prefix kernel: (lib "kerncase.ss" "syntax")))
(require (lib "syncheck-debug.ss" "drscheme" "private"))
(require (lib "marks.ss" "stepper" "private"))
(require "tests-common.ss")

(load "/Users/clements/plt/tests/mzscheme/testing.ss")

(reset-namespaces) 

(SECTION 'stepper-annotater)


; check-mark : test the validity of a mark.  the symbols in 'binding-ids' must be included. the symbols
; in excluded-ids must not appear in the list.  If binding-ids is 'all, then no symbols other than those
; in the binding-ids may appear.
; 
; note: cheap hack: if a string is supplied rather than a symbol in binding-ids, it passes if the string
; is a prefix of (symbol->string) of one of the present symbols.
; (syntax-object (listof (union symbol string)) (union (listof symbol) 'all) -> void)

(define (binding-match? input actual)
  (if (string? input)
      (and (>= (string-length (symbol->string actual)) (string-length input))
           (string=? (substring (symbol->string actual) 0 (string-length input)) input))
      (eq? input actual)))

(define (check-mark mark-stx binding-ids excluded-ids) 
  (let* ([bindings (syntax-case mark-stx (lambda )
                     [(lambda ()
                        (mark-maker
                         source
                         label
                         . bindings))
                      (let loop ([binding-list (syntax->list (syntax bindings))])
                        (cond [(null? binding-list) null]
                              [(null? (cdr binding-list)) 
                               (error 'check-mark "odd number of elements in binding list: ~a" (syntax-object->datum (syntax bindings)))]
                              [else
                               (let* ([quoted-stx (stx-protector-stx (syntax-e (cadr binding-list)))])
                                 (when (not (module-identifier=?
                                             (car binding-list)
                                             quoted-stx))
                                   (error 'check-mark "binding pair does not match: ~a, ~a" (syntax-object->datum (car binding-list))
                                          (syntax-object->datum (cadr binding-list))))
                                 (when (not (identifier? (car binding-list)))
                                   (error 'check-mark "syntax object is not an identifier: ~a" (syntax-object->datum (car bindings-list))))
                                 (cons (syntax-e (car binding-list))
                                     (loop (cddr binding-list))))]))])])
    (let loop ([remaining bindings])
      (unless (null? remaining)
        (when (memq (car remaining) (cdr remaining))
          (error 'check-mark "binding ~a appears twice in binding-list: ~a" (car remaining) bindings))
        (loop (cdr remaining))))
    (for-each (lambda (desired)
                (unless (ormap (lambda (binding)
                                 (binding-match? desired binding))
                               bindings)
                  (error 'check-mark "binding ~a not contained in binding-list: ~a" desired bindings)))
              binding-ids)
    (if (eq? excluded-ids 'all)
        (for-each (lambda (binding)
                    (unless (ormap (lambda (binding-id)
                                     (binding-match? binding-id binding))
                                   binding-ids)
                      (error 'check-mark "binding ~a does not appear in desired list: ~a" binding binding-ids)))
                  bindings)
        (for-each (lambda (not-desired)
                    (when (memq not-desired bindings)
                      (error 'check-mark "excluded binding ~a contained in binding-list: ~a" not-desired bindings)))
                  excluded-ids))))

; test cases

(syntax-case (expand #'(let ([a 1] [b 2]) (begin a b))) (let-values begin)
  [(let-values bindings a b)
   (begin
     (err/rt-test (check-mark (let* ([a-var #'a]) (make-full-mark #'3 'a (list a-var a-var))) '() '()) exn:user?) ; binding appears twice
     (test (void) check-mark (make-full-mark #'3 'a (list #'a #'b)) '(a b) 'all)
     (err/rt-test (check-mark (make-full-mark #'3 'a (list #'a #'b)) '(a b c) 'all) exn:user?) ; c isn't there
     (err/rt-test (check-mark (make-full-mark #'3 'a (list #'a #'b)) '(a) 'all) exn:user?) ; bad 'all
     (test (void) check-mark (make-full-mark #'3 'a (list #'a #'b)) '(a) '(c))
     (err/rt-test (check-mark (make-full-mark #'3 'a (list #'a #'b)) '(a) '(b c)) exn:user?) ; b is there
     (test (void) check-mark (make-full-mark #'3 'a (list #'a #'b)) '(a) '())
     (test (void) check-mark (make-full-mark #'3 'a (list #'arg0-436 #'c)) '("arg0" c) '())
     (err/rt-test (check-mark (make-full-mark #'3 'a (list #'arg0-436 #'c)) '("djs") '()) exn:user?))])

; syntax-symbol=? : compares a list of symbols to a given symbol (or to each other if sym = #f)
; (union symbol #f) (listof syntax-object) -> boolean

(define (syntax-symbol=? sym lostx)
  (if sym
      (andmap (lambda (stx) (eq? sym (syntax-e stx))) lostx)
      (if (pair? lostx)
          (andmap (lambda (stx) (eq? (syntax-e stx) (syntax-e (car lostx)))) lostx)
          #t)))

(define (wrap-expand-unwrap stx language-level-spec)
  (let* ([wrapped (datum->syntax-object #f `(module test-module ,language-level-spec
                                              ,@stx))]
         [expanded (expand wrapped)])
    (with-syntax ([(module name lang (_ . exprs)) expanded])
      (syntax->list (syntax exprs)))))

(test '((if (#%app verify-boolean (#%datum . 3) 'if) (#%datum . 4) (#%datum . 5)))
      map syntax-object->datum (wrap-expand-unwrap (list #'(if 3 4 5)) '(lib "htdp-beginner.ss" "lang")))
         
(define (annotate-exprs-no-break stx-list)
  (annotate-exprs (map expand stx-list) void))

(define (namespace-annotate-expr stx namespace)
  ;(when (syntax? stx)
  ;  (error 'namespace-rewrite-expr "namespace-rewrite-expr accepts s-exps, not syntax-objects"))
  (parameterize ([current-namespace namespace])
    (let*-values ([(annotated new-env)
                   (annotate:annotate (expand stx) annotate:initial-env-package break 'foot-wrap)])
      annotated)))

; the following procedure is used to test just the top-level-rewrite part of the annotater:

(define (namespace-rewrite-expr stx namespace)
  ;(when (syntax? stx)
  ;  (error 'namespace-rewrite-expr "namespace-rewrite-expr accepts s-exps, not syntax-objects"))
  (parameterize ([current-namespace namespace])
    (annotate:top-level-rewrite (expand stx))))

; strip-outer-lambda takes off a lambda wrapped around a test expression. For testing purposes,
; we often want to establish lexical bindings, then strip them off to check the test expr

(define (strip-outer-lambda stx)
  (syntax-case stx (lambda begin with-continuation-mark)
    [(with-continuation-mark
      debug-key-1
      debug-mark-1
      (closure-storing-proc
       (lambda args
         content)
       debug-mark-2))
     (syntax content)]))


; test case:
(test #t 
      (lambda ()
        (syntax-case  (strip-outer-lambda (car (annotate-exprs-no-break (list #'(lambda (a b c) 3)))))
          (with-continuation-mark lambda quote-syntax #%datum)
          [(with-continuation-mark 
            key
            bogus-key
            (begin
              break-proc-1
              (#%datum . 3)))
           #t])))

(define (strip-return-value-wrap stx)
  (syntax-case stx (let*)
    [(let* ([result-var-0 expr])
       break-0
       result-var-1)
     (begin
       (test 'result syntax-e (syntax result-var-0))
       (test 'result syntax-e (syntax result-var-1))
       (syntax expr))]))

(test 'a syntax-e
      (strip-return-value-wrap 
       (syntax-case (car (annotate-exprs-no-break (list #'a))) (with-continuation-mark begin)
         [(with-continuation-mark
           key-0
           mark-0
           (begin
             break-0
             expr))
          (syntax expr)])))
     
; test notes to myself:
; the never-undefined property can only be tested in the non-foot-wrap modes
; hard to test 3D values like closure-capturing-proc
; hard to test whether the source pointer is right.

(define test-cases
  ; begin
  (list (list (list #'(lambda (a b c) (begin a b (begin a c))))
              (lambda (stx)
                (syntax-case (strip-outer-lambda stx) (with-continuation-mark begin)
                  [(with-continuation-mark
                    debug-key-1
                    debug-mark-1
                    (begin
                      pre-break-1
                      (begin
                        (with-continuation-mark
                         debug-key-2
                         debug-mark-2
                         a-var-0)
                        (with-continuation-mark
                         debug-key-3
                         debug-mark-3
                         b-var-0)
                        (with-continuation-mark
                         debug-key-4
                         debug-mark-4
                         begin-body-4))))
                   (begin
                     (test 'a syntax-e (syntax a-var-0))
                     (test 'b syntax-e (syntax b-var-0))
                     (test (void) check-mark (syntax debug-mark-1) '(a b c) 'all)
                     (test (void) check-mark (syntax debug-mark-2) '() 'all)
                     (test (void) check-mark (syntax debug-mark-3) '() 'all)
                     (test (void) check-mark (syntax debug-mark-4) '(a c) 'all))])))
         
        ; lambda : general test
        (list (list #'(lambda (a b) (lambda (b c) (+ b c) (+ a b 4))))
              (lambda (stx)
                (syntax-case (strip-outer-lambda stx) (with-continuation-mark begin lambda)
                  [(with-continuation-mark
                    debug-key
                    debug-mark-1
                    (begin
                      pre-break-1
                      (closure-capturing-proc
                       (lambda (b c) 
                         (with-continuation-mark
                          debug-key-2
                          debug-mark-lambda-body
                          (begin
                            pre-break-2
                            (begin
                              . begin-bodies))))
                       debug-mark-3)))
                    (begin (test (void) check-mark (syntax debug-mark-1) '(a) 'all)
                           (test (void) check-mark (syntax debug-mark-3) '(a) 'all))])))
        
        ; improper arg-list:
        (list (list #'(lambda (a b . c) (begin b c)))
              (lambda (stx)
                (syntax-case stx (with-continuation-mark begin lambda)
                  [(with-continuation-mark
                    key-0
                    mark-0
                    (closure-capturing-proc
                     (lambda (a b . c)
                       (with-continuation-mark
                        key-1
                        mark-1
                        body))
                     mark-2))
                   (begin (test (void) check-mark (syntax mark-0) '() 'all)
                          (test (void) check-mark (syntax mark-1) '(b c) 'all)
                          (test (void) check-mark (syntax mark-2) '() 'all))])))
                    
        ; test of lambda's one-label inferred-names :
        (list (list #'(define (a x) (+ x 1)))
              (lambda (stx)
                (kernel:kernel-syntax-case stx #f
                   [(define-values (a)
                      (with-continuation-mark
                       debug-key
                       debug-mark
                       (closure-capturing-proc
                        lambda-exp
                        closure-info)))
                    (test 'a syntax-property (syntax lambda-exp) 'inferred-name)])))
        
        ; test of lambda's cons-pair inferred-names (that is, with lifting):
        (list (list #'(let ([a (lambda (x) (+ x 1))]) 3))
              (lambda (stx)
                (syntax-case stx (let*-values with-continuation-mark begin set!-values set!)
                   [(let*-values _c
                       (with-continuation-mark debug-key_1 debug_mark_1
                                               ;(begin
                                               ;  (break-proc_1)
                                                 (begin
                                                   (set!-values a-label
                                                                (with-continuation-mark
                                                                 debug-key
                                                                 debug-mark
                                                                 (closure-capturing-proc
                                                                  lambda-exp
                                                                  closure-info
                                                                  lifter-val)))
                                                   (set! counter 1)
                                                   body)
                                               ;  )
                                               ))
                    (test 'a syntax-property (syntax lambda-exp) 'inferred-name)])))
        
        ; case-lambda
        (list (list #'(lambda (d e) (case-lambda ((b) b d) ((c) c e))))
              (lambda (stx)
                (syntax-case (strip-outer-lambda stx) (with-continuation-mark lambda quote-syntax)
                  [(with-continuation-mark
                    debug-key
                    debug-mark-1
                    (begin
                      pre-break-1
                      (closure-storing-proc
                       (case-lambda ((b) . bodies_1)
                                    ((c) . bodies_2))
                       closure-info)))
                   (test (void) check-mark (syntax debug-mark-1) '(d e) '(b c))])))
        
        ; if
        (list (list #'(lambda (a b c d) (if (a b) (a c) (a d))))
              (lambda (stx)
                (syntax-case (strip-outer-lambda stx) (with-continuation-mark if let-values begin let)
                  [(let ([test-0 *unevaluated*-0])
                     (with-continuation-mark
                      debug-key_1
                      debug-mark-1
                      (begin
                        pre-break-1
                        (begin
                          (set! test-1 (let-values temp-bindings
                                         (with-continuation-mark
                                          debug-key_2
                                          debug-mark-test
                                          . test-clauses)))
                          (break-0)
                          (if test-2
                              (let-values temp-bindings_2
                                (with-continuation-mark
                                 debug-key_3
                                 debug-mark-then
                                 . then-clauses))
                              (let-values temp-bindings-3
                                (with-continuation-mark
                                 debug-key-4
                                 debug-mark-else
                                 . else-clauses)))))))
                   (begin
                     (test 'if-temp syntax-e (syntax test-0))
                     (test 'if-temp syntax-e (syntax test-1))
                     (test 'if-temp syntax-e (syntax test-2))
                     (test (void) check-mark (syntax debug-mark-1) '(a b c d if-temp) '())
                     (test (void) check-mark (syntax debug-mark-test) '() '(a b c d if-temp))
                     (test (void) check-mark (syntax debug-mark-then) '(a c) '(b d if-temp))
                     (test (void) check-mark (syntax debug-mark-else) '(a d) '(b c if-temp)))])))
        
        ; one-armed if
        (list (list #'(lambda (a b c) (if (begin a b) (begin a c))))
              (lambda (stx)
                (syntax-case (strip-outer-lambda stx) (with-continuation-mark if let-values begin)
                  [(let ([test-0 *unevaluated*-0])
                     (with-continuation-mark
                      debug-key-1
                      debug-mark-1
                      (begin
                        pre-break-1
                        (begin
                          (set! test-1 (with-continuation-mark
                                        debug-key_2
                                        debug-mark-test
                                        . test-clauses))
                          (break-0)
                          (if test-2
                              (with-continuation-mark
                               debug-key_3
                               debug-mark-then
                               . then-clauses))))))
                   (begin
                     (test 'if-temp syntax-e (syntax test-0))
                     (test 'if-temp syntax-e (syntax test-1))
                     (test 'if-temp syntax-e (syntax test-2))
                     (test (void) check-mark (syntax debug-mark-1) '(a b c if-temp) 'all)
                     (test (void) check-mark (syntax debug-mark-test) '() 'all)
                     (test (void) check-mark (syntax debug-mark-then) '(a c ) 'all))])))
        
        ; top-level begin
        (list (list #'(begin (define a 3) (begin (begin a))))
              (lambda (stx)
                (syntax-case stx (begin with-continuation-mark define-values)
                  [(begin
                     (define-values . rest)
                     (begin
                       (begin
                         (with-continuation-mark key-3 mark-3 (begin var-break-1 a-exp-3)))))
                   (test 'a syntax-e (strip-return-value-wrap (syntax a-exp-3)))])))
        
        ; begin0
        (list (list #'(lambda (a b) (begin0 a b)))
              (lambda (stx)
                (syntax-case (strip-outer-lambda stx) (begin begin0 with-continuation-mark)
                  [(with-continuation-mark
                    key-0
                    mark-0
                    (begin
                      pre-break-0
                      (begin0
                        (with-continuation-mark
                         key-result
                         mark-result
                         result-expr)
                        (with-continuation-mark
                         key-other
                         mark-other
                         other-expr))))
                   (begin
                     (test (void) check-mark (syntax mark-0) '(a b) 'all)
                     (test (void) check-mark (syntax mark-result) '() 'all)
                     (test (void) check-mark (syntax mark-other) '() 'all))])))
        
        ; begin0 : inferred-name transfer
        (list (list #'(define-values (a) (begin0 (lambda () 3) 4)))
              (lambda (stx)
                (syntax-case stx (begin0 define-values with-continuation-mark)
                  [(define-values names
                     (with-continuation-mark
                      key-0
                      mark-0
                      (begin0
                        (with-continuation-mark
                         key-1
                         mark-1
                         (procedure-capturing-proc
                          procedure
                          mark-2))
                        . rest)))
                   (test 'a syntax-property (syntax procedure) 'inferred-name)])))
        ; let 
        (list (list #'(lambda (a b c) (let* ([d b] [e (begin a d)]) (begin a b c d))))
              (lambda (stx)
                (syntax-case (strip-outer-lambda stx) (begin with-continuation-mark let*-values set!-values set!)
                  [(let*-values bindings
                     (with-continuation-mark
                      key-0
                      mark-0
                      (begin
                        pre-break-0
                        ;(begin
                        ;  break-1
                          (begin
                            (set!-values vars-0 (with-continuation-mark key-1 mark-1 body-1))
                            (set! let-counter-0 1)
                            (set!-values vars-1 (with-continuation-mark key-2 mark-2 body-2))
                            (set! let-counter-1 2)
                            ;(begin
                            ;  break-2
                              body-3
                            ;  )
                            )
                        ;  )
                        )))
                   (begin
                     (test (void) check-mark (syntax mark-0) '(a b c d e lifter-d-1 lifter-e-2 let-counter) 'all)
                     (test '(d) syntax-object->datum (syntax vars-0))
                     (test '(e) syntax-object->datum (syntax vars-1))
                     (test (void) check-mark (syntax mark-1) '() 'all)
                     (test (void) check-mark (syntax mark-2) '() 'all))])))
        
        ; letrec --- the only thing that needs to be tested with letrec is that the undefined value is properly used.
        
        ; set!
        (list (list #'(lambda (a b c) (set! a (begin b c))))
              (lambda (stx)
                (syntax-case (strip-outer-lambda stx) (begin with-continuation-mark set!)
                  [(with-continuation-mark
                    key-0
                    mark-0
                    (begin
                      pre-break-0
                      (set! var (with-continuation-mark key-1 mark-1 body))))
                   (begin
                     (test (void) check-mark (syntax mark-0) '(a b c) 'all)
                     (test 'a syntax-object->datum (syntax var))
                     (test (void) check-mark (syntax mark-1) '() 'all))])))
        
        ; set! with top-level-var
        (list (list #'(set! a 9))
              (lambda (stx)
                (syntax-case stx (set! with-continuation-mark)
                  [(with-continuation-mark
                    key-0
                    mark-0
                    (set! var val))
                   (begin
                     (test (void) check-mark (syntax mark-0) '(a) 'all)
                     (test 'a syntax-e (syntax var)))])))
        
        ; quote
        (list (list #'(quote a))
              (lambda (stx)
                (syntax-case stx (quote with-continuation-mark)
                  [(with-continuation-mark
                    key-0
                    mark-0
                    (quote sym))
                   (begin
                     (test (void) check-mark (syntax mark-0) '() 'all)
                     (test 'a syntax-e (syntax sym)))])))
                     
        ; quote-syntax
        (list (list #'(quote-syntax a))
              (lambda (stx)
                (syntax-case stx (quote-syntax with-continuation-mark)
                  [(with-continuation-mark
                    key-0
                    mark-0
                    (quote-syntax sym))
                   (begin
                     (test (void) check-mark (syntax mark-0) '() 'all)
                     (test 'a syntax-e (syntax sym)))])))
        
        ; wcm is explicitly not working (as opposed to _lots_ of other forms, which simply won't work in 
        ; a stepper sense.  Begin0, for example.  I think.  And set!.  etc., etc.
        
        ; application
        
        (list (list #'(lambda (a b c) (a b)))
              (lambda (stx)
                (syntax-case (strip-outer-lambda stx) (let-values with-continuation-mark begin set!)
                  [(let-values arg-temps
                     (with-continuation-mark
                      key-0
                      mark-0
                      (begin
                        pre-break-0
                        (begin
                          (set! var-0 (with-continuation-mark key-1 mark-1 sym-1))
                          (set! var-1 (with-continuation-mark key-2 mark-2 sym-2))
                          (begin 
                            break-0
                            (with-continuation-mark key-3 mark-3 (sym-3 sym-4)))))))
                   (begin
                     (test (void) check-mark (syntax mark-0) '(a b "arg0" "arg1") 'all)
                     (test "arg0" substring (symbol->string (syntax-e (syntax var-0))) 0 4)
                     (test (void) check-mark (syntax mark-1) '() 'all)
                     (test 'a syntax-e (syntax sym-1))
                     (test "arg1" substring (symbol->string (syntax-e (syntax var-1))) 0 4)
                     (test (void) check-mark (syntax mark-2) '() 'all)
                     (test 'b syntax-e (syntax sym-2))
                     (test (void) check-mark (syntax mark-3) '("arg0" "arg1") 'all)
                     (test "arg0" substring (symbol->string (syntax-e (syntax sym-3))) 0 4)
                     (test "arg1" substring (symbol->string (syntax-e (syntax sym-4))) 0 4))])))
        
        ; application with return-wrap
        (list (list #'(+ 3 4))
              (lambda (stx)
                (syntax-case stx (let-values with-continuation-mark begin set!)
                  [(let-values arg-temps
                     (with-continuation-mark
                      key-0
                      mark-0
                      (begin
                        (set! var-1 rhs-1)
                        (set! var-2 rhs-2)
                        (set! var-3 rhs-3)
                        (begin
                          break-0
                          (with-continuation-mark 
                           key-3
                           mark-3
                           result-expr)))))
                   (syntax-case (strip-return-value-wrap (syntax result-expr)) ()
                     [(var-4 var-5 var-6)
                      (begin
                        (test "arg0" substring (symbol->string (syntax-e (syntax var-4))) 0 4)
                        (test "arg1" substring (symbol->string (syntax-e (syntax var-5))) 0 4)
                        (test "arg2" substring (symbol->string (syntax-e (syntax var-6))) 0 4))])])))
        
         ; application with non-var in fun pos
        (list (list #'(4 3 4))
              (lambda (stx)
                (syntax-case stx (let-values with-continuation-mark begin set!)
                  [(let-values arg-temps
                     (with-continuation-mark
                      key-0
                      mark-0
                      (begin
                        (set! var-1 rhs-1)
                        (set! var-2 rhs-2)
                        (set! var-3 rhs-3)
                        (begin
                          break-0
                          (with-continuation-mark key-3 mark-3 (var-4 var-5 var-6))))))
                   (begin 
                     (test "arg0" substring (symbol->string (syntax-e (syntax var-4))) 0 4)
                     (test "arg1" substring (symbol->string (syntax-e (syntax var-5))) 0 4)
                     (test "arg2" substring (symbol->string (syntax-e (syntax var-6))) 0 4))])))
                    
        ; datum
        (list (list #'3)
              (lambda (stx)
                (syntax-case stx (with-continuation-mark #%datum)
                  [(with-continuation-mark
                    key-0
                    mark-0
                    (#%datum . 3))
                   #t])))
        
        ; define-values
        (list (list #'(define-values (a b) b))
              (lambda (stx)
                (syntax-case stx (with-continuation-mark define-values)
                  [(define-values (sym-0 sym-1)
                     (with-continuation-mark
                      key-0
                      mark-0
                      body))
                   (begin
                     (test 'a syntax-e (syntax sym-0))
                     (test 'b syntax-e (syntax sym-1))
                     (test (void) check-mark (syntax mark-0) '() 'all))])))
        
        ; top-level vars
        (list (list #'a)
              (lambda (stx)
                (syntax-case stx (begin with-continuation-mark)
                  [(with-continuation-mark
                    key-0
                    mark-0
                    (begin 
                      break-0
                      body))
                   (begin
                     (test (void) check-mark (syntax mark-0) '() 'all)
                     (test 'a syntax-e (strip-return-value-wrap (syntax body))))])))
        
        ; lexical vars
        (list (list #'(lambda (a b) a))
              (lambda (stx)
                (syntax-case (strip-outer-lambda stx) (begin with-continuation-mark)
                  [(with-continuation-mark
                    key-0
                    mark-0
                    (begin
                      pre-break-0
                      sym-0))
                   (begin
                     (test (void) check-mark (syntax mark-0) '(a) 'all)
                     (test 'a syntax-e (syntax sym-0)))])))
        
        ; correct labelling of variables:
        (list (list #'(lambda (b) (let ([a 13]) (begin a b))))
              (lambda (stx)
                (syntax-case (strip-outer-lambda stx) (begin with-continuation-mark let*-values set!-values)
                  [(let*-values bindings
                     (with-continuation-mark
                      key-0
                      mark-0
                      (begin
                        pre-break-0
                        ;(begin
                        ;  break-0
                          (begin
                            (set!-values (a-var-0) rest0)
                            (set! counter-0 1)
                            ;(begin 
                            ;  break-1
                              (with-continuation-mark
                               key-1
                               mark-1
                               (begin
                                 (with-continuation-mark key-2 mark-2 (begin break-2 a-var-1))
                                 (with-continuation-mark key-3 mark-3 (begin pre-break-1 b-var-0))))
                            ;  )
                            )
                        ;  )
                        )))
                   (begin
                     (test 'a syntax-e (syntax a-var-0))
                     (test 'a syntax-e (strip-return-value-wrap (syntax a-var-1)))
                     (test 'b syntax-e (syntax b-var-0))
                     (test 'let-bound syntax-property (syntax a-var-0) 'stepper-binding-type)
                     (test 'let-bound syntax-property (strip-return-value-wrap (syntax a-var-1)) 'stepper-binding-type)
                     (test 'lambda-bound syntax-property (syntax b-var-0) 'stepper-binding-type)
                     )])))
                        
        
        ))

(for-each (lambda (test-case)
            ((cadr test-case) (car (annotate-exprs-no-break (car test-case)))))
          test-cases)

;(namespace-annotate-expr '(or 3 4 5) beginner-namespace)
  
(syntax-case (namespace-rewrite-expr '(lambda (a) a) mz-namespace) (lambda)
  [(lambda (a-var-0) a-var-1)
   (begin
     (test 'lambda-bound syntax-property (syntax a-var-0) 'stepper-binding-type)
     (test 'lexical identifier-binding (syntax a-var-0)) 
     (test 'lambda-bound syntax-property (syntax a-var-1) 'stepper-binding-type)
     (test 'lexical identifier-binding (syntax a-var-1)))])

(syntax-case (namespace-rewrite-expr (datum->syntax-object #'here '(case-lambda ((a) a) ((a b) b))) mz-namespace) (case-lambda)
  [(case-lambda ((a-0) a-1) ((a-2 b-0) b-1))
   (begin
     (test 'lexical identifier-binding (syntax b-0))
     (test 'lexical identifier-binding (syntax b-1)))])

;(syntax-case (car (namespace-rewrite-expr "(or true false true)" beginner-namespace)) (let-values if)
;  [(let-values ([(or-part-0) true-0]) (if or-part-1 or-part-2 rest))
;   (begin
;     (test 'or-part syntax-e (syntax or-part-0))
;     (test 'let-bound syntax-property (syntax or-part-0) 'stepper-binding-type)
;     (test 'or-part syntax-e (syntax or-part-1))
;     (test 'let-bound syntax-property (syntax or-part-1) 'stepper-binding-type))])

(parameterize ([current-namespace beginner-namespace])
  (err/rt-test (eval (car (annotate-exprs-no-break (string->stx-list "(define first 3)")))) exn:user?))

;(test 7 eval (car (annotate-exprs-no-break (list #'(begin (+ 3 4) (+ 4 5))))))
;(test 9 eval (car (annotate-exprs-no-break (list #'(begin (+ 3 4) (+ 4 5))))))

(report-errs)