]> birchwood-abbey.net Git - mit-scheme.git/commitdiff
Fix compilation errors.
authorChris Hanson <org/chris-hanson/cph>
Mon, 15 Nov 2021 02:21:26 +0000 (18:21 -0800)
committerChris Hanson <org/chris-hanson/cph>
Mon, 15 Nov 2021 02:21:26 +0000 (18:21 -0800)
src/runtime/library-ixports-mit.scm
src/runtime/library-ixports-r7rs.scm
src/runtime/library-ixports.scm
src/runtime/library-loader.scm

index bb6d2da8fecc0393a4c0ad303b8e3c50902266f3..cbb7225a0c9d45666e5164444814ca5c616d06f5 100644 (file)
@@ -86,16 +86,16 @@ USA.
                                         (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
@@ -192,14 +192,14 @@ USA.
       (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)
@@ -208,7 +208,7 @@ USA.
          ((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)
@@ -237,14 +237,15 @@ USA.
       (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))
index b6101b3d2eb23c52fe4ad9025182b59068c557ef..943ad58ca0c2f5dcca6ce70d535edc82aca4c4f8 100644 (file)
@@ -41,13 +41,12 @@ USA.
                       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)
@@ -61,7 +60,7 @@ USA.
                                    to))
                      imports)))
              imports
-             (get-exports import-set db))
+             (get-exports import-set db importing-library))
        (case (car import-set)
          ((only)
           (loop (cadr import-set)
index 018e0fbd48b7080b6a10aa59cccdbce52f97258b..459afc1b380db9b474f95317c4e258ae951754e9 100644 (file)
@@ -204,7 +204,7 @@ USA.
                                   (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))
@@ -251,4 +251,8 @@ USA.
                    (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
index b51bd259396c2e2ea4ea5ac997a4c27c8cd3a540..7f7d179c1eadc461d8ce2d18449a12ca25664538 100644 (file)
@@ -46,7 +46,7 @@ USA.
 (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)
@@ -112,8 +112,10 @@ USA.
   (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 () '()))))