mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-20 02:30:23 +02:00
Code Activity

(resolve-interface, use-srfis): Small cleanup; nfc.

Browse source 
(process-define-module): Internal proc `unrecognized'
now accepts arg; update callers.
Reverse order of interfaces added to module to be
consistent with that specified in `define-module' form.
This commit is contained in:
Thien-Thi Nguyen 2001-05-18 17:28:03 +00:00
parent 58e5b91086
commit f8a502cb72
1 changed files with 24 additions and 33 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1603,11 +1603,6 @@
(eq? (car (last-pair use-list)) the-scm-module)) (eq? (car (last-pair use-list)) the-scm-module))
(set-module-uses! module (reverse (cdr (reverse use-list))))))) (set-module-uses! module (reverse (cdr (reverse use-list)))))))
(define (resolve-interface name)
(let ((module (resolve-module name)))
(and module (module-public-interface module))))
;; Return a module interface made from SPEC. ;; Return a module interface made from SPEC.
;; SPEC can be a list of symbols, in which case it names a module ;; SPEC can be a list of symbols, in which case it names a module
;; whose public interface is found and returned. ;; whose public interface is found and returned.
@ -1616,8 +1611,8 @@
;; (MODULE-NAME [:select SELECTION] [:rename RENAMER]) ;; (MODULE-NAME [:select SELECTION] [:rename RENAMER])
;; in which case a partial interface is newly created and returned. ;; in which case a partial interface is newly created and returned.
;; MODULE-NAME is a list of symbols, as above; SELECTION is a list of ;; MODULE-NAME is a list of symbols, as above; SELECTION is a list of
;; selection-specs to be imported; and RENAMER is a procedure that takes a ;; binding-specs to be imported; and RENAMER is a procedure that takes a
;; symbol and returns its new name. A selection-spec is either a symbol or a ;; symbol and returns its new name. A binding-spec is either a symbol or a
;; pair of symbols (ORIG . SEEN), where ORIG is the name in the used module ;; pair of symbols (ORIG . SEEN), where ORIG is the name in the used module
;; and SEEN is the name in the using module. Note that SEEN is also passed ;; and SEEN is the name in the using module. Note that SEEN is also passed
;; through RENAMER. ;; through RENAMER.
@ -1649,14 +1644,10 @@
(else identity))) (else identity)))
(custom-i (make-module 31))) (custom-i (make-module 31)))
(set-module-kind! custom-i 'interface) (set-module-kind! custom-i 'interface)
(for-each (lambda (sel-spec) (for-each (lambda (bspec)
(let* ((direct? (symbol? sel-spec)) (let* ((direct? (symbol? bspec))
(orig (if direct? (orig (if direct? bspec (car bspec)))
sel-spec (seen (if direct? bspec (cdr bspec))))
(car sel-spec)))
(seen (if direct?
sel-spec
(cdr sel-spec))))
(module-add! custom-i (rename seen) (module-add! custom-i (rename seen)
(or (module-local-variable module orig) (or (module-local-variable module orig)
(error (error
@ -1672,11 +1663,11 @@
(symbol-append prefix symbol))) (symbol-append prefix symbol)))
(define (process-define-module args) (define (process-define-module args)
(let* ((module-id (car args)) (let* ((module-id (car args))
(module (resolve-module module-id #f)) (module (resolve-module module-id #f))
(kws (cdr args)) (kws (cdr args))
(unrecognized (lambda () (unrecognized (lambda (arg)
(error "unrecognized define-module argument" kws)))) (error "unrecognized define-module argument" arg))))
(beautify-user-module! module) (beautify-user-module! module)
(let loop ((kws kws) (let loop ((kws kws)
(reversed-interfaces '()) (reversed-interfaces '())
@ -1685,7 +1676,7 @@
(begin (begin
(for-each (lambda (interface) (for-each (lambda (interface)
(module-use! module interface)) (module-use! module interface))
reversed-interfaces) (reverse reversed-interfaces))
(module-export! module exports)) (module-export! module exports))
(let ((keyword (if (keyword? (car kws)) (let ((keyword (if (keyword? (car kws))
(keyword->symbol (car kws)) (keyword->symbol (car kws))
@ -1696,7 +1687,7 @@
(case keyword (case keyword
((use-module use-syntax) ((use-module use-syntax)
(or (pair? (cdr kws)) (or (pair? (cdr kws))
(unrecognized)) (unrecognized kws))
(let* ((spec (cadr kws)) (let* ((spec (cadr kws))
(interface (resolve-interface spec))) (interface (resolve-interface spec)))
(and (eq? keyword 'use-syntax) (and (eq? keyword 'use-syntax)
@ -1712,7 +1703,7 @@
exports))) exports)))
((autoload) ((autoload)
(or (and (pair? (cdr kws)) (pair? (cddr kws))) (or (and (pair? (cdr kws)) (pair? (cddr kws)))
(unrecognized)) (unrecognized kws))
(loop (cdddr kws) (loop (cdddr kws)
(cons (make-autoload-interface module (cons (make-autoload-interface module
(cadr kws) (cadr kws)
@ -1727,12 +1718,12 @@
(loop (cdr kws) reversed-interfaces exports)) (loop (cdr kws) reversed-interfaces exports))
((export) ((export)
(or (pair? (cdr kws)) (or (pair? (cdr kws))
(unrecognized)) (unrecognized kws))
(loop (cddr kws) (loop (cddr kws)
reversed-interfaces reversed-interfaces
(append (cadr kws) exports))) (append (cadr kws) exports)))
(else (else
(unrecognized)))))) (unrecognized kws))))))
(set-current-module module) (set-current-module module)
module)) module))
@ -2791,14 +2782,14 @@
(define (use-srfis srfis) (define (use-srfis srfis)
(let lp ((s srfis)) (let lp ((s srfis))
(if (pair? s) (if (pair? s)
(let* ((srfi (string->symbol (let* ((srfi (string->symbol
(string-append "srfi-" (number->string (car s))))) (string-append "srfi-" (number->string (car s)))))
(mod (resolve-interface (list 'srfi srfi)))) (mod-i (resolve-interface (list 'srfi srfi))))
(module-use! (current-module) mod) (module-use! (current-module) mod-i)
(set! cond-expand-features (set! cond-expand-features
(append cond-expand-features (list srfi))) (append cond-expand-features (list srfi)))
(lp (cdr s)))))) (lp (cdr s))))))
;;; {Load emacs interface support if emacs option is given.} ;;; {Load emacs interface support if emacs option is given.}