Move COMPILE-FILE into the compiler proper.

diff --git a/v7/src/sos/compile.scm b/v7/src/sos/compile.scm
index e71f05496e0788a85adaa13cf3e1e8a04bd13bb0..2b7a1420f439572f76d47d79d9820697087e4d73 100644 (file)
--- a/v7/src/sos/compile.scm
+++ b/v7/src/sos/compile.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: compile.scm,v 1.1 1997/06/04 06:08:30 cph Exp $
+;;; $Id: compile.scm,v 1.2 1997/06/12 04:37:55 cph Exp $
 ;;;
 ;;; Copyright (c) 1995-97 Massachusetts Institute of Technology
 ;;;
@@ -35,69 +35,6 @@
 
 (load-option 'CREF)
 
-(define compile-file-override-usual-integrations '())
-(define compile-file-sf-only? #f)
-(define compile-file)
-(let ((scm-pathname (lambda (path) (pathname-new-type path "scm")))
-      (bin-pathname (lambda (path) (pathname-new-type path "bin")))
-      (ext-pathname (lambda (path) (pathname-new-type path "ext")))
-      (com-pathname (lambda (path) (pathname-new-type path "com"))))
-
-  (define (process-file input-file output-file dependencies processor)
-    (let ((reasons
-          (let ((output-time (file-modification-time output-file)))
-            (if (not output-time)
-                (list input-file)
-                (list-transform-positive (cons input-file dependencies)
-                  (lambda (dependency)
-                    (let ((dep-time (file-modification-time dependency)))
-                      (if dep-time
-                          (> dep-time output-time)
-                          (begin
-                            (warn "Missing dependency:"
-                                  (->namestring dependency))
-                            #f)))))))))
-      (if (not (null? reasons))
-         (begin
-           (newline)
-           (write-string ";Generating ")
-           (write (->namestring output-file))
-           (write-string " because of:")
-           (for-each (lambda (reason)
-                       (write-char #\space)
-                       (write (->namestring reason)))
-                     reasons)
-           (processor input-file output-file dependencies)))))
-
-  (set! compile-file
-       (named-lambda (compile-file file #!optional dependencies syntax-table)
-         (process-file (scm-pathname file)
-                       (bin-pathname file)
-                       (map ext-pathname
-                            (if (default-object? dependencies)
-                                '()
-                                dependencies))
-           (lambda (input-file output-file dependencies)
-             (fluid-let ((sf/default-syntax-table
-                          (if (default-object? syntax-table)
-                              #f
-                              syntax-table))
-                         (sf/default-declarations
-                          `((USUAL-INTEGRATIONS
-                             ,@compile-file-override-usual-integrations)
-                            ,@(if (null? dependencies)
-                                  '()
-                                  `((INTEGRATE-EXTERNAL ,@dependencies))))))
-               (sf input-file output-file))))
-         (if (not compile-file-sf-only?)
-             (process-file (bin-pathname file)
-                           (com-pathname file)
-                           '()
-               (lambda (input-file output-file dependencies)
-                 dependencies
-                 (fluid-let ((compiler:coalescing-constant-warnings? #f))
-                   (compile-bin-file input-file output-file))))))))
-
 (with-working-directory-pathname (directory-pathname (current-load-pathname))
   (lambda ()
     (compile-file "class")