~ 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