From 8ead11813b169f67807f49aee817199a56f98a4c Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sat, 27 Feb 2016 19:22:25 -0800 Subject: [PATCH] Tweak make-general-parameter to allow defining a setter. --- src/runtime/dynamic.scm | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) 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)) -- 2.25.1