moved marks.ss to mztake and removed all references to stepper.

changed mztake-process to define-mztake-process
changed 'break to 'entry
improved error messages

traces get processed in the order they are defined in the script file now.

svn: r148

collects/mztake/debugger-annotate.ss

@@ -1,7 +1,7 @@
 (module debugger-annotate mzscheme
   
   (require (prefix kernel: (lib "kerncase.ss" "syntax"))
-           (lib "marks.ss" "stepper" "private"))
+           (lib "marks.ss" "mztake" "private"))
   
 ;;  (define count 0)
   

collects/mztake/debugger-model.ss

@@ -1,11 +1,11 @@
 (module debugger-model mzscheme
   (require (lib "unit.ss")
            (lib "mred.ss" "mred")
-           (lib "marks.ss" "stepper" "private")
+           (lib "marks.ss" "mztake" "private")
            "debugger-annotate.ss"
            "mztake-structs.ss"
-           "private/load-annotator.ss"
+           (lib "load-annotator.ss" "mztake" "private")
-           "private/more-useful-code.ss")
+           (lib "more-useful-code.ss" "mztake" "private"))
   
   (provide debugger-model@)
   

collects/mztake/demos/dijkstra/dijkstra-test.ss

@@ -2,7 +2,7 @@
 (require "dijkstra-solver.ss"
          (lib "match.ss"))
 
-(mztake-process p 
+(define-mztake-process p 
                 ("dijkstra.ss")
                 ("heap.ss"
                    [inserts 49 6 bind 'item]

collects/mztake/demos/highway/highway-test.ss

@@ -3,7 +3,7 @@
 (require (lib "animation.ss" "frtime")) ;; needed for display-shapes
 
 
-(mztake-process radar-program ("highway.ss" [values-of-speed 3 4 bind 'speed]))
+(define-mztake-process radar-program ("highway.ss" [values-of-speed 3 4 bind 'speed]))
 #| * Create a process to debug highway.ss
 
    * Add a tracepoint at line 3, column 4; in the program,

collects/mztake/demos/misc/exception-test.ss

@@ -6,7 +6,7 @@
    run the program and catch the exception it throws.
 |#
 
-(mztake-process p ("exception.ss"))
+(define-mztake-process p ("exception.ss"))
 
 (printf-b "exception.ss exited? ~a" (process:exited? p))
 ;; Prints out a behavior that tells you whether the debug-process is still running...

collects/mztake/demos/misc/first-class-test.ss

@@ -9,7 +9,7 @@
    and idea of why they recieve different values from the same "x".
 |#
 
-(mztake-process p ("first-class.ss" [x-before-let 3 29 bind 'x]
+(define-mztake-process p ("first-class.ss" [x-before-let 3 29 bind 'x]
                                     [x-in-let     4 25 bind 'x]
                                     [x-after-let  5 11 bind 'x]))
 

collects/mztake/demos/montecarlo/montecarlo-test.ss

@@ -20,7 +20,7 @@
    See the doc for more information on this kind of drawing.
 |#
 
-(mztake-process p ("montecarlo.ss" [x/y/pi-trace 13 18 bind '(x y pi)]))
+(define-mztake-process p ("montecarlo.ss" [x/y/pi-trace 13 18 bind '(x y pi)]))
 #| * Create a process to debug montecarlo.ss
 
    * Add a tracepoint at line 13, column 18; in the program,

collects/mztake/demos/random/random-Xs-test.ss

@@ -29,7 +29,7 @@
    See the doc for more information on this kind of drawing.
 |#
 
-(mztake-process p ("random-Xs.ss" [x-trace 4 6 bind 'x]))
+(define-mztake-process p ("random-Xs.ss" [x-trace 4 6 bind 'x]))
 #| * Create a process to debug random-xs.ss
 
    * Add a tracepoint at line 4, column 6; in the program,

collects/mztake/demos/sine/sine-test.ss

@@ -7,7 +7,7 @@
 (require (lib "animation.ss" "frtime")) ;; needed for display-shapes
 
 
-(mztake-process p ("sine.ss" [sin/x-trace 5 8 bind '(sin-x x)]))
+(define-mztake-process p ("sine.ss" [sin/x-trace 5 8 bind '(sin-x x)]))
 #| * Create a process to debug sine.ss
 
    * Add a tracepoint at line 5, column 8; in the program,

collects/mztake/doc.txt

@@ -23,7 +23,7 @@ using callbacks). Consider a MzTake script to monitor the
 behavior of the program "highway.ss", in the demos directory
 of the MzTake collection:
 
-   (debug-mztake-process
+   (define-mztake-process
      radar-program
      ("highway.ss" [values-of-speed 3 4 bind 'speed]))
    (printf-b "current speed: ~a" (hold values-of-speed))
@@ -112,6 +112,11 @@ MzTake is a DrScheme tool distributed as a self-installing
 
   http://planet.plt-scheme.org/
 
+You need to have the latest version of FrTime installed
+for MzTake to work correctly (it may function, though
+unpredictably, in older versions). Please use FrTime from
+DrScheme v208 and up, or the latest CVS revision.
+
 
 ============================================================
 
@@ -205,11 +210,11 @@ The model of the debugger is as follows:
     that you run it in DrScheme in the "module..." language), assuming there
     will be side-effects that start the debugging.
 
-    The rest of the files traced in a mztake-process are typically
+    The rest of the files traced in a MZTAKE-PROCESS are typically
     modules used *by* the main-module, allowing you to see
     what is going on deeper than the main module. For example:
 
-      (mztake-process p1
+      (define-mztake-process p1
             ("my-stack-tests.ss")
             ((lib "my-stack.ss" "my-stack") [s-push-p1 3  29 bind 'insert-value]
                                             [s-pop-p1  10 16 bind 'return-value]))
@@ -221,7 +226,7 @@ The model of the debugger is as follows:
   * The same file can be traced differently in different processes, even with
     different main clients using them:
 
-      (mztake-process p2
+      (define-mztake-process p2
             ("more-my-stack-tests.ss")
             ((lib "my-stack.ss" "my-stack") [s-clear-p2 22 8 ENTRY]))
 
@@ -257,7 +262,7 @@ ENTRYs are event streams that get a "#t" event every time the
 target program reaches the trace point. Binds are event streams that
 ping the value of one or more variables when the trace point is reached.
 
-> (mztake-process process-name
+> (define-mztake-process process-name
     [target-filename trace-clause ...] ...)
 
    Where trace-clause is one of the following:
@@ -278,15 +283,15 @@ ping the value of one or more variables when the trace point is reached.
    syntax for modules:
 
    * Absolute path:
-       (mztake-process p [(file "/home/me/test.ss") [brk 10 7 ENTRY]])
+       (define-mztake-process p [(file "/home/me/test.ss") [brk 10 7 ENTRY]])
 
    * Relative path:
-       (mztake-process p ["../test.ss" [brk 10 7 ENTRY]])
+       (define-mztake-process p ["../test.ss" [brk 10 7 ENTRY]])
 
    * Library path:
-       (mztake-process p [(lib "test.ss" "collect-dir") [brk 10 7 ENTRY]])
+       (define-mztake-process p [(lib "test.ss" "collect-dir") [brk 10 7 ENTRY]])
 
-   For each trace-clause in the call to mztake-process,
+   For each trace-clause in the call to DEFINE-MZTAKE-PROCESS,
    the trace-name is a variable name bound at the
    top-level, whose value is a FrTime event
    stream. Each time the execution of the target
@@ -337,7 +342,7 @@ and can be used in the Interactions window.
 
 > (start/resume process-name)
 
-   Start the execution and monitoring of the mztake-process,
+   Start the execution and monitoring of the MZTAKE-PROCESS,
    process-name. If the process given to START/RESUME is already
    running, and was paused with the function PAUSE (below),
    START/RESUME resumes its execution.
@@ -442,12 +447,12 @@ Known Problems
   you are putting bind-traces on:
 
   ORIGINAL FILE:
-  (define (my-fun some-struct) ...)
+    (define (my-fun some-struct) ...)
 
   MZTAKE SCRIPT:
-  (require "original-file.ss")
+    (require "original-file.ss")
-  (mztake-process p ("original-file.ss" [val 10 12 bind 'my-struct]))
+    (define-mztake-process p ("original-file.ss" [val 10 12 bind 'my-struct]))
-  (my-fun (hold val))
+    (my-fun (hold val))
 
   Sometimes this causes unusual errors. These problems usually only
   show up if you are binding to structs (defined in the same file) and
@@ -472,23 +477,10 @@ Known Problems
      (let ([x (add1 x)]) x)
      ^        ^^    ^    ^
 
-* Don't rely completely on MzTake to complain when you change
+* Don't rely entirely on MzTake to complain when you change
   target code and your line/col locations in the script are out
   of date. It can only raise an error if the locations are invalid.
 
-* Order matters -- if you have more than one kind of trace at
-  an identical syntax location, the order that trace events get
-  updated is currently undefined.
-
-  For now, the hack is to add traces as follows:
-
-       First trace:                   Second trace:
-       (code ... (more-code ...))     (code ... (more-code ...))
-       ^                                        ^
-  Because of how Scheme is evaluated, usually nothing happens on
-  the same line of between two "open" parentheses as they are
-  traversed from left to right; this gives you a definite trace order.
-
 * MzTake has not been tested for stability if the target is using
   multiple threads. This only applies to threaded modules
   *with* traces on them -- other REQUIRE'd modules will work
@@ -514,6 +506,29 @@ Known Problems
   there will probably be some sort of name-clash and strange error.
   This will be fixed.
 
+* If you find that sometimes it seems one of the breakpoints you
+  set in a file REQUIRE'd by the main client module, your problem
+  may be that the file-specification you used is different in the
+  script than it is in the main client module (occuring in REQUIREs
+  that use sub-directories):
+
+  MAIN CLIENT:
+    (require (lib "my-lib.ss" "mycollect" "private"))
+
+  MZTAKE SCRIPT:
+    (define-mztake-process p ("main.ss")
+                             ((lib "my-lib.ss" "mycollect/private") [traces...])
+
+  This seems to be an issue with DrScheme rather than MzTake.
+  For instance, you get an error if you make a module like this
+  on Windows:
+
+   (module m mzschem
+     (require (lib "my-lib.ss" "mycollect" "private"))
+     (provide (lib "my-lib.ss" "mycollect/private")))
+
+  This will be looked into, but keep your eyes open for it.
+
 
 ============================================================
 
@@ -529,16 +544,40 @@ Tips and Tricks
     * Then 'x updates and 'y is out-of-date.
     * Then 'y updates, and both are up-to-date.
 
-  But code that draws using a position derived from x and y
+  But code that draws using a position derived from X and Y
   will draw twice, in two locations, one for each update,
   the second one being correct.
 
+* Order matters -- if you have more than one trace at an identical
+  syntax location (in the same file), the order that trace events
+  get updated is identical to the order they exist in the script.
+  For example:
+
+  (define-mztake-process p ("file.ss" [a-bind  5 55 bind 'x]
+                                      [some-bind  2 22 bind 'irrelevent]
+                                      [a-entry 5 55 entry]
+                                      [another-bind 5 55 bind 'y]))
+
+  When that trace gets evaluated, A-BIND will get the new value
+  of X, and relevant FrTime code will get re-evaluated. *Then*
+  A-ENTRY will be notified about the trace and a #t will be emitted,
+  (at this point in time, Y is out-of-date, but X is up-to-date). Lastly,
+  ANOTHER-BIND will get the new value of Y, and the trace is complete.
+
+  Of course, you will typically want ENTRY as the first trace,
+  and all other BINDs to be in a list, so that you get two updates,
+  as explained in the previous tip:
+
+  (define-mztake-process p ("file.ss" [a-entry 5 55 entry]
+                                      [x/y-bind 5 55 bind '(x y)]
+                                      [some-bind  2 22 bind 'irrelevent]))
+
 * You can trace the *same* file in different ways by using
   multiple processes on the same file, under different
   contexts, and compare results. For example, in
   "demos/misc/first-class-test.ss":
 
-     (mztake-process p ("first-class.ss" [x-before-let 3 29 bind 'x]
+     (define-mztake-process p ("first-class.ss" [x-before-let 3 29 bind 'x]
                                          [x-in-let     4 25 bind 'x]
                                          [x-after-let  5 11 bind 'x]))
      (... code omitted ...)
@@ -546,9 +585,9 @@ Tips and Tricks
 
   is functionally equivalent to:
 
-     (mztake-process p1 ("first-class.ss" [x-before-let 3 29 bind 'x]))
+     (define-mztake-process p1 ("first-class.ss" [x-before-let 3 29 bind 'x]))
-     (mztake-process p2 ("first-class.ss" [x-in-let     4 25 bind 'x]))
+     (define-mztake-process p2 ("first-class.ss" [x-in-let     4 25 bind 'x]))
-     (mztake-process p3 ("first-class.ss" [x-after-let  5 11 bind 'x]))
+     (define-mztake-process p3 ("first-class.ss" [x-after-let  5 11 bind 'x]))
      (... code omitted ...)
      (start/resume p1) (start/resume p2) (start/resume p3)
 

collects/mztake/mztake-structs.ss

@@ -1,6 +1,6 @@
 (module mztake-structs mzscheme
   (require (prefix frp: (lib "frp.ss" "frtime"))
-           "private/more-useful-code.ss")
+           (lib "more-useful-code.ss" "mztake" "private"))
   
   (provide (all-defined))
   
@@ -19,7 +19,7 @@
   
   (define-struct trace-struct (evnt-rcvr))           ; frp:event-receiver
   
-  (define-struct (break-trace trace-struct) ())
+  (define-struct (entry-trace trace-struct) ())
   (define-struct (bind-trace trace-struct)
                  (variable-to-bind))          ; symbol
   
@@ -59,9 +59,9 @@
   (define (create-bind-trace sym-to-bind) ; ((union (listof symbol?) symbol?) . -> . trace?)
     (make-bind-trace (frp:event-receiver) sym-to-bind))
   
-  ; Creates a trace that simply pauses the program
+  ; Creates a trace that simply alerts that it was hit
-  (define (create-break-trace) ; (void? . -> . trace?)
+  (define (create-entry-trace) ; (void? . -> . trace?)
-    (make-break-trace (frp:event-receiver)))
+    (make-entry-trace (frp:event-receiver)))
   
   (define (create-empty-debug-process)
     (make-debug-process (make-custodian)

collects/mztake/mztake-syntax.ss

@@ -1,7 +1,7 @@
 #|
 (mztake-process p ("sine.ss" [sin/x 5 8 bind '(sin-x x)]
-                            [foo 10 20 bind '(sin-x x)])
+                             [foo 10 20 bind '(sin-x x)])
-                 ("sine-extra.ss"))
+                  ("sine-extra.ss"))
  
 (define sin/x (hold sin/x))
 (define x (+ 200 (second sin/x)))
@@ -19,11 +19,11 @@
 (module mztake-syntax (lib "frtime-big.ss" "frtime")
   
   (require (lib "mztake.ss" "mztake")
-           (lib "useful-code.ss" "mztake/private"))
+           (lib "useful-code.ss" "mztake" "private"))
   
-  (define-syntax mztake-process
+  (define-syntax define-mztake-process
-    (syntax-rules (mztake-process)
+    (syntax-rules (define-mztake-process)
-      [(mztake-process proc-id (client (trace line col cmd . args) ...) ...)
+      [(define-mztake-process proc-id (client (trace line col cmd . args) ...) ...)
        (begin
          (define proc-id (create-debug-process))
          (begin
@@ -33,7 +33,7 @@
                 (create-trace tmp line col 'cmd . args)
                 ...))) ...))]))
   
-  (provide mztake-process
+  (provide define-mztake-process
-           (all-from-except (lib "frtime-big.ss" "frtime") #%module-begin)
+           (all-from (lib "frtime-big.ss" "frtime"))
            (all-from (lib "mztake.ss" "mztake"))
-           (all-from (lib "useful-code.ss" "mztake/private"))))
+           (all-from (lib "useful-code.ss" "mztake" "private"))))

collects/mztake/mztake.ss

@@ -1,4 +1,12 @@
-#| TODO
+(module mztake mzscheme
+  
+  (define mztake-version "Rev. Wed Aug 5, 2004 - 23:12:00")
+  
+  #| TODO
+
+Remove marks.ss from MzTake as soon as the new version of it becomes standard with releases.
+Search for everywhere marks.ss shows up in mztake and replace
+(lib "marks.ss" "mztake" "private") with (lib "marks.ss" "stepper" "private")
 
 :::::::::LOAD/ANNOTATOR BUGS::::::::::::::
 * catch oops exception
@@ -38,7 +46,7 @@ SCRIPT--------------------------------------------------------------------------
 * Provide a body to bind instead or returning an eventstream, like (list x y)
   Write a nested syntax for bind so that you can take a first-class function that defines a way to return variables, not just as a list
 
-* Maybe take a thunk to do when a break-point is hit?
+* Maybe take a thunk to do when a entry trace is hit?
 
 * Way to turn printouts on and off like (print-struct #t), or should we have an output window? (mztake-verbose) (parameterize it?)
 
@@ -65,26 +73,25 @@ ERROR-CHECKING/HANDLING---------------------------------------------------------
 TESTING/CAPABILITIES------------------------------------------------------------------------
 * Does user interaction work?  Can we step through loops one line at a time waiting for input?  GUIs?
 
-* We want a way to interactively step through code one line at a time when we hit a breakpoint.
+* We want a way to interactively step through code one line at a time when we pause.
   Provide way to check bindings at the same time -- EVEN IF NOT BOUND USING TRACE/BIND
 
 * What kind of interface do we want to dig into frames
 
-* Need to know where the program breaks at -- need to know *when* it breaks too -- print something out
+* Need to know where the program pauses at
 
 * What do we do about binding to a variable and following it EVERYWHERE it goes.  Even if it is assigned to something else.
 
 * Find a way to bind to the result of ananonymous expression: here->(add1 2)
 |#
   
-(module mztake mzscheme
   (require (lib "match.ss")
            (lib "unit.ss")
            (lib "contract.ss")
-           (lib "marks.ss" "stepper" "private")
+           (lib "marks.ss" "mztake" "private") ; TODO local private copy until stepper release
            (prefix frp: (lib "frp.ss" "frtime"))
-           "private/useful-code.ss"
+           (lib "useful-code.ss" "mztake" "private")
-           "private/more-useful-code.ss" ; mostly for hash- bindings
+           (lib "more-useful-code.ss" "mztake" "private") ; mostly for hash- bindings
            "mztake-structs.ss"
            "debugger-model.ss")
   
@@ -105,7 +112,7 @@ TESTING/CAPABILITIES------------------------------------------------------------
                             process:exited?
                             (debug-process? . -> . frp:behavior?)])
   
-                    #| DISABLED - BROKEN
+  #| DISABLED - BROKEN
                     [process:running? (debug-process? . -> . frp:behavior?)]
                     [rename time-per-event/milliseconds
                             process:time-per-event/milliseconds
@@ -133,9 +140,6 @@ TESTING/CAPABILITIES------------------------------------------------------------
   ; turns debug output on and off
   (define debugging? #f)
   
-  ; 
-  (define mztake-version "Rev. Wed Aug 4, 2004 - 17:06:00")
-  
   ;###########################################################################################################
   
   
@@ -169,10 +173,10 @@ TESTING/CAPABILITIES------------------------------------------------------------
               [traces (hash-get (debug-client-tracepoints client) byte-offset)])
          
          (assert (not (empty? traces))
-                 (format "There are no traces at offset ~a, but a breakpoint is defined!~n"
+                 (format "There are no traces at offset ~a, but a trace point is defined!~n"
                          (number->string byte-offset)))
          
-         ; Run all traces at this breakpoint               
+         ; Run all traces at this trace point               
          (let ([to-send (map (lambda (t) (trace->frp-event client result t)) traces)])
            (frp:send-synchronous-events to-send))
          
@@ -217,7 +221,7 @@ TESTING/CAPABILITIES------------------------------------------------------------
   
   ; wrapper for errors related to the script only
   (define (script-error err)
-    (raise-syntax-error 'mztake:script-error: (format "~a" err))
+    (raise-syntax-error 'mztake:script-error (format "~a" err))
     (kill-all))
   
   
@@ -235,7 +239,7 @@ TESTING/CAPABILITIES------------------------------------------------------------
     (display (format "mztake: ~a~n---~n" str)))
   
   
-  ; retreives the binding of a variable from a breakpoint event
+  ; retreives the binding of a variable from a bind trace event
   (define (binding event sym)
     (define (do-n-times fn n arg)
       (foldl (lambda (x arg) (fn arg)) arg (build-list n (lambda (x) x))))
@@ -253,7 +257,10 @@ TESTING/CAPABILITIES------------------------------------------------------------
       [(client line col type args)
        (case type
          ['bind  (trace/bind client line col args)]
-         ['break (trace/break client line col)])]
+         ['entry (trace/entry client line col)]
+         [else (script-error (format "Invalid trace type: `~a' in client: `~a'"
+                                     (symbol->string type)
+                                     (debug-client-modpath client)))])]
       
       [(client line col type)
        (create-trace client line col type null)]))
@@ -262,18 +269,20 @@ TESTING/CAPABILITIES------------------------------------------------------------
   ; takes a single trace, looks up what it needs to do, and returns an frp-event to publish
   (define (trace->frp-event client event trace)
     (match trace
-      [($ break-trace evnt-rcvr)
+      [($ entry-trace evnt-rcvr)
        (list evnt-rcvr #t)]
       
       [($ bind-trace evnt-rcvr variable-to-bind)
        (let* ([vars (if (list? variable-to-bind) variable-to-bind
                         (list variable-to-bind))]
-              [values (map (lambda (var)
+              [values (map
-                             (let ([val (binding event var)])
+                       (lambda (var)
-                               (if (empty? val)
+                         (let ([val (binding event var)])
-                                   (script-error (format "trace/bind: No binding found in trace for symbol '~a" var))
+                           (if (empty? val)
-                                   (cadar (binding event var)))))
+                               (script-error
-                           vars)])
+                                (format "Variable not found at the syntax location for the BIND: `~a'" var))
+                               (cadar (binding event var)))))
+                       vars)])
          (list evnt-rcvr
                (if (list? variable-to-bind) values
                    (first values))))]))  
@@ -305,7 +314,7 @@ TESTING/CAPABILITIES------------------------------------------------------------
           (cond
             ; none is found
             [(empty? lst)
-             (raise (format "No syntax found for trace at line/column ~a:~a in ~a" line col filename))]
+             (raise (format "No syntax found for trace at line/column ~a:~a in client `~a'" line col filename))]
             
             ; if first is correct line and correct column
             [(and (= line (caar lst))
@@ -334,9 +343,6 @@ TESTING/CAPABILITIES------------------------------------------------------------
   ;  ;        ;       ;;;;     ;;;    ;;;;   ;;;;   ;;;;       ;         ;;;; ; ;      ;   ;;;   ;;;;  
   
   (define (start-debug-process receive-result process)    
-    (assert (not (null? (debug-process-main-client process)))
-            "main-client not defined for one of the processes!")
-    
     ; initialize the semaphore
     (set-debug-process-run-semaphore! process (make-semaphore))
     ; set initial state of exit predicate
@@ -459,13 +465,13 @@ TESTING/CAPABILITIES------------------------------------------------------------
   
   
   #;(define (running? process)
-    (script-error "client-running? is broken")
+      (script-error "client-running? is broken")
-    (and (running-now? process)
+      (and (running-now? process)
-         (not (debug-process-exited? process))))
+           (not (debug-process-exited? process))))
   
   #;(define (time-per-event/milliseconds process behavior)
-    (frp:lift (truncate (/ (frp:value-now (debug-process-runtime process))
+      (frp:lift (truncate (/ (frp:value-now (debug-process-runtime process))
-                 (add1 (frp:value-now (count-e (frp:changes behavior))))))))
+                             (add1 (frp:value-now (count-e (frp:changes behavior))))))))
   
   (define (runtime/milliseconds process)
     (debug-process-runtime process))
@@ -484,7 +490,7 @@ TESTING/CAPABILITIES------------------------------------------------------------
     (parameterize ([current-namespace (make-namespace)])
       (with-handlers ([exn:module?
                        (lambda (exn)
-                         (client-error (format "Expected a module in client: ~a" filename)))])
+                         (client-error (format "Expected a module in client file: ~a" filename)))])
         
         (let* ([build-module-filename ; taken from module-overview.ss
                 (lambda (str)
@@ -526,6 +532,10 @@ TESTING/CAPABILITIES------------------------------------------------------------
   ; (client (offset | line column) (symbol | listof symbols) -> (frp:event-receiver)
   ; (debug-client? number? number? (union symbol? (listof symbol?)) . -> . frp:event?)
   (define (trace/bind client line col binding-symbol)
+    (when (empty? binding-symbol)
+      (script-error (format "No symbols defined in BIND for client: `~a'"
+                            (debug-client-modpath client))))
+
     (with-handlers ([(lambda (exn) #t)
                      (lambda (exn) (raise-syntax-error 'mztake:script-error:trace/bind exn))])
       (let ([trace-hash (debug-client-tracepoints client)]
@@ -533,19 +543,19 @@ TESTING/CAPABILITIES------------------------------------------------------------
             [pos ((debug-client-line-col->pos client) line col)])
         ; add the trace to the list of traces for that byte-offset
         (hash-put! trace-hash pos
-                   (cons trace
+                   (append (hash-get trace-hash pos (lambda () '()))
-                         (hash-get trace-hash pos (lambda () '()))))
+                           (list trace)))
         (trace-struct-evnt-rcvr trace))))
   
   
   ;(debug-file? number? number? . -> . frp:event?)
-  (define (trace/break client line col)
+  (define (trace/entry client line col)
     (let ([trace-hash (debug-client-tracepoints client)]
-          [trace (create-break-trace)]
+          [trace (create-entry-trace)]
           [pos ((debug-client-line-col->pos client) line col)])
       (hash-put! trace-hash pos
-                 (cons trace
+                 (append (hash-get trace-hash pos (lambda () '()))
-                       (hash-get trace-hash pos (lambda () '()))))
+                         (list trace)))
       (trace-struct-evnt-rcvr trace)))
   
   

collects/mztake/private/marks.ss

@@ -0,0 +1,180 @@
+(module marks mzscheme
+
+  (require (lib "list.ss")
+	   (lib "contract.ss")
+           (lib "my-macros.ss" "stepper" "private")
+           (lib "shared.ss" "stepper" "private"))
+
+  (define-struct full-mark-struct (source label bindings values))
+
+  ; CONTRACTS
+  (define mark? (-> ; no args  
+                 full-mark-struct?))
+  (define mark-list? (listof procedure?))
+  
+  (provide/contract 
+   ;[make-debug-info (-> any? binding-set? varref-set? any? boolean? syntax?)] ; (location tail-bound free label lifting? -> mark-stx)
+   [expose-mark (-> mark? (list/p any? symbol? (listof (list/p identifier? any?))))]
+   [make-top-level-mark (syntax? . -> . syntax?)]
+   [lookup-all-bindings ((identifier? . -> . boolean?) mark-list? . -> . (listof any?))]
+   [lookup-first-binding ((identifier? . -> . boolean?) mark-list? ( -> any) . -> . any?)]
+   [lookup-binding (mark-list? identifier? . -> . any)])
+  
+  (provide
+   make-debug-info
+   wcm-wrap
+   skipto-mark?
+   skipto-mark
+   strip-skiptos
+   mark-list?
+   mark-source
+   mark-bindings
+   mark-label
+   mark-binding-value
+   mark-binding-binding
+   display-mark
+   all-bindings
+   #;lookup-binding-list
+   debug-key
+   extract-mark-list
+   (struct normal-breakpoint-info (mark-list kind))
+   (struct error-breakpoint-info (message))
+   (struct breakpoint-halt ())
+   (struct expression-finished (returned-value-list)))
+  
+  ; BREAKPOINT STRUCTURES
+  
+  (define-struct normal-breakpoint-info (mark-list kind))
+  (define-struct error-breakpoint-info (message))
+  (define-struct breakpoint-halt ())
+  (define-struct expression-finished (returned-value-list))
+  
+  (define-struct skipto-mark-struct ())
+  (define skipto-mark? skipto-mark-struct?)
+  (define skipto-mark (make-skipto-mark-struct))
+  (define (strip-skiptos mark-list)
+    (filter (lx (not (skipto-mark? _))) mark-list))
+  
+    
+  ; debug-key: this key will be used as a key for the continuation marks.
+  (define-struct debug-key-struct ())
+  (define debug-key (make-debug-key-struct))
+  
+  (define (extract-mark-list mark-set)
+    (strip-skiptos (continuation-mark-set->list mark-set debug-key)))
+   
+  
+  ; the 'varargs' creator is used to avoid an extra cons cell in every mark:
+  (define (make-make-full-mark-varargs source label bindings)
+    (lambda values 
+      (make-full-mark-struct source label bindings values)))
+  
+  ; see module top for type
+  (define (make-full-mark location label bindings)
+    (datum->syntax-object #'here `(lambda () (,(make-make-full-mark-varargs location label bindings)
+                                              ,@(map make-mark-binding-stx bindings)))))
+  
+  (define (mark-source mark)
+    (full-mark-struct-source (mark)))
+    
+  ; : identifier -> identifier
+  (define (make-mark-binding-stx id)
+    #`(lambda () #,(syntax-property id 'stepper-dont-check-for-function #t)))
+  
+  (define (mark-bindings mark)
+    (map list 
+         (full-mark-struct-bindings (mark)) 
+         (full-mark-struct-values (mark))))
+  
+  (define (mark-label mark)
+    (full-mark-struct-label (mark)))
+  
+  (define (mark-binding-value mark-binding)
+    ((cadr mark-binding)))
+  
+  (define (mark-binding-binding mark-binding)
+    (car mark-binding))
+
+  (define (expose-mark mark)
+    (let ([source (mark-source mark)]
+          [label (mark-label mark)]
+          [bindings (mark-bindings mark)])
+      (list source
+            label
+            (map (lambda (binding)
+                   (list (mark-binding-binding binding)
+                         (mark-binding-value binding)))
+                 bindings))))
+  
+  (define (display-mark mark)
+    (apply
+     string-append
+     (format "source: ~a~n" (syntax-object->datum (mark-source mark)))
+     (format "label: ~a~n" (mark-label mark))
+     (format "bindings:~n")
+     (map (lambda (binding)
+                 (format " ~a : ~a~n" (syntax-e (mark-binding-binding binding))
+                         (mark-binding-value binding)))
+               (mark-bindings mark))))
+  
+  
+  ; possible optimization: rig the mark-maker to guarantee statically that a
+  ; variable can occur at most once in a mark.  
+  
+  (define (binding-matches matcher mark)
+    (filter (lambda (binding-pair) (matcher (mark-binding-binding binding-pair))) (mark-bindings mark)))
+  
+  (define (lookup-all-bindings matcher mark-list)
+    (apply append (map (lambda (m) (binding-matches matcher m)) mark-list)))
+  
+  (define (lookup-first-binding matcher mark-list fail-thunk)
+    (let ([all-bindings (lookup-all-bindings matcher mark-list)])
+      (if (null? all-bindings)
+          (fail-thunk)
+          (car all-bindings))))
+  
+  (define (lookup-binding mark-list id)
+    (mark-binding-value
+     (lookup-first-binding (lambda (id2) (module-identifier=? id id2)) 
+                           mark-list 
+                           (lambda ()
+                             (error 'lookup-binding "variable not found in environment: ~a~n" (if (syntax? id) 
+                                                                                                  (syntax-object->datum id)
+                                                                                                  id))))))
+  
+  (define (all-bindings mark)
+    (map mark-binding-binding (mark-bindings mark)))
+  
+  (define (wcm-wrap debug-info expr)
+    #`(with-continuation-mark #,debug-key #,debug-info #,expr))
+
+  
+  ; DEBUG-INFO STRUCTURES
+  
+  ;;;;;;;;;;
+  ;;
+  ;; make-debug-info builds the thunk which will be the mark at runtime.  It contains 
+  ;; a source expression and a set of binding/value pairs.
+  ;; (syntax-object BINDING-SET VARREF-SET any boolean) -> debug-info)
+  ;;
+  ;;;;;;;;;;
+     
+  (define (make-debug-info source tail-bound free-vars label lifting?)
+       (let*-2vals ([kept-vars (binding-set-varref-set-intersect tail-bound free-vars)])
+         (if lifting?
+             (let*-2vals ([let-bindings (filter (lambda (var) 
+                                                  (case (syntax-property var 'stepper-binding-type)
+                                                    ((let-bound macro-bound) #t)
+                                                    ((lambda-bound stepper-temp non-lexical) #f)
+                                                    (else (error 'make-debug-info 
+                                                                 "varref ~a's binding-type info was not recognized: ~a"
+                                                                 (syntax-e var)
+                                                                 (syntax-property var 'stepper-binding-type)))))
+                                                kept-vars)]
+                          [lifter-syms (map get-lifted-var let-bindings)])
+               (make-full-mark source label (append kept-vars lifter-syms)))
+             (make-full-mark source label kept-vars))))
+  
+  
+  (define (make-top-level-mark source-expr)
+    (make-full-mark source-expr 'top-level null)))