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

implemented current-reqspec

Browse Source 
svn: r2011
This commit is contained in:
Greg Cooper 2006-01-27 23:54:38 +00:00
parent f73ccaaf95
commit a5a017bd9f
4 changed files with 27 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/mztake/demos/dijkstra/dijkstra-mztake.ss
View File

@ -39,9 +39,10 @@
(define inserts (trace (loc "heap.ss" 49 6) item))
;(define removes (trace (loc "heap.ss" 67 10) result))
(define removes (trace (loc/r "heap.ss" 66 22)))
(define removes (trace (loc/r 66 22)))
#| The following code merely observes the insertions and removals
#| The following code
merely observes the insertions and removals
from the heap. We notice whether any of the removals are out
of order based on the last item removed, as long as there are
no insertions between the two events. We can keep track of the

2
collects/mztake/engine.ss
View File

@ -278,6 +278,7 @@
annotated-stx))))))
(define (process:new->running process)
(printf "mztake: starting ~a~n" (debug-client-modpath (debug-process-main-client process)))
(set-debug-process-run-semaphore! process (make-semaphore))
(set-debug-process-policy! process (current-policy))
@ -289,6 +290,7 @@
(process:->dead process))
(define (process:->dead process)
(printf "mztake: finished ~a~n" (debug-client-modpath (debug-process-main-client process)))
(set! all-debug-processes (remq process all-debug-processes))
(custodian-shutdown-all (debug-process-custodian process))
(frp:set-cell! (debug-process-exited? process) true))

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

@ -1,10 +1,16 @@
(module mztake-structs mzscheme
(require (lib "more-useful-code.ss" "mztake"))
(require (lib "match.ss")
(lib "more-useful-code.ss" "mztake"))
(provide (all-defined))
(define (require-spec? sexp)
(or string? list?))
(define require-spec?
(match-lambda
[(? string?) true]
[('file (? string?)) true]
[('lib (? string?) (? string?) ...) true]
[('planet . arg) true]
[else false]))
; ;;;;; ; ;
; ; ; ; ;

17
collects/mztake/mztake.ss
View File

@ -1,5 +1,6 @@
(module mztake mzscheme
(require (lib "contract.ss")
(lib "match.ss")
(prefix frp: (lib "lang-ext.ss" "frtime"))
(rename (lib "frtime.ss" "frtime") frp:list list)
(rename (lib "frtime.ss" "frtime") frp:value-nowable? value-nowable?)
@ -29,20 +30,26 @@
[set-running-e! ((frp:event?) (debug-process?) . opt-> . any)]
[set-running! ((frp:value-nowable?) (debug-process?) . opt-> . any)]
[where (() (debug-process?) . opt-> . frp:event?)]
[current-policy (case-> (-> any)
(any/c . -> . void?))]
[current-process (case-> (-> debug-process?)
(debug-process? . -> . void?))]
[current-reqspec (case-> (-> string?)
(string? . -> . void?))]
[create-debug-process (-> debug-process?)]
[set-main! ((require-spec?) (debug-process?) . opt-> . void?)]
[trace* (debug-process? loc? (-> any) . -> . frp:event?)]
[bind* (debug-process? symbol? . -> . any)])
(define (loc* after?)
(opt-lambda (reqspec line/pattern [col #f])
(if (number? line/pattern)
(make-loc/lc reqspec after? line/pattern col)
(make-loc/p reqspec after? line/pattern))))
(define (set-r r) (current-reqspec r))
(match-lambda*
[(arg) ((loc* after?) (current-reqspec) arg)]
[((and (not (? require-spec?)) arg) args ...) (apply (loc* after?) (current-reqspec) arg args)]
[((? require-spec? r) (? number? line)) (set-r r) (make-loc/lc r after? line false)]
[((? require-spec? r) (? number? line) (? number? col)) (set-r r) (make-loc/lc r after? line col)]
[((? require-spec? r) pattern) (set-r r) (make-loc/p r after? pattern)]))
(define loc/r (loc* true))
@ -83,9 +90,11 @@
(debug-process-where p)))
(define current-process (make-parameter (create-debug-process)))
(define current-reqspec (make-parameter false))
(define set-main!
(opt-lambda (reqspec [p (current-process)])
(current-reqspec reqspec )
(process:set-main! p reqspec)))
(define-syntax trace