suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fixing mztake for dijkstra demo

Browse Source 
svn: r408
This commit is contained in:
Jay McCarthy 2005-07-20 20:07:06 +00:00
parent 25467f48cb
commit e1a277f2fa
8 changed files with 20 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/mztake/demos/dijkstra/dijkstra-mztake-uncommented.ss → collects/mztake/demos/dijkstra/dijkstra-mztake.ss
View File

@ -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))

15
collects/mztake/demos/first-class/first-class-mztake-uncommented.ss
View File

@ -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)

28
collects/mztake/demos/first-class/first-class-mztake.ss
View File

@ -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)

6
collects/mztake/demos/first-class/first-class.ss
View File

@ -1,6 +0,0 @@
(module first-class mzscheme
(map (lambda (x)
(let* ([x (* 2 (+ 1 x))]
[x (sub1 x)])
x))
'(2 4 6 7)))

0
collects/mztake/demos/montecarlo/montecarlo-mztake-uncommented.ss → collects/mztake/demos/montecarlo/montecarlo-mztake.ss
View File

0
collects/mztake/demos/sine/sine-mztake-uncommented.ss → collects/mztake/demos/sine/sine-mztake.ss
View File

2
collects/mztake/mztake-structs.ss
View File

@ -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))
;###########################################################################################################

30
collects/mztake/mztake.ss
View File

@ -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)