~ chicken-r7rs (master) 4f60b8d9abb0cab6ac7dd363b9f3c229218821fb
commit 4f60b8d9abb0cab6ac7dd363b9f3c229218821fb
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Tue Jan 7 02:25:45 2014 +0000
Commit: Evan Hanson <evhan@foldling.org>
CommitDate: Tue Jan 7 02:25:45 2014 +0000
Ensure tmp mod is removed
diff --git a/scheme.eval.scm b/scheme.eval.scm
index b96a9d7..f753d12 100644
--- a/scheme.eval.scm
+++ b/scheme.eval.scm
@@ -16,18 +16,24 @@
(define (environment . specs)
(let ((name (gensym "environment-module-")))
- ;; create module...
- (%eval `(module ,name ()
- ,@(map (lambda (spec)
- `(import ,(fixup-import/export-spec spec 'environment)))
- specs)))
- (let ((mod (##sys#find-module name)))
- ;; ...and remove it right away
- (set! ##sys#module-table (##sys#delq mod ##sys#module-table))
- (##sys#make-structure 'environment
- name
- (let ((env (##sys#slot mod 13)))
- (append (car env) (cdr env))) ; combine env and syntax bindings
- #t))))
+ (define (delmod)
+ (and-let* ((modp (assq name ##sys#module-table)))
+ (set! ##sys#module-table (##sys#delq modp ##sys#module-table))))
+ (dynamic-wind
+ void
+ (lambda ()
+ ;; create module...
+ (%eval `(module ,name ()
+ ,@(map (lambda (spec)
+ `(import ,(fixup-import/export-spec spec 'environment)))
+ specs)))
+ (let ((mod (##sys#find-module name)))
+ (##sys#make-structure 'environment
+ name
+ (let ((env (##sys#slot mod 13)))
+ (append (car env) (cdr env))) ; combine env and syntax bindings
+ #t)))
+ ;; ...and remove it right away
+ delmod)))
)
Trap