From: Chris Hanson Date: Thu, 12 Jun 1997 04:36:25 +0000 (+0000) Subject: Add COMPILE-FILE incremental file compilation procedure. X-Git-Tag: 20090517-FFI~5145 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=99c09ea47be72b29b45b3a12f7125b0374a8e6c6;p=mit-scheme.git Add COMPILE-FILE incremental file compilation procedure. --- diff --git a/v7/src/compiler/base/toplev.scm b/v7/src/compiler/base/toplev.scm index e4eed7eb6..62224e0e8 100644 --- 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)) -;;;; 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)))))))) + +;;;; 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 08c4622bf..06a5f20fc 100644 --- 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 15ca7c984..5b10fe568 100644 --- 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 1c6234408..dd65d767b 100644 --- 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)) -;;;; 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)))))))) + +;;;; 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 a95db9047..1fc89b41e 100644 --- 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 46d667975..0dd98fc70 100644 --- 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