From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 20 Jul 1988 07:35:52 +0000 (+0000)
Subject: Add new operation `sc' for running `sf' on compiler files.
X-Git-Tag: 20090517-FFI~12643
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=cee9c8c3eefb7c57ed2203eba1bdb78a16fe0cdd;p=mit-scheme.git

Add new operation `sc' for running `sf' on compiler files.
---

diff --git a/v7/src/compiler/machines/bobcat/compiler.pkg b/v7/src/compiler/machines/bobcat/compiler.pkg
index 112f7e16b..b254be107 100644
--- a/v7/src/compiler/machines/bobcat/compiler.pkg
+++ b/v7/src/compiler/machines/bobcat/compiler.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/compiler.pkg,v 1.3 1988/07/19 18:22:41 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/compiler.pkg,v 1.4 1988/07/20 07:35:36 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -95,6 +95,8 @@ MIT in each case. |#
 (define-package (compiler declarations)
   (files "machines/bobcat/decls")
   (parent (compiler))
+  (export (compiler)
+	  sc)
   (import (scode-optimizer top-level)
 	  sf/internal
 	  sf/pathname-defaulting)
diff --git a/v7/src/compiler/machines/bobcat/decls.scm b/v7/src/compiler/machines/bobcat/decls.scm
index e7762fcb6..9b55a0156 100644
--- a/v7/src/compiler/machines/bobcat/decls.scm
+++ b/v7/src/compiler/machines/bobcat/decls.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/decls.scm,v 4.5 1988/06/14 08:55:55 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/decls.scm,v 4.6 1988/07/20 07:35:52 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -210,29 +210,35 @@ MIT in each case. |#
 			   (set-source-node/modification-time! node false))
 			 (source-node/dependents node))))
 	 source-nodes)))
-  (for-each source-node/syntax! source-nodes/circular-dependencies)
-  (for-each source-node/syntax! source-nodes/by-rank))
+  (for-each source-node/maybe-syntax! source-nodes/circular-dependencies)
+  (for-each source-node/maybe-syntax! source-nodes/by-rank))
 
-(define (source-node/syntax! node)
+(define (source-node/maybe-syntax! node)
   (if (not (source-node/modification-time node))
-      (with-values
-	  (lambda ()
-	    (sf/pathname-defaulting (source-node/pathname node) "" false))
-	(lambda (input-pathname bin-pathname spec-pathname)
-	  (sf/internal
-	   input-pathname bin-pathname spec-pathname
-	   (source-node/syntax-table node)
-	   ((if compiler:enable-integration-declarations?
-		identity-procedure
-		(lambda (declarations)
-		  (list-transform-negative declarations
-		    integration-declaration?)))
-	    ((if compiler:enable-expansion-declarations?
-		 identity-procedure
-		 (lambda (declarations)
-		   (list-transform-negative declarations
-		     expansion-declaration?)))
-	     (source-node/declarations node))))))))
+      (source-node/syntax! node)))
+
+(define (sc filename)
+  (source-node/syntax! (filename->source-node filename)))
+
+(define (source-node/syntax! node)
+  (with-values
+      (lambda ()
+	(sf/pathname-defaulting (source-node/pathname node) "" false))
+    (lambda (input-pathname bin-pathname spec-pathname)
+      (sf/internal
+       input-pathname bin-pathname spec-pathname
+       (source-node/syntax-table node)
+       ((if compiler:enable-integration-declarations?
+	    identity-procedure
+	    (lambda (declarations)
+	      (list-transform-negative declarations
+		integration-declaration?)))
+	((if compiler:enable-expansion-declarations?
+	     identity-procedure
+	     (lambda (declarations)
+	       (list-transform-negative declarations
+		 expansion-declaration?)))
+	 (source-node/declarations node)))))))
 
 (define-integrable (modification-time node type)
   (file-modification-time