(library-ixport-to export))
imports))
imports
- (get-exports import-set db))
+ (get-exports import-set db library))
(case (car import-set)
((drop)
- (expand-exclusions (get-exports (cadr import-set) db)
+ (expand-exclusions (get-exports (cadr import-set) db library)
(cddr import-set)
db
library
imports))
((take)
- (expand-inclusions (get-exports (cadr import-set) db)
+ (expand-inclusions (get-exports (cadr import-set) db library)
(cddr import-set)
db
library
(let ((nss
(apply nss-union
(map (lambda (nameset)
- (expand-nameset nameset lookup db))
+ (expand-nameset nameset lookup library db))
namesets))))
(check-for-missing-names (explicit-names nss)
available-names
ixclusions)
(make-matcher (append (explicit-names nss) (implicit-names nss)))))))
-(define (expand-nameset nameset lookup db)
+(define (expand-nameset nameset lookup library db)
(let loop ((nameset nameset))
(if (symbol? nameset)
(or (lookup nameset)
((exports)
(make-nss '()
(map library-ixport-to
- (get-exports (cadr nameset) db))))
+ (get-exports (cadr nameset) db library))))
((intersection)
(apply nss-intersection (map loop (cdr nameset))))
((union)
(and p
(cdr p)))))
-(define-automatic-property 'mit-defines '(parsed-defines db)
+(define-automatic-property 'mit-defines '(parsed-defines db library)
#f
- (lambda (parsed-defines db)
+ (lambda (parsed-defines db library)
(fold (lambda (def defs)
(if (eq? 'mit-define (car def))
(cons (cons (cadr def)
(expand-nameset (caddr def)
(make-lookup defs)
+ library
db))
defs)
defs))
libraries))
(define (r7rs-expand-parsed-import parsed-import db library imports)
- (declare (ignore library))
(fold (lambda (import-set imports)
- (expand-import-set import-set db imports))
+ (expand-import-set import-set db imports library))
imports
(cdr parsed-import)))
-(define (expand-import-set import-set db imports)
+(define (expand-import-set import-set db imports importing-library)
(let loop ((import-set import-set) (filter (lambda (name) name)))
(if (library-name? import-set)
(fold (lambda (export imports)
to))
imports)))
imports
- (get-exports import-set db))
+ (get-exports import-set db importing-library))
(case (car import-set)
((only)
(loop (cadr import-set)
(export-group-exports private))))
private))))
-(define (map-re-exports exports)
+(define (map-re-exports exports imports)
(map (lambda (export)
;; If this is a re-export, export directly from the source.
(let* ((export-from (library-ixport-from export))
(pair? (cddr p)))
(hash-table->alist table))
(lambda (a b)
- (symbol<? (car a) (car b))))))
\ No newline at end of file
+ (symbol<? (car a) (car b))))))
+
+(define (get-exports library db importing-library)
+ (library-exports (registered-library library db)
+ (and importing-library (library-name importing-library))))
\ No newline at end of file
(define-automatic-property 'imports-used
'(imports export-groups free-names bound-names name)
#f
- (lambda (imports export-groups free-names bound-names)
+ (lambda (imports groups free-names bound-names)
(let ((imports-to
(lset-difference eq?
(map library-ixport-to imports)
(let ((grouped
(let ((table (make-strong-eq-hash-table)))
(for-each (lambda (import)
- (let-values (((senv sname)
- (library-import-source import db)))
+ (let-values
+ (((senv sname)
+ (library-import-source import db
+ importing-library-name)))
(hash-table-update! table (library-ixport-to import)
(lambda (sources) (cons (cons senv sname) sources))
(lambda () '()))))