[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
guile/guile-core/ice-9 session.scm optargs.scm ...
|
From: |
Marius Vollmer |
|
Subject: |
guile/guile-core/ice-9 session.scm optargs.scm ... |
|
Date: |
Tue, 15 May 2001 07:59:01 -0700 |
CVSROOT: /cvs
Module name: guile
Changes by: Marius Vollmer <address@hidden> 01/05/15 07:59:01
Modified files:
guile-core/ice-9: session.scm optargs.scm format.scm debug.scm
boot-9.scm
Log message:
Merged from mvo-vcell-cleanup-1-branch.
CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/ice-9/session.scm.diff?cvsroot=OldCVS&tr1=1.25&tr2=1.26&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/ice-9/optargs.scm.diff?cvsroot=OldCVS&tr1=1.10&tr2=1.11&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/ice-9/format.scm.diff?cvsroot=OldCVS&tr1=1.7&tr2=1.8&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/ice-9/debug.scm.diff?cvsroot=OldCVS&tr1=1.19&tr2=1.20&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/ice-9/boot-9.scm.diff?cvsroot=OldCVS&tr1=1.245&tr2=1.246&r1=text&r2=text
Patches:
Index: guile/guile-core/ice-9/boot-9.scm
diff -u guile/guile-core/ice-9/boot-9.scm:1.245
guile/guile-core/ice-9/boot-9.scm:1.246
--- guile/guile-core/ice-9/boot-9.scm:1.245 Mon May 14 17:51:06 2001
+++ guile/guile-core/ice-9/boot-9.scm Tue May 15 07:59:01 2001
@@ -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
+;; 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)
-
-(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)))
+;; 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 (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
Index: guile/guile-core/ice-9/debug.scm
diff -u guile/guile-core/ice-9/debug.scm:1.19
guile/guile-core/ice-9/debug.scm:1.20
--- guile/guile-core/ice-9/debug.scm:1.19 Sun Sep 12 04:06:25 1999
+++ guile/guile-core/ice-9/debug.scm Tue May 15 07:59:01 2001
@@ -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)
Index: guile/guile-core/ice-9/format.scm
diff -u guile/guile-core/ice-9/format.scm:1.7
guile/guile-core/ice-9/format.scm:1.8
--- guile/guile-core/ice-9/format.scm:1.7 Mon Aug 14 08:40:03 2000
+++ guile/guile-core/ice-9/format.scm Tue May 15 07:59:01 2001
@@ -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.
Index: guile/guile-core/ice-9/optargs.scm
diff -u guile/guile-core/ice-9/optargs.scm:1.10
guile/guile-core/ice-9/optargs.scm:1.11
--- guile/guile-core/ice-9/optargs.scm:1.10 Sat Apr 28 11:58:09 2001
+++ guile/guile-core/ice-9/optargs.scm Tue May 15 07:59:01 2001
@@ -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:
Index: guile/guile-core/ice-9/session.scm
diff -u guile/guile-core/ice-9/session.scm:1.25
guile/guile-core/ice-9/session.scm:1.26
--- guile/guile-core/ice-9/session.scm:1.25 Fri Apr 27 17:35:02 2001
+++ guile/guile-core/ice-9/session.scm Tue May 15 07:59:00 2001
@@ -220,15 +220,9 @@
(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 @@
(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 @@
(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))))))