fun times pasted by megane on Thu Jul 19 09:50:57 2018

Error: (map) bad argument type - not a proper list: (((syntax-rules (((syntax-rules (((syntax-rules (((syntax-rules (((syntax-rules (((syntax-rules (((syntax-rules (((syntax-rules (((syntax-rules (((syntax-rules (((syntax-rules (((syntax-rules (((syntax-rules (((syntax-rules (((syntax-rules (((syntax-rules (((syntax-rules (((syntax-rules (((syntax-rules (((syntax-rules (((syntax-rules (((syntax-rules (((syntax-rules (((syntax-rules (((syntax-rule...

	Call history:

	library.scm:2289: body3899	  
	library.scm:2291: assign	  
	library.scm:3447: current-print-length53155316	  
	library.scm:2289: body3899	  
	library.scm:2291: assign	  
	library.scm:1694: ##sys#dynamic-unwind	  
	library.scm:3924: ##sys#print	  
	library.scm:3187: case-sensitive	  
	library.scm:3188: keyword-style	  
	library.scm:3189: ##sys#print-length-limit	  
	library.scm:3296: outchr	  
	library.scm:3187: g5024	  
	library.scm:3925: print-call-chain	  
	library.scm:3880: ##sys#get-call-chain	  
	library.scm:3832: ##sys#make-vector	  
	library.scm:1370: ##sys#allocate-vector	  	<--

example of compile options:
chicken  expand.scm -optimize-level 0 -debug-level 2 -include-path . -include-path ./ -ignore-repository -feature chicken-bootstrap -feature debugbuild -verbose -debug-info -specialize -types ./types.db   -explicit-use  -output-file expand.c
gcc -fno-strict-aliasing -fwrapv -DHAVE_CHICKEN_CONFIG_H -DC_ENABLE_PTABLES -c -g -Wall -Wno-unused  -DC_BUILDING_LIBCHICKEN expand.c -o expand-static.o -I. -I./

disappearing call chain pasted by megane on Thu Jul 19 09:58:18 2018

(error "foo")
 -->
 Error: foo

	Call history:

	library.scm:3447: print-exit53135314	  
	library.scm:2289: body3899	  
	library.scm:2291: assign	  
	library.scm:3447: current-print-length53155316	  
	library.scm:2289: body3899	  
	library.scm:2291: assign	  
	library.scm:3924: ##sys#print	  
	library.scm:3187: case-sensitive	  
	library.scm:3188: keyword-style	  
	library.scm:3189: ##sys#print-length-limit	  
	library.scm:3296: outchr	  
	library.scm:3187: g5024	  
	library.scm:3925: print-call-chain	  
	library.scm:3880: ##sys#get-call-chain	  
	library.scm:3832: ##sys#make-vector	  
	library.scm:1370: ##sys#allocate-vector	  	<--


(print-call-chain)
(error "foo")
-->

	Call history:

	library.scm:2289: def-convert?3901	  
	library.scm:2289: def-set?3902	  
	library.scm:2289: body3899	  
	library.scm:2291: assign	  
	library.scm:2271: guard	  
	expand.scm:1545: ##sys#macro-environment	  
	expand.scm:1545: ##sys#fixup-macro-environment	  
	expand.scm:1533: se-for-each	  
	ses.scm:42: real-se?	  
	for-each	  
	library.scm:1589: p	  
	expand.scm:1540: merge-se	  
	ses.scm:22: print-call-chain	  
	library.scm:3880: ##sys#get-call-chain	  
	library.scm:3832: ##sys#make-vector	  
	library.scm:1370: ##sys#allocate-vector	  	<--

Error: foo

	Call history:

	library.scm:3447: print-exit53135314	  
	library.scm:2289: body3899	  
	library.scm:2291: assign	  
	library.scm:3447: current-print-length53155316	  
	library.scm:2289: body3899	  
	library.scm:2291: assign	  
	library.scm:3924: ##sys#print	  
	library.scm:3187: case-sensitive	  
	library.scm:3188: keyword-style	  
	library.scm:3189: ##sys#print-length-limit	  
	library.scm:3296: outchr	  
	library.scm:3187: g5024	  
	library.scm:3925: print-call-chain	  
	library.scm:3880: ##sys#get-call-chain	  
	library.scm:3832: ##sys#make-vector	  
	library.scm:1370: ##sys#allocate-vector	  	<--

ready to ship! added by megane on Sat Jul 21 19:52:33 2018

diff --git a/chicken-ffi-syntax.scm b/chicken-ffi-syntax.scm
index 6757b78..4816070 100644
--- a/chicken-ffi-syntax.scm
+++ b/chicken-ffi-syntax.scm
@@ -40,7 +40,7 @@
 
 
 (define ##sys#chicken-ffi-macro-environment
-  (let ((me0 (##sys#macro-environment)))
+  (let ((me0 (se-derive-new (##sys#macro-environment))))
 
 (##sys#extend-macro-environment
  'define-external
diff --git a/chicken-syntax.scm b/chicken-syntax.scm
index 11482bb..fc36b47 100644
--- a/chicken-syntax.scm
+++ b/chicken-syntax.scm
@@ -37,11 +37,12 @@
 
 (##sys#provide 'chicken-syntax)
 
+(include "ses.scm")
 
 ;;; Non-standard macros:
 
 (define ##sys#chicken-macro-environment
-  (let ((me0 (##sys#macro-environment)))
+  (let ((me0 (se-derive-new (##sys#macro-environment))))
 
 (##sys#extend-macro-environment
  'define-constant
@@ -1233,10 +1234,10 @@
 	   (##sys#check-syntax 'define-specialization x '(_ (variable . #(_ 0)) _ . #(_ 0 1)))
 	   (let* ((head (cadr x))
 		  (name (car head))
-		  (gname (##sys#globalize name '())) ;XXX correct?
+		  (gname (##sys#globalize name (make-se))) ;XXX correct?
 		  (args (cdr head))
 		  (alias (gensym name))
-		  (galias (##sys#globalize alias '())) ;XXX and this?
+		  (galias (##sys#globalize alias (make-se))) ;XXX and this?
 		  (rtypes (and (pair? (cdddr x)) (##sys#strip-syntax (caddr x))))
 		  (%define (r 'define))
 		  (body (if rtypes (cadddr x) (caddr x))))
diff --git a/compiler-syntax.scm b/compiler-syntax.scm
index 9e88947..8186b9e 100644
--- a/compiler-syntax.scm
+++ b/compiler-syntax.scm
@@ -30,6 +30,7 @@
 
 (include "compiler-namespace")
 (include "tweaks.scm")
+(include "ses.scm")
 
 
 ;;; Compiler macros (that operate in the expansion phase)
@@ -46,7 +47,7 @@
   (let ((t (cons (##sys#ensure-transformer
 		  (##sys#er-transformer transformer)
 		  (car names))
-		 (append se ##sys#default-macro-environment))))
+		 (se-append (make-se se) ##sys#default-macro-environment))))
     (for-each
      (lambda (name)
        (##sys#put! name '##compiler#compiler-syntax t) )
diff --git a/compiler.scm b/compiler.scm
index 44fd24e..f2867fb 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -270,6 +270,7 @@
 
 
 (include "compiler-namespace")
+(include "ses.scm")
 
 (define (d arg1 . more)
   (when (##sys#fudge 13)		; debug mode?
@@ -404,17 +405,9 @@
 ;;; Expand macros and canonicalize expressions:
 
 (define (canonicalize-expression exp)
-  (let ((compiler-syntax '()))
+  (let ((se-compiler-syntax '())) ; (id . old-compiler-syntax-entry)
 
-  (define (find-id id se)		; ignores macro bindings
-    (cond ((null? se) #f)
-	  ((and (eq? id (caar se)) (symbol? (cdar se))) (cdar se))
-	  (else (find-id id (cdr se)))))
-
-  (define (lookup id se)
-    (cond ((find-id id se))
-	  ((##sys#get id '##core#macro-alias))
-	  (else id)))
+    (define lookup se-rename)
 
   (define (macro-alias var se)
     (let ((alias (gensym var)))
@@ -493,6 +486,7 @@
 		 (print "\n;; END OF FILE"))))) ) )
 
   (define (walk x e se dest ldest h outer-ln)
+    (assert (real-se? se))
     (cond ((symbol? x)
 	   (cond ((keyword? x) `(quote ,x))
 		 ((memq x unlikely-variables)
@@ -684,7 +678,7 @@
 				(set-real-names! aliases vars)
 				(cond ((or (not dest) 
 					   ldest
-					   (assq dest se)) ; not global?
+					   (se-assq dest se)) ; not global?
 				       l)
 				      ((and emit-profile
 					    (or (eq? profiled-procedures 'all)
@@ -699,15 +693,15 @@
 				      (else l)))))))
 			
 			((##core#let-syntax)
-			 (let ((se2 (append
-				     (map (lambda (b)
-					    (list
-					     (car b)
-					     se
-					     (##sys#ensure-transformer
-					      (##sys#eval/meta (cadr b))
-					      (car b))))
-					  (cadr x) )
+			 (let ((se2 (se-append
+				     (make-se (map (lambda (b)
+						     (list
+						      (car b)
+						      se
+						      (##sys#ensure-transformer
+						       (##sys#eval/meta (cadr b))
+						       (car b))))
+						   (cadr x) ))
 				     se) ) )
 			   (walk
 			    (##sys#canonicalize-body (cddr x) se2 compiler-syntax-enabled)
@@ -715,16 +709,17 @@
 			    dest ldest h ln) ) )
 			       
 		       ((##core#letrec-syntax)
-			(let* ((ms (map (lambda (b)
-					  (list
-					   (car b)
-					   #f
-					   (##sys#ensure-transformer
-					    (##sys#eval/meta (cadr b))
-					    (car b))))
-					(cadr x) ) )
-			       (se2 (append ms se)) )
-			  (for-each 
+			(let* ((ms (make-se
+				    (map (lambda (b)
+					   (list
+					    (car b)
+					    #f
+					    (##sys#ensure-transformer
+					     (##sys#eval/meta (cadr b))
+					     (car b))))
+					 (cadr x) )) )
+			       (se2 (se-append ms se)) )
+			  (se-for-each 
 			   (lambda (sb)
 			     (set-car! (cdr sb) se2) )
 			   ms)
@@ -762,11 +757,12 @@
 			       (body (caddr x))
 			       (name (lookup var se)))
 			  (when body
-			    (set! compiler-syntax
-			      (alist-cons
-			       name
-			       (##sys#get name '##compiler#compiler-syntax)
-			       compiler-syntax)))
+			    (set! se-compiler-syntax
+				(cons
+				 (cons name
+				       (##sys#get name '##compiler#compiler-syntax))
+				 se-compiler-syntax)))
+			  (assert (valid-se? (##sys#current-environment)))
 			  (##sys#put! 
 			   name '##compiler#compiler-syntax
 			   (and body
@@ -856,14 +852,14 @@
 						   'module
 						   "invalid export syntax" exp name))))
 					 (##sys#strip-syntax (caddr x)))))
-			       (csyntax compiler-syntax))
+			       (csyntax se-compiler-syntax))
 			  (when (##sys#current-module)
 			    (##sys#syntax-error-hook
 			     'module "modules may not be nested" name))
 			  (let-values (((body mreg)
 					(parameterize ((##sys#current-module 
 							(##sys#register-module name exports) )
-						       (##sys#current-environment '())
+						       (##sys#current-environment (make-se))
 						       (##sys#macro-environment
 							##sys#initial-macro-environment)
 						       (##sys#module-alias-environment
@@ -924,10 +920,10 @@
 					   (##sys#current-meta-environment) #f #f h ln) )
 					mreg))
 				     body))))
-			      (do ((cs compiler-syntax (cdr cs)))
+			      (do ((cs se-compiler-syntax (cdr cs)))
 				  ((eq? cs csyntax))
 				(##sys#put! (caar cs) '##compiler#compiler-syntax (cdar cs)))
-			      (set! compiler-syntax csyntax)
+			      (set! se-compiler-syntax csyntax)
 			      body))))
 
 		       ((##core#loop-lambda) ;XXX is this really needed?
@@ -992,7 +988,7 @@
 					    (if ln (sprintf "(~a)" ln) "") ))
 					 (when undefine-shadowed-macros (##sys#undefine-macro! var) ) )
 					((and ##sys#notices-enabled
-					      (assq var (##sys#current-environment)))
+					      (se-assq var (##sys#current-environment)))
 					 (##sys#notice "assignment to imported value binding" var)))
 				  (when (keyword? var)
 				    (warning (sprintf "assignment to keyword `~S'" var) ))
@@ -1133,7 +1129,7 @@
 				      `((##core#set! ,alias ,init))
 				      '() )
 				,(if init (fifth x) (fourth x)) ) )
-			    e (alist-cons var alias se)
+			    e (se-cons var alias se)
 			    dest ldest h ln) ) )
 
 			((##core#define-inline)
@@ -1182,7 +1178,7 @@
 				       (lambda (id)
 					 (memq (lookup id se) e))))
 				    (cdr x) ) )
-			  e '() #f #f h ln) )
+			  e (make-se) #f #f h ln) )
 	     
 			((##core#foreign-callback-wrapper)
 			 (let-values ([(args lam) (split-at (cdr x) 4)])
@@ -2427,7 +2423,8 @@
 				   (else rest) ) ) )
 			   (fourth params) )
 		     (list (let ((body (transform (car subs) cvar capturedvars)))
-			     (if (pair? boxedvars)
+			     ;; TODO: HACK should be (pair? boxedvars)
+			     (if (pair? boxedaliases)
 				 (fold-right
 				  (lambda (alias val body)
 				    (make-node 'let (list alias) (list val body)))
diff --git a/defaults.make b/defaults.make
index d6ee531..9719409 100644
--- a/defaults.make
+++ b/defaults.make
@@ -239,7 +239,7 @@ CSI ?= csi$(EXE)
 
 # Scheme compiler flags
 
-CHICKEN_OPTIONS = -optimize-level 2 -include-path . -include-path $(SRCDIR) -inline -ignore-repository -feature chicken-bootstrap
+CHICKEN_OPTIONS = -optimize-level 0 -debug-level 2 -include-path . -include-path $(SRCDIR) -ignore-repository -feature chicken-bootstrap
 ifdef DEBUGBUILD
 CHICKEN_OPTIONS += -feature debugbuild -verbose -debug-info
 else
@@ -249,16 +249,16 @@ ifndef BUILDING_CHICKEN_BOOT
 CHICKEN_OPTIONS += -specialize -types $(SRCDIR)types.db 
 endif
 CHICKEN_OPTIONS += $(EXTRA_CHICKEN_OPTIONS)
-CHICKEN_LIBRARY_OPTIONS = $(CHICKEN_OPTIONS) -explicit-use -no-trace
-CHICKEN_PROGRAM_OPTIONS = $(CHICKEN_OPTIONS) -no-lambda-info -local
-CHICKEN_COMPILER_OPTIONS = $(CHICKEN_OPTIONS) -no-lambda-info -extend private-namespace.scm
+CHICKEN_LIBRARY_OPTIONS = $(CHICKEN_OPTIONS) -explicit-use # -no-trace
+CHICKEN_PROGRAM_OPTIONS = $(CHICKEN_OPTIONS) # -no-lambda-info -local
+CHICKEN_COMPILER_OPTIONS = $(CHICKEN_OPTIONS) -extend private-namespace.scm # -no-lambda-info
 CHICKEN_DYNAMIC_OPTIONS = $(CHICKEN_OPTIONS) -feature chicken-compile-shared -dynamic
-CHICKEN_IMPORT_LIBRARY_OPTIONS = $(CHICKEN_DYNAMIC_OPTIONS) -no-trace
+CHICKEN_IMPORT_LIBRARY_OPTIONS = $(CHICKEN_DYNAMIC_OPTIONS) # -no-trace
 
-ifndef DEBUGBUILD
-CHICKEN_PROGRAM_OPTIONS += -no-trace
-CHICKEN_COMPILER_OPTIONS += -no-trace
-endif
+# ifndef DEBUGBUILD
+# CHICKEN_PROGRAM_OPTIONS += -no-trace
+# CHICKEN_COMPILER_OPTIONS += -no-trace
+# endif
 
 CHICKEN_PROGRAM_OPTIONS += $(if $(PROFILE_OBJECTS),-profile)
 
diff --git a/eval.scm b/eval.scm
index e481749..c02a846 100644
--- a/eval.scm
+++ b/eval.scm
@@ -32,7 +32,6 @@
   (not inline ##sys#repl-read-hook ##sys#repl-print-hook 
        ##sys#read-prompt-hook ##sys#alias-global-hook ##sys#user-read-hook
        ##sys#syntax-error-hook))
-
 #>
 #ifndef C_INSTALL_EGG_HOME
 # define C_INSTALL_EGG_HOME    "."
@@ -50,6 +49,7 @@
 <#
 
 (include "common-declarations.scm")
+(include "ses.scm")
 
 (define-syntax d (syntax-rules () ((_ . _) (void))))
 
@@ -193,37 +193,30 @@
 (define ##sys#unbound-in-eval #f)
 (define ##sys#eval-debug-level (make-parameter 1))
 
+(define (se-rename-lookup var0 e se)
+  (define (posq x lst)
+    (let loop ([lst lst] [i 0])
+      (cond [(null? lst) #f]
+	    [(eq? x (car lst)) i]
+	    [else (loop (cdr lst) (add1 i))] ) ) )
+  (let ((var (se-rename var0 se)))
+    ;; (d `(LOOKUP/EVAL: ,var0 ,var ,e ,(map (lambda (x) (car x)) se)))
+    ;; (print `(LOOKUP/EVAL: ,var0 ,var ,e ,(se-identifiers se)))
+    (let loop ((envs e) (ei 0))
+      (cond ((null? envs) (values #f var))
+	    ((posq var (##sys#slot envs 0)) => (lambda (p) (values ei p)))
+	    (else (loop (##sys#slot envs 1) (fx+ ei 1))) ) ) ))
+
 (define ##sys#compile-to-closure
   (let ([write write]
 	[reverse reverse]
 	[with-input-from-file with-input-from-file]
 	[unbound (##sys#slot '##sys#arbitrary-unbound-symbol 0)]
-	[display display] )
+	[display display]
+	[rename se-rename]
+	[lookup se-rename-lookup])
     (lambda (exp env se #!optional cntr evalenv static)
-
-      (define (find-id id se)		; ignores macro bindings
-	(cond ((null? se) #f)
-	      ((and (eq? id (caar se)) (symbol? (cdar se))) (cdar se))
-	      (else (find-id id (cdr se)))))
-
-      (define (rename var se)
-	(cond ((find-id var se))
-	      ((##sys#get var '##core#macro-alias))
-	      (else var)))
-
-      (define (lookup var0 e se)
-	(let ((var (rename var0 se)))
-	  (d `(LOOKUP/EVAL: ,var0 ,var ,e ,(map (lambda (x) (car x)) se)))
-	  (let loop ((envs e) (ei 0))
-	    (cond ((null? envs) (values #f var))
-		  ((posq var (##sys#slot envs 0)) => (lambda (p) (values ei p)))
-		  (else (loop (##sys#slot envs 1) (fx+ ei 1))) ) ) ))
-
-      (define (posq x lst)
-	(let loop ((lst lst) (i 0))
-	  (cond ((null? lst) #f)
-		((eq? x (##sys#slot lst 0)) i)
-		(else (loop (##sys#slot lst 1) (fx+ i 1))) ) ) )
+      (assert (valid-se? se))
 
       (define (emit-trace-info tf info cntr e v) 
 	(when tf
@@ -245,12 +238,13 @@
 	(##sys#eval-decorator p ll h cntr) )
 
       (define (compile x e h tf cntr se)
+	(assert (real-se? se))
 	(cond ((keyword? x) (lambda v x))
 	      ((symbol? x)
 	       (receive (i j) (lookup x e se)
 		 (cond ((not i)
 			(let ((var (cond ((not (symbol? j)) x) ; syntax?
-                                         ((not (assq x se))
+                                         ((not (se-assq x se))
                                           (and (not static)
                                                (##sys#alias-global-hook j #f cntr)))
                                          (else (or (##sys#get j '##core#primitive) j)))))
@@ -369,11 +363,11 @@
 			      (let ((val (compile (caddr x) e var tf cntr se)))
 				(cond [(not i)
 				       (when ##sys#notices-enabled
-					 (and-let* ((a (assq var (##sys#current-environment)))
+					 (and-let* ((a (se-assq var (##sys#current-environment)))
 						    ((symbol? (cdr a))))
 					   (##sys#notice "assignment to imported value binding" var)))
 				       (let ((var
-					      (if (not (assq x se)) ;XXX this looks wrong
+					      (if (not (se-assq x se)) ;XXX this looks wrong
 						  (and (not static)
 						       (##sys#alias-global-hook j #t cntr))
 						  (or (##sys#get j '##core#primitive) j))))
@@ -562,34 +556,36 @@
 					   info h cntr) ) ) ] ) ) ) ) ) ]
 
 			 ((##core#let-syntax)
-			  (let ((se2 (append
-				      (map (lambda (b)
-					     (list
-					      (car b)
-					      se
-					      (##sys#ensure-transformer
-					       (##sys#eval/meta (cadr b))
-					       (car b))))
-					   (cadr x) ) 
+			  (let ((se2 (se-append
+				      (make-se
+				       (map (lambda (b)
+					      (list
+					       (car b)
+					       se
+					       (##sys#ensure-transformer
+						(##sys#eval/meta (cadr b))
+						(car b))))
+					    (cadr x) )) 
 				      se) ) )
 			    (compile
 			     (##sys#canonicalize-body (cddr x) se2 #f)
 			     e #f tf cntr se2)))
 			       
 			 ((##core#letrec-syntax)
-			  (let* ((ms (map (lambda (b)
-					    (list
-					     (car b)
-					     #f
-					     (##sys#ensure-transformer
-					      (##sys#eval/meta (cadr b))
-					      (car b))))
-					  (cadr x) ) )
-				 (se2 (append ms se)) )
-			    (for-each 
+			  (let* ((ms (make-se
+				      (map (lambda (b)
+					     (list
+					      (car b)
+					      #f
+					      (##sys#ensure-transformer
+					       (##sys#eval/meta (cadr b))
+					       (car b))))
+					   (cadr x) )) )
+				 (se2 (se-append ms se)) )
+			    (se-for-each
 			     (lambda (sb)
 			       (set-car! (cdr sb) se2) )
-			     ms) 
+			     ms)
 			    (compile
 			     (##sys#canonicalize-body (cddr x) se2 #f)
 			     e #f tf cntr se2)))
@@ -598,7 +594,7 @@
 			  (let* ((var (cadr x))
 				 (body (caddr x))
 				 (name (rename var se)))
-			    (when (and static (not (assq var se)))
+			    (when (and static (not (se-assq var se)))
 			      (##sys#error 'eval "environment is not mutable" evalenv var))
 			    (##sys#register-syntax-export 
 			     name (##sys#current-module)
@@ -654,9 +650,9 @@
 			      (##sys#syntax-error-hook 'module "modules may not be nested" name))
 			    (parameterize ((##sys#current-module 
 					    (##sys#register-module name exports))
-					   (##sys#current-environment '())
+					   (##sys#current-environment (make-se))
 					   (##sys#macro-environment 
-					    ##sys#initial-macro-environment)
+					    (se-derive-new ##sys#initial-macro-environment))
 					   (##sys#module-alias-environment
 					    (##sys#module-alias-environment)))
 			      (##sys#with-property-restore
@@ -860,7 +856,7 @@
 	      (##sys#check-structure env 'environment 'eval)
 	      (let ((se2 (##sys#slot env 2)))
 		((if se2		; not interaction-environment?
-		     (parameterize ((##sys#macro-environment '()))
+		     (parameterize ((##sys#macro-environment (make-se)))
 		       (##sys#compile-to-closure x '() se2 #f env (##sys#slot env 3)))
 		     (##sys#compile-to-closure x '() se #f env #f))
 		 '() ) ) )
@@ -1424,24 +1420,19 @@
        (r4n (module-environment 'r4rs-null 'null-environment/4))
        (r5n (module-environment 'r5rs-null 'null-environment/5)))
   (define (strip se)
-    (foldr
-     (lambda (s r)
-       (if (memq (car s)
-		 '(import 
-		    require-extension 
-		    require-extension-for-syntax
-		    require-library 
-		    begin-for-syntax
-		    export 
-		    module
-		    cond-expand
-		    syntax
-		    reexport 
-		    import-for-syntax))
-	   r
-	   (cons s r)))
-     '()
-     se))
+    (let ([ids '(import 
+		 require-extension 
+		 require-extension-for-syntax
+		 require-library 
+		 begin-for-syntax
+		 export 
+		 module
+		 cond-expand
+		 syntax
+		 reexport 
+		 import-for-syntax)])
+      (receive (_missing se2) (se-derive-except ids se)
+	se2)))
   ;; Strip non-std syntax from SEs
   (##sys#setslot r4s 2 (strip (##sys#slot r4s 2)))
   (##sys#setslot r4n 2 (strip (##sys#slot r4n 2)))
diff --git a/expand.scm b/expand.scm
index 9e73e09..3c677a4 100644
--- a/expand.scm
+++ b/expand.scm
@@ -40,6 +40,7 @@
        ##sys#toplevel-definition-hook))
 
 (include "common-declarations.scm")
+(include "ses.scm")
 
 (define-syntax d (syntax-rules () ((_ . _) (void))))
 
@@ -70,17 +71,12 @@
 
 ;;; Syntactic environments
 
-(define ##sys#current-environment (make-parameter '()))
-(define ##sys#current-meta-environment (make-parameter '()))
+(define ##sys#current-environment (make-parameter (make-se)))
+(define ##sys#current-meta-environment (make-parameter (make-se)))
 
 ;;XXX should this be in eval.scm?
 (define ##sys#active-eval-environment (make-parameter ##sys#current-environment))
 
-(define (lookup id se)
-  (cond ((##core#inline "C_u_i_assq" id se) => cdr)
-	((getp id '##core#macro-alias))
-	(else #f)))
-
 (define (macro-alias var se)
   (if (or (##sys#qualified-symbol? var)
 	  (let* ((str (##sys#slot var 1))
@@ -130,41 +126,41 @@
 (define (##sys#extend-se se vars #!optional (aliases (map gensym vars)))
   (for-each
    (lambda (alias sym)
+     ;; (print "extend-se " sym " -> " alias)
      (let ((original-real-name (getp sym '##core#real-name)))
        (putp alias '##core#real-name (or original-real-name sym))))
    aliases vars)
-  (append (map (lambda (x y) (cons x y)) vars aliases) se)) ; inline cons
+  (se-append (make-se (map (lambda (x y) (cons x y)) vars aliases)) se)) ; inline cons
 
 
 ;;; resolve symbol to global name
 
 (define (##sys#globalize sym se)
+  (assert (real-se? se))
   (let loop1 ((sym sym))
     (cond ((not (symbol? sym)) sym)
 	  ((getp sym '##core#macro-alias) =>
 	   (lambda (a) (if (symbol? a) (loop1 a) sym)))
 	  (else
-	   (let loop ((se se))		; ignores syntax bindings
-	     (cond ((null? se)
-		    (##sys#alias-global-hook sym #t #f)) ;XXX could hint at decl (3rd arg)
-		   ((and (eq? sym (caar se)) (symbol? (cdar se))) (cdar se))
-		   (else (loop (cdr se)))))))))
+	   (find-id/alias sym se)))))
 
 
 ;;; Macro handling
 
-(define ##sys#macro-environment (make-parameter '()))
-(define ##sys#chicken-macro-environment '()) ; used later in chicken.import.scm
-(define ##sys#chicken-ffi-macro-environment '()) ; used later in foreign.import.scm
+(define ##sys#macro-environment (make-parameter (make-se)))
+(define ##sys#chicken-macro-environment (make-se)) ; used later in chicken.import.scm
+(define ##sys#chicken-ffi-macro-environment (make-se)) ; used later in foreign.import.scm
 
 (define (##sys#ensure-transformer t #!optional loc)
   (cond ((procedure? t) (##sys#slot (##sys#er-transformer t) 1)) ; DEPRECATED
 	((##sys#structure? t 'transformer) (##sys#slot t 1))
 	(else (##sys#error loc "expected syntax-transformer, but got" t))))
 
-(define (##sys#extend-macro-environment name se transformer)
+(define (##sys#extend-macro-environment name se* transformer)
   (let ((me (##sys#macro-environment))
+	(se (if (real-se? se*) se* (make-se se*)))
 	(handler (##sys#ensure-transformer transformer name)))
+    (assert (valid-se? se))
     (cond ((lookup name me) =>
 	   (lambda (a)
 	     (set-car! a se)
@@ -173,7 +169,7 @@
 	  (else 
 	   (let ((data (list se handler)))
 	     (##sys#macro-environment
-	      (cons (cons name data) me))
+	      (se-cons name data me))
 	     data)))))
 
 (define (##sys#copy-macro old new)
@@ -201,7 +197,9 @@
 ;; The basic macro-expander
 
 (define (##sys#expand-0 exp dse cs?)
-  (define (call-handler name handler exp se cs)
+  (assert (real-se? dse))
+  (assert (real-se? (##sys#macro-environment)))
+  (define (call-handler name handler exp se* cs)
     (dd "invoking macro: " name)
     (dd `(STATIC-SE: ,@(map-se se)))
     (handle-exceptions ex
@@ -231,20 +229,26 @@
 				 (cdr r) ) )
 			  (copy r) ) ) ) ) )
 	     ex) )
-      (let ((exp2
-	     (if cs
-		 ;; compiler-syntax may "fall through"
-		 (fluid-let ((##sys#syntax-rules-mismatch (lambda (input) exp))) ; a bit of a hack
-		   (handler exp se dse))
-		 (handler exp se dse))) )
-	(when (and (not cs) (eq? exp exp2))
-	  (##sys#syntax-error-hook
-	   (string-append
-	    "syntax transformer for `" (symbol->string name)
-	    "' returns original form, which would result in endless expansion")
-	   exp))
-	(dx `(,name ~~> ,exp2))
-	exp2)))
+	;; (print "call-handler " name " " handler "real: " (real-se? se*))
+	(let* ([se (if (real-se? se*) se* (make-se se*))]
+	       [_ (assert (valid-se? se))]
+	       (exp2
+		(if cs
+		    ;; compiler-syntax may "fall through"
+		    (fluid-let ((##sys#syntax-rules-mismatch (lambda (input) exp))) ; a bit of a hack
+		      (handler exp se dse))
+		    (begin
+		      (assert (real-se? se))
+		      (assert (real-se? dse))
+		      (handler exp se dse)))) )
+	  (when (and (not cs) (eq? exp exp2))
+	    (##sys#syntax-error-hook
+	     (string-append
+	      "syntax transformer for `" (symbol->string name)
+	      "' returns original form, which would result in endless expansion")
+	     exp))
+	  (dx `(,name ~~> ,exp2))
+	  exp2)))
   (define (expand head exp mdef)
     (dd `(EXPAND: 
 	  ,head 
@@ -289,6 +293,7 @@
 			     [else (values exp #f)] ) ) ]
 		    ((and cs? (symbol? head2) (getp head2 '##compiler#compiler-syntax)) =>
 		     (lambda (cs)
+		       (assert (not (mangled-se? (cdr cs))))
 		       (let ((result (call-handler head (car cs) exp (cdr cs) #t)))
 			 (cond ((eq? result exp) (expand head exp head2))
 			       (else
@@ -307,6 +312,7 @@
 ;;; User-level macroexpansion
 
 (define (expand exp #!optional (se (##sys#current-environment)) cs?)
+  (assert (real-se? se))
   (let loop ((exp exp))
     (let-values (((exp2 m) (##sys#expand-0 exp se cs?)))
       (if m
@@ -448,17 +454,30 @@
   (##sys#decompose-lambda-list
    formals
    (lambda (vars argc rest)
-     (let ((aliases    (if (symbol? formals) '() (map gensym formals)))
-	   (rest-alias (if (not rest) '() (gensym rest))))
-       `(##sys#call-with-values
-	 (##core#lambda () ,expr)
-	 (##core#lambda
-	  ,(append aliases rest-alias)
-	  ,@(map (lambda (v a) `(##core#set! ,v ,a)) vars aliases)
-	  ,@(cond
-	      ((null? formals) '((##core#undefined)))
-	      ((null? rest-alias) '())
-	      (else `((##core#set! ,rest ,rest-alias))))))))))
+     (let* ((aliases    (if (symbol? formals) '() (map gensym vars)))
+	    (rest-alias (cond [(symbol? formals) (gensym formals)]
+			      [rest (car (reverse aliases))]
+			      [else '()])))
+       ;; (print "here " "formals: " formals " aliases: " aliases " rest " rest-alias (null? rest-alias))
+       (let ([r `(##sys#call-with-values
+		  (##core#lambda () ,expr)
+		  (##core#lambda
+		   ,(cond
+		     [(symbol? formals) rest-alias]
+		     [(and rest (null? (cdr vars))) rest-alias]
+		     [(null? aliases) aliases]
+		     [rest (let lp ([vs aliases])
+			     (if (null? (cdr vs))
+				 (car vs)
+				 (cons (car vs) (lp (cdr vs)))))]
+		     [else aliases])
+		   ,@(map (lambda (v a) `(##core#set! ,v ,a)) vars aliases)
+		   ,@(cond
+		      ((null? formals) '((##core#undefined)))
+		      ((null? rest-alias) '())
+		      (else `((##core#set! ,rest ,rest-alias))))))])
+	 ;; (print r)
+	 r)))))
 
 ;;; Expansion of bodies (and internal definitions)
 ;
@@ -470,6 +489,7 @@
 
 (define ##sys#canonicalize-body
   (lambda (body #!optional (se (##sys#current-environment)) cs?)
+    (assert (real-se? se))
     (define (comp s id)
       (let ((f (lookup id se)))
 	(or (eq? s f)
@@ -801,33 +821,35 @@
   (##sys#make-structure 
    'transformer
    (lambda (form se dse)
-     (let ((renv '()))	  ; keep rename-environment for this expansion
-       (assert (list? se) "not a list" se) ;XXX remove later
+     (let ((renv (make-se)))	  ; keep rename-environment for this expansion
+       (assert (real-se? se)) ;XXX remove later
        (define (rename sym)
+	 (assert (real-se? se)) ;XXX remove later
+	 (assert (real-se? renv))
 	 (cond ((pair? sym)
 		(cons (rename (car sym)) (rename (cdr sym))))
 	       ((vector? sym)
 		(list->vector (rename (vector->list sym))))
 	       ((not (symbol? sym)) sym)
-	       ((assq sym renv) => 
-		(lambda (a) 
+	       ((se-assq sym renv) => 
+		(lambda (a)
 		  (dd `(RENAME/RENV: ,sym --> ,(cdr a)))
 		  (cdr a)))
-	       ((assq sym se) =>
+	       ((se-assq sym se) =>
 		(lambda (a)
 		  (cond ((symbol? a)
 			 (dd `(RENAME/SE: ,sym --> ,a))
-			 (set! renv (cons (cons sym a) renv))
+			 (set! renv (se-cons sym a renv))
 			 a)
 			(else
 			 (let ((a2 (macro-alias sym se)))
 			   (dd `(RENAME/SE/MACRO: ,sym --> ,a2))
-			   (set! renv (cons (cons sym a2) renv))
+			   (set! renv (se-cons sym a2 renv))
 			   a2)))))
 	       (else
 		(let ((a (macro-alias sym se)))
 		  (dd `(RENAME: ,sym --> ,a))
-		  (set! renv (cons (cons sym a) renv))
+		  (set! renv (se-cons sym a renv))
 		  a))))
        (define (compare s1 s2)
 	 (let ((result
@@ -853,11 +875,11 @@
 				(cond ((symbol? ss2) 
 				       (eq? (or (getp ss1 '##core#primitive) ss1)
 					    (or (getp ss2 '##core#primitive) ss2)))
-				      ((assq ss1 (##sys#macro-environment)) =>
+				      ((se-assq ss1 (##sys#macro-environment)) =>
 				       (lambda (a) (eq? (cdr a) ss2)))
 				      (else #f) ) )
 			       ((symbol? ss2)
-				(cond ((assq ss2 (##sys#macro-environment)) =>
+				(cond ((se-assq ss2 (##sys#macro-environment)) =>
 				       (lambda (a) (eq? ss1 (cdr a))))
 				      (else #f)))
 			       (else (eq? ss1 ss2)))))
@@ -872,11 +894,7 @@
 		   r)
 	       ")")
 	   r))
-       (define (assq-reverse s l)
-	 (cond
-	  ((null? l) #f)
-	  ((eq? (cdar l) s) (car l))
-	  (else (assq-reverse s (cdr l)))))
+
        (define (mirror-rename sym)
 	 (cond ((pair? sym)
 		(cons (mirror-rename (car sym)) (mirror-rename (cdr sym))))
@@ -885,7 +903,7 @@
 	       ((not (symbol? sym)) sym)
 	       (else		 ; Code stolen from ##sys#strip-syntax
 		(let ((renamed (lookup sym se) ) )
-		  (cond ((assq-reverse sym renv) =>
+		  (cond ((se-assq-reverse sym renv) =>
 			 (lambda (a)
 			   (dd "REVERSING RENAME: " sym " --> " (car a)) (car a)))
 			((not renamed)
@@ -941,7 +959,7 @@
        #f #t 'reexport) ) )
 
 ;; contains only "import[-for-syntax]" and "reexport"
-(define ##sys#initial-macro-environment (##sys#macro-environment))
+(define ##sys#initial-macro-environment (se-derive-new (##sys#macro-environment)))
 
 (##sys#extend-macro-environment
  'lambda
@@ -1021,7 +1039,7 @@
 	       (##sys#check-syntax 'define-syntax head 'symbol)
 	       (##sys#check-syntax 'define-syntax body '#(_ 1))
                (let ((name (or (getp head '##core#macro-alias) head)))
-                 (##sys#register-export name (##sys#current-module)))
+		 (##sys#register-export name (##sys#current-module)))
 	       (when (c (r 'define-syntax) head)
 		 (##sys#defjam-error form))
 	       `(##core#define-syntax ,head ,(car body)))
@@ -1527,22 +1545,19 @@
 ;;; the base macro environment ("scheme", essentially)
 
 (define (##sys#macro-subset me0 #!optional parent-env)
-  (let ((se (let loop ((me (##sys#macro-environment)))
-	      (if (or (null? me) (eq? me me0))
-		  '()
-		  (cons (car me) (loop (cdr me)))))))
+  (let ((se (se-not-tail me0 (##sys#macro-environment))))
     (##sys#fixup-macro-environment se parent-env)))
 
 (define (##sys#fixup-macro-environment se #!optional parent-env)
-  (let ((se2 (if parent-env (##sys#append se parent-env) se)))
-    (for-each				; fixup se
+  (let ((se2 (if parent-env (se-append se parent-env) se)))
+    (se-for-each				; fixup se
      (lambda (sdef)
        (when (pair? (cdr sdef))
 	 (set-car!
 	  (cdr sdef) 
 	  (if (null? (cadr sdef)) 
 	      se2
-	      (##sys#append (cadr sdef) se2)))))
+	      (se-append (cadr sdef) se2)))))
      se)
     se))
 
diff --git a/modules.scm b/modules.scm
index a346028..bdebbc1 100644
--- a/modules.scm
+++ b/modules.scm
@@ -29,13 +29,14 @@
   (disable-interrupts)
   (fixnum)
   (hide lookup merge-se module-indirect-exports)
-  (not inline ##sys#alias-global-hook))
-
+  (not inline ##sys#alias-global-hook merge-se))
+ 
 (use (only srfi-69 make-hash-table hash-table-exists?))
 
 (include "common-declarations.scm")
 
 (define-syntax d (syntax-rules () ((_ . _) (void))))
+;; (define d (lambda x (apply print (map ->string x))))
 
 (define-alias dd d)
 (define-alias dm d)
@@ -57,16 +58,15 @@
 ;;; Support definitions
 
 ;; duoplicates code in the hope of being inlined
-(define (lookup id se)
-  (cond ((##core#inline "C_u_i_assq" id se) => cdr)
-	((getp id '##core#macro-alias))
-	(else #f)))
+
+(include "ses.scm")
 
 #+debugbuild
 (define (map-se se)
-  (map (lambda (a) 
-	 (cons (car a) (if (symbol? (cdr a)) (cdr a) ')))
-       se))
+  (se->list
+   (se-map (lambda (a) 
+	     (cons (car a) (if (symbol? (cdr a)) (cdr a) ')))
+	   se)))
 
 
 ;;; low-level module support
@@ -168,11 +168,11 @@
 	      (sexps '()))
 	  (for-each
 	   (lambda (exp)
-	     (cond ((assq exp me) =>
+	     (cond ((se-assq exp me) =>
 		    (lambda (a)
 		      (set! sexps (cons a sexps))))))
 	   exps)
-	  (set-module-sexports! mod (append sexps (module-sexports mod)))
+	  (set-module-sexports! mod (se-append (make-se sexps) (module-sexports mod)))
 	  (set-module-exist-list! mod (append el exps)))
 	(set-module-export-list! mod (append xl exps)))))
 
@@ -183,9 +183,9 @@
     (set-module-meta-expressions! mod (cons exp (module-meta-expressions mod)))))
 
 (define (check-for-redef sym env senv)
-  (and-let* ((a (assq sym env)))
+  (and-let* ((a (se-assq sym env)))
     (##sys#warn "redefinition of imported value binding" sym) )
-  (and-let* ((a (assq sym senv)))
+  (and-let* ((a (se-assq sym senv)))
     (##sys#warn "redefinition of imported syntax binding" sym)))
 
 (define (##sys#register-export sym mod)
@@ -239,12 +239,12 @@
 	      (cons (cons sym (if where (list where) '())) ul)))))))
 
 (define (##sys#register-module name explist #!optional (vexports '()) (sexports '()))
-  (let ((mod (make-module name explist vexports sexports '())))
+  (let ((mod (make-module name explist (make-se vexports) (make-se sexports) (make-se))))
     (set! ##sys#module-table (cons (cons name mod) ##sys#module-table))
     mod) )
 
 (define (##sys#mark-imported-symbols se)
-  (for-each
+  (se-for-each
    (lambda (imp)
      (when (and (symbol? (cdr imp)) (not (eq? (car imp) (cdr imp))))
        (dm `(MARKING: ,(cdr imp)))
@@ -273,7 +273,7 @@
 		(else
 		 (let loop2 ((iexports (cdar exports))) ; walk indirect exports for a given entry
 		   (cond ((null? iexports) (loop (cdr exports)))
-			 ((assq (car iexports) (##sys#macro-environment))
+			 ((se-assq (car iexports) (##sys#macro-environment))
 			  (warn "indirect export of syntax binding" (car iexports))
 			  (loop2 (cdr iexports)))
 			 ((assq (car iexports) dlist) => ; defined in current module?
@@ -283,7 +283,7 @@
 			      (car iexports)
 			      (or (cdr a) (##sys#module-rename (car iexports) mname)))
 			     (loop2 (cdr iexports)))))
-			 ((assq (car iexports) (##sys#current-environment)) =>
+			 ((se-assq (car iexports) (##sys#current-environment)) =>
 			  (lambda (a)	; imported in current env.
 			    (cond ((symbol? (cdr a)) ; not syntax
 				   (cons (cons (car iexports) (cdr a)) (loop2 (cdr iexports))) )
@@ -294,9 +294,6 @@
 			  (warn "indirect export of unknown binding" (car iexports))
 			  (loop2 (cdr iexports)))))))))))
 
-(define (merge-se . ses) ; later occurrences take precedence to earlier ones
-  (apply append (reverse ses)))
-
 (define (##sys#compiled-module-registration mod)
   (let ((dlist (module-defined-list mod))
 	(mname (module-name mod))
@@ -308,78 +305,89 @@
       ,@(##sys#fast-reverse (map ##sys#strip-syntax (module-meta-expressions mod)))
       (##sys#register-compiled-module
        ',(module-name mod)
+       ',(se->list
+	  (se-map (lambda (ie)
+		    (if (symbol? (cdr ie))
+			`(,(car ie) . ,(cdr ie))
+			`(list ,(car ie) () ,(cdr ie))))
+		  (module-iexports mod)))
+       ',(se->list (module-vexports mod))
        (list
-	,@(map (lambda (ie)
-		 (if (symbol? (cdr ie))
-		     `'(,(car ie) . ,(cdr ie))
-		     `(list ',(car ie) '() ,(cdr ie))))
-	       (module-iexports mod)))
-       ',(module-vexports mod)
-       (list 
 	,@(map (lambda (sexport)
 		 (let* ((name (car sexport))
 			(a (assq name dlist)))
-		   (cond ((pair? a) 
+		   (cond ((pair? a)
 			  `(cons ',(car sexport) ,(##sys#strip-syntax (cdr a))))
 			 (else
 			  (dm "re-exported syntax" name mname)
 			  `',name))))
-	       sexports))
-       (list 
+	       (se-entries sexports)))
+       (list
 	,@(if (null? sexports)
 	      '() 			; no syntax exported - no more info needed
 	      (let loop ((sd (module-defined-syntax-list mod)))
 		(cond ((null? sd) '())
-		      ((assq (caar sd) sexports) (loop (cdr sd)))
+		      ((se-assq (caar sd) sexports) (loop (cdr sd)))
 		      (else
 		       (let ((name (caar sd)))
 			 (cons `(cons ',(caar sd) ,(##sys#strip-syntax (cdar sd)))
 			       (loop (cdr sd)))))))))))))
 
-(define (##sys#register-compiled-module name iexports vexports sexports #!optional
+(define (##sys#register-compiled-module name iexports vexports* sexports #!optional
 					(sdefs '()))
   (define (find-reexport name)
-    (let ((a (assq name (##sys#macro-environment))))
+    (let ((a (se-assq name (##sys#macro-environment))))
       (if (and a (pair? (cdr a)))
 	  a
 	  (##sys#error
 	   'import "cannot find implementation of re-exported syntax"
 	   name))))
   (let* ((sexps
-	  (map (lambda (se)
-		 (if (symbol? se)
-		     (find-reexport se)
-		     (list (car se) #f (##sys#ensure-transformer (cdr se) (car se)))))
-	       sexports))
-	 (iexps 
-	  (map (lambda (ie)
-		 (if (pair? (cdr ie))
-		     (list (car ie) (cadr ie) (##sys#ensure-transformer (caddr ie) (car ie)))
-		     ie))
-	       iexports))
+	  (make-se
+	   (map (lambda (se)
+		  (if (symbol? se)
+		      (find-reexport se)
+		      (list (car se) #f (##sys#ensure-transformer (cdr se) (car se)))))
+		sexports)))
+	 (iexps
+	  (make-se
+	   (map (lambda (ie)
+		  (if (pair? (cdr ie))
+		      (list (car ie) (cadr ie) (##sys#ensure-transformer (caddr ie) (car ie)))
+		      ie))
+		iexports)))
 	 (nexps
-	  (map (lambda (ne)
-		 (list (car ne) #f (##sys#ensure-transformer (cdr ne) (car ne))))
-	       sdefs))
+	  (make-se
+	   (map (lambda (ne)
+		  (list (car ne) #f (##sys#ensure-transformer (cdr ne) (car ne))))
+		sdefs)))
+	 (vexports (make-se vexports*))
 	 (mod (make-module name '() vexports sexps iexps))
+	 (_ (assert (valid-se? (##sys#macro-environment))))
+	 (_ (assert (valid-se? (##sys#current-environment))))
+	 (_ (assert (valid-se? iexps)))
+	 (_ (assert (valid-se? vexports)))
+	 (_ (assert (valid-se? sexps)))
+	 (_ (assert (valid-se? nexps)))
 	 (senv (merge-se 
 		(##sys#macro-environment)
 		(##sys#current-environment)
 		iexps vexports sexps nexps)))
     (##sys#mark-imported-symbols iexps)
-    (for-each
-     (lambda (sexp)
-       (set-car! (cdr sexp) (merge-se (or (cadr sexp) '()) senv)))
-     sexps)
-    (for-each
-     (lambda (iexp)
-       (when (pair? (cdr iexp))
-	 (set-car! (cdr iexp) (merge-se (or (cadr iexp) '()) senv))))
-     iexps)
-    (for-each
-     (lambda (nexp)
-       (set-car! (cdr nexp) (merge-se (or (cadr nexp) '()) senv)))
-     nexps)
+    (let ([fix (lambda (exps)
+		 (se-for-each
+		  (lambda (exp)
+		    (when (pair? (cdr exp))
+		      (set-car! (cdr exp)
+				(cond [(cadr exp) =>
+				       (lambda (se2)
+					 (merge-se (if (real-se? se2) se2 (make-se se2))
+						   senv))]
+				      [senv]))))
+		  exps))])
+      (fix sexps)
+      (fix iexps)
+      (fix nexps))
     (set-module-saved-environments!
      mod
      (cons (merge-se (##sys#current-environment) vexports sexps)
@@ -394,24 +402,29 @@
     (putp palias '##core#primitive sym)
     palias))
 
-(define (##sys#register-primitive-module name vexports #!optional (sexports '()))
-  (let* ((me (##sys#macro-environment))
+(define (##sys#register-primitive-module name vexports #!optional (sexports* (make-se)))
+  (let* ((sexports (if (real-se? sexports*) sexports* (make-se sexports*)))
+	 (me (##sys#macro-environment))
 	 (mod (make-module 
 	       name '()
-	       (map (lambda (ve)
-		      (if (symbol? ve)
-			  (cons ve (##sys#primitive-alias ve))
-			  ve))
-		    vexports)
-	       (map (lambda (se)
-		      (if (symbol? se)
-			  (or (assq se me)
-			      (##sys#error
-			       "unknown syntax referenced while registering module" 
-			       se name))
-			  se))
-		    sexports)
-	       '())))
+	       (make-se
+		(map (lambda (ve)
+		       (if (symbol? ve)
+			   (cons ve (##sys#primitive-alias ve))
+			   ve))
+		     vexports))
+	       (se-map (lambda (se)
+			 (if (symbol? se)
+			     (or (se-assq se me)
+				 (##sys#error
+				  "unknown syntax referenced while registering module" 
+				  se name))
+			     se))
+		       sexports)
+	       (make-se))))
+    (assert (real-se? (##sys#current-environment)) "not real-se (##sys#current-environment)")
+    (assert (real-se? (module-vexports mod)) "2")
+    (assert (real-se? (module-sexports mod)) "3")
     (set-module-saved-environments!
      mod
      (cons (merge-se (##sys#current-environment)
@@ -441,45 +454,51 @@
 	     (dlist (module-defined-list mod))
 	     (elist (module-exist-list mod))
 	     (missing #f)
-	     (sdlist (map (lambda (sym) (assq (car sym) (##sys#macro-environment)))
-			  (module-defined-syntax-list mod)))
+	     (sdlist (make-se
+		      (map (lambda (sym) (se-assq (car sym) (##sys#macro-environment)))
+			   (module-defined-syntax-list mod))))
 	     (sexports
 	      (if (eq? #t explist)
 		  (merge-se (module-sexports mod) sdlist)
-		  (let loop ((me (##sys#macro-environment)))
-		    (cond ((null? me) '())
-			  ((##sys#find-export (caar me) mod #f)
-			   (cons (car me) (loop (cdr me))))
-			  (else (loop (cdr me)))))))
+		  ;; (let loop ((me (##sys#macro-environment)))
+		  ;;   (cond ((null? me) '())
+		  ;; 	  ((##sys#find-export (caar me) mod #f)
+		  ;; 	   (cons (car me) (loop (cdr me))))
+		  ;; 	  (else (loop (cdr me)))))
+		  (se-fold (lambda (e l) (if (##sys#find-export (car e) mod #f)
+					(cons e l)
+					l))
+			   (##sys#macro-environment))))
 	     (vexports
-	      (let loop ((xl (if (eq? #t explist) elist explist)))
-		(if (null? xl)
-		    '()
-		    (let* ((h (car xl))
-			   (id (if (symbol? h) h (car h))))
-		      (if (assq id sexports) 
-			  (loop (cdr xl))
-			  (cons 
+	      (make-se
+	       (let loop ((xl (if (eq? #t explist) elist explist)))
+		 (if (null? xl)
+		     '()
+		     (let* ((h (car xl))
+			    (id (if (symbol? h) h (car h))))
+		       (if (se-assq id sexports) 
+			   (loop (cdr xl))
 			   (cons 
-			    id
-			    (let ((def (assq id dlist)))
-			      (if (and def (symbol? (cdr def))) 
-				  (cdr def)
-				  (let ((a (assq id (##sys#current-environment))))
-				    (cond ((and a (symbol? (cdr a))) 
-					   (dm "reexporting: " id " -> " (cdr a))
-					   (cdr a)) 
-					  ((not def)
-					   (set! missing #t)
-					   (##sys#warn 
-					    (string-append 
-					     "exported identifier of module `" 
-					     (symbol->string name)
-					     "' has not been defined")
-					    id)
-					   #f)
-					  (else (##sys#module-rename id name)))))))
-			   (loop (cdr xl)))))))))
+			    (cons 
+			     id
+			     (let ((def (assq id dlist)))
+			       (if (and def (symbol? (cdr def))) 
+				   (cdr def)
+				   (let ((a (se-assq id (##sys#current-environment))))
+				     (cond ((and a (symbol? (cdr a))) 
+					    (dm "reexporting: " id " -> " (cdr a))
+					    (cdr a)) 
+					   ((not def)
+					    (set! missing #t)
+					    (##sys#warn 
+					     (string-append 
+					      "exported identifier of module `" 
+					      (symbol->string name)
+					      "' has not been defined")
+					     id)
+					    #f)
+					   (else (##sys#module-rename id name)))))))
+			    (loop (cdr xl))))))))))
 	(for-each
 	 (lambda (u)
 	   (let* ((where (cdr u))
@@ -515,17 +534,24 @@
 	(when missing
 	  (##sys#error "module unresolved" name))
 	(let* ((iexports 
-		(map (lambda (exp)
-		       (cond ((symbol? (cdr exp)) exp)
-			     ((assq (car exp) (##sys#macro-environment)))
-			     (else (##sys#error "(internal) indirect export not found" (car exp)))) )
-		     (module-indirect-exports mod)))
+		(make-se
+		 (map (lambda (exp)
+			(cond ((symbol? (cdr exp)) exp)
+			      ((se-assq (car exp) (##sys#macro-environment)))
+			      (else (##sys#error "(internal) indirect export not found" (car exp)))) )
+		      (module-indirect-exports mod))))
+	       (_ (assert (real-se? (##sys#macro-environment))))
+	       (_ (assert (real-se? (##sys#current-environment))))
+	       (_ (assert (real-se? iexports)))
+	       (_ (assert (real-se? vexports)))
+	       (_ (assert (real-se? sexports)))
+	       (_ (assert (real-se? sdlist)))
 	       (new-se (merge-se 
 			(##sys#macro-environment) 
 			(##sys#current-environment) 
 			iexports vexports sexports sdlist)))
 	  (##sys#mark-imported-symbols iexports)
-	  (for-each
+	  (se-for-each
 	   (lambda (m)
 	     (let ((se (merge-se (cadr m) new-se))) ;XXX needed?
 	       (dm `(FIXUP: ,(car m) ,@(map-se se)))
@@ -540,6 +566,8 @@
 		(SEXPORTS: ,@(map-se sexports))))
 	  (set-module-vexports! mod vexports)
 	  (set-module-sexports! mod sexports)
+	  (assert (real-se? iexports))
+	  (assert (real-se? (module-iexports mod)))
 	  (set-module-iexports! 
 	   mod
 	   (merge-se (module-iexports mod) iexports)) ; "reexport" may already have added some
@@ -561,7 +589,7 @@
 		  (string-append (symbol->string mname) ".import")
 		  #t)))
 	(cond (il (parameterize ((##sys#current-module #f)
-				 (##sys#current-environment '())
+				 (##sys#current-environment (make-se))
 				 (##sys#current-meta-environment 
 				  (##sys#current-meta-environment))
 				 (##sys#macro-environment
@@ -582,7 +610,7 @@
 	(%prefix (r 'prefix))
 	(%srfi (r 'srfi)))
     (define (resolve sym)
-      (or (lookup sym '()) sym))	;XXX really empty se?
+      (or (lookup sym (make-se)) sym))	;XXX really empty se?
     (define (warn msg mod id)
       (##sys#warn (sprintf msg mod id)))
     (define (tostr x)
@@ -597,6 +625,9 @@
 	     (sexp (module-sexports mod))
 	     (iexp (module-iexports mod))
 	     (name (module-name mod)))
+	(assert (valid-se? vexp))
+	(assert (valid-se? sexp))
+	(assert (valid-se? iexp))
 	(values name name vexp sexp iexp)))
     (define (import-spec spec)
       (cond ((symbol? spec) (import-name spec))
@@ -607,85 +638,52 @@
 	      (##sys#intern-symbol
 	       (##sys#string-append "srfi-" (##sys#number->string (cadr spec))))))
 	    (else
-	     (let ((head (car spec))
-		   (imports (cddr spec)))
+	     (let ([head (car spec)]
+		   [imports (cddr spec)])
 	       (let-values (((name form impv imps impi) (import-spec (cadr spec))))
-		 (cond ((c %only head)
-			(##sys#check-syntax loc spec '(_ _ . #(symbol 0)))
-			(let ((ids (map resolve imports)))
-			  (let loop ((ids ids) (v '()) (s '()) (missing '()))
-			    (cond ((null? ids)
-				   (for-each
-				    (lambda (id)
-				      (warn "imported identifier doesn't exist in module ~s: ~s" name id))
-				    missing)
-				   (values name `(,head ,form ,@imports) v s impi))
-				  ((assq (car ids) impv) =>
-				   (lambda (a)
-				     (loop (cdr ids) (cons a v) s missing)))
-				  ((assq (car ids) imps) =>
-				   (lambda (a)
-				     (loop (cdr ids) v (cons a s) missing)))
-				  (else
-				   (loop (cdr ids) v s (cons (car ids) missing)))))))
-		       ((c %except head)
-			(##sys#check-syntax loc spec '(_ _ . #(symbol 0)))
-			(let ((ids (map resolve imports)))
-			  (let loop ((impv impv) (v '()) (ids imports))
-			    (cond ((null? impv)
-				   (let loop ((imps imps) (s '()) (ids ids))
-				     (cond ((null? imps)
-					    (for-each
-					     (lambda (id)
-					       (warn "excluded identifier doesn't exist in module ~s: ~s" name id))
-					     ids)
-					    (values name `(,head ,form ,@imports) v s impi))
-					   ((memq (caar imps) ids) =>
-					    (lambda (id)
-					      (loop (cdr imps) s (##sys#delq (car id) ids))))
-					   (else
-					    (loop (cdr imps) (cons (car imps) s) ids)))))
-				  ((memq (caar impv) ids) =>
-				   (lambda (id)
-				     (loop (cdr impv) v (##sys#delq (car id) ids))))
-				  (else
-				   (loop (cdr impv) (cons (car impv) v) ids))))))
-		       ((c %rename head)
-			(##sys#check-syntax loc spec '(_ _ . #((symbol symbol) 0)))
-			(let loop ((impv impv) (v '()) (ids imports))
-			  (cond ((null? impv)
-				 (let loop ((imps imps) (s '()) (ids ids))
-				   (cond ((null? imps)
-					  (for-each
-					   (lambda (id)
-					     (warn "renamed identifier doesn't exist in module ~s: ~s" name id))
-					   (map car ids))
-					  (values name `(,head ,form ,@imports) v s impi))
-					 ((assq (caar imps) ids) =>
-					  (lambda (a)
-					    (loop (cdr imps)
-						  (cons (cons (cadr a) (cdar imps)) s)
-						  (##sys#delq a ids))))
-					 (else
-					  (loop (cdr imps) (cons (car imps) s) ids)))))
-				((assq (caar impv) ids) =>
-				 (lambda (a)
-				   (loop (cdr impv)
-					 (cons (cons (cadr a) (cdar impv)) v)
-					 (##sys#delq a ids))))
-				(else
-				 (loop (cdr impv) (cons (car impv) v) ids)))))
-		       ((c %prefix head)
-			(##sys#check-syntax loc spec '(_ _ _))
-			(let* ([pref (caddr spec)]
-			       [pref-str (tostr pref)])
-			  (define (ren imp)
-			    (cons
-			     (##sys#string->symbol
-			      (##sys#string-append pref-str (##sys#symbol->string (car imp))))
-			     (cdr imp) ) )
-			  (values name `(,head ,form ,pref) (map ren impv) (map ren imps) impi)))
-		       (else (##sys#syntax-error-hook loc "invalid import specification" spec))))))))
+		 (assert (valid-se? impv))
+		 (assert (valid-se? imps))
+		 (assert (valid-se? impi))
+		 (let ([imp-form `(,head ,form ,@imports)])
+		   ;; (print "IMPORT" imp-form " v: " (se-size impv) " s: " (se-size imps))
+		   (cond ((c %only head)
+			  (##sys#check-syntax loc spec '(_ _ . #(symbol 0)))
+			  (let lp ([ids (map resolve imports)]
+				   [vs '()]
+				   [ss '()])
+			    (cond
+			     [(null? ids) (values name imp-form (make-se vs) (make-se ss) impi)]
+			     [(se-assq (car ids) impv) => (lambda (e) (lp (cdr ids) (cons e vs) ss))]
+			     [(se-assq (car ids) imps) => (lambda (e) (lp (cdr ids) vs (cons e ss)))]
+			     [else (warn "imported identifier doesn't exist in module ~s: ~s"
+					 name (car ids))
+				   (lp (cdr ids) vs ss)])))
+			 ((c %except head)
+			  (##sys#check-syntax loc spec '(_ _ . #(symbol 0)))
+			  (let ((ids (map resolve imports)))
+			    (receive (missing v s) (se-derive-except ids impv imps)
+			      (for-each
+			       (lambda (id)
+				 (warn "excluded identifier doesn't exist in module ~s: ~s" name id))
+			       missing)
+			      (values name imp-form v s impi))))
+			 ((c %rename head)
+			  (##sys#check-syntax loc spec '(_ _ . #((symbol symbol) 0)))
+			  (receive (missing v s) (se-derive-rename imports impv imps)
+			    (for-each
+			     (lambda (id)
+			       (warn "renamed identifier doesn't exist in module ~s: ~s" name id))
+			     missing)
+			    (values name imp-form v s impi)))
+			 ((c %prefix head)
+			  (##sys#check-syntax loc spec '(_ _ _))
+			  (let* ([pref (caddr spec)]
+				 [pref-str (tostr pref)])
+			    (values name `(,head ,form ,pref)
+				    (se-derive-prefix pref-str impv)
+				    (se-derive-prefix pref-str imps)
+				    impi)))
+			 (else (##sys#syntax-error-hook loc "invalid import specification" spec)))))))))
     (##sys#check-syntax loc x '(_ . #(_ 1)))
     (let ((cm (##sys#current-module)))
       (for-each
@@ -699,21 +697,21 @@
 		 (set-module-import-forms!
 		  cm
 		  (append (module-import-forms cm) (list form)))))
-	   (dd `(IMPORT: ,loc))
+	   (dd `(IMPORT: ,x))
 	   (dd `(V: ,(if cm (module-name cm) ') ,(map-se vsv)))
 	   (dd `(S: ,(if cm (module-name cm) ') ,(map-se vss)))
 	   (##sys#mark-imported-symbols vsv) ; mark imports as ##core#aliased
-	   (for-each
+	   (se-for-each
 	    (lambda (imp)
 	      (and-let* ((id (car imp))
-			 (a (assq id (import-env)))
+			 (a (se-assq id (import-env)))
 			 (aid (cdr imp))
 			 ((not (eq? aid (cdr a)))))
 		(##sys#notice "re-importing already imported identifier" id)))
 	    vsv)
-	   (for-each
+	   (se-for-each
 	    (lambda (imp)
-	      (and-let* ((a (assq (car imp) (macro-env)))
+	      (and-let* ((a (se-assq (car imp) (macro-env)))
 			 ((not (eq? (cdr imp) (cdr a)))))
 		(##sys#notice "re-importing already imported syntax" (car imp))))
 	    vss)
@@ -722,26 +720,26 @@
 	       (##sys#syntax-error-hook loc "`reexport' only valid inside a module"))
 	     (let ((el (module-export-list cm)))
 	       (cond ((eq? #t el)
-		      (set-module-sexports! cm (append vss (module-sexports cm)))
+		      (set-module-sexports! cm (se-append vss (module-sexports cm)))
 		      (set-module-exist-list!
 		       cm
 		       (append (module-exist-list cm)
-			       (map car vsv)
-			       (map car vss))))
+			       (se-identifiers vsv)
+			       (se-identifiers vss))))
 		     (else
 		      (set-module-export-list!
 		       cm
 		       (append
 			(let ((xl (module-export-list cm)))
 			  (if (eq? #t xl) '() xl))
-			(map car vsv)
-			(map car vss))))))
+			(se-identifiers vsv)
+			(se-identifiers vss))))))
 	     (set-module-iexports!
 	      cm
 	      (merge-se (module-iexports cm) vsi))
 	     (dm "export-list: " (module-export-list cm)))
-	   (import-env (append vsv (import-env)))
-	   (macro-env (append vss (macro-env)))))
+	   (import-env (se-append vsv (import-env)))
+	   (macro-env (se-append vss (macro-env)))))
        (cdr x))
       '(##core#undefined))))
 
@@ -756,7 +754,7 @@
   (define (mrename sym)
     (cond ((##sys#current-module) => 
 	   (lambda (mod)
-	     (dm "(ALIAS) global alias " sym " in " (module-name mod))
+	     (dm "(ALIAS) global alias `" sym "' in module `" (module-name mod) "'")
 	     (unless assign 
 	       (##sys#register-undefined sym mod where))
 	     (##sys#module-rename sym (module-name mod))))
@@ -769,7 +767,7 @@
 	((getp sym '##core#aliased) 
 	 (dm "(ALIAS) marked: " sym)
 	 sym)
-	((assq sym ((##sys#active-eval-environment))) =>
+	((se-assq sym ((##sys#active-eval-environment))) =>
 	 (lambda (a)
 	   (let ((sym2 (cdr a)))
 	     (dm "(ALIAS) in current environment " sym " -> " sym2)
@@ -870,8 +868,8 @@
 	(for-each
 	 (lambda (exp)
 	   (let ((sym (if (symbol? exp) exp (car exp))))
-	     (unless (or (assq sym (module-vexports mod))
-			 (assq sym (module-sexports mod)))
+	     (unless (or (se-assq sym (module-vexports mod))
+			 (se-assq sym (module-sexports mod)))
 	       (set! missing (cons sym missing)))))
 	 exps)
 	(when (pair? missing)
diff --git a/rules.make b/rules.make
index 7e3a9e0..50766ad 100644
--- a/rules.make
+++ b/rules.make
@@ -502,12 +502,13 @@ endef
 bootstrap-lib = $(CHICKEN) $(call profile-flags, $@) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
 
 library.c: $(SRCDIR)library.scm $(SRCDIR)banner.scm $(SRCDIR)common-declarations.scm
+	# $(bootstrap-lib) -no-trace
+	$(CHICKEN) $(call profile-flags, $@) $< -no-trace -explicit-use -feature chicken-bootstrap
+eval.c: $(SRCDIR)eval.scm $(SRCDIR)common-declarations.scm $(SRCDIR)ses.scm
 	$(bootstrap-lib)
-eval.c: $(SRCDIR)eval.scm $(SRCDIR)common-declarations.scm
+expand.c: $(SRCDIR)expand.scm $(SRCDIR)synrules.scm $(SRCDIR)common-declarations.scm $(SRCDIR)ses.scm
 	$(bootstrap-lib)
-expand.c: $(SRCDIR)expand.scm $(SRCDIR)synrules.scm $(SRCDIR)common-declarations.scm
-	$(bootstrap-lib)
-modules.c: $(SRCDIR)modules.scm $(SRCDIR)common-declarations.scm
+modules.c: $(SRCDIR)modules.scm $(SRCDIR)common-declarations.scm $(SRCDIR)ses.scm
 	$(bootstrap-lib)
 extras.c: $(SRCDIR)extras.scm $(SRCDIR)common-declarations.scm
 	$(bootstrap-lib)
@@ -522,7 +523,7 @@ irregex.c: $(SRCDIR)irregex.scm $(SRCDIR)irregex-core.scm $(SRCDIR)irregex-utils
 #
 # The ones below just depend on their matching .scm file and common-declarations
 #
-chicken-syntax.c: $(SRCDIR)chicken-syntax.scm $(SRCDIR)common-declarations.scm
+chicken-syntax.c: $(SRCDIR)chicken-syntax.scm $(SRCDIR)common-declarations.scm $(SRCDIR)ses.scm
 	$(bootstrap-lib)
 chicken-ffi-syntax.c: $(SRCDIR)chicken-ffi-syntax.scm $(SRCDIR)common-declarations.scm
 	$(bootstrap-lib)
@@ -599,7 +600,11 @@ setup-api.c: $(SRCDIR)setup-api.scm
 	  -output-file $@ 
 setup-download.c: $(SRCDIR)setup-download.scm setup-api.c
 	$(CHICKEN) $< $(CHICKEN_DYNAMIC_OPTIONS) -emit-import-library setup-download \
-	  -output-file $@ 
+	  -output-file $@
+
+chicken.c: $(SRCDIR)ses.scm
+compiler.c: $(SRCDIR)ses.scm
+compiler-syntax.c: $(SRCDIR)ses.scm
 
 # distribution files
 
diff --git a/ses.scm b/ses.scm
new file mode 100644
index 0000000..db15e5e
--- /dev/null
+++ b/ses.scm
@@ -0,0 +1,198 @@
+(declare (not inline se-assq))
+(use (only srfi-1 fold))
+
+(define (make-se #!optional (entries '()))
+  (assert (not (real-se? entries)))
+  (cons entries 'cant-touch-this)
+  ;; entries
+  )
+
+(define (se-derive-new se)
+  (assert (valid-se? se))
+  (make-se (car se)))
+
+(define (se-entries se)
+  (assert (valid-se? se))
+  (car se))
+
+(define (real-se? se)
+  (and (pair? se) (eq? 'cant-touch-this (cdr se))
+       ;; (or (not (and (pair? (car se))
+       ;; 		     (begin (print "%")
+       ;; 		      (real-se? se))) )
+       ;; 	   (begin (print "muchos sphagetti")
+       ;; 		  #f))
+       ))
+
+(define (mangled-se? se)
+  (and (pair? se)
+       (pair? (cdr se))
+       (let lp ([es (cdr se)]
+		[len 1])
+	 (cond
+	  [(null? es) #f]
+	  [(symbol? (cdr es)) (print "oops " (cdr es) " " len) #t]
+	  [else (lp (cdr es) (add1 len))]))))
+
+(define (valid-se? se)
+  (and (real-se? se)
+       (not (mangled-se? se))))
+
+(define (se-assq id se*)		; ignores macro bindings
+  (assert (valid-se? se*))
+  (assq id (car se*)))
+
+(define (lookup id se)
+  (assert (valid-se? se))
+  (let ([r (cond ((##core#inline "C_u_i_assq" id (car se)) => cdr)
+		 ((##core#inline "C_i_getprop" id '##core#macro-alias #f)
+		  ;; (getp id '##core#macro-alias)
+		  )
+		 (else #f))])
+    ;; (print "lookup " id " -> " (cond
+    ;; 				[(and (pair? r) (= 2 (length r))) (cons 'something (second r))]
+    ;; 				[r]
+    ;; 				[else 'NOT-FOUND]))
+    r))
+
+(define (find-id id se*)		; ignores macro bindings
+  (assert (valid-se? se*))
+  (let lp ([se (car se*)])
+    (cond ((null? se) #f)
+	  ((and (eq? id (caar se)) (symbol? (cdar se))) (cdar se))
+	  (else (lp (cdr se))))))
+
+(define (find-id/alias id se*)		; ignores macro bindings
+  (assert (valid-se? se*))
+  (or (find-id id se*)
+      ;;XXX could hint at decl (3rd arg)
+      (##sys#alias-global-hook id #t #f)))
+
+(define (se-rename var se)
+  (assert (valid-se? se))
+  (cond ((find-id var se))
+	((##sys#get var '##core#macro-alias))
+	(else var)))
+
+(define (se-assq-reverse id se*)
+  (assert (valid-se? se*))
+  (define (assq-reverse s l)
+    (cond
+     ((null? l) #f)
+     ((eq? (cdar l) s) (car l))
+     (else (assq-reverse s (cdr l)))))
+  (assq-reverse id (car se*)))
+
+(define (se-fold fun se)
+  (assert (valid-se? se))
+  (make-se (fold fun '() (car se))))
+
+(define (merge-se . ses) ; later occurrences take precedence to earlier ones
+  (for-each (lambda (se) (assert (valid-se? se))) ses)
+  (make-se (apply append (map car (reverse ses))))
+
+  ;; (apply append (reverse ses))
+  )
+
+(define (se->list se)
+  (assert (valid-se? se))
+  (car se))
+
+(define (se-append . ses)
+  (for-each (lambda (se) (assert (valid-se? se))) ses)
+  (make-se (apply append (map car ses))))
+
+(define (se-identifiers se)
+  (assert (valid-se? se))
+  (map car (car se)))
+
+(define (se-size se)
+  (length (se-identifiers se)))
+
+(define (se-cons name data se)
+  (assert (valid-se? se))
+  (set-car! se (cons (cons name data) (car se)))
+  se)
+
+(define (se-empty? se)
+  (assert (valid-se? se) "real-se? se-empty?")
+  (null? (car se)))
+
+(define (se-for-each fun se)
+  (assert (valid-se? se))
+  (for-each fun (car se)))
+
+(define (se-map fun se)
+  (assert (valid-se? se))
+  (make-se (map fun (car se))))
+
+(define (se-not-tail tail se)
+  ;; original from expand.scm
+  ;; (let loop ((me (##sys#macro-environment)))
+  ;;   (if (or (null? me) (eq? me me0))
+  ;; 	'()
+  ;; 	(cons (car me) (loop (cdr me)))))
+
+  (assert (valid-se? se))
+  (assert (valid-se? tail))
+  (let ([tail* (car tail)]
+	[se* (car se)])
+    (make-se (let loop ((me se*))
+	       (if (or (null? me) (eq? me tail*))
+		   '()
+		   (cons (car me) (loop (cdr me))))))))
+
+(define (%%se-find-ids ids . ses) ; returns (values missing-ids . found-ids)
+  (let* ([missing '()]
+	 [fss (fold
+	       (lambda (id fss)
+		 (let* ([found? #f]
+			[r (map (lambda (fs se) (cond [(se-assq id se) (set! found? #t) (cons id fs)]
+						 [else fs]))
+				fss ses)])
+		   (unless found?
+		     (set! missing (cons id missing)))
+		   r))
+	       (map (lambda _ (list)) ses)
+	       ids)])
+    (apply values missing fss)))
+
+(define (se-derive-except ids . ses) ; returns (values missing-ids . derived-ses)
+  (receive ret (apply %%se-find-ids ids ses)
+    (let ([missing (car ret)]
+	  [fss (cdr ret)])
+      (apply values missing
+	     (map (lambda (ids2 se)
+		    (if (null? ids2)
+			se
+			(se-fold (lambda (e es) (cond [(memq (car e) ids2) es]
+						 [else (cons e es)]))
+				 se)))
+		  fss
+		  ses)))))
+
+(define (se-derive-rename renames . ses) ; returns (values missing-ids . derived-ses)
+  (receive ret (apply %%se-find-ids (map car renames) ses)
+    (let ([missing (car ret)]
+	  [fss (cdr ret)])
+      (apply values missing
+	     (map (lambda (ids2 se)
+		    (if (null? ids2)
+			se
+			(se-fold (lambda (e es) (cond [(assq (car e) renames)
+						  => (lambda (r) (cons (cons (cadr r) (cdr e)) es))]
+						 [else (cons e es)]))
+				 se)))
+		  fss
+		  ses)))))
+
+(define (se-derive-prefix prefix-str se)
+  (assert (valid-se? se))
+  (define (ren imp)
+    (cons
+     (##sys#string->symbol
+      (##sys#string-append prefix-str (##sys#symbol->string (car imp))))
+     (cdr imp)))
+  (se-map ren se))
+
+
diff --git a/tests/runtests.sh b/tests/runtests.sh
index f61b4ef..e7e7384 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -64,7 +64,7 @@ TYPESDB=../types.db
 cp $TYPESDB test-repository/types.db
 
 time=time
-compile="../csc -types ${TYPESDB} -ignore-repository ${COMPILE_OPTIONS} -o a.out"
+compile="../csc -debug-level 2 -types ${TYPESDB} -ignore-repository ${COMPILE_OPTIONS} -o a.out"
 compile2="../csc -compiler $CHICKEN -v -I${TEST_DIR}/.. -L${TEST_DIR}/.. -include-path ${TEST_DIR}/.."
 compile_s="../csc -s -types ${TYPESDB} -ignore-repository ${COMPILE_OPTIONS} -v -I${TEST_DIR}/.. -L${TEST_DIR}/.. -include-path ${TEST_DIR}/.."
 interpret="../csi -n -include-path ${TEST_DIR}/.."