.

original commit: a8fa10621a9cfefe53defb6b7e79ba4923a64cc8

collects/mzlib/private/stxparamkey.ss

@@ -1,5 +1,23 @@
 
 (module stxparamkey mzscheme
-  (define-struct syntax-parameter (target))
+  
-  (provide (struct syntax-parameter (target))))
+  (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))
+
+  (define (syntax-parameter-target sp)
+    (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)))))
+
+  (provide syntax-parameter?
+	   make-syntax-parameter
+	   syntax-parameter-target
+	   syntax-parameter-target-value))
+	   
 

collects/mzlib/stxparam.ss

@@ -11,52 +11,11 @@
        (with-syntax ([gen-id (car (generate-temporaries (list #'id)))])
 	 #'(begin
 	     (define-syntax gen-id init-val)
-	     (define-syntax id (make-syntax-parameter #'gen-id))))]))
+	     (define-syntax id 
-
-  (define-syntax (syntax-parameterize stx)
-    (syntax-case stx ()
-      [(_ ([id val] ...) body0 body ...)
-       (let ([ids (syntax->list #'(id ...))])
-	 (with-syntax ([(gen-id ...)
-			(map (lambda (id)
-			       (unless (identifier? id)
-				 (raise-syntax-error
-				  #f
-				  "not an identifier"
-				  stx
-				  id))
-			       (let ([rt (syntax-local-value id (lambda () #f))])
-				 (unless (syntax-parameter? rt)
-				   (raise-syntax-error
-				    #f
-				    "not bound as a syntax parameter"
-				    stx
-				    id))
-				 (syntax-local-get-shadower 
-				  (syntax-local-introduce (syntax-parameter-target rt)))))
-			     ids)])
-	   (let ([dup (check-duplicate-identifier ids)])
-	     (when dup
-	       (raise-syntax-error
-		#f
-		"duplicate binding"
-		stx
-		dup)))
-	   #'(let-syntax ([gen-id val] ...)
-	       body0 body ...)))]))
-
-  ;; ----------------------------------------
-
-  (require "private/stxparamkey.ss")
-  (require-for-template mzscheme)
-
-  (provide make-parameter-rename-transformer
-	   syntax-parameter-value)
-
-  (define (make-parameter-rename-transformer id)
 	       (make-set!-transformer
+		(make-syntax-parameter 
 		 (lambda (stx)
-       (let ([v (syntax-parameter-value (syntax-local-introduce id))])
+		   (let ([v (syntax-parameter-target-value #'gen-id)])
 		     (cond
 		      [(set!-transformer? v) ((set!-transformer-procedure v) stx)]
 		      [(and (procedure? v)
@@ -73,16 +32,56 @@
 			#f
 			"bad syntax"
 			stx
-	    #f)])))))
+			#f)])))
+		 #'gen-id)))))]))
+
+  (define-syntax (syntax-parameterize stx)
+    (syntax-case stx ()
+      [(_ ([id val] ...) body0 body ...)
+       (let ([ids (syntax->list #'(id ...))])
+	 (with-syntax ([(gen-id ...)
+			(map (lambda (id)
+			       (unless (identifier? id)
+				 (raise-syntax-error
+				  #f
+				  "not an identifier"
+				  stx
+				  id))
+			       (let* ([rt (syntax-local-value id (lambda () #f))]
+				      [sp (if (set!-transformer? rt)
+					      (set!-transformer-procedure rt)
+					      rt)])
+				 (unless (syntax-parameter? sp)
+				   (raise-syntax-error
+				    #f
+				    "not bound as a syntax parameter"
+				    stx
+				    id))
+				 (syntax-local-get-shadower 
+				  (syntax-local-introduce (syntax-parameter-target sp)))))
+			     ids)])
+	   (let ([dup (check-duplicate-identifier ids)])
+	     (when dup
+	       (raise-syntax-error
+		#f
+		"duplicate binding"
+		stx
+		dup)))
+	   #'(let-syntax ([gen-id val] ...)
+	       body0 body ...)))]))
+
+  ;; ----------------------------------------
+
+  (require "private/stxparamkey.ss")
+  (provide syntax-parameter-value)
+
 
   (define (syntax-parameter-value id)
-    (let ([v (syntax-local-value id (lambda () #f))])
+    (let* ([v (syntax-local-value id (lambda () #f))]
+	   [v (if (set!-transformer? v)
+		  (set!-transformer-procedure v)
+		  v)])
       (unless (syntax-parameter? v)
 	(raise-type-error 'syntax-parameter-value "syntax parameter" v))
       (let ([target (syntax-parameter-target v)])
-	(syntax-local-value (syntax-local-get-shadower target)
+	(syntax-parameter-target-value target)))))
-			    (lambda ()
-			      #f
-			      (syntax-local-value 
-			       target
-			       (lambda () #f))))))))