From f0489bbb6cf6f2cd2888468ccdad87f4684cc45f Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sun, 5 Sep 2004 14:44:27 +0000
Subject: [PATCH] .

original commit: 9d40ed27b30d40cea1d9be135319959e1dc0ba07
---
 collects/mzlib/etc.ss                 | 10 +++--
 collects/mzlib/private/stxparamkey.ss | 62 ++++++++++++++++++++++++---
 collects/mzlib/stxparam.ss            | 40 ++---------------
 3 files changed, 66 insertions(+), 46 deletions(-)

diff --git a/collects/mzlib/etc.ss b/collects/mzlib/etc.ss
index 4c8b97c..64fecc9 100644
--- a/collects/mzlib/etc.ss
+++ b/collects/mzlib/etc.ss
@@ -456,9 +456,13 @@
                                         (current-directory))))))
                        (local)))])
         (if (and (pair? dir) (eq? 'plthome (car dir)))
-          (with-syntax ([d dir])
-            (syntax (un-plthome-ify 'd)))
-          (datum->syntax-object (quote-syntax here) dir stx)))]))
+	    (with-syntax ([d dir])
+	      (syntax (un-plthome-ify 'd)))
+	    (datum->syntax-object (quote-syntax here) 
+				  (if (path? dir)
+				      (path->string dir)
+				      dir)
+				  stx)))]))
 
  ;; This is a macro-generating macro that wants to expand
  ;; expressions used in the generated macro. So it's weird,
diff --git a/collects/mzlib/private/stxparamkey.ss b/collects/mzlib/private/stxparamkey.ss
index dfa8949..9dd8806 100644
--- a/collects/mzlib/private/stxparamkey.ss
+++ b/collects/mzlib/private/stxparamkey.ss
@@ -1,5 +1,7 @@
 
 (module stxparamkey mzscheme
+
+  (define-struct wrapped-renamer (renamer))
   
   (define-values (struct:syntax-parameter make-syntax-parameter syntax-parameter? syntax-parameter-ref syntax-parameter-set!)
     (make-struct-type 'syntax-parameter #f 2 0 #f null (current-inspector) 0))
@@ -8,14 +10,60 @@
     (syntax-parameter-ref sp 1))
 
   (define (syntax-parameter-target-value target)
-    (syntax-local-value (syntax-local-get-shadower target)
-			(lambda ()
-			  #f
-			  (syntax-local-value 
-			   target
-			   (lambda () #f)))))
+    (let ([v (syntax-local-value (syntax-local-get-shadower target)
+				 (lambda ()
+				   #f
+				   (syntax-local-value 
+				    target
+				    (lambda () #f))))])
+      (if (wrapped-renamer? v)
+	  (wrapped-renamer-renamer v)
+	  v)))
 
-  (provide syntax-parameter?
+  (define (convert-renamer v)
+    (if (rename-transformer? v)
+	(make-wrapped-renamer v)
+	v))
+
+  (define (apply-transformer v stx set!-stx)
+    (cond
+     [(rename-transformer? v) 
+      (with-syntax ([target (rename-transformer-target v)])
+	(syntax-case stx ()
+	  [(set! id _expr) 
+	   (module-identifier=? #'set! set!-stx)
+	   (syntax/loc stx (set! target expr))]
+	  [(id . rest)
+	   (let ([v (syntax (target . rest))])
+	     (datum->syntax-object
+	      stx
+	      (syntax-e v)
+	      stx))]
+	  [_else
+	   #'target]))]
+     [(set!-transformer? v) ((set!-transformer-procedure v) stx)]
+     [(and (procedure? v)
+	   (procedure-arity-includes? v 1))
+      (syntax-case stx ()
+	[(set! id _) 
+	 (module-identifier=? #'set! set!-stx)
+	 (raise-syntax-error
+	  #f
+	  "cannot mutate syntax identifier"
+	  stx
+	  #'id)]
+	[else (v stx)])]
+     [else
+      (raise-syntax-error
+       #f
+       "bad syntax"
+       stx
+       #f)]))
+
+
+  (provide convert-renamer
+	   apply-transformer
+	   syntax-parameter?
 	   make-syntax-parameter
 	   syntax-parameter-target
 	   syntax-parameter-target-value))
diff --git a/collects/mzlib/stxparam.ss b/collects/mzlib/stxparam.ss
index 8be6c7d..4f6bb2e 100644
--- a/collects/mzlib/stxparam.ss
+++ b/collects/mzlib/stxparam.ss
@@ -10,29 +10,13 @@
       [(_ id init-val)
        (with-syntax ([gen-id (car (generate-temporaries (list #'id)))])
 	 #'(begin
-	     (define-syntax gen-id init-val)
+	     (define-syntax gen-id (convert-renamer init-val))
 	     (define-syntax id 
 	       (make-set!-transformer
 		(make-syntax-parameter 
 		 (lambda (stx)
 		   (let ([v (syntax-parameter-target-value #'gen-id)])
-		     (cond
-		      [(set!-transformer? v) ((set!-transformer-procedure v) stx)]
-		      [(and (procedure? v)
-			    (procedure-arity-includes? v 1))
-		       (syntax-case stx (set!)
-			 [(set! id _) (raise-syntax-error
-				       #f
-				       "cannot mutate syntax identifier"
-				       stx
-				       #'id)]
-			 [else (v stx)])]
-		      [else
-		       (raise-syntax-error
-			#f
-			"bad syntax"
-			stx
-			#f)])))
+		     (apply-transformer v stx #'set!)))
 		 #'gen-id)))))]))
 
   (define-syntax (syntax-parameterize stx)
@@ -67,7 +51,7 @@
 		"duplicate binding"
 		stx
 		dup)))
-	   #'(let-syntax ([gen-id val] ...)
+	   #'(let-syntax ([gen-id (convert-renamer val)] ...)
 	       body0 body ...)))]))
 
   ;; ----------------------------------------
@@ -80,23 +64,7 @@
     (make-set!-transformer
      (lambda (stx)
        (let ([v (syntax-parameter-value (syntax-local-introduce id))])
-	 (cond
-	  [(set!-transformer? v) ((set!-transformer-procedure v) stx)]
-	  [(and (procedure? v)
-		(procedure-arity-includes? v 1))
-	   (syntax-case stx (set!)
-	     [(set! id _) (raise-syntax-error
-			  #f
-			  "cannot mutate syntax identifier"
-			  stx
-			  #'id)]
-	     [else (v stx)])]
-	  [else
-	   (raise-syntax-error
-	    #f
-	    "bad syntax"
-	    stx
-	    #f)])))))
+	 (apply-transformer v stx #'set!)))))
 
   (define (syntax-parameter-value id)
     (let* ([v (syntax-local-value id (lambda () #f))]