From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 28 Feb 2016 03:22:25 +0000 (-0800)
Subject: Tweak make-general-parameter to allow defining a setter.
X-Git-Tag: mit-scheme-pucked-9.2.12~261^2~111
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=8ead11813b169f67807f49aee817199a56f98a4c;p=mit-scheme.git

Tweak make-general-parameter to allow defining a setter.
---

diff --git a/src/runtime/dynamic.scm b/src/runtime/dynamic.scm
index cb8700f2a..9e2d495da 100644
--- a/src/runtime/dynamic.scm
+++ b/src/runtime/dynamic.scm
@@ -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))