Fix mutated-vars for #%plain-lambda.

Require stuff.
Fix make-eq.

svn: r9245

collects/typed-scheme/private/mutated-vars.ss

@@ -14,8 +14,8 @@
   ;; syntax -> void
   (define (fmv/list lstx)
     (for-each find-mutated-vars (syntax->list lstx)))
-  ;(printf "called with ~a~n" (syntax-object->datum form))
-  (kernel-syntax-case* form #f (define-type-alias-internal define-typed-struct-internal require/typed-internal #%app lambda)     
+  ;(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
@@ -23,10 +23,10 @@
        (module-identifier-mapping-put! table #'v #t))]
     [(define-values (var ...) expr)
      (find-mutated-vars #'expr)]
-    [(#%app . rest) (fmv/list #'rest)]
+    [(#%plain-app . rest) (fmv/list #'rest)]
     [(begin . rest) (fmv/list #'rest)]
     [(begin0 . rest) (fmv/list #'rest)]
-    [(lambda _ . 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))]

collects/typed-scheme/private/planet-requires.ss

@@ -1,11 +1,27 @@
 #lang scheme/base
 
-(require (for-syntax scheme/base scheme/require-transform))
+(require (for-syntax scheme/base scheme/require-transform)
+         scheme/require-syntax)
 
 (define-for-syntax (splice-requires specs)  
   (define subs (map (compose cons expand-import) specs))
   (values (apply append (map car subs)) (apply append (map cdr subs))))
 
+(define-syntax define-module
+  (syntax-rules ()
+    [(_ nm spec ...)
+     
+     (define-syntax nm
+       (make-require-transformer
+        (lambda (stx)
+          (splice-requires (list (syntax-local-introduce (quote-syntax spec)) ...)))))
+     #;
+     (define-require-syntax nm
+       (lambda (stx) 
+         (syntax-case stx ()
+           [(_) (datum->syntax stx (syntax->datum #'(combine-in spec ...)))])))]))
+
+#;
 (define-syntax define-module
   (lambda (stx)
     (syntax-case stx ()
@@ -38,6 +54,10 @@
 (define-module galore
   (prefix-in table: "tables.ss"))
 
+(require (galore))
+
+(void (table:alist->eq '()))
+
 (define-module schemeunit 
   (planet/multiple ("schematics" "schemeunit.plt" 2 3)
                    "test.ss"

collects/typed-scheme/private/tables.ss

@@ -7,8 +7,12 @@
   (for/hasheq ([e l])
     (values (car e) (cdr e))))
 
+(define (sexp->eq l) 
+  (for/hasheq ([e l])
+    (values (car e) (cadr e))))
+
 ;; to-sexp : table -> Listof(List k v)
-(define (to-sexp t) (hash-map list t))
+(define (to-sexp t) (hash-map t list))
 
 ;; union/value : table(k,v) table(k,v) [(v v -> v)] -> table(k,v)
 (define (union/value t1 t2 [f (lambda (x y) x)])
@@ -20,7 +24,7 @@
 		  [else
 		   (hash-set new-table k v)])))
 
-(define make-eq make-immutable-hasheq)
+(define (make-eq) (make-immutable-hasheq null))
 
 (define (lookup k t) (hash-ref t k #f))