Now syntax-expand works for PLT Scheme, too, thanks to a (meta -1) import

8 files changed, 25 insertions, 36 deletions

diff --git a/scheme/Makefile b/scheme/Makefile
index 0fe7bd0..f69b528 100644
--- a/scheme/Makefile
+++ b/scheme/Makefile
@@ -1,4 +1,4 @@
 upload:
 	python make_sweet_macros.py
-	zip -r aps aps/README.txt sweet-macros aps/compat.ikarus.sls aps/compat.ypsilon.sls aps/cut.sls aps/test-utils.sls aps/list-utils.sls aps/repeat.sls
+	zip -r aps aps/README.txt sweet-macros aps/compat.ikarus.sls aps/compat.ypsilon.sls aps/cut.sls aps/easy-test.sls aps/list-utils.sls aps/repeat.sls
 	#scp aps.zip merlin.phyast.pitt.edu:public_html/scheme
diff --git a/scheme/aps/README.txt b/scheme/aps/README.txt
index 3126df9..447a4b5 100644
--- a/scheme/aps/README.txt
+++ b/scheme/aps/README.txt
@@ -20,12 +20,6 @@ They also pass with the latest development version of Ypsilon and with
 PLT Scheme version 4, except for
 the test "zip-with-error". However, this is an expected failure, since the
 error messages are different between Ikarus, Ypsilon and PLT Scheme.
-Ypsilon is easy enough to support, and I use it, so I think I will
-keep supporting it in the future.
-
-PLT Scheme is not supported as well as I would, and I will accept patches
-from PLT experts willing to help me; the nontrivial part is supporting
-``sweet-macros`` fully.
 
 Larceny Scheme is not supported since it does not support the ``.IMPL.sls``
 convention. When it does, it could be supported as well, expecially if I
diff --git a/scheme/aps/test-utils.sls b/scheme/aps/easy-test.sls
index 9e206c3..70fd253 100644
--- a/scheme/aps/test-utils.sls
+++ b/scheme/aps/easy-test.sls
@@ -1,5 +1,5 @@
 #!r6rs
-(library (aps test-utils)
+(library (aps easy-test)
 (export catch-error test run-tests runner run)
 (import (rnrs) (aps compat) (sweet-macros))
 
diff --git a/scheme/aps/test-all.ss b/scheme/aps/test-all.ss
index f051422..c4eab80 100644
--- a/scheme/aps/test-all.ss
+++ b/scheme/aps/test-all.ss
@@ -1,4 +1,4 @@
-(import (rnrs) (aps test-utils) (aps list-utils))
+(import (rnrs) (aps easy-test) (aps list-utils))
 
 (define (test-range-zip-transpose-enumerate)
   (list
diff --git a/scheme/make_sweet_macros.py b/scheme/make_sweet_macros.py
index 96c6d1b..1ff9f38 100644
--- a/scheme/make_sweet_macros.py
+++ b/scheme/make_sweet_macros.py
@@ -20,19 +20,27 @@ helper1 = '''#!r6rs
 
 helper2 = '''#!r6rs
 (library (sweet-macros helper2)
-(export local guarded-syntax-case syntax-match)
-(import (rnrs) (for (sweet-macros helper1) run expand))
+(export local syntax-match)
+(import (rnrs) (for (rnrs) (meta -1))
+(for (sweet-macros helper1) (meta -1) (meta 0) (meta 1)))
 
 %(SYNTAX-MATCH)s
 )
 '''
 
-main = '''#!r6rs
+helper3 = '''#!r6rs
 (library (sweet-macros)
-(export local guarded-syntax-case syntax-match def-syntax syntax-expand)
+(export local syntax-match def-syntax)
 (import (rnrs) (for (sweet-macros helper2) run expand))
 
 %(DEF-SYNTAX)s
+)
+'''
+
+main = '''#!r6rs
+(library (sweet-macros)
+(export local syntax-match def-syntax syntax-expand)
+(import (rnrs) (for (sweet-macros helper3) run expand))
 
 %(SYNTAX-EXPAND)s
 )
@@ -41,6 +49,7 @@ main = '''#!r6rs
 def makefiles(name, snippet):
     file(name + '/helper1.mzscheme.sls', 'w').write(helper1 % snippet)
     file(name + '/helper2.mzscheme.sls', 'w').write(helper2 % snippet)
+    file(name + '/helper3.mzscheme.sls', 'w').write(helper3 % snippet)
     file(name + '/main.mzscheme.sls', 'w').write(main % snippet)
     #os.system('zip -r %s %s' % (name, name))
     
diff --git a/scheme/sweet-macros/helper2.mzscheme.sls b/scheme/sweet-macros/helper2.mzscheme.sls
index e1c14cc..c9b9e2b 100644
--- a/scheme/sweet-macros/helper2.mzscheme.sls
+++ b/scheme/sweet-macros/helper2.mzscheme.sls
@@ -1,7 +1,8 @@
 #!r6rs
 (library (sweet-macros helper2)
-(export local guarded-syntax-case syntax-match)
-(import (rnrs) (for (sweet-macros helper1) run expand))
+(export local syntax-match)
+(import (rnrs) (for (rnrs) (meta -1))
+(for (sweet-macros helper1) (meta -1) (meta 0) (meta 1)))
 
 (define-syntax syntax-match
   (guarded-syntax-case () (sub local)
@@ -11,7 +12,7 @@
          (guarded-syntax-case ()
            (<literals> <patterns> <source> <transformer> literal ...)
            ((ctx <literals>)
-            #''((... (... literal)) ...))
+            #''(literal ...))
            ((ctx <patterns>)
             #''((... (... patt)) ...))
            ((ctx <source>)
diff --git a/scheme/sweet-macros/main.mzscheme.sls b/scheme/sweet-macros/main.mzscheme.sls
index 488e291..9c765e6 100644
--- a/scheme/sweet-macros/main.mzscheme.sls
+++ b/scheme/sweet-macros/main.mzscheme.sls
@@ -1,22 +1,7 @@
 #!r6rs
 (library (sweet-macros)
-(export local guarded-syntax-case syntax-match def-syntax syntax-expand)
-(import (rnrs) (for (sweet-macros helper2) run expand))
-
-(define-syntax def-syntax
-  (syntax-match (extends local)
-    (sub (def-syntax name (extends parent)
-       (local loc ...) (literal ...) 
-       clause ...)
-     #'(define-syntax name
-         (syntax-match (local loc ...) (literal ...)
-           clause ...
-           (sub x ((parent <transformer>) #'x)))))
-    (sub (def-syntax (name . args) skel . rest)
-     #'(define-syntax name (syntax-match () (sub (name . args) skel . rest))))
-    (sub (def-syntax name transformer)
-     #'(define-syntax name transformer))
-    ))
+(export local syntax-match def-syntax syntax-expand)
+(import (rnrs) (for (sweet-macros helper3) run expand))
 
 (def-syntax (syntax-expand (macro . args))
   #'(syntax->datum ((macro <transformer>) #'(... (... (macro . args))))))
diff --git a/scheme/sweet-macros/main.sls b/scheme/sweet-macros/main.sls
index 8d9e632..1bc94fd 100644
--- a/scheme/sweet-macros/main.sls
+++ b/scheme/sweet-macros/main.sls
@@ -52,14 +52,14 @@
          (guarded-syntax-case ()
            (<literals> <patterns> <source> <transformer> literal ...)
            ((ctx <literals>)
-            #''((... (... literal)) ...))
+            #''(literal ...))
            ((ctx <patterns>)
             #''((... (... patt)) ...))
            ((ctx <source>)
-            #''(self (local (let-form name value) ...) ((... (... literal)) ...)
+            #''(self (local (let-form name value) ...) (literal ...)
                      (... (... (sub patt skel . rest))) ...))
            ((ctx <transformer>)
-            #'(self (local (let-form name value) ...) ((... (... literal)) ...)
+            #'(self (local (let-form name value) ...) (literal ...)
                     (... (... (sub patt skel . rest))) ...))
            (patt skel . rest) ...))
      (for-all identifier? #'(literal ...))