diff --git a/collects/mztake/demos/dijkstra/dijkstra-mztake-uncommented.ss b/collects/mztake/demos/dijkstra/dijkstra-mztake.ss similarity index 94% rename from collects/mztake/demos/dijkstra/dijkstra-mztake-uncommented.ss rename to collects/mztake/demos/dijkstra/dijkstra-mztake.ss index 28772659d2..1fef18dfb9 100644 --- a/collects/mztake/demos/dijkstra/dijkstra-mztake-uncommented.ss +++ b/collects/mztake/demos/dijkstra/dijkstra-mztake.ss @@ -33,11 +33,12 @@ binary heap implementation without satisfying its (stronger) contract. |# (require (lib "mztake.ss" "mztake") + (lib "useful-code.ss" "mztake" "private") "dijkstra-solver.ss" (lib "match.ss")) -(define/bind (loc "heap.ss" 49 6) item) -(define/bind (loc "heap.ss" 67 10) result) +(define inserts (trace (loc "heap.ss" 49 6) (bind (item) item))) +(define removes (trace (loc "heap.ss" 67 10) (bind (result) result))) #| The following code merely observes the insertions and removals from the heap. We notice whether any of the removals are out @@ -59,7 +60,6 @@ (inserts . -=> . 'reset))) (define violations (not-in-order inserts-and-removes-e)) - (printf-b "all inserts and removes: ~a" (history-b inserts-and-removes-e)) (printf-b "all violations: ~a" (history-b violations)) (printf-b "latest-violation: ~a" (hold violations)) @@ -78,4 +78,6 @@ (define inserters (accum-b (inserts . ==> . insert-in-model) empty)) (define removers (accum-b (removes . ==> . remove-from-model) inserters)) +(set-main! "dijkstra.ss") + (set-running-e! (violations . -=> . false)) \ No newline at end of file diff --git a/collects/mztake/demos/first-class/first-class-mztake-uncommented.ss b/collects/mztake/demos/first-class/first-class-mztake-uncommented.ss deleted file mode 100644 index 2a6599ae0f..0000000000 --- a/collects/mztake/demos/first-class/first-class-mztake-uncommented.ss +++ /dev/null @@ -1,15 +0,0 @@ -(define x-before-let (trace (loc "first-class.ss" 3 29) (bind (x) x))) -(define x-in-let (trace (loc "first-class.ss" 4 25) (bind (x) x))) -(define x-after-let (trace (loc "first-class.ss" 5 11) (bind (x) x))) - - -(printf-b "Number of times x updates, should be 12: ~a" - (count-b (merge-e x-before-let - x-in-let - x-after-let))) - -(printf-b "x before let, should be (2 4 6 7): ~a" (history-b 4 x-before-let)) -(printf-b "x in let, should be (6 10 14 16): ~a" (history-b 4 x-in-let)) -(printf-b "x after let, should be (5 9 13 15): ~a" (history-b 4 x-after-let)) - -(set-running! true) \ No newline at end of file diff --git a/collects/mztake/demos/first-class/first-class-mztake.ss b/collects/mztake/demos/first-class/first-class-mztake.ss deleted file mode 100644 index f6245595a2..0000000000 --- a/collects/mztake/demos/first-class/first-class-mztake.ss +++ /dev/null @@ -1,28 +0,0 @@ -#| This program demonstrates how you can add traces to first class, anonymous functions, - such as those passed to map, and the traces will still respond from anywhere - the code is executed. - - This test also shows how you can bind to the same variable at different locations, - and recieve different values, watching how an algorithm unfolds. - - Be sure you look at first-class.ss to see where the bindings are taken from, to get - and idea of why they recieve different values from the same "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])) - -(printf-b "Number of times x updates, should be 12: ~a" - (count-b (merge-e x-before-let - x-in-let - x-after-let))) -#| merge-e takes multiple event streams and turns them into one event stream. - count-e then counts how many pings are recieved on all three streams, - in other words, how many times "x" updates in all the traces. |# - -(printf-b "x before let, should be (2 4 6 7): ~a" (history-b 4 x-before-let)) -(printf-b "x in let, should be (6 10 14 16): ~a" (history-b 4 x-in-let)) -(printf-b "x after let, should be (5 9 13 15): ~a" (history-b 4 x-after-let)) -#| Prints out a FIFO list containing the last 4 values seen by each trace. |# - -(start/resume p) \ No newline at end of file diff --git a/collects/mztake/demos/first-class/first-class.ss b/collects/mztake/demos/first-class/first-class.ss deleted file mode 100644 index 3146f48568..0000000000 --- a/collects/mztake/demos/first-class/first-class.ss +++ /dev/null @@ -1,6 +0,0 @@ -(module first-class mzscheme - (map (lambda (x) - (let* ([x (* 2 (+ 1 x))] - [x (sub1 x)]) - x)) - '(2 4 6 7))) \ No newline at end of file diff --git a/collects/mztake/demos/montecarlo/montecarlo-mztake-uncommented.ss b/collects/mztake/demos/montecarlo/montecarlo-mztake.ss similarity index 100% rename from collects/mztake/demos/montecarlo/montecarlo-mztake-uncommented.ss rename to collects/mztake/demos/montecarlo/montecarlo-mztake.ss diff --git a/collects/mztake/demos/sine/sine-mztake-uncommented.ss b/collects/mztake/demos/sine/sine-mztake.ss similarity index 100% rename from collects/mztake/demos/sine/sine-mztake-uncommented.ss rename to collects/mztake/demos/sine/sine-mztake.ss diff --git a/collects/mztake/mztake-structs.ss b/collects/mztake/mztake-structs.ss index 9ab412a550..f16a36e428 100644 --- a/collects/mztake/mztake-structs.ss +++ b/collects/mztake/mztake-structs.ss @@ -41,7 +41,7 @@ where ; a behavior signaling each position where we pause marks)) ; while paused, the marks at the point of the pause (else false) - (define-struct loc (modpath line col)) + (define-struct loc (reqspec line col)) ;########################################################################################################### diff --git a/collects/mztake/mztake.ss b/collects/mztake/mztake.ss index 2cb153c875..b61c927994 100644 --- a/collects/mztake/mztake.ss +++ b/collects/mztake/mztake.ss @@ -167,7 +167,7 @@ (define (find-client process modpath) (cond - [(memf (lambda (c) (equal? (debug-client-modpath c) (path->string modpath))) + [(memf (lambda (c) (equal? (debug-client-modpath c) modpath)) (debug-process-clients process)) => first] [else false])) @@ -186,7 +186,6 @@ [where-event ((frp:signal-thunk (debug-process-where process)) #t)]) (set-debug-process-marks! process marks) - (if (empty? traces) (frp:send-synchronous-event where-event w) @@ -221,7 +220,6 @@ false) (define (launch-sandbox process) - (require/sandbox+annotations (debug-process-custodian process) ;; error-display-handler : @@ -230,6 +228,7 @@ (frp:send-event (debug-process-exceptions process) exn) (orig-err-disp msg exn))) `(file ,(debug-client-modpath (debug-process-main-client process))) + ;; annotate-module? (lambda (filename module-name) (memf (lambda (c) (equal? (debug-client-modpath c) (path->string filename)));; TODO: harmonize path & string @@ -237,7 +236,7 @@ ;; annotator (lambda (stx) (let ([client (and (syntax-source stx) - (find-client process (syntax-source stx)))]) + (find-client process (path->string (syntax-source stx))))]) (if (not client) stx (let-values ([(annotated-stx pos-list) @@ -373,29 +372,28 @@ (set-debug-process-clients! process (append (list client) (debug-process-clients process))) - ; set the main module if it has not been set - ; this implies that the first client created is always the main module + ; set the main module if it has not been set + ; this implies that the first client created is always the main module (unless (debug-process-main-client process) (set-debug-process-main-client! process client)) client))) - (define (set-main! mod-path) - (let ([client (find-client (current-process) mod-path)]) - (if client - (set-debug-process-main-client! (current-process) client) - (create-debug-client (current-process) mod-path)))) + (define (set-main! reqspec) + (let* ([modpath (reqspec->modpath reqspec)] + [maybe-client (find-client (current-process) modpath)] + [client (or maybe-client (create-debug-client (current-process) modpath))]) + (set-debug-process-main-client! (current-process) client))) (define (hold-b b) (frp:hold (frp:filter-e (lambda (ev) (not (frp:undefined? ev))) (frp:changes b)))) - (define (expand-module-filename filename) + (define (reqspec->modpath filename) (define (build-module-filename str) ; taken from module-overview.ss (let ([try (lambda (ext) (let ([tst (string-append str ext)]) (and (file-exists? tst) tst)))]) - (or (try ".ss") (try ".scm") (try "") str))) - + (or (try ".ss") (try ".scm") (try "") str))) (let ([modpath (symbol->string ((current-module-name-resolver) filename #f #f))]) (build-module-filename (if (regexp-match #rx"^," modpath) @@ -403,7 +401,7 @@ modpath)))) (define (trace* loc thunk) - (let* ([modpath (expand-module-filename (loc-modpath loc))] + (let* ([modpath (reqspec->modpath (loc-reqspec loc))] [clients (filter (lambda (c) (equal? modpath (debug-client-modpath c))) (debug-process-clients (current-process)))] @@ -457,7 +455,7 @@ (let ([p (syntax-position stx)]) (string->symbol (format "~a::~a" s p))))))))) - (provide loc$ loc loc-modpath loc-line loc-col + (provide loc$ loc loc-reqspec loc-line loc-col trace trace* bind define/bind create-debug-process create-debug-client where set-main! mztake-version)