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

svn: r118

Browse Source
This commit is contained in:
Jono Spiro 2004-07-30 17:55:54 +00:00
parent 8223b03b3b
commit 25b2b3cb44
2 changed files with 9 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/mztake/debugger-model.ss
View File

@ -1,9 +1,3 @@
#|
(let* ([breakpoint-origin (debug-file-filename client)]
[breakpoints (hash-keys (debug-file-tracepoints client))]
[program-expander (program-expander breakpoint-origin)])
|#
(module debugger-model mzscheme
(require (lib "unit.ss")
(lib "mred.ss" "mred")
@ -26,10 +20,11 @@
process)
(export run)
(define (run-semaphore) (debug-process-run-semaphore process))
(define run-semaphore (debug-process-run-semaphore process))
(define debug-eventspace (debug-process-eventspace process))
(define (queue-result result)
(send-to-eventspace (debug-process-eventspace process)
(send-to-eventspace debug-eventspace
(lambda () (receive-result result))))
(define basic-eval (current-eval))
@ -38,7 +33,7 @@
(let ([mark-list (continuation-mark-set->list mark-set debug-key)])
(queue-result (make-normal-breakpoint-info (cons final-mark mark-list) client))
(queue-result (make-breakpoint-halt))
(semaphore-wait (run-semaphore))))
(semaphore-wait run-semaphore)))
(define ((err-display-handler source) message exn)
(queue-result (make-error-breakpoint-info (list source exn))))

25
collects/mztake/mztake.ss
View File

@ -280,6 +280,9 @@ Find a way to bind to the result of ananonymous expression: here->(add1 2)
; retreives the binding of a variable from a breakpoint 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))))
(let ([mark-list (normal-breakpoint-info-mark-list event)]
[current-frame-num 0])
(map (lambda (binding) (list (mark-binding-binding binding)
@ -287,9 +290,6 @@ Find a way to bind to the result of ananonymous expression: here->(add1 2)
(lookup-all-bindings (lambda (id) (eq? (syntax-e id) sym))
(do-n-times cdr current-frame-num mark-list)))))
; does something for (binding)
(define (do-n-times fn n arg)
(foldl (lambda (x arg) (fn arg)) arg (build-list n (lambda (x) x))))
; 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)
@ -309,22 +309,7 @@ Find a way to bind to the result of ananonymous expression: here->(add1 2)
vars)])
(list evnt-rcvr
(if (list? variable-to-bind) values
(first values))))]))
; TODO improve program expander
(define ((program-expander filename) init callback)
;; (init) ; TODO now that's a bit of a hack.
(parameterize ([port-count-lines-enabled #t])
(let ([port (open-input-file filename)])
(begin0
(let loop ([stx (read-syntax filename port)])
(unless (eof-object? stx)
#;(print-debug (format "expanding: ~a" (syntax-object->datum (expand stx))))
(callback
(expand stx)
(lambda () (loop (read-syntax filename port))))))
(close-input-port port)))))
(first values))))]))
; returns a memoized function that takes (line column) -> position
; line-col->pos : (debug-file? . -> . (number? number? . -> . (union void? number?)))
@ -506,7 +491,7 @@ Find a way to bind to the result of ananonymous expression: here->(add1 2)
;TODO dont forget to contract this
(define (runtime/seconds process)
(frp:hold ((frp:changes (runtime/milliseconds process))
(frp:hold ((frp:changes (debug-process-runtime process))
. frp:==> .
(lambda (t) (truncate (/ t 1000))))
0))