From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 28 Feb 2016 09:03:09 +0000 (-0800)
Subject: Define and export the default parameter procedures.
X-Git-Tag: mit-scheme-pucked-9.2.12~261^2~102
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=9f937ebc6b1c7d784e64d71ca2c5b207b2b789f3;p=mit-scheme.git

Define and export the default parameter procedures.
---

diff --git a/src/runtime/dynamic.scm b/src/runtime/dynamic.scm
index 9e2d495da..c14f225c8 100644
--- a/src/runtime/dynamic.scm
+++ b/src/runtime/dynamic.scm
@@ -60,15 +60,19 @@ USA.
   (make-parameter-internal initial-value converter #t))
 
 (define (make-parameter-internal initial-value converter settable?)
-  (let ((noop (lambda (x) x)))
-    (make-general-parameter initial-value
-			    (if (default-object? converter)
-				noop
-				converter)
-			    noop
-			    (and settable?
-				 (lambda (set-param value)
-				   (set-param value))))))
+  (make-general-parameter initial-value
+			  (if (default-object? converter)
+			      default-parameter-converter
+			      converter)
+			  default-parameter-getter
+			  (and settable?
+			       default-parameter-setter)))
+
+(define (default-parameter-converter value) value)
+(define (default-parameter-getter value) value)
+
+(define (default-parameter-setter set-param value)
+  (set-param value))
 
 (define (make-general-parameter initial-value converter getter setter)
   (guarantee-procedure converter 'make-general-parameter)
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index d729778b6..e428c7167 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -4615,6 +4615,9 @@ USA.
   (parent (runtime))
   (export ()
 	  (make-parameter make-settable-parameter)
+	  default-parameter-converter
+	  default-parameter-getter
+	  default-parameter-setter
 	  parameter?
 	  make-general-parameter
 	  make-settable-parameter