#| -*-Scheme-*-
-$Id: redpkg.scm,v 1.6 1995/01/05 20:21:16 cph Exp $
+$Id: redpkg.scm,v 1.7 1995/01/06 00:14:12 cph Exp $
Copyright (c) 1988-95 Massachusetts Institute of Technology
(pathname-new-type (merge-pathnames pathname
model-pathname)
"glo")))
- (handle-old-pathname-type pathname "glob")
(if (file-exists? pathname)
(let ((contents (fasload pathname)))
(cond ((check-list contents symbol?)
(define (cache-file-analyses! pmodel)
(let ((pathname (pathname-new-type (pmodel/pathname pmodel) "fre")))
- (handle-old-pathname-type pathname "free")
(let ((result
(let ((caches (if (file-exists? pathname) (fasload pathname) '())))
(append-map! (lambda (package)
(define (check-list items predicate)
(and (list? items)
(for-all? items predicate)))
-
-(define (handle-old-pathname-type pathname type)
- (let ((old (pathname-new-type pathname type)))
- (if (file-exists? old)
- (if (file-exists? pathname)
- (delete-file old)
- (rename-file old pathname)))))
\f
;;;; Packages
#| -*-Scheme-*-
-$Id: toplev.scm,v 1.7 1995/01/05 20:21:50 cph Exp $
+$Id: toplev.scm,v 1.8 1995/01/06 00:13:50 cph Exp $
Copyright (c) 1988-95 Massachusetts Institute of Technology
(write-globals pathname pmodel)
(write-constructor pathname pmodel)
(write-loader pathname pmodel))))
-\f
+
(define (write-constructor pathname pmodel)
(let ((constructor (construct-constructor pmodel)))
(with-output-to-file (pathname-new-type pathname "con")
loader)))))
(define (write-cref pathname pmodel)
- (let ((old (pathname-new-type pathname "cref")))
- (if (file-exists? old)
- (delete-file old)))
(with-output-to-file (pathname-new-type pathname "crf")
(lambda ()
(format-packages pmodel))))
(define (write-cref-unusual pathname pmodel)
- (let ((old (pathname-new-type pathname "cref")))
- (if (file-exists? old)
- (delete-file old)))
(with-output-to-file (pathname-new-type pathname "crf")
(lambda ()
(format-packages-unusual pmodel))))
(define (write-globals pathname pmodel)
- (let ((old (pathname-new-type pathname "glob")))
- (if (file-exists? old)
- (delete-file old)))
(fasdump (map (lambda (package)
(cons (package/name package)
(map binding/name