Simplified the syntax-match implementation

4 files changed, 52 insertions, 58 deletions

diff --git a/scheme/sweet-macros/helper1.mzscheme.sls b/scheme/sweet-macros/helper1.mzscheme.sls
index 206f540..a5964b5 100644
--- a/scheme/sweet-macros/helper1.mzscheme.sls
+++ b/scheme/sweet-macros/helper1.mzscheme.sls
@@ -21,11 +21,7 @@
                   ))))))
     (lambda (x)
       (syntax-case x ()
-        ((guarded-syntax-case () (literal ...) clause ...)
-         #'(lambda (y) (guarded-syntax-case y (literal ...) clause ...)))
         ((guarded-syntax-case y (literal ...) clause ...)
-         (with-syntax
-             (((c ...) (fold-right add-clause '() #'(clause ...))))
-           #'(syntax-case y (literal ...) c ...)))
-        ))))
+         (with-syntax (((c ...) (fold-right add-clause '() #'(clause ...))))
+           #'(syntax-case y (literal ...) c ...)))))))
 )
diff --git a/scheme/sweet-macros/helper2.mzscheme.sls b/scheme/sweet-macros/helper2.mzscheme.sls
index 2be4d40..29045f5 100644
--- a/scheme/sweet-macros/helper2.mzscheme.sls
+++ b/scheme/sweet-macros/helper2.mzscheme.sls
@@ -5,20 +5,20 @@
 (for (sweet-macros helper1) (meta -1) (meta 0) (meta 1)))
 
 (define-syntax syntax-match
-  (guarded-syntax-case () (sub)
-        
-    ((self (literal ...) (sub patt skel rest ...) ...)
-     #'(guarded-syntax-case ()
-         (<literals> <patterns> literal ...)
-         ((ctx <literals>) #''(literal ...))
-         ((ctx <patterns>) #''((... (... patt)) ...))
-         (patt skel rest ...)
-         ...)
-     (for-all identifier? #'(literal ...))
-     (syntax-violation 'syntax-match "Found non identifier" #'(literal ...)
-                       (remp identifier? #'(literal ...))))
-    
-    ((self x (literal ...) (sub patt skel rest ...) ...)
-     #'(guarded-syntax-case x (literal ...) (patt skel rest ...) ...))
-    ))
+  (lambda (y)
+    (guarded-syntax-case y (sub)
+      
+      ((self (literal ...) (sub patt skel rest ...) ...)
+       #'(lambda (x) (self x (literal ...) (sub patt skel rest ...) ...)))
+      
+      ((self x (literal ...) (sub patt skel rest ...) ...)
+       #'(guarded-syntax-case x (<literals> <patterns> literal ...)
+           ((ctx <literals>) #''(literal ...))
+           ((ctx <patterns>) #''((... (... patt)) ...))
+           (patt skel rest ...)
+           ...)
+       (for-all identifier? #'(literal ...))
+       (syntax-violation 'syntax-match "Found non identifier" #'(literal ...)
+                         (remp identifier? #'(literal ...))))
+      )))
 )
diff --git a/scheme/sweet-macros/helper3.mzscheme.sls b/scheme/sweet-macros/helper3.mzscheme.sls
index b1cb947..f737dc0 100644
--- a/scheme/sweet-macros/helper3.mzscheme.sls
+++ b/scheme/sweet-macros/helper3.mzscheme.sls
@@ -6,6 +6,12 @@
 (define-syntax def-syntax
   (syntax-match (extends)
 
+    (sub (def-syntax name (extends parent) (literal ...) clause ...)
+     #'(def-syntax name
+         (syntax-match (literal ...)
+           clause ...
+           (sub x ((parent <transformer>) #'x)))))
+    
     (sub (def-syntax (name . args) skel rest ...)
      #'(def-syntax name (syntax-match () (sub (name . args) skel rest ...))))
     
@@ -16,13 +22,8 @@
              ((name <transformer>) #'(... (... transformer)))
              ((name <source>) #''(... (... transformer)))
              (x (transformer #'x)))))
-     (identifier? #'name))
-     ;(syntax-violation 'def-syntax "Invalid name" #'name))
+     (identifier? #'name)
+     (syntax-violation 'def-syntax "Invalid name" #'name))
 
-    (sub (def-syntax name (extends parent) (literal ...) clause ...)
-     #'(def-syntax name
-         (syntax-match (literal ...)
-           clause ...
-           (sub x ((parent <transformer>) #'x)))))
     ))
 )
diff --git a/scheme/sweet-macros/main.sls b/scheme/sweet-macros/main.sls
index 946daf0..d1b4775 100644
--- a/scheme/sweet-macros/main.sls
+++ b/scheme/sweet-macros/main.sls
@@ -21,39 +21,41 @@
                   ))))))
     (lambda (x)
       (syntax-case x ()
-        ((guarded-syntax-case () (literal ...) clause ...)
-         #'(lambda (y) (guarded-syntax-case y (literal ...) clause ...)))
         ((guarded-syntax-case y (literal ...) clause ...)
-         (with-syntax
-             (((c ...) (fold-right add-clause '() #'(clause ...))))
-           #'(syntax-case y (literal ...) c ...)))
-        ))))
+         (with-syntax (((c ...) (fold-right add-clause '() #'(clause ...))))
+           #'(syntax-case y (literal ...) c ...)))))))
 ;;END
 
 ;;SYNTAX-MATCH
 (define-syntax syntax-match
-  (guarded-syntax-case () (sub)
-        
-    ((self (literal ...) (sub patt skel rest ...) ...)
-     #'(guarded-syntax-case ()
-         (<literals> <patterns> literal ...)
-         ((ctx <literals>) #''(literal ...))
-         ((ctx <patterns>) #''((... (... patt)) ...))
-         (patt skel rest ...)
-         ...)
-     (for-all identifier? #'(literal ...))
-     (syntax-violation 'syntax-match "Found non identifier" #'(literal ...)
-                       (remp identifier? #'(literal ...))))
-    
-    ((self x (literal ...) (sub patt skel rest ...) ...)
-     #'(guarded-syntax-case x (literal ...) (patt skel rest ...) ...))
-    ))
+  (lambda (y)
+    (guarded-syntax-case y (sub)
+      
+      ((self (literal ...) (sub patt skel rest ...) ...)
+       #'(lambda (x) (self x (literal ...) (sub patt skel rest ...) ...)))
+      
+      ((self x (literal ...) (sub patt skel rest ...) ...)
+       #'(guarded-syntax-case x (<literals> <patterns> literal ...)
+           ((ctx <literals>) #''(literal ...))
+           ((ctx <patterns>) #''((... (... patt)) ...))
+           (patt skel rest ...)
+           ...)
+       (for-all identifier? #'(literal ...))
+       (syntax-violation 'syntax-match "Found non identifier" #'(literal ...)
+                         (remp identifier? #'(literal ...))))
+      )))
 ;;END
 
 ;; DEF-SYNTAX
 (define-syntax def-syntax
   (syntax-match (extends)
 
+    (sub (def-syntax name (extends parent) (literal ...) clause ...)
+     #'(def-syntax name
+         (syntax-match (literal ...)
+           clause ...
+           (sub x ((parent <transformer>) #'x)))))
+    
     (sub (def-syntax (name . args) skel rest ...)
      #'(def-syntax name (syntax-match () (sub (name . args) skel rest ...))))
     
@@ -64,14 +66,9 @@
              ((name <transformer>) #'(... (... transformer)))
              ((name <source>) #''(... (... transformer)))
              (x (transformer #'x)))))
-     (identifier? #'name))
-     ;(syntax-violation 'def-syntax "Invalid name" #'name))
+     (identifier? #'name)
+     (syntax-violation 'def-syntax "Invalid name" #'name))
 
-    (sub (def-syntax name (extends parent) (literal ...) clause ...)
-     #'(def-syntax name
-         (syntax-match (literal ...)
-           clause ...
-           (sub x ((parent <transformer>) #'x)))))
     ))
 ;;END