Add COMPILE-FILE incremental file compilation procedure.

diff --git a/v7/src/compiler/base/toplev.scm b/v7/src/compiler/base/toplev.scm
index e4eed7eb68c6563c2bd6b26554a24b47849520a5..62224e0e8c469d40183dce37ae5d0ed5bf9bc2f8 100644 (file)
--- a/v7/src/compiler/base/toplev.scm
+++ b/v7/src/compiler/base/toplev.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: toplev.scm,v 4.52 1993/11/29 19:11:24 gjr Exp $
+$Id: toplev.scm,v 4.53 1997/06/12 04:35:47 cph Exp $
 
-Copyright (c) 1988-1993 Massachusetts Institute of Technology
+Copyright (c) 1988-97 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -37,7 +37,76 @@ MIT in each case. |#
 
 (declare (usual-integrations))
 \f
-;;;; Usual Entry Point: File Compilation
+;;;; Incremental File Compiler
+
+(define compile-file:override-usual-integrations '())
+(define compile-file:sf-only? #f)
+(define compile-file:force? #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 ((doit (lambda () (processor input-file output-file dependencies))))
+    (if compile-file:force?
+       (doit)
+       (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)
+               (doit)))))))
+
+  (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))))))))
+\f
+;;;; Non-Incremental File Compiler
 
 (define (cf input #!optional output)
   (let ((kernel

diff --git a/v7/src/compiler/machines/i386/compiler.pkg b/v7/src/compiler/machines/i386/compiler.pkg
index 08c4622bfa56409cacbd8a83b84db0795894ef5a..06a5f20fca76f9f5cbebdab011357ccf19c92d3a 100644 (file)
--- a/v7/src/compiler/machines/i386/compiler.pkg
+++ b/v7/src/compiler/machines/i386/compiler.pkg
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: compiler.pkg,v 1.22 1996/11/10 05:59:09 adams Exp $
+$Id: compiler.pkg,v 1.23 1997/06/12 04:35:59 cph Exp $
 
-Copyright (c) 1992-1994 Massachusetts Institute of Technology
+Copyright (c) 1992-97 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -151,6 +151,10 @@ MIT in each case. |#
          cbf
          cf
          compile-bin-file
+         compile-file
+         compile-file:force?
+         compile-file:override-usual-integrations
+         compile-file:sf-only?
          compile-procedure
          compile-scode
          compiler:reset!

diff --git a/v7/src/compiler/machines/spectrum/compiler.pkg b/v7/src/compiler/machines/spectrum/compiler.pkg
index 15ca7c984e6ffcaaab7fdd6dd9e9ae4caeb97cb3..5b10fe5685bf6606b8597cd37789e7ee698c0502 100644 (file)
--- a/v7/src/compiler/machines/spectrum/compiler.pkg
+++ b/v7/src/compiler/machines/spectrum/compiler.pkg
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: compiler.pkg,v 1.47 1994/01/08 21:18:45 gjr Exp $
+$Id: compiler.pkg,v 1.48 1997/06/12 04:36:08 cph Exp $
 
-Copyright (c) 1988-1994 Massachusetts Institute of Technology
+Copyright (c) 1988-97 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -150,6 +150,10 @@ MIT in each case. |#
          cbf
          cf
          compile-bin-file
+         compile-file
+         compile-file:force?
+         compile-file:override-usual-integrations
+         compile-file:sf-only?
          compile-procedure
          compile-scode
          compiler:dump-bci-file

diff --git a/v8/src/compiler/base/toplev.scm b/v8/src/compiler/base/toplev.scm
index 1c62344080146ffa0dab3e33d587001fbf541f2b..dd65d767bc615b57de516602623f37396dfc1519 100644 (file)
--- a/v8/src/compiler/base/toplev.scm
+++ b/v8/src/compiler/base/toplev.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: toplev.scm,v 1.13 1996/07/26 01:01:44 adams Exp $
+$Id: toplev.scm,v 1.14 1997/06/12 04:36:25 cph Exp $
 
-Copyright (c) 1988-1996 Massachusetts Institute of Technology
+Copyright (c) 1988-97 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -37,7 +37,76 @@ MIT in each case. |#
 
 (declare (usual-integrations))
 \f
-;;;; Usual Entry Point: File Compilation
+;;;; Incremental File Compiler
+
+(define compile-file:override-usual-integrations '())
+(define compile-file:sf-only? #f)
+(define compile-file:force? #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 ((doit (lambda () (processor input-file output-file dependencies))))
+    (if compile-file:force?
+       (doit)
+       (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)
+               (doit)))))))
+
+  (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))))))))
+\f
+;;;; Non-Incremental File Compiler
 
 (define (cf input #!optional output)
   (let ((kernel

diff --git a/v8/src/compiler/machines/i386/compiler.pkg b/v8/src/compiler/machines/i386/compiler.pkg
index a95db9047de3ee4044e4b6529b67be776289dd2c..1fc89b41e1e7da95cede59d3e9e213a4857e352d 100644 (file)
--- a/v8/src/compiler/machines/i386/compiler.pkg
+++ b/v8/src/compiler/machines/i386/compiler.pkg
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: compiler.pkg,v 1.3 1995/10/25 19:49:37 ssmith Exp $
+$Id: compiler.pkg,v 1.4 1997/06/12 04:36:20 cph Exp $
 
-Copyright (c) 1988-1995 Massachusetts Institute of Technology
+Copyright (c) 1988-97 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -139,6 +139,10 @@ MIT in each case. |#
          cf
          compile-bin-file
          compile-expression
+         compile-file
+         compile-file:force?
+         compile-file:override-usual-integrations
+         compile-file:sf-only?
          compile-procedure
          compile-scode
          compiler:dump-bci-file

diff --git a/v8/src/compiler/machines/spectrum/compiler.pkg b/v8/src/compiler/machines/spectrum/compiler.pkg
index 46d6679754a90b345e65da50ab12d95e20aa2fee..0dd98fc70dfe2d5862dfb7c85569f7f171d891c8 100644 (file)
--- a/v8/src/compiler/machines/spectrum/compiler.pkg
+++ b/v8/src/compiler/machines/spectrum/compiler.pkg
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: compiler.pkg,v 1.18 1996/07/30 19:29:48 adams Exp $
+$Id: compiler.pkg,v 1.19 1997/06/12 04:36:16 cph Exp $
 
-Copyright (c) 1988-1995 Massachusetts Institute of Technology
+Copyright (c) 1988-97 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -141,6 +141,10 @@ MIT in each case. |#
          cf
          compile-bin-file
          compile-expression
+         compile-file
+         compile-file:force?
+         compile-file:override-usual-integrations
+         compile-file:sf-only?
          compile-procedure
          compile-scode
          compiler:dump-bci-file