[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. release_1-9-10-72-g4d
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. release_1-9-10-72-g4d67cd4 |
|
Date: |
Tue, 27 Apr 2010 20:15:10 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=4d67cd4073b43bb48af6c1664357b5e18247e335
The branch, master has been updated
via 4d67cd4073b43bb48af6c1664357b5e18247e335 (commit)
via 1c1a08238ead8627a65dbc97d6eeb91fe9f8e1a9 (commit)
via 4e48b4950ecaa10265de6709bf87597a818cf44d (commit)
via 69928c8a3240d8d2417434c18839e098de9f93d8 (commit)
via 993dae8623e0fe6195000afb81902ea466bd2dc4 (commit)
via 81fc66cfb665814d9cfd766b3c19be90ae1b13ec (commit)
via f6a5308b03f30872a1973a6d40116a636fa52b11 (commit)
via f905381d317d0e3edbcea55cdd05e29ba9e5cb20 (commit)
via 9b023f3c63f51ded3216de11c7f6126f02bacd8f (commit)
via 28b8c785e7fbdc53045b32a896f4a730b29e050b (commit)
via 635a8b36b1dbed877fb8df752600870e9e1ee625 (commit)
via d58ccc669cf796b8b9c579e86f3072f0f4223adf (commit)
via 9e0bfdbaa39ff87e002ec5bbf7183de4ce8f6b61 (commit)
via b910c4ac4ec8c66d1c6495ae958fd76641a32e53 (commit)
via 0f27ab8a9e10ccb014a0bfc7fcc984d8d1bf124b (commit)
via 51b22dbb48b51303e0a2f8d3fa2b87e703736feb (commit)
via aa26a6d2b15f2a1315fffb2fec9ea7c8b4ef81f1 (commit)
from 44ecb503787b4ca3eb68975e15c511638c198740 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 4d67cd4073b43bb48af6c1664357b5e18247e335
Merge: 44ecb503787b4ca3eb68975e15c511638c198740
1c1a08238ead8627a65dbc97d6eeb91fe9f8e1a9
Author: Andy Wingo <address@hidden>
Date: Tue Apr 27 22:04:33 2010 +0200
Merge branch 'wip-module-namespaces'
commit 1c1a08238ead8627a65dbc97d6eeb91fe9f8e1a9
Author: Andy Wingo <address@hidden>
Date: Tue Apr 27 22:04:24 2010 +0200
comment some global variables in modules.c
* libguile/modules.c: Comment some global variables.
-----------------------------------------------------------------------
Summary of changes:
libguile/modules.c | 43 ++++-------
module/ice-9/boot-9.scm | 173 +++++++++++++++++++++++++++++--------------
module/ice-9/deprecated.scm | 64 +++++++++++++---
module/ice-9/ls.scm | 26 +++----
module/ice-9/r5rs.scm | 7 +-
module/ice-9/safe-r5rs.scm | 5 +-
module/ice-9/session.scm | 3 +-
module/oop/goops/save.scm | 6 +-
module/oop/goops/simple.scm | 5 +-
module/oop/goops/stklos.scm | 6 +-
module/system/xref.scm | 6 +-
11 files changed, 220 insertions(+), 124 deletions(-)
diff --git a/libguile/modules.c b/libguile/modules.c
index ccb68b7..ac15eaa 100644
--- a/libguile/modules.c
+++ b/libguile/modules.c
@@ -42,9 +42,20 @@ int scm_module_system_booted_p = 0;
scm_t_bits scm_module_tag;
+/* The current module, a fluid. */
static SCM the_module;
+/* Most of the module system is implemented in Scheme. These bindings from
+ boot-9 are needed to provide the Scheme interface. */
static SCM the_root_module_var;
+static SCM module_make_local_var_x_var;
+static SCM process_define_module_var;
+static SCM process_use_modules_var;
+static SCM resolve_module_var;
+static SCM module_public_interface_var;
+static SCM module_export_x_var;
+static SCM default_duplicate_binding_procedures_var;
+
static SCM unbound_variable (const char *func, SCM sym)
{
@@ -149,10 +160,6 @@ convert_module_name (const char *name)
return list;
}
-static SCM process_define_module_var;
-static SCM process_use_modules_var;
-static SCM resolve_module_var;
-
SCM
scm_c_resolve_module (const char *name)
{
@@ -183,8 +190,6 @@ scm_c_use_module (const char *name)
scm_list_1 (scm_list_1 (convert_module_name (name))));
}
-static SCM module_export_x_var;
-
SCM
scm_module_export (SCM module, SCM namelist)
{
@@ -267,12 +272,6 @@ scm_lookup_closure_module (SCM proc)
* release.
*/
-/* The `module-make-local-var!' variable. */
-static SCM module_make_local_var_x_var = SCM_UNSPECIFIED;
-
-/* The `default-duplicate-binding-procedures' variable. */
-static SCM default_duplicate_binding_procedures_var = SCM_UNSPECIFIED;
-
/* Return the list of default duplicate binding handlers (procedures). */
static inline SCM
default_duplicate_binding_handlers (void)
@@ -638,24 +637,11 @@ SCM_DEFINE (scm_module_import_interface,
"module-import-interface", 2, 0, 0,
}
#undef FUNC_NAME
-SCM_SYMBOL (sym_sys_module_public_interface, "%module-public-interface");
-
-SCM_DEFINE (scm_module_public_interface, "module-public-interface", 1, 0, 0,
- (SCM module),
- "Return the public interface of @var{module}.\n\n"
- "If @var{module} has no public interface, @code{#f} is returned.")
-#define FUNC_NAME s_scm_module_public_interface
+SCM
+scm_module_public_interface (SCM module)
{
- SCM var;
-
- SCM_VALIDATE_MODULE (1, module);
- var = scm_module_local_variable (module, sym_sys_module_public_interface);
- if (scm_is_true (var))
- return SCM_VARIABLE_REF (var);
- else
- return SCM_BOOL_F;
+ return scm_call_1 (SCM_VARIABLE_REF (module_public_interface_var), module);
}
-#undef FUNC_NAME
/* scm_sym2var
*
@@ -899,6 +885,7 @@ scm_post_boot_init_modules ()
the_root_module_var = scm_c_lookup ("the-root-module");
default_duplicate_binding_procedures_var =
scm_c_lookup ("default-duplicate-binding-procedures");
+ module_public_interface_var = scm_c_lookup ("module-public-interface");
scm_module_system_booted_p = 1;
}
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 6a36ea4..05b6a19 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -1551,6 +1551,7 @@ If there is no handler at all, Guile prints an error and
then exits."
;; NOTE: The getter `module-eval-closure' is used in libguile/modules.c.
;; NOTE: The getter `module-transfomer' is defined libguile/modules.c.
;; NOTE: The getter `module-name' is defined later, due to boot reasons.
+ ;; NOTE: The getter `module-public-interface' is used in libguile/modules.c.
;;
(define-record-type module
(lambda (obj port) (%print-module obj port))
@@ -1565,7 +1566,10 @@ If there is no handler at all, Guile prints an error and
then exits."
(import-obarray #:no-setter)
observers
(weak-observers #:no-setter)
- version)))
+ version
+ submodules
+ submodule-binder
+ public-interface)))
;; make-module &opt size uses binder
@@ -1606,7 +1610,8 @@ If there is no handler at all, Guile prints an error and
then exits."
#f #f #f
(make-hash-table
%default-import-size)
'()
- (make-weak-key-hash-table 31) #f)))
+ (make-weak-key-hash-table 31) #f
+ (make-hash-table 7) #f #f)))
;; We can't pass this as an argument to module-constructor,
;; because we need it to close over a pointer to the module
@@ -1916,6 +1921,20 @@ If there is no handler at all, Guile prints an error and
then exits."
(define (module-map proc module)
(hash-map->list proc (module-obarray module)))
+;; Submodules
+;;
+;; Modules exist in a separate namespace from values, because you generally do
+;; not want the name of a submodule, which you might not even use, to collide
+;; with local variables that happen to be named the same as the submodule.
+;;
+(define (module-ref-submodule module name)
+ (or (hashq-ref (module-submodules module) name)
+ (and (module-submodule-binder module)
+ ((module-submodule-binder module) module name))))
+
+(define (module-define-submodule! module name submodule)
+ (hashq-set! (module-submodules module) name submodule))
+
;;; {Low Level Bootstrapping}
@@ -2070,15 +2089,15 @@ If there is no handler at all, Guile prints an error
and then exits."
;;; {Recursive Namespaces}
;;;
;;; A hierarchical namespace emerges if we consider some module to be
-;;; root, and variables bound to modules as nested namespaces.
+;;; root, and submodules of that module to be nested namespaces.
;;;
-;;; The routines in this file manage variable names in hierarchical namespace.
+;;; The routines here manage variable names in hierarchical namespace.
;;; Each variable name is a list of elements, looked up in successively nested
;;; modules.
;;;
;;; (nested-ref some-root-module '(foo bar baz))
-;;; => <value of a variable named baz in the module bound to bar in
-;;; the module bound to foo in some-root-module>
+;;; => <value of a variable named baz in the submodule bar of
+;;; the submodule foo of some-root-module>
;;;
;;;
;;; There are:
@@ -2091,50 +2110,104 @@ If there is no handler at all, Guile prints an error
and then exits."
;;; nested-define! a-root name val
;;; nested-remove! a-root name
;;;
+;;; These functions manipulate values in namespaces. For referencing the
+;;; namespaces themselves, use the following:
+;;;
+;;; nested-ref-module a-root name
+;;; nested-define-module! a-root name mod
;;;
-;;; (current-module) is a natural choice for a-root so for convenience there
are
+;;; (current-module) is a natural choice for a root so for convenience there
are
;;; also:
;;;
-;;; local-ref name == nested-ref (current-module) name
-;;; local-set! name val == nested-set! (current-module) name val
-;;; local-define name val == nested-define! (current-module) name
val
-;;; local-remove name == nested-remove! (current-module) name
+;;; local-ref name == nested-ref (current-module) name
+;;; local-set! name val == nested-set! (current-module) name val
+;;; local-define name val == nested-define! (current-module) name
val
+;;; local-remove name == nested-remove! (current-module) name
+;;; local-ref-module name == nested-ref-module (current-module)
name
+;;; local-define-module! name m == nested-define-module!
(current-module) name m
;;;
(define (nested-ref root names)
- (let loop ((cur root)
- (elts names))
- (cond
- ((null? elts) cur)
- ((not (module? cur)) #f)
- (else (loop (module-ref cur (car elts) #f) (cdr elts))))))
+ (if (null? names)
+ root
+ (let loop ((cur root)
+ (head (car names))
+ (tail (cdr names)))
+ (if (null? tail)
+ (module-ref cur head #f)
+ (let ((cur (module-ref-submodule cur head)))
+ (and cur
+ (loop cur (car tail) (cdr tail))))))))
(define (nested-set! root names val)
(let loop ((cur root)
- (elts names))
- (if (null? (cdr elts))
- (module-set! cur (car elts) val)
- (loop (module-ref cur (car elts)) (cdr elts)))))
+ (head (car names))
+ (tail (cdr names)))
+ (if (null? tail)
+ (module-set! cur head val)
+ (let ((cur (module-ref-submodule cur head)))
+ (if (not cur)
+ (error "failed to resolve module" names)
+ (loop cur (car tail) (cdr tail)))))))
(define (nested-define! root names val)
(let loop ((cur root)
- (elts names))
- (if (null? (cdr elts))
- (module-define! cur (car elts) val)
- (loop (module-ref cur (car elts)) (cdr elts)))))
+ (head (car names))
+ (tail (cdr names)))
+ (if (null? tail)
+ (module-define! cur head val)
+ (let ((cur (module-ref-submodule cur head)))
+ (if (not cur)
+ (error "failed to resolve module" names)
+ (loop cur (car tail) (cdr tail)))))))
(define (nested-remove! root names)
(let loop ((cur root)
- (elts names))
- (if (null? (cdr elts))
- (module-remove! cur (car elts))
- (loop (module-ref cur (car elts)) (cdr elts)))))
+ (head (car names))
+ (tail (cdr names)))
+ (if (null? tail)
+ (module-remove! cur head)
+ (let ((cur (module-ref-submodule cur head)))
+ (if (not cur)
+ (error "failed to resolve module" names)
+ (loop cur (car tail) (cdr tail)))))))
+
+
+(define (nested-ref-module root names)
+ (let loop ((cur root)
+ (names names))
+ (if (null? names)
+ cur
+ (let ((cur (module-ref-submodule cur (car names))))
+ (and cur
+ (loop cur (cdr names)))))))
+
+(define (nested-define-module! root names module)
+ (if (null? names)
+ (error "can't redefine root module" root module)
+ (let loop ((cur root)
+ (head (car names))
+ (tail (cdr names)))
+ (if (null? tail)
+ (module-define-submodule! cur head module)
+ (let ((cur (or (module-ref-submodule cur head)
+ (let ((m (make-module 31)))
+ (set-module-kind! m 'directory)
+ (set-module-name! m (append (module-name cur)
+ (list head)))
+ (module-define-submodule! cur head m)
+ m))))
+ (loop cur (car tail) (cdr tail)))))))
+
(define (local-ref names) (nested-ref (current-module) names))
(define (local-set! names val) (nested-set! (current-module) names val))
(define (local-define names val) (nested-define! (current-module) names val))
(define (local-remove names) (nested-remove! (current-module) names))
+(define (local-ref-module names) (nested-ref-module (current-module) names))
+(define (local-define-module names mod) (nested-define-module!
(current-module) names mod))
+
@@ -2147,9 +2220,6 @@ If there is no handler at all, Guile prints an error and
then exits."
;;; better thought of as a root.
;;;
-;; module-public-interface is defined in C.
-(define (set-module-public-interface! m i)
- (module-define! m '%module-public-interface i))
(define (set-system-module! m s)
(set-procedure-property! (module-eval-closure m) 'system-module s))
(define the-root-module (make-root-module))
@@ -2199,24 +2269,16 @@ If there is no handler at all, Guile prints an error
and then exits."
;; `resolve-module'. This is important as `psyntax' stores module
;; names and relies on being able to `resolve-module' them.
(set-module-name! mod name)
- (nested-define! (resolve-module '() #f) name mod)
+ (nested-define-module! (resolve-module '() #f) name mod)
(accessor mod))))))
(define (make-modules-in module name)
- (if (null? name)
- module
- (make-modules-in
- (let* ((var (module-local-variable module (car name)))
- (val (and var (variable-bound? var) (variable-ref var))))
- (if (module? val)
- val
- (let ((m (make-module 31)))
- (set-module-kind! m 'directory)
- (set-module-name! m (append (module-name module)
- (list (car name))))
- (module-define! module (car name) m)
- m)))
- (cdr name))))
+ (or (nested-ref-module module name)
+ (let ((m (make-module 31)))
+ (set-module-kind! m 'directory)
+ (set-module-name! m (append (module-name module) name))
+ (nested-define-module! module name m)
+ m)))
(define (beautify-user-module! module)
(let ((interface (module-public-interface module)))
@@ -2340,15 +2402,15 @@ If there is no handler at all, Guile prints an error
and then exits."
(let ((root (make-module)))
(set-module-name! root '())
;; Define the-root-module as '(guile).
- (module-define! root 'guile the-root-module)
+ (module-define-submodule! root 'guile the-root-module)
(lambda (name . args) ;; #:optional (autoload #t) (version #f)
- (let* ((already (nested-ref root name))
+ (let* ((already (nested-ref-module root name))
(numargs (length args))
(autoload (or (= numargs 0) (car args)))
(version (and (> numargs 1) (cadr args))))
(cond
- ((and already (module? already)
+ ((and already
(or (not autoload) (module-public-interface already)))
;; A hit, a palpable hit.
(if (and version
@@ -2360,10 +2422,10 @@ If there is no handler at all, Guile prints an error
and then exits."
(try-load-module name version)
(resolve-module name #f))
(else
- ;; A module is not bound (but maybe something else is),
- ;; we're not autoloading -- here's the weird semantics,
- ;; we create an empty module.
- (make-modules-in root name)))))))
+ ;; No module found (or if one was, it had no public interface), and
+ ;; we're not autoloading. Here's the weird semantics: we ensure
+ ;; there's an empty module.
+ (or already (make-modules-in root name))))))))
(define (try-load-module name version)
@@ -2620,7 +2682,8 @@ If there is no handler at all, Guile prints an error and
then exits."
(set-car! autoload i)))
(module-local-variable i sym))))))
(module-constructor (make-hash-table 0) '() b #f #f name 'autoload #f
- (make-hash-table 0) '() (make-weak-value-hash-table
31) #f)))
+ (make-hash-table 0) '() (make-weak-value-hash-table
31) #f
+ (make-hash-table 0) #f #f)))
(define (module-autoload! module . args)
"Have @var{module} automatically load the module named @var{name} when one
diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm
index 5c43b2f..d55f20f 100644
--- a/module/ice-9/deprecated.scm
+++ b/module/ice-9/deprecated.scm
@@ -38,9 +38,10 @@
$tanh
closure?
%nil
- @bind
- %app
- app))
+ @bind)
+
+ #:replace (module-ref-submodule module-define-submodule!))
+
;;;; Deprecated definitions.
@@ -299,10 +300,53 @@
(lambda ()
(set! id old-v) ...)))))))))
-;; Define (%app modules)
-(define %app (make-module 31))
-(set-module-name! %app '(%app))
-(nested-define! %app '(modules) (resolve-module '() #f))
-
-;; app aliases %app
-(define app %app)
+(define (module-ref-submodule module name)
+ (or (hashq-ref (module-submodules module) name)
+ (and (module-submodule-binder module)
+ ((module-submodule-binder module) module name))
+ (let ((var (module-local-variable module name)))
+ (and (variable-bound? var)
+ (module? (variable-ref var))
+ (begin
+ (warn "module" module "not in submodules table")
+ (variable-ref var))))))
+
+(define (module-define-submodule! module name submodule)
+ (let ((var (module-local-variable module name)))
+ (if (and var (variable-bound? var) (not (module? (variable-ref var))))
+ (warn "defining module" module ": not overriding local definition" var)
+ (module-define! module name submodule)))
+ (hashq-set! (module-submodules module) name submodule))
+
+;; Define (%app) and (%app modules), and have (app) alias (%app). This
+;; side-effects the-root-module, both to the submodules table and (through
+;; module-define-submodule! above) the obarray.
+;;
+(let ((%app (make-module 31)))
+ (set-module-name! %app '(%app))
+ (module-define-submodule! the-root-module '%app %app)
+ (module-define-submodule! the-root-module 'app %app)
+ (module-define-submodule! %app 'modules (resolve-module '() #f)))
+
+;; Allow code that poked %module-public-interface to keep on working.
+;;
+(set! module-public-interface
+ (let ((getter module-public-interface))
+ (lambda (mod)
+ (or (getter mod)
+ (cond
+ ((and=> (module-local-variable mod '%module-public-interface)
+ variable-ref)
+ => (lambda (iface)
+ (issue-deprecation-warning
+"Setting a module's public interface via munging %module-public-interface is
+deprecated. Use set-module-public-interface! instead.")
+ (set-module-public-interface! mod iface)
+ iface))
+ (else #f))))))
+
+(set! set-module-public-interface!
+ (let ((setter set-module-public-interface!))
+ (lambda (mod iface)
+ (setter mod iface)
+ (module-define! mod '%module-public-interface iface))))
diff --git a/module/ice-9/ls.scm b/module/ice-9/ls.scm
index f729d58..6a5b4e0 100644
--- a/module/ice-9/ls.scm
+++ b/module/ice-9/ls.scm
@@ -1,6 +1,6 @@
;;;; ls.scm --- functions for browsing modules
;;;;
-;;;; Copyright (C) 1995, 1996, 1997, 1999, 2001, 2006 Free Software
Foundation, Inc.
+;;;; Copyright (C) 1995, 1996, 1997, 1999, 2001, 2006, 2010 Free Software
Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -54,21 +54,19 @@
;;; Analogous to `ls', but with local definitions only.
(define (local-definitions-in root names)
- (let ((m (nested-ref root names))
- (answer '()))
- (if (not (module? m))
- (set! answer m)
- (module-for-each (lambda (k v) (set! answer (cons k answer))) m))
- answer))
+ (let ((m (nested-ref-module root names)))
+ (if m
+ (module-map (lambda (k v) k) m)
+ (nested-ref root names))))
(define (definitions-in root names)
- (let ((m (nested-ref root names)))
- (if (not (module? m))
- m
+ (let ((m (nested-ref-module root names)))
+ (if m
(reduce union
- (cons (local-definitions-in m '())
+ (cons (local-definitions-in m '())
(map (lambda (m2) (definitions-in m2 '()))
- (module-uses m)))))))
+ (module-uses m))))
+ (nested-ref root names))))
(define (ls . various-refs)
(if (pair? various-refs)
@@ -90,7 +88,7 @@
(define (recursive-local-define name value)
(let ((parent (reverse! (cdr (reverse name)))))
- (and parent (make-modules-in (current-module) parent))
- (local-define name value)))
+ (module-define! (make-modules-in (current-module) parent)
+ name value)))
;;; ls.scm ends here
diff --git a/module/ice-9/r5rs.scm b/module/ice-9/r5rs.scm
index c867f9a..6432bbc 100644
--- a/module/ice-9/r5rs.scm
+++ b/module/ice-9/r5rs.scm
@@ -1,4 +1,4 @@
-;;;; Copyright (C) 2000, 2001, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 2000, 2001, 2006, 2010 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -31,9 +31,10 @@
load))
-(module-use! %module-public-interface (resolve-interface '(ice-9 safe-r5rs)))
+(module-use! (module-public-interface (current-module))
+ (resolve-interface '(ice-9 safe-r5rs)))
-(define scheme-report-interface %module-public-interface)
+(define scheme-report-interface (module-public-interface (current-module)))
(define (scheme-report-environment n)
(if (not (= n 5))
diff --git a/module/ice-9/safe-r5rs.scm b/module/ice-9/safe-r5rs.scm
index f728533..a7ab164 100644
--- a/module/ice-9/safe-r5rs.scm
+++ b/module/ice-9/safe-r5rs.scm
@@ -1,4 +1,4 @@
-;;;; Copyright (C) 2000, 2001, 2004, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 2000, 2001, 2004, 2006, 2010 Free Software Foundation,
Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -129,7 +129,8 @@
(define null-interface (resolve-interface '(ice-9 null)))
-(module-use! %module-public-interface null-interface)
+(module-use! (module-public-interface (current-module))
+ null-interface)
(define (null-environment n)
(if (not (= n 5))
diff --git a/module/ice-9/session.scm b/module/ice-9/session.scm
index f3c8f66..10ce613 100644
--- a/module/ice-9/session.scm
+++ b/module/ice-9/session.scm
@@ -404,8 +404,7 @@ It is an image under the mapping EXTRACT."
identity))
(define (root-modules)
- (cons the-root-module
- (submodules (nested-ref the-root-module '(app modules)))))
+ (submodules (resolve-module '() #f)))
(define (submodules m)
(hash-fold (lambda (name var data)
diff --git a/module/oop/goops/save.scm b/module/oop/goops/save.scm
index b51c9e3..70d8a13 100644
--- a/module/oop/goops/save.scm
+++ b/module/oop/goops/save.scm
@@ -1,6 +1,6 @@
;;; installed-scm-file
-;;;; Copyright (C) 2000,2001,2002, 2006, 2009 Free Software Foundation, Inc.
+;;;; Copyright (C) 2000,2001,2002, 2006, 2009, 2010 Free Software Foundation,
Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -848,10 +848,12 @@
(close-port port)
objects))
+(define iface (module-public-interface (current-module)))
+
(define-method (load-objects (file <input-port>))
(let ((m (make-module)))
(module-use! m the-scm-module)
- (module-use! m %module-public-interface)
+ (module-use! m iface)
(save-module-excursion
(lambda ()
(set-current-module m)
diff --git a/module/oop/goops/simple.scm b/module/oop/goops/simple.scm
index bc5405a..8f4d839 100644
--- a/module/oop/goops/simple.scm
+++ b/module/oop/goops/simple.scm
@@ -1,6 +1,6 @@
;;; installed-scm-file
-;;;; Copyright (C) 2005, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 2005, 2006, 2010 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -28,4 +28,5 @@
((_ arg ...)
(define-class-with-accessors-keywords arg ...))))
-(module-use! %module-public-interface (resolve-interface '(oop goops)))
+(module-use! (module-public-interface (current-module))
+ (resolve-interface '(oop goops)))
diff --git a/module/oop/goops/stklos.scm b/module/oop/goops/stklos.scm
index 718635e..8a7ae16 100644
--- a/module/oop/goops/stklos.scm
+++ b/module/oop/goops/stklos.scm
@@ -34,9 +34,9 @@
;; Export all bindings that are exported from (oop goops)...
(module-for-each (lambda (sym var)
- (module-add! %module-public-interface sym var))
- (nested-ref the-root-module '(%app modules oop goops
- %module-public-interface)))
+ (module-add! (module-public-interface (current-module))
+ sym var))
+ (resolve-interface '(oop goops)))
;; ...but replace the following bindings:
(export define-class define-method)
diff --git a/module/system/xref.scm b/module/system/xref.scm
index 94ecb5b..acf5ed2 100644
--- a/module/system/xref.scm
+++ b/module/system/xref.scm
@@ -1,4 +1,4 @@
-;;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -62,8 +62,8 @@
(lp (1+ i) (if v (cons-uniq v out) out))))
((,mod ,sym ,public?)
;; hm, hacky.
- (let* ((m (nested-ref the-root-module
- (append '(%app modules) mod)))
+ (let* ((m (nested-ref-module (resolve-module '() #f)
+ mod))
(v (and m
(module-variable
(if public?
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. release_1-9-10-72-g4d67cd4,
Andy Wingo <=