Eliminate use of ".glo" files; ".pkd" files have all the information
authorChris Hanson <org/chris-hanson/cph>
Thu, 16 Aug 2001 20:50:26 +0000 (20:50 +0000)
committerChris Hanson <org/chris-hanson/cph>
Thu, 16 Aug 2001 20:50:26 +0000 (20:50 +0000)
needed.

v7/src/cref/redpkg.scm
v7/src/cref/toplev.scm

index 3cd14dd471ec994b85ee70d956ad27b369e8b99e..29c9924fe442f33422283059f4fb359aefd58aaa 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: redpkg.scm,v 1.14 2001/08/16 20:46:11 cph Exp $
+$Id: redpkg.scm,v 1.15 2001/08/16 20:50:26 cph Exp $
 
 Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
@@ -48,10 +48,10 @@ USA.
                             (begin
                               (warn "Malformed package-description file:"
                                     pathname)
-                              '())))
+                              #f)))
                       (begin
                         (warn "Can't find package-description file:" pathname)
-                        '())))))
+                        #f)))))
              globals)
         model-pathname)))))
 
@@ -408,9 +408,10 @@ USA.
                           (error "Unknown package name:" name)))))))
        ;; GLOBALS is a list of the bindings supplied externally.
        (for-each (lambda (global)
-                   (process-globals-info (cdr global)
-                                         (->namestring (car global))
-                                         get-package))
+                   (if (cdr global)
+                       (process-globals-info (cdr global)
+                                             (->namestring (car global))
+                                             get-package)))
                  globals)
        (for-each
         (lambda (package description)
index 3c89ca84ff47b5bc628132dce3411f5c315fed8c..c4500bd17c9fdee34e1a8fa53140440a3dcfeccf 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: toplev.scm,v 1.14 2001/08/15 02:59:58 cph Exp $
+$Id: toplev.scm,v 1.15 2001/08/16 20:46:15 cph Exp $
 
 Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
@@ -50,14 +50,12 @@ USA.
   (generate/common
    (lambda (pathname pmodel changes?)
      (write-cref-unusual pathname pmodel changes?)
-     (write-globals pathname pmodel changes?)
      (write-external-descriptions pathname pmodel changes?))))
 
 (define cref/generate-all
   (generate/common
    (lambda (pathname pmodel changes?)
      (write-cref pathname pmodel changes?)
-     (write-globals pathname pmodel changes?)
      (write-external-descriptions pathname pmodel changes?))))
 
 (define (write-external-descriptions pathname pmodel changes?)
@@ -75,49 +73,4 @@ USA.
   (if (or changes? (not (file-processed? pathname "pkg" "crf")))
       (with-output-to-file (pathname-new-type pathname "crf")
        (lambda ()
-         (format-packages-unusual pmodel)))))
-\f
-(define (write-globals pathname pmodel changes?)
-  (if (or changes? (not (file-processed? pathname "pkg" "glo")))
-      (let ((package-bindings
-            (map (lambda (package)
-                   (cons package
-                         (list-transform-positive
-                             (package/sorted-bindings package)
-                           binding/source-binding)))
-                 (pmodel/packages pmodel)))
-           (exports '()))
-       (for-each (lambda (entry)
-                   (for-each (lambda (binding)
-                               (for-each (lambda (link)
-                                           (set! exports
-                                                 (cons (link/destination link)
-                                                       exports))
-                                           unspecific)
-                                         (binding/links binding)))
-                             (cdr entry)))
-                 package-bindings)
-       (for-each (lambda (binding)
-                   (let ((package (binding/package binding)))
-                     (let ((entry (assq package package-bindings)))
-                       (if entry
-                           (set-cdr! entry (cons binding (cdr entry)))
-                           (begin
-                             (set! package-bindings
-                                   (cons (list package binding)
-                                         package-bindings))
-                             unspecific)))))
-                 exports)
-       (fasdump (cons '(VERSION . 2)
-                      (map (lambda (entry)
-                             (vector (package/name (car entry))
-                                     (let loop ((package (car entry)))
-                                       (let ((parent
-                                              (package/parent package)))
-                                         (if parent
-                                             (cons (package/name parent)
-                                                   (loop parent))
-                                             '())))
-                                     (map binding/name (cdr entry))))
-                           package-bindings))
-                (pathname-new-type pathname "glo")))))
\ No newline at end of file
+         (format-packages-unusual pmodel)))))
\ No newline at end of file