* Adding new files by Jost to the repository.dirk-adding-josts-environments

24 files changed, 6998 insertions, 151 deletions

diff --git a/ice-9/ChangeLog-environments b/ice-9/ChangeLog-environments
new file mode 100644
index 000000000..963a335f5
--- /dev/null
+++ b/ice-9/ChangeLog-environments
@@ -0,0 +1,37 @@
+1999-08-24  Jost Boekemeier  <jostobfe@calvados.zrz.tu-berlin.de>
+
+	* guile.scm (error-catching-loop): Correct non-RnRS usage of internal
+	defines.
+
+1999-08-12  Jost Boekemeier  <jostobfe@calvados.zrz.tu-berlin.de>
+
+        * arrays.scm, check-version.scm defmacro.scm, error.scm,
+	files.scm, guile.scm, hooks.scm, keywords.scm lists.scm,
+	macros.scm, math.scm, misc.scm, modules.scm, options.scm
+	posix.scm, provide.scm, run-test.scm, structs.scm, symbols.scm:
+	new file
+	* Makefile.am: added files
+
+	* debug.scm (define-module): the module imports the modules:
+	hooks, options, defmacro
+	(variable-set!): disabled
+
+	* r4rs.scm (defined?): `defined?' is a special form now.
+	(%load-announce): added environment parameter
+	(load): `load' loads and evaluates expressions in
+	`interaction-environment'
+
+	* boot-9.scm: added warning that this module is obsolete
+	(c-module-registry): load all c modules into the root environment
+	(primitive-load-path): load expressions in file "ice-9/r4rs" into
+	interaction-environment
+	(symbol-property): disabled
+	(record-constructor): evaluates expressions in interaction
+	environment
+	(record-accessor): dto.
+	(record-modifier): dto.
+	(modules): disabled
+	(scm-style-repl): evaluates expressions in interaction-environment
+	(environments): disabled
+	(macros): disabled
+	(variables): disabled
diff --git a/ice-9/arrays.scm b/ice-9/arrays.scm
index 51be69210..6e175fde1 100644
--- a/ice-9/arrays.scm
+++ b/ice-9/arrays.scm
@@ -1,83 +1,27 @@
-;;; installed-scm-file
 
-;;;; Copyright (C) 1999 Free Software Foundation, Inc.
-;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
-;;;; 
-;;;; This program is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
-;;;; Boston, MA 02111-1307 USA
-;;;; 
+
+;;; {Arrays}
+;;;
+
+(begin
+  (define uniform-vector? array?)
+  (define make-uniform-vector dimensions->uniform-array)
+  ;      (define uniform-vector-ref array-ref)
+  (define (uniform-vector-set! u i o)
+    (uniform-array-set1! u o i))
+  (define uniform-vector-fill! array-fill!)
+  (define uniform-vector-read! uniform-array-read!)
+  (define uniform-vector-write uniform-array-write)
+
+  (define (make-array fill . args)
+    (dimensions->uniform-array args () fill))
+  (define (make-uniform-array prot . args)
+    (dimensions->uniform-array args prot))
+  (define (list->array ndim lst)
+    (list->uniform-array ndim '() lst))
+  (define (list->uniform-vector prot lst)
+    (list->uniform-array 1 prot lst))
+  (define (array-shape a)
+    (map (lambda (ind) (if (number? ind) (list 0 (+ -1 ind)) ind))
+	 (array-dimensions a))))
 
-(define uniform-vector? array?)
-(define make-uniform-vector dimensions->uniform-array)
-
-;;  (define uniform-vector-ref array-ref)
-
-(define (uniform-vector-set! u i o)
-  (uniform-array-set1! u o i))
-(define uniform-vector-fill! array-fill!)
-(define uniform-vector-read! uniform-array-read!)
-(define uniform-vector-write uniform-array-write)
-
-(define (make-array fill . args)
-  (dimensions->uniform-array args () fill))
-(define (make-uniform-array prot . args)
-  (dimensions->uniform-array args prot))
-(define (list->array ndim lst)
-  (list->uniform-array ndim '() lst))
-(define (list->uniform-vector prot lst)
-  (list->uniform-array 1 prot lst))
-(define (array-shape a)
-  (map (lambda (ind) (if (number? ind) (list 0 (+ -1 ind)) ind))
-       (array-dimensions a)))
-
-(let ((make-array-proc (lambda (template)
-			 (lambda (c port)
-			   (read:uniform-vector template port)))))
-  (for-each (lambda (char template)
-	      (read-hash-extend char
-				(make-array-proc template)))
-	    '(#\b #\a #\u #\e #\s #\i #\c #\y   #\h #\l)
-	    '(#t  #\a 1   -1  1.0 1/3 0+i #\nul s   l)))
-
-(let ((array-proc (lambda (c port)
-		    (read:array c port))))
-  (for-each (lambda (char) (read-hash-extend char array-proc))
-		  '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)))
-
-(define (read:array digit port)
-  (define chr0 (char->integer #\0))
-  (let ((rank (let readnum ((val (- (char->integer digit) chr0)))
-		(if (char-numeric? (peek-char port))
-		    (readnum (+ (* 10 val)
-				(- (char->integer (read-char port)) chr0)))
-		    val)))
-	(prot (if (eq? #\( (peek-char port))
-		  '()
-		  (let ((c (read-char port)))
-		    (case c ((#\b) #t)
-			  ((#\a) #\a)
-			  ((#\u) 1)
-			  ((#\e) -1)
-			  ((#\s) 1.0)
-			  ((#\i) 1/3)
-			  ((#\c) 0+i)
-			  (else (error "read:array unknown option " c)))))))
-    (if (eq? (peek-char port) #\()
-	(list->uniform-array rank prot (read port))
-	(error "read:array list not found"))))
-
-(define (read:uniform-vector proto port)
-  (if (eq? #\( (peek-char port))
-      (list->uniform-array 1 proto (read port))
-      (error "read:uniform-vector list not found")))
diff --git a/ice-9/check-version.scm b/ice-9/check-version.scm
new file mode 100644
index 000000000..fd3c9e8e6
--- /dev/null
+++ b/ice-9/check-version.scm
@@ -0,0 +1,22 @@
+
+;;; {Check that the interpreter and scheme code match up.}
+
+(let ((show-line
+       (lambda args
+	 (with-output-to-port (current-error-port)
+	   (lambda ()
+	     (display (car (command-line)))
+	     (display ": ")
+	     (for-each (lambda (string) (display string))
+		       args) 
+	     (newline))))))
+
+  (load-from-path "ice-9/version.scm")
+
+  (if (not (string=?
+	    (libguile-config-stamp)	; from the interprpreter
+	    (ice-9-config-stamp)))	; from the Scheme code
+      (begin
+	(show-line "warning: different versions of libguile and ice-9:")
+	(show-line "libguile: configured on " (libguile-config-stamp))
+	(show-line "ice-9:    configured on " (ice-9-config-stamp)))))
diff --git a/ice-9/config.scm b/ice-9/config.scm
new file mode 100644
index 000000000..f31bddd4d
--- /dev/null
+++ b/ice-9/config.scm
@@ -0,0 +1,830 @@
+;;;; This is the (ice-9 config) module.  It exports the module
+;;;; configuration language and creates the (user guile) module.
+
+;; from r4rs
+(define (call-with-current-continuation proc)
+  (@call-with-current-continuation proc))
+
+
+;; the export list
+(define the-module-exports 
+  '(the-module 
+    module 
+    module-go 
+    go 
+    module-ref
+    module-open     
+    module-protect  
+    module-export   
+    module-export   
+    module-access   
+    module-close    
+    module-create   
+    module-use      
+    (module-use (alias use-modules))
+    (module-export (alias export))
+    (module-export (alias export-syntax))
+    define-module 
+    define-public
+    module-config-export
+    module-config-protect
+    module-config-open
+    (define-public (alias define*))
+    (define (alias define-private))
+    symbol-property
+    set-symbol-property!
+    remove-symbol-property!
+    (remove-symbol-property! (alias symbol-property-remove!))
+    ))
+
+(define the-module-protects 
+  '(module-eval-environment
+    module-interface-environment
+    module-package-name
+    module-name))
+
+
+
+
+;;; Symbol properties
+(define symbol-property
+  (procedure->memoizing-macro
+   (lambda (x env)
+     `(,environment-symbol-property (the-environment) ,(cadr x) ,(caddr x) ))))
+
+(define set-symbol-property!
+  (procedure->memoizing-macro
+   (lambda (x env)
+     `(,environment-set-symbol-property! (the-environment)  ,(cadr x) ,(caddr x) ,(cadddr x) ))))
+
+(define remove-symbol-property!
+  (procedure->memoizing-macro
+   (lambda (x env)
+     `(,environment-remove-symbol-property! (the-environment) ,(cadr x) ,(caddr x) ))))
+
+
+;;; {Error Handling}
+;;;
+
+;; from ice-9 error
+(define (error . args)
+  (if (null? args)
+      (scm-error 'misc-error #f "?" #f #f)
+      (let loop ((msg "%s")
+		 (rest (cdr args)))
+	(if (not (null? rest))
+	    (loop (string-append msg " %S")
+		  (cdr rest))
+	    (scm-error 'misc-error #f msg args #f)))))
+
+
+
+;;; {Low Level Modules}
+
+
+;; the module-signature (also called `module') maps modules to:
+;; (vector eval-env export-env protect-env package-sym module-sym)
+(define (module-eval-environment module) (vector-ref module 0))
+
+
+;;; the accessor procedures
+
+;; export environment		 
+(define (module-export-environment module) 
+  (vector-ref module 1))
+
+;;; protect environment
+(define (module-protect-environment module) 
+  (vector-ref module 2))
+
+;;; package and module name 
+(define (module-package-name module) (vector-ref module 3))
+(define (module-name module) (vector-ref module 4))
+(define (make-module eval export protect package name) (vector eval export protect package name (list )))
+
+;; Return the interface environment for module.  The interface is
+;; either the protect environment if the module is accessed from
+;; another package or the module's export environment
+(define module-interface-environment
+  (lambda (current-module module)
+    (if (eq? (module-package-name current-module)
+	     (module-package-name module))
+	(module-protect-environment module)
+	(module-export-environment module))))
+
+;; export-list used by define-public
+(define (module-export-list module) (vector-ref module 5))
+(define (module-set-export-list! module val) (vector-set! module 5 val))
+
+;; return the current module-signature 
+(define the-module
+  (procedure->syntax
+   (lambda (x env)
+     (let ((m (hashq-ref (environment-module-hash) (car (reverse env)))))
+       (if (not m) 
+	   (error "PANIC: Could not find module for " (car (reverse env)))
+	   m)))))
+
+
+;;; Convert a list of symbols into a package/module name
+
+;; (ice-9 my boot) -> (ice-9/my/ . boot)
+;; (boot) -> (user/ . boot)
+(define symlist->package+module
+  (lambda (symlist)
+    (if (not (pair? symlist)) (error "not a symbol list:" symlist))
+    (let ((symlist (if (null? (cdr symlist)) (cons 'user symlist) symlist)))
+      (let loop ((dirs "")
+		 (syms symlist))
+	(let ((sym (car syms)))
+	  (if (not (symbol? sym)) (error "not a valid symbol:" sym))
+	  (if (null? (cdr syms))
+	      (cons (string->symbol dirs) sym)
+	      (loop (string-append dirs sym "/") (cdr syms))))))))
+
+;; (ice-9/my/ . boot) -> ice-9/my/boot
+(define package+module->module-sym
+  (lambda (name-pair)
+    (string->symbol
+     (string-append (symbol->string (car name-pair))
+		    (symbol->string (cdr name-pair))))))
+
+;; (ice-9/my/ . boot) -> ice-9/my/
+(define package+module->package-sym
+  (lambda (name-pair)
+    (car name-pair)))
+
+;; (ice-9 my boot) -> ice-9/my/boot
+(define symlist->module-sym
+  (lambda (mod)
+    (package+module->module-sym (symlist->package+module mod))))
+
+
+;;; The implementation (low level proc. interface)
+
+;; load and evaluate package-sym module-sym in its own environment
+(define module-load-internal
+  (lambda (package-sym module-sym)
+    (let* (
+	   (skel (make-module-skeleton package-sym module-sym))
+	   (skel-env (module-eval-environment skel))
+	   (c_name (string-append (symbol->string module-sym) ".scm"))
+	   (full_name (%search-load-path c_name)))
+      
+      (if (not full_name)
+	  ;; try to invoke c-function directly
+	  (let (
+		(c_module_init (and
+				(environment-bound? (c-module-registry) module-sym)
+				(environment-ref (c-module-registry) module-sym))))
+	    (if (not c_module_init)
+		(begin
+		  ;; remove all references to the created module
+		  (environment-undefine (module-registry) module-sym)
+		  #f)
+		(begin
+		  (c_module_init skel-env)
+
+		  ;; now modify the export and protect environment so
+		  ;; that all cells are visible
+		  (let ((export (module-export-environment skel)))
+		    (interface-environment-set-interface! 
+		     export 
+		     (list (cons skel-env (environment-fold skel-env (lambda (sym val last) (cons sym last)) (list )))))
+		    (interface-environment-set-interface! (module-protect-environment skel) (list (cons export #f))))
+
+		  skel)))
+	  
+	  (begin 
+	    (primitive-load full_name skel-env)
+	    skel)))))
+
+;; load `(package module)' 
+(define module-load-proc
+  (lambda (mod)
+    (let* (
+	   (name-pair (symlist->package+module mod))
+	   (package-sym (package+module->package-sym name-pair))
+	   (module-sym (package+module->module-sym name-pair)))
+      (module-load-internal package-sym module-sym))))
+
+(define last-indent 0)
+
+;; load package-sym/module-sym only if module has not been loaded
+(define module-auto-load
+  (lambda (package-sym module-sym)
+    (let (
+	  (module (and 
+		   (environment-bound? (module-registry) module-sym) 
+		   (environment-ref (module-registry) module-sym)))
+	  (indent (lambda (count)
+	    (do ((i 0 (+ i 1))) ((= i count)) (display " ")))))
+		    
+      (if (not module)
+
+	  (begin
+	    (display "loading ") 
+	    (indent last-indent)
+	    (display module-sym) (force-output)
+	    (newline)
+
+	    (set! last-indent (+ last-indent 2))
+	    (let ((module (module-load-internal package-sym module-sym)))
+
+	      (set! last-indent (- last-indent 2))
+	      module))
+
+	  module))))
+
+;; Create a continuation to start a new repl in module.
+;; #f means: start a repl in (user config)
+(define module-go
+  (lambda (module)
+
+    (define (y-or-n? question eof-value count)
+      (let ((i-port (current-input-port))
+	    (o-port (current-output-port)))
+	(let loop ((count count))
+	  (display question o-port)
+	  (display " (y/n)? " o-port)
+	  (force-output)
+	  (let ((line (read i-port)))
+	    (cond ((eof-object? line)
+		   (newline o-port)
+		   (if (= count 0)
+		       eof-value
+		       (begin (display "I'll only ask another " o-port)
+			      (write count o-port)
+			      (display " times." o-port)
+			      (newline o-port)
+			      (loop (- count 1)))))
+		  ((< (string-length line) 1) (loop count))
+		  ((char=? (string-ref line 0) #\y) #t)
+		  ((char=? (string-ref line 0) #\n) #f)
+		  (else (loop count)))))))
+
+    (let ((guile (module-access-proc '(ice-9 repl)))
+	  (user/config (module-create (user config)))
+	  (quit  (lambda args
+		   (apply throw 'quit args))))
+      
+      ;; (user config) opens the current module (ice-9 config) and
+      ;; imports some symbols
+      (let ((interface (eval-environment-imported (module-eval-environment user/config)))
+	    (export (module-export-environment (the-module)))
+	    (import-list '(module-ref module-access module-close module-create the-module
+				      module-use define-module module module-go go
+				      (module-config-export (alias config-export))
+				      (module-config-protect (alias config-protect))
+				      (module-config-open (alias config-open)))))
+
+	(interface-environment-set-interface! interface (list (cons export import-list))))
+
+
+      (let (
+	    (top-repl (module-ref-proc (the-module) guile 'top-repl)))
+
+	(let (
+	      (in-module (call-with-current-continuation (lambda (k) (set! module-go k) module))))
+
+	  (letrec (
+	      (confirm
+	       (lambda ()
+		 (newline) 
+		 (y-or-n? "Do you really want to quit guile" #t 1)))
+		 
+	      (user-repl
+	       (lambda ()
+		 (set-interaction-environment! (module-eval-environment in-module))
+		 (let ((ret-val (top-repl in-module)))
+		   (newline)
+		   ret-val)))
+
+	      (config-repl 
+	       (lambda () 
+		 (set-interaction-environment! (module-eval-environment user/config))
+		 (top-repl user/config))))
+	  
+	    (let (
+		  (ret-val
+		   (or (and in-module (user-repl)) (config-repl))))
+
+	      (if (not (confirm)) (module-go #f))
+
+	      ret-val)))))))
+
+;; fix the interface of the guile module.
+(let* (
+       (guile-module (environment-ref (module-registry) 'ice-9/guile))
+       (guile-eval-env (module-eval-environment guile-module))
+       (guile-export-list (environment-fold guile-eval-env (lambda (sym val rest) (cons sym rest)) '()))
+       (guile-interface (list (cons guile-eval-env guile-export-list)))
+       (export (module-export-environment guile-module))
+       (protect (module-protect-environment guile-module)))
+  
+  ;; get out your barf bag ...  It is probably better to export
+  ;; %load-path from (ice-9 config) and *features* from whereever but
+  ;; not from the guile module
+  ;;
+					; export mutable
+  (for-each (lambda (s) 
+	      (set-car! (memq s guile-export-list) (list s 'mutable-location)))
+	    (list 
+	     '%load-path 
+	     '*features*
+					; complete weired ... (from r4rs.scm)
+	     '%load-hook
+	     'apply
+					; argh... (popen.scm)
+	     'gc-thunk
+	     ))
+
+
+  
+					; now set the interface
+  (interface-environment-set-interface! export guile-interface)
+  (interface-environment-set-interface! protect guile-interface))
+
+;; update the config module `(ice-9 config)'
+(let* (
+      (config-module (environment-ref (module-registry) 'ice-9/config))
+      (eval (module-eval-environment config-module))
+      (export (module-export-environment config-module))
+      (protect (module-protect-environment config-module)))
+
+  (interface-environment-set-interface! export (list (cons eval the-module-exports)))
+  (interface-environment-set-interface! protect (list (cons eval the-module-protects) (cons export #f))))
+
+;; create a simple but full-featured module.
+(define make-module-skeleton
+  (lambda (package-sym module-sym) 
+    (let* (
+	   (config-export-env (module-export-environment 
+			       (environment-ref (module-registry) 'ice-9/config)))
+	   (local (make-leaf-environment))
+	   (import (make-interface-environment (list (cons config-export-env #f))))
+	   (eval (make-eval-environment local import))
+	   (export (make-interface-environment (list (list eval)))) ;; export nothing
+	   (protect (make-interface-environment (list (cons export #f) (list eval))))
+	   (module  (make-module eval export protect package-sym module-sym)))
+
+      (hashq-set! (environment-module-hash) eval module)
+      (environment-define (module-registry) module-sym module)
+
+      module)))
+
+(define module-create-proc
+  (lambda (mod)
+    (let* (
+	   (name-pair (symlist->package+module mod))
+	   (package-sym (package+module->package-sym name-pair))
+	   (module-sym (package+module->module-sym name-pair))
+	   (module (and
+		    (environment-bound? (module-registry) module-sym) 
+		    (environment-ref (module-registry) module-sym))))
+
+      (if (not module)
+	  (let* ( 
+		 (c_name (string-append (symbol->string module-sym) ".scm"))
+		 (full_name (%search-load-path c_name)))
+	    (if (not full_name)
+		(let* (
+		       (skel (make-module-skeleton package-sym module-sym))
+		       (eval-env (module-eval-environment skel)))
+		  skel)
+		
+		(error "module exists but has not been loaded" module-sym)))
+	  (error "module exists and has been loaded" module-sym)))))
+
+
+(define module-load-error
+  (lambda (module-sym)
+    (error "module could not be loaded" module-sym)))
+
+;; add an export environment to our module skeleton or set a new
+(define (module-export-proc module export-list)
+  (let (
+	(export (module-export-environment module))
+	(eval (module-eval-environment module)))
+
+    (if (pair? (module-export-list module)) 
+	(error "You can either use `define-public' or `export', but not both."))
+    
+    (module-set-export-list! module #f) ;; can't use `define-public' anymore
+
+    (interface-environment-set-interface! export (list (cons eval export-list)))
+    (if #f #f)))
+
+;; package boundary
+(define (module-protect-proc module protect-list)
+  (let ((protect (module-protect-environment module))
+	(export (module-export-environment module))
+	(eval (module-eval-environment module)))
+    
+    (interface-environment-set-interface! protect (list (cons eval protect-list) (cons export #f)))
+    (if #f #f)))
+
+
+;; check for circular references
+;; every interface-environment has a list of environment specs
+;; an environment spec is a list of the environment and its exported symbols
+;; every eval-environment has an interface-environment
+(define referenced 
+  (lambda (environment l)
+    (letrec (
+	     (search 
+	      (lambda (l)
+		(cond ((null? l) #f) 
+		      ((eq? (caar l) environment) #t)
+	              (else 
+			(or (search (get-list-from-env (caar l)))
+			    (search (cdr l)))))))
+	     
+	     (get-list-from-env 
+	      (lambda (env)
+		(cond ((interface-environment? env) 
+			(interface-environment-interface env))
+	
+		       ((eval-environment? env)
+			(get-list-from-env (eval-environment-imported env)))
+
+		       (else (error "FIXME: unsupported environment" env))))))
+      
+      (search l))))
+		  
+		  
+(define module-access-proc
+  (lambda (mod)
+    (let* (
+	   (name-pair (symlist->package+module mod))
+	   (package-sym (package+module->package-sym name-pair))
+	   (module-sym (package+module->module-sym name-pair)))
+
+      (or (module-auto-load package-sym module-sym) 
+	  (module-load-error module-sym)))))
+
+
+;; remove module from module-registry
+(define module-close-proc
+  (lambda (mod)
+    (let* (
+	   (name-pair (symlist->package+module mod))
+	   (package-sym (package+module->package-sym name-pair))
+	   (module-sym (package+module->module-sym name-pair)))
+
+      (environment-undefine (module-registry) module-sym))))
+
+
+(define module-open-internal
+  (lambda (skel imports)
+
+    (let* (
+	  (eval (module-eval-environment skel))
+	  (import (eval-environment-imported eval)))
+      
+      (if (referenced eval imports)
+ 	  (error "Can't open modules: circular dependency for " eval))
+
+      (interface-environment-set-interface! import imports))))
+
+(define import-symlist->import-list
+  (lambda (skel import-symlist)
+    (letrec 
+	((fix-imports 
+	  (lambda (l)
+	    (cond	
+	     ((null? l) '())
+	     ((not (list? (caar l))) (cons (cons (car l) #f) (fix-imports (cdr l))))
+	     (else (cons (car l) (fix-imports (cdr l))))))))
+
+      (let* (
+	     (import-symlist (fix-imports import-symlist))
+	     (import-modlist (map (lambda (x) (cons (module-access-proc (car x)) (cdr x))) import-symlist))
+	     (import-list (map (lambda (x) (cons (module-interface-environment skel (car x)) (cdr x))) import-modlist)))
+
+ 	import-list))))
+
+(define module-open-proc
+  (lambda (skel import-symlist)
+    (module-open-internal skel (import-symlist->import-list skel import-symlist))))
+    
+(define module-use-proc
+  (lambda (skel import-symlist)
+    (let* (
+	   (eval (module-eval-environment skel))
+	   (interface-env (eval-environment-imported eval))
+	   (interface (interface-environment-interface interface-env))
+	   (import-list (import-symlist->import-list skel import-symlist)))
+
+      (module-open-internal skel (append import-list interface))
+      (if #f #f)
+      )))
+
+
+(define module-ref-proc
+  (lambda (curr module sym)
+    (let (
+	  (name (module-name module))
+	  (interface-env (module-interface-environment curr module))
+	  )
+
+      (cond
+       ((environment-bound? interface-env sym)
+	(environment-ref interface-env sym))
+       
+       (else (scm-error 'misc-error #f "Symbol `%s' is not exported from `%s'." (list sym name) #f))))))
+
+
+(define (module-proc current-module args)
+  (let*  (
+	  (mod (car args))
+	  (arglist (cdr args))
+	  (current-module-sym (module-name current-module))
+	  (sym (symlist->module-sym mod))
+	  (same-module (eq? current-module-sym sym))
+	  (has-exports (assq 'export arglist))
+	  (skel (if same-module current-module (module-create-proc mod))))
+
+    (let loop ((arglist arglist)
+	       (modules '())
+	       (exports '())
+	       (protects '()))
+
+      (if (null? arglist)
+	  (begin
+
+	    (if (not same-module) 
+		(error "Can't manipulate a foreign module's interface."))
+	    
+	    (module-open-proc skel modules)
+	    
+	    (if has-exports (module-export-proc skel exports))
+	    
+	    (module-protect-proc skel protects)
+	    )
+
+
+	  (begin
+	    (if (not (pair? (car arglist)))
+		(error  "unrecognized module argument in" current-module-sym))
+	    
+	    (let ((fkt (caar arglist)))
+	      (case fkt
+		((open)
+		 (loop (cdr arglist)
+		       (append modules (cdar arglist))
+		       exports
+		       protects))
+
+		((export)
+		 (loop (cdr arglist)
+		       modules
+		       (append exports (cdar arglist))
+		       protects))
+
+		((protect)
+		 (loop (cdr arglist)
+		       modules
+		       exports
+		       (append protects (cdar arglist))))
+		(else	
+		 (error "unrecognized module argument in"  current-module-sym)))))))))
+
+(define (go-proc module)
+  (module-go (module-access-proc module)))
+
+
+;;; High level interface
+
+;; declare a module
+(define module
+  (procedure->memoizing-macro
+   (lambda (x env)
+     `(,module-proc (,the-module) (,quote ,(cdr x) )))))
+
+;; open module and start a repl in it
+(define go
+  (procedure->memoizing-macro
+   (lambda (x env)
+     (if (not (list? (cadr x))) (error "not a list:" (cadr x)))
+     `(,go-proc (,quote ,(cadr x))))))
+
+
+;;; low level interface
+
+;; access symbol exported from module
+(define module-ref
+  (procedure->memoizing-macro
+   (lambda (x env)
+     `(,module-ref-proc (,the-module) ,(cadr x) ,(caddr x)))))
+
+;; add module to import-list
+(define module-use
+  (procedure->memoizing-macro
+   (lambda (x env)
+     `(,module-use-proc (,the-module) (,quote ,(cdr x))))))
+
+;; start a new import-list
+(define module-open
+  (procedure->memoizing-macro
+   (lambda (x env)
+     `(,module-open-proc (,the-module) (,quote ,(cdr x))))))
+
+;; load a module
+(define module-load
+  (procedure->memoizing-macro
+   (lambda (x env)
+     (if (not (
+	       list? (cadr x))) (error "not a list:" (cadr x)))
+     `(,module-load-proc (,quote ,(cadr x))))))
+
+;; publish symbols (visible to all other modules)
+(define module-protect
+  (procedure->memoizing-macro
+   (lambda (x env)
+     `(,module-protect-proc (,the-module) (,quote ,(cdr x) )))))
+
+;; make symbols visible to modules that belong the current package
+(define module-export
+  (procedure->memoizing-macro
+   (lambda (x env)
+     `(,module-export-proc (,the-module) (,quote ,(cdr x))))))
+
+;; open a module and return a handle
+(define module-access
+  (procedure->memoizing-macro
+   (lambda (x env)
+     (if (not (list? (cadr x))) (error "not a list:" (cadr x)))
+     `(,module-access-proc (,quote ,(cadr x))))))
+
+;; close a module (remove it from the module-registry)
+(define module-close
+  (procedure->memoizing-macro
+   (lambda (x env)
+     (if (not (list? (cadr x))) (error "not a list:" (cadr x)))
+     `(,module-close-proc (,quote ,(cadr x))))))
+
+;; create a in-memory module and return a handle
+(define module-create
+  (procedure->memoizing-macro
+   (lambda (x env)
+     (if (not (list? (cadr x))) (error "not a list:" (cadr x)))
+     `(,module-create-proc (,quote ,(cadr x) )))))
+
+;; import symbols from other modules
+(define module-config-open
+  (procedure->memoizing-macro
+   (lambda (x env)
+     `(,module-open-proc (,module-access-proc (,quote ,(cadr x))) (,quote ,(cddr x))))))
+
+;; make symbols visible within the current package
+(define module-config-protect
+  (procedure->memoizing-macro
+   (lambda (x env)
+     `(,module-protect-proc (,module-access-proc (,quote ,(cadr x))) (,quote ,(cddr x))))))
+
+;; make symbols visible to the world
+(define module-config-export
+  (procedure->memoizing-macro
+   (lambda (x env)
+     `(,module-export-proc (,module-access-proc (,quote ,(cadr x))) (,quote ,(cddr x))))))
+
+
+;;; For backward compatibility 
+;;; 
+
+(define (define-module-proc current-module args)
+  (let*  (
+	  (kws (cdr args))
+	  (current-module-sym (module-name current-module))
+	  (mod (car args))
+	  (sym (symlist->module-sym mod))
+
+	  ;; do not create a new module if the module names are the
+	  ;; same and the current module has not been closed
+	  (same-module (and (eq? current-module-sym sym) 
+			    (environment-bound? (module-registry) current-module-sym)))
+
+	  (skel (if same-module 
+		    current-module 
+		    (module-create-proc mod))))
+
+
+    (let loop ((kws kws)
+	       (modules '()))
+      (if (null? kws)
+	  (begin
+	    ;; append (ice-9 guile) and (ice-9 config) for convenience
+	    (module-open-proc skel (cons '(ice-9 config) (cons '(ice-9 guile) modules)))
+	    (if (not same-module) (module-go (module-access-proc mod)))
+	    )
+	  
+	  (let ((keyword (car kws)))
+	    (let ((keyword (if (keyword? keyword) (keyword->symbol keyword) keyword)))
+	      (case keyword
+		((use-module use-syntax autoload :use-module :use-syntax :autoload)
+		 (let (
+		       (mod (cadr kws)))
+		   
+		   (if (not (pair? mod))
+		       (error "unrecognized defmodule argument" kws))
+		   
+		   (loop (cddr kws)
+			 (cons mod modules))))
+		((no-backtrace :no-backtrace)
+		 (loop (cdr kws) modules))
+		(else	
+		 (error "unrecognized defmodule argument" kws)))))))))
+
+(define define-module
+  (procedure->memoizing-macro
+   (lambda (x env)
+     `(,define-module-proc (,the-module) (,quote ,(cdr x) )))))
+
+;; rewrite me 
+(define define-public 
+  (procedure->memoizing-macro
+   (lambda (x env)
+     (let ((args (cdr x)))
+       (letrec (
+		(syntax (lambda () 
+			  (error "bad syntax" (list 'define-public args))))
+		(defined-name 
+		  (lambda (n)
+		    (cond 
+		     ((symbol? n) n)
+		     ((pair? n) (defined-name (car n)))
+		     (else (syntax))))) 
+		)
+
+	 (if (null? args) (syntax))
+
+	 (let (
+	       (name (defined-name (car args))))
+
+	   `(begin
+	      (letrec (
+		       ;; according to environment proposal either
+		       ;; symbol or (sym tags)
+		       (get-symbol
+			(lambda (s)
+			  (cond 
+			   ((pair? s) (car s))
+			   (else s))))
+		       
+		       ;; test if symbol is already exported
+		       (exported?
+			(lambda (sym l)
+			  (cond
+			   ((null? l) #f)
+			   ((eq? (get-symbol (car l)) sym) #t)
+			   (else (exported? sym (cdr l)))))))
+		
+		(let* (
+		       (module-eval-environment ,module-eval-environment)
+		       (module-export-environment ,module-export-environment)
+		       (interface-environment-interface ,interface-environment-interface)
+		       (environment-bound? ,environment-bound?)
+		       (environment-ref ,environment-ref)
+		       (environment-define ,environment-define)
+		       (the-module ,the-module)
+		       (the-environment ,the-environment)
+		       (interface-environment-set-interface! ,interface-environment-set-interface!)
+		       (module-export-list ,module-export-list)
+		       
+		       (module (the-module))
+		       (eval-env (module-eval-environment module))
+		       (export (module-export-environment module))
+		       (export-list (module-export-list module))
+
+		       (val (,and (,environment-bound? eval-env ',name)
+				 (,environment-ref eval-env ',name))))
+		  
+		  (if (not (list? export-list))
+		      (,error "You can either use `define-public' or `export', but not both"))
+
+		  (if (not (memq ',name export-list))
+		      (begin
+			(environment-define eval-env ',name val)
+			(set! export-list (cons ',name export-list))
+			(,module-set-export-list! module export-list)
+			(interface-environment-set-interface! 
+			 export
+			 (list (cons eval-env export-list)))))
+
+
+		  
+		  ;; Now (re)define the var normally.  Bernard URBAN
+		  ;; suggests we use eval here to accomodate Hobbit; it lets
+		  ;; the interpreter handle the define-private form, which
+		  ;; Hobbit can't digest.
+		  (eval '(define ,@ args) (the-environment))
+
+		  )))))))))
+
+
+;; the entry point (called by (ice-9 repl))
+(define start
+  (lambda ()
+    (module-go #f)))
+
diff --git a/ice-9/defmacro.scm b/ice-9/defmacro.scm
new file mode 100644
index 000000000..c0c96a526
--- /dev/null
+++ b/ice-9/defmacro.scm
@@ -0,0 +1,114 @@
+(module (ice-9 defmacro) 
+	(open (ice-9 error) 
+	      (ice-9 provide)
+	      (ice-9 guile))
+	(export defmacro gentemp defmacro:transformer defmacro:syntax-transformer))
+	      
+
+;;; {Macros}
+;;;
+
+(define (primitive-macro? m)
+  (and (macro? m)
+       (not (macro-transformer m))))
+
+;;; {Defmacros}
+;;;
+(define macro-table (make-weak-key-hash-table 523))
+(define xformer-table (make-weak-key-hash-table 523))
+
+(define (defmacro? m)  (hashq-ref macro-table m))
+(define (assert-defmacro?! m) (hashq-set! macro-table m #t))
+(define (defmacro-transformer m) (hashq-ref xformer-table m))
+(define (set-defmacro-transformer! m t) (hashq-set! xformer-table m t))
+
+(define defmacro:transformer
+  (lambda (f)
+    (let* ((xform (lambda (exp env)
+		    (copy-tree (apply f (cdr exp)))))
+	   (a (procedure->memoizing-macro xform)))
+      (assert-defmacro?! a)
+      (set-defmacro-transformer! a f)
+      a)))
+
+
+(define defmacro
+  (let ((defmacro-transformer
+	  (lambda (name parms . body)
+	    (let ((transformer `(lambda ,parms ,@body)))
+	      `(define ,name
+		 (,(lambda (transformer)
+		     (defmacro:transformer transformer))
+		  ,transformer))))))
+    (defmacro:transformer defmacro-transformer)))
+
+
+; (defmacro defmacro-public args
+;   (define (syntax)
+;     (error "bad syntax" (list 'defmacro-public args)))
+;   (define (defined-name n)
+;     (cond
+;      ((symbol? n)	n)
+;      (else 		(syntax))))
+;   (cond
+;    ((null? args)	(syntax))
+
+;    (#t
+;     (let ((name (defined-name (car args))))
+;       `(begin
+; 	 (let* (
+; 		(module (the-module))
+; 		(eval (module-eval-environment module))
+
+; 		;; look up the old value first
+; 		(val (if (environment-bound? eval ',name)
+; 			 (environment-ref eval ',name)
+; 			 (begin
+; 			   (environment-define eval ',name #f)
+; 			   #f)))
+		
+; 		(export (module-export-environment module)))
+; 	   (if (not (environment? export))
+; 	       (let ( ;; create export environment
+; 		     (export (make-export-environment eval (list ',name))))
+; 		 (module-export-environment-set! module export)
+; )
+; 	       (environment-define export ',name val)))
+			       
+; 	 ;; Now (re)define the var normally.
+; 	 ;;
+; 	 (defmacro ,@ args))))))
+
+(define defmacro:syntax-transformer
+  (lambda (f)
+    (procedure->syntax
+     (lambda (exp env)
+       (copy-tree (apply f (cdr exp)))))))
+
+
+;; XXX - should the definition of the car really be looked up in the
+;; current module?
+
+(define (macroexpand-1 e)
+  (cond
+   ((pair? e) (let* ((a (car e))
+		     (val (and (symbol? a) (local-ref (list a)))))
+		(if (defmacro? val)
+		    (apply (defmacro-transformer val) (cdr e))
+		    e)))
+   (#t e)))
+
+(define (macroexpand e)
+  (cond
+   ((pair? e) (let* ((a (car e))
+		     (val (and (symbol? a) (local-ref (list a)))))
+		(if (defmacro? val)
+		    (macroexpand (apply (defmacro-transformer val) (cdr e)))
+		    e)))
+   (#t e)))
+
+(define (gentemp)
+  (gensym "scm:G"))
+
+(provide 'defmacro)
+
diff --git a/ice-9/error.scm b/ice-9/error.scm
new file mode 100644
index 000000000..8da006d4f
--- /dev/null
+++ b/ice-9/error.scm
@@ -0,0 +1,37 @@
+;;; {Error Handling}
+;;;
+
+(module (ice-9 error)
+	(open (ice-9 guile)
+	      ((ice-9 repl) save-stack))
+	(export error warn))
+	
+(define (error . args)
+  (save-stack)
+  (if (null? args)
+      (scm-error 'misc-error #f "?" #f #f)
+      (let loop ((msg "%s")
+		 (rest (cdr args)))
+	(if (not (null? rest))
+	    (loop (string-append msg " %S")
+		  (cdr rest))
+	    (scm-error 'misc-error #f msg args #f)))))
+
+;; bad-throw is the hook that is called upon a throw to a an unhandled
+;; key (unless the throw has four arguments, in which case
+;; it's usually interpreted as an error throw.)
+;; If the key has a default handler (a throw-handler-default property),
+;; it is applied to the throw.
+;;
+(define (bad-throw key . args)
+  (apply error "unhandled-exception:" key args))
+
+
+(define (warn . stuff)
+  (with-output-to-port (current-error-port)
+    (lambda ()
+      (newline)
+      (display ";;; WARNING ")
+      (display stuff)
+      (newline)
+      (car (last-pair stuff)))))
\ No newline at end of file
diff --git a/ice-9/files.scm b/ice-9/files.scm
new file mode 100644
index 000000000..7c150530c
--- /dev/null
+++ b/ice-9/files.scm
@@ -0,0 +1,246 @@
+(module (ice-9 files)
+
+	(open (ice-9 posix)
+	      (ice-9 guile)
+	      (ice-9 provide)
+	      ((ice-9 strorder) string=?))
+
+	(export scm-line-incrementors 
+		read-line
+		file-exists?
+		file-is-directory?
+		has-suffix?
+		load-from-path
+		(dev (alias stat:dev))
+		(ino (alias stat:ino))
+		(mode (alias stat:mode))
+		(nlink (alias stat:nlink))
+		(uid (alias stat:uid))
+		(gid (alias stat:gid))
+		(rdev (alias stat:rdev))
+		(size (alias stat:size))
+		(atime (alias stat:atime))
+		(mtime (alias stat:mtime))
+		(ctime (alias stat:ctime))
+		(blksize (alias stat:blksize))
+		(blocks (alias stat:blocks))
+		(type (alias stat:type))
+		(perms (alias stat:perms))
+		read-delimited
+		read-delimited!
+		))
+		
+
+;;; {Line and Delimited I/O}
+
+;;; corresponds to SCM_LINE_INCREMENTORS in libguile.
+(define scm-line-incrementors "\n")
+
+(define (read-line! string . maybe-port)
+  (let* ((port (if (pair? maybe-port)
+		   (car maybe-port)
+		   (current-input-port))))
+    (let* ((rv (%read-delimited! scm-line-incrementors
+				 string
+				 #t
+				 port))
+	   (terminator (car rv))
+	   (nchars (cdr rv)))
+      (cond ((and (= nchars 0)
+		  (eof-object? terminator))
+	     terminator)
+	    ((not terminator) #f)
+	    (else nchars)))))
+
+(define (read-delimited! delims buf . args)
+  (let* ((num-args (length args))
+	 (port (if (> num-args 0)
+		   (car args)
+		   (current-input-port)))
+	 (handle-delim (if (> num-args 1)
+			   (cadr args)
+			   'trim))
+	 (start (if (> num-args 2)
+		    (caddr args)
+		    0))
+	 (end (if (> num-args 3)
+		  (cadddr args)
+		  (string-length buf))))
+    (let* ((rv (%read-delimited! delims
+				 buf
+				 (not (eq? handle-delim 'peek))
+				 port
+				 start
+				 end))
+	   (terminator (car rv))
+	   (nchars (cdr rv)))
+      (cond ((or (not terminator)	; buffer filled
+		 (eof-object? terminator))
+	     (if (zero? nchars)
+		 (if (eq? handle-delim 'split)
+		     (cons terminator terminator)
+		     terminator)
+		 (if (eq? handle-delim 'split)
+		     (cons nchars terminator)
+		     nchars)))
+	    (else
+	     (case handle-delim
+	       ((trim peek) nchars)
+	       ((concat) (string-set! buf nchars terminator)
+			 (+ nchars 1))
+	       ((split) (cons nchars terminator))
+	       (else (error "unexpected handle-delim value: " 
+			    handle-delim))))))))
+  
+(define (read-delimited delims . args)
+  (let* ((port (if (pair? args)
+		   (let ((pt (car args)))
+		     (set! args (cdr args))
+		     pt)
+		   (current-input-port)))
+	 (handle-delim (if (pair? args)
+			   (car args)
+			   'trim)))
+    (let loop ((substrings ())
+	       (total-chars 0)
+	       (buf-size 100))		; doubled each time through.
+      (let* ((buf (make-string buf-size))
+	     (rv (%read-delimited! delims
+				   buf
+				   (not (eq? handle-delim 'peek))
+				   port))
+	     (terminator (car rv))
+	     (nchars (cdr rv))
+	     (join-substrings
+	      (lambda ()
+		(apply string-append
+		       (reverse
+			(cons (if (and (eq? handle-delim 'concat)
+				       (not (eof-object? terminator)))
+				  (string terminator)
+				  "")
+			      (cons (make-shared-substring buf 0 nchars)
+				    substrings))))))
+	     (new-total (+ total-chars nchars)))
+	(cond ((not terminator)
+	       ;; buffer filled.
+	       (loop (cons (substring buf 0 nchars) substrings)
+		     new-total
+		     (* buf-size 2)))
+	      ((eof-object? terminator)
+	       (if (zero? new-total)
+		   (if (eq? handle-delim 'split)
+		       (cons terminator terminator)
+		       terminator)
+		   (if (eq? handle-delim 'split)
+		       (cons (join-substrings) terminator)
+		       (join-substrings))))
+	      (else
+	       (case handle-delim
+		   ((trim peek concat) (join-substrings))
+		   ((split) (cons (join-substrings) terminator))
+
+
+		   (else (error "unexpected handle-delim value: "
+				handle-delim)))))))))
+
+;;; read-line [PORT [HANDLE-DELIM]] reads a newline-terminated string
+;;; from PORT.  The return value depends on the value of HANDLE-DELIM,
+;;; which may be one of the symbols `trim', `concat', `peek' and
+;;; `split'.  If it is `trim' (the default), the trailing newline is
+;;; removed and the string is returned.  If `concat', the string is
+;;; returned with the trailing newline intact.  If `peek', the newline
+;;; is left in the input port buffer and the string is returned.  If
+;;; `split', the newline is split from the string and read-line
+;;; returns a pair consisting of the truncated string and the newline.
+
+(define (read-line . args)
+  (let* ((port		(if (null? args)
+			    (current-input-port)
+			    (car args)))
+	 (handle-delim	(if (> (length args) 1)
+			    (cadr args)
+			    'trim))
+	 (line/delim	(%read-line port))
+	 (line		(car line/delim))
+	 (delim		(cdr line/delim)))
+    (case handle-delim
+      ((trim) line)
+      ((split) line/delim)
+      ((concat) (if (and (string? line) (char? delim))
+		    (string-append line (string delim))
+		    line))
+      ((peek) (if (char? delim)
+		  (unread-char delim port))
+	      line)
+      (else
+       (error "unexpected handle-delim value: " handle-delim)))))
+
+
+
+;;; {Files}
+;;;
+;;; If no one can explain this comment to me by 31 Jan 1998, I will
+;;; assume it is meaningless and remove it. -twp
+;;;   !!!! these should be implemented using Tcl commands, not fports.
+
+;; Using the vector returned by stat directly is probably not a good
+;; idea (it could just as well be a record).  Hence some accessors.
+(define (dev f) (vector-ref f 0))
+(define (ino f) (vector-ref f 1))
+(define (mode f) (vector-ref f 2))
+(define (nlink f) (vector-ref f 3))
+(define (uid f) (vector-ref f 4))
+(define (gid f) (vector-ref f 5))
+(define (rdev f) (vector-ref f 6))
+(define (size f) (vector-ref f 7))
+(define (atime f) (vector-ref f 8))
+(define (mtime f) (vector-ref f 9))
+(define (ctime f) (vector-ref f 10))
+(define (blksize f) (vector-ref f 11))
+(define (blocks f) (vector-ref f 12))
+
+;; derived from stat mode.
+(define (type f) (vector-ref f 13))
+(define (perms f) (vector-ref f 14))
+
+(define file-exists?
+  (if (feature? 'posix)
+      (lambda (str)
+	(access? str F_OK))
+      (lambda (str)
+	(let ((port (catch 'system-error (lambda () (open-file str OPEN_READ))
+			   (lambda args #f))))
+	  (if port (begin (close-port port) #t)
+	      #f)))))
+
+(define file-is-directory?
+  (if (feature? 'i/o-extensions)
+      (lambda (str)
+	(eq? (type (stat str)) 'directory))
+      (lambda (str)
+	(display str)
+	(newline)
+	(let ((port (catch 'system-error
+			   (lambda () (open-file (string-append str "/.")
+						 OPEN_READ))
+			   (lambda args #f))))
+	  (if port (begin (close-port port) #t)
+	      #f)))))
+
+(define (has-suffix? str suffix)
+  (let ((sufl (string-length suffix))
+	(sl (string-length str)))
+    (and (> sl sufl)
+	 (string=? (substring str (- sl sufl) sl) suffix))))
+
+
+;;; {Loading by paths}
+
+;;; Load a Scheme source file named NAME, searching for it in the
+;;; directories listed in %load-path, and applying each of the file
+;;; name extensions listed in %load-extensions.
+(define (load-from-path name)
+  (start-stack 'load-stack
+	       (primitive-load-path name (interaction-environment))))
+
diff --git a/ice-9/hooks.scm b/ice-9/hooks.scm
new file mode 100644
index 000000000..a6e4f6c6b
--- /dev/null
+++ b/ice-9/hooks.scm
@@ -0,0 +1,23 @@
+;;; {Hooks}
+;;;
+;;; Warning: Hooks are now first class objects and add-hook! and remove-hook!
+;;; procedures.  This interface is only provided for backward compatibility
+;;; and will be removed.
+;;;
+(module-open (ice-9 guile))
+(if (not (defined? new-add-hook!))
+    (begin
+      (define new-add-hook! add-hook!)
+      (define new-remove-hook! remove-hook!)))
+
+(define (run-hooks hook)
+  (if (and (pair? hook) (eq? (car hook) 'hook))
+      (run-hook hook)
+      (for-each (lambda (thunk) (thunk)) hook)))
+
+(define *suppress-old-style-hook-warning* #f)
+
+(define abort-hook (make-hook))
+
+
+
diff --git a/ice-9/keywords.scm b/ice-9/keywords.scm
new file mode 100644
index 000000000..da45f046a
--- /dev/null
+++ b/ice-9/keywords.scm
@@ -0,0 +1,15 @@
+
+;;; {Keywords}
+;;;
+
+(define (symbol->keyword symbol)
+  (make-keyword-from-dash-symbol (symbol-append '- symbol)))
+
+(define (keyword->symbol kw)
+  (let ((sym (keyword-dash-symbol kw)))
+    (string->symbol (substring sym 1 (string-length sym)))))
+
+(define (kw-arg-ref args kw)
+  (let ((rem (member kw args)))
+    (and rem (pair? (cdr rem)) (cadr rem))))
+
diff --git a/ice-9/lists.scm b/ice-9/lists.scm
new file mode 100644
index 000000000..654bab60e
--- /dev/null
+++ b/ice-9/lists.scm
@@ -0,0 +1,23 @@
+;;; {Lists}
+;;;
+(module (ice-9 lists)
+	(open (ice-9 guile))
+	(export list-index make-list))
+	      
+(define (list-index l k)
+  (let loop ((n 0)
+	     (l l))
+    (and (not (null? l))
+	 (if (eq? (car l) k)
+	     n
+	     (loop (+ n 1) (cdr l))))))
+
+(define (make-list n . init)
+  (if (pair? init) (set! init (car init)))
+  (let loop ((answer '())
+	     (n n))
+    (if (<= n 0)
+	answer
+	(loop (cons init answer) (- n 1)))))
+
+
diff --git a/ice-9/macros.scm b/ice-9/macros.scm
new file mode 100644
index 000000000..e697861d1
--- /dev/null
+++ b/ice-9/macros.scm
@@ -0,0 +1,28 @@
+;;; {Macros}
+;;;
+
+;; actually....hobbit might be able to hack these with a little
+;; coaxing
+;;
+(module (ice-9 macros)
+	(export define-macro define-syntax-macro defmacro:transformer defmacro:syntax-transformer)
+	(open (ice-9 guile) (ice-9 defmacro)))
+
+
+(defmacro define-macro (first . rest)
+  (let ((name (if (symbol? first) first (car first)))
+	(transformer
+	 (if (symbol? first)
+	     (car rest)
+	     `(lambda ,(cdr first) ,@rest))))
+    `(define ,name (defmacro:transformer ,transformer))))
+
+
+(defmacro define-syntax-macro (first . rest)
+  (let ((name (if (symbol? first) first (car first)))
+	(transformer
+	 (if (symbol? first)
+	     (car rest)
+	     `(lambda ,(cdr first) ,@rest))))
+    `(define ,name (defmacro:syntax-transformer ,transformer))))
+
diff --git a/ice-9/math.scm b/ice-9/math.scm
new file mode 100644
index 000000000..f60d284e1
--- /dev/null
+++ b/ice-9/math.scm
@@ -0,0 +1,102 @@
+
+;;; {Transcendental Functions}
+;;;
+;;; Derived from "Transcen.scm", Complex trancendental functions for SCM.
+;;; Written by Jerry D. Hedden, (C) FSF.
+;;; See the file `COPYING' for terms applying to this program.
+;;;
+
+(define (exp z)
+  (if (real? z) ($exp z)
+      (make-polar ($exp (real-part z)) (imag-part z))))
+
+(define (log z)
+  (if (and (real? z) (>= z 0))
+      ($log z)
+      (make-rectangular ($log (magnitude z)) (angle z))))
+
+(define (sqrt z)
+  (if (real? z)
+      (if (negative? z) (make-rectangular 0 ($sqrt (- z)))
+	  ($sqrt z))
+      (make-polar ($sqrt (magnitude z)) (/ (angle z) 2))))
+
+(define expt
+  (let ((integer-expt integer-expt))
+    (lambda (z1 z2)
+      (cond ((exact? z2)
+	     (integer-expt z1 z2))
+	    ((and (real? z2) (real? z1) (>= z1 0))
+	     ($expt z1 z2))
+	    (else
+	     (exp (* z2 (log z1))))))))
+
+(define (sinh z)
+  (if (real? z) ($sinh z)
+      (let ((x (real-part z)) (y (imag-part z)))
+	(make-rectangular (* ($sinh x) ($cos y))
+			  (* ($cosh x) ($sin y))))))
+(define (cosh z)
+  (if (real? z) ($cosh z)
+      (let ((x (real-part z)) (y (imag-part z)))
+	(make-rectangular (* ($cosh x) ($cos y))
+			  (* ($sinh x) ($sin y))))))
+(define (tanh z)
+  (if (real? z) ($tanh z)
+      (let* ((x (* 2 (real-part z)))
+	     (y (* 2 (imag-part z)))
+	     (w (+ ($cosh x) ($cos y))))
+	(make-rectangular (/ ($sinh x) w) (/ ($sin y) w)))))
+
+(define (asinh z)
+  (if (real? z) ($asinh z)
+      (log (+ z (sqrt (+ (* z z) 1))))))
+
+(define (acosh z)
+  (if (and (real? z) (>= z 1))
+      ($acosh z)
+      (log (+ z (sqrt (- (* z z) 1))))))
+
+(define (atanh z)
+  (if (and (real? z) (> z -1) (< z 1))
+      ($atanh z)
+      (/ (log (/ (+ 1 z) (- 1 z))) 2)))
+
+(define (sin z)
+  (if (real? z) ($sin z)
+      (let ((x (real-part z)) (y (imag-part z)))
+	(make-rectangular (* ($sin x) ($cosh y))
+			  (* ($cos x) ($sinh y))))))
+(define (cos z)
+  (if (real? z) ($cos z)
+      (let ((x (real-part z)) (y (imag-part z)))
+	(make-rectangular (* ($cos x) ($cosh y))
+			  (- (* ($sin x) ($sinh y)))))))
+(define (tan z)
+  (if (real? z) ($tan z)
+      (let* ((x (* 2 (real-part z)))
+	     (y (* 2 (imag-part z)))
+	     (w (+ ($cos x) ($cosh y))))
+	(make-rectangular (/ ($sin x) w) (/ ($sinh y) w)))))
+
+(define (asin z)
+  (if (and (real? z) (>= z -1) (<= z 1))
+      ($asin z)
+      (* -i (asinh (* +i z)))))
+
+(define (acos z)
+  (if (and (real? z) (>= z -1) (<= z 1))
+      ($acos z)
+      (+ (/ (angle -1) 2) (* +i (asinh (* +i z))))))
+
+(define (atan z . y)
+  (if (null? y)
+      (if (real? z) ($atan z)
+	  (/ (log (/ (- +i z) (+ +i z))) +2i))
+      ($atan2 z (car y))))
+
+(set! abs magnitude)
+
+(define (log10 arg)
+  (/ (log arg) (log 10)))
+
diff --git a/ice-9/misc.scm b/ice-9/misc.scm
new file mode 100644
index 000000000..6c892e7d7
--- /dev/null
+++ b/ice-9/misc.scm
@@ -0,0 +1,333 @@
+(module (ice-9 misc)
+	(export in-vicinity with-fluids)
+	(open (ice-9 structs) (ice-9 files) (ice-9 defmacro) (ice-9 provide) (ice-9 guile)))
+
+
+
+;;; {Simple Debugging Tools}
+;;
+
+;; peek takes any number of arguments, writes them to the
+;; current ouput port, and returns the last argument.
+;; It is handy to wrap around an expression to look at
+;; a value each time is evaluated, e.g.:
+;;
+;;	(+ 10 (troublesome-fn))
+;;	=> (+ 10 (pk 'troublesome-fn-returned (troublesome-fn)))
+;;
+
+(define (peek . stuff)
+  (newline)
+  (display ";;; ")
+  (write stuff)
+  (newline)
+  (car (last-pair stuff)))
+
+(define pk peek)
+
+
+
+
+;;; {Trivial Functions}
+;;;
+
+(define (id x) x)
+(define (1+ n) (+ n 1))
+(define (-1+ n) (+ n -1))
+(define 1- -1+)
+(define return-it noop)
+(define (and=> value procedure) (and value (procedure value)))
+(define (make-hash-table k) (make-vector k '()))
+
+;;; apply-to-args is functionally redunant with apply and, worse,
+;;; is less general than apply since it only takes two arguments.
+;;;
+;;; On the other hand, apply-to-args is a syntacticly convenient way to 
+;;; perform binding in many circumstances when the "let" family of
+;;; of forms don't cut it.  E.g.:
+;;;
+;;;	(apply-to-args (return-3d-mouse-coords)
+;;;	  (lambda (x y z) 
+;;;		...))
+;;;
+
+(define (apply-to-args args fn) (apply fn args))
+
+
+;;; {Integer Math}
+;;;
+
+(define (ipow-by-squaring x k acc proc)
+  (cond ((zero? k) acc)
+	((= 1 k) (proc acc x))
+	(else (ipow-by-squaring (proc x x)
+				(quotient k 2)
+				(if (even? k) acc (proc acc x))
+				proc))))
+
+(define string-character-length string-length)
+
+
+
+;; A convenience function for combining flag bits.  Like logior, but
+;; handles the cases of 0 and 1 arguments.
+;;
+(define (flags . args)
+  (cond
+   ((null? args) 0)
+   ((null? (cdr args)) (car args))
+   (else (apply logior args))))
+
+
+;;; {Multiple return values}
+
+(define *values-rtd*
+  (make-record-type "values"
+		    '(values)))
+
+(define values
+  (let ((make-values (record-constructor *values-rtd*)))
+    (lambda x
+      (if (and (not (null? x))
+	       (null? (cdr x)))
+	  (car x)
+	  (make-values x)))))
+
+(define call-with-values
+  (let ((access-values (record-accessor *values-rtd* 'values))
+	(values-predicate? (record-predicate *values-rtd*)))
+    (lambda (producer consumer)
+      (let ((result (producer)))
+	(if (values-predicate? result)
+	    (apply consumer (access-values result))
+	    (consumer result))))))
+
+
+
+;;; {and-map and or-map}
+;;;
+;;; (and-map fn lst) is like (and (fn (car lst)) (fn (cadr lst)) (fn...) ...)
+;;; (or-map fn lst) is like (or (fn (car lst)) (fn (cadr lst)) (fn...) ...)
+;;; (map-in-order fn lst) is like (map fn lst) but definately in order of lst.
+;;;
+
+;; and-map f l
+;;
+;; Apply f to successive elements of l until exhaustion or f returns #f.
+;; If returning early, return #f.  Otherwise, return the last value returned
+;; by f.  If f has never been called because l is empty, return #t.
+;; 
+(define (and-map f lst)
+  (let loop ((result #t)
+	     (l lst))
+    (and result
+	 (or (and (null? l)
+		  result)
+	     (loop (f (car l)) (cdr l))))))
+
+;; or-map f l
+;;
+;; Apply f to successive elements of l until exhaustion or while f returns #f.
+;; If returning early, return the return value of f.
+;;
+(define (or-map f lst)
+  (let loop ((result #f)
+	     (l lst))
+    (or result
+	(and (not (null? l))
+	     (loop (f (car l)) (cdr l))))))
+
+
+;;; {Booleans}
+;;;
+
+(define (->bool x) (not (not x)))
+
+
+;;; {Load Paths}
+;;;
+
+;;; Here for backward compatability
+;;
+(define scheme-file-suffix (lambda () ".scm"))
+
+(define (in-vicinity vicinity file)
+  (let ((tail (let ((len (string-length vicinity)))
+		(if (zero? len)
+		    #f
+		    (string-ref vicinity (- len 1))))))
+    (string-append vicinity
+		   (if (or (not tail)
+			   (eq? tail #\/))
+		       ""
+		       "/")
+		   file)))
+
+
+;;; {Help for scm_shell}
+;;; The argument-processing code used by Guile-based shells generates
+;;; Scheme code based on the argument list.  This page contains help
+;;; functions for the code it generates.
+
+(define (command-line) (program-arguments))
+
+;; This is mostly for the internal use of the code generated by
+;; scm_compile_shell_switches.
+(define (load-user-init)
+  (define (has-init? dir)
+    (let ((path (in-vicinity dir ".guile")))
+      (catch 'system-error 
+	     (lambda ()
+	       (let ((stats (stat path)))
+		 (if (not (eq? (stat:type stats) 'directory))
+		     path)))
+	     (lambda dummy #f))))
+  (let ((path (or (has-init? (or (getenv "HOME") "/"))
+                  (has-init? (passwd:dir (getpw (getuid)))))))
+    (if path (primitive-load path))))
+
+
+
+;;; {Reader Extensions}
+;;;
+
+;;; Reader code for various "#c" forms.
+;;;
+
+;;; Parse the portion of a #/ list that comes after the first slash.
+(define (read-path-list-notation slash port)
+  (letrec 
+      
+      ;; Is C a delimiter?
+      ((delimiter? (lambda (c) (or (eof-object? c)
+				   (char-whitespace? c)
+				   (string-index "()\";" c))))
+
+       ;; Read and return one component of a path list.
+       (read-component
+	(lambda ()
+	  (let loop ((reversed-chars '()))
+	    (let ((c (peek-char port)))
+	      (if (or (delimiter? c)
+		      (char=? c #\/))
+		  (string->symbol (list->string (reverse reversed-chars)))
+		  (loop (cons (read-char port) reversed-chars))))))))
+
+    ;; Read and return a path list.
+    (let loop ((reversed-path (list (read-component))))
+      (let ((c (peek-char port)))
+	(if (and (char? c) (char=? c #\/))
+	    (begin
+	      (read-char port)
+	      (loop (cons (read-component) reversed-path)))
+	    (reverse reversed-path))))))
+
+(define (read-path-list-notation-warning slash port)
+  (if (not (getenv "GUILE_HUSH"))
+      (begin
+	(display "warning: obsolete `#/' list notation read from "
+		 (current-error-port))
+	(display (port-filename port) (current-error-port))
+	(display "; see guile-core/NEWS." (current-error-port))
+	(newline (current-error-port))
+	(display "         Set the GUILE_HUSH environment variable to disable this warning."
+		 (current-error-port))
+	(newline (current-error-port))))
+  (read-hash-extend #\/ read-path-list-notation)
+  (read-path-list-notation slash port))
+
+
+(read-hash-extend #\' (lambda (c port)
+			(read port)))
+(read-hash-extend #\. (lambda (c port)
+			(eval (read port) (the-environment))))
+
+(if (feature? 'array)
+    (begin
+      (let ((make-array-proc (lambda (template)
+			       (lambda (c port)
+				 (read:uniform-vector template port)))))
+	(for-each (lambda (char template)
+		    (read-hash-extend char
+				      (make-array-proc template)))
+		  '(#\b #\a #\u #\e #\s #\i #\c #\y   #\h)
+		  '(#t  #\a 1   -1  1.0 1/3 0+i #\nul s)))
+      (let ((array-proc (lambda (c port)
+			  (read:array c port))))
+	(for-each (lambda (char) (read-hash-extend char array-proc))
+		  '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)))))
+
+;; pushed to the beginning of the alist since it's used more than the
+;; others at present.
+(read-hash-extend #\/ read-path-list-notation-warning)
+
+(define (read:array digit port)
+  (define chr0 (char->integer #\0))
+  (let ((rank (let readnum ((val (- (char->integer digit) chr0)))
+		(if (char-numeric? (peek-char port))
+		    (readnum (+ (* 10 val)
+				(- (char->integer (read-char port)) chr0)))
+		    val)))
+	(prot (if (eq? #\( (peek-char port))
+		  '()
+		  (let ((c (read-char port)))
+		    (case c ((#\b) #t)
+			  ((#\a) #\a)
+			  ((#\u) 1)
+			  ((#\e) -1)
+			  ((#\s) 1.0)
+			  ((#\i) 1/3)
+			  ((#\c) 0+i)
+			  (else (error "read:array unknown option " c)))))))
+    (if (eq? (peek-char port) #\()
+	(list->uniform-array rank prot (read port))
+	(error "read:array list not found"))))
+
+(define (read:uniform-vector proto port)
+  (if (eq? #\( (peek-char port))
+      (list->uniform-array 1 proto (read port))
+      (error "read:uniform-vector list not found")))
+
+
+;;; {IOTA functions: generating lists of numbers}
+
+(define (reverse-iota n) (if (> n 0) (cons (1- n) (reverse-iota (1- n))) '()))
+(define (iota n) (reverse! (reverse-iota n)))
+
+
+;;; {While}
+;;;
+;;; with `continue' and `break'.
+;;;
+
+(defmacro while (cond . body)
+  `(letrec ((continue (lambda () (or (not ,cond) (begin (begin ,@ body) (continue)))))
+	    (break (lambda val (apply throw 'break val))))
+     (catch 'break
+	    (lambda () (continue))
+	    (lambda v (cadr v)))))
+
+;;; {collect}
+;;;
+;;; Similar to `begin' but returns a list of the results of all constituent
+;;; forms instead of the result of the last form.
+;;; (The definition relies on the current left-to-right
+;;;  order of evaluation of operands in applications.)
+
+(defmacro collect forms
+  (cons 'list forms))
+
+;;; {with-fluids}
+
+;; with-fluids is a convenience wrapper for the builtin procedure
+;; `with-fluids*'.  The syntax is just like `let':
+;;
+;;  (with-fluids ((fluid val)
+;;                ...)
+;;     body)
+
+(defmacro with-fluids (bindings . body)
+  `(with-fluids* (list ,@(map car bindings)) (list ,@(map cadr bindings))
+		 (lambda () ,@body)))
+
+
diff --git a/ice-9/modules.scm b/ice-9/modules.scm
new file mode 100644
index 000000000..630a6e697
--- /dev/null
+++ b/ice-9/modules.scm
@@ -0,0 +1,82 @@
+;;; this is an add-on module for those who want to "load" the module
+;;; system.
+
+
+;; load the standard module system and add the module which exports
+;; the module configuration language to the current module's import
+;; list
+(eval
+ `(letrec (
+	   
+
+					; return #f if module system
+					; has already been loaded
+	   (load-module-system
+
+	    (let (
+		  (load-sys-modules
+		   (lambda (repl-env)
+		     (if (not (environment-bound? (module-registry) 'ice-9/config))
+			 (begin
+			   (eval '(make-guile-module) repl-env)
+			   (eval '(make-repl-module) repl-env)
+			   (eval '(make-user-module) repl-env)
+			   (let (
+				 (ice-9/config (eval '(make-config-module) repl-env)))
+			     (primitive-load-path "ice-9/config.scm" (vector-ref ice-9/config 0))
+			     #t))
+			 #f))))
+	      
+	      (lambda ()
+					; the code that creates system
+					; modules comes from the repl
+					; module.
+		
+		(if (not (environment-bound? (module-registry) 'ice-9/repl))
+		    
+		    (let* (
+			   (import (make-interface-environment (list (cons (scheme-guile-environment 2) #t))))
+			   (eval-env (make-eval-environment (make-leaf-environment) import)))
+		      (primitive-load-path "ice-9/repl.scm" eval-env) 
+		      (load-sys-modules eval-env))
+		    (let* (
+			   (repl-module (environment-ref (module-registry) 'ice-9/repl))
+			   (eval-env (vector-ref repl-module 0)))
+		      (load-sys-modules eval-env))))))
+	    
+					; fix current interface
+	   (set-new-interface 
+	    (lambda (current-interface-env)
+	      (let (
+		    (guile-export (vector-ref (environment-ref (module-registry) 'ice-9/guile) 1))
+		    (config-export (vector-ref (environment-ref (module-registry) 'ice-9/config) 1)))
+		
+		(interface-environment-set-interface! 
+		 current-interface-env
+		 (list (cons config-export #f) (cons guile-export #f))))))
+	   
+	   
+					; append config-export to
+					; current interface
+	   (append-interface 
+	    (lambda (current-interface-env)
+	      (let (
+		    (import-interface (interface-environment-interface current-interface-env))
+		    (config-export (vector-ref (environment-ref (module-registry) 'ice-9/config) 1)))
+		
+		(if (not (assq config-export import-interface))
+		    (interface-environment-set-interface!
+		     current-interface-env
+		     (cons (cons config-export #t) import-interface)))))))
+    
+    (let* (
+	   (current-eval-env ,(the-environment))
+	   (current-interface-env (eval-environment-imported current-eval-env)))
+      
+      (if (load-module-system)
+	  (set-new-interface  current-interface-env)
+	  (append-interface current-interface-env))))
+
+ (scheme-guile-environment 2))
+
+
diff --git a/ice-9/options.scm b/ice-9/options.scm
new file mode 100644
index 000000000..8bc3e3fe7
--- /dev/null
+++ b/ice-9/options.scm
@@ -0,0 +1,223 @@
+(define-module (ice-9 options) :use-module (ice-9 defmacro))
+;;; {Command Line Options}
+;;;
+
+(define (get-option argv kw-opts kw-args return)
+  (cond
+   ((null? argv)
+    (return #f #f argv))
+
+   ((or (not (eq? #\- (string-ref (car argv) 0)))
+	(eq? (string-length (car argv)) 1))
+    (return 'normal-arg (car argv) (cdr argv)))
+
+   ((eq? #\- (string-ref (car argv) 1))
+    (let* ((kw-arg-pos (or (string-index (car argv) #\=)
+			   (string-length (car argv))))
+	   (kw (symbol->keyword (substring (car argv) 2 kw-arg-pos)))
+	   (kw-opt? (member kw kw-opts))
+	   (kw-arg? (member kw kw-args))
+	   (arg (or (and (not (eq? kw-arg-pos (string-length (car argv))))
+			 (substring (car argv)
+				    (+ kw-arg-pos 1)
+				    (string-length (car argv))))
+		    (and kw-arg?
+			 (begin (set! argv (cdr argv)) (car argv))))))
+      (if (or kw-opt? kw-arg?)
+	  (return kw arg (cdr argv))
+	  (return 'usage-error kw (cdr argv)))))
+
+   (else
+    (let* ((char (substring (car argv) 1 2))
+	   (kw (symbol->keyword char)))
+      (cond
+
+       ((member kw kw-opts)
+	(let* ((rest-car (substring (car argv) 2 (string-length (car argv))))
+	       (new-argv (if (= 0 (string-length rest-car))
+			     (cdr argv)
+			     (cons (string-append "-" rest-car) (cdr argv)))))
+	  (return kw #f new-argv)))
+
+       ((member kw kw-args)
+	(let* ((rest-car (substring (car argv) 2 (string-length (car argv))))
+	       (arg (if (= 0 (string-length rest-car))
+			(cadr argv)
+			rest-car))
+	       (new-argv (if (= 0 (string-length rest-car))
+			     (cddr argv)
+			     (cdr argv))))
+	  (return kw arg new-argv)))
+
+       (else (return 'usage-error kw argv)))))))
+
+(define (for-next-option proc argv kw-opts kw-args)
+  (let loop ((argv argv))
+    (get-option argv kw-opts kw-args
+		(lambda (opt opt-arg argv)
+		  (and opt (proc opt opt-arg argv loop))))))
+
+(define (display-usage-report kw-desc)
+  (for-each
+   (lambda (kw)
+     (or (eq? (car kw) #t)
+	 (eq? (car kw) 'else)
+	 (let* ((opt-desc kw)
+		(help (cadr opt-desc))
+		(opts (car opt-desc))
+		(opts-proper (if (string? (car opts)) (cdr opts) opts))
+		(arg-name (if (string? (car opts))
+			      (string-append "<" (car opts) ">")
+			      ""))
+		(left-part (string-append
+			    (with-output-to-string
+			      (lambda ()
+				(map (lambda (x) (display (keyword-symbol x)) (display " "))
+				     opts-proper)))
+			    arg-name))
+		(middle-part (if (and (< (string-length left-part) 30)
+				      (< (string-length help) 40))
+				 (make-string (- 30 (string-length left-part)) #\ )
+				 "\n\t")))
+	   (display left-part)
+	   (display middle-part)
+	   (display help)
+	   (newline))))
+   kw-desc))
+		  
+
+	   
+(define (transform-usage-lambda cases)
+  (let* ((raw-usage (delq! 'else (map car cases)))
+	 (usage-sans-specials (map (lambda (x)
+				    (or (and (not (list? x)) x)
+					(and (symbol? (car x)) #t)
+					(and (boolean? (car x)) #t)
+					x))
+				  raw-usage))
+	 (usage-desc (delq! #t usage-sans-specials))
+	 (kw-desc (map car usage-desc))
+	 (kw-opts (apply append (map (lambda (x) (and (not (string? (car x))) x)) kw-desc)))
+	 (kw-args (apply append (map (lambda (x) (and (string? (car x)) (cdr x))) kw-desc)))
+	 (transmogrified-cases (map (lambda (case)
+				      (cons (let ((opts (car case)))
+					      (if (or (boolean? opts) (eq? 'else opts))
+						  opts
+						  (cond
+						   ((symbol? (car opts))  opts)
+						   ((boolean? (car opts)) opts)
+						   ((string? (caar opts)) (cdar opts))
+						   (else (car opts)))))
+					    (cdr case)))
+				    cases)))
+    `(let ((%display-usage (lambda () (display-usage-report ',usage-desc))))
+       (lambda (%argv)
+	 (let %next-arg ((%argv %argv))
+	   (get-option %argv
+		       ',kw-opts
+		       ',kw-args
+		       (lambda (%opt %arg %new-argv)
+			 (case %opt
+			   ,@ transmogrified-cases))))))))
+
+
+;;; {Run-time options}
+
+((let* ((names '((eval-options-interface
+		  (eval-options eval-enable eval-disable)
+		  (eval-set!))
+		 
+		 (debug-options-interface
+		  (debug-options debug-enable debug-disable)
+		  (debug-set!))
+		 
+		 (evaluator-traps-interface
+		  (traps trap-enable trap-disable)
+		  (trap-set!))
+		 
+		 (read-options-interface
+		  (read-options read-enable read-disable)
+		  (read-set!))
+		 
+		 (print-options-interface
+		  (print-options print-enable print-disable)
+		  (print-set!))
+
+		 (readline-options-interface
+		  (readline-options readline-enable readline-disable)
+		  (readline-set!))
+		 ))
+	(option-name car)
+	(option-value cadr)
+	(option-documentation caddr)
+
+	(print-option (lambda (option)
+			(display (option-name option))
+			(if (< (string-length
+				(symbol->string (option-name option)))
+			       8)
+			    (display #\tab))
+			(display #\tab)
+			(display (option-value option))
+			(display #\tab)
+			(display (option-documentation option))
+			(newline)))
+
+	;; Below follows the macros defining the run-time option interfaces.
+
+	(make-options (lambda (interface)
+			`(lambda args
+			   (cond ((null? args) (,interface))
+				 ((list? (car args))
+				  (,interface (car args)) (,interface))
+				 (else (for-each ,print-option
+						 (,interface #t)))))))
+
+	(make-enable (lambda (interface)
+		       `(lambda flags
+			  (,interface (append flags (,interface)))
+			  (,interface))))
+
+	(make-disable (lambda (interface)
+			`(lambda flags
+			   (let ((options (,interface)))
+			     (for-each (lambda (flag)
+					 (set! options (delq! flag options)))
+				       flags)
+			     (,interface options)
+			     (,interface)))))
+
+	(make-set! (lambda (interface)
+		     `((name exp)
+		       (,'quasiquote
+			(begin (,interface (append (,interface)
+						   (list '(,'unquote name)
+							 (,'unquote exp))))
+			       (,interface))))))
+	)
+   (procedure->macro
+    (lambda (exp env)
+      (cons 'begin
+	    (apply append
+		   (map (lambda (group)
+			  (let ((interface (car group)))
+			    (append (map (lambda (name constructor)
+					   `(define ,name
+					      ,(constructor interface)))
+					 (cadr group)
+					 (list make-options
+					       make-enable
+					       make-disable))
+				    (map (lambda (name constructor)
+					   `(defmacro ,name
+					      ,@(constructor interface)))
+					 (caddr group)
+					 (list make-set!)))))
+			names)))))))
+
+(export eval-options eval-enable eval-disable eval-set! debug-options
+debug-enable debug-disable traps trap-enable trap-disable trap-set!
+read-enable read-disable read-set! print-enable print-disable
+print-set! readline-options readline-enable readline-disable
+readline-set!)
+
diff --git a/ice-9/posix.scm b/ice-9/posix.scm
index 9698a0b8a..14ce238da 100644
--- a/ice-9/posix.scm
+++ b/ice-9/posix.scm
@@ -1,70 +1,190 @@
-;;; installed-scm-file
-
-;;;; Copyright (C) 1999 Free Software Foundation, Inc.
-;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
-;;;; 
-;;;; This program is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
-;;;; Boston, MA 02111-1307 USA
-;;;; 
-
-(define (stat:dev f) (vector-ref f 0))
-(define (stat:ino f) (vector-ref f 1))
-(define (stat:mode f) (vector-ref f 2))
-(define (stat:nlink f) (vector-ref f 3))
-(define (stat:uid f) (vector-ref f 4))
-(define (stat:gid f) (vector-ref f 5))
-(define (stat:rdev f) (vector-ref f 6))
-(define (stat:size f) (vector-ref f 7))
-(define (stat:atime f) (vector-ref f 8))
-(define (stat:mtime f) (vector-ref f 9))
-(define (stat:ctime f) (vector-ref f 10))
-(define (stat:blksize f) (vector-ref f 11))
-(define (stat:blocks f) (vector-ref f 12))
-
-;; derived from stat mode.
-(define (stat:type f) (vector-ref f 13))
-(define (stat:perms f) (vector-ref f 14))
-
-(define (passwd:name obj) (vector-ref obj 0))
-(define (passwd:passwd obj) (vector-ref obj 1))
-(define (passwd:uid obj) (vector-ref obj 2))
-(define (passwd:gid obj) (vector-ref obj 3))
-(define (passwd:gecos obj) (vector-ref obj 4))
-(define (passwd:dir obj) (vector-ref obj 5))
-(define (passwd:shell obj) (vector-ref obj 6))
-
-(define (group:name obj) (vector-ref obj 0))
-(define (group:passwd obj) (vector-ref obj 1))
-(define (group:gid obj) (vector-ref obj 2))
-(define (group:mem obj) (vector-ref obj 3))
-
-(define (utsname:sysname obj) (vector-ref obj 0))
-(define (utsname:nodename obj) (vector-ref obj 1))
-(define (utsname:release obj) (vector-ref obj 2))
-(define (utsname:version obj) (vector-ref obj 3))
-(define (utsname:machine obj) (vector-ref obj 4))
-
-(define (getpwent) (getpw))
-(define (setpwent) (setpw #t))
-(define (endpwent) (setpw))
-
-(define (getpwnam name) (getpw name))
-(define (getpwuid uid) (getpw uid))
-
-(define (getgrent) (getgr))
-(define (setgrent) (setgr #f))
-(define (endgrent) (setgr))
-
-(define (getgrnam name) (getgr name))
-(define (getgrgid id) (getgr id))
+(module (ice-9 posix)
+	(open (ice-9 guile) 
+	      ((ice-9 config) define-public)))
+
+
+;;; {Non-polymorphic versions of POSIX functions}
+
+(define-public (getgrnam name) (getgr name))
+(define-public (getgrgid id) (getgr id))
+(define-public (gethostbyaddr addr) (gethost addr))
+(define-public (gethostbyname name) (gethost name))
+(define-public (getnetbyaddr addr) (getnet addr))
+(define-public (getnetbyname name) (getnet name))
+(define-public (getprotobyname name) (getproto name))
+(define-public (getprotobynumber addr) (getproto addr))
+(define-public (getpwnam name) (getpw name))
+(define-public (getpwuid uid) (getpw uid))
+(define-public (getservbyname name proto) (getserv name proto))
+(define-public (getservbyport port proto) (getserv port proto))
+(define-public (endgrent) (setgr))
+(define-public (endhostent) (sethost))
+(define-public (endnetent) (setnet))
+(define-public (endprotoent) (setproto))
+(define-public (endpwent) (setpw))
+(define-public (endservent) (setserv))
+(define-public (getgrent) (getgr))
+(define-public (gethostent) (gethost))
+(define-public (getnetent) (getnet))
+(define-public (getprotoent) (getproto))
+(define-public (getpwent) (getpw))
+(define-public (getservent) (getserv))
+(define-public (reopen-file . args) (apply freopen args))
+(define-public (setgrent) (setgr #f))
+(define-public (sethostent) (sethost #t))
+(define-public (setnetent) (setnet #t))
+(define-public (setprotoent) (setproto #t))
+(define-public (setpwent) (setpw #t))
+(define-public (setservent) (setserv #t))
+
+(define-public (passwd:name obj) (vector-ref obj 0))
+(define-public (passwd:passwd obj) (vector-ref obj 1))
+(define-public (passwd:uid obj) (vector-ref obj 2))
+(define-public (passwd:gid obj) (vector-ref obj 3))
+(define-public (passwd:gecos obj) (vector-ref obj 4))
+(define-public (passwd:dir obj) (vector-ref obj 5))
+(define-public (passwd:shell obj) (vector-ref obj 6))
+
+(define-public (group:name obj) (vector-ref obj 0))
+(define-public (group:passwd obj) (vector-ref obj 1))
+(define-public (group:gid obj) (vector-ref obj 2))
+(define-public (group:mem obj) (vector-ref obj 3))
+
+(define-public (hostent:name obj) (vector-ref obj 0))
+(define-public (hostent:aliases obj) (vector-ref obj 1))
+(define-public (hostent:addrtype obj) (vector-ref obj 2))
+(define-public (hostent:length obj) (vector-ref obj 3))
+(define-public (hostent:addr-list obj) (vector-ref obj 4))
+
+(define-public (netent:name obj) (vector-ref obj 0))
+(define-public (netent:aliases obj) (vector-ref obj 1))
+(define-public (netent:addrtype obj) (vector-ref obj 2))
+(define-public (netent:net obj) (vector-ref obj 3))
+
+(define-public (protoent:name obj) (vector-ref obj 0))
+(define-public (protoent:aliases obj) (vector-ref obj 1))
+(define-public (protoent:proto obj) (vector-ref obj 2))
+
+(define-public (servent:name obj) (vector-ref obj 0))
+(define-public (servent:aliases obj) (vector-ref obj 1))
+(define-public (servent:port obj) (vector-ref obj 2))
+(define-public (servent:proto obj) (vector-ref obj 3))
+
+(define-public (sockaddr:fam obj) (vector-ref obj 0))
+(define-public (sockaddr:path obj) (vector-ref obj 1))
+(define-public (sockaddr:addr obj) (vector-ref obj 1))
+(define-public (sockaddr:port obj) (vector-ref obj 2))
+
+(define-public (utsname:sysname obj) (vector-ref obj 0))
+(define-public (utsname:nodename obj) (vector-ref obj 1))
+(define-public (utsname:release obj) (vector-ref obj 2))
+(define-public (utsname:version obj) (vector-ref obj 3))
+(define-public (utsname:machine obj) (vector-ref obj 4))
+
+(define-public (tm:sec obj) (vector-ref obj 0))
+(define-public (tm:min obj) (vector-ref obj 1))
+(define-public (tm:hour obj) (vector-ref obj 2))
+(define-public (tm:mday obj) (vector-ref obj 3))
+(define-public (tm:mon obj) (vector-ref obj 4))
+(define-public (tm:year obj) (vector-ref obj 5))
+(define-public (tm:wday obj) (vector-ref obj 6))
+(define-public (tm:yday obj) (vector-ref obj 7))
+(define-public (tm:isdst obj) (vector-ref obj 8))
+(define-public (tm:gmtoff obj) (vector-ref obj 9))
+(define-public (tm:zone obj) (vector-ref obj 10))
+
+(define-public (set-tm:sec obj val) (vector-set! obj 0 val))
+(define-public (set-tm:min obj val) (vector-set! obj 1 val))
+(define-public (set-tm:hour obj val) (vector-set! obj 2 val))
+(define-public (set-tm:mday obj val) (vector-set! obj 3 val))
+(define-public (set-tm:mon obj val) (vector-set! obj 4 val))
+(define-public (set-tm:year obj val) (vector-set! obj 5 val))
+(define-public (set-tm:wday obj val) (vector-set! obj 6 val))
+(define-public (set-tm:yday obj val) (vector-set! obj 7 val))
+(define-public (set-tm:isdst obj val) (vector-set! obj 8 val))
+(define-public (set-tm:gmtoff obj val) (vector-set! obj 9 val))
+(define-public (set-tm:zone obj val) (vector-set! obj 10 val))
+
+(define-public (tms:clock obj) (vector-ref obj 0))
+(define-public (tms:utime obj) (vector-ref obj 1))
+(define-public (tms:stime obj) (vector-ref obj 2))
+(define-public (tms:cutime obj) (vector-ref obj 3))
+(define-public (tms:cstime obj) (vector-ref obj 4))
+
+(define-public (file-position . args) (apply ftell args))
+(define-public (file-set-position . args) (apply fseek args))
+
+(define-public (open-input-pipe command) (open-pipe command OPEN_READ))
+(define-public (open-output-pipe command) (open-pipe command OPEN_WRITE))
+
+(define-public (move->fdes fd/port fd)
+  (cond ((integer? fd/port)
+	 (dup->fdes fd/port fd)
+	 (close fd/port)
+	 fd)
+	(else
+	 (primitive-move->fdes fd/port fd)
+	 (set-port-revealed! fd/port 1)
+	 fd/port)))
+
+(define-public (release-port-handle port)
+  (let ((revealed (port-revealed port)))
+    (if (> revealed 0)
+	(set-port-revealed! port (- revealed 1)))))
+
+(define-public (dup->port port/fd mode . maybe-fd)
+  (let ((port (fdopen (apply dup->fdes port/fd maybe-fd)
+		      mode)))
+    (if (pair? maybe-fd)
+	(set-port-revealed! port 1))
+    port))
+  
+(define-public (dup->inport port/fd . maybe-fd)
+  (apply dup->port port/fd "r" maybe-fd))
+
+(define-public (dup->outport port/fd . maybe-fd)
+  (apply dup->port port/fd "w" maybe-fd))
+
+(define-public (dup port/fd . maybe-fd)
+  (if (integer? port/fd)
+      (apply dup->fdes port/fd maybe-fd)
+      (apply dup->port port/fd (port-mode port/fd) maybe-fd)))
+
+(define-public (duplicate-port port modes)
+  (dup->port port modes))
+
+(define-public (fdes->inport fdes)
+  (let loop ((rest-ports (fdes->ports fdes)))
+    (cond ((null? rest-ports)
+	   (let ((result (fdopen fdes "r")))
+	     (set-port-revealed! result 1)
+	     result))
+	  ((input-port? (car rest-ports))
+	   (set-port-revealed! (car rest-ports)
+			       (+ (port-revealed (car rest-ports)) 1))
+	   (car rest-ports))
+	  (else
+	   (loop (cdr rest-ports))))))
+
+(define-public (fdes->outport fdes)
+  (let loop ((rest-ports (fdes->ports fdes)))
+    (cond ((null? rest-ports)
+	   (let ((result (fdopen fdes "w")))
+	     (set-port-revealed! result 1)
+	     result))
+	  ((output-port? (car rest-ports))
+	   (set-port-revealed! (car rest-ports)
+			       (+ (port-revealed (car rest-ports)) 1))
+	   (car rest-ports))
+	  (else
+	   (loop (cdr rest-ports))))))
+
+(define-public (port->fdes port)
+  (set-port-revealed! port (+ (port-revealed port) 1))
+  (fileno port))
+
+(define-public (setenv name value)
+  (if value
+      (putenv (string-append name "=" value))
+      (putenv name)))
+
diff --git a/ice-9/provide.scm b/ice-9/provide.scm
new file mode 100644
index 000000000..a5d7a881c
--- /dev/null
+++ b/ice-9/provide.scm
@@ -0,0 +1,13 @@
+;;; {Features}
+;;
+(module (ice-9 provide)
+	(open (ice-9 guile))
+	(export provide feature?))
+
+(define (provide sym)
+  (if (not (memq sym *features*))
+      (set! *features* (cons sym *features*))))
+
+(define (feature? feature)
+  (and (memq feature *features*) #t))
+
diff --git a/ice-9/repl.scm b/ice-9/repl.scm
new file mode 100644
index 000000000..3a09045e2
--- /dev/null
+++ b/ice-9/repl.scm
@@ -0,0 +1,478 @@
+;;; This is the module (ice-9 repl).
+;;;
+
+;; the current module
+(define make-repl-module
+  (lambda ()
+    (let ((ice-9/repl (and (environment-bound? (module-registry) 'ice-9/repl)
+			   (environment-ref (module-registry) 'ice-9/repl))))
+      (if (not ice-9/repl)
+	  (let* (
+		 (eval (the-environment))
+		 (export (make-interface-environment (list (list eval 'top-repl))))
+		 (protect (make-interface-environment (list (list eval 'top-repl 'save-stack 'abort-hook))))
+		 (ice-9/repl (vector eval export protect 'ice-9/ 'ice-9/repl)))
+	    (environment-define (module-registry) 'ice-9/repl ice-9/repl)
+	    (hashq-set! (environment-module-hash) eval ice-9/repl))
+	  ice-9/repl))))
+
+;; the guile module
+(define make-guile-module
+  (lambda ()
+    (let ((ice-9/guile (and (environment-bound? (module-registry) 'ice-9/guile)
+			   (environment-ref (module-registry) 'ice-9/guile))))
+
+      (if (not ice-9/guile)
+	  (let* (
+		 (eval (scheme-guile-environment 2))
+		 (export (make-interface-environment (list (cons eval #t))))
+		 (protect (make-interface-environment (list (cons eval #t))))
+		 (ice-9/guile (vector eval export protect 'ice-9/ 'ice-9/guile)))
+	    (environment-define (module-registry) 'ice-9/guile ice-9/guile)
+	    (hashq-set! (environment-module-hash) eval ice-9/guile))
+	  ice-9/guile))))
+	 
+(define make-user-module
+  (lambda ()
+    (let ((user/guile (and (environment-bound? (module-registry) 'user/guile)
+			   (environment-ref (module-registry) 'user/guile))))
+
+      (if (not user/guile)
+	  (let* (
+		 (eval-env (guile-user-environment 2))
+		 (export (make-interface-environment (list (cons eval-env #t))))
+		 (protect (make-interface-environment (list (cons eval-env #t))))
+		 (user/guile (vector eval-env export protect 'user/ 'user/guile)))
+	    
+	    (environment-define (module-registry) 'user/guile user/guile)
+	    (hashq-set! (environment-module-hash) eval-env user/guile))
+	  user/guile))))
+
+(define make-config-module
+  (lambda ()
+    (let ((ice-9/config (and (environment-bound? (module-registry) 'ice-9/config)
+			   (environment-ref (module-registry) 'ice-9/config))))
+
+      (if (not ice-9/config)
+	  (let* ((import (make-interface-environment (list (cons (scheme-guile-environment 2) #t))))
+		 (eval-env (make-eval-environment (make-leaf-environment) import))
+		 (export (make-interface-environment (list (cons eval-env #t))))
+		 (protect (make-interface-environment (list (cons eval-env #t))))
+		 (ice-9/config (vector eval-env export protect 'ice-9/ 'ice-9/config)))
+	    
+	    (environment-define (module-registry) 'ice-9/config ice-9/config)
+	    (hashq-set! (environment-module-hash) eval-env ice-9/config))
+	  ice-9/config))))
+	    
+
+
+
+;;; some more redundancy
+
+(define (module-name module) (vector-ref module 4))
+(define (module-eval-environment module) (vector-ref module 0))
+
+(define (run-hooks hook)
+  (if (and (pair? hook) (eq? (car hook) 'hook))
+      (run-hook hook)
+      (for-each (lambda (thunk) (thunk)) hook)))
+
+
+
+;;; {Running Repls}
+;;;
+
+(define (repl read evaler print)
+  (let loop ((source (read (current-input-port))))
+    (print (evaler source))
+    (loop (read (current-input-port)))))
+
+;; A provisional repl that acts like the SCM repl:
+;;
+(define scm-repl-silent #f)
+(define (assert-repl-silence v) (set! scm-repl-silent v))
+
+(define *unspecified* (if #f #f))
+(define (unspecified? v) (eq? v *unspecified*))
+
+(define scm-repl-print-unspecified #f)
+(define (assert-repl-print-unspecified v) (set! scm-repl-print-unspecified v))
+
+(define scm-repl-verbose #f)
+(define (assert-repl-verbosity v) (set! scm-repl-verbose v))
+
+(define scm-repl-prompt "guile> ")
+
+(define (set-repl-prompt! v) (set! scm-repl-prompt v))
+
+(define (default-lazy-handler key . args)
+  (save-stack lazy-handler-dispatch)
+  (apply throw key args))
+
+(define enter-frame-handler default-lazy-handler)
+(define apply-frame-handler default-lazy-handler)
+(define exit-frame-handler default-lazy-handler)
+
+(define (lazy-handler-dispatch key . args)
+  (case key
+    ((apply-frame)
+     (apply apply-frame-handler key args))
+    ((exit-frame)
+     (apply exit-frame-handler key args))
+    ((enter-frame)
+     (apply enter-frame-handler key args))
+    (else
+     (apply default-lazy-handler key args))))
+
+(define abort-hook (make-hook))
+
+;; these definitions are used if running a script.
+;; otherwise redefined in error-catching-loop.
+(define (set-batch-mode?! arg) #t)
+(define (batch-mode?) #t)
+
+(define (error-catching-loop thunk)
+  (let ((status #f)
+	(interactive #t))
+    (define (loop first)
+      (let ((next 
+	     (catch #t
+
+		    (lambda ()
+		      (lazy-catch #t
+				  (lambda ()
+				    (dynamic-wind
+					(lambda () (unmask-signals))
+					(lambda ()
+					  (with-traps
+					   (lambda ()
+					     (first)
+					     
+					     ;; This line is needed because mark
+					     ;; doesn't do closures quite right.
+					     ;; Unreferenced locals should be
+					     ;; collected.
+					     ;;
+					     (set! first #f)
+					     (let loop ((v (thunk)))
+					       (loop (thunk)))
+					     #f)))
+					(lambda () (mask-signals))))
+
+				  lazy-handler-dispatch))
+		    
+		    (lambda (key . args)
+		      (case key
+			((quit)
+			 (force-output)
+			 (set! status (car args))
+			 #f)
+
+			((switch-repl)
+			 (apply throw 'switch-repl args))
+
+			((abort)
+			 ;; This is one of the closures that require
+			 ;; (set! first #f) above
+			 ;;
+			 (lambda ()
+			   (run-hook abort-hook)
+			   (force-output)
+			   (display "ABORT: "  (current-error-port))
+			   (write args (current-error-port))
+			   (newline (current-error-port))
+			   (if interactive
+			       (if (and (not has-shown-debugger-hint?)
+					(not (memq 'backtrace
+						   (debug-options-interface)))
+					(stack? (fluid-ref the-last-stack)))
+				   (begin
+				     (newline (current-error-port))
+				     (display
+				      "Type \"(backtrace)\" to get more information.\n"
+				      (current-error-port))
+				     (set! has-shown-debugger-hint? #t)))
+			       (primitive-exit 1))
+			   (set! stack-saved? #f)))
+
+			(else
+			 ;; This is the other cons-leak closure...
+			 (lambda ()
+			   (cond ((= (length args) 4)
+				  (apply handle-system-error key args))
+				 (else
+				  (apply bad-throw key args))))))))))
+	(if next (loop next) status)))
+
+    (set! set-batch-mode?! (lambda (arg)
+			     (cond (arg 
+				    (set! interactive #f)
+				    (restore-signals))
+				   (#t
+				    (error "sorry, not implemented")))))
+    (set! batch-mode? (lambda () (not interactive)))
+
+    (loop (lambda () #t))))
+
+;;(define the-last-stack (make-fluid)) Defined by scm_init_backtrace ()
+(define stack-saved? #f)
+
+(define (save-stack . narrowing)
+  (or stack-saved?
+      (cond ((not (memq 'debug (debug-options-interface)))
+	     (fluid-set! the-last-stack #f)
+	     (set! stack-saved? #t))
+	    (else
+	     (fluid-set!
+	      the-last-stack
+	      (case (stack-id #t)
+		((repl-stack)
+		 (apply make-stack #t save-stack eval #t 0 narrowing))
+		((load-stack)
+		 (apply make-stack #t save-stack 0 #t 0 narrowing))
+		((tk-stack)
+		 (apply make-stack #t save-stack tk-stack-mark #t 0 narrowing))
+		((#t)
+		 (apply make-stack #t save-stack 0 1 narrowing))
+		(else
+		 (let ((id (stack-id #t)))
+		   (and (procedure? id)
+			(apply make-stack #t save-stack id #t 0 narrowing))))))
+	     (set! stack-saved? #t)))))
+
+(define before-error-hook (make-hook))
+(define after-error-hook (make-hook))
+(define before-backtrace-hook (make-hook))
+(define after-backtrace-hook (make-hook))
+
+(define has-shown-debugger-hint? #f)
+
+(define (handle-system-error key . args)
+  (let ((cep (current-error-port)))
+    (cond ((not (stack? (fluid-ref the-last-stack))))
+	  ((memq 'backtrace (debug-options-interface))
+	   (run-hook before-backtrace-hook)
+	   (newline cep)
+	   (display-backtrace (fluid-ref the-last-stack) cep)
+	   (newline cep)
+	   (run-hook after-backtrace-hook)))
+    (run-hook before-error-hook)
+    (apply display-error (fluid-ref the-last-stack) cep args)
+    (run-hook after-error-hook)
+    (force-output cep)
+    (throw 'abort key)))
+
+
+;;(define has-shown-backtrace-hint? #f) Defined by scm_init_backtrace ()
+
+;; Replaced by C code:
+;;(define (backtrace)
+;;  (if (fluid-ref the-last-stack)
+;;      (begin
+;;	(newline)
+;;	(display-backtrace (fluid-ref the-last-stack) (current-output-port))
+;;	(newline)
+;;	(if (and (not has-shown-backtrace-hint?)
+;;		 (not (memq 'backtrace (debug-options-interface))))
+;;	    (begin
+;;	      (display
+;;"Type \"(debug-enable 'backtrace)\" if you would like a backtrace
+;;automatically if an error occurs in the future.\n")
+;;	      (set! has-shown-backtrace-hint? #t))))
+;;      (display "No backtrace available.\n")))
+
+(define (error-catching-repl r e p)
+  (error-catching-loop (lambda () (p (e (r))))))5
+
+(define (gc-run-time)
+  (cdr (assq 'gc-time-taken (gc-stats))))
+
+(define before-read-hook (make-hook))
+(define after-read-hook (make-hook))
+
+;;; The default repl-reader function.  We may override this if we've
+;;; the readline library.
+(define repl-reader
+  (lambda (prompt)
+    (display prompt)
+    (force-output)
+    (run-hook before-read-hook)
+    (read (current-input-port))))
+
+(define (scm-style-repl module)
+  (letrec (
+	   (start-gc-rt #f)
+	   (start-rt #f)
+	   (repl-report-start-timing (lambda ()
+				       (set! start-gc-rt (gc-run-time))
+				       (set! start-rt (get-internal-run-time))))
+	   (repl-report (lambda ()
+			  (display ";;; ")
+			  (display (inexact->exact
+				    (* 1000 (/ (- (get-internal-run-time) start-rt)
+					       internal-time-units-per-second))))
+			  (display "  msec  (")
+			  (display  (inexact->exact
+				     (* 1000 (/ (- (gc-run-time) start-gc-rt)
+						internal-time-units-per-second))))
+			  (display " msec in gc)\n")))
+
+	   (consume-trailing-whitespace
+	    (lambda ()
+	      (let ((ch (peek-char)))
+		(cond
+		 ((eof-object? ch))
+		 ((or (char=? ch #\space) (char=? ch #\tab))
+		  (read-char)
+		  (consume-trailing-whitespace))
+		 ((char=? ch #\newline)
+		  (read-char))))))
+		 
+	   (-read (lambda ()
+		    (let ((val
+			   (let ((prompt (string-append (module-name module) "> "  )))
+			     (repl-reader prompt))))
+
+		      (run-hooks after-read-hook)
+		      (if (eof-object? val)
+			  (begin
+			    (repl-report-start-timing)
+			    (if scm-repl-verbose
+				(begin
+				  (newline)
+				  (display ";;; EOF -- quitting")
+				  (newline)))
+			    (throw 'quit #f)))
+
+		      ;; As described in R4RS, the READ procedure updates the
+		      ;; port to point to the first characetr past the end of
+		      ;; the external representation of the object.  This
+		      ;; means that it doesn't consume the newline typically
+		      ;; found after an expression.  This means that, when
+		      ;; debugging Guile with GDB, GDB gets the newline, which
+		      ;; it often interprets as a "continue" command, making
+		      ;; breakpoints kind of useless.  So, consume any
+		      ;; trailing newline here, as well as any whitespace
+		      ;; before it.
+		      (consume-trailing-whitespace)
+
+		      val)))
+
+	   (-eval (lambda (sourc)
+		    (repl-report-start-timing)
+		    (start-stack 'repl-stack (eval sourc (module-eval-environment module)))))
+
+	   (-print (lambda (result)
+		     (if (not scm-repl-silent)
+			 (begin
+			   (if (or scm-repl-print-unspecified
+				   (not (unspecified? result)))
+			       (begin
+				 (write result)
+				 (newline)))
+			   (if scm-repl-verbose
+			       (repl-report))
+			   (force-output)))))
+
+	   (-quit (lambda (args)
+		    (if scm-repl-verbose
+			(begin
+			  (display ";;; QUIT executed, repl exitting")
+			  (newline)
+			  (repl-report)))
+		    args))
+
+	   (-abort (lambda ()
+		     (if scm-repl-verbose
+			 (begin
+			   (display ";;; ABORT executed.")
+			   (newline)
+			   (repl-report)))
+		     (repl -read -eval -print))))
+
+    (let ((status (error-catching-repl -read
+				       -eval
+				       -print)))
+      (-quit status))))
+
+
+;; this is just (scm-style-repl) with a wrapper to install and remove 
+;; signal handlers.  Every module may have exactly one repl.
+
+
+(define (top-repl module) 
+  (let ((old-handlers #f)
+	(signals `((,SIGINT . "User interrupt")
+		   (,SIGFPE . "Arithmetic error")
+		   (,SIGBUS . "Bad memory access (bus error)")
+		   (,SIGSEGV . "Bad memory access (Segmentation violation)"))))
+
+    (dynamic-wind
+
+	;; call at entry
+	(lambda ()
+	  (let ((make-handler (lambda (msg)
+				(lambda (sig)
+				  (save-stack %deliver-signals)
+				  (scm-error 'signal
+					     #f
+					     msg
+					     #f
+					     (list sig))))))
+	    (set! old-handlers
+		  (map (lambda (sig-msg)
+			 (sigaction (car sig-msg)
+				    (make-handler (cdr sig-msg))))
+		       signals))))
+
+	;; the protected thunk.
+	(lambda ()
+	  (scm-style-repl module))
+
+
+	;; call at exit.
+	(lambda ()
+	  (map (lambda (sig-msg old-handler)
+		 (if (not (car old-handler))
+		     ;; restore original C handler.
+		     (sigaction (car sig-msg) #f)
+		     ;; restore Scheme handler, SIG_IGN or SIG_DFL.
+		     (sigaction (car sig-msg)
+				(car old-handler)
+				(cdr old-handler))))
+	       signals old-handlers)))))
+
+;;; This hook is run at the very end of an interactive session.
+;;;
+(define exit-hook (make-hook))
+
+
+
+;; now provide a function which starts the repl
+(define start
+  (lambda ()
+    (make-guile-module)
+    (make-repl-module)
+    (let ((user/guile (make-user-module)))
+
+      (set-interaction-environment! (vector-ref user/guile 0))
+
+      (let (
+	    (ret-val (top-repl user/guile))
+
+	    (start-module-system 
+	     (lambda ()
+	       ;; create (ice-9 config) and re-start the repl in there
+	       (let* ((ice-9/config (make-config-module))
+		      (eval-env (vector-ref ice-9/config 0)))
+		 (primitive-load-path "ice-9/config.scm" eval-env)
+		 (eval '(start) eval-env)))))
+
+	(if (and (eqv? #f ret-val) (isatty? (current-input-port)))
+	    (begin 
+	      (newline) 
+	      (set! ret-val (start-module-system))))
+	
+	(or ret-val 0)))))
+
+
diff --git a/ice-9/run-test.scm b/ice-9/run-test.scm
new file mode 100644
index 000000000..44c73d95f
--- /dev/null
+++ b/ice-9/run-test.scm
@@ -0,0 +1,5 @@
+(define %library-dir
+  (lambda () (string-append (%package-data-dir) "/" (version))))
+
+(chdir (string-append (%library-dir) "/ice-9"))
+(define-module (ice-9 run-test) :use-module (ice-9 test))
\ No newline at end of file
diff --git a/ice-9/structs.scm b/ice-9/structs.scm
new file mode 100644
index 000000000..760e61d8e
--- /dev/null
+++ b/ice-9/structs.scm
@@ -0,0 +1,127 @@
+(module (ice-9 structs)
+
+	(export record-type? make-record-type record-type-name record-type-fields record-constructor record-predicate
+		record-accessor record-modifier record? record-type-descriptor)
+
+	(open (ice-9 provide) (ice-9 symbols) (ice-9 lists) (ice-9 guile)))
+
+;;; {Structs}
+
+(define (struct-layout s)
+  (struct-ref (struct-vtable s) vtable-index-layout))
+
+
+;;; {Records}
+;;;
+
+;; Printing records: by default, records are printed as
+;;
+;;   #<type-name field1: val1 field2: val2 ...>
+;;
+;; You can change that by giving a custom printing function to
+;; MAKE-RECORD-TYPE (after the list of field symbols).  This function
+;; will be called like
+;;
+;;   (<printer> object port)
+;;
+;; It should print OBJECT to PORT.
+
+(define (inherit-print-state old-port new-port)
+  (if (pair? old-port)
+      (cons (if (pair? new-port) (car new-port) new-port)
+	    (cdr old-port))
+      new-port))
+
+;; 0: type-name, 1: fields
+(define record-type-vtable 
+  (make-vtable-vtable "prpr" 0
+		      (lambda (s p)
+			(cond ((eq? s record-type-vtable)
+			       (display "#<record-type-vtable>" p))
+			      (else
+			       (display "#<record-type " p)
+			       (display (record-type-name s) p)
+			       (display ">" p))))))
+
+(define (record-type? obj)
+  (and (struct? obj) (eq? record-type-vtable (struct-vtable obj))))
+
+(define (make-record-type type-name fields . opt)
+  (let ((printer-fn (and (pair? opt) (car opt))))
+    (let ((struct (make-struct record-type-vtable 0
+			       (make-struct-layout
+				(apply symbol-append
+				       (map (lambda (f) "pw") fields)))
+			       (or printer-fn
+				   (lambda (s p)
+				     (display "#<" p)
+				     (display type-name p)
+				     (let loop ((fields fields)
+						(off 0))
+				       (cond
+					((not (null? fields))
+					 (display " " p)
+					 (display (car fields) p)
+					 (display ": " p)
+					 (display (struct-ref s off) p)
+					 (loop (cdr fields) (+ 1 off)))))
+				     (display ">" p)))
+			       type-name
+			       (copy-tree fields))))
+      ;; Temporary solution: Associate a name to the record type descriptor
+      ;; so that the object system can create a wrapper class for it.
+      (set-struct-vtable-name! struct (if (symbol? type-name)
+					  type-name
+					  (string->symbol type-name)))
+      struct)))
+
+(define (record-type-name obj)
+  (if (record-type? obj)
+      (struct-ref obj vtable-offset-user)
+      (error 'not-a-record-type obj)))
+
+(define (record-type-fields obj)
+  (if (record-type? obj)
+      (struct-ref obj (+ 1 vtable-offset-user))
+      (error 'not-a-record-type obj)))
+
+(define (record-constructor rtd . opt)
+  (let ((field-names (if (pair? opt) (car opt) (record-type-fields rtd))))
+    (eval `(lambda ,field-names
+	     (make-struct ',rtd 0 ,@(map (lambda (f)
+					  (if (memq f field-names)
+					      f
+					      #f))
+					(record-type-fields rtd)))) 
+	  (the-environment))))
+
+(define (record-predicate rtd)
+  (lambda (obj) (and (struct? obj) (eq? rtd (struct-vtable obj)))))
+
+(define (record-accessor rtd field-name)
+  (let* ((pos (list-index (record-type-fields rtd) field-name)))
+    (if (not pos)
+	(error 'no-such-field field-name))
+    (eval `(lambda (obj)
+	     (and (eq? ',rtd (record-type-descriptor obj))
+		  (struct-ref obj ,pos))) (the-environment))))
+
+(define (record-modifier rtd field-name)
+  (let* ((pos (list-index (record-type-fields rtd) field-name)))
+    (if (not pos)
+	(error 'no-such-field field-name))
+    (eval `(lambda (obj val)
+	     (and (eq? ',rtd (record-type-descriptor obj))
+		  (struct-set! obj ,pos val))) (the-environment) )))
+
+
+(define (record? obj)
+  (and (struct? obj) (record-type? (struct-vtable obj))))
+
+(define (record-type-descriptor obj)
+  (if (struct? obj)
+      (struct-vtable obj)
+      (error 'not-a-record obj)))
+
+(provide 'record)
+
diff --git a/ice-9/symbols.scm b/ice-9/symbols.scm
new file mode 100644
index 000000000..cb2cfb504
--- /dev/null
+++ b/ice-9/symbols.scm
@@ -0,0 +1,23 @@
+;;; {Symbols}
+;;;
+(module (ice-9 symbols)
+	(open (ice-9 guile))
+	(export symbol-append list->symbol symbol obarray-symbol-append obarray-gensym))
+
+(define (symbol-append . args)
+  (string->symbol (apply string-append args)))
+
+(define (list->symbol . args)
+  (string->symbol (apply list->string args)))
+
+(define (symbol . args)
+  (string->symbol (apply string args)))
+
+(define (obarray-symbol-append ob . args)
+  (string->obarray-symbol (apply string-append ob args)))
+
+(define (obarray-gensym obarray . opt)
+  (if (null? opt)
+      (gensym "%%gensym" obarray)
+      (gensym (car opt) obarray)))
+
diff --git a/libguile/ChangeLog-environments b/libguile/ChangeLog-environments
new file mode 100644
index 000000000..b0ed545f2
--- /dev/null
+++ b/libguile/ChangeLog-environments
@@ -0,0 +1,288 @@
+1999-08-21  Jost Boekemeier  <jostobfe@calvados.zrz.tu-berlin.de>
+
+	* print.c (scm_init_print): renamed scm_intern0() to 
+	scm_intern().
+
+	* eval.c (scm_m_atfop): Funktion uses symbol properties which
+	aren't supported anymore. Disabled.
+	(scm_m_atbind): Disabled.
+
+1999-08-19  Jost Boekemeier  <jostobfe@calvados.zrz.tu-berlin.de>
+
+	* eval.c (scm_lookupcar, scm_lookupcar1): Renamed `check' to 
+	`modify' which corresponds to the environment_cells `modify'
+        parameter.  Special value modify == -1 means that the function 
+        should return undef_cell instead of throwing an error.
+
+	* readline.c (scm_init_readline): Funktion accepts 
+	environment and returns scheme value. Intern 
+	"*readline-completion-function*" in readline's environment.
+	* eval.c (scm_init_eval): Create symbols nil and t in eval's 
+	environment.
+	* lang.c (scm_init_lang): function accepts environment and 
+	returns scheme value.  "nil-while" is interned in lang's 
+	environment.
+
+	* gsubr.c (scm_init_gsubr): make "name" a permanent symbol.
+
+	* Makefile.am : removed kw.h
+	* Makefile.in : regenerated
+		
+1999-08-12  Jost Boekemeier  <jostobfe@calvados.zrz.tu-berlin.de>
+
+	Removed symbol slots and ssymbols.
+	* tags.h (scm_tc7_ssymbol, scm_tc_7_msymbol): removed tags 
+	5 and 7,
+	(scm_tc7_msymbol): added tag 29
+	* gc.c (scm_gc_mark): Do not mark symbol_func and
+	symbol_slots.
+	* symbols.h (SCM_SYMBOL_PROPS): removed
+	(SCM_SYMBOL_FUNC): Removed
+	(SCM_SYMBOL_SLOTS): Removed
+	(SCM_HASHCODE): Symbol carries its own hash code
+	(SCM_SYMBOL_SLOTS): Changed to 2.
+
+	Symbols don't carry values anymore. Instead an environment 
+	binds symbols to locations which carry values.
+	* symbols.c: rewritten
+	* symbols.h: removed ssymbols, removed slots from msymbols,
+	added `SCM_HASHCODE',
+	* debug.c eval.c feature.c feature.c filesys.c fports.c 
+	gh_funcs.c gc.c gsubr.c keywords.c load.c macros.c net_db.c 
+	objects.c options.c ports.c posix.c procs.c read.c 
+	readline.c regex-posix.c scmsigs.c script.c socket.c 
+	srcprop.c stime.c struct.c, cpp_cnvt.awk:
+	Changed scm_sysintern() into scm_environment_intern() or
+	scm_permanent_object(scm_intern(...)) depending on the 
+	context.
+
+	Added environments.
+	* environments.c, environments.h: new file.
+	* gc.c (scm_igc): Added finalize method for weak environment
+	observers.
+	* Makefile.am: added environments.c, added environments.h
+	* Makefile.in: regenerated.
+
+        * libguile.h: removed reference to old "kw.h".
+
+	* init.c (scm_load_startup_files): load ice-9/boot-9.scm and
+	ice-9/init.scm into scm_root_environment.
+	(scm_boot_guile_1): Create the root environment by calling
+	scm_init_environment(). All other modules create bindings 
+	in this environment.  Store some module's init functions in
+	scm_c_module_registry so that these modules can be 
+	initialized when needed.
+	(invoke_main_func): removed old module's post initialisation
+	function (scm_post_boot_init_modules()).
+
+        Memory pointers changed to type (void*)
+	* gc.c (scm_must_malloc): returns (void*)
+	(scm_must_realloc): returns and accepts (void*)
+	(scm_must_free): accepts (void*)
+
+	defined? is a special form.
+	* evalext.c (scm_defined_p): turned `scm_defined_p' into a
+	special form (macro) which tries to find a symbol in the
+	current environment frame or above.
+	(scm_m_undefine): use ENVIRONMENT_UNDEFINE() to remove a 
+	binding.
+
+	eval conforms to r5rs.
+	* eval.c (scm_eval2): removed
+	(scm_eval): evaluate expressions in a environment context,
+	create the top of the environment stack: (env-smob . EOL).
+	(scm_eval_x): dto.
+
+	* procs.h (SCM_TOP_LEVEL): replaced by SCM_TOP_LEVEL_ENV
+	from environments.h
+	* eval.c (SCM_CEVAL, scm_m_define): SCM_TOP_LEVEL -> 
+	SCM_TOP_LEVEL_ENV
+	* evalext.c (scm_m_undefine): dto.
+
+	Symbol lookup via scm_lookupcar():
+	* eval.c (scm_lookupcar1, scm_lookupcar): additional 
+	parameter `modify' which corresponds to 
+	SCM_ENVIRONMENT_CELL()'s `for_write' parameter.
+	(SCM_CEVAL): request a writeable location via
+	scm_lookupcar() only if we know that the location will be 
+	changed (with set!).
+	(EVALCELLCAR): dto. (argument `modify' is always zero).
+
+	Memoization protocol, environment representation:
+	* eval.c (scm_lookupcar1): rewritten: environment smob 
+	replaces `top_thunk'.  Changed memoize method to
+	`scm_eval_environment_memoize_cell_internal()'.
+	(scm_lookupcar): scm_lookupcar1 doesn't return 0; test 
+	removed.
+	(scm_unmemocar): Changed unmemoize method to
+	`eval_environment_update_memoized'.
+	Renamed scm_sym2vcell() to SCM_ENVIRONMENT_DEFINE().
+
+	* struct.c (scm_make_struct_layout): Renamed 
+	scm_intern_obarray() to scm_permanent_object(scm_intern(...))
+
+	* stacks.c (get_applybody): replaced lookup for 
+	scm_sym_apply by value of scm_i_apply.
+	(narrow_stack): removed reference to system_module_env_p
+
+	* snarf.h : rewritten.  Create symbols in the appropriate
+	environment.
+
+	New startup sequence.
+	* script.c (sym_go): new symbol
+	(sym_top_repl ("top-repl")): removed
+	(scm_compile_shell_switches): evaluate "-c" arguments in
+	scm_root_environment
+	(scm_compile_shell_switches): intern "use-emacs-interface"
+	in scm_root_environment
+	(scm_compile_shell_switches): When interactive load
+	modules.scm into the root environment and start a repl in
+	module `ice-9/guile'.
+
+	* root.h (scm_symhash): removed
+	(scm_keyword_environment): replaces scm_keyword_obarray
+	(scm_root_environment): new variable
+	(scm_c_module_registry): new variable
+	(scm_interaction_environment): new variable
+	* gc.c (scm_init_storage): removed scm_symhash
+
+	* gc.c (scm_init_storage): Moved most-positive-fixnum,
+	most-negative-fixnum and bignum-radix to scm_init_root() 
+	because they need a top-level environment.
+	* root.c (scm_init_root): added most-positive-fixnum,
+	most-negative-fixnum and bignum-radix 
+	(from scm_init_storage()).
+
+	* backtrace.c, coop-threads.c, coop.c, debug.c, dynwind.c,
+	feature.c, filesys.c, fluids.c, fports.c, gh_data.c, 
+	gh_eval.c, gh_init.c, gscm.c, hashtab.c, init.c, iselect.c, 
+	keywords.c, load.c, ramap.c, read.c, readline.c, root.c, 
+	struct.c, throw.c, unif.c: removed length argument from 
+	scm_intern, renamed scm_intern0 to scm_intern.
+
+	Changed keyword obarray into a finite environment.
+	* keywords.c (scm_make_keyword_from_dash_symbol): 
+	Renamed scm_sym2ovcell_soft() to 
+	SCM_ENVIRONMENT_CELL()/SCM_ENVIRONMENT_DEFINE().
+	(scm_init_keywords): Renamed scm_keyword_obarray to 
+	scm_keyword_environment.
+	(scm_c_make_keyword): changed scm_sysintern0() to
+	scm_permanent_object(...);
+	(scm_init_keywords): changed scm_keyword_obarray to
+	scm_keyword_environment
+
+	* gdbint.c (gdb_binding): Look up name in root environment.
+
+	All functions that evaluate expressions must do this in an 
+	environment context.
+	* _scm.h: added "environments.h" since environments are 
+	used by every c file.
+	* debug.c (scm_memcons): third argument `environment' is 
+	required
+	(scm_procedure_environment): scm_tc7_cclo, scm_tcs_subrs, 
+	scm_tc7_contin don't close over an environment, throw error.
+	* debug.h: removed declaration for scm_eval_string() which is
+	not defined in debug.c
+	* feature.c (scm_make_named_hook): added environment 
+	parameter
+	* gdbint.c (gdb_eval): added environment parameter
+	* gh_eval.c: (gh_eval_str, gh_eval_file): evaluate in
+	scm_interaction_environment
+	* gh_funcs.c: (gh_new_procedure, gh_define): evaluate in
+	scm_interaction_environment
+	* gh_data.c (gh_lookup): look up symbols in
+	scm_interaction_environment	
+	(gh_module_lookup): look up symbols in the given environment
+	* gsubr.c (scm_make_gsubr): added environment parameter
+	* macros.c (scm_make_synt): added environment parameter
+	* print.c (scm_init_print): make printer in specified 
+	environment
+	* procs.c (scm_make_subr_opt, scm_make_subr, 
+	scm_init_iprocs): added environment parameter
+	* strports.c (scm_eval_0str, scm_eval_string): added 
+	environment parameter
+	* load.c (load_data): new type
+	(load): load and evaluate expressions in a given environment,
+	argument to load must be (struct load_data*)
+	(scm_primitive_load (primitive-load)): added environment 
+	parameter, load hook called with additional environment 
+	argument,
+	encapsulate environment and port into load_data.
+	(scm_init_load_path): added environment parameter
+	(scm_primitive_load_path (primitive-load-path)): dto.
+	(scm_read_and_eval_x (read-and-eval!)): environment is 
+	optional and defaults to interaction-environment 
+	(`scm_interaction_environment').
+	(init_build_info): added environment parameter
+	* async.c (scm_init_async): create "%gc-thunk" in module's 
+	environment.
+	* evalext.c (scm_init_evalext): create 
+	scm_m_generalized_set_x in module's environment.
+	* feature.c (scm_make_named_hook): intern hook in feature's
+	environment.
+	* (scm_init_feature): intern `*features*' in feature's 
+	environment.
+	* gsubr.c (scm_init_gsubr): create `scm_gsubr_apply' in 
+	module's environment.
+	* guardians.c (scm_init_guardian): create guard in module's
+	environment.
+	* procs.c (scm_make_subr): added environment argument.
+	(scm_init_iprocs): added environment argument.
+	* options.c (scm_init_opts): Do not intern options into one 
+	of the environments. Make them permanent symbols instead.
+	* load.c (scm_init_load): intern "%load-path", 
+	"%load-extensions" and "%load-hook", "%guile-build-info" in 
+	module's environment.
+	(init_build_info): renamed scm_intern0 to scm_intern.
+	* ramap.c (scm_init_ramap): create scm_array_equal_p in
+	module's environment.
+	* strports.c (scm_eval_string): evaluate form in environment
+	* stacks.c (narrow_stack): removed scm_system_module_env_p
+
+	Turned all .c files into guile c-modules. All module's
+	init functions create bindings in a given environment and
+	return a scheme value.
+	* alist.c, arbiters.c, async.c, backtrace.c, boolean.c,
+	chars.c continuations.c, debug.c, dynamic_linking.c,
+	dynwind.c, eq.c, error.c eval.c, evalext.c, feature.c,
+	filesys.c, fluids.c, fports.c, gc.c gdbint.c, gsubr.c,
+	guardian.c, hash.c, hashtab.c, ioext.c, iselect.c
+	keywords.c, list.c, load.c, macros.c, mallocs.c, net_db.c,
+	numbers.c objects.c, objprop.c, options.c, pairs.c,
+	ports.c, posix.c, print.c procprop.c, procs.c, ramap.c,
+	random.c, read.c, readline.c regex-posix.c, root.c,
+	scmsigs.c, script.c, simpos.c, socket.c, sort.c srcprop.c,
+	stackchk.c, stacks.c, stime.c, strings.c, strop.c,
+	strorder.c strports.c, struct.c, symbols.c, tag.c,
+	threads.c, throw.c, unif.c vectors.c, version.c, vports.c,
+	weaks.c: changed init function so that it evaluates in a
+	given environment and returns a scheme value.  * dynl.c
+	(scm_dynamic_call): Call the module init function in a
+	environment context and return its return-value.
+
+	Switched to new environment implementation
+	* eval.c (scm_m_define): rewritten.
+	* debug.c (scm_memcons): rewritten.
+	* evalext.c (scm_m_undefine): rewritten
+
+	Removed all references to variables and modules.
+	* Makefile.am: removed modules.h modules.c variables.c
+	variables.h debug.c (scm_make_gloc (make-gloc), scm_gloc_p
+	(gloc?)): removed
+	* debug.c, eval.c, evalext.c, gdbint.c, init.c,
+	libguile.h: removed #include "modules.h" 
+	* debug.c, init.c, libguile.h, symbols.c, variable.c: 
+	removed #include "variables.h"
+
+	Removed old module registry.
+	* dynl.c (scm_register_module_xxx, struct moddata,
+	scm_registered_modules, scm_clear_registered_modules): 
+	removed
+
+	Removed all variables used by the old module system.
+	* debug.c, eval.c, evalext.c, gdbint.c, init.c, root.c, 
+	root.h: removed top_level_lookup_closure 
+	(*top-level-lookup-closure*),
+	scm_top_level_lookup_closure_var,
+	scm_can_use_top_level_lookup_closure_var.
+	* eval.c, init.c, root.h: removed scm_system_transformer.
diff --git a/libguile/environments.c b/libguile/environments.c
new file mode 100644
index 000000000..acdc031fc
--- /dev/null
+++ b/libguile/environments.c
@@ -0,0 +1,3558 @@
+#include "_scm.h"
+#include "environments.h"
+#include "symbols.h"
+#include "eval.h"
+#include "smob.h"
+#include "numbers.h"
+#include "alist.h"
+#include "weaks.h"
+#include "gh.h"
+
+#include <stdio.h>
+/* 
+ * This file implements first class top-level-environments.  An
+ * environment is a datatype that maps `symbols' to `values'.
+ *
+ * For example:  
+ * SCM A = scm_make_leaf_environment();
+ * SCM B = scm_make_leaf_environment();
+ * scm_environment_define (A, gh_symbol2scm("a"), gh_int2scm(1))
+ * scm_environment_define (A, gh_symbol2scm("b"), gh_int2scm(2))
+ * scm_environment_define (B, gh_symbol2scm("b"), gh_int2scm(3))
+ *
+ *                     a           b
+ *-----+-------------------------------
+ *  A  |               1           2
+ *  B  |                           3  
+ *  
+ *   
+ * It has an obarray (hash table) and a list of observers.
+ * The obarray's elements are vcells e.g. (a . 1) in environment A.
+ *
+ * An environment is generic and has the type `scm_tc16_environment'.
+ * It responds to the messages: 
+ *
+ * ref -> return `value' (cdr of vcell)
+ * fold -> iterate over all bindings (vcells) 
+ * define -> create new binding
+ * undefine -> remove binding 
+ * set -> set `value' 
+ * cell -> return vcell 
+ * bound -> #t if binding exists, #f if not
+ *
+ *
+ * This file defines 3 concrete environment types: leaf, eval and
+ * interface environments.
+ *  */
+
+/*
+ * Data structures
+ * 
+ * cell: (((symbol . value) . (property alist)) . location_tag)
+ * CAR (cell) -> location
+ * CDR (cell) -> a location tag, either "immutable-location" or
+ * SCM_EOL ("mutable-location")
+ *
+ * vcell: (symbol . value) where value is either a scheme object or a
+ * cached cell
+ *
+ *
+ * Cache
+ *
+ * The following environments cache values (vcells) from other
+ * environments: 
+ *
+ * interface-environment caches values from an eval-environment or
+ * interface-environment.
+ *
+ * interface-environment caches values from $n$ other environments
+ *
+ * eval-environment caches values from the interface-environment and from
+ * its local environment.
+ *
+ *
+ * Cache implementation
+ *
+ * All caching environments use the following structure: (symbol
+ * . value) where value is the cached cell from another environment.
+ * Given the eval-environment E which imports bindings from A (see
+ * above) and has B as its local environment, E holds the following
+ * vcell: (b . ((((b . 3)) . property-list) . mutable-location)).
+ * Whenever the location of the binding changes, it will take the new
+ * location and store it in the cdr of the vcell. 
+ *
+ *
+ * Update protocol
+ *
+ * Every environment implements an update procedure with four
+ * parameters:
+ * 1. the receiver environment `self'
+ * 2. the calling environment `caller'
+ * 3. a symbol
+ * 4. the old cell
+ * 5. the new cell
+ * 6. the name of the current operation
+ *
+ * When some environment has changed a binding, it sends out an
+ * environment-update message (see broadcast and environment-update)
+ * to all observers.  The environment which receives this
+ * environment-update message must:
+ *
+ * 1. find the appropriate cell in its environment
+ * 2. check if the cell it found has changed (by comparing with old cell)
+ * 3. update the cell.
+ * If the environment was not able to update the cell it must:
+ * a. re-construct the old state
+ * b. send out an update broadcast to all observers
+ * c. throw an error
+ *
+ *
+ * Whenever some environment has changed all bindings, it sends out an
+ * environment update message with symbol, old cell and new cell set
+ * to #f.  Every environment receiving such a message can either:
+ *
+ * a) update all bindings in its environment by looking up
+ *    bindings in caller's environment, or 
+ * b) simply clear it's cache.
+ *
+ * An environment observing an eval environment (or any other
+ * user-contributed environments in general) however doesn't have this
+ * choice; it must implement algorithm a) if it still wants to receive
+ * update requests for specific bindings afterwards.  The
+ * eval-environment (or user-contributed environments) need to know
+ * for which bindings they have to send out update broadcasts; if they
+ * find a vcell in their cache they know that someone cares about this
+ * binding and announce a change.
+ * 
+ * Unmemoization protocoll: Guile's evaluator evals
+ * expressions in two steps: 
+ *
+ * 1. compile code into memoized tree code
+ * 2. evaluate the compiled code
+ *
+ * An eval-environment receiving an update request
+ * for a specifig binding must:
+ *
+ * 1. update all expressions pointing to the old binding
+ *
+ * An eval environment receiving an update request
+ * for all bindings must:
+ *
+ * 1. unmemoize all expressions in its cache.
+ *
+ *
+ * All standard environments will send an update message iff:
+ * a) a binding has been removed from an environment (undefine ...) or
+ * b) a new binding in eval-environment's local environment shadows a
+ *    binding from its import-environment (define ...) or
+ * c) the signature of an interface-environment has changed or
+ * d) the imported environment of a eval-environment has changed.
+ *   
+ */
+
+
+#define SWAP(a, b) {SCM tmp = a; a = b; b = tmp;}
+#define UPDATE_EMPTY_OBARRAY (SCM_VELTS(protect_vec)[0])
+
+#define SCM_OBSERVERP(x) ((SCM_CAR (x)) == scm_tc16_observer)
+#define SCM_OBSERVER_STRUCT(observer) ((struct environment_observer*) SCM_CDR(observer))
+
+/* cell structure: (((sym . val) . symbol-property-alist) . (home-environment . tag)) */
+#define SCM_CELL_PROPERTY_ALIST SCM_CDAR
+#define SCM_CELL_TAG SCM_CDR	/* either immutable or mutable_location */
+#define SCM_CELL_VAL SCM_CAAR	/* return the (sym . val) of a cell */
+#define SCM_IMMUTABLE_LOCATIONP(tag) (scm_sym_immutable_location==(tag)) 
+#define SCM_MUTABLE_LOCATIONP(tag) (!(scm_sym_immutable_location==(tag))) /* cells don't carry `scm_sym_mutable_location' tags */
+
+SCM_SYMBOL (scm_sym_immutable_location, "immutable-location");
+SCM_SYMBOL (scm_sym_mutable_location, "mutable-location");
+SCM_SYMBOL (scm_sym_alias, "alias");
+SCM_SYMBOL (scm_sym_syntax, "syntax");
+
+long scm_tc16_environment;
+long scm_tc16_observer;
+static SCM protect_vec;
+
+/* the observer list */
+struct environment_observer {
+  SCM next;
+  SCM synapse;
+
+  short weak_p;			/* is scheme weak? */
+
+  /* c is either a default_observer or a user supplied c function. */
+  scm_environment_observer c;
+
+  SCM scheme; 
+};    
+ 
+/* leaf environments */
+struct leaf_environment {
+  struct environment environment;
+  SCM synapse;
+  void (*update) (SCM env, SCM caller, SCM sym, SCM old_cell, SCM new_cell, char *name);
+};
+  
+/* eval environments */
+struct eval_environment {
+  struct leaf_environment leaf;
+
+  SCM imported;			/* interface-environment */
+  SCM local;			/* leaf-environment */
+  SCM memoized;			/* weak key hash table */
+};
+
+/* interface_environments */
+struct interface_environment {
+  struct leaf_environment leaf;
+
+  scm_environment_conflict_proc c_conflict_proc;
+  short aquisition;
+
+  SCM interface;		/* list of environments with interface symbols */
+  SCM conflict_proc;
+
+  short empty;
+};
+
+
+
+/* manipulate obarrays */
+
+/*
+ * Copy symbol to obarray.  The symbol must not already exist in obarray.
+ */
+static SCM 
+scm_symbol_create_handle (obarray,  symbol, scm_hash, init)
+     SCM symbol;
+     SCM obarray;
+     scm_sizet scm_hash;
+     SCM init;
+{
+  SCM sym;
+
+  sym = scm_acons (symbol, init, 
+		   SCM_VELTS (obarray)[scm_hash]);
+  SCM_VELTS (obarray)[scm_hash] = sym;
+
+  return SCM_CAR (sym);
+}
+
+/*
+ * look up symbol in obarray
+ */
+static SCM 
+scm_symbol_get_handle (obarray, sym, scm_hash)
+     SCM sym;
+     SCM obarray;
+     scm_sizet scm_hash;
+{
+  SCM lsym;
+  SCM z;
+
+  for (lsym = SCM_VELTS (obarray)[scm_hash]; SCM_NIMP (lsym); lsym = SCM_CDR (lsym))
+    {
+      z = SCM_CAR (lsym);
+      if (SCM_CAR (z) == sym)
+	{
+	  return z;
+	}
+    }
+  return SCM_BOOL_F;
+}
+
+
+/*
+ * remove handle from obarray
+ */
+static SCM 
+scm_symbol_remove_handle (obarray, sym, scm_hash)
+     SCM sym;
+     SCM obarray;
+     scm_sizet scm_hash;
+{
+  SCM lsym;
+  SCM *lsymp;
+  SCM z;
+
+  for (lsym = *(lsymp = &SCM_VELTS (obarray)[scm_hash]);
+	   SCM_NIMP (lsym);
+	   lsym = *(lsymp = SCM_CDRLOC (lsym)))
+	{
+	  z = SCM_CAR (lsym);
+	  if (SCM_CAR (z) == sym)
+	    {
+	      *lsymp = SCM_CDR (lsym);
+	      return z;
+	    }
+	}
+  return SCM_BOOL_F;
+}
+
+static void
+scm_symbol_remove_all_handles (obarray, size)
+     SCM obarray;
+     scm_sizet size;
+{
+  scm_sizet i;
+
+  for (i=0; i<size; i++) 
+    {
+      SCM_VELTS (obarray)[i] = SCM_EOL;
+    }
+}
+
+
+
+/* error conditions */
+
+/*
+ * Throw an error if symbol is not bound in environment func
+ */
+static void
+scm_error_environment_unbound(func, message, args, env, symbol)
+     char *func;
+     char *message;
+     SCM args;
+     SCM env;
+     SCM symbol;
+{
+  char error[255] = "Symbol not bound in environment `%s' (symbol: `%s').";
+  SCM arguments = scm_cons(env, scm_cons(symbol, args));
+  scm_misc_error (func, strcat(error, message), arguments);
+}
+
+/*
+ * Throw an error if two imported symbols have the same name
+ */
+static void
+scm_error_environment_name_conflict(func, message, args, env, symbol)
+     char *func;
+     char *message;
+     SCM args;
+     SCM env;
+     SCM symbol;
+{
+  char error[255] =  "Symbol `%s' imported from `%s' shadows another symbol with the same name.";
+  SCM arguments = scm_cons(symbol, scm_cons(env, args));
+  scm_misc_error (func, strcat(error, message), arguments);
+}
+
+/*
+ * Throw an error if symbol has conflicting location tags 
+ */
+static void
+scm_error_environment_conflicting_tags(func, message, args, env, symbol)
+     char *func;
+     char *message;
+     SCM args;
+     SCM env;
+     SCM symbol;
+{
+  char error[255] = "In environment `%s':\nThe cell for symbol `%s' can either be imported immutable or mutable, but not both.";
+  SCM arguments = scm_cons(env, scm_cons(symbol, args));
+  scm_misc_error (func, strcat(error, message), arguments);
+}
+
+/*
+ * Throw an error if func tried to create (define) or remove
+ * (undefine) a new binding for symbol in env 
+ */
+static void
+scm_error_environment_immutable_bindings(func, message, args, env, symbol)
+     char *func;
+     char *message;
+     SCM args;
+     SCM env;
+     SCM symbol;
+{
+  char error[255] = "Immutable bindings in environment %s (symbol: `%s').";
+  SCM arguments = scm_cons(env, scm_cons(symbol, args));
+  scm_misc_error (func, strcat(error, message), arguments);
+}
+
+/*
+ * Throw an error if func tried to change (set_cdr) a immutable vcell.
+ */
+static void
+scm_error_environment_immutable_location(func, message, args, env, symbol)
+     char *func;
+     char *message;
+     SCM args;
+     SCM env;
+     SCM symbol;
+{
+  char error[255] = "Immutable location in environment `%s' (symbol: `%s').";
+  SCM arguments = scm_cons(env, scm_cons(symbol, args));
+  scm_misc_error (func, strcat(error, message), arguments);
+}
+
+
+
+/* generic environments */
+
+SCM
+scm_c_environment_ref (env, sym)
+     SCM env;
+     SCM sym;
+{
+  SCM_ASSERT(SCM_NIMP(env) && SCM_ENVIRONMENTP(env), env, SCM_ARG1, "scm_c_environment_ref");
+  SCM_ASSERT(SCM_NIMP(sym) && SCM_SYMBOLP(sym), sym, SCM_ARG2, "scm_c_environment_ref");
+
+  return SCM_ENVIRONMENT_REF(env, sym);
+}
+
+SCM_PROC(s_environment_ref, "environment-ref", 2, 0, 0, scm_environment_ref);
+SCM
+scm_environment_ref (env, sym)
+     SCM env;
+     SCM sym;
+{
+  SCM val;
+  SCM_ASSERT(SCM_NIMP(env) && SCM_ENVIRONMENTP(env), env, SCM_ARG1, s_environment_ref);
+  SCM_ASSERT(SCM_NIMP(sym) && SCM_SYMBOLP(sym), sym, SCM_ARG2, s_environment_ref);
+ 
+
+ val = SCM_ENVIRONMENT_REF (env, sym);
+
+  if(val == SCM_UNDEFINED)
+    scm_error_environment_unbound(s_environment_ref, "", SCM_EOL, env, sym);
+
+  return val;
+}
+
+
+/*
+ * the default env_folder
+ */
+static SCM
+scm_default_environment_folder (data, symbol, value, tail)
+     SCM data;
+     SCM symbol;
+     SCM value;
+     SCM tail;
+{
+  SCM answer;
+				/* don't pass these values to scheme level */
+  if ((value == SCM_UNDEFINED) || (value == SCM_UNSPECIFIED))
+     return tail;
+  
+  answer = gh_call3 (data, symbol, value, tail);
+  
+  return answer;
+}
+
+SCM 
+scm_c_environment_fold (env, proc, data, init)
+     SCM env;
+     scm_environment_folder proc;
+     SCM data;
+     SCM init;
+{
+  SCM_ASSERT(SCM_NIMP(env) && SCM_ENVIRONMENTP(env), env, SCM_ARG1, "scm_c_environment_fold");
+
+  return SCM_ENVIRONMENT_FOLD(env, proc, data, init);
+}
+  
+SCM_PROC(s_environment_fold, "environment-fold", 3, 0, 0, scm_environment_fold);
+SCM
+scm_environment_fold(env, proc, init)
+     SCM env;
+     SCM proc;
+     SCM init;
+{
+  SCM_ASSERT(SCM_NIMP(env) && SCM_ENVIRONMENTP(env), env, SCM_ARG1, s_environment_fold);
+  SCM_ASSERT(SCM_NIMP(proc) && (SCM_BOOL_T == scm_procedure_p(proc)), proc, SCM_ARG2, s_environment_fold);
+  
+  return SCM_ENVIRONMENT_FOLD (env, scm_default_environment_folder, proc, init); 
+}
+
+SCM_PROC(s_environment_define, "environment-define", 3, 0, 0, scm_environment_define);
+SCM
+scm_environment_define(env, sym, val)
+     SCM env;
+     SCM sym;
+     SCM val;
+{
+  SCM_ASSERT(SCM_NIMP(env) && SCM_ENVIRONMENTP(env), env, SCM_ARG1, s_environment_define);
+  SCM_ASSERT(SCM_NIMP(sym) && SCM_SYMBOLP(sym), sym, SCM_ARG2, s_environment_define);
+ 
+  SCM_ENVIRONMENT_DEFINE(env, sym, val);
+
+  return SCM_UNSPECIFIED;
+}
+
+SCM_PROC(s_environment_undefine, "environment-undefine", 2, 0, 0, scm_environment_undefine);
+SCM
+scm_environment_undefine(env, sym)
+     SCM env;
+     SCM sym;
+{
+  SCM_ASSERT(SCM_NIMP(env) && SCM_ENVIRONMENTP(env), env, SCM_ARG1, s_environment_undefine);
+  SCM_ASSERT(SCM_NIMP(sym) && SCM_SYMBOLP(sym), sym, SCM_ARG2, s_environment_undefine);
+
+  SCM_ENVIRONMENT_UNDEFINE(env, sym);
+
+  return SCM_UNSPECIFIED;
+}
+
+SCM_PROC(s_environment_set_x, "environment-set!", 3, 0, 0, scm_environment_set_x);
+SCM
+scm_environment_set_x(env,sym,val)
+     SCM env;
+     SCM sym;
+     SCM val;
+{
+  SCM_ASSERT(SCM_NIMP(env) && SCM_ENVIRONMENTP(env), env, SCM_ARG1, s_environment_set_x);
+  SCM_ASSERT(SCM_NIMP(sym) && SCM_SYMBOLP(sym), sym, SCM_ARG2, s_environment_set_x);
+
+  SCM_ENVIRONMENT_SET(env, sym, val);
+
+  return SCM_UNSPECIFIED;
+}  
+
+SCM
+scm_c_environment_cell(env, sym, for_write)
+     SCM env;
+     SCM sym;
+     int for_write;
+{
+  SCM_ASSERT(SCM_NIMP(env) && SCM_ENVIRONMENTP(env), env, SCM_ARG1, "scm_c_environment_cell");
+  SCM_ASSERT(SCM_NIMP(sym) && SCM_SYMBOLP(sym), sym, SCM_ARG2, "scm_c_environment_cell");
+
+  return SCM_ENVIRONMENT_CELL (env, sym, for_write);
+}
+
+
+SCM_PROC(s_environment_cell, "environment-cell", 3, 0, 0, scm_environment_cell);
+SCM
+scm_environment_cell(env, sym, for_write)
+     SCM env;
+     SCM sym;
+     SCM for_write;
+{
+  SCM vcell;
+
+  SCM_ASSERT(SCM_NIMP(env) && SCM_ENVIRONMENTP(env), env, SCM_ARG1, s_environment_cell);
+  SCM_ASSERT(SCM_NIMP(sym) && SCM_SYMBOLP(sym), sym, SCM_ARG2, s_environment_cell);
+
+  vcell = SCM_ENVIRONMENT_CELL (env, sym, for_write == SCM_BOOL_T);
+
+  if (SCM_IMP (vcell))
+    scm_error_environment_unbound(s_environment_cell, "", SCM_EOL, env, sym);
+
+  return vcell;
+}
+
+SCM_PROC(s_environment_bound_p, "environment-bound?", 2, 0, 0, scm_environment_bound_p);
+SCM
+scm_environment_bound_p (env, sym)
+     SCM env;
+     SCM sym;
+{
+  SCM_ASSERT(SCM_NIMP(env) && SCM_ENVIRONMENTP(env), env, SCM_ARG1, s_environment_bound_p);
+  SCM_ASSERT(SCM_NIMP(sym) && SCM_SYMBOLP(sym), sym, SCM_ARG2, s_environment_bound_p);
+
+  return SCM_ENVIRONMENT_BOUND (env, sym);
+}
+
+/*
+ * call scheme level observer
+ * data is observer proc
+ */
+static void
+default_observer (env, data)
+     SCM env;
+     SCM data;
+{
+  gh_call1 (data, env);
+}
+
+/* 
+ * the internal update protocoll uses this function as a tag.  Instead
+ * of calling this function it will call environment_update()
+ * directly. */
+static void
+environment_update_dummy_observer (env, data)
+     SCM env;
+     SCM data;
+{
+}
+
+static SCM
+scm_environment_observe_internal (env, proc, data, weak_p)
+     SCM env;
+     scm_environment_observer proc;
+     SCM data;
+     int weak_p;
+{
+  static SCM scm_make_leaf_observer ();
+
+  return scm_make_leaf_observer(SCM_LEAF_ENVIRONMENT_STRUCT(env), proc, data, weak_p);
+}
+
+SCM
+scm_c_environment_observe (env, proc, data, weak_p)
+     SCM env;
+     scm_environment_observer proc;
+     SCM data;
+     int weak_p;
+{
+  SCM_ASSERT(SCM_NIMP(env) && SCM_ENVIRONMENTP(env), env, SCM_ARG1, "scm_c_environment_observe");
+
+  return SCM_ENVIRONMENT_OBSERVE(env, proc, data, weak_p);
+}
+  
+SCM_PROC(s_environment_observe, "environment-observe", 2, 0, 0, scm_environment_observe);
+SCM
+scm_environment_observe(env, proc)
+     SCM env;
+     SCM proc;
+{
+  SCM_ASSERT(SCM_NIMP(env) && SCM_ENVIRONMENTP(env), env, SCM_ARG1, s_environment_observe);
+
+  return SCM_ENVIRONMENT_OBSERVE (env, default_observer, proc, 0);
+}
+
+SCM_PROC(s_environment_observe_weak, "environment-observe-weak", 2, 0, 0, scm_environment_observe_weak);
+SCM
+scm_environment_observe_weak(env, proc)
+     SCM env;
+     SCM proc;
+{
+  static SCM scm_make_leaf_observer ();
+
+  SCM_ASSERT(SCM_NIMP(env) && SCM_ENVIRONMENTP(env), env, SCM_ARG1, s_environment_observe_weak);
+
+  return scm_make_leaf_observer(SCM_LEAF_ENVIRONMENT_STRUCT(env), default_observer, proc, 1);
+}
+
+
+/*
+ * Remove observer from list
+ */
+static void 
+environment_unobserve (observer)
+     struct environment_observer *observer;
+{
+  SCM leaf_environment;
+  SCM smob;
+  struct environment_observer *node, *prev;
+
+				/* does it observe an environment? */
+  if (SCM_IMP(observer->synapse)) return;
+
+				/* is the environment still available? */
+  leaf_environment = SCM_VELTS (observer->synapse)[0];
+  if(SCM_IMP(leaf_environment)) return;
+
+				/* does the environment have an observer-list? */
+  smob = SCM_VELTS(SCM_LEAF_ENVIRONMENT_STRUCT(leaf_environment)->synapse)[1];
+  if(SCM_IMP(smob)) return;
+
+				/* remove first element */
+  node = SCM_OBSERVER_STRUCT(smob);
+  if(node == observer) 
+    {
+      SCM_VELTS(SCM_LEAF_ENVIRONMENT_STRUCT (leaf_environment)->synapse)[1] = node->next;
+      node->synapse = SCM_BOOL_F;
+    }
+
+				/* remove element from list */
+  prev = node;
+  smob = node->next;
+
+  while (SCM_NIMP(smob))
+    {
+      node = SCM_OBSERVER_STRUCT(smob);
+      smob = node->next;
+
+      if (node == observer) 
+	{
+	  prev->next = smob;
+	  node->synapse = SCM_BOOL_F;
+	  return;
+	}
+      prev = node;
+    }
+}
+
+static void
+scm_environment_unobserve_internal (dummy, observer_smob)
+     SCM dummy;
+     SCM observer_smob;
+{
+  environment_unobserve (SCM_OBSERVER_STRUCT(observer_smob));
+}
+  
+SCM_PROC(s_environment_unobserve, "environment-unobserve", 1, 0, 0, scm_environment_unobserve);
+SCM
+scm_environment_unobserve (observer_smob)
+     SCM observer_smob;
+{
+  struct environment_observer *observer;
+  SCM_ASSERT(SCM_NIMP(observer_smob) && SCM_OBSERVERP(observer_smob),
+	     observer_smob, SCM_ARG1, s_environment_unobserve);
+
+  observer = SCM_OBSERVER_STRUCT(observer_smob);
+  if(SCM_NIMP (observer->synapse) && SCM_NIMP(SCM_VELTS(observer->synapse)[0]))
+    {
+      SCM_ENVIRONMENT_UNOBSERVE(SCM_VELTS(observer->synapse)[0], observer_smob);
+    }
+
+  return SCM_UNSPECIFIED;
+}
+
+/* 
+ * tell all obervers to update their bindings 
+ */
+static void 
+scm_environment_broadcast (leaf_env, sym, old_cell, new_cell, name)
+     SCM leaf_env;
+     SCM sym;			/* #f -> remove all bindings */
+     SCM old_cell;		
+     SCM new_cell;		/* #f -> remove binding */
+     char *name;
+{
+  struct leaf_environment *leaf_environment = SCM_LEAF_ENVIRONMENT_STRUCT(leaf_env);
+  SCM node;
+
+				/* call all observers */
+  node = SCM_VELTS(leaf_environment->synapse)[1];
+  while (SCM_NIMP (node))
+    {
+      struct environment_observer *observer =  SCM_OBSERVER_STRUCT(node);
+      node = observer->next;
+
+      (observer->c) (leaf_env, observer->scheme);
+    }
+
+
+  /* now the enhanced version for all environments that support it
+   (leaf, export, protect, eval and import environment).  Environments
+   which do not support the enhanced update protocol (i.e. do not
+   share the common structure `leaf_environment') must not call
+   environment_observe with argument
+   `environment_update_dummy_observer'. */
+
+  node = SCM_VELTS(leaf_environment->synapse)[1];
+  while (SCM_NIMP (node))
+    {
+      struct environment_observer *observer =  SCM_OBSERVER_STRUCT(node);
+      node = observer->next;
+      
+      if(observer->c == environment_update_dummy_observer)
+	{
+	  (*SCM_LEAF_ENVIRONMENT_STRUCT(observer->scheme)->update)
+	    (observer->scheme, leaf_env, sym, old_cell, new_cell, name);
+	}
+    }
+}
+
+static SCM
+mark_environment (SCM environment_smob)
+{
+  struct environment *environment = SCM_ENVIRONMENT_STRUCT(environment_smob);
+
+  scm_gc_mark (environment->obarray);
+
+				/* subtype */
+  if(environment->environment_funcs->mark) 
+    {
+      return (*environment->environment_funcs->mark) (environment_smob);
+    }
+
+  return  SCM_BOOL_F;
+}
+
+static scm_sizet
+free_environment (SCM environment_smob)
+{
+  struct environment *environment = SCM_ENVIRONMENT_STRUCT(environment_smob);
+  scm_sizet size;
+
+  /* free the concrete but not the generic environment */
+  size = (*environment->environment_funcs->free) (environment_smob);
+
+  return size;
+}
+
+
+static int
+print_environment (SCM environment_smob, SCM port, scm_print_state *pstate)
+{
+  struct environment_funcs *environment_funcs = 
+    SCM_ENVIRONMENT_FUNCS(environment_smob);
+
+  if(environment_funcs->print) 
+    {
+      return (*environment_funcs->print) (environment_smob, port, pstate);
+    }
+  else 
+    {
+      abort(); /* instance of a generic environment!?! */
+    }
+
+  return 1;
+}
+
+static scm_smobfuns environment_funs = {
+  mark_environment, free_environment, print_environment, 0
+};
+
+/*
+ * Create a concrete environment for type `handle'
+ * handle is the parameter for the generic type struct environment. Together
+ * they build a concrete (eval-/export- etc) environment.
+ *
+ * `handle' is a pointer to both struct environment and
+ * struct_export/eval/..._environment.  struct environment_funcs
+ * is the class signature and has been initialized by the caller.
+ */
+SCM
+scm_make_environment (void *handle, scm_sizet size)
+{
+  struct environment *environment = (struct environment*) handle;
+  SCM environment_smob;
+  
+  environment->obarray = SCM_BOOL_F;
+
+  SCM_NEWCELL (environment_smob);
+  SCM_SETCDR (environment_smob, environment);
+  SCM_SETCAR (environment_smob, scm_tc16_environment);
+
+  environment->obarray = 
+    scm_make_vector ((SCM) SCM_MAKINUM (size), SCM_EOL);  
+
+  return environment_smob;
+}
+
+SCM_PROC(s_environment_p, "environment?", 1, 0, 0, scm_environment_p);
+SCM
+scm_environment_p(env)
+     SCM env;
+{
+  return (SCM_NIMP(env) && SCM_ENVIRONMENTP(env)) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+
+
+
+/* observers */
+
+/* after the sweep phase every weak observer will be checked if its
+   weak `scheme' data is still valid.  If not, the observer will be
+   removed from the observer-list and from guardians  */
+struct guardian {
+  struct environment_observer observer;
+  struct guardian *next;
+};
+
+static struct guardian *guardians = 0;
+
+/*
+ * create and return a new observer smob observing any of the
+ * standard environments (leaf, eval, export, protect and import).
+ * If data is weak, create a guard for it.
+ */
+static SCM
+scm_make_leaf_observer (leaf_environment, proc, data, weak_p)
+     struct leaf_environment *leaf_environment;
+     scm_environment_observer proc;
+     SCM data;
+     int weak_p;
+{
+  SCM observer_smob;
+  struct environment_observer *observer;
+
+  observer = scm_must_malloc (weak_p ? 
+			      sizeof (struct guardian) : 
+			      sizeof (struct environment_observer), 
+			      "scm_make_leaf_observer");
+  
+  observer->weak_p = weak_p;
+  observer->c = proc;
+  observer->scheme = data;
+  observer->next = SCM_EOL;
+
+  SCM_NEWCELL (observer_smob);
+  SCM_SETCDR (observer_smob, observer);
+  SCM_SETCAR (observer_smob, scm_tc16_observer);
+
+  observer->next = SCM_VELTS(leaf_environment->synapse)[1];
+  SCM_VELTS(leaf_environment->synapse)[1] = observer_smob;
+  observer->synapse = leaf_environment->synapse;
+
+  if(weak_p) /* needs guard */
+    {
+      SCM_REDEFER_INTS;
+      ((struct guardian*) observer)->next = guardians;
+      guardians = (struct guardian*) observer;
+      SCM_REALLOW_INTS;
+    }
+
+  return observer_smob;
+}
+
+
+/*
+ * remove the observer_env watching env from env's observer-list
+ */
+static void 
+scm_drop_internal_observer(env, observer_env)
+     SCM env;
+     SCM observer_env;
+{
+  struct leaf_environment *leaf_environment = SCM_LEAF_ENVIRONMENT_STRUCT(env);
+  SCM node;
+
+  node = SCM_VELTS(leaf_environment->synapse)[1];
+  while (SCM_NIMP(node))
+    {
+      struct environment_observer *observer = SCM_OBSERVER_STRUCT(node);
+
+      if (observer->c == environment_update_dummy_observer && 
+	  observer->scheme == observer_env)
+	{
+	  environment_unobserve(observer);
+	  return;
+	}
+      node = observer->next;
+    }
+}
+  
+/*
+ * remove guard from guardians
+ */
+static void
+scm_remove_guard (guard)
+     struct guardian *guard;
+{
+  struct guardian *node, *prev;
+
+  if (guardians == guard)
+    {
+      guardians = guardians->next;
+      return;
+    }
+
+  prev = guardians; 
+  node = guardians->next;
+  while (node)
+    {
+      if (node == guard)
+	{
+	  prev->next = node->next;
+	  return;
+	}
+      prev = node;
+      node = node->next;
+    }
+
+  /* may happen when removed by finalize_weaks and then
+     gc'ed. */
+}
+
+/*
+ * remove all observers that contain gc'ed `scheme' data
+ * called directly after the sweep phase 
+ */
+void 
+scm_observer_finalize_weaks()
+{
+  struct guardian *node, *prev;
+
+  while (guardians && SCM_FREEP (guardians->observer.scheme))
+    {
+      environment_unobserve ((struct environment_observer*)guardians);
+      guardians = guardians->next;
+    }
+  if (!guardians) return;
+
+
+  prev = guardians;
+  node = guardians->next;
+  while (node)
+    {
+      if (SCM_FREEP (node->observer.scheme))
+	{
+	  environment_unobserve ((struct environment_observer*)node);
+	  prev->next = node->next;
+	}
+      prev = node;
+      node = node ->next;
+    }
+}
+
+static SCM
+mark_observer (SCM observer_smob)
+{
+  struct environment_observer *observer = SCM_OBSERVER_STRUCT(observer_smob);
+  
+  if (!observer->weak_p)
+    {
+      scm_gc_mark(observer->scheme);
+    }
+  
+  scm_gc_mark(observer->synapse);
+
+  return SCM_BOOL_F;
+}
+
+static scm_sizet
+free_observer (SCM observer_smob)
+{
+  struct environment_observer *observer = SCM_OBSERVER_STRUCT(observer_smob);
+  
+  if (observer->weak_p)		/* observer has guard */
+    {
+				/* remove from guarded list */
+      scm_remove_guard ((struct guard*) observer);
+    }
+
+  free(observer);
+
+  return sizeof observer_smob;
+}
+
+
+static int
+print_observer (SCM type, SCM port, scm_print_state *pstate)
+{
+  scm_puts ("#<observer ", port);
+  scm_puts (SCM_CHARS(scm_number_to_string(scm_ulong2num((unsigned long)type), SCM_MAKINUM (16))), port);
+  scm_puts (">", port);
+
+  return 1;
+}
+
+static scm_smobfuns observer_funs = {
+  mark_observer, free_observer, print_observer, 0
+};
+
+
+
+/* leaf environments */
+
+static SCM
+leaf_environment_get_vcell(env, sym)
+     SCM env;
+     scm_sizet sym;
+{
+  scm_sizet scm_hash = SCM_HASHCODE (sym);
+  return scm_symbol_get_handle (SCM_ENVIRONMENT_OBARRAY(env), sym, scm_hash);
+}  
+
+static SCM 
+scm_leaf_environment_fold (env, proc, data, init)
+     SCM env;
+     scm_environment_folder proc;
+     SCM data;
+     SCM init;
+{
+  scm_sizet i;
+  SCM retcode;
+  SCM obarray;
+
+  retcode = init;
+  
+  obarray = SCM_ENVIRONMENT_OBARRAY(env);
+
+  for (i=0; i<scm_symhash_dim; i++) 
+    {
+      SCM lsym;
+      
+      for (lsym = SCM_VELTS (obarray)[i]; SCM_NIMP (lsym); 
+	   lsym = SCM_CDR (lsym))
+	{
+	  SCM vcell;
+	  vcell = SCM_CAR (lsym);
+	  vcell = SCM_CELL_VAL (SCM_CDR (vcell));
+	  retcode = (*proc)(data, SCM_CAR(vcell), SCM_CDR(vcell), retcode);
+	} 
+    }
+  return retcode;
+}
+
+static SCM
+scm_leaf_environment_define(env, sym, val)
+     SCM env;
+     SCM sym;
+     SCM val;
+{
+  SCM vcell;
+  scm_sizet scm_hash;
+
+  scm_hash = SCM_HASHCODE (sym);
+  vcell = scm_symbol_get_handle (SCM_ENVIRONMENT_OBARRAY(env), sym, scm_hash);
+
+  if (SCM_NIMP (vcell))
+    {
+      SCM_SETCDR (SCM_CELL_VAL (SCM_CDR (vcell)), val);
+    }
+  else 
+    {				/* create a new cell */
+      SCM cell = scm_cons (scm_cons (scm_cons (sym, val), SCM_EOL), SCM_EOL);
+      vcell = scm_symbol_create_handle (SCM_ENVIRONMENT_OBARRAY(env), sym, scm_hash, cell);
+      
+    }
+
+  return SCM_CELL_VAL (SCM_CDR (vcell)); /* environment_define returns "real" vcell */
+}
+
+static void
+scm_leaf_environment_undefine(env, sym)
+     SCM env;
+     SCM sym;
+{
+  SCM obarray = SCM_ENVIRONMENT_OBARRAY(env);
+  scm_sizet scm_hash = SCM_HASHCODE (sym);
+  SCM vcell = scm_symbol_get_handle(obarray, sym, scm_hash);
+
+  if (SCM_IMP (vcell)) return;
+
+  scm_environment_broadcast (env, sym, SCM_CDR(vcell), SCM_BOOL_F, s_environment_undefine);
+
+				/* if succeded ... */
+  scm_symbol_remove_handle(obarray, sym, scm_hash);
+}
+
+static void
+scm_leaf_environment_set_x(env, sym, val)
+     SCM env;
+     SCM sym;
+     SCM val;
+{
+  SCM vcell = leaf_environment_get_vcell(env, sym);
+  
+  if (SCM_NIMP (vcell))
+    {
+      SCM_SETCDR( SCM_CELL_VAL (SCM_CDR (vcell)), val);
+    }
+  else 
+    {
+      scm_error_environment_unbound(s_environment_set_x, "", SCM_EOL, env, sym);
+    }
+}
+
+static SCM 
+scm_leaf_environment_ref (env, sym)
+     SCM env;
+     SCM sym;
+{
+  SCM vcell = leaf_environment_get_vcell(env, sym);
+
+  if (SCM_NIMP(vcell))
+    {
+      return SCM_CDR (SCM_CELL_VAL (SCM_CDR (vcell)));
+    }
+  return SCM_UNDEFINED;
+}
+
+static SCM
+scm_leaf_environment_cell(env, sym, for_write)
+     SCM env;
+     SCM sym;
+     int for_write;
+{
+  SCM vcell = leaf_environment_get_vcell(env, sym);
+
+  if (SCM_NIMP(vcell))
+    {
+      return SCM_CDR (vcell);
+    }
+  return SCM_BOOL_F;
+}
+
+static void 
+mark_all_observer_smobs(node)
+     SCM node;
+{
+  while (SCM_NIMP (node))
+    {
+      struct environment_observer *observer =  SCM_OBSERVER_STRUCT(node);
+
+      scm_gc_mark(node);
+
+      node = observer->next;
+    }
+}
+  
+static SCM
+mark_leaf_environment (env)
+     SCM env;
+{
+  struct leaf_environment *leaf_environment = SCM_LEAF_ENVIRONMENT_STRUCT(env);
+
+  if(SCM_NIMP(leaf_environment->synapse))
+    {
+      mark_all_observer_smobs(SCM_VELTS(leaf_environment->synapse)[1]);
+      scm_gc_mark(leaf_environment->synapse);
+    }
+
+  return  SCM_BOOL_F;
+}
+
+static scm_sizet
+free_leaf_environment (env)
+     SCM env;
+{
+  struct leaf_environment *leaf_environment = SCM_LEAF_ENVIRONMENT_STRUCT(env);
+
+  scm_sizet size;
+
+  size = sizeof (struct leaf_environment);
+
+  free (leaf_environment);
+
+  return size;
+}
+
+static int
+print_leaf_environment (SCM type, SCM port, scm_print_state *pstate)
+{
+  scm_puts ("#<leaf environment ", port);
+  scm_puts (SCM_CHARS(scm_number_to_string(scm_ulong2num((unsigned long)type), SCM_MAKINUM (16))), port);
+  scm_puts (">", port);
+  return 1;
+}
+
+struct environment_funcs leaf_environment_funcs = {
+  scm_leaf_environment_ref,
+  scm_leaf_environment_fold,
+  scm_leaf_environment_define,
+  scm_leaf_environment_undefine,
+  scm_leaf_environment_set_x,
+  scm_leaf_environment_cell,
+  scm_environment_observe_internal,
+  scm_environment_unobserve_internal,
+  mark_leaf_environment,
+  free_leaf_environment,
+  print_leaf_environment
+};
+
+void *scm_type_leaf_environment = &leaf_environment_funcs;
+
+SCM_PROC(s_make_leaf_environment, "make-leaf-environment", 0, 0, 0, scm_make_leaf_environment);
+SCM
+scm_make_leaf_environment ()
+{
+  SCM leaf_environment_smob;
+  struct leaf_environment *leaf_environment = 
+    scm_must_malloc (sizeof *leaf_environment, s_make_leaf_environment);
+
+  leaf_environment->environment.environment_funcs = &leaf_environment_funcs;
+  leaf_environment->synapse = SCM_EOL;
+  leaf_environment->update = 0;
+
+  leaf_environment_smob = scm_make_environment(leaf_environment, scm_symhash_dim);
+
+  leaf_environment->synapse = scm_make_weak_vector (SCM_MAKINUM(2), SCM_EOL);
+  SCM_VELTS(leaf_environment->synapse)[0] = leaf_environment_smob;
+
+
+  return leaf_environment_smob;
+}
+
+SCM_PROC(s_leaf_environment_p, "leaf-environment?", 1, 0, 0, scm_leaf_environment_p);
+static SCM
+scm_leaf_environment_p (env)
+     SCM env;
+{
+  return SCM_NIMP(env) && SCM_ENVIRONMENTP(env) && 
+    SCM_LEAF_ENVIRONMENTP(env) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+ 
+
+
+/* eval environments */ 
+
+static SCM
+eval_environment_get_cell(env, sym, for_write, name)
+     SCM env;
+     SCM sym;
+     int for_write;
+     char *name;
+{
+  struct eval_environment *eval_environment =
+    SCM_EVAL_ENVIRONMENT_STRUCT(env);
+
+  SCM cell;
+  SCM vcell;
+  SCM obarray;
+  SCM local_obarray;
+  scm_sizet scm_hash;
+  SCM import;
+
+  obarray = SCM_ENVIRONMENT_OBARRAY (env);
+  local_obarray = SCM_ENVIRONMENT_OBARRAY (eval_environment->local);
+
+  scm_hash = SCM_HASHCODE (sym);
+
+				/* in cache? */
+  vcell =  scm_symbol_get_handle (obarray, sym, scm_hash);
+  if (SCM_NIMP (vcell))
+    {
+      if (!for_write || 
+	 SCM_MUTABLE_LOCATIONP (SCM_CELL_TAG (SCM_CDR(vcell))))
+	{
+	  return SCM_CDR(vcell); 
+	}
+      else
+	{
+	  scm_error_environment_immutable_location(name, "", SCM_EOL, env, sym);
+	}
+    }
+				/* in local? */
+  vcell = scm_symbol_get_handle (local_obarray, sym, scm_hash);
+  if (SCM_NIMP (vcell))
+    {				/* copy to cache */
+      vcell = scm_symbol_create_handle(obarray, sym, scm_hash, SCM_CDR(vcell));
+
+      return SCM_CDR(vcell);
+    }
+      
+
+  import = SCM_EVAL_ENVIRONMENT_IMPORTED(env);
+  cell = SCM_ENVIRONMENT_CELL (import, sym, 0); 
+
+  if (SCM_NIMP (cell))
+    {
+      if(!for_write || 
+	 SCM_MUTABLE_LOCATIONP(SCM_CELL_TAG (cell)))
+	{			
+				/* copy to cache */
+	  vcell = scm_symbol_create_handle(obarray, sym, scm_hash, cell);
+	  return SCM_CDR(vcell);
+	}
+      else
+	{
+	  scm_error_environment_immutable_location(name, "", SCM_EOL, env, sym);
+	}
+    }
+  return SCM_BOOL_F;
+}
+
+static SCM
+scm_eval_environment_cell(env, sym, for_write)
+     SCM env;
+     SCM sym;
+     int for_write;
+{
+  return eval_environment_get_cell (env, sym, for_write, s_environment_cell);
+}
+
+static SCM 
+scm_eval_environment_ref (env, sym)
+     SCM env;
+     SCM sym;
+{
+  SCM cell = eval_environment_get_cell(env, sym, 0, s_environment_ref);
+    
+  if (SCM_NIMP (cell))
+    {			    
+      return SCM_CDR (SCM_CELL_VAL (cell));
+    }
+
+  return SCM_UNDEFINED;
+}
+
+static SCM 
+scm_eval_environment_fold (env, proc, data, init)
+     SCM env;
+     scm_environment_folder proc;
+     SCM data;
+     SCM init;
+{
+  struct eval_environment *environment = SCM_EVAL_ENVIRONMENT_STRUCT(env);
+  return scm_leaf_environment_fold (environment->local, proc, data, init);
+}
+
+/*
+ * update all memoized expressions to new_vcell+1 or unmemoize them
+ * if new_vcell is SCM_UNDEFINED
+ */
+void
+eval_environment_update_memoized (env, old_vcell, new_vcell)
+     SCM env;
+     SCM old_vcell;
+     SCM new_vcell; /* SCM_UNDEFINED -> unmemoize */
+{
+  SCM lsym;
+  SCM *lsymp;
+  SCM vcell;
+  SCM obarray;
+  unsigned int k;
+
+  obarray = SCM_EVAL_ENVIRONMENT_MEMOIZED(env);
+  k = scm_ihashq (old_vcell, SCM_LENGTH (obarray));
+
+  for (lsym = *(lsymp = &SCM_VELTS (obarray)[k]); SCM_NIMP (lsym);)
+	{
+	  vcell = SCM_CAR (lsym);
+	  if (SCM_CAR (vcell) == old_vcell)
+	    {			/* (vcell sym . expr) */
+	      SCM expr = SCM_CDDR (vcell);
+	      if (SCM_IMP (new_vcell)) /* undefined: unmemoize expr */
+		{
+		  SCM sym = SCM_CADR(vcell);
+
+		  SCM_SETCAR(expr, sym);
+		  lsym = (*lsymp = SCM_CDR (lsym)); /* remove unmemoized */
+		}
+	      else		/* re-memoize */
+		{
+		  SCM_SETCAR (expr, new_vcell + 1);
+		  lsym = *(lsymp = SCM_CDRLOC (lsym)); /* next cell */
+		}
+	    }
+	  else
+	    {
+	      lsym = *(lsymp = SCM_CDRLOC (lsym)); /* next cell */
+	    }
+	}
+}
+
+static void
+eval_environment_unmemoize_all(env)
+     SCM env;
+{
+  scm_sizet i;
+  SCM obarray;
+  SCM lsym;
+  SCM *lsymp;
+
+  obarray = SCM_EVAL_ENVIRONMENT_MEMOIZED (env);
+
+  for (i=0; i<scm_symhash_dim; i++) 
+    {
+      for (lsym = *(lsymp = &SCM_VELTS (obarray)[i]); 
+	   SCM_NIMP (lsym); 
+	   lsym = (*lsymp = SCM_CDR (lsym))) /* remove unmemoized */
+	{
+				/* (vcell sym . expr) */
+	  SCM vcell = SCM_CAR(lsym);
+	  SCM sym = SCM_CADR(vcell);
+	  SCM expr = SCM_CDDR(vcell);
+
+	  SCM_SETCAR(expr, sym); /* unmemoize */
+	}
+    }
+}
+
+/*
+ * Update the value of old_cell to the value of new_cell.
+ * - Do not update a value that has not been cached
+ * - old_cell == #f: remove and unmemoize old binding
+ * - new_cell == #f: remove and unmemoize all bindings
+ * - copy location tags
+ */
+static void
+scm_eval_environment_update (env, caller, sym, old_cell, new_cell, name)
+     SCM env;
+     SCM caller;
+     SCM sym;
+     SCM old_cell;
+     SCM new_cell;
+     char *name;
+{
+  SCM obarray;
+  scm_sizet scm_hash;
+  SCM vcell;
+  obarray = SCM_ENVIRONMENT_OBARRAY(env);
+
+  if (SCM_NIMP(old_cell))
+    {
+      scm_hash = SCM_HASHCODE (sym);
+      vcell = scm_symbol_get_handle (obarray, sym, scm_hash);
+      if (!((SCM_IMP(vcell)) || (SCM_CELL_VAL (SCM_CDR (vcell)) != SCM_CELL_VAL (old_cell))))
+	{
+	  old_cell = SCM_CDR(vcell);
+	  
+	  if (SCM_NIMP (new_cell)) 
+	    {
+	      SCM_SETCDR (vcell, new_cell);
+	    }
+	  else
+	    {
+	      vcell = scm_symbol_remove_handle (obarray, sym, scm_hash);
+	    }
+      
+	  scm_environment_broadcast (env, sym, old_cell, new_cell, name);
+				/* if succeded ... */
+	}
+
+				/* unmemoize all expressions which
+                                   capture old_cell in the current
+                                   environment */
+      eval_environment_update_memoized(env, SCM_CELL_VAL(old_cell),
+				       SCM_NIMP (new_cell)? 
+				       SCM_CELL_VAL(new_cell) :
+				       new_cell);
+    }
+  else 
+    {
+      scm_symbol_remove_all_handles(obarray, scm_symhash_dim);
+      scm_environment_broadcast (env, sym, old_cell, new_cell, name);
+				/* if succeded ... */
+
+      eval_environment_unmemoize_all(env);
+    }
+}
+/*
+ * create a new binding in env and send out an update broadcast
+ * if we shadow a binding from the uses list.
+ *
+ * Do not send out an update broadcast if
+ * 1. vcell was not found in local
+ * 2. environment has no observers
+ * 3. vcell was not found in cache, which means that
+ * binding was never requested by env's observers.
+ */
+static SCM
+scm_eval_environment_define(env, sym, val)
+     SCM env;
+     SCM sym;
+     SCM val;
+{
+  struct eval_environment *eval_environment = SCM_EVAL_ENVIRONMENT_STRUCT(env);
+  SCM obarray;
+  SCM vcell;
+  SCM local_environment;
+  SCM local_obarray;
+  SCM local_vcell;
+  scm_sizet scm_hash;
+
+  obarray = eval_environment->leaf.environment.obarray;
+  scm_hash = SCM_HASHCODE (sym);
+  vcell = scm_symbol_get_handle(obarray, sym, scm_hash);
+
+  local_environment = eval_environment->local;
+  local_obarray = SCM_ENVIRONMENT_OBARRAY (local_environment);
+  local_vcell = scm_symbol_get_handle (local_obarray, sym, scm_hash);
+  
+
+  if (SCM_IMP(local_vcell))
+    {
+				/* create a cell and copy into local and
+                                   into cache */
+      SCM local_cell = scm_cons (scm_cons (scm_cons (sym, val), SCM_EOL), SCM_EOL);
+
+      local_vcell = scm_symbol_create_handle (local_obarray, sym, scm_hash, local_cell);
+      scm_symbol_create_handle(obarray, sym, scm_hash, local_cell);
+
+      if (SCM_NIMP (vcell))	/* we've shadowed a binding from
+                                   useslist */
+	{
+	  SCM shadowed_cell = SCM_CDR(vcell);
+
+	  scm_environment_broadcast (env, sym, shadowed_cell, local_cell, s_environment_define);
+
+				/* re-memoize */
+	  eval_environment_update_memoized(env, SCM_CELL_VAL(shadowed_cell), SCM_CELL_VAL (local_cell));
+	}
+    }
+  else
+    {
+				/* replace value of existing local cell */
+      SCM_SETCDR (SCM_CELL_VAL(SCM_CDR (local_vcell)), val);
+    }
+
+  return SCM_CELL_VAL (SCM_CDR (local_vcell));
+}
+
+static void
+scm_eval_environment_undefine(env, sym)
+     SCM env;
+     SCM sym;
+{
+  struct eval_environment *eval_environment = SCM_EVAL_ENVIRONMENT_STRUCT(env);
+  SCM shadowed_cell;
+  SCM local_environment;
+  SCM local_obarray;
+  SCM local_vcell;
+  SCM local_cell;
+  scm_sizet scm_hash;
+
+  scm_hash = SCM_HASHCODE (sym);
+  local_environment = eval_environment->local;
+  local_obarray = SCM_ENVIRONMENT_OBARRAY (local_environment);
+  local_vcell = scm_symbol_get_handle (local_obarray, sym, scm_hash);
+  
+				/* does it exist? */
+  if (SCM_IMP (local_vcell)) return;
+
+  local_cell = SCM_CDR(local_vcell);
+
+				/* did it shadow a binding? */
+  shadowed_cell = SCM_ENVIRONMENT_CELL (eval_environment->imported, sym, 0); 
+
+
+  scm_environment_broadcast (env, sym, local_cell, shadowed_cell, s_environment_undefine);
+  
+				/* if succeded ... */
+  eval_environment_update_memoized(env, SCM_CELL_VAL(local_cell), 
+				   SCM_NIMP(shadowed_cell) ? 
+				   SCM_CELL_VAL (shadowed_cell) :
+				   shadowed_cell);
+  
+
+				/* remove from cache and from local */
+  scm_symbol_remove_handle (eval_environment->leaf.environment.obarray, sym, scm_hash);
+  scm_symbol_remove_handle (local_obarray, sym, scm_hash);
+}
+
+static void
+scm_eval_environment_set_x(env, sym, val)
+     SCM env;
+     SCM sym;
+     SCM val;
+{
+  SCM cell = eval_environment_get_cell(env, sym, 1, s_environment_set_x);
+    
+  if (SCM_NIMP (cell))
+    {
+      SCM_SETCDR(SCM_CELL_VAL (cell), val);
+    }
+  else
+    {
+      scm_error_environment_unbound(s_environment_set_x, "", SCM_EOL, env, sym);
+    }
+}
+
+
+static SCM
+mark_eval_environment (env)
+     SCM env;
+{
+  struct eval_environment *eval_environment = SCM_EVAL_ENVIRONMENT_STRUCT(env);
+
+  if(SCM_NIMP(eval_environment->leaf.synapse))
+    {
+      mark_all_observer_smobs(SCM_VELTS(eval_environment->leaf.synapse)[1]);
+      scm_gc_mark(eval_environment->leaf.synapse);
+    }
+
+  scm_gc_mark (eval_environment->imported);
+  scm_gc_mark (eval_environment->local);
+  scm_gc_mark (eval_environment->memoized);
+
+  return  SCM_BOOL_F;
+}
+
+static scm_sizet
+free_eval_environment (env)
+     SCM env;
+{
+  scm_sizet size;
+  struct eval_environment *eval_environment = SCM_EVAL_ENVIRONMENT_STRUCT(env);
+
+  size = sizeof (struct eval_environment);
+
+  free (eval_environment);
+
+  return size;
+}
+
+static int
+print_eval_environment (SCM type, SCM port, scm_print_state *pstate)
+{
+  scm_puts ("#<eval environment ", port);
+  scm_puts (SCM_CHARS(scm_number_to_string(scm_ulong2num((unsigned long)type), SCM_MAKINUM (16))), port);
+  scm_puts (">", port);
+
+  return 1;
+}
+
+
+static struct environment_funcs eval_environment_funcs = {
+    scm_eval_environment_ref,
+    scm_eval_environment_fold,
+    scm_eval_environment_define,
+    scm_eval_environment_undefine,
+    scm_eval_environment_set_x,
+    scm_eval_environment_cell,
+    scm_environment_observe_internal,
+    scm_environment_unobserve_internal,
+    mark_eval_environment,
+    free_eval_environment,
+    print_eval_environment
+ };
+void *scm_type_eval_environment = &eval_environment_funcs;
+
+
+SCM_PROC(s_make_eval_environment, "make-eval-environment", 2, 0, 0, scm_make_eval_environment);
+SCM
+scm_make_eval_environment (local, imported)
+     SCM local;
+     SCM imported;
+{
+  struct eval_environment *eval_environment;
+  SCM eval_environment_smob;
+
+  SCM_ASSERT(SCM_NIMP(local) && SCM_ENVIRONMENTP(local) && SCM_LEAF_ENVIRONMENTP(local), local, SCM_ARG1, s_make_eval_environment);
+
+  SCM_ASSERT(SCM_NIMP(imported) && SCM_ENVIRONMENTP(imported), imported, SCM_ARG2, s_make_eval_environment);
+  
+  eval_environment = 
+    scm_must_malloc (sizeof *eval_environment, s_make_eval_environment);
+
+  eval_environment->leaf.environment.environment_funcs = &eval_environment_funcs;
+  eval_environment->local = local;
+  eval_environment->imported = imported;
+  eval_environment->memoized = SCM_BOOL_F;
+
+  eval_environment->leaf.synapse = SCM_BOOL_F;
+  eval_environment->leaf.update = scm_eval_environment_update;
+
+  eval_environment_smob = scm_make_environment(eval_environment, scm_symhash_dim);
+
+  eval_environment->leaf.synapse = scm_make_weak_vector(SCM_MAKINUM(2), SCM_EOL);
+  SCM_VELTS(eval_environment->leaf.synapse)[0] = eval_environment_smob;
+
+  eval_environment->memoized =
+    scm_make_weak_key_hash_table ((SCM) SCM_MAKINUM (scm_symhash_dim));
+
+  if (SCM_NIMP (imported))
+  {
+				/* connect to imported.  Will be dropped when
+				   environment_smob disappears */
+    SCM_ENVIRONMENT_OBSERVE (imported, 
+				      environment_update_dummy_observer,
+				      eval_environment_smob, 1);
+  }
+
+  /* not necessary to observe local because local cells are changed
+     through eval_environment_define/undefine */
+
+  return eval_environment_smob;
+}
+
+SCM_PROC(s_eval_environment_imported, "eval-environment-imported", 1, 0, 0, scm_eval_environment_imported);
+
+SCM
+scm_eval_environment_imported (env)
+     SCM env;
+{
+  SCM_ASSERT(SCM_NIMP(env) && SCM_ENVIRONMENTP(env) && SCM_EVAL_ENVIRONMENTP(env), env, SCM_ARG1, s_eval_environment_imported);
+
+  return SCM_EVAL_ENVIRONMENT_IMPORTED(env);
+}
+
+SCM_PROC(s_eval_environment_local, "eval-environment-local", 1, 0, 0, scm_eval_environment_local);
+
+SCM
+scm_eval_environment_local (env)
+     SCM env;
+{
+  SCM_ASSERT(SCM_NIMP(env) && SCM_ENVIRONMENTP(env) && SCM_EVAL_ENVIRONMENTP(env), env, SCM_ARG1, s_eval_environment_local);
+
+  return SCM_EVAL_ENVIRONMENT_LOCAL(env);
+}
+
+/*
+ * append expr to the list of memoized cells
+ */
+void
+scm_eval_environment_memoize_cell_internal(env, expr, vcell, sym)
+     SCM env;
+     SCM expr;
+     SCM vcell;
+     SCM sym;
+{
+  SCM obarray;
+  unsigned int k;
+
+  obarray = SCM_EVAL_ENVIRONMENT_MEMOIZED (env);
+  k = scm_ihashq (vcell, SCM_LENGTH (obarray));
+
+  SCM_VELTS(obarray)[k] = scm_acons(vcell, scm_cons(sym, expr), SCM_VELTS(obarray)[k]);
+  SCM_SETCAR (expr, vcell + 1);
+
+}
+
+SCM_PROC(s_eval_environment_set_imported_x, "eval-environment-set-imported!", 2, 0, 0, scm_eval_environment_set_imported_x);
+SCM
+scm_eval_environment_set_imported_x (env, imported)
+     SCM env;
+     SCM imported;
+{
+  struct eval_environment *eval_environment;
+  SCM_ASSERT(SCM_NIMP(env) && SCM_ENVIRONMENTP(env) && SCM_EVAL_ENVIRONMENTP(env), env, SCM_ARG1, s_eval_environment_set_imported_x);
+  SCM_ASSERT(SCM_NIMP(imported) && SCM_ENVIRONMENTP(imported), imported, SCM_ARG2, s_eval_environment_set_imported_x);
+
+  eval_environment = SCM_EVAL_ENVIRONMENT_STRUCT(env);  
+
+  eval_environment_unmemoize_all(env);
+  scm_symbol_remove_all_handles(eval_environment->leaf.environment.obarray, scm_symhash_dim);
+
+				/* ask old import-env to remove my old
+                                   observer */
+  if (SCM_NIMP(eval_environment->imported))
+    {
+      scm_drop_internal_observer(eval_environment->imported, env);
+    }
+
+  eval_environment->imported = imported;
+
+				/* a new observer */
+  SCM_ENVIRONMENT_OBSERVE (imported, 
+			   environment_update_dummy_observer,
+			   env, 1);
+
+				/* environments should update their
+                                   caches */
+  scm_environment_broadcast (env, SCM_BOOL_F, SCM_BOOL_F, SCM_BOOL_F, s_eval_environment_set_imported_x);
+
+  return SCM_UNSPECIFIED;
+}
+
+SCM_PROC(s_eval_environment_p, "eval-environment?", 1, 0, 0, scm_eval_environment_p);
+SCM
+scm_eval_environment_p (env)
+     SCM env;
+{
+  return SCM_NIMP(env) && SCM_ENVIRONMENTP(env) && 
+    SCM_EVAL_ENVIRONMENTP(env) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+
+
+/* interface environments */
+
+/*
+ * Throw an error if two imported symbols with the same name are bound
+ * to two different locations 
+ */
+static SCM
+scm_interface_environment_conflict_proc (data, sym, env1, env2)
+     SCM data;
+     SCM sym;
+     SCM env1;
+     SCM env2;
+{
+				/* whamm! */
+  scm_error_environment_name_conflict(SCM_CHARS (data), "", SCM_EOL, env1, sym);
+
+  return 0;
+}
+
+static SCM
+interface_environment_get_vcell(env, sym, for_write, name)
+     SCM env;
+     SCM sym;
+     int for_write;
+     char *name;
+{
+  struct interface_environment *interface_environment = SCM_INTERFACE_ENVIRONMENT_STRUCT(env);
+  scm_sizet scm_hash = SCM_HASHCODE (sym);
+  SCM obarray = interface_environment->leaf.environment.obarray;
+  SCM vcell = scm_symbol_get_handle (obarray, sym, scm_hash);
+
+  if (SCM_IMP (vcell))
+    {
+      /* Special case: aquisition.  Assume that all symbols are
+         visible */
+
+      if (interface_environment->aquisition)
+	{
+	  SCM cell = SCM_ENVIRONMENT_CELL (SCM_CAAR (interface_environment->interface), sym, for_write);
+
+	  if (SCM_NIMP (cell)) 
+	    {
+				/* copy to cache */
+	      vcell = scm_symbol_create_handle(obarray, sym, scm_hash, cell);
+	    }
+	}
+    }
+  else				/* found in cache */
+    {
+      if (for_write && SCM_IMMUTABLE_LOCATIONP (SCM_CELL_TAG (SCM_CDR(vcell))))
+	{
+	  scm_error_environment_immutable_location(name, "", SCM_EOL, env, sym);
+	}
+    }
+  
+  return vcell;
+}
+
+static SCM interface_environment_fix_interface(SCM env, struct interface_environment *interface_environment, SCM imports, char *name);
+
+static SCM 
+scm_interface_environment_ref_fixed (env, sym)
+     SCM env;
+     SCM sym;
+{
+  SCM vcell = interface_environment_get_vcell(env, sym, 0, s_environment_ref);
+
+  if (SCM_NIMP (vcell))
+    {				
+      return SCM_CDR (SCM_CELL_VAL (SCM_CDR (vcell)));
+    }
+
+  return SCM_UNDEFINED;
+}
+
+static SCM 
+scm_interface_environment_ref(env, sym)
+     SCM env;
+     SCM sym;
+{
+  struct interface_environment *interface = SCM_INTERFACE_ENVIRONMENT_STRUCT(env);
+  interface_environment_fix_interface(env, interface, interface->interface, s_environment_ref);
+
+  return scm_interface_environment_ref_fixed(env, sym);
+}
+
+static void 
+no_interface_error(env, imported_environment, name)
+     SCM env;
+     SCM imported_environment;
+     char *name;
+{
+  scm_misc_error(name, "The export environment `%s' for `%s' doesn't have a signature.", 
+		 scm_listify(env, imported_environment,SCM_UNDEFINED));
+}
+
+/* 
+ * iterate over all symbols mentioned in our interface 
+ */
+static SCM 
+scm_interface_environment_fold_fixed (env, proc, data, init)
+     SCM env;
+     scm_environment_folder proc;
+     SCM data;
+     SCM init;
+{
+  SCM ret_val;
+
+  struct interface_environment *interface_environment = SCM_INTERFACE_ENVIRONMENT_STRUCT(env);
+
+  if (interface_environment->aquisition)
+    {				
+      no_interface_error(env, interface_environment->interface, s_environment_fold);
+    }
+  else
+    {
+      ret_val = scm_leaf_environment_fold (env, proc, data, init);
+    }
+
+  return ret_val;
+}
+static SCM 
+scm_interface_environment_fold(env, proc, data, init)
+     SCM env;
+     scm_environment_folder proc;
+     SCM data;
+     SCM init;
+{
+  struct interface_environment *interface = SCM_INTERFACE_ENVIRONMENT_STRUCT(env);
+  interface_environment_fix_interface(env, interface, interface->interface, s_environment_fold);
+
+  return scm_interface_environment_fold_fixed(env, proc, data, init);
+}
+
+static SCM
+scm_interface_environment_define_fixed(env, sym, val)
+     SCM env;
+     SCM sym;
+     SCM val;
+{
+  scm_error_environment_immutable_bindings(s_environment_define, "", SCM_EOL, env, sym);
+  return 0;
+}
+
+static void
+scm_interface_environment_undefine_fixed(env, sym)
+     SCM env;
+     SCM sym;
+{
+  scm_error_environment_immutable_bindings(s_environment_undefine, "", SCM_EOL, env, sym);
+}
+
+static void
+scm_interface_environment_set_x_fixed (env, sym, val)
+     SCM env;
+     SCM sym;
+     SCM val;
+{
+  SCM vcell;
+
+  vcell = interface_environment_get_vcell(env, sym, 1, s_environment_set_x);
+
+  if (SCM_NIMP (vcell))
+    {
+      vcell = SCM_CELL_VAL (SCM_CDR (vcell));
+      SCM_SETCDR(vcell, val);
+    }
+  else
+    {
+      scm_error_environment_unbound(s_environment_set_x, "", SCM_EOL, env, sym);
+    }
+}
+static void 
+scm_interface_environment_set_x(env, sym, val)
+     SCM env;
+     SCM sym;
+     SCM val;
+{
+  struct interface_environment *interface = SCM_INTERFACE_ENVIRONMENT_STRUCT(env);
+  interface_environment_fix_interface(env, interface, interface->interface, s_environment_set_x);
+
+  scm_interface_environment_set_x_fixed(env, sym, val);
+}
+
+static SCM
+scm_interface_environment_cell_fixed(env, sym, for_write)
+     SCM env;
+     SCM sym;
+     int for_write;
+{
+  SCM vcell = interface_environment_get_vcell(env, sym, for_write, s_environment_cell);
+
+  if (SCM_NIMP (vcell))
+    {
+      return SCM_CDR (vcell); /* (vcell . (list-of-tags)) */
+    }
+
+  return SCM_BOOL_F;  
+}
+static SCM 
+scm_interface_environment_cell(env, sym, for_write)
+     SCM env;
+     SCM sym;
+     int for_write;
+{
+  struct interface_environment *interface = SCM_INTERFACE_ENVIRONMENT_STRUCT(env);
+  interface_environment_fix_interface(env, interface, interface->interface, s_environment_cell);
+
+  return scm_interface_environment_cell_fixed(env, sym, for_write);
+}
+
+/*
+ * Do not respond to update requests until the environment
+ * is fixed.
+ */
+static void
+scm_interface_environment_update (env, caller, sym, old_cell, new_cell, name)
+     SCM env;
+     SCM caller;
+     SCM old_cell;
+     SCM new_cell;
+     char *name;
+{
+  abort();
+}
+
+/*
+ * Update the value of old_cell to the value of new_cell.
+ * - Do not update a value that has not been cached
+ * - old_cell == #f (remove all cells): re-build cache
+ * - new_cell == #f (remove cell): throw immutable-binding error
+ * - do not copy location tags (the location tag always stays the same)
+ * - throw an error on a request to change the location tag from
+ *   mutable-location to immutable-location.
+ * - Always extract the interface and the exported name from the sig
+ */
+static void
+update_cell(env, sig, sym, obarray, old_cell, new_cell, name)
+     SCM env;
+     SCM sig;
+     SCM sym;
+     SCM old_cell;
+     SCM new_cell;
+     char *name;
+{
+  SCM vcell;
+  SCM tags = scm_assq(sym, SCM_CDR(sig));
+  short export_writeable;
+  scm_sizet scm_hash;
+  short new_cell_is_writeable;
+  
+  if(SCM_IMP(tags)) return;	/* nothing to update */
+
+  scm_hash = SCM_HASHCODE(sym);     
+  tags = SCM_CDR(tags);
+     
+  export_writeable = SCM_NIMP(scm_sloppy_memq (scm_sym_mutable_location, tags));
+  vcell = scm_symbol_get_handle (obarray, sym, scm_hash);
+
+				/* cache inconsistency? */
+  if (SCM_IMP(vcell)) abort();
+
+				/* if we receive $n$ requests through
+				   different paths it may happen that
+				   the cell is already updated */
+  if  (SCM_CELL_VAL (SCM_CDR (vcell)) == SCM_CELL_VAL (new_cell)) return;
+
+				/* cache inconsistency? */
+  if (SCM_CELL_VAL (SCM_CDR (vcell)) != SCM_CELL_VAL (old_cell)) abort();
+
+  old_cell = SCM_CDR(vcell);
+  
+  new_cell_is_writeable = SCM_MUTABLE_LOCATIONP (SCM_CELL_TAG (new_cell));
+  if (new_cell_is_writeable != export_writeable)
+    {
+      if (export_writeable)
+	{
+	  /* the user decided to export a mutable location but
+	     we received an immutable location.  Throw an error. */
+		  
+	  scm_error_environment_immutable_bindings(name, "", SCM_EOL, env, sym);
+	}
+      else
+	{
+				/* reset to old tag by constructing a new cell */
+	  new_cell = scm_cons (SCM_CAR (new_cell), export_writeable ? scm_sym_mutable_location : scm_sym_immutable_location);
+	}
+    }
+  SCM_SETCDR (vcell, new_cell);
+}
+static void
+update_all_cells(interface, obarray, name)
+  SCM interface;
+ {
+   SCM l;
+   SCM s;
+		 
+   for(l = interface; SCM_NIMP(l); l = SCM_CDR(l))
+     {
+       SCM spec = SCM_CAR(l);
+       SCM env = SCM_CAR(spec);
+       SCM sig = SCM_CDR(spec);
+       
+       for(s = sig; SCM_NIMP(s); s = SCM_CDR(s))
+	 {
+	   short new_cell_is_writeable;
+	   SCM sym = SCM_CAAR(s);
+	   SCM tags = SCM_CDAR(s);
+	   scm_sizet scm_hash;
+	   short export_writeable = SCM_NIMP(scm_sloppy_memq (scm_sym_mutable_location,tags));
+	   SCM alias;
+	   SCM new_cell;
+	  
+	   alias = scm_sloppy_assq (scm_sym_alias, tags);
+	   if(SCM_NIMP(alias))
+	     {
+	       alias = SCM_CADR(alias);
+	     }
+	   else
+	     {
+	       alias = sym;
+	     }
+
+	   new_cell = SCM_ENVIRONMENT_CELL(env, sym, 0);
+	   if (SCM_IMP(new_cell))
+	     {
+	       scm_error_environment_unbound(name, "", SCM_EOL, env, sym);
+	     }
+
+	   new_cell_is_writeable = SCM_MUTABLE_LOCATIONP (SCM_CELL_TAG (new_cell));
+	   if (new_cell_is_writeable != export_writeable)
+	     {
+	       if (export_writeable)
+		 {
+		   /* the user decided to export a mutable location but
+		      we received an immutable location.  Throw an error. */
+			  
+		   scm_error_environment_immutable_bindings(name, "", SCM_EOL, env, sym);
+		 }
+		      
+				/* reset to old tag by constructing a new cell */
+	       new_cell = scm_cons (SCM_CAR (new_cell), export_writeable ? scm_sym_mutable_location : scm_sym_immutable_location);
+	     }
+				/* copy to cache */
+	   scm_hash = SCM_HASHCODE (alias);
+	   scm_symbol_create_handle (obarray, alias, scm_hash, new_cell);
+	 }
+     }
+ }
+static void
+scm_interface_environment_update_fixed (env, caller, sym, old_cell, new_cell, name)
+     SCM env;
+     SCM caller;
+     SCM old_cell;
+     SCM new_cell;
+     char *name;
+{
+  struct interface_environment *interface_environment = SCM_INTERFACE_ENVIRONMENT_STRUCT(env);
+  SCM obarray;
+
+  obarray = interface_environment->leaf.environment.obarray;
+
+  if(interface_environment->aquisition)
+    {
+      scm_symbol_remove_all_handles(obarray, scm_symhash_dim);
+    }
+  else
+    {
+      if (SCM_NIMP (old_cell)) 
+	{
+	  SCM sig;
+
+	  if (SCM_IMP(new_cell))
+	    {
+	      scm_error_environment_immutable_bindings(name, "", SCM_EOL, env, sym);
+	    }
+
+	  sig = scm_assq(caller, interface_environment->interface);
+	  if (SCM_IMP (sig)) 
+	    {
+	      abort();
+	    }
+	  update_cell(env, sig, sym, obarray, old_cell, new_cell, name);
+	}
+      else
+	{
+	  scm_symbol_remove_all_handles(obarray, scm_symhash_dim);
+	  update_all_cells(interface_environment->interface, obarray, name);
+	}
+    }
+				/* environments should update their
+                                   caches */
+  scm_environment_broadcast (env, sym, old_cell, new_cell, name);
+}
+
+static SCM
+mark_interface_environment (env)
+     SCM env;
+{
+  struct interface_environment *interface_environment = SCM_INTERFACE_ENVIRONMENT_STRUCT(env);
+
+  if(SCM_NIMP(interface_environment->leaf.synapse))
+    {
+      mark_all_observer_smobs(SCM_VELTS(interface_environment->leaf.synapse)[1]);
+      scm_gc_mark(interface_environment->leaf.synapse);
+    }
+
+  scm_gc_mark (interface_environment->interface);
+  scm_gc_mark (interface_environment->conflict_proc);
+
+  return  SCM_BOOL_F;
+}
+
+static scm_sizet
+free_interface_environment (env)
+     SCM env;
+{
+  struct interface_environment *interface_environment = SCM_INTERFACE_ENVIRONMENT_STRUCT(env);
+
+  scm_sizet size;
+  
+  size = sizeof (struct interface_environment);
+
+  free (interface_environment);
+
+  return size;
+}
+
+static int
+print_interface_environment (SCM type, SCM port, scm_print_state *pstate)
+{
+  scm_puts ("#<incomplete interface environment ", port);
+  scm_puts (SCM_CHARS(scm_number_to_string(scm_ulong2num((unsigned long)type), SCM_MAKINUM (16))), port);
+  scm_puts (">", port);
+
+  return 1;
+}
+static int
+print_interface_environment_fixed (SCM type, SCM port, scm_print_state *pstate)
+{
+  scm_puts ("#<interface environment ", port);
+  scm_puts (SCM_CHARS(scm_number_to_string(scm_ulong2num((unsigned long)type), SCM_MAKINUM (16))), port);
+  scm_puts (">", port);
+
+  return 1;
+}
+
+static struct environment_funcs interface_environment_funcs_fixed = {
+    scm_interface_environment_ref_fixed,
+    scm_interface_environment_fold_fixed,
+    scm_interface_environment_define_fixed, /* throw error */
+    scm_interface_environment_undefine_fixed, /* throw error */
+    scm_interface_environment_set_x_fixed,
+    scm_interface_environment_cell_fixed,
+    scm_environment_observe_internal,
+    scm_environment_unobserve_internal,
+    mark_interface_environment,		
+    free_interface_environment,		
+    print_interface_environment_fixed		
+};
+void *scm_type_interface_environment_fixed = &interface_environment_funcs_fixed;
+static struct environment_funcs interface_environment_funcs = {
+  scm_interface_environment_ref, /* fix it */
+  scm_interface_environment_fold, /* fix it */
+  scm_interface_environment_define_fixed, /* throw error */
+  scm_interface_environment_undefine_fixed, /* throw error */
+  scm_interface_environment_set_x, /* fix it */
+  scm_interface_environment_cell, /* fix it */
+  scm_environment_observe_internal,
+  scm_environment_unobserve_internal,
+  mark_interface_environment,		
+  free_interface_environment,		
+  print_interface_environment		
+};
+void *scm_type_interface_environment = &interface_environment_funcs;
+
+/*
+ * parse something like this: (sym (alias a) mutable-location)
+ */
+static 
+SCM syntax_parse_location_tags(tags_list, name, sym_ret, tags_ret)
+     SCM tags_list;
+     char *name;
+     SCM *sym_ret;
+     SCM *tags_ret;
+{
+  SCM alias_sym;
+  SCM tags = tags_list;
+
+  SCM_ASSERT(SCM_NIMP(tags), tags_list, SCM_ARG2, name);
+	  
+  if (SCM_SYMBOLP(tags))
+    {
+      alias_sym = *sym_ret = tags_list;
+      *tags_ret = SCM_EOL;
+
+      return alias_sym;
+    }
+  else
+    {
+      SCM_ASSERT(SCM_CONSP(tags), tags_list, SCM_ARG2, name);
+
+      alias_sym = *sym_ret = SCM_CAR(tags);
+      SCM_ASSERT(SCM_NIMP(alias_sym) && SCM_SYMBOLP(alias_sym), tags_list, SCM_ARG2, name);
+
+      *tags_ret = tags = SCM_CDR (tags);
+    }
+
+  for(; SCM_NIMP(tags); tags = SCM_CDR(tags))
+    {
+      SCM tag = SCM_CAR(tags);
+      if(SCM_NIMP(tag) && SCM_SYMBOLP(tag)) 
+	{
+	  SCM_ASSERT((scm_sym_immutable_location == tag) 
+		     || (scm_sym_mutable_location == tag) 
+		     || (scm_sym_syntax == tag), tags_list, SCM_ARG2, name);
+	}
+      else
+	{
+	  SCM sym_alias;	/* the name "alias" */
+
+	  SCM_ASSERT(SCM_NIMP(tag) && 
+		     SCM_CONSP(tag) && 
+		     SCM_NNULLP(SCM_CDR(tag)) &&
+		     SCM_NULLP(SCM_CDDR(tag)), tags_list, SCM_ARG2, name);
+
+	  sym_alias = SCM_CAR(tag);
+	  SCM_ASSERT(scm_sym_alias == sym_alias, tags_list, SCM_ARG2, name);
+	  
+	  alias_sym = SCM_CADR(tag);
+	  SCM_ASSERT(SCM_NIMP(alias_sym) && SCM_SYMBOLP(alias_sym), tags_list, SCM_ARG2, name);
+	}
+    }
+
+  return alias_sym;
+}	  
+
+/* 
+ * Copy all symbols and their values from parent.
+ */
+static SCM
+copy_from_parent(env, obarray, imported_obarray, imported_environment, conflict_proc, name)
+     SCM env;
+     SCM obarray;
+     SCM imported_environment;
+     scm_environment_conflict_proc conflict_proc;
+     char *name;
+{
+  scm_sizet i;
+  SCM signature_ret = SCM_EOL;
+
+				/* Can't use environment-fold because
+                                   we need the cell */
+  for (i=0; i<scm_symhash_dim; i++) 
+    {
+      SCM lsym;
+      
+      for (lsym = SCM_VELTS (imported_obarray)[i]; SCM_NIMP (lsym); 
+	   lsym = SCM_CDR (lsym))
+	{
+	  SCM old_vcell;
+	  SCM vcell = SCM_CAR (lsym);
+	  SCM cell = SCM_CDR (vcell);
+	  SCM sym = SCM_CAR(vcell);
+	  SCM scm_hash = SCM_HASHCODE(sym);
+
+	  signature_ret = scm_cons(SCM_LIST1(sym), signature_ret);
+
+				/* check for name clashes */
+	  old_vcell = scm_symbol_get_handle (obarray, sym, scm_hash);
+	  if (SCM_NIMP(old_vcell))
+	    {
+	      SCM old_cell = SCM_CDR(old_vcell);
+	      if (SCM_CELL_VAL (old_cell) != SCM_CELL_VAL (cell))
+		{
+		  (*conflict_proc) (scm_makfrom0str (name), sym, imported_environment, imported_environment);
+
+		}
+	      if(SCM_CELL_TAG(old_cell) != SCM_CELL_TAG(cell))
+		{
+		  scm_error_environment_conflicting_tags(name, "", SCM_EOL, env, sym);
+		}
+	    }
+	  else 
+	    {
+				/* copy to cache */
+	      scm_symbol_create_handle (obarray, sym, scm_hash, cell);
+	    }
+	}
+    }
+
+  return signature_ret;
+}
+  
+/*
+ * parse the interface `imports' into obarray and return the
+ * parsed interface.  
+ */
+static SCM
+interface_environment_parse_interface_internal (env, imports, obarray, conflict_proc, name)
+     SCM env;
+     SCM imports;
+     SCM obarray;
+     scm_environment_conflict_proc conflict_proc;
+     char *name;
+{
+  SCM signature_ret;
+  SCM interface_ret;
+  SCM sig;
+  SCM cell;
+  SCM imported_cell;
+  SCM import_list;
+  SCM old_vcell;
+
+  interface_ret = SCM_EOL;
+				/* traverse import list */
+  for (import_list = imports; SCM_NIMP (import_list); import_list = SCM_CDR (import_list))
+    {
+      scm_sizet scm_hash;
+      SCM imported_interface_env;
+      SCM spec;
+      SCM signature;
+
+		
+      spec = SCM_CAR(import_list); /* (env ...) or (env . #f) */
+
+      imported_interface_env = SCM_CAR(spec);
+      SCM_ASSERT(SCM_NIMP(imported_interface_env) && SCM_ENVIRONMENTP(imported_interface_env), 
+		 imported_interface_env, SCM_ARG2, name);
+
+      /* 
+       * get the signature 
+       */
+      signature = SCM_CDR(spec);/* (sym ...) or #f */
+
+      if(SCM_BOOL_F == signature)
+	{		
+	  SCM signature_ret;
+	  if(SCM_INTERFACE_ENVIRONMENTP(imported_interface_env) ||
+	     (SCM_ENVIRONMENT_FUNCS(imported_interface_env) == scm_type_export_environment) ||
+	     (SCM_ENVIRONMENT_FUNCS(imported_interface_env) == scm_type_import_environment))
+	    {
+				/* delegate to parent */
+	      struct interface_environment *interface_environment = 
+		SCM_INTERFACE_ENVIRONMENT_STRUCT(imported_interface_env);
+	      
+				/* if it not fixed, fix it now! */
+	      if(SCM_ENVIRONMENT_FUNCS(imported_interface_env) == scm_type_interface_environment)
+		{
+		  interface_environment_fix_interface(imported_interface_env,
+						      interface_environment, 
+						      interface_environment->interface, 
+						      name);
+		}
+
+	      if(interface_environment->aquisition)
+		{
+		  no_interface_error(env, imported_interface_env, name);
+		}
+
+	      signature_ret = copy_from_parent(env,
+					       obarray,
+					       interface_environment->leaf.environment.obarray, 
+					       imported_interface_env, 
+					       conflict_proc, name);
+	      
+	      interface_ret = scm_cons(scm_cons(imported_interface_env, signature_ret), interface_ret);
+	      continue;
+	    }
+	  else
+	    {		
+				/* no signature: throw error */
+	      no_interface_error(env, imported_interface_env, name);
+	    }
+	}
+      else 
+	{			/* signature must be a list */
+	  SCM_ASSERT((SCM_NIMP(signature) && SCM_CONSP(signature)) || SCM_NULLP(signature), signature, SCM_ARG2, name);
+	}
+
+      /*
+       * parse it
+       */
+      signature_ret = SCM_EOL;
+      for(sig = signature; SCM_NIMP(sig); sig = SCM_CDR(sig))
+	{
+	  SCM alias;
+	  SCM sym;
+	  SCM tags;
+
+	  alias = syntax_parse_location_tags(SCM_CAR(sig), name, &sym, &tags);
+	  signature_ret = scm_cons(scm_cons(sym, tags), signature_ret);
+
+				/* find cell in environment */
+	  cell = imported_cell = SCM_ENVIRONMENT_CELL(imported_interface_env, sym, 0);
+      
+	  if (SCM_NIMP (cell))
+	    {			
+	      SCM old_tag;
+	      int export_writeable;
+
+				/* check the location tag */
+	      old_tag = SCM_CELL_TAG (cell);
+	      export_writeable = SCM_NIMP(scm_sloppy_memq (scm_sym_mutable_location, tags));
+
+	      if (export_writeable)
+		{
+				/* check if only one tag has been specified */
+		  if (SCM_NIMP(scm_sloppy_memq (scm_sym_immutable_location, tags)))
+		    {
+		      scm_error_environment_conflicting_tags(name, "", SCM_EOL, env, sym);
+		    }
+	      
+				/* throw error if old tag was immutable */
+		  if (old_tag == scm_sym_immutable_location)
+		    {
+		      scm_error_environment_immutable_location(name, "", SCM_EOL, env, sym);
+		    }
+		}
+	      else
+		{
+				/* set immutable tag by constructing a new cell */
+		  if (old_tag != scm_sym_immutable_location) /* SCM_EOL means: writable! */
+		    {
+		      cell = scm_cons (SCM_CAR (cell), scm_sym_immutable_location);
+
+		    }
+		}
+	    }
+	  else
+	    {
+	      scm_error_environment_unbound(name, "", SCM_EOL, imported_interface_env, sym);
+	    }
+
+	  /*
+	   * copy to cache
+	   */
+	  scm_hash = SCM_HASHCODE (alias);
+
+				/* check for name clashes */
+	  old_vcell = scm_symbol_get_handle (obarray, alias, scm_hash);
+	  if (SCM_NIMP(old_vcell))
+	    {
+	      SCM old_cell = SCM_CDR(old_vcell);
+	      if (SCM_CELL_VAL (old_cell) != SCM_CELL_VAL (cell))
+		{
+		  (*conflict_proc) (scm_makfrom0str (name), alias, imported_interface_env, imported_interface_env);
+
+		}
+	      if(SCM_CELL_TAG(old_cell) != SCM_CELL_TAG(cell))
+		{
+		  scm_error_environment_conflicting_tags(name, "", SCM_EOL, env, alias);
+		}
+	    }
+	  else 
+	    {
+				/* copy to cache */
+	      scm_symbol_create_handle (obarray, alias, scm_hash, cell);
+	    }
+	}
+      interface_ret = scm_cons(scm_cons(imported_interface_env, signature_ret), interface_ret);
+    }
+  return interface_ret;
+}
+
+/*
+ * same as parse_interface but also handles aquisition
+ */
+static SCM
+interface_environment_parse_interface (env, interface_environment, imports, obarray, name)
+     SCM env;
+     struct interface_environment *interface_environment;
+     SCM imports;
+     SCM obarray;
+     char *name;
+{
+  SCM parsed_interface;
+
+  if(!interface_environment->aquisition)
+    {
+      if (interface_environment->aquisition == -1) abort(); /* Unknown!?! */
+
+       parsed_interface = 
+	 interface_environment_parse_interface_internal(env, 
+							imports, 
+							obarray,
+							interface_environment->c_conflict_proc, 
+							name);
+    }
+  else
+    {
+				/* nothing to parse */
+      parsed_interface = imports;
+    }
+
+  return parsed_interface;
+}
+
+/*
+ * fixit_args, fixit, fixit_rewind, fixit_failed,
+ * interface_environment_fix_interface, scm_interface_environment_ref,
+ * scm_interface_environment_fold, scm_interface_environment_set_x,
+ * scm_interface_environment_cell: Initially lookup bindings, resolve
+ * name clashes and make sure that during interface-env's lifetime these
+ * functions will never be called again.
+ *
+ */
+
+
+static short update_running = 0;	/* sanity check */
+struct fixit_args 
+{
+  SCM env; 
+  struct interface_environment *interface_environment;
+  SCM interface;
+  SCM old_interface;
+  struct environment_funcs *old_environment_funcs;
+  char *name;
+};
+
+/*
+ * Observe all environments mentioned in interface
+ */
+static void
+interface_environment_observe_interface(env, interface, name)
+     SCM env;
+     SCM interface;
+     char *name;
+{
+  SCM node;
+				/* connect to all imported_env.  Will be
+				   dropped when env disappears. */
+  for (node = interface; SCM_NIMP (node); node = SCM_CDR (node))
+    {
+      SCM spec;
+      SCM imported_environment; 
+
+      				/* (env ...) or (env . #f) */
+      spec = SCM_CAR(node);
+      SCM_ASSERT(SCM_NIMP(spec) && SCM_CONSP(spec), spec, SCM_ARG2, name);
+
+      imported_environment = SCM_CAR(spec);
+      SCM_ASSERT(SCM_NIMP(imported_environment) && SCM_ENVIRONMENTP(imported_environment), imported_environment, SCM_ARG2, name);
+
+
+      SCM_ENVIRONMENT_OBSERVE (imported_environment,
+			       environment_update_dummy_observer,
+			       env, 1);
+    }
+}
+
+/*
+ * Drop env's old observers from interface_environment's observer list
+ * */
+static void
+interface_environment_drop_old_observers(env, interface_environment)
+     SCM env;
+     struct interface_environment *interface_environment;
+{
+  SCM node;
+       
+				/* remove my old observers */
+  for (node = interface_environment->interface; SCM_NIMP(node); node = SCM_CDR(node)) 
+    {
+				/* tell environment to remove me from
+                                   its list */
+      scm_drop_internal_observer(SCM_CAAR(node), env);
+    }
+  
+}     
+
+/* 
+ * check for aquisition
+ */
+static short
+aquisition(interface, name)
+     SCM interface;
+     char *name;
+{
+  SCM l;
+  long length = scm_ilength(interface);
+  SCM_ASSERT(length >=0, interface, SCM_ARG1, name);
+
+  for (l = interface; SCM_NIMP(l); l = SCM_CDR(l))
+    {
+      SCM spec;
+      SCM environment;
+      
+      spec = SCM_CAR(l);
+      SCM_ASSERT(SCM_NIMP(spec) && SCM_CONSP(spec), interface, SCM_ARG1, name);
+      
+      environment = SCM_CAR(spec);
+      SCM_ASSERT(SCM_NIMP(environment) && SCM_ENVIRONMENTP(environment), interface, SCM_ARG1, name);
+
+      if(SCM_BOOL_T == SCM_CDR(spec)) 
+	{
+	  SCM_ASSERT(length = 1, interface, SCM_ARG1, name);
+
+	  return 1;
+	}
+    }
+  return 0;
+}
+
+/*
+ * try
+ */
+static SCM
+fixit(void *p)
+{
+  SCM parsed_interface;
+  struct fixit_args *u = (struct fixit_args*)p;
+
+  if(u->interface_environment->empty != 1) abort();
+
+  update_running++;
+
+  u->interface_environment->aquisition = aquisition(u->interface, u->name);
+  parsed_interface = interface_environment_parse_interface(u->env, 
+							   u->interface_environment,
+							   u->interface, 
+							   u->interface_environment->leaf.environment.obarray,
+							   u->name);
+
+  u->interface_environment->interface = parsed_interface;
+  u->interface_environment->leaf.environment.environment_funcs = &interface_environment_funcs_fixed;
+  u->interface_environment->leaf.update = scm_interface_environment_update_fixed;
+
+  /* Because we've been an incomplete interface environment we don't
+     have listeners yet. So don't call environment-update() at this point! */
+     
+				/* now we're ready to receive update
+                                   requests */
+  interface_environment_observe_interface(u->env, u->interface, u->name);
+
+  update_running--;
+
+  return SCM_UNSPECIFIED;
+}
+
+/*
+ * re-construct old state after either parse_interface or
+ * scm_environment_broadcast failed 
+ */
+static SCM
+fixit_rewind(void *p)
+{
+  struct fixit_args *u = (struct fixit_args*)p;
+
+  scm_symbol_remove_all_handles(u->interface_environment->leaf.environment.obarray, scm_symhash_dim);
+
+  u->interface_environment->interface = u->old_interface;
+  u->interface_environment->aquisition = -1; /* Unknown */
+
+  u->interface_environment->leaf.environment.environment_funcs = u->old_environment_funcs;
+  u->interface_environment->leaf.update = scm_interface_environment_update;
+
+  update_running --;
+
+  return SCM_UNSPECIFIED;
+}
+
+/*
+ * back to old state or abort()
+ */
+static SCM
+fixit_failed(void *p, SCM tag, SCM args)
+{
+  scm_internal_catch(SCM_BOOL_T, fixit_rewind, p, (scm_catch_handler_t)abort, 0);
+  
+  scm_ithrow(tag, args, 1);
+
+  abort();
+
+  return 0;
+}
+
+/*
+ * interface_environment_fix_interface: fix env's interface, once and
+ * for all 
+ */
+static SCM
+interface_environment_fix_interface(env, interface_environment, imports, name)
+     SCM env;
+     struct interface_environment *interface_environment;
+     SCM imports;
+     char *name;
+{
+  struct fixit_args fixit_args;
+
+				/* abort if fixed */
+  if(interface_environment->leaf.environment.environment_funcs != scm_type_interface_environment)
+   {
+     abort();
+   }
+
+  fixit_args.env = env;
+  fixit_args.interface_environment = interface_environment;
+  fixit_args.interface = imports;
+  fixit_args.old_interface = interface_environment->interface;
+  fixit_args.old_environment_funcs = interface_environment->leaf.environment.environment_funcs;
+  fixit_args.name = name;
+
+  scm_internal_catch(SCM_BOOL_T, fixit, &fixit_args, fixit_failed, &fixit_args);
+
+  interface_environment->empty = 0;
+  return interface_environment->interface;
+}
+
+static SCM
+make_interface_environment(interface_environment, interface, name)
+     struct interface_environment *interface_environment;
+     SCM interface;
+     char *name;
+{
+  SCM interface_environment_smob;
+
+  interface_environment->leaf.environment.environment_funcs = scm_type_interface_environment;
+
+  interface_environment->aquisition = -1; /* Unknown */
+  interface_environment->interface = interface;
+
+  interface_environment->leaf.synapse = SCM_BOOL_F;
+  interface_environment->leaf.update = scm_interface_environment_update;
+
+  interface_environment_smob = scm_make_environment(interface_environment, scm_symhash_dim);
+
+  interface_environment->empty = 1;
+
+  interface_environment->leaf.synapse = scm_make_weak_vector(SCM_MAKINUM(2), SCM_EOL);
+  SCM_VELTS(interface_environment->leaf.synapse)[0] = interface_environment_smob;
+
+  return interface_environment_smob;
+}
+
+SCM_PROC(s_make_interface_environment, "make-interface-environment", 1, 0, 0, scm_make_interface_environment);
+SCM
+scm_make_interface_environment (interface)
+     SCM interface;
+{
+  SCM interface_environment_smob;
+  struct interface_environment *interface_environment;
+
+  SCM_ASSERT(SCM_NULLP(interface) || SCM_NIMP(interface), interface, SCM_ARG1, s_make_interface_environment);
+
+  interface_environment = 
+    scm_must_malloc (sizeof *interface_environment, s_make_interface_environment);
+
+  interface_environment->c_conflict_proc = scm_interface_environment_conflict_proc;
+  interface_environment->conflict_proc = SCM_EOL;
+  
+  interface_environment_smob = make_interface_environment (interface_environment, interface, s_make_interface_environment);
+
+  return interface_environment_smob;
+}
+
+SCM_PROC(s_interface_environment_p, "interface-environment?", 1, 0, 0, scm_interface_environment_p);
+SCM
+scm_interface_environment_p (env)
+     SCM env;
+{
+  return SCM_NIMP(env) && SCM_ENVIRONMENTP(env) && 
+    SCM_INTERFACE_ENVIRONMENTP(env) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+SCM_PROC(s_interface_environment_interface, "interface-environment-interface", 1, 0, 0, scm_interface_environment_interface);
+SCM
+scm_interface_environment_interface (env)
+     SCM env;
+{
+  struct interface_environment *interface_environment;
+  SCM computed_interface;
+
+  SCM_ASSERT(SCM_NIMP(env) && SCM_ENVIRONMENTP(env) && SCM_INTERFACE_ENVIRONMENTP(env), env, SCM_ARG1, s_interface_environment_interface);
+
+  interface_environment = SCM_INTERFACE_ENVIRONMENT_STRUCT(env);
+
+				/* if not fixed, fix it */
+  computed_interface = (interface_environment->leaf.environment.environment_funcs != scm_type_interface_environment) ?
+    interface_environment->interface : 
+    interface_environment_fix_interface(env, interface_environment,
+					interface_environment->interface, 
+					s_interface_environment_interface);
+  
+  return computed_interface;
+}
+
+/*
+ * update_args, update, update_rewind, update_failed,
+ * interface_environment_set_interface,
+ * scm_interface_environment_set_interface: Set a new interface for
+ * environment `env'. We must send an update broadcast to all
+ * observers if `env's interface has been fixed.  This code will
+ * call fix_interface through environment_update_internal's
+ * lookup method.
+ */
+SCM_PROC(s_interface_environment_set_interface_x, "interface-environment-set-interface!", 2, 0, 0, scm_interface_environment_set_interface_x);
+
+struct update_args 
+{
+  SCM env; 
+  SCM old_interface; 
+  SCM old_aquisition; 
+  SCM interface; 
+  SCM aquisition; 
+  struct interface_environment *interface_environment;
+};
+
+/*
+ * try
+ */
+static SCM
+update(void *p)
+{
+  SCM parsed_interface;
+  struct update_args *u = (struct update_args*)p;
+
+  u->interface_environment->aquisition = u->aquisition;
+
+				/* abort if incomplete */
+  if(u->interface_environment->leaf.environment.environment_funcs == scm_type_interface_environment) abort();
+
+  if(update_running != 0) abort();
+
+  update_running = 1;
+     
+  SWAP(u->interface_environment->leaf.environment.obarray, 
+       UPDATE_EMPTY_OBARRAY);
+				/* parse the signature */
+  parsed_interface = 
+    interface_environment_parse_interface(u->env, 
+					  u->interface_environment,
+					  u->interface, 
+					  u->interface_environment->leaf.environment.obarray,
+					  s_interface_environment_set_interface_x);
+
+				/* environments should update their
+                                   caches: "hey, look at my new cool
+                                   interface" */
+  u->interface_environment->interface = parsed_interface;
+  scm_environment_broadcast (u->env, SCM_BOOL_F, SCM_BOOL_F, SCM_BOOL_F, s_interface_environment_set_interface_x);
+
+  scm_symbol_remove_all_handles(UPDATE_EMPTY_OBARRAY, scm_symhash_dim);
+
+				/* now we're ready to receive update
+                                   requests for the new interface */
+  interface_environment_drop_old_observers(u->env, u->interface_environment);
+  interface_environment_observe_interface(u->env, u->interface, s_interface_environment_set_interface_x);
+
+  update_running --;
+
+
+  return SCM_UNSPECIFIED;
+}
+
+/*
+ * re-construct old state after either parse_interface or 
+ */
+static SCM
+update_rewind(void *p)
+{
+  struct update_args *u = (struct update_args*)p;
+
+  SWAP(u->interface_environment->leaf.environment.obarray, 
+       UPDATE_EMPTY_OBARRAY);
+
+  u->interface_environment->interface = u->old_interface;
+  u->interface_environment->aquisition = u->old_aquisition;
+
+  scm_symbol_remove_all_handles(UPDATE_EMPTY_OBARRAY, scm_symhash_dim);
+
+				/* back to the old observer list */
+  interface_environment_drop_old_observers(u->env, u->interface_environment);
+  interface_environment_observe_interface(u->env, u->old_interface, s_interface_environment_set_interface_x);
+
+				/* environments should update their
+                                   caches */
+  scm_environment_broadcast (u->env, SCM_BOOL_F, SCM_BOOL_F, SCM_BOOL_F, s_interface_environment_set_interface_x);
+
+  update_running --;
+
+  return SCM_UNSPECIFIED;
+}
+
+/*
+ * back to old state or abort()
+ */
+static SCM
+update_failed(void *p, SCM tag, SCM args)
+{
+  scm_internal_catch(SCM_BOOL_T, update_rewind, p, (scm_catch_handler_t)abort, 0);
+  
+  if(update_running != 0) abort();
+ 
+  scm_ithrow(tag, args, 1);
+
+  abort();
+
+  return 0;
+}
+
+/*
+ * Set a new interface for env/interface_environment
+ */
+static void
+interface_environment_set_interface(env, interface_environment, interface)
+     SCM env;
+     struct interface_environment *interface_environment;
+     SCM interface;
+{
+
+  if(interface_environment->leaf.environment.environment_funcs != scm_type_interface_environment)
+    {				/* fixed interface, either interface-, export- or import-environment */
+      struct update_args update_args;
+      
+      update_args.env = env;	
+      update_args.interface = interface;
+      update_args.aquisition = aquisition(interface);
+      update_args.interface_environment = interface_environment;
+      
+      update_args.old_interface = interface_environment->interface;
+      update_args.old_aquisition = interface_environment->aquisition;
+      
+      scm_internal_catch(SCM_BOOL_T, update, &update_args, update_failed, &update_args);
+    }
+  else
+    {
+      interface_environment->interface = interface;
+    }
+}
+
+SCM
+scm_interface_environment_set_interface_x (env, interface)
+     SCM env;
+     SCM interface;
+{
+  struct interface_environment *interface_environment;
+
+  SCM_ASSERT(SCM_NIMP(env) && SCM_ENVIRONMENTP(env) && SCM_INTERFACE_ENVIRONMENTP(env), env, SCM_ARG1, s_interface_environment_interface);
+  SCM_ASSERT((SCM_NIMP(interface) && SCM_CONSP(interface)) || SCM_NULLP(interface), interface, SCM_ARG2, s_interface_environment_set_interface_x);
+
+  interface_environment = SCM_INTERFACE_ENVIRONMENT_STRUCT(env);
+
+  interface_environment_set_interface(env, interface_environment, interface);
+  
+  return interface_environment->interface;
+}
+
+
+/* export environments */
+
+static int
+print_export_environment (SCM type, SCM port, scm_print_state *pstate)
+{
+  scm_puts ("#<export environment ", port);
+  scm_puts (SCM_CHARS(scm_number_to_string(scm_ulong2num((unsigned long)type), SCM_MAKINUM (16))), port);
+  scm_puts (">", port);
+
+  return 1;
+}
+
+static struct environment_funcs export_environment_funcs = {
+    scm_interface_environment_ref_fixed,
+    scm_interface_environment_fold_fixed,
+    scm_interface_environment_define_fixed,
+    scm_interface_environment_undefine_fixed,
+    scm_interface_environment_set_x_fixed,
+    scm_interface_environment_cell_fixed,
+    scm_environment_observe_internal,
+    scm_environment_unobserve_internal,
+    mark_interface_environment,		
+    free_interface_environment,		
+    print_export_environment		
+};
+void *scm_type_export_environment = &export_environment_funcs;
+
+SCM_PROC(s_make_export_environment, "make-export-environment", 2, 0, 0, scm_make_export_environment);
+SCM
+scm_make_export_environment (private, signature)
+     SCM private;
+     SCM signature;
+{
+  SCM interface_environment_smob;
+  struct interface_environment *interface_environment;
+
+  SCM_ASSERT(SCM_NIMP(private) && SCM_ENVIRONMENTP(private), private, SCM_ARG1, s_make_export_environment);
+  SCM_ASSERT(SCM_NIMP(signature) && (SCM_CONSP(signature) || SCM_NULLP(signature)), signature, SCM_ARG2, s_make_export_environment);
+
+  interface_environment = 
+    scm_must_malloc (sizeof *interface_environment, s_make_export_environment);
+
+  interface_environment->c_conflict_proc = scm_interface_environment_conflict_proc;
+  interface_environment->conflict_proc = SCM_EOL;
+
+  interface_environment_smob = 
+    make_interface_environment (interface_environment,
+				SCM_LIST1(scm_cons(private, signature)), 
+				s_make_export_environment);
+
+				/* now fix it */
+  interface_environment_fix_interface(interface_environment_smob, 
+				      interface_environment,
+				      interface_environment->interface,
+				      s_make_export_environment);
+
+  interface_environment->leaf.environment.environment_funcs = scm_type_export_environment;
+
+  return interface_environment_smob;
+}
+
+SCM_PROC(s_export_environment_private, "export-environment-private", 1, 0, 0, scm_export_environment_private);
+
+SCM
+scm_export_environment_private (env)
+     SCM env;
+{
+  struct interface_environment *interface_environment;
+  SCM_ASSERT(SCM_NIMP(env) && SCM_ENVIRONMENTP(env) && SCM_EXPORT_ENVIRONMENTP(env), env, SCM_ARG1, s_export_environment_private);
+  
+  interface_environment = SCM_INTERFACE_ENVIRONMENT_STRUCT(env);
+  
+  return SCM_CAAR(interface_environment->interface);
+}
+
+SCM_PROC(s_export_environment_set_private_x, "export-environment-set-private!", 2, 0, 0, scm_export_environment_set_private_x);
+
+SCM
+scm_export_environment_set_private_x (env, private)
+     SCM env;
+     SCM private;
+{
+  struct interface_environment *interface_environment;
+  SCM old_signature_list;
+
+  SCM_ASSERT(SCM_NIMP(env) && SCM_ENVIRONMENTP(env), env, SCM_ARG1, s_export_environment_set_private_x);
+  SCM_ASSERT(SCM_NIMP(private) && SCM_ENVIRONMENTP(private), private, SCM_ARG2, s_export_environment_set_private_x);
+
+  interface_environment = SCM_INTERFACE_ENVIRONMENT_STRUCT(env);
+  old_signature_list = SCM_CDR(interface_environment->interface);
+  
+  interface_environment_set_interface(env, scm_cons(private, old_signature_list), interface_environment);
+
+  return SCM_UNSPECIFIED;
+}
+
+SCM_PROC(s_export_environment_signature, "export-environment-signature", 1, 0, 0, scm_export_environment_signature);
+
+SCM
+scm_export_environment_signature (env)
+     SCM env;
+{
+
+  SCM_ASSERT(SCM_NIMP(env) && SCM_ENVIRONMENTP(env) && SCM_EXPORT_ENVIRONMENTP(env), env, SCM_ARG1, s_export_environment_signature);
+
+  return SCM_INTERFACE_ENVIRONMENT_INTERFACE(env);
+}
+
+SCM_PROC(s_export_environment_set_signature_x, "export-environment-set-signature!", 2, 0, 0, scm_export_environment_set_signature_x);
+
+SCM
+scm_export_environment_set_signature_x (env, interface)
+     SCM env;
+     SCM interface;
+{
+  struct interface_environment *interface_environment;
+  SCM old_private;
+
+  SCM_ASSERT(SCM_NIMP(env) && SCM_ENVIRONMENTP(env) && SCM_EXPORT_ENVIRONMENTP(env), env, SCM_ARG1, s_export_environment_set_signature_x);
+  SCM_ASSERT(SCM_NIMP(interface) && (SCM_CONSP(interface) || SCM_NULLP(interface)), interface, SCM_ARG2, s_export_environment_set_signature_x);
+  
+  interface_environment = SCM_INTERFACE_ENVIRONMENT_STRUCT(env);
+  old_private = SCM_CAAR(interface_environment->interface);
+
+  interface_environment_set_interface(env, scm_cons(scm_cons(old_private, interface), SCM_EOL), interface_environment);
+
+  return SCM_UNSPECIFIED;
+}
+
+SCM_PROC(s_export_environment_p, "export-environment?", 1, 0, 0, scm_export_environment_p);
+SCM
+scm_export_environment_p (env)
+     SCM env;
+{
+  return SCM_NIMP(env) && SCM_ENVIRONMENTP(env) && 
+    SCM_EXPORT_ENVIRONMENTP(env) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+
+
+/* import environments */ 
+
+static int
+print_import_environment (SCM type, SCM port, scm_print_state *pstate)
+{
+  scm_puts ("#<import environment ", port);
+  scm_puts (SCM_CHARS(scm_number_to_string(scm_ulong2num((unsigned long)type), SCM_MAKINUM (16))), port);
+  scm_puts (">", port);
+
+  return 1;
+}
+
+static struct environment_funcs import_environment_funcs = {
+    scm_interface_environment_ref_fixed,
+    scm_interface_environment_fold_fixed,
+    scm_interface_environment_define_fixed,  
+    scm_interface_environment_undefine_fixed,
+    scm_interface_environment_set_x_fixed,
+    scm_interface_environment_cell_fixed,
+    scm_environment_observe_internal,
+    scm_environment_unobserve_internal,
+    mark_interface_environment,
+    free_interface_environment,
+    print_import_environment
+};
+void *scm_type_import_environment = &import_environment_funcs;
+
+SCM_PROC(s_make_import_environment, "make-import-environment", 2, 0, 0, scm_make_import_environment);
+SCM
+scm_make_import_environment (imports, conflict_proc)
+     SCM imports;
+     SCM conflict_proc;
+{
+  SCM list;
+  SCM interface_imports;
+  SCM interface_environment_smob;
+  struct interface_environment *interface_environment;
+
+  SCM_ASSERT(SCM_NIMP(imports) && (SCM_CONSP(imports) || SCM_NULLP(imports)), imports, SCM_ARG2, s_make_import_environment);
+
+  interface_imports = SCM_EOL;
+  for (list = imports; SCM_NIMP(list); list = SCM_CDR(list)) 
+    {
+      SCM interface_env = SCM_CAR(list);
+      SCM_ASSERT(SCM_NIMP(interface_env) && SCM_ENVIRONMENTP(interface_env), interface_env, SCM_ARG1, s_make_import_environment);
+      interface_imports = scm_cons(scm_cons(interface_env, SCM_BOOL_F), interface_imports);
+    }
+
+  interface_environment = 
+    scm_must_malloc (sizeof *interface_environment, s_make_import_environment);
+
+  interface_environment->c_conflict_proc = gh_call3;
+  interface_environment->conflict_proc = conflict_proc;
+
+  interface_environment_smob = 
+    make_interface_environment (interface_environment,
+				interface_imports,
+				s_make_import_environment);
+
+				/* now fix it */
+  interface_environment_fix_interface(interface_environment_smob, 
+				      interface_environment,
+				      interface_imports,
+				      s_make_import_environment);
+
+  interface_environment->leaf.environment.environment_funcs = scm_type_import_environment;
+
+  return interface_environment_smob;
+}
+
+SCM_PROC(s_import_environment_p, "import-environment?", 1, 0, 0, scm_import_environment_p);
+SCM
+scm_import_environment_p (env)
+     SCM env;
+{
+  return SCM_NIMP(env) && SCM_ENVIRONMENTP(env) && 
+    SCM_IMPORT_ENVIRONMENTP(env) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+SCM_PROC(s_import_environment_imports, "import-environment-imports", 1, 0, 0, scm_import_environment_imports);
+SCM
+scm_import_environment_imports (env)
+     SCM env;
+{
+  SCM_ASSERT(SCM_NIMP(env) && SCM_ENVIRONMENTP(env) && SCM_IMPORT_ENVIRONMENTP(env), env, SCM_ARG1, s_import_environment_imports);
+
+  return SCM_INTERFACE_ENVIRONMENT_INTERFACE(env);
+}
+
+SCM_PROC(s_import_environment_set_imports_x, "import-environment-set-imports!", 2, 0, 0, scm_import_environment_set_imports_x);
+SCM
+scm_import_environment_set_imports_x (env, imports)
+     SCM env;
+     SCM imports;
+{
+  SCM list;
+  SCM interface_imports;
+  SCM_ASSERT(SCM_NIMP(env) && SCM_ENVIRONMENTP(env) && SCM_EXPORT_ENVIRONMENTP(env), env, SCM_ARG1, s_import_environment_set_imports_x);
+  SCM_ASSERT(SCM_NIMP(imports) && (SCM_CONSP(imports) || SCM_NULLP(imports)), imports, SCM_ARG2, s_import_environment_set_imports_x);
+
+
+  interface_imports = SCM_EOL;
+  for (list = imports; SCM_NIMP(list); list = SCM_CDR(list)) 
+    {
+      SCM interface_env = SCM_CAR(list);
+      SCM_ASSERT(SCM_NIMP(interface_env) && SCM_ENVIRONMENTP(interface_env), env, SCM_ARG1, s_make_import_environment);
+      interface_imports = scm_cons(scm_cons(interface_env, SCM_BOOL_F), interface_imports);
+    }
+
+  interface_environment_set_interface(env, SCM_INTERFACE_ENVIRONMENT_STRUCT(env), interface_imports);
+
+  return SCM_UNSPECIFIED;
+}
+
+
+
+/*
+ * intern a symbol in environment env
+ */
+SCM 
+scm_environment_intern (env, name, val)
+     SCM env;
+     char *name;
+     SCM val;
+{
+  SCM vcell;
+  SCM sym;
+
+
+  vcell = scm_intern (name);
+  sym = SCM_CAR(vcell);
+
+  return SCM_ENVIRONMENT_DEFINE(env, sym, val);
+}
+
+
+/* Miscellaneous */
+
+/* according to r5rs `load' evaluates expressions in the interaction
+   environment */
+SCM_PROC(s_set_interaction_environment_x, "set-interaction-environment!", 1, 0, 0, scm_set_interaction_environment_x);
+SCM
+scm_set_interaction_environment_x (env)
+     SCM env;
+{
+  SCM_ASSERT(SCM_NIMP(env) && SCM_ENVIRONMENTP(env) && SCM_EVAL_ENVIRONMENTP(env), env, SCM_ARG1, s_set_interaction_environment_x);
+
+  SCM_DEFER_INTS;
+  scm_interaction_environment = env;
+  SCM_ALLOW_INTS;
+
+  return SCM_UNSPECIFIED;
+}
+
+SCM_PROC(s_interaction_environment, "interaction-environment", 0, 0, 0, scm_interaction_environment_proc);
+SCM
+scm_interaction_environment_proc ()
+{
+  return scm_interaction_environment;
+}
+
+SCM_PROC(s_scheme_guile_environment, "scheme-guile-environment", 0, 1, 0, scm_scheme_guile_environment_proc);
+SCM
+scm_scheme_guile_environment_proc (version)
+     SCM version;
+{
+  SCM_ASSERT(SCM_INUMP(version), version, SCM_ARG1, s_scheme_guile_environment);
+  
+  return scm_scheme_guile_environment;
+}
+
+SCM_PROC(s_null_environment, "null-environment", 0, 1, 0, scm_null_environment_proc);
+SCM
+scm_null_environment_proc (version)
+     SCM version;
+{
+  SCM_ASSERT(SCM_INUMP(version), version, SCM_ARG1, s_null_environment);
+  
+  return scm_scheme_guile_environment;
+}
+
+SCM_PROC(s_guile_user_environment, "guile-user-environment", 0, 1, 0, scm_guile_user_environment_proc);
+SCM
+scm_guile_user_environment_proc (version)
+     SCM version;
+{
+  SCM_ASSERT(SCM_INUMP(version), version, SCM_ARG1, s_guile_user_environment);
+  
+  return scm_guile_user_environment;
+}
+
+SCM_PROC(s_module_registry, "module-registry", 0, 0, 0, scm_module_registry_proc);
+SCM
+scm_module_registry_proc ()
+{
+  return scm_module_registry;
+}
+
+SCM_PROC(s_c_module_registry, "c-module-registry", 0, 0, 0, scm_c_module_registry_proc);
+SCM
+scm_c_module_registry_proc ()
+{
+  return scm_c_module_registry;
+}
+
+SCM_PROC(s_environment_module_hash, "environment-module-hash", 0, 0, 0, scm_environment_module_hash_proc);
+SCM
+scm_environment_module_hash_proc ()
+{
+  return scm_environment_module_hash;
+}
+
+
+
+SCM_PROC(s_environment_set_symbol_property_x, "environment-set-symbol-property!", 4, 0, 0, scm_environment_set_symbol_property_x);
+SCM
+scm_environment_set_symbol_property_x(env, sym, prop, val)
+     SCM env;
+     SCM sym;
+     SCM prop;
+     SCM val;
+{
+  SCM list;
+  SCM pair;
+  SCM cell;
+
+  SCM_ASSERT(SCM_NIMP(env) && SCM_ENVIRONMENTP(env), env, SCM_ARG1, s_environment_set_symbol_property_x);
+  SCM_ASSERT(SCM_NIMP(sym) && SCM_SYMBOLP(sym), sym, SCM_ARG2, s_environment_set_symbol_property_x);
+  SCM_ASSERT(SCM_NIMP(prop) && SCM_SYMBOLP(prop), prop, SCM_ARG3, s_environment_set_symbol_property_x);
+
+
+  cell = SCM_ENVIRONMENT_CELL (env, sym, 0);
+
+  if(SCM_IMP(cell))
+    {
+      scm_error_environment_unbound (s_environment_set_symbol_property_x, "", SCM_EOL, env, sym);
+    }
+
+  list = SCM_CELL_PROPERTY_ALIST (cell);
+  pair = scm_sloppy_assq (prop, list);
+
+  if (SCM_NIMP (pair))
+    {
+      if (SCM_CONSP (pair))
+	{
+	  SCM_SETCDR (pair, val);
+	}
+    }
+  else
+    {
+      SCM_SETCDR (SCM_CAR (cell), scm_acons (prop, val, list));
+    }
+
+  return SCM_UNSPECIFIED;
+}
+  
+SCM_PROC(s_environment_symbol_property, "environment-symbol-property", 3, 0, 0, scm_environment_symbol_property); 
+SCM
+scm_environment_symbol_property(env, sym, prop)
+     SCM env;
+     SCM sym;
+     SCM prop;
+{
+  SCM list;
+  SCM pair;
+  SCM cell;
+
+  SCM_ASSERT(SCM_NIMP(env) && SCM_ENVIRONMENTP(env), env, SCM_ARG1, s_environment_symbol_property);
+  SCM_ASSERT(SCM_NIMP(sym) && SCM_SYMBOLP(sym), sym, SCM_ARG2, s_environment_symbol_property);
+  SCM_ASSERT(SCM_NIMP(prop) && SCM_SYMBOLP(prop), prop, SCM_ARG3, s_environment_symbol_property);
+
+  cell = SCM_ENVIRONMENT_CELL (env, sym, 0);
+
+  if(SCM_IMP(cell))
+    {
+      scm_error_environment_unbound (s_environment_symbol_property, "", SCM_EOL, env, sym);
+    }
+
+  list = SCM_CELL_PROPERTY_ALIST (cell);
+  pair = scm_sloppy_assq (prop, list);
+
+  return pair;
+}
+  
+SCM_PROC(s_environment_remove_symbol_property_x, "environment-remove-symbol-property!", 3, 0, 0, scm_environment_remove_symbol_property_x);
+SCM
+scm_environment_remove_symbol_property_x(env, sym, prop)
+     SCM env;
+     SCM sym;
+     SCM prop;
+{
+  SCM list;
+  SCM cell;
+
+  SCM_ASSERT(SCM_NIMP(env) && SCM_ENVIRONMENTP(env), env, SCM_ARG1, s_environment_remove_symbol_property_x);
+  SCM_ASSERT(SCM_NIMP(sym) && SCM_SYMBOLP(sym), sym, SCM_ARG2, s_environment_remove_symbol_property_x);
+  SCM_ASSERT(SCM_NIMP(prop) && SCM_SYMBOLP(prop), prop, SCM_ARG3, s_environment_remove_symbol_property_x);
+
+  cell = SCM_ENVIRONMENT_CELL (env, sym, 0);
+
+  if(SCM_IMP(cell))
+    {
+      scm_error_environment_unbound (s_environment_remove_symbol_property_x, "", SCM_EOL, env, sym);
+    }
+
+  list = SCM_CELL_PROPERTY_ALIST (cell);
+
+  SCM_SETCDR (SCM_CAR (cell), scm_assq_remove_x (list, prop));
+
+
+  return SCM_UNSPECIFIED;
+}
+
+void
+scm_environments_prehistory()
+{
+  /* create observer smob */
+  scm_tc16_observer = scm_newsmob(&observer_funs);
+
+  /* create default environment */
+  scm_tc16_environment = scm_newsmob (&environment_funs);
+  scm_interaction_environment = scm_scheme_guile_environment = 
+    scm_make_eval_environment (scm_make_leaf_environment(), scm_make_interface_environment(SCM_EOL));
+
+  scm_c_module_registry = scm_make_leaf_environment();
+
+  scm_module_registry = scm_make_leaf_environment();
+  scm_environment_module_hash = scm_make_doubly_weak_hash_table(SCM_MAKINUM (32));
+
+  /* create the user environment */
+  scm_guile_user_environment = 
+    scm_make_eval_environment (scm_make_leaf_environment(), 
+			       scm_make_interface_environment(SCM_LIST1 (scm_cons (scm_scheme_guile_environment, SCM_BOOL_T))));
+
+  /* create supporting data structures */
+  protect_vec = scm_make_vector(SCM_MAKINUM(1), SCM_UNDEFINED);
+  scm_permanent_object(protect_vec);
+
+  UPDATE_EMPTY_OBARRAY = scm_make_vector((SCM) SCM_MAKINUM (scm_symhash_dim), SCM_EOL);
+}
+  
+SCM
+scm_init_environments (env)
+     SCM env;
+{
+#include "environments.x"
+
+  return SCM_UNSPECIFIED;
+}
diff --git a/libguile/environments.h b/libguile/environments.h
new file mode 100644
index 000000000..125f6852a
--- /dev/null
+++ b/libguile/environments.h
@@ -0,0 +1,176 @@
+#ifndef ENVIRONMENTSH
+#define ENVIRONMENTSH
+
+#include "__scm.h"
+#include "tags.h"
+
+
+
+typedef void (*scm_environment_observer) (SCM env, SCM data);
+typedef SCM (*scm_environment_folder) (SCM data, SCM symbol, SCM value, SCM tail);
+typedef SCM (*scm_environment_conflict_proc) (SCM data, SCM sym, SCM env1, SCM env2);
+
+struct environment_funcs {
+  SCM  (*ref) (SCM self, SCM symbol);
+  SCM  (*fold) (SCM self, scm_environment_folder proc, SCM data, SCM init);
+  SCM  (*define) (SCM self, SCM symbol, SCM value);
+  void  (*undefine) (SCM self, SCM symbol);
+  void (*set) (SCM self, SCM symbol, SCM value);
+  SCM (*cell) (SCM self, SCM symbol, int for_write);
+  SCM (*observe) (SCM self, scm_environment_observer proc, SCM data, int weak_p);
+  void (*unobserve) (SCM dummy, SCM token);
+ 
+  SCM  (*mark) (SCM self);
+  scm_sizet (*free) (SCM self);
+  int  (*print) (SCM self, SCM port, scm_print_state *pstate);
+};
+
+struct environment {
+  struct environment_funcs *environment_funcs; /* class signature */
+  SCM obarray;
+};
+
+
+
+/* create the root environment */
+extern void scm_environments_prehistory (void);
+
+/* intern environment functions in env */
+extern SCM scm_init_environments (SCM env);
+
+
+/* generic environment functions */
+
+#define SCM_ENVIRONMENT_FUNCS(env) ( *((struct environment_funcs **) SCM_CDR (env)))
+#define SCM_ENVIRONMENT_OBARRAY(env)  (((struct environment*)(SCM_CDR(env)))->obarray)
+#define SCM_ENVIRONMENT_STRUCT(env) ((struct environment*) SCM_CDR (env))
+#define SCM_ENVIRONMENTP(x) ((SCM_CAR (x)) == scm_tc16_environment)
+#define SCM_TOP_LEVEL_ENVP(x) ((SCM_CONSP(x) && (SCM_EOL==SCM_CDR(x))))
+#define SCM_ENVIRONMENT_REF(env, symbol) ((*(SCM_ENVIRONMENT_FUNCS(env)->ref)) (env, symbol))
+#define SCM_ENVIRONMENT_FOLD(env, proc, data, init) ((*(SCM_ENVIRONMENT_FUNCS(env)->fold)) (env, proc, data, init))
+#define SCM_ENVIRONMENT_DEFINE(env, symbol, value) ((*(SCM_ENVIRONMENT_FUNCS(env)->define)) (env, symbol, value))
+#define SCM_ENVIRONMENT_UNDEFINE(env, symbol) ((*(SCM_ENVIRONMENT_FUNCS(env)->undefine)) (env, symbol))
+#define SCM_ENVIRONMENT_SET(env, symbol, value) ((*(SCM_ENVIRONMENT_FUNCS(env)->set)) (env, symbol, value))
+#define SCM_ENVIRONMENT_CELL(env, symbol, for_write) ((*(SCM_ENVIRONMENT_FUNCS(env)->cell)) (env, symbol, for_write))
+#define SCM_ENVIRONMENT_OBSERVE(env, proc, data, weak_p) ((*(SCM_ENVIRONMENT_FUNCS(env)->observe)) (env, proc, data, weak_p))
+#define SCM_ENVIRONMENT_UNOBSERVE(env, token) ((*(SCM_ENVIRONMENT_FUNCS(env)->unobserve)) (env, token))
+#define SCM_ENVIRONMENT_BOUND(env, symbol) (SCM_UNDEFINED==SCM_ENVIRONMENT_REF(env, symbol) ? SCM_BOOL_F : SCM_BOOL_T)
+
+extern long scm_tc16_environment;
+
+extern SCM scm_environment_observe_weak(SCM env, SCM proc);
+extern SCM scm_environment_unobserve (SCM token);
+extern SCM scm_c_environment_ref (SCM env, SCM sym);
+extern SCM scm_environment_ref (SCM env, SCM sym);
+extern SCM scm_c_environment_fold (SCM env, scm_environment_folder proc, SCM data, SCM init);
+extern SCM scm_environment_fold(SCM env, SCM proc, SCM init);
+extern SCM scm_environment_undefine(SCM env, SCM sym);
+extern SCM scm_environment_define(SCM env, SCM sym, SCM val);
+extern SCM scm_environment_set_x(SCM env, SCM sym, SCM val);
+extern SCM scm_c_environment_cell(SCM env, SCM sym, int for_write);
+extern SCM scm_environment_cell(SCM env, SCM sym, SCM for_write);
+extern SCM scm_environment_bound_p (SCM env, SCM sym);
+extern SCM scm_c_environment_observe (SCM env, scm_environment_observer proc, SCM data, int weak_p);
+extern SCM scm_environment_observe(SCM env, SCM proc);
+extern SCM scm_environment_p(SCM env);
+extern SCM scm_make_environment (void *handle, scm_sizet size);
+
+
+
+/* leaf environments */
+#define SCM_LEAF_ENVIRONMENTP(env) ((void*)SCM_ENVIRONMENT_FUNCS(env) == scm_type_leaf_environment)
+#define SCM_LEAF_ENVIRONMENT_STRUCT(env) ((struct leaf_environment*) SCM_CDR (env))
+
+extern void *scm_type_leaf_environment;
+extern SCM scm_make_leaf_environment (void);
+
+extern void *scm_type_immutable_environment;
+extern SCM scm_make_immutable_environment (void);
+
+
+
+/* eval environments */
+#define SCM_EVAL_ENVIRONMENTP(env) (SCM_ENVIRONMENT_FUNCS(env) == scm_type_eval_environment)
+#define SCM_EVAL_ENVIRONMENT_STRUCT(env) ((struct eval_environment*) SCM_CDR (env))
+#define SCM_EVAL_ENVIRONMENT_IMPORTED(eval_env) (SCM_EVAL_ENVIRONMENT_STRUCT(eval_env)->imported)
+#define SCM_EVAL_ENVIRONMENT_LOCAL(eval_env)  (SCM_EVAL_ENVIRONMENT_STRUCT(eval_env)->local)
+#define SCM_EVAL_ENVIRONMENT_MEMOIZED(eval_env) (SCM_EVAL_ENVIRONMENT_STRUCT(eval_env)->memoized)
+
+extern void *scm_type_eval_environment;
+
+extern void scm_eval_environment_memoize_cell_internal(SCM env, SCM expr, SCM val, SCM sym);
+extern SCM scm_make_eval_environment (SCM local, SCM imported);
+extern SCM scm_eval_environment_imported (SCM env);
+extern SCM scm_eval_environment_local(SCM env);
+extern SCM scm_eval_environment_set_imported_x (SCM env, SCM imported);
+extern SCM scm_eval_environment_p (SCM env);
+
+
+
+/* interface environments */
+#define SCM_INTERFACE_ENVIRONMENTP(env) ((SCM_ENVIRONMENT_FUNCS(env) == scm_type_interface_environment)||(SCM_ENVIRONMENT_FUNCS(env) == scm_type_interface_environment_fixed))
+#define SCM_INTERFACE_ENVIRONMENT_STRUCT(env) ((struct interface_environment*) SCM_CDR (env))
+#define SCM_INTERFACE_ENVIRONMENT_PRIVATE(interface_env) (SCM_INTERFACE_ENVIRONMENT_STRUCT(interface_env)->private)
+#define SCM_INTERFACE_ENVIRONMENT_INTERFACE(interface_env) (SCM_INTERFACE_ENVIRONMENT_STRUCT(interface_env)->interface)
+
+extern void *scm_type_interface_environment;
+
+extern SCM scm_make_interface_environment (SCM interface);
+extern SCM scm_interface_environment_interface(SCM env);
+extern SCM scm_interface_environment_set_interface_x(SCM env, SCM interface);
+extern SCM scm_interface_environment_p (SCM env);
+
+
+
+/* export environments */
+#define SCM_EXPORT_ENVIRONMENTP(env) (SCM_ENVIRONMENT_FUNCS(env) == scm_type_export_environment)
+#define SCM_EXPORT_ENVIRONMENT_STRUCT(env) ((struct interface_environment*) SCM_CDR (env))
+
+extern void *scm_type_export_environment;
+
+extern SCM scm_make_export_environment (SCM private, SCM signature);
+extern SCM scm_export_environment_signature(SCM env);
+extern SCM scm_export_environment_set_signature_x(SCM env, SCM signature);
+extern SCM scm_export_environment_set_private_x (SCM env, SCM private);
+extern SCM scm_export_environment_private (SCM env);
+extern SCM scm_export_environment_p (SCM env);
+
+
+
+/* import environments */
+#define SCM_IMPORT_ENVIRONMENTP(env) (SCM_ENVIRONMENT_FUNCS(env) == scm_type_import_environment)
+#define SCM_IMPORT_ENVIRONMENT_STRUCT(env) ((struct interface_environment*) SCM_CDR (env))
+#define SCM_IMPORT_ENVIRONMENT_CONFLICT_PROC(import_env) (SCM_IMPORT_ENVIRONMENT_STRUCT(import_env)->conflict_proc)
+
+extern void *scm_type_import_environment;
+
+extern SCM scm_make_import_environment (SCM imports, SCM conflict_proc);
+extern SCM scm_import_environment_imports (SCM env);
+extern SCM scm_import_environment_set_imports_x (SCM env, SCM imports);
+extern SCM scm_import_environment_p (SCM env);
+
+
+
+extern SCM scm_set_interaction_environment_x (SCM env);
+extern SCM scm_interaction_environment_proc (void);
+extern SCM scm_c_module_registry_proc (void);
+extern SCM scm_module_registry_proc (void);
+extern SCM scm_environment_module_hash_proc (void);
+extern SCM scm_null_environment_proc(SCM version);
+extern SCM scm_scheme_guile_environment_proc(SCM version);
+extern SCM scm_guile_user_environment_proc(SCM version);
+extern SCM scm_report_environment_proc(SCM version);
+
+
+
+extern SCM scm_environment_intern (SCM env, char* name, SCM val);
+
+
+
+/* environment-symbol-properties */
+SCM scm_environment_symbol_property(SCM env, SCM sym, SCM prop);
+SCM scm_environment_remove_symbol_property_x(SCM env, SCM sym, SCM prop);
+SCM scm_environment_set_symbol_property_x(SCM env, SCM sym, SCM prop, SCM  val);
+
+
+#endif