.

original commit: 77566789cee6d53331f69c6ccbf4a826d119f768

collects/mzlib/class.ss

@@ -5,7 +5,7 @@
   (require "private/class-internal.ss")
   
   (provide class
-	   class* class*/names
+	   class*
            class?
 	   interface interface?
 	   object% object?
@@ -35,4 +35,5 @@
            public-final override-final augment-final
 	   field init init-field
 	   rename-super rename-inner inherit
-	   super inner))
+	   this super inner
+	   super-make-object super-instantiate super-new))

collects/mzlib/pretty.ss

@@ -549,6 +549,8 @@
 					       (get-output-string p))
 					     col)))
 
+		    ((and display? (path? obj)) (out (path->string obj) col))
+
 		    ;; Let symbol get printed by default case to get proper quoting
 		    ;; ((symbol? obj)      (out (symbol->string obj) col))
 

collects/mzlib/private/stxparamkey.ss

@@ -0,0 +1,5 @@
+
+(module stxparamkey mzscheme
+  (define-struct syntax-parameter (target))
+  (provide (struct syntax-parameter (target))))
+

collects/mzlib/stxparam.ss

@@ -0,0 +1,88 @@
+
+(module stxparam mzscheme
+  (require-for-syntax "private/stxparamkey.ss")
+
+  (provide define-syntax-parameter
+	   syntax-parameterize)
+
+  (define-syntax (define-syntax-parameter stx)
+    (syntax-case stx ()
+      [(_ id init-val)
+       (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 (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
+     (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)])))))
+
+  (define (syntax-parameter-value id)
+    (let ([v (syntax-local-value id (lambda () #f))])
+      (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)
+			    (lambda ()
+			      #f
+			      (syntax-local-value 
+			       target
+			       (lambda () #f))))))))