From cb30a90f04fa1e328b91e21b885e0534a744a3ab Mon Sep 17 00:00:00 2001
From: Guillaume Marceau <gmarceau@racket-lang.org>
Date: Wed, 3 Aug 2005 19:45:21 +0000
Subject: [PATCH] define-values-for-syntax and (now-running b) and broken #%top

svn: r542
---
 collects/mztake/annotator.ss                  |  6 +++++-
 .../mztake/demos/highway/highway-mztake.ss    |  2 +-
 collects/mztake/demos/sine/sine-mztake.ss     |  2 +-
 collects/mztake/mztake.ss                     | 20 ++++++++++++++++---
 4 files changed, 24 insertions(+), 6 deletions(-)

diff --git a/collects/mztake/annotator.ss b/collects/mztake/annotator.ss
index f96bdd96c2..ea7f980184 100644
--- a/collects/mztake/annotator.ss
+++ b/collects/mztake/annotator.ss
@@ -112,6 +112,9 @@
             #,(annotate #`expr (syntax->list #`(var ...)) #t))]
        [(define-syntaxes (var ...) expr)
         stx]
+       [(define-values-for-syntax (var ...) expr)
+        #`(define-values-for-syntax (var ...) 
+            #,(annotate #`expr #`(syntax->list #'(var ...)) #t))]      
        [(begin . top-level-exprs)
         (quasisyntax/loc stx (begin #,@(map (lambda (expr)
                                               (module-level-expr-iterator expr))
@@ -120,6 +123,7 @@
         stx]
        [(require-for-syntax . require-specs)
         stx]
+       [(require-for-template dot require-specs) stx]
        [else
         (annotate stx '() #f)]))
     
@@ -297,4 +301,4 @@
      (lambda (fn pos)
        (printf "break?: ~a ~a~n" fn pos) #t)
      (lambda (bp-info) (printf "break: ~a~n" bp-info) #f)))  
-)
\ No newline at end of file
+)                                                                 
\ No newline at end of file
diff --git a/collects/mztake/demos/highway/highway-mztake.ss b/collects/mztake/demos/highway/highway-mztake.ss
index 15df347da0..9cf22b1c71 100644
--- a/collects/mztake/demos/highway/highway-mztake.ss
+++ b/collects/mztake/demos/highway/highway-mztake.ss
@@ -2,7 +2,7 @@
 	 (lib "animation.ss" "frtime")
          (lib "useful-code.ss" "mztake" "private"))
 
-(define/bind (loc "highway.ss" 3 4) speed)
+(define/bind (loc "highway.ss" 3 ) speed)
 
 (printf-b "current speed: ~a" speed)
 
diff --git a/collects/mztake/demos/sine/sine-mztake.ss b/collects/mztake/demos/sine/sine-mztake.ss
index 6436d5ba9d..bc9e2ad92d 100644
--- a/collects/mztake/demos/sine/sine-mztake.ss
+++ b/collects/mztake/demos/sine/sine-mztake.ss
@@ -2,7 +2,7 @@
          (lib "useful-code.ss" "mztake" "private"))
 (require (lib "mztake.ss" "mztake"))
 
-(define/bind (loc "sine.ss" 5 8) x sin-x)
+(define/bind (loc "sine.ss" 5 ) x sin-x)
 
 (define (pick-cute-color x y)
   (if (< 200 y)
diff --git a/collects/mztake/mztake.ss b/collects/mztake/mztake.ss
index 1cd1da66fc..9a3fe8473f 100644
--- a/collects/mztake/mztake.ss
+++ b/collects/mztake/mztake.ss
@@ -10,7 +10,9 @@
            "engine.ss")
   
   (provide loc$ loc-reqspec loc-line loc-col
-           trace trace* bind define/bind define/bind-e where set-main!)
+           trace
+           trace* bind define/bind define/bind-e where set-main!
+           [rename #%top mztake-top])
   (provide/contract [kill (() (debug-process?) . opt-> . void?)]
                     [kill-all (-> void?)]
                     [set-running-e! (frp:event? . -> . void?)]
@@ -50,7 +52,8 @@
   (define set-running!
     (opt-lambda (b [process (current-process)])
       (if (frp:value-now b) (resume process) (pause process))
-      (frp:set-cell! (debug-process-running-e process) (frp:changes b))))
+      (frp:set-cell! (debug-process-running-e process) (frp:changes b))
+      (list 'now-running (debug-process-running-e process))))
     
   (define where
     (opt-lambda ([p (current-process)])
@@ -74,6 +77,17 @@
       [(_ loc body ...)
        (trace* (current-process) loc (lambda () body ...))]))
   
+  ;; TODO this does not actually work
+  (define-syntax (mztake-top stx)
+    (syntax-case stx () 
+      [(_ . name) 
+       (begin 
+         (printf "~a~n" 'name) 
+         #'(with-handlers ([exn:fail?
+                            (lambda (exn) (bind* (current-process) 'name))])
+             (printf "~a~n" 'name)
+             (#%top . name)))]))
+  
   (define (bind* p name)
     (mark-binding-value
      (first (lookup-all-bindings
@@ -105,4 +119,4 @@
          ...)]))
   
   
-  )
\ No newline at end of file
+  )                                                                                                                     
\ No newline at end of file