Import Upstream version 2a6upstream/2a6

1 files changed, 146 insertions, 0 deletions

diff --git a/syncase.sh b/syncase.sh
new file mode 100644
index 0000000..4ae4db4
--- /dev/null
+++ b/syncase.sh
@@ -0,0 +1,146 @@
+#! /bin/sh -e
+
+echo Cleaning up old version and unpacking original ...
+rm -fr syntax-case
+gzip --decompress --stdout syntax-case.tar.z | tar xf -
+
+cd syntax-case
+
+echo Removing some files ...
+rm *.ps loadpp.ss hooks*
+
+# Remove enormous amount (about 200k) of white space in expand.pp
+echo Slimming expand.pp ...
+sed -e '/^ */s///' expand.pp > tt; mv tt expand.pp
+
+echo Patching ...
+patch -s -b .ORIG << 'PATCH'
+--- ./expand.pp.ORIG	Wed Mar 24 19:54:52 1993
++++ ./expand.pp	Wed Mar 24 19:54:52 1993
+@@ -337,9 +337,10 @@
+ '()
+ (lambda (e maps) (regen e)))))
+ (ellipsis? (lambda (x)
+-(if (if (top-level-bound? 'dp) dp #f)
+-(break)
+-(void))
++;; I dont know what this is supposed to do, and removing it seemed harmless.
++;; (if (if (top-level-bound? 'dp) dp #f)
++;; (break)
++;; (void))
+ (if (identifier? x)
+ (free-id=? x '...)
+ #f)))
+@@ -1674,7 +1675,7 @@
+ (set! generate-temporaries
+ (lambda (ls)
+ (arg-check list? ls 'generate-temporaries)
+-(map (lambda (x) (wrap (gensym) top-wrap)) ls)))
++(map (lambda (x) (wrap (new-symbol-hook "g") top-wrap)) ls)))
+ (set! free-identifier=?
+ (lambda (x y)
+ (arg-check id? x 'free-identifier=?)
+--- ./expand.ss.ORIG	Thu Jul  2 13:56:19 1992
++++ ./expand.ss	Wed Mar 24 19:54:53 1993
+@@ -564,7 +564,8 @@
+ 
+ (define ellipsis?
+    (lambda (x)
+-      (when (and (top-level-bound? 'dp) dp) (break))
++      ;; I dont know what this is supposed to do, and removing it seemed harmless.
++      ;; (when (and (top-level-bound? 'dp) dp) (break))
+       (and (identifier? x)
+            (free-id=? x (syntax (... ...))))))
+ 
+@@ -887,7 +888,7 @@
+    ;; gensym
+    (lambda (ls)
+       (arg-check list? ls 'generate-temporaries)
+-      (map (lambda (x) (wrap (gensym) top-wrap)) ls)))
++      (map (lambda (x) (wrap (new-symbol-hook "g") top-wrap)) ls)))
+ 
+ (set! free-identifier=?
+    (lambda (x y)
+--- ./macro-defs.ss.ORIG	Thu Jul  2 12:28:49 1992
++++ ./macro-defs.ss	Wed Mar 24 19:55:31 1993
+@@ -161,26 +161,3 @@
+        (syntax-case x ()
+           ((- e) (gen (syntax e) 0))))))
+ 
+-;;; simple delay and force; also defines make-promise
+-
+-(define-syntax delay
+-   (lambda (x)
+-      (syntax-case x ()
+-         ((delay exp)
+-          (syntax (make-promise (lambda () exp)))))))
+-
+-(define make-promise
+-   (lambda (thunk)
+-      (let ([value (void)] [set? #f])
+-         (lambda ()
+-            (unless set?
+-               (let ([v (thunk)])
+-                  (unless set?
+-                     (set! value v)
+-                     (set! set? #t))))
+-            value))))
+-
+-(define force
+-   (lambda (promise)
+-      (promise)))
+-
+PATCH
+test $# -gt 0 && exit 0
+rm *.ORIG
+###############################################################################
+
+echo Renaming globals ...
+
+CR='
+'
+SEDCMD='s/list\*/syncase:list*/g'
+for x in \
+  build- void andmap install-global-transformer eval-hook error-hook \
+  new-symbol-hook put-global-definition-hook get-global-definition-hook \
+  expand-install-hook;
+do SEDCMD=$SEDCMD$CR"s/$x/syncase:$x/g"; done
+
+WARN=";;; This file was munged by a simple minded sed script since it left
+;;; its original authors' hands.  See syncase.doc for the horrid details.
+"
+
+for f in *.pp *.ss; do
+  mv $f tt; (echo "$WARN"; sed -e "$SEDCMD" tt) >$f; rm tt; done
+
+echo Making the doc file ...
+DOC=syncase.doc
+cp ../$DOC .
+for f in Notes ReadMe; do
+echo "
+*******************************************************************************
+The file named $f in the original distribution:
+"
+cat $f
+rm $f
+done >>$DOC
+
+echo "
+*******************************************************************************
+The shell script that created these files out of the original distribution:
+" >>$DOC
+cat ../fixit >>$DOC
+
+echo Renaming files ...
+mv compat.ss sca-comp.scm
+mv output.ss scaoutp.scm
+mv init.ss scaglob.scm
+mv expand.pp scaexpp.scm
+mv expand.ss sca-exp.scm
+mv macro-defs.ss scamacr.scm
+mv structure.ss structure.scm
+
+echo Adding new pieces ...
+cp ../sca-init.scm scainit.scm
+
+echo Done.