Merged from mvo-vcell-cleanup-1-branch.

guile-readline/readline.c

@@ -397,7 +397,7 @@ SCM scm_readline_completion_function_var;
 static char *
 completion_function (char *text, int continuep)
 {
-  SCM compfunc = SCM_CDR (scm_readline_completion_function_var);
+  SCM compfunc = SCM_VARIABLE_REF (scm_readline_completion_function_var);
   SCM res;
 
   if (SCM_FALSEP (compfunc))
@@ -542,7 +542,7 @@ scm_init_readline ()
 #ifdef HAVE_RL_GETC_FUNCTION
 #include "guile-readline/readline.x"
   scm_readline_completion_function_var
-    = scm_sysintern ("*readline-completion-function*", SCM_BOOL_F);
+    = scm_c_define ("*readline-completion-function*", SCM_BOOL_F);
   rl_getc_function = current_input_getc;
   rl_redisplay_function = redisplay;
   rl_completion_entry_function = (Function*) completion_function;

ice-9/boot-9.scm

@@ -1250,7 +1250,8 @@
       (and (module-binder m)
 	   ((module-binder m) m v #t))
       (begin
-	(let ((answer (make-undefined-variable v)))
+	(let ((answer (make-undefined-variable)))
+	  (variable-set-name-hint! answer v)
 	  (module-obarray-set! (module-obarray m) v answer)
 	  (module-modified m)
 	  answer))))
@@ -1313,43 +1314,28 @@
 
 ;; make-root-module
 
-;; A root module uses the symhash table (the system's privileged
-;; obarray).  Being inside a root module is like using SCM without
-;; any module system.
+;; A root module uses the pre-modules-obarray as its obarray.  This
+;; special obarray accumulates all bindings that have been established
+;; before the module system is fully booted.
 ;;
-
-
-(define (root-module-closure m s define?)
-  (let ((bi (builtin-variable s)))
-    (and bi
-	 (or define? (variable-bound? bi))
-	 (begin
-	   (module-add! m s bi)
-	   bi))))
+;; (The obarray continues to be used by code that has been closed over
+;;  before the module system has been booted.)
 
 (define (make-root-module)
-  (make-module 1019 '() root-module-closure))
-
+  (let ((m (make-module 0)))
+    (set-module-obarray! m (%get-pre-modules-obarray))
+    m))
 
 ;; make-scm-module 
 
-;; An scm module is a module into which the lazy binder copies
-;; variable bindings from the system symhash table.  The mapping is
-;; one way only; newly introduced bindings in an scm module are not
-;; copied back into the system symhash table (and can be used to override
-;; bindings from the symhash table).
-;;
-
-(define (scm-module-closure m s define?)
-  (let ((bi (builtin-variable s)))
-    (and bi
-	 (variable-bound? bi)
-	 (begin
-	   (module-add! m s bi)
-	   bi))))
+;; The root interface is a module that uses the same obarray as the
+;; root module.  It does not allow new definitions, tho.
 
 (define (make-scm-module)
-  (make-module 1019 '() scm-module-closure))
+  (let ((m (make-module 0)))
+    (set-module-obarray! m (%get-pre-modules-obarray))
+    (set-module-eval-closure! m (standard-interface-eval-closure m))
+    m))
 
 
 
@@ -1422,7 +1408,9 @@
 	(begin
 	  (variable-set! variable value)
 	  (module-modified module))
-	(module-add! module name (make-variable value name)))))
+	(let ((variable (make-variable value)))
+	  (variable-set-name-hint! variable name)
+	  (module-add! module name variable)))))
 
 ;; MODULE-DEFINED? -- exported
 ;;
@@ -1539,18 +1527,33 @@
 (set-module-kind! the-scm-module 'interface)
 (for-each set-system-module! (list the-root-module the-scm-module) '(#t #t))
 
-(set-current-module the-root-module)
+;; NOTE: This binding is used in libguile/modules.c.
+;;
+(define (make-modules-in module name)
+  (if (null? name)
+      module
+      (cond
+       ((module-ref module (car name) #f)
+	=> (lambda (m) (make-modules-in m (cdr name))))
+       (else	(let ((m (make-module 31)))
+		  (set-module-kind! m 'directory)
+		  (set-module-name! m (append (or (module-name module)
+						  '())
+					      (list (car name))))
+		  (module-define! module (car name) m)
+		  (make-modules-in m (cdr name)))))))
 
-(define app (make-module 31))
-(local-define '(app modules) (make-module 31))
-(local-define '(app modules guile) the-root-module)
-
-;; (define-special-value '(app modules new-ws) (lambda () (make-scm-module)))
-
-(define (try-load-module name)
-  (or (try-module-linked name)
-      (try-module-autoload name)
-      (try-module-dynamic-link name)))
+(define (beautify-user-module! module)
+  (let ((interface (module-public-interface module)))
+    (if (or (not interface)
+	    (eq? interface module))
+	(let ((interface (make-module 31)))
+	  (set-module-name! interface (module-name module))
+	  (set-module-kind! interface 'interface)
+	  (set-module-public-interface! module interface))))
+  (if (and (not (memq the-scm-module (module-uses module)))
+	   (not (eq? module the-root-module)))
+      (set-module-uses! module (append (module-uses module) (list the-scm-module)))))
 
 ;; NOTE: This binding is used in libguile/modules.c.
 ;;
@@ -1574,18 +1577,24 @@
 	    ;; Get/create it.
 	    (make-modules-in (current-module) full-name))))))
 
-(define (beautify-user-module! module)
-  (let ((interface (module-public-interface module)))
-    (if (or (not interface)
-	    (eq? interface module))
-	(let ((interface (make-module 31)))
-	  (set-module-name! interface (module-name module))
-	  (set-module-kind! interface 'interface)
-	  (set-module-public-interface! module interface))))
-  (if (and (not (memq the-scm-module (module-uses module)))
-	   (not (eq? module the-root-module)))
-      (set-module-uses! module (append (module-uses module)
-                                       (list the-scm-module)))))
+;; Cheat.
+(define try-module-autoload #f)
+
+;; This boots the module system.  All bindings needed by modules.c
+;; must have been defined by now.
+;;
+(set-current-module the-root-module)
+
+(define app (make-module 31))
+(local-define '(app modules) (make-module 31))
+(local-define '(app modules guile) the-root-module)
+
+;; (define-special-value '(app modules new-ws) (lambda () (make-scm-module)))
+
+(define (try-load-module name)
+  (or (try-module-linked name)
+      (try-module-autoload name)
+      (try-module-dynamic-link name)))
 
 (define (purify-module! module)
   "Removes bindings in MODULE which are inherited from the (guile) module."
@@ -1594,21 +1603,10 @@
 	     (eq? (car (last-pair use-list)) the-scm-module))
 	(set-module-uses! module (reverse (cdr (reverse use-list)))))))
 
-;; NOTE: This binding is used in libguile/modules.c.
-;;
-(define (make-modules-in module name)
-  (if (null? name)
-      module
-      (cond
-       ((module-ref module (car name) #f)
-	=> (lambda (m) (make-modules-in m (cdr name))))
-       (else	(let ((m (make-module 31)))
-		  (set-module-kind! m 'directory)
-		  (set-module-name! m (append (or (module-name module)
-						  '())
-					      (list (car name))))
-		  (module-define! module (car name) m)
-		  (make-modules-in m (cdr name)))))))
+(define (resolve-interface name)
+  (let ((module (resolve-module name)))
+    (and module (module-public-interface module))))
+
 
 ;; Return a module interface made from SPEC.
 ;; SPEC can be a list of symbols, in which case it names a module

ice-9/debug.scm

@@ -109,7 +109,8 @@
 
 ;;; A fix to get the error handling working together with the module system.
 ;;;
-(variable-set! (builtin-variable 'debug-options) debug-options)
+;;; XXX - Still needed?
+(module-set! the-root-module 'debug-options debug-options)
 
 
 

ice-9/format.scm

@@ -1704,7 +1704,7 @@
 
 (define format format:format)
 ;; Thanks to Shuji Narazaki
-(variable-set! (builtin-variable 'format) format)
+(module-set! the-root-module 'format format)
 
 ;; If this is not possible then a continuation is used to recover
 ;; properly from a format error. In this case format returns #f.

ice-9/optargs.scm

@@ -31,7 +31,6 @@
 ;;; a convenient and attractive syntax.
 ;;;
 ;;; exported macros are:
-;;;   bound?
 ;;;   let-optional
 ;;;   let-optional*
 ;;;   let-keywords
@@ -61,36 +60,19 @@
 
 (define-module (ice-9 optargs))
 
-;; bound? var
-;;   Checks if a variable is bound in the current environment.
-;;
-;; defined? doesn't quite cut it as it stands, since it only
-;; checks bindings in the top-level environment, not those in
-;; local scope only.
-;;
-
-(defmacro-public bound? (var)
-  `(catch 'misc-error
-	  (lambda ()
-	    ,var
-	    (not (eq? ,var ,(variable-ref
-			    (make-undefined-variable)))))
-	  (lambda args #f)))
-
-
 ;; let-optional rest-arg (binding ...) . body
 ;; let-optional* rest-arg (binding ...) . body
 ;;   macros used to bind optional arguments
 ;;
-;; These two macros give you an optional argument interface that
-;; is very "Schemey" and introduces no fancy syntax. They are
-;; compatible with the scsh macros of the same name, but are slightly
+;; These two macros give you an optional argument interface that is
+;; very "Schemey" and introduces no fancy syntax. They are compatible
+;; with the scsh macros of the same name, but are slightly
 ;; extended. Each of binding may be of one of the forms <var> or
 ;; (<var> <default-value>). rest-arg should be the rest-argument of
 ;; the procedures these are used from. The items in rest-arg are
 ;; sequentially bound to the variable namess are given. When rest-arg
 ;; runs out, the remaining vars are bound either to the default values
-;; or left unbound if no default value was specified. rest-arg remains
+;; or to `#f' if no default value was specified. rest-arg remains
 ;; bound to whatever may have been left of rest-arg.
 ;;
 
@@ -130,8 +112,7 @@
   (let ((bindings (map (lambda (x)
 			 (if (list? x)
 			     x
-			     (list x (variable-ref
-				      (make-undefined-variable)))))
+			     (list x #f)))
 		       BINDINGS)))
     `(,let-type ,(map proc bindings) ,@BODY)))
 
@@ -219,8 +200,7 @@
 ;;   (lambda* (a b #:optional c d . e) '())
 ;; creates a procedure with fixed arguments a and b, optional arguments c
 ;; and d, and rest argument e. If the optional arguments are omitted
-;; in a call, the variables for them are unbound in the procedure. This
-;; can be checked with the bound? macro.
+;; in a call, the variables for them are bound to `#f'.
 ;;
 ;; lambda* can also take keyword arguments. For example, a procedure
 ;; defined like this:

ice-9/session.scm

@@ -220,15 +220,9 @@ where OPTIONSET is one of debug, read, eval, print
 	       (set! value #t)))
 	(for-each
 	 (lambda (module)
-	   (let* ((builtin (or (eq? module the-scm-module)
-			       (eq? module the-root-module)))
-		  (name (module-name module))
-		  (obarray (if builtin
-			       (builtin-bindings)
-			       (module-obarray module)))
-		  (get-ref (if builtin
-			       identity
-			       variable-ref)))
+	   (let* ((name (module-name module))
+		  (obarray (module-obarray module)))
+	     ;; XXX - should use hash-fold here
 	     (array-for-each
 	      (lambda (oblist)
 		(for-each
@@ -237,20 +231,19 @@ where OPTIONSET is one of debug, read, eval, print
 			  (display name)
 			  (display ": ")
 			  (display (car x))
-			  (cond ((procedure? (get-ref (cdr x)))
+			  (cond ((procedure? (variable-ref (cdr x)))
 				 (display separator)
-				 (display (get-ref (cdr x))))
+				 (display (variable-ref (cdr x))))
 				(value
 				 (display separator)
-				 (display (get-ref (cdr x)))))
+				 (display (variable-ref (cdr x)))))
 			  (if (and shadow
 				   (not (eq? (module-ref module
 							 (car x))
 					     (module-ref (current-module)
 							 (car x)))))
 			      (display " shadowed"))
-			  (newline)
-			  )))
+			  (newline))))
 		 oblist))
 	      obarray)))
 	 modules))))
@@ -295,12 +288,7 @@ Fourth arg FOLDER is one of
 		    (module-filter
 		     (lambda (name var data)
 		       (obarray-filter name (variable-ref var) data))))
-	       (cond ((or (eq? module the-scm-module)
-			  (eq? module the-root-module))
-		      (hash-fold obarray-filter
-				 data
-				 (builtin-bindings)))
-		     (module (hash-fold module-filter
+	       (cond (module (hash-fold module-filter
 					data
 					(module-obarray module)))
 		     (else data))))))

oop/goops/compile.scm

@@ -114,6 +114,8 @@
 
 (define (compile-method methods types)
   (let* ((proc (method-procedure (car methods)))
+	 ;; XXX - procedure-source can not be guaranteed to be
+	 ;;       reliable or efficient
 	 (src (procedure-source proc)) 
 	 (formals (source-formals src))
 	 (body (source-body src)))