49 lines
1.4 KiB
Scheme
49 lines
1.4 KiB
Scheme
#!r6rs
|
|
;; Copyright 2009 Derick Eddington. My MIT-style license is in the file named
|
|
;; LICENSE from the original collection this file is distributed with.
|
|
|
|
;; Fall-back library in case the host Scheme system does not provide SRFI-39.
|
|
|
|
(library (srfi :39 parameters)
|
|
(export
|
|
make-parameter
|
|
parameterize)
|
|
(import
|
|
(rnrs))
|
|
|
|
(define make-parameter
|
|
(case-lambda
|
|
((val) (make-parameter val values))
|
|
((val guard)
|
|
(unless (procedure? guard)
|
|
(assertion-violation 'make-parameter "not a procedure" guard))
|
|
(let ((p (case-lambda
|
|
(() val)
|
|
((x) (set! val (guard x))))))
|
|
(p val)
|
|
p))))
|
|
|
|
(define-syntax parameterize
|
|
;; Derived from Ikarus's implementation of parameterize.
|
|
(lambda (stx)
|
|
(syntax-case stx ()
|
|
((_ () b0 b ...)
|
|
#'(let () b0 b ...))
|
|
((_ ((p e) ...) b0 b ...)
|
|
(with-syntax (((tp ...) (generate-temporaries #'(p ...)))
|
|
((te ...) (generate-temporaries #'(e ...))))
|
|
#'(let ((tp p) ...
|
|
(te e) ...)
|
|
(let ((swap (lambda ()
|
|
(let ((t (tp)))
|
|
(tp te)
|
|
(set! te t))
|
|
...)))
|
|
(dynamic-wind
|
|
swap
|
|
(lambda () b0 b ...)
|
|
swap))))))))
|
|
|
|
)
|
|
|