~ chicken-core (chicken-5) de3731bd8b0fef528a1d2d0ebfb6af2e65dfa71e

commit de3731bd8b0fef528a1d2d0ebfb6af2e65dfa71e
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Wed Apr 13 06:14:45 2011 -0400
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Wed Apr 13 06:14:45 2011 -0400

    proper environment switching with ,m (reported by ckeen)

diff --git a/csi.scm b/csi.scm
index 705e6beb..6527e2d3 100644
--- a/csi.scm
+++ b/csi.scm
@@ -428,7 +428,7 @@ EOF
    (lambda ()
      (let ((name (read)))
        (cond ((not name)
-	      (##sys#current-module #f)
+	      (##sys#switch-module #f)
 	      (printf "; resetting current module to toplevel~%"))
 	     ((string? name)
 	      (set! name (##sys#string->symbol name)))
@@ -436,7 +436,7 @@ EOF
 	      (printf "invalid module name `~a'~%" name))
 	     ((##sys#find-module (##sys#resolve-module-name name #f) #f) =>
 	      (lambda (m)
-		(##sys#current-module m)
+		(##sys#switch-module m)
 		(printf "; switching current module to `~a'~%" name)))
 	     (else
 	      (printf "undefined module `~a'~%" name))))))
diff --git a/modules.scm b/modules.scm
index d60560e2..3c190e77 100644
--- a/modules.scm
+++ b/modules.scm
@@ -68,12 +68,13 @@
 	module-meta-import-forms set-module-meta-import-forms!
 	module-exist-list set-module-exist-list!
 	module-meta-expressions set-module-meta-expressions!
-	module-defined-syntax-list set-module-defined-syntax-list!))
+	module-defined-syntax-list set-module-defined-syntax-list!
+	module-saved-environments set-module-saved-environments!))
 
 (define-record-type module
   (%make-module name export-list defined-list exist-list defined-syntax-list
 		undefined-list import-forms meta-import-forms meta-expressions 
-		vexports sexports) 
+		vexports sexports saved-environments) 
   module?
   (name module-name)			; SYMBOL
   (export-list module-export-list set-module-export-list!) ; (SYMBOL | (SYMBOL ...) ...)
@@ -85,7 +86,8 @@
   (meta-import-forms module-meta-import-forms set-module-meta-import-forms!)	    ; (SPEC ...)
   (meta-expressions module-meta-expressions set-module-meta-expressions!) ; (EXP ...)
   (vexports module-vexports set-module-vexports!)	      ; ((SYMBOL . SYMBOL) ...)
-  (sexports module-sexports set-module-sexports!) )	      ; ((SYMBOL SE TRANSFORMER) ...)
+  (sexports module-sexports set-module-sexports!)	      ; ((SYMBOL SE TRANSFORMER) ...)
+  (saved-environments module-saved-environments set-module-saved-environments!)) ; for csi's ",m" command, holds (<env> . <macroenv>)
 
 (define ##sys#module-name module-name)
 
@@ -96,7 +98,7 @@
    (module-sexports m)))
 
 (define (make-module name explist vexports sexports)
-  (%make-module name explist '() '() '() '() '() '() '() vexports sexports))
+  (%make-module name explist '() '() '() '() '() '() '() vexports sexports #f))
 
 (define (##sys#register-module-alias alias name)
   (##sys#module-alias-environment
@@ -124,6 +126,21 @@
 	(err (error loc "module not found" name))
 	(else #f)))
 
+(define ##sys#switch-module
+  (let ((saved-default-envs #f))
+    (lambda (mod)
+      (let ((now (cons (##sys#current-environment) (##sys#macro-environment))))
+	(cond ((##sys#current-module) =>
+	       (lambda (m)
+		 (set-module-saved-environments! m now)))
+	      (else 
+	       (set! saved-default-envs now)))
+	(let ((saved (if mod (module-saved-environments mod) saved-default-envs)))
+	  (when saved
+	    (##sys#current-environment (car saved))
+	    (##sys#macro-environment (cdr saved))
+	    (##sys#current-module mod)))))))
+
 (define (##sys#toplevel-definition-hook sym mod exp val) #f)
 
 (define (##sys#register-meta-expression exp)
@@ -484,7 +501,11 @@
 		(VEXPORTS: ,@(map-se vexports))
 		(SEXPORTS: ,@(map-se sexports))))
 	  (set-module-vexports! mod vexports)
-	  (set-module-sexports! mod sexports))))))
+	  (set-module-sexports! mod sexports)
+	  (set-module-saved-environments!
+	   mod
+	   (cons (##sys#current-environment)
+		 (##sys#macro-environment))))))))
 
 (define ##sys#module-table '())