From f6e93c9c35a1fcd5ba70004d03f76ac43c7250d2 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 30 Jun 1987 21:48:06 +0000 Subject: [PATCH] Change `sf' so that it does sticky filename defaulting when given multiple filenames. --- v7/src/sf/make.scm | 4 ++-- v7/src/sf/toplev.scm | 56 +++++++++++++++++++------------------------- v8/src/sf/make.scm | 4 ++-- v8/src/sf/toplev.scm | 56 +++++++++++++++++++------------------------- 4 files changed, 52 insertions(+), 68 deletions(-) diff --git a/v7/src/sf/make.scm b/v7/src/sf/make.scm index 6be9d8ef5..1d649eec9 100644 --- a/v7/src/sf/make.scm +++ b/v7/src/sf/make.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/make.scm,v 3.9 1987/06/05 21:36:53 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/make.scm,v 3.10 1987/06/30 21:48:06 cph Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -60,7 +60,7 @@ MIT in each case. |# (make-environment (define :name "SF") (define :version 3) - (define :modification 9) + (define :modification 10) (define :files) (define :files-lists diff --git a/v7/src/sf/toplev.scm b/v7/src/sf/toplev.scm index d5ebe017a..35e60e582 100644 --- a/v7/src/sf/toplev.scm +++ b/v7/src/sf/toplev.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/toplev.scm,v 3.3 1987/05/09 23:22:58 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/toplev.scm,v 3.4 1987/06/30 21:45:39 cph Rel $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -117,37 +117,29 @@ Currently only the 68000 implementation needs this." (define sf/unfasl-pathname-type "unf") (define (syntax-file input-string bin-string spec-string) - (let ((eval-sf-expression - (lambda (input-string) - (let ((input-path - (pathname->input-truename - (merge-pathnames (->pathname input-string) - sf/default-input-pathname)))) - (if (not input-path) - (error "SF: File does not exist" input-string)) - (let ((bin-path - (let ((bin-path - (pathname-new-type input-path - sf/output-pathname-type))) - (if bin-string - (merge-pathnames (->pathname bin-string) bin-path) - bin-path)))) - (let ((spec-path - (and (or spec-string sfu?) - (let ((spec-path - (pathname-new-type bin-path - sf/unfasl-pathname-type))) - (if spec-string - (merge-pathnames (->pathname spec-string) - spec-path) - spec-path))))) - (syntax-file* input-path bin-path spec-path))))))) - (if (list? input-string) - (for-each (lambda (input-string) - (eval-sf-expression input-string)) - input-string) - (eval-sf-expression input-string))) - *the-non-printing-object*) + (for-each + (lambda (pathname) + (let ((input-path (pathname->input-truename pathname))) + (if (not input-path) + (error "SF: File does not exist" pathname)) + (let ((bin-path + (let ((bin-path + (pathname-new-type input-path + sf/output-pathname-type))) + (if bin-string + (merge-pathnames (->pathname bin-string) bin-path) + bin-path)))) + (let ((spec-path + (and (or spec-string sfu?) + (let ((spec-path + (pathname-new-type bin-path + sf/unfasl-pathname-type))) + (if spec-string + (merge-pathnames (->pathname spec-string) + spec-path) + spec-path))))) + (syntax-file* input-path bin-path spec-path))))) + (stickify-input-filenames input-string sf/default-input-pathname))) (define (syntax-file* input-pathname bin-pathname spec-pathname) (let ((start-date (date)) diff --git a/v8/src/sf/make.scm b/v8/src/sf/make.scm index 2d69c630d..489177a2c 100644 --- a/v8/src/sf/make.scm +++ b/v8/src/sf/make.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/sf/make.scm,v 3.9 1987/06/05 21:36:53 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/sf/make.scm,v 3.10 1987/06/30 21:48:06 cph Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -60,7 +60,7 @@ MIT in each case. |# (make-environment (define :name "SF") (define :version 3) - (define :modification 9) + (define :modification 10) (define :files) (define :files-lists diff --git a/v8/src/sf/toplev.scm b/v8/src/sf/toplev.scm index 0a99c88a6..12726580c 100644 --- a/v8/src/sf/toplev.scm +++ b/v8/src/sf/toplev.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/sf/toplev.scm,v 3.3 1987/05/09 23:22:58 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/sf/toplev.scm,v 3.4 1987/06/30 21:45:39 cph Rel $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -117,37 +117,29 @@ Currently only the 68000 implementation needs this." (define sf/unfasl-pathname-type "unf") (define (syntax-file input-string bin-string spec-string) - (let ((eval-sf-expression - (lambda (input-string) - (let ((input-path - (pathname->input-truename - (merge-pathnames (->pathname input-string) - sf/default-input-pathname)))) - (if (not input-path) - (error "SF: File does not exist" input-string)) - (let ((bin-path - (let ((bin-path - (pathname-new-type input-path - sf/output-pathname-type))) - (if bin-string - (merge-pathnames (->pathname bin-string) bin-path) - bin-path)))) - (let ((spec-path - (and (or spec-string sfu?) - (let ((spec-path - (pathname-new-type bin-path - sf/unfasl-pathname-type))) - (if spec-string - (merge-pathnames (->pathname spec-string) - spec-path) - spec-path))))) - (syntax-file* input-path bin-path spec-path))))))) - (if (list? input-string) - (for-each (lambda (input-string) - (eval-sf-expression input-string)) - input-string) - (eval-sf-expression input-string))) - *the-non-printing-object*) + (for-each + (lambda (pathname) + (let ((input-path (pathname->input-truename pathname))) + (if (not input-path) + (error "SF: File does not exist" pathname)) + (let ((bin-path + (let ((bin-path + (pathname-new-type input-path + sf/output-pathname-type))) + (if bin-string + (merge-pathnames (->pathname bin-string) bin-path) + bin-path)))) + (let ((spec-path + (and (or spec-string sfu?) + (let ((spec-path + (pathname-new-type bin-path + sf/unfasl-pathname-type))) + (if spec-string + (merge-pathnames (->pathname spec-string) + spec-path) + spec-path))))) + (syntax-file* input-path bin-path spec-path))))) + (stickify-input-filenames input-string sf/default-input-pathname))) (define (syntax-file* input-pathname bin-pathname spec-pathname) (let ((start-date (date)) -- 2.25.1