diff options
author | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:29 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:29 -0800 |
commit | 8466d8cfa486fb30d1755c4261b781135083787b (patch) | |
tree | c8c12c67246f543c3cc4f64d1c07e003cb1d45ae /dynamic.scm | |
parent | 87b82b5822ca54228cfa6df29be3ad9d4bc47d16 (diff) | |
download | slib-8466d8cfa486fb30d1755c4261b781135083787b.tar.gz slib-8466d8cfa486fb30d1755c4261b781135083787b.zip |
Import Upstream version 3a1upstream/3a1
Diffstat (limited to 'dynamic.scm')
-rw-r--r-- | dynamic.scm | 10 |
1 files changed, 6 insertions, 4 deletions
diff --git a/dynamic.scm b/dynamic.scm index 937f93e..3bdd037 100644 --- a/dynamic.scm +++ b/dynamic.scm @@ -26,21 +26,23 @@ *current-dynamic-environment*))) (define dynamic-rtd (make-record-type "dynamic" '())) +;@ (define make-dynamic (let ((dynamic-constructor (record-constructor dynamic-rtd))) (lambda (obj) (let ((dynamic (dynamic-constructor))) (extend-current-dynamic-environment dynamic obj) dynamic)))) - +;@ (define dynamic? (record-predicate dynamic-rtd)) + (define (guarantee-dynamic dynamic) (or (dynamic? dynamic) (slib:error "Not a dynamic" dynamic))) (define dynamic:errmsg "No value defined for this dynamic in the current dynamic environment") - +;@ (define (dynamic-ref dynamic) (guarantee-dynamic dynamic) (let loop ((env *current-dynamic-environment*)) @@ -50,7 +52,7 @@ (dynamic-environment:value env)) (else (loop (dynamic-environment:parent env)))))) - +;@ (define (dynamic-set! dynamic obj) (guarantee-dynamic dynamic) (let loop ((env *current-dynamic-environment*)) @@ -60,7 +62,7 @@ (dynamic-environment:set-value! env obj)) (else (loop (dynamic-environment:parent env)))))) - +;@ (define (call-with-dynamic-binding dynamic obj thunk) (let ((out-thunk-env #f) (in-thunk-env (make-dynamic-environment |