.

original commit: 9bfb826b9cc49b5a347a2ded32e759c8f637d2d9

collects/mzlib/etc.ss

@@ -4,6 +4,7 @@
   (require-for-syntax (lib "kerncase.ss" "syntax")
 		      (lib "stx.ss" "syntax")
 		      (lib "name.ss" "syntax")
+		      (lib "context.ss" "syntax")
 		      "private/stxset.ss")
 
   (provide true false
@@ -196,56 +197,57 @@
    (lambda (stx)
      (syntax-case stx ()
        [(_ (defn ...) body1 body ...)
-	(let ([defs (let loop ([defns (syntax->list (syntax (defn ...)))])
-		      (apply
-		       append
-		       (map
-			(lambda (defn)
-			  (let ([d (local-expand
-				    defn
-				    'internal-define
-				    (kernel-form-identifier-list 
-				     (quote-syntax here)))]
-				[check-ids (lambda (ids)
-					     (for-each
-					      (lambda (id)
-						(unless (identifier? id)
-						  (raise-syntax-error
-						   #f
-						   "not an identifier for definition"
-						   stx
-						   id)))
-					      ids))])
-			    (syntax-case d (define-values define-syntaxes begin)
-			      [(begin defn ...)
-			       (loop (syntax->list (syntax (defn ...))))]
-			      [(define-values (id ...) body)
-			       (begin
-				 (check-ids (syntax->list (syntax (id ...))))
-				 (list d))]
-			      [(define-values . rest)
-			       (raise-syntax-error
-				#f
-				"ill-formed definition"
-				stx
-				d)]
-			      [(define-syntaxes (id ...) body)
-			       (begin
-				 (check-ids (syntax->list (syntax (id ...))))
-				 (list d))]
-			      [(define-syntaxes . rest)
-			       (raise-syntax-error
-				#f
-				"ill-formed definition"
-				stx
-				d)]
-			      [_else
-			       (raise-syntax-error
-				#f
-				"not a definition"
-				stx
-				defn)])))
-			defns)))])
+	(let ([defs (let ([expand-context (generate-expand-context)])
+		      (let loop ([defns (syntax->list (syntax (defn ...)))])
+			(apply
+			 append
+			 (map
+			  (lambda (defn)
+			    (let ([d (local-expand
+				      defn
+				      expand-context
+				      (kernel-form-identifier-list 
+				       (quote-syntax here)))]
+				  [check-ids (lambda (ids)
+					       (for-each
+						(lambda (id)
+						  (unless (identifier? id)
+						    (raise-syntax-error
+						     #f
+						     "not an identifier for definition"
+						     stx
+						     id)))
+						ids))])
+			      (syntax-case d (define-values define-syntaxes begin)
+				[(begin defn ...)
+				 (loop (syntax->list (syntax (defn ...))))]
+				[(define-values (id ...) body)
+				 (begin
+				   (check-ids (syntax->list (syntax (id ...))))
+				   (list d))]
+				[(define-values . rest)
+				 (raise-syntax-error
+				  #f
+				  "ill-formed definition"
+				  stx
+				  d)]
+				[(define-syntaxes (id ...) body)
+				 (begin
+				   (check-ids (syntax->list (syntax (id ...))))
+				   (list d))]
+				[(define-syntaxes . rest)
+				 (raise-syntax-error
+				  #f
+				  "ill-formed definition"
+				  stx
+				  d)]
+				[_else
+				 (raise-syntax-error
+				  #f
+				  "not a definition"
+				  stx
+				  defn)])))
+			  defns))))])
 	  (let ([ids (apply append
 			    (map
 			     (lambda (d)

collects/mzlib/private/sigutil.ss

@@ -4,7 +4,8 @@
   ;; (needs an overhaul, too)
 
   (require (lib "stx.ss" "syntax")
-	   (lib "struct.ss" "syntax"))
+	   (lib "struct.ss" "syntax")
+	   (lib "context.ss" "syntax"))
 
   (require "sigmatch.ss")
   (require "../unit.ss")
@@ -600,7 +601,8 @@
 					 swapped-renames)
 				  (loop (cdr e))
 				  (cons (car e) (loop (cdr e)))))))]
-		   [local-vars (append renamed-internals filtered-exported-names imported-names)])
+		   [local-vars (append renamed-internals filtered-exported-names imported-names)]
+		   [expand-context (generate-expand-context)])
 	      (let loop ([pre-lines null][lines body][port #f][port-name #f][body null][vars null])
 		(cond
 		 [(and (null? pre-lines) (not port) (null? lines))
@@ -623,7 +625,7 @@
 					 (if (eof-object? s)
 					   s
 					   (local-expand s    
-							 'internal-define
+							 expand-context
 							 (append
 							  user-stx-forms
 							  local-vars))))]

collects/mzlib/private/stxset.ss

@@ -1,7 +1,8 @@
 
 (module stxset mzscheme
 
-  (require-for-syntax (lib "kerncase.ss" "syntax"))
+  (require-for-syntax (lib "kerncase.ss" "syntax")
+		      (lib "context.ss" "syntax"))
 
   (provide finish-syntax-set)
 
@@ -19,7 +20,8 @@
 					  id
 					  (string->symbol (format "~a/proc" (syntax-e id)))
 					  id))
-				       ids)])
+				       ids)]
+		    [expand-context (generate-expand-context)])
 		;; Check defns (requires expand) ---------
 		(let* ([defns (let loop ([defns (syntax->list (syntax (defn ...)))])
 				(apply 
@@ -28,7 +30,7 @@
 				  (lambda (defn)
 				    (let ([defn (local-expand
 						 defn
-						 'internal-define
+						 expand-context
 						 (kernel-form-identifier-list (quote-syntax here)))])
 				      (syntax-case defn (define-values define-syntaxes begin)
 					[(define-values (id ...) expr)

collects/mzlib/unit.ss

@@ -5,6 +5,7 @@
   (require-for-syntax (lib "kerncase.ss" "syntax")
 		      (lib "stx.ss" "syntax")
 		      (lib "name.ss" "syntax")
+		      (lib "context.ss" "syntax")
 		      "list.ss"
 		      "private/unitidmap.ss")
 
@@ -60,6 +61,7 @@
 			   "export is not an identifier or renamed identifier"
 			   stx
 			   v)]))]
+	       [expand-context (generate-expand-context)]
 	       [ivars (syntax->list (syntax (ivar ...)))]
 	       [evars (syntax->list (syntax (evar ...)))])
 	   (for-each check-id ivars)
@@ -100,7 +102,7 @@
 				 (lambda (defn-or-expr)
 				   (local-expand
 				    defn-or-expr
-				    'internal-define
+				    expand-context
 				    (append
 				     (kernel-form-identifier-list (quote-syntax here))
 				     declared-names)))