From 2b288b258210be71345c7f8a5b8b32cba010f729 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Thu, 11 Sep 2008 09:01:49 -0400
Subject: [PATCH] Add eof and read-accept-reader.

Fix find-mutated-vars

original commit: 7cf9b36c1501aa994d29e1bbd61b1785b5e92655
---
 collects/typed-scheme/private/base-env.ss     |  3 ++-
 collects/typed-scheme/private/mutated-vars.ss | 13 +++++------
 collects/typed-scheme/utils/utils.ss          | 22 ++++++++++---------
 3 files changed, 19 insertions(+), 19 deletions(-)

diff --git a/collects/typed-scheme/private/base-env.ss b/collects/typed-scheme/private/base-env.ss
index 719c25ba..6600a1f7 100644
--- a/collects/typed-scheme/private/base-env.ss
+++ b/collects/typed-scheme/private/base-env.ss
@@ -560,7 +560,8 @@
      [values (-polydots (a) (null (a a) . ->... . (make-ValuesDots null a 'a)))]
      [call-with-values (-polydots (b a) ((-> (make-ValuesDots null a 'a)) (null (a a) . ->... . b) . -> .  b))]
   
-     [foo (N #:bar B #f . ->key . B)]
+     [eof (-val eof)]
+     [read-accept-reader (-Param B B)]
      )
 
 (begin-for-syntax 
diff --git a/collects/typed-scheme/private/mutated-vars.ss b/collects/typed-scheme/private/mutated-vars.ss
index 6e7a2c2d..a362bd53 100644
--- a/collects/typed-scheme/private/mutated-vars.ss
+++ b/collects/typed-scheme/private/mutated-vars.ss
@@ -14,12 +14,11 @@
   ;; syntax -> void
   (define (fmv/list lstx)
     (for-each find-mutated-vars (syntax->list lstx)))
-  ;(printf "called with ~a~n" (syntax->datum form))
+  ;(when (and (pair? (syntax->datum form))) (printf "called with ~a~n" (syntax->datum form)))
   (kernel-syntax-case* form #f (define-type-alias-internal define-typed-struct-internal require/typed-internal)     
     ;; what we care about: set!
     [(set! v e)
      (begin
-       ;(printf "mutated var found: ~a~n" (syntax-e #'v))
        (module-identifier-mapping-put! table #'v #t))]
     [(define-values (var ...) expr)
      (find-mutated-vars #'expr)]
@@ -28,15 +27,13 @@
     [(begin0 . rest) (fmv/list #'rest)]
     [(#%plain-lambda _ . rest) (fmv/list #'rest)]
     [(case-lambda (_ . rest) ...) (for-each fmv/list (syntax->list #'(rest ...)))]
-    [(if e1 e2) (begin (find-mutated-vars #'e1) (find-mutated-vars #'e2))]
-    [(if e1 e2 e3) (begin (find-mutated-vars #'e1) (find-mutated-vars #'e1) (find-mutated-vars #'e3))]
-    [(with-continuation-mark e1 e2 e3) (begin (find-mutated-vars #'e1) 
-                                              (find-mutated-vars #'e1)
-                                              (find-mutated-vars #'e3))]
+    [(if . es) (fmv/list #'es)]
+    [(with-continuation-mark . es) (fmv/list #'es)]
     [(let-values ([_ e] ...) . b) (begin (fmv/list #'(e ...))
                                          (fmv/list #'b))]
     [(letrec-values ([_ e] ...) . b) (begin (fmv/list #'(e ...))
-                                            (fmv/list #'b))]  
+                                            (fmv/list #'b))]
+    [(#%expression e) (find-mutated-vars #'e)]
     ;; all the other forms don't have any expression subforms (like #%top)
     [_ (void)]))
 
diff --git a/collects/typed-scheme/utils/utils.ss b/collects/typed-scheme/utils/utils.ss
index ad04ad79..6ca8a6a9 100644
--- a/collects/typed-scheme/utils/utils.ss
+++ b/collects/typed-scheme/utils/utils.ss
@@ -30,16 +30,18 @@
 	    (syntax-case stx ()
 	      [(_ id ...)
 	       (andmap identifier? (syntax->list #'(id ...)))
-	       (with-syntax ([(id* ...) (map (lambda (id) (datum->syntax 
-							   id 
-							   (string->symbol
-							    (string-append 
-							     "typed-scheme/"
-							     #,(symbol->string (syntax-e #'nm))
-							     "/" 
-							     (symbol->string (syntax-e id))))
-							   id id))
-					     (syntax->list #'(id ...)))])
+	       (with-syntax ([(id* ...) 
+                              (map (lambda (id) 
+                                     (datum->syntax 
+                                      id 
+                                      (string->symbol
+                                       (string-append 
+                                        "typed-scheme/"
+                                        #,(symbol->string (syntax-e #'nm))
+                                        "/" 
+                                        (symbol->string (syntax-e id))))
+                                      id id))
+                                   (syntax->list #'(id ...)))])
 			    (syntax/loc stx (combine-in id* ...)))]))))]))