Tweak make-general-parameter to allow defining a setter.
authorChris Hanson <org/chris-hanson/cph>
Sun, 28 Feb 2016 03:22:25 +0000 (19:22 -0800)
committerChris Hanson <org/chris-hanson/cph>
Sun, 28 Feb 2016 03:22:25 +0000 (19:22 -0800)
src/runtime/dynamic.scm

index cb8700f2aa76c50bccad11bc6fe045133f77ef02..9e2d495dacefba11875607ce1e4e99b580bba879 100644 (file)
@@ -66,21 +66,26 @@ USA.
                                noop
                                converter)
                            noop
-                           settable?)))
+                           (and settable?
+                                (lambda (set-param value)
+                                  (set-param value))))))
 
-(define (make-general-parameter initial-value converter reader settable?)
+(define (make-general-parameter initial-value converter getter setter)
   (guarantee-procedure converter 'make-general-parameter)
-  (guarantee-procedure reader 'make-general-parameter)
+  (guarantee-procedure getter 'make-general-parameter)
+  (if setter (guarantee-procedure setter 'make-general-parameter))
   (let* ((metadata (cons converter (converter initial-value)))
         (get-binding (lambda () (or (assq metadata bindings) metadata)))
         (parameter
-         (if settable?
+         (if setter
              (lambda (#!optional new-value)
                (if (default-object? new-value)
-                   (reader (cdr (get-binding)))
-                   (set-cdr! (get-binding) (converter new-value))))
+                   (getter (cdr (get-binding)))
+                   (setter (lambda (value)
+                             (set-cdr! (get-binding) value))
+                           (converter new-value))))
              (lambda ()
-               (reader (cdr (get-binding)))))))
+               (getter (cdr (get-binding)))))))
     (set-parameter-metadata! parameter metadata)
     parameter))