mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-03 05:20:16 +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, ;; returned interface has no bindings. If the `:select' clause is omitted,
;; RENAMER operates on the used module's public interface. ;; 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) (define (resolve-interface spec)
(let* ((simple? (not (pair? (car spec)))) (let* ((simple? (not (pair? (car spec))))
(name (if simple? spec (car spec))) (name (if simple? spec (car spec)))
(module (resolve-module name))) (module (resolve-module name))
(if (not module) (public-i (and module (module-public-interface module))))
(error "no code for module" name) (and (or (not module) (not public-i))
(let ((public-i (module-public-interface module))) (error "no code for module" name))
(cond ((not public-i)
(beautify-user-module! module)
(set! public-i (module-public-interface module))))
(if simple? (if simple?
public-i public-i
(let ((selection (cond ((memq ':select spec) => cadr) (let ((selection (cond ((memq ':select spec) => cadr)
@ -1645,10 +1644,11 @@
public-i)))) public-i))))
(rename (cond ((memq ':rename spec) (rename (cond ((memq ':rename spec)
=> (lambda (x) => (lambda (x)
;; fixme:ttn -- move to macroexpansion time
(eval (cadr x) (current-module)))) (eval (cadr x) (current-module))))
(else identity))) (else identity)))
(partial-i (make-module 31))) (custom-i (make-module 31)))
(set-module-kind! partial-i 'interface) (set-module-kind! custom-i 'interface)
(for-each (lambda (sel-spec) (for-each (lambda (sel-spec)
(let* ((direct? (symbol? sel-spec)) (let* ((direct? (symbol? sel-spec))
(orig (if direct? (orig (if direct?
@ -1657,10 +1657,15 @@
(seen (if direct? (seen (if direct?
sel-spec sel-spec
(cdr sel-spec)))) (cdr sel-spec))))
(module-add! partial-i (rename seen) (module-add! custom-i (rename seen)
(module-variable module orig)))) (or (module-local-variable module orig)
(error
;; fixme: format manually for now
(simple-format
#f "no binding `~A' in module ~A"
orig name))))))
selection) selection)
partial-i)))))) custom-i))))
(define (symbol-prefix-proc prefix) (define (symbol-prefix-proc prefix)
(lambda (symbol) (lambda (symbol)