From a1e05d5bb412a2992250907224e350e378dda792 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 12 Jun 1997 04:37:55 +0000
Subject: [PATCH] Move COMPILE-FILE into the compiler proper.
---
v7/src/sos/compile.scm | 65 +-----------------------------------------
1 file changed, 1 insertion(+), 64 deletions(-)
diff --git a/v7/src/sos/compile.scm b/v7/src/sos/compile.scm
index e71f05496..2b7a1420f 100644
--- 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")
--
2.25.1