diff --git a/collects/mztake/demos/misc/exception-test.ss b/collects/mztake/demos/misc/exception-test.ss new file mode 100644 index 0000000000..467c2512c7 --- /dev/null +++ b/collects/mztake/demos/misc/exception-test.ss @@ -0,0 +1,13 @@ +(require (lib "mztake.ss" "mztake")) + +; tests catching of anonymously threaded exceptions + +exceptions + +(debug-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... + +(process:exceptions p) +(start/resume p) \ No newline at end of file diff --git a/collects/mztake/demos/misc/exception.ss b/collects/mztake/demos/misc/exception.ss new file mode 100644 index 0000000000..f6a314ef4d --- /dev/null +++ b/collects/mztake/demos/misc/exception.ss @@ -0,0 +1,6 @@ +(module exception mzscheme + (thread (lambda () (raise 'first-raise))) + ;(require (lib "match.ss")) + ;(match ) + ;(printf "dd~a" (random 100)) + ) \ No newline at end of file diff --git a/collects/mztake/demos/misc/higher-order-test.ss b/collects/mztake/demos/misc/higher-order-test.ss new file mode 100644 index 0000000000..a71fb52b6c --- /dev/null +++ b/collects/mztake/demos/misc/higher-order-test.ss @@ -0,0 +1,16 @@ +;tests higher order annotation and redefinition of bindings + +(debug-process p ("higher-order.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-e (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 10 x-before-let)) +(printf-b "x in let, should be (6 10 14 16): ~a" (history-b 10 x-in-let)) +(printf-b "x after let, should be (5 9 13 15): ~a" (history-b 10 x-after-let)) + +(start/resume p) \ No newline at end of file diff --git a/collects/mztake/demos/misc/higher-order.ss b/collects/mztake/demos/misc/higher-order.ss new file mode 100644 index 0000000000..f0007a0a57 --- /dev/null +++ b/collects/mztake/demos/misc/higher-order.ss @@ -0,0 +1,6 @@ +(module higher-order 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-test.ss b/collects/mztake/demos/montecarlo/montecarlo-test.ss new file mode 100644 index 0000000000..c07595d58f --- /dev/null +++ b/collects/mztake/demos/montecarlo/montecarlo-test.ss @@ -0,0 +1,25 @@ +(require (lib "graphics.ss" "graphics")) + +(open-graphics) +(define window (open-viewport "Debugger" 400 400)) + +(debug-process p ("montecarlo.ss" [x/y/pi-trace 12 18 bind '(x y pi)])) + +(define x/y/pi (hold x/y/pi-trace)) + +(define x (+ 200 (first x/y/pi))) +(define y (+ 200 (second x/y/pi))) +(define current-pi (third x/y/pi)) + +(printf-b "total: ~a" (count-b x)) +(printf-b "current pi: ~a" current-pi) +; more negative the better ...down to -14 +(printf-b "log error: ~a" (log (abs (- current-pi 3.1415926)))) + +((changes (list x y)) + . ==> . + (lambda (x/y) + ((draw-solid-ellipse window) (make-posn (first x/y) (second x/y)) + 3 3 "blue"))) + +(start/resume p) diff --git a/collects/mztake/demos/montecarlo/montecarlo.ss b/collects/mztake/demos/montecarlo/montecarlo.ss new file mode 100644 index 0000000000..656caf63cf --- /dev/null +++ b/collects/mztake/demos/montecarlo/montecarlo.ss @@ -0,0 +1,13 @@ +(module montecarlo mzscheme + (random-seed 846259386) ; specially chosen because it isn't terribly erratic + + (define (run) + (let loop ([hits 1] + [total 1]) + (let* ([x (- (random 400) 200)] + [y (- (random 400) 200)] + [length (sqrt (+ (* x x) (* y y)))] + [pi (* 4. (/ hits total))]) + (cond [(length . <= . 200) (loop (add1 hits) (add1 total))] + [else (loop hits (add1 total))])))) + (run)) \ No newline at end of file diff --git a/collects/mztake/demos/random/random-Xs-test.ss b/collects/mztake/demos/random/random-Xs-test.ss new file mode 100644 index 0000000000..2300441532 --- /dev/null +++ b/collects/mztake/demos/random/random-Xs-test.ss @@ -0,0 +1,39 @@ +(require (lib "graphics.ss" "graphics") + (lifted mzscheme + make-hash-table + hash-table-put! + hash-table-get)) +#| + "Lifted" is explained in FrTime's own documentation (plt/collects/frtime/doc.txt) + Quickly put, lifting extends the functions listed above so they can take FrTime time-varying + values (such as MzTake traces) as arguments. +|# + + +(open-graphics) +(define window (open-viewport "Debugger" 600 500)) + +(debug-process p ("random-Xs.ss" [x-trace 4 6 bind 'x])) + +(define x (hold x-trace)) + +(define valcount (make-hash-table)) + +((changes x) . ==> . (lambda (x) + (hash-table-put! valcount x (add1 (hash-table-get valcount x (lambda () 0)))) + ((draw-solid-ellipse window) (make-posn (* x 3) + (- 500 (* 3 (hash-table-get valcount x (lambda () 1))))) + 4 4 "blue"))) + +(define runtime (process:runtime/milliseconds p)) +(printf-b "~a millisecs per event" (truncate (runtime . / . (add1 (count-e (changes x)))))) + +(printf-b "x: ~a" x) +(printf-b "count: ~a" (count-e (changes x))) + +(let ([cnt (count-e (changes x))]) + (when (= 13000 cnt) + ; pause on next breakpoint + (pause p))) + +(start/resume p) \ No newline at end of file diff --git a/collects/mztake/demos/random/random-Xs.ss b/collects/mztake/demos/random/random-Xs.ss new file mode 100644 index 0000000000..36c8b2c3fb --- /dev/null +++ b/collects/mztake/demos/random/random-Xs.ss @@ -0,0 +1,5 @@ +(module |random-Xs| mzscheme + (define (run) + (let loop ([x (random 200)]) + (loop (random 200)))) + (run)) \ No newline at end of file diff --git a/collects/mztake/demos/sine/sine-test.ss b/collects/mztake/demos/sine/sine-test.ss new file mode 100644 index 0000000000..1c291386d9 --- /dev/null +++ b/collects/mztake/demos/sine/sine-test.ss @@ -0,0 +1,61 @@ +#| * The program being debugged (in the file "sine.ss") is a module that runs an infinite loop, + binding "x" to a moment in time [-200,200], and "sin-x" to the sin(x) ... over and over. + This MzTake script plots the value of x over time, in sync with the execution of "sine.ss". +|# + +(require (lib "animation.ss" "frtime")) ;; needed for display-shapes + + +(debug-process p ("sine.ss" [sin/x-trace 5 8 bind '(sin-x x)])) +#| * Create a process to debug for sine.ss + + * Add a tracepoint at line 5, column 8; in the program, + this is right after the let values are bound, ->(if (x ...) + + * At this tracepoint, define "sin/x-trace" to a FrTime eventstream that + recieves events containing a list of two elements: + * The (lexically-scoped) current values of the variables `sin-x' and `x' are + sent as a list every time the code at line 5, column 8, is reached. +|# + +(printf-b "runtime elapsed: ~a" (process:runtime/seconds p)) +;; Prints how long the program has been running, in seconds + + +(printf-b "sine.ss exited? ~a" (process:exited? p)) +;; Prints out a behavior that tells you whether the debug-process is still running... + + +(define sin/x (hold sin/x-trace)) +;; "sin/x" now is a FrTime behavior that holds the current value of the list (sin-x x) + + +(define sin-x (+ 200 (first sin/x))) +(define x (+ 200 (second sin/x))) +;; "x" and "sin-x" are the current values of (x + 200) and (sin(x) + 200) + + +(printf-b "x: ~a" x) +(printf-b "sin(x): ~a" sin-x) +;; Print the current values of x and sin-x + + +(display-shapes + (list* (make-line (make-posn 0 200) (make-posn 400 200) "gray") + (make-line (make-posn 200 0) (make-posn 200 400) "gray") + ;; draw horizontal and vertical gray lines + + (history-b 50 (changes (make-circle + (make-posn x sin-x) + 5 ; diameter + (if (< 200 sin-x) + (if (< 200 x) "blue" "darkblue") ; Quadrants 3 and 4 + (if (< 200 x) "red" "darkred"))))))) ; 1 and 2 +#| * Make a circle at position (x, sin-x) with diameter 5 pixels, and a color based on the coords. + * Everytime this value (the circle) changes (when the values of x and sin-x change) + * Keep a history (as a FIFO list) of (up to) the last 50 circles that were created. + * Pass this list to the display-shapes function, which will redraw everytime this list changes. +|# + +(start/resume p) +;; Start the process for sine.ss \ No newline at end of file diff --git a/collects/mztake/demos/sine/sine.ss b/collects/mztake/demos/sine/sine.ss new file mode 100644 index 0000000000..6ce9ab58ff --- /dev/null +++ b/collects/mztake/demos/sine/sine.ss @@ -0,0 +1,8 @@ +(module sine mzscheme + (define (run) + (let loop ([x -200]) + (let ([sin-x (* 100 (sin (/ x 20.0)))]) + (if (x . <= . 200) + (loop (add1 x)) + (loop -200))))) + (run)) \ No newline at end of file