summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMikael Djurfeldt <djurfeldt@nada.kth.se>2003-03-11 15:58:02 +0000
committerMikael Djurfeldt <djurfeldt@nada.kth.se>2003-03-11 15:58:02 +0000
commit109c2c9f29c206ee05e68fb3a08093dc7767f275 (patch)
tree9b84957653fcc615e20038e254d82bb7540f0de2
parentf8af5c6d355b2c05e0aff4bcb2f1651b6f5c7824 (diff)
downloadguile-109c2c9f29c206ee05e68fb3a08093dc7767f275.tar.gz
* modules.c (scm_module_import_interface): New function.
* boot-9.scm (process-duplicates): Use module-import-interface. (module-symbol-interface): Removed.
-rw-r--r--ice-9/ChangeLog3
-rw-r--r--ice-9/boot-9.scm95
-rw-r--r--libguile/ChangeLog2
-rw-r--r--libguile/modules.c36
-rw-r--r--libguile/modules.h3
5 files changed, 87 insertions, 52 deletions
diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog
index 96eba46f9..66ff590d7 100644
--- a/ice-9/ChangeLog
+++ b/ice-9/ChangeLog
@@ -1,5 +1,8 @@
2003-03-11 Mikael Djurfeldt <djurfeldt@nada.kth.se>
+ * boot-9.scm (process-duplicates): Use module-import-interface.
+ (module-symbol-interface): Removed.
+
* boot-9.scm (module-override!, make-mutable-parameter,
lookup-duplicates-handlers, default-module-duplicates-handler):
New functions.
diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm
index 93b55d14b..a447e9b76 100644
--- a/ice-9/boot-9.scm
+++ b/ice-9/boot-9.scm
@@ -2837,14 +2837,15 @@
m))
(define (lookup-duplicates-handlers handler-names)
- (map (lambda (handler-name)
- (or (module-symbol-local-binding
- duplicate-handlers handler-name #f)
- (error "invalid duplicate handler name:"
- handler-name)))
- (if (list? handler-names)
- handler-names
- (list handler-names))))
+ (and handler-names
+ (map (lambda (handler-name)
+ (or (module-symbol-local-binding
+ duplicate-handlers handler-name #f)
+ (error "invalid duplicate handler name:"
+ handler-name)))
+ (if (list? handler-names)
+ handler-names
+ (list handler-names)))))
(define default-module-duplicates-handler
(make-mutable-parameter '(replace warn-override-core check)
@@ -2856,55 +2857,47 @@
(set-module-name! m 'duplicates)
m))
-(define (module-symbol-interface module sym)
- (or-map (lambda (interface)
- (module-search (lambda (interface sym)
- (and (module-local-variable interface sym)
- interface))
- interface
- sym))
- (module-uses module)))
-
(define (process-duplicates module interface)
(let* ((duplicates-info (module-duplicates-info module))
(duplicates-handlers (car duplicates-info))
(duplicates-interface (cdr duplicates-info)))
(module-for-each
(lambda (name var)
- (let ((prev-interface (module-symbol-interface module name)))
- (if prev-interface
- (let ((var1 (module-local-variable prev-interface name))
- (var2 (module-local-variable interface name)))
- (if (not (eq? var1 var2))
- (begin
- (if (not duplicates-interface)
- (begin
- (set! duplicates-interface
- (make-duplicates-interface))
- (set-cdr! duplicates-info duplicates-interface)))
- (let* ((var (module-local-variable duplicates-interface
- name))
- (val (and var
- (variable-bound? var)
- (variable-ref var))))
- (let loop ((duplicates-handlers duplicates-handlers))
- (cond ((null? duplicates-handlers))
- (((car duplicates-handlers)
- module
- name
- prev-interface
- (and (variable-bound? var1)
- (variable-ref var1))
- interface
- (and (variable-bound? var2)
- (variable-ref var2))
- var
- val)
- =>
- (lambda (var)
- (module-add! duplicates-interface name var)))
- (else
- (loop (cdr duplicates-handlers))))))))))))
+ (cond ((module-import-interface module name)
+ =>
+ (lambda (prev-interface)
+ (let ((var1 (module-local-variable prev-interface name))
+ (var2 (module-local-variable interface name)))
+ (if (not (eq? var1 var2))
+ (begin
+ (if (not duplicates-interface)
+ (begin
+ (set! duplicates-interface
+ (make-duplicates-interface))
+ (set-cdr! duplicates-info duplicates-interface)))
+ (let* ((var (module-local-variable duplicates-interface
+ name))
+ (val (and var
+ (variable-bound? var)
+ (variable-ref var))))
+ (let loop ((duplicates-handlers duplicates-handlers))
+ (cond ((null? duplicates-handlers))
+ (((car duplicates-handlers)
+ module
+ name
+ prev-interface
+ (and (variable-bound? var1)
+ (variable-ref var1))
+ interface
+ (and (variable-bound? var2)
+ (variable-ref var2))
+ var
+ val)
+ =>
+ (lambda (var)
+ (module-add! duplicates-interface name var)))
+ (else
+ (loop (cdr duplicates-handlers)))))))))))))
interface)))
diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 00e7cf4c6..a11364aae 100644
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,5 +1,7 @@
2003-03-11 Mikael Djurfeldt <djurfeldt@nada.kth.se>
+ * modules.c (scm_module_import_interface): New function.
+
* goops.c, goops.h (scm_class_accessor_method): Renamed from
scm_class_accessor.
(scm_class_accessor): New class.
diff --git a/libguile/modules.c b/libguile/modules.c
index a0031af9c..46b9e7f88 100644
--- a/libguile/modules.c
+++ b/libguile/modules.c
@@ -413,6 +413,42 @@ scm_current_module_transformer ()
return SCM_BOOL_F;
}
+SCM_DEFINE (scm_module_import_interface, "module-import-interface", 2, 0, 0,
+ (SCM module, SCM sym),
+ "")
+#define FUNC_NAME s_scm_module_import_interface
+{
+#define SCM_BOUND_THING_P(b) (!SCM_FALSEP (b))
+ SCM_VALIDATE_MODULE (SCM_ARG1, module);
+ /* Search the use list */
+ SCM uses = SCM_MODULE_USES (module);
+ while (SCM_CONSP (uses))
+ {
+ SCM interface = SCM_CAR (uses);
+ /* 1. Check module obarray */
+ SCM b = scm_hashq_ref (SCM_MODULE_OBARRAY (interface), sym, SCM_BOOL_F);
+ if (SCM_BOUND_THING_P (b))
+ return interface;
+ {
+ SCM binder = SCM_MODULE_BINDER (interface);
+ if (!SCM_FALSEP (binder))
+ /* 2. Custom binder */
+ {
+ b = scm_call_3 (binder, interface, sym, SCM_BOOL_F);
+ if (SCM_BOUND_THING_P (b))
+ return interface;
+ }
+ }
+ /* 3. Search use list recursively. */
+ interface = scm_module_import_interface (interface, sym);
+ if (!SCM_FALSEP (interface))
+ return interface;
+ uses = SCM_CDR (uses);
+ }
+ return SCM_BOOL_F;
+}
+#undef FUNC_NAME
+
/* scm_sym2var
*
* looks up the variable bound to SYM according to PROC. PROC should be
diff --git a/libguile/modules.h b/libguile/modules.h
index db3d789be..b1d7cef12 100644
--- a/libguile/modules.h
+++ b/libguile/modules.h
@@ -3,7 +3,7 @@
#ifndef SCM_MODULES_H
#define SCM_MODULES_H
-/* Copyright (C) 1998, 2000, 2001, 2002 Free Software Foundation, Inc.
+/* Copyright (C) 1998, 2000, 2001, 2002, 2003 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
@@ -114,6 +114,7 @@ SCM_API void scm_c_export (const char *name, ...);
SCM_API SCM scm_sym2var (SCM sym, SCM thunk, SCM definep);
+SCM_API SCM scm_module_import_interface (SCM module, SCM sym);
SCM_API SCM scm_module_lookup_closure (SCM module);
SCM_API SCM scm_module_transformer (SCM module);
SCM_API SCM scm_current_module_lookup_closure (void);