;step collector state machine (not yet implemented):
;     
; datatype held-type = NO-HELD-STEP | SKIPPED-STEP | HELD(args)
;
; states: global state of held
; global: held : held-type
; edge-names: first, skipped-first, second, skipped-second, double, late-let 
;
;transitions (& actions):
;
; held = NO-HELD-STEP : 
;  first(x) : held := HELD(x)
;  skipped-first : held := SKIPPED-STEP
;  second(x) : trigger(NO-HELD-STEP, x), held := NO-HELD-STEP ; this happens when evaluating unannotated code
;  skipped-second : held := NO-HELD-STEP ; I believe this can also arise in unannotated code
;  double(x) : double-trigger(x), held := NO-HELD-STEP
;  late-let(x) : late-let-trigger(x), held := NO-HELD-STEP
;
; held = SOME(SKIPPED-STEP) :
;  first(x) : ERROR
;  skipped-first : ERROR
;  second(x) : held := NO-HELD-STEP ; this happens e.g. for evaluation of top-level var bound to a procedure
;  skipped-second : held := NO-HELD-STEP
;  double(x) : ERROR
;  late-let(x) : ERROR
;
; held = SOME(HELD(args))
;  first(x) : ERROR
;  skipped-first : ERROR
;  second(x) : trigger(HELD(args),x), held = NO-HELD-STEP
;  skipped-second : held = NO-HELD-STEP
;  double(x) : ERROR
;  late-let(x) : ERROR


(module model mzscheme
  (require (lib "contract.ss")
           (lib "etc.ss")
           (lib "list.ss")
           "my-macros.ss"
           (prefix a: "annotate.ss")
           (prefix r: "reconstruct.ss")
           "shared.ss"
           "marks.ss"
           "testing-shared.ss"
           "model-settings.ss")
 

  (define program-expander-contract
    (-> (-> void?) ; init
        (-> (union eof-object? syntax? (cons/p string? any?)) (-> void?) void?) ; iter
        void?))
    

  (provide/contract [go (-> program-expander-contract       ; program-expander
                            (-> step-result? void?)         ; receive-result
                            (union render-settings? false?) ; render-settings
                            boolean?                        ; track-inferred-names?
                            void?)])
  
  ; go starts a stepper instance
  ; see provide stmt for contract 
  (define (go program-expander receive-result render-settings track-inferred-names?)
    
    (local
        
        ((define finished-exprs null)
         
         (define held-expr-list no-sexp)
         (define held-step-was-app? #f)
         
         (define basic-eval (current-eval))
         
         ; redivide takes a list of sexps and divides them into the 'before', 'during', and 'after' lists,
         ; where the before and after sets are maximal-length lists where none of the s-expressions contain
         ; a highlight-placeholder
         ; (->* ((listof syntax)) (list/p syntax syntax syntax))
         (define (redivide exprs)
           (letrec ([contains-highlight
                     (lambda (expr)
                       (or (syntax-property expr 'stepper-highlight)
                           (syntax-case expr ()
                             [(a . rest) (or (contains-highlight #`a) (contains-highlight #`rest))]
                             [else #f])))])
             (let* ([list-length (length exprs)]
                    [split-point-a (- list-length (length (or (memf contains-highlight exprs) null)))]
                    [split-point-b (length (or (memf contains-highlight (reverse exprs)) null))])
               (if (<= split-point-b split-point-a)
                   (error 'redivide-exprs "s-expressions did not contain the highlight-placeholder: ~v" (map syntax-object->hilite-datum exprs))
                   (values (sublist 0 split-point-a exprs) ; before
                           (sublist split-point-a split-point-b exprs) ; during
                           (sublist split-point-b list-length exprs)))))) ; after

         
;         (redivide `(3 4 (+ (define ,highlight-placeholder) 13) 5 6))
;         (values `(3 4) `((+ (define ,highlight-placeholder) 13)) `(5 6))
;         
;         (redivide `(,highlight-placeholder 5 6))
;         (values `() `(,highlight-placeholder) `(5 6))
;         
;         (redivide `(4 5 ,highlight-placeholder ,highlight-placeholder))
;         (values `(4 5) `(,highlight-placeholder ,highlight-placeholder) `())
;         
;         (printf "will be errors:~n")
;         (equal? (redivide `(1 2 3 4))
;                 error-value)
;         
;         (redivide `(1 2 ,highlight-placeholder 3 ,highlight-placeholder 4 5))
;         (values `(1 2) `(,highlight-placeholder 3 ,highlight-placeholder) `(4 5))
         
         
         (define break 
           (opt-lambda (mark-set break-kind [returned-value-list null])
             
             (let* ([mark-list (and mark-set (extract-mark-list mark-set))])

               (define (double-redivide finished-exprs new-exprs-before new-exprs-after)
                 (let*-values ([(before current after) (redivide new-exprs-before)]
                               [(before-2 current-2 after-2) (redivide new-exprs-after)])
                   (unless (equal? (map syntax-object->hilite-datum before) 
                                   (map syntax-object->hilite-datum before-2))
                     (error 'double-redivide "reconstructed before defs are not equal."))
                   (unless (equal? (map syntax-object->hilite-datum after) 
                                   (map syntax-object->hilite-datum after-2))
                     (error 'double-redivide "reconstructed after defs are not equal."))
                   (values (append finished-exprs before) current current-2 after)))
               
               (define (reconstruct-helper)
                 (r:reconstruct-current mark-list break-kind returned-value-list render-settings))
               
               (if (r:skip-step? break-kind mark-list render-settings)
                   (when (eq? break-kind 'normal-break)
                     (set! held-expr-list skipped-step))
                   (case break-kind
                     [(normal-break)
                      (begin
                        (set! held-expr-list (reconstruct-helper))
                        (set! held-step-was-app? (r:step-was-app? mark-list)))]
                     
                     [(result-exp-break result-value-break)
                      (if (eq? held-expr-list skipped-step)
                          (set! held-expr-list no-sexp)
                          (let* ([reconstructed (reconstruct-helper)]
                                 [result
                                  (if (not (eq? held-expr-list no-sexp))
                                      (let*-values 
                                          ([(step-kind) (if (and held-step-was-app?
                                                                 (eq? break-kind 'result-exp-break))
                                                            'user-application
                                                            'normal)]
                                           [(new-finished current-pre current-post after) 
                                            (double-redivide finished-exprs held-expr-list reconstructed)])
                                        (make-before-after-result new-finished current-pre current-post after step-kind))
                                      
                                      (let*-values
                                          ([(before current after) (redivide reconstructed)])
                                        (make-before-after-result (append finished-exprs before) (list 
                                                                                                  (syntax-property #`(... ...)
                                                                                                                   'stepper-highlight
                                                                                                                   #t))
                                                                  current after 'normal)))])
                            (set! held-expr-list no-sexp)
                            (receive-result result)))]
                     [(double-break)
                      ; a double-break occurs at the beginning of a let's evaluation.
                      (let* ([reconstruct-quadruple (reconstruct-helper)])
                        (when (not (eq? held-expr-list no-sexp))
                          (error 'break-reconstruction
                                 "held-expr-list not empty when a double-break occurred"))
                        (let*-values 
                            ([(new-finished current-pre current-post after) 
                              (double-redivide finished-exprs 
                                               (list-ref reconstruct-quadruple 0) 
                                               (list-ref reconstruct-quadruple 1))])
                          (receive-result (make-before-after-result new-finished
                                                                    current-pre
                                                                    current-post
                                                                    after
                                                                    'normal))))]
                     [(late-let-break)
                      (let ([new-finished (r:reconstruct-current mark-list break-kind returned-value-list render-settings)])
                        (set! finished-exprs (append finished-exprs new-finished)))]
                     
                     [(expr-finished-break)
                      (let ([reconstructed (r:reconstruct-completed mark-list returned-value-list render-settings)])
                        (set! finished-exprs (append finished-exprs (list reconstructed))))]
                     
                     [(define-struct-break)
                      (set! finished-exprs (append finished-exprs
                                                   (list (car returned-value-list))))]
                     
                     [else (error 'break "unknown label on break")])))))
         
         (define (step-through-expression expanded expand-next-expression)
           (let* ([annotated (a:annotate expanded break track-inferred-names?)])
             (eval-syntax annotated)
             (expand-next-expression)))
         
         (define (err-display-handler message exn)
           (if (not (eq? held-expr-list no-sexp))
                 (let*-values ([(before current after) (redivide held-expr-list)])
                   (set! held-expr-list no-sexp)
                   (receive-result (make-before-error-result (append finished-exprs before) 
                                                             current message after)))
               (receive-result (make-error-result finished-exprs message)))))
      
      (program-expander
       (lambda () 
         ; swap these to allow errors to escape (e.g., when debugging)
         (error-display-handler err-display-handler)
         ;(void)
         )
       (lambda (expanded continue-thunk) ; iter
         (if (eof-object? expanded)
             (begin
               (receive-result (make-finished-result finished-exprs))
               (receive-result (make-finished-stepping)))
             (step-through-expression expanded continue-thunk)))))))

