Split make-parameter into settable and unsettable variants.

* Default is settable, but that might want to be reconsidered.
* Parameters defined in runtime should probably be made explicit.
* Rename make-parameter* to make-general-parameter.

diff --git a/src/runtime/dynamic.scm b/src/runtime/dynamic.scm
index 35db0bd68ee82dcf5ab9583b12201fc8094199b7..cb8700f2aa76c50bccad11bc6fe045133f77ef02 100644 (file)
--- a/src/runtime/dynamic.scm
+++ b/src/runtime/dynamic.scm
@@ -53,22 +53,34 @@ USA.
 
 (define-guarantee parameter "parameter")
 
-(define (make-parameter initial-value #!optional write-converter)
+(define (make-unsettable-parameter initial-value #!optional converter)
+  (make-parameter-internal initial-value converter #f))
+
+(define (make-settable-parameter initial-value #!optional converter)
+  (make-parameter-internal initial-value converter #t))
+
+(define (make-parameter-internal initial-value converter settable?)
   (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)))
+    (make-general-parameter initial-value
+                           (if (default-object? converter)
+                               noop
+                               converter)
+                           noop
+                           settable?)))
+
+(define (make-general-parameter initial-value converter reader settable?)
+  (guarantee-procedure converter 'make-general-parameter)
+  (guarantee-procedure reader 'make-general-parameter)
+  (let* ((metadata (cons converter (converter initial-value)))
+        (get-binding (lambda () (or (assq metadata bindings) metadata)))
         (parameter
-         (lambda (#!optional new-value)
-           (let ((p (or (assq metadata bindings) metadata)))
-             (if (default-object? new-value)
-                 (read-converter (cdr p))
-                 (set-cdr! p (write-converter new-value)))))))
+         (if settable?
+             (lambda (#!optional new-value)
+               (if (default-object? new-value)
+                   (reader (cdr (get-binding)))
+                   (set-cdr! (get-binding) (converter new-value))))
+             (lambda ()
+               (reader (cdr (get-binding)))))))
     (set-parameter-metadata! parameter metadata)
     parameter))
 

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 67f6bbb05fac9527a4671402d58f404841ec9f30..450c38ac72b98eadd558a7be61d96fcead09f94a 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -4581,9 +4581,11 @@ USA.
   (files "dynamic")
   (parent (runtime))
   (export ()
+         (make-parameter make-settable-parameter)
          parameter?
-         make-parameter
-         make-parameter*
+         make-general-parameter
+         make-settable-parameter
+         make-unsettable-parameter
          parameterize*)
   (initialization (initialize-package!)))