diff options
author | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 2003-03-11 15:58:02 +0000 |
---|---|---|
committer | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 2003-03-11 15:58:02 +0000 |
commit | 109c2c9f29c206ee05e68fb3a08093dc7767f275 (patch) | |
tree | 9b84957653fcc615e20038e254d82bb7540f0de2 | |
parent | f8af5c6d355b2c05e0aff4bcb2f1651b6f5c7824 (diff) | |
download | guile-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/ChangeLog | 3 | ||||
-rw-r--r-- | ice-9/boot-9.scm | 95 | ||||
-rw-r--r-- | libguile/ChangeLog | 2 | ||||
-rw-r--r-- | libguile/modules.c | 36 | ||||
-rw-r--r-- | libguile/modules.h | 3 |
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); |