mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-02 21:10:27 +02:00
Code Activity

(resolve-interface): Signal error now also if used module's

Browse source 
public interface is not available.
No longer call `beautify-user-module!'.
Signal error now also if selected binding not found.
This commit is contained in:
Thien-Thi Nguyen 2001-05-15 19:33:43 +00:00
parent f3f9dcbc5d
commit b622dec753
1 changed files with 37 additions and 32 deletions
Download patch file Download diff file Expand all files Collapse all files

31
ice-9/boot-9.scm
View file

@ -1626,18 +1626,17 @@
;; returned interface has no bindings. If the `:select' clause is omitted,
;; RENAMER operates on the used module's public interface.
;;
;; Signal error if module name is not resolvable.
;; Signal "no code for module" error if module name is not resolvable or its
;; public interface is not available. Signal "no binding" error if selected
;; binding does not exist in the used module.
;;
(define (resolve-interface spec)
(let* ((simple? (not (pair? (car spec))))
(name (if simple? spec (car spec)))
(module (resolve-module name)))
(if (not module)
(error "no code for module" name)
(let ((public-i (module-public-interface module)))
(cond ((not public-i)
(beautify-user-module! module)
(set! public-i (module-public-interface module))))
(module (resolve-module name))
(public-i (and module (module-public-interface module))))
(and (or (not module) (not public-i))
(error "no code for module" name))
(if simple?
public-i
(let ((selection (cond ((memq ':select spec) => cadr)
@ -1645,10 +1644,11 @@
public-i))))
(rename (cond ((memq ':rename spec)
=> (lambda (x)
;; fixme:ttn -- move to macroexpansion time
(eval (cadr x) (current-module))))
(else identity)))
(partial-i (make-module 31)))
(set-module-kind! partial-i 'interface)
(custom-i (make-module 31)))
(set-module-kind! custom-i 'interface)
(for-each (lambda (sel-spec)
(let* ((direct? (symbol? sel-spec))
(orig (if direct?
@ -1657,10 +1657,15 @@
(seen (if direct?
sel-spec
(cdr sel-spec))))
(module-add! partial-i (rename seen)
(module-variable module orig))))
(module-add! custom-i (rename seen)
(or (module-local-variable module orig)
(error
;; fixme: format manually for now
(simple-format
#f "no binding `~A' in module ~A"
orig name))))))
selection)
partial-i))))))
custom-i))))
(define (symbol-prefix-proc prefix)
(lambda (symbol)