From: Matt Birkholz Date: Mon, 11 Aug 2014 21:28:33 +0000 (-0700) Subject: Add fluid and parameter objects. X-Git-Tag: mit-scheme-pucked-9.2.12~402^2~5 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=9df78b57d1e8ecc578017636e005c4d076223cff;p=mit-scheme.git Add fluid and parameter objects. Update documentation of miscellaneous object type Cell and special form Fluid-Let, describing them as deprecated. --- diff --git a/doc/ref-manual/misc-datatypes.texi b/doc/ref-manual/misc-datatypes.texi index c9e284782..e3c445ac2 100644 --- a/doc/ref-manual/misc-datatypes.texi +++ b/doc/ref-manual/misc-datatypes.texi @@ -4,7 +4,7 @@ @menu * Booleans:: * Symbols:: -* Cells:: +* Parameters:: * Records:: * Promises:: * Streams:: @@ -116,7 +116,7 @@ This procedure returns @code{#f} if all of its arguments are @code{#f}. Otherwise it returns @code{#t}. @end deffn -@node Symbols, Cells, Booleans, Miscellaneous Datatypes +@node Symbols, Parameters, Booleans, Miscellaneous Datatypes @section Symbols @cindex symbol (defn) @@ -404,12 +404,68 @@ This procedure computes a total order on symbols. It is equivalent to @end example @end deffn -@node Cells, Records, Symbols, Miscellaneous Datatypes -@section Cells +@node Parameters, Records, Symbols, Miscellaneous Datatypes +@section Parameters +@cindex parameter, dynamic (defn) +@cindex dynamic parameter (defn) + +@dfn{Parameters} are objects that can be bound to new values for the +duration of a dynamic extent. @xref{Dynamic Binding}. + +@deffn procedure make-parameter init [converter] +Returns a newly allocated parameter object, which is a procedure that +accepts zero arguments and returns the value associated with the +parameter object. Initially this value is the value of +@code{(converter init)}, or of @var{init} if the conversion procedure +@var{converter} is not specified. The associated value can be +temporarily changed using the @code{parameterize} special form +(@pxref{parameterize}). +@end deffn + +@deffn procedure parameterize* bindings thunk +@var{Bindings} should be an alist associating parameter objects with +new values. Returns the value of @var{thunk} while the parameters are +dynamically bound to the values. +@end deffn + +@anchor{Fluids} +@subsection Fluids + +@cindex fluid (defn) +A @dfn{fluid} object is very similar to a parameter. Its value can be +dynamically bound like a parameter, and it has a top-level value that +is used when it is unbound in the current dynamic environment. + +@deffn procedure make-fluid value +Returns a new fluid object with @var{value} as its initial, top-level +value. +@end deffn + +@deffn procedure fluid fluid +Returns @var{fluid}'s current value. +@end deffn + +@deffn procedure set-fluid! fluid value +Changes @var{fluid}'s current value. If @var{fluid} is not bound in +the current dynamic environment, its top-level value is changed. +@end deffn + +@anchor{let-fluids} +@deffn procedure let-fluid fluid value thunk +@deffnx procedure let-fluids fluid value [ fluid value ] @dots{} thunk +Returns the value of @var{thunk} while @var{fluid} is dynamically +bound to @var{value. @code{Let-fluids} is identical to +@code{let-fluid} except that it binds an arbitrary number of fluids to +new values. +@end deffn + +@anchor{Cells} +@subsection Cells @cindex cell (defn) -@dfn{Cells} are data structures similar to pairs except that they have -only one element. They are useful for managing state. +A @dfn{cell} object is very similar to a parameter but is not +implemented in multi-processing worlds and thus is +@strong{deprecated}. Parameters should be used instead. @deffn procedure cell? object @cindex type predicate, for cell @@ -441,7 +497,7 @@ equivalent to dynamic binding of a variable, including the behavior when continuations are used (@pxref{Dynamic Binding}). @end deffn -@node Records, Promises, Cells, Miscellaneous Datatypes +@node Records, Promises, Parameters, Miscellaneous Datatypes @section Records MIT/GNU Scheme provides a @dfn{record} abstraction, which is a simple and diff --git a/doc/ref-manual/scheme.texinfo b/doc/ref-manual/scheme.texinfo index 05705821e..22e04a34d 100644 --- a/doc/ref-manual/scheme.texinfo +++ b/doc/ref-manual/scheme.texinfo @@ -258,7 +258,7 @@ Miscellaneous Datatypes * Booleans:: * Symbols:: -* Cells:: +* Parameters:: * Records:: * Promises:: * Streams:: diff --git a/doc/ref-manual/special-forms.texi b/doc/ref-manual/special-forms.texi index 018795d85..974facbb8 100644 --- a/doc/ref-manual/special-forms.texi +++ b/doc/ref-manual/special-forms.texi @@ -332,106 +332,113 @@ the restriction is satisfied automatically. @node Dynamic Binding, Definitions, Lexical Binding, Special Forms @section Dynamic Binding -@deffn {special form} fluid-let ((@var{variable} @var{init}) @dots{}) expression expression @dots{} -@cindex binding expression, dynamic (or fluid) -@cindex fluid binding -@cindex dynamic binding -@cindex variable binding, fluid-let -The @var{init}s are evaluated in the current environment (in some -unspecified order), the current values of the @var{variable}s are saved, -the results are assigned to the @var{variable}s, the @var{expression}s -are evaluated sequentially in the current environment, the -@var{variable}s are restored to their original values, and the value of -the last @var{expression} is returned. - -@findex let -The syntax of this special form is similar to that of @code{let}, but -@code{fluid-let} temporarily rebinds existing variables. Unlike -@code{let}, @code{fluid-let} creates no new bindings; instead it -@emph{assigns} the value of each @var{init} to the binding (determined -by the rules of lexical scoping) of its corresponding @var{variable}. - -@cindex unassigned variable, and dynamic bindings -MIT/GNU Scheme allows any of the @var{init}s to be omitted, in which -case the corresponding @var{variable}s are temporarily unassigned. - -An error of type @code{condition-type:unbound-variable} is signalled if -any of the @var{variable}s are unbound. However, because -@code{fluid-let} operates by means of side effects, it is valid for any -@var{variable} to be unassigned when the form is entered. -@findex condition-type:unbound-variable +@anchor{parameterize} +@deffn {special form} parameterize ((@var{parameter} @var{value}) @dots{}) expression expression @dots{} +Note that both @var{parameter} and @var{value} are expressions. +It is an error if the value of any @var{parameter} expression is not a +parameter object. + +A @code{parameterize} expression is used to change the values of +specified parameter objects during the evaluation of the body +@var{expression}s. + +The @var{parameter} and @var{value} expressions are evaluated in an +unspecified order. The body is evaluated in a dynamic +environment in which each @var{parameter} is bound to the converted +@var{value}---the result of passing @var{value} to the conversion +procedure specified when the @var{parameter} was created. +Then the previous value of @var{parameter} is restored +without passing it to the conversion procedure. +The value of the parameterize expression is the value of the last +body @var{expression}. +@end deffn -Here is an example showing the difference between @code{fluid-let} and -@code{let}. First see how @code{let} affects the binding of a variable: +Parameter objects can be used to specify configurable settings for a +computation without the need to pass the value to every procedure in +the call chain explicitly. @example @group -(define variable #t) -(define (access-variable) variable) -variable @result{} #t -(let ((variable #f)) - (access-variable)) @result{} #t -variable @result{} #t +(define radix + (make-parameter + 10 + (lambda (x) + (if (and (exact-integer? x) (<= 2 x 16)) + x + (error "invalid radix"))))) @end group -@end example -@code{access-variable} returns @code{#t} in this case because it -is defined in an environment with @code{variable} bound to -@code{#t}. @code{fluid-let}, on the other hand, temporarily reuses an -existing variable: +(define (f n) (number->string n (radix))) -@example @group -variable @result{} #t -(fluid-let ((variable #f)) @r{;reuses old binding} - (access-variable)) @result{} #f -variable @result{} #t +(f 12) @result{} "12" +(parameterize ((radix 2)) + (f 12)) @result{} "1100" +(f 12) @result{} "12" +(radix 16) @error{} Wrong number of arguments +(parameterize ((radix 0)) + (f 12)) @error{} invalid radix @end group @end example +@cindex binding expression, dynamic (or fluid) +@cindex fluid binding +@cindex dynamic binding +A @dfn{dynamic binding} or @dfn{fluid binding} changes the value of a +parameter (@pxref{Parameters}) or fluid (@pxref{Fluids}) object +temporarily, for a @dfn{dynamic extent}. The set of all fluid +bindings at a given time is called the @dfn{dynamic environment}. The +new values are only accessible to the thread that constructed the +dynamic environment, and any threads created within that environment. + @cindex extent, of dynamic binding (defn) The @dfn{extent} of a dynamic binding is defined to be the time period -during which the variable contains the new value. Normally this time -period begins when the body is entered and ends when it is exited; on a -sequential machine it is normally a contiguous time period. However, -because Scheme has first-class continuations, it is possible to leave -the body and then reenter it, as many times as desired. In this -situation, the extent becomes non-contiguous. +during which calling the parameter returns the new value. Normally +this time period begins when the body is entered and ends when it is +exited, a contiguous time period. However Scheme has first-class +continuations by which it is possible to leave the body and reenter it +many times. In this situation, the extent is non-contiguous. @cindex dynamic binding, and continuations @cindex continuation, and dynamic binding -When the body is exited by invoking a continuation, the new value is -saved, and the variable is set to the old value. Then, if the body is -reentered by invoking a continuation, the old value is saved, and the -variable is set to the new value. In addition, side effects to the -variable that occur both inside and outside of body are preserved, even -if continuations are used to jump in and out of body repeatedly. -@end deffn +When the body is exited by invoking a continuation, the current +dynamic environment is unwound until it can be re-wound to the +environment captured by the continuation. When the continuation +returns, the process is reversed, restoring the original dynamic +environment. -Here is a complicated example that shows the interaction between dynamic -binding and continuations: +The following example shows the interaction between dynamic +binding and continuations. Side effects to the binding that occur +both inside and outside of the body are preserved, even if +continuations are used to jump in and out of the body repeatedly. +A fluid object is used rather than a parameter only for variety. A +mutator similar to @code{set-fluid!} is available for parameter +bindings (@code{set-parameter!}). Both will modify the initial or +top-level value when the parameter or fluid is not bound in the +current dynamic environment. @example @group (define (complicated-dynamic-binding) - (let ((variable 1) + (let ((variable (make-fluid 1)) (inside-continuation)) - (write-line variable) + (write-line (fluid variable)) (call-with-current-continuation (lambda (outside-continuation) - (fluid-let ((variable 2)) - (write-line variable) - (set! variable 3) - (call-with-current-continuation - (lambda (k) - (set! inside-continuation k) - (outside-continuation #t))) - (write-line variable) - (set! inside-continuation #f)))) - (write-line variable) + (let-fluid variable 2 + (lambda () + (write-line (fluid variable)) + (set-fluid! variable 3) + (call-with-current-continuation + (lambda (k) + (set! inside-continuation k) + (outside-continuation #t))) + (write-line (fluid variable)) + (set! inside-continuation #f))))) + (write-line (fluid variable)) (if inside-continuation (begin - (set! variable 4) + (set-fluid! variable 4) (inside-continuation #f))))) @end group @end example @@ -452,17 +459,55 @@ the console: @noindent Commentary: the first two values written are the initial binding of -@code{variable} and its new binding after the @code{fluid-let}'s body is -entered. Immediately after they are written, @code{variable} is set to -@samp{3}, and then @code{outside-continuation} is invoked, causing us to -exit the body. At this point, @samp{1} is written, demonstrating that -the original value of @code{variable} has been restored, because we have -left the body. Then we set @code{variable} to @samp{4} and reenter the -body by invoking @code{inside-continuation}. At this point, @samp{3} is -written, indicating that the side effect that previously occurred within -the body has been preserved. Finally, we exit body normally, and write -@samp{4}, demonstrating that the side effect that occurred outside of -the body was also preserved. +@code{variable} and its new binding after @code{let-fluid}'s thunk is +entered. Immediately after they are written, the binding visible in +the thunk is set to @samp{3}, and @code{outside-continuation} is +invoked, exiting the thunk. At this point, @samp{1} is written, +demonstrating that the original binding of @code{variable} is still +visible outside the thunk. Then we set @code{variable} to @samp{4} +and reenter the body by invoking @code{inside-continuation}. At this +point, @samp{3} is written, indicating that the binding modified in +the thunk is still the binding visible in the thunk. Finally, we exit +the thunk normally, and write @samp{4}, demonstrating that the binding +modified outside of the thunk was also preserved. + +@subsection Fluid-Let + +The @code{fluid-let} special form can change the value of @emph{any} +variable for a dynamic extent, but it is difficult to implement in a +multi-processing (SMP) world. It and the cell object type +(@pxref{Cells}) are now @strong{deprecated}. They are still available +and functional in a uni-processing (non-SMP) world, but will signal an +error when used in an SMP world. The @code{parameterize} special form +(@pxref{parameterize}) or @code{let-fluids} procedure +(@pxref{let-fluids}) should be used instead. + +@deffn {special form} fluid-let ((@var{variable} @var{init}) @dots{}) expression expression @dots{} +@cindex variable binding, fluid-let +The @var{init}s are evaluated in the current environment (in some +unspecified order), the current values of the @var{variable}s are saved, +the results are assigned to the @var{variable}s, the @var{expression}s +are evaluated sequentially in the current environment, the +@var{variable}s are restored to their original values, and the value of +the last @var{expression} is returned. + +@findex let +The syntax of this special form is similar to that of @code{let}, but +@code{fluid-let} temporarily rebinds existing variables. Unlike +@code{let}, @code{fluid-let} creates no new bindings; instead it +@emph{assigns} the value of each @var{init} to the binding (determined +by the rules of lexical scoping) of its corresponding @var{variable}. + +@cindex unassigned variable, and dynamic bindings +MIT/GNU Scheme allows any of the @var{init}s to be omitted, in which +case the corresponding @var{variable}s are temporarily unassigned. + +An error of type @code{condition-type:unbound-variable} is signalled if +any of the @var{variable}s are unbound. However, because +@code{fluid-let} operates by means of side effects, it is valid for any +@var{variable} to be unassigned when the form is entered. +@findex condition-type:unbound-variable +@end deffn @node Definitions, Assignments, Dynamic Binding, Special Forms @section Definitions diff --git a/src/runtime/dynamic.scm b/src/runtime/dynamic.scm new file mode 100644 index 000000000..1bc0ca511 --- /dev/null +++ b/src/runtime/dynamic.scm @@ -0,0 +1,145 @@ +#| -*-Scheme-*- + +Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, + 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, + 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Massachusetts + Institute of Technology + +This file is part of MIT/GNU Scheme. + +MIT/GNU Scheme is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or (at +your option) any later version. + +MIT/GNU Scheme is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You should have received a copy of the GNU General Public License +along with MIT/GNU Scheme; if not, write to the Free Software +Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, +USA. + +|# + +;;;; Fluids and Parameters +;;; package: (runtime dynamic) + +(declare (usual-integrations)) + + +;; The current thread's fluid and parameter bindings. +(define bindings '()) + +;;;; Fluids + +(define-structure fluid + value) + +(define (guarantee-fluid f operator) + (if (not (fluid? f)) + (error:wrong-type-argument f "a fluid" operator))) + +(define (fluid f) + (guarantee-fluid f 'FLUID) + (let ((entry (assq f bindings))) + (if entry (cdr entry) (fluid-value f)))) + +(define (set-fluid! f val) + (guarantee-fluid f 'SET-FLUID!) + (let ((entry (assq f bindings))) + (if entry (set-cdr! entry val) (set-fluid-value! f val)))) + +(define (let-fluid fluid value thunk) + (guarantee-fluid fluid 'LET-FLUID) + (guarantee-thunk thunk 'LET-FLUID) + (fluid-let ((bindings (cons (cons fluid value) bindings))) + (thunk))) + +(define (let-fluids . args) + (let loop ((args args) + (new-bindings '())) + (if (null? (cdr args)) + (begin + (guarantee-thunk (car args) 'LET-FLUIDS) + (fluid-let ((bindings (append! new-bindings bindings))) + ((car args)))) + (begin + (guarantee-fluid (car args) 'LET-FLUIDS) + (loop (cddr args) + (cons (cons (car args) (cadr args)) new-bindings)))))) + +;;;; Parameters + +(define-structure %parameter + value converter) + +(define (parameter? p) + (and (entity? p) (%parameter? (entity-extra p)))) + +(define (guarantee-parameter p operator) + (if (not (parameter? p)) + (error:wrong-type-argument p "a parameter" operator))) + +(define (make-parameter init #!optional converter) + (if (not (default-object? converter)) + (guarantee-procedure-of-arity converter 1 'MAKE-PARAMETER)) + (make-entity (lambda (self) + (let ((entry (assq self bindings))) + (if entry + (cdr entry) + (%parameter-value (entity-extra self))))) + (make-%parameter (if (default-object? converter) + init + (converter init)) + (if (default-object? converter) + identity-procedure + converter)))) + +(define (set-parameter! p v) + (guarantee-parameter p 'PARAMETER-SET!) + (let ((%p (entity-extra p))) + (let ((%v ((%parameter-converter %p) v)) + (entry (assq p bindings))) + (if entry + (set-cdr! entry %v) + (set-%parameter-value! %p %v))))) + +(define (parameter-converter p) + (%parameter-converter (entity-extra p))) + +(define-syntax parameterize + (syntax-rules () + ((_ ((PARAM VALUE) BINDING ...) BODY ...) + (parameterize-helper ((PARAM VALUE) BINDING ...) () BODY ...)))) + +(define-syntax parameterize-helper + (syntax-rules () + ((_ ((PARAM VALUE) BINDING ...) (EXTENSION ...) BODY ...) + (parameterize-helper (BINDING ...) + ((cons PARAM VALUE) EXTENSION ...) + BODY ...)) + ((_ () (EXTENSION ...) BODY ...) + (parameterize* (list EXTENSION ...) (lambda () BODY ...))))) + +(define (parameterize* new-bindings thunk) + (fluid-let + ((bindings + (let loop ((new new-bindings)) + (if (null? new) + bindings + (if (and (pair? new) + (pair? (car new))) + (let ((p (caar new)) + (v (cdar new))) + (cons (if (parameter? p) + (cons p ((parameter-converter p) v)) + (let ((p* (error:wrong-type-argument + p "parameter" 'parameterize*))) + (cons p* ((parameter-converter p*) v)))) + (loop (cdr new)))) + (error:wrong-type-argument + new-bindings "alist" 'parameterize*)))))) + (thunk))) \ No newline at end of file diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index 47b1729bc..c93e503f8 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -4504,6 +4504,25 @@ USA. translate-to-state-point) (initialization (initialize-package!))) +(define-package (runtime dynamic) + (files "dynamic") + (parent (runtime)) + (export () + fluid? + guarantee-fluid + make-fluid + fluid + set-fluid! + let-fluid + let-fluids + parameter? + guarantee-parameter + make-parameter + set-parameter! + parameterize + parameter-converter + parameterize*)) + (define-package (runtime stream) (files "stream") (parent (runtime)) diff --git a/tests/check.scm b/tests/check.scm index 0805661a2..7f6294c50 100644 --- a/tests/check.scm +++ b/tests/check.scm @@ -43,6 +43,7 @@ USA. "microcode/test-lookup" "runtime/test-arith" ("runtime/test-char-set" (runtime character-set)) + "runtime/test-dynamic-env" "runtime/test-division" "runtime/test-ephemeron" "runtime/test-floenv" diff --git a/tests/runtime/test-dynamic-env.scm b/tests/runtime/test-dynamic-env.scm new file mode 100644 index 000000000..778085501 --- /dev/null +++ b/tests/runtime/test-dynamic-env.scm @@ -0,0 +1,129 @@ +#| -*-Scheme-*- + +Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, + 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, + 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Massachusetts + Institute of Technology + +This file is part of MIT/GNU Scheme. + +MIT/GNU Scheme is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or (at +your option) any later version. + +MIT/GNU Scheme is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You should have received a copy of the GNU General Public License +along with MIT/GNU Scheme; if not, write to the Free Software +Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, +USA. + +|# + +;;;; Tests of the dynamic environment + +(declare (usual-integrations)) + +(define-test 'FLUIDS + (lambda () + (let ((f (make-fluid 'f)) + (g (make-fluid 'g))) + (assert-eqv (fluid f) 'f) + (assert-eqv (let-fluid f 'x (lambda () (fluid f))) 'x) + (assert-eqv (fluid f) 'f) + (assert-equal (let-fluids f 'h g 'i + (lambda () + (cons (fluid f) (fluid g)))) + '(h . i)) + (assert-equal (cons (fluid f) (fluid g)) + '(f . g))))) + +(define-test 'PARAMETERS + (lambda () + (let ((p (make-parameter 1)) + (q (make-parameter 2 (lambda (v) + (if (not (integer? v)) + (error:wrong-type-argument v "an integer" + 'PARAMETER-Q) + v))))) + (assert-eqv (p) 1) + (assert-equal (parameterize ((p "7") (q 9)) (cons (p) (q))) + '("7" . 9)) + (assert-equal (cons (p) (q)) + '(1 . 2)) + (assert-error (lambda () (parameterize ((q "7")) (q))) + (list condition-type:wrong-type-argument))))) + +;; From node "Dynamic Binding" in doc/ref-manual/special-forms.texi: +(define (complicated-dynamic-binding) + (let ((variable (make-fluid 1)) + (inside-continuation)) + (write-line (fluid variable)) + (call-with-current-continuation + (lambda (outside-continuation) + (let-fluid variable 2 + (lambda () + (write-line (fluid variable)) + (set-fluid! variable 3) + (call-with-current-continuation + (lambda (k) + (set! inside-continuation k) + (outside-continuation #t))) + (write-line (fluid variable)) + (set! inside-continuation #f))))) + (write-line (fluid variable)) + (if inside-continuation + (begin + (set-fluid! variable 4) + (inside-continuation #f))))) + +(define-test 'COMPLICATED-DYNAMIC-BINDING + (lambda () + (assert-equal (call-with-output-string + (lambda (port) + (with-output-to-port port complicated-dynamic-binding))) + "1 +2 +1 +3 +4 +"))) + +;; This time with a parameter. +(define (complicated-dynamic-parameter) + (let ((variable (make-parameter 1)) + (inside-continuation)) + (write-line (variable)) + (call-with-current-continuation + (lambda (outside-continuation) + (parameterize ((variable 2)) + (write-line (variable)) + (set-parameter! variable 3) + (call-with-current-continuation + (lambda (k) + (set! inside-continuation k) + (outside-continuation #t))) + (write-line (variable)) + (set! inside-continuation #f)))) + (write-line (variable)) + (if inside-continuation + (begin + (set-parameter! variable 4) + (inside-continuation #f))))) + +(define-test 'COMPLICATED-DYNAMIC-PARAMETER + (lambda () + (assert-equal + (call-with-output-string + (lambda (port) + (with-output-to-port port complicated-dynamic-parameter))) + "1 +2 +1 +3 +4 +"))) \ No newline at end of file