From b4bf0afd8794bcdd50cab853d451ad73fce61f5e Mon Sep 17 00:00:00 2001 From: Stephen Adams Date: Tue, 15 Jul 1997 17:54:48 +0000 Subject: [PATCH] Small changes to allow butils.scm to be shared between 7.4 and 8.0 --- v7/src/sf/toplev.scm | 8 +++++--- v8/src/sf/toplev.scm | 22 ++++++++++++++++++---- 2 files changed, 23 insertions(+), 7 deletions(-) diff --git a/v7/src/sf/toplev.scm b/v7/src/sf/toplev.scm index 3b7f6edfc..f5467c3aa 100644 --- a/v7/src/sf/toplev.scm +++ b/v7/src/sf/toplev.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: toplev.scm,v 4.13 1995/01/06 18:36:24 cph Exp $ +$Id: toplev.scm,v 4.14 1997/07/15 17:54:38 adams Exp $ -Copyright (c) 1988-95 Massachusetts Institute of Technology +Copyright (c) 1988-1997 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -39,6 +39,8 @@ MIT in each case. |# ;;;; User Interface +(define bin-pathname-type "bin") + (define (integrate/procedure procedure declarations) (procedure-components procedure (lambda (*lambda environment) @@ -169,7 +171,7 @@ MIT in each case. |# (if (> (string-length input-type) 2) (string-head input-type 2) input-type)) - "bin"))))) + bin-pathname-type))))) (if bin-string (merge-pathnames bin-string bin-path) bin-path)) diff --git a/v8/src/sf/toplev.scm b/v8/src/sf/toplev.scm index 3b7f6edfc..06cead5a1 100644 --- a/v8/src/sf/toplev.scm +++ b/v8/src/sf/toplev.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: toplev.scm,v 4.13 1995/01/06 18:36:24 cph Exp $ +$Id: toplev.scm,v 4.14 1997/07/15 17:54:48 adams Exp $ -Copyright (c) 1988-95 Massachusetts Institute of Technology +Copyright (c) 1988-1997 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -39,6 +39,8 @@ MIT in each case. |# ;;;; User Interface +(define bin-pathname-type "bin") + (define (integrate/procedure procedure declarations) (procedure-components procedure (lambda (*lambda environment) @@ -133,6 +135,7 @@ MIT in each case. |# ;;;; File Syntaxer (define (syntax-file input-string bin-string spec-string) + (perhaps-issue-compatibility-warning) (if (not (or (false? sf/default-syntax-table) (syntax-table? sf/default-syntax-table))) (error "Malformed binding of SF/DEFAULT-SYNTAX-TABLE:" @@ -169,7 +172,7 @@ MIT in each case. |# (if (> (string-length input-type) 2) (string-head input-type 2) input-type)) - "bin"))))) + bin-pathname-type))))) (if bin-string (merge-pathnames bin-string bin-path) bin-path)) @@ -379,4 +382,15 @@ MIT in each case. |# (write (/ (exact->inexact process-time) 1000)) (write-string " (process time); ") (write (/ (exact->inexact real-time) 1000)) - (write-string " (real time)")))) \ No newline at end of file + (write-string " (real time)")))) + +(define compatibility-detection-frob (vector #F '())) + +(define (perhaps-issue-compatibility-warning) + (if (eq? (vector-ref compatibility-detection-frob 0) + (vector-ref compatibility-detection-frob 1)) + (begin + (warn "!! You are syntaxing while in compatibilty mode, where #F is the") + (warn "!! same as '(). The resulting file may be incorrect for the") + (warn "!! standard environment.")))) + -- 2.25.1