mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-19 13:49:17 +02:00
29 lines
1.2 KiB
Scheme
29 lines
1.2 KiB
Scheme
;; param.scm -- SRFI-39 parameters
|
|
;; Copyright (c) 2010 Alex Shinn. All rights reserved.
|
|
;; BSD-style license: http://synthcode.com/license.txt
|
|
|
|
(define (parameter-convert param value)
|
|
(let ((proc (parameter-converter param)))
|
|
(if (procedure? proc)
|
|
(proc value)
|
|
value)))
|
|
|
|
(define (make-parameter init . o)
|
|
(let ((conv (and (pair? o) (car o))))
|
|
(%make-parameter (if conv (conv init) init) conv)))
|
|
|
|
(define-syntax parameterize
|
|
(syntax-rules ()
|
|
((parameterize ("step") old cons-new ((param value ptmp vtmp) ...) () body)
|
|
(let ((ptmp param) ...)
|
|
(let ((vtmp (parameter-convert ptmp value)) ...)
|
|
(let ((old (thread-parameters)))
|
|
(let ((new cons-new))
|
|
(dynamic-wind
|
|
(lambda () (thread-parameters-set! new))
|
|
(lambda () . body)
|
|
(lambda () (thread-parameters-set! old))))))))
|
|
((parameterize ("step") old cons-new args ((param value) . rest) body)
|
|
(parameterize ("step") old (cons (cons ptmp vtmp) cons-new) ((param value ptmp vtmp) . args) rest body))
|
|
((parameterize ((param value) ...) . body)
|
|
(parameterize ("step") old (thread-parameters) () ((param value) ...) body))))
|