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

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

@ -1326,7 +1326,7 @@
(set-module-obarray! m (%get-pre-modules-obarray)) (set-module-obarray! m (%get-pre-modules-obarray))
m)) m))
;; make-scm-module ;; make-scm-module
;; The root interface is a module that uses the same obarray as the ;; The root interface is a module that uses the same obarray as the
;; root module. It does not allow new definitions, tho. ;; root module. It does not allow new definitions, tho.
@ -1626,41 +1626,46 @@
;; 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) (if simple?
(beautify-user-module! module) public-i
(set! public-i (module-public-interface module)))) (let ((selection (cond ((memq ':select spec) => cadr)
(if simple? (else (module-map (lambda (sym var) sym)
public-i public-i))))
(let ((selection (cond ((memq ':select spec) => cadr) (rename (cond ((memq ':rename spec)
(else (module-map (lambda (sym var) sym) => (lambda (x)
public-i)))) ;; fixme:ttn -- move to macroexpansion time
(rename (cond ((memq ':rename spec) (eval (cadr x) (current-module))))
=> (lambda (x) (else identity)))
(eval (cadr x) (current-module)))) (custom-i (make-module 31)))
(else identity))) (set-module-kind! custom-i 'interface)
(partial-i (make-module 31))) (for-each (lambda (sel-spec)
(set-module-kind! partial-i 'interface) (let* ((direct? (symbol? sel-spec))
(for-each (lambda (sel-spec) (orig (if direct?
(let* ((direct? (symbol? sel-spec)) sel-spec
(orig (if direct? (car sel-spec)))
sel-spec (seen (if direct?
(car sel-spec))) sel-spec
(seen (if direct? (cdr sel-spec))))
sel-spec (module-add! custom-i (rename seen)
(cdr sel-spec)))) (or (module-local-variable module orig)
(module-add! partial-i (rename seen) (error
(module-variable module orig)))) ;; fixme: format manually for now
selection) (simple-format
partial-i)))))) #f "no binding `~A' in module ~A"
orig name))))))
selection)
custom-i))))
(define (symbol-prefix-proc prefix) (define (symbol-prefix-proc prefix)
(lambda (symbol) (lambda (symbol)