From a5a017bd9f00b7afa227b57a6c891b45e26aec15 Mon Sep 17 00:00:00 2001
From: Greg Cooper <greg@cs.brown.edu>
Date: Fri, 27 Jan 2006 23:54:38 +0000
Subject: [PATCH] implemented current-reqspec

svn: r2011
---
 .../mztake/demos/dijkstra/dijkstra-mztake.ss    |  5 +++--
 collects/mztake/engine.ss                       |  2 ++
 collects/mztake/mztake-structs.ss               | 12 +++++++++---
 collects/mztake/mztake.ss                       | 17 +++++++++++++----
 4 files changed, 27 insertions(+), 9 deletions(-)

diff --git a/collects/mztake/demos/dijkstra/dijkstra-mztake.ss b/collects/mztake/demos/dijkstra/dijkstra-mztake.ss
index 336fb79f3b..9b5b427eb2 100644
--- a/collects/mztake/demos/dijkstra/dijkstra-mztake.ss
+++ b/collects/mztake/demos/dijkstra/dijkstra-mztake.ss
@@ -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
diff --git a/collects/mztake/engine.ss b/collects/mztake/engine.ss
index 6187ac0459..5052e4d07e 100644
--- a/collects/mztake/engine.ss
+++ b/collects/mztake/engine.ss
@@ -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))
diff --git a/collects/mztake/mztake-structs.ss b/collects/mztake/mztake-structs.ss
index d2f7c48520..c3bf88038c 100644
--- a/collects/mztake/mztake-structs.ss
+++ b/collects/mztake/mztake-structs.ss
@@ -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]))
   
   ;    ;;;;;   ;                          ;          
   ;   ;     ;  ;                          ;          
diff --git a/collects/mztake/mztake.ss b/collects/mztake/mztake.ss
index ea1ced789d..a8f720d6db 100644
--- a/collects/mztake/mztake.ss
+++ b/collects/mztake/mztake.ss
@@ -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