Implement make-parameter*.

diff --git a/src/runtime/dynamic.scm b/src/runtime/dynamic.scm
index bf646a681eb9f219d63c8426dbde6dd354fca059..35db0bd68ee82dcf5ab9583b12201fc8094199b7 100644 (file)
--- a/src/runtime/dynamic.scm
+++ b/src/runtime/dynamic.scm
@@ -53,18 +53,22 @@ USA.
 
 (define-guarantee parameter "parameter")
 
-(define (make-parameter init #!optional converter)
-  (let* ((converter
-         (if (default-object? converter)
-             (lambda (x) x)
-             converter))
-        (metadata (cons converter (converter init)))
+(define (make-parameter initial-value #!optional write-converter)
+  (let ((noop (lambda (x) x)))
+    (make-parameter* initial-value
+                    noop
+                    (if (default-object? write-converter)
+                        noop
+                        write-converter))))
+
+(define (make-parameter* initial-value read-converter write-converter)
+  (let* ((metadata (cons write-converter (write-converter initial-value)))
         (parameter
          (lambda (#!optional new-value)
            (let ((p (or (assq metadata bindings) metadata)))
              (if (default-object? new-value)
-                 (cdr p)
-                 (set-cdr! p (converter new-value)))))))
+                 (read-converter (cdr p))
+                 (set-cdr! p (write-converter new-value)))))))
     (set-parameter-metadata! parameter metadata)
     parameter))
 

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index e50101e45825c25c5ce68262c5981c60e9379526..431bf35399073a8e85f916d944e1852a5ba6a2c7 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -4581,6 +4581,7 @@ USA.
   (export ()
          parameter?
          make-parameter
+         make-parameter*
          parameterize*)
   (initialization (initialize-package!)))