- wrote debugger macro

svn: r125
This commit is contained in:
Jono Spiro 2004-08-03 18:24:16 +00:00
parent 1b25e0a121
commit fa9459d08d

View File

@ -1,8 +1,8 @@
#| #|
(debugger (debugger
(processes (p ["sine.ss" (sin/x 5 8 bind '(sin-x x))) (processes (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 sin/x (hold sin/x))
(define x (+ 200 (second sin/x))) (define x (+ 200 (second sin/x)))
@ -11,8 +11,9 @@
*** translates to *** *** translates to ***
(define p (create-debug-process)) (define p (create-debug-process))
(define <temp2> (create-debug-client p "sine.ss")) (define-values (sin/x foo ...)(
(define sin/x (trace/bind <temp2> 5 8 '(sin-x x))) (let ([tmp (create-debug-client p "sine.ss")])
(values (create-trace tmp 5 8 'bind '(sin-x x))))
... ...
(start/resume <temp1>) (start/resume <temp1>)
... ...
@ -20,27 +21,28 @@
(module mztake-syntax (lib "frtime-big.ss" "frtime") (module mztake-syntax (lib "frtime-big.ss" "frtime")
(require (lib "mztake.ss" "mztake")) (define-syntax debugger-module-begin
(require-for-syntax (lib "list.ss")) (syntax-rules (debugger)
[(_ (debugger . clauses))
(#%module-begin (debugger . clauses))]))
(define-syntax (debugger stx) (define-syntax debugger
(syntax-case stx (processes) (syntax-rules (processes)
[(debugger [(_ (processes (proc-id (client (trace line col cmd . args) ...))
(processes (clause ...)) ...)
expr ...) expr ...)
(foldl
(lambda (cls prev)
(syntax-case prev ()
[(begin transformed-expr ...)
(syntax-case cls ()
[(proc-id (client trace-clause ...) ...)
(with-syntax ([(client-name ...)
(generate-temporaries #'(client ...))])
(begin (begin
transformed-expr ...
(define proc-id (create-debug-process)) (define proc-id (create-debug-process))
(define-values (client-name trace ...) ...
(let ([tmp (create-debug-client proc-id)]) (define-values (trace ...)
) ... (let ([tmp (create-debug-client proc-id client)])
(values
(create-trace line col 'cmd . args)
...)))
...
expr
...)]))
) (provide debugger
(rename debugger-module-begin #%module-begin)
(all-from-except (lib "frtime-big.ss" "frtime") #%module-begin)))