Major improvement: removed 'locally' and simplified syntax-match significantly

7 files changed, 65 insertions, 109 deletions

diff --git a/scheme/aps/list-utils.sls b/scheme/aps/list-utils.sls
index 95a479a..b662e73 100644
--- a/scheme/aps/list-utils.sls
+++ b/scheme/aps/list-utils.sls
@@ -2,7 +2,7 @@
 (library (aps list-utils)
 (export range enumerate zip transpose distinct? let+ perm list-of-aux list-for
         remove-dupl append-unique fold flatten list-of normalize)
-(import (rnrs) (sweet-macros) (aps cut))
+(import (rnrs) (sweet-macros) (aps cut) (for (aps lang) expand))
 
 ;;; macros
 
@@ -127,17 +127,15 @@
 (def-syntax fold
   (syntax-match (left right in)
      (sub (fold left (acc seed) (x in lst) (x* in lst*) ... new-acc)
-          (locally
-           (with-syntax (a a* ...) (generate-temporaries #'(x x* ...)))
-           #'(fold-left
-              (lambda (acc a a* ...) (let+ (x a) (x* a*) ... new-acc))
-             seed lst lst* ...)))
+           (: with-syntax (a a* ...) (generate-temporaries #'(x x* ...))
+              #'(fold-left
+                 (lambda (acc a a* ...) (let+ (x a) (x* a*) ... new-acc))
+                 seed lst lst* ...)))
      (sub (fold right (acc seed) (x in lst) (x* in lst*) ... new-acc)
-          (locally
-           (with-syntax (a a* ...) (generate-temporaries #'(x x* ...)))
-           #'(fold-right
-              (lambda (a a* ... acc) (let+ (x a) (x* a*) ... new-acc))
-             seed lst lst* ...)))
+           (: with-syntax (a a* ...) (generate-temporaries #'(x x* ...))
+              #'(fold-right
+                 (lambda (a a* ... acc) (let+ (x a) (x* a*) ... new-acc))
+                 seed lst lst* ...)))
      ))
 ;;END
 
diff --git a/scheme/make_sweet_macros.py b/scheme/make_sweet_macros.py
index d6adff5..fb44731 100644
--- a/scheme/make_sweet_macros.py
+++ b/scheme/make_sweet_macros.py
@@ -3,24 +3,22 @@ from scheme2rst import SNIPPET
 
 code = file('sweet-macros/main.sls').read()
 
-# LOCALLY, GUARDED-SYNTAX-CASE, SYNTAX-MATCH, DEF-SYNTAX, SYNTAX-EXPAND
+# GUARDED-SYNTAX-CASE, SYNTAX-MATCH, DEF-SYNTAX, SYNTAX-EXPAND
 snippets = [s.groups() for s in SNIPPET.finditer(code)]
 snippet = dict(snippets)
 
 helper1 = '''#!r6rs
 (library (sweet-macros helper1)
-(export locally guarded-syntax-case)
+(export guarded-syntax-case)
 (import (rnrs))
 
-%(LOCALLY)s
-
 %(GUARDED-SYNTAX-CASE)s
 )
 '''
 
 helper2 = '''#!r6rs
 (library (sweet-macros helper2)
-(export locally syntax-match)
+(export syntax-match)
 (import (rnrs) (for (rnrs) (meta -1))
 (for (sweet-macros helper1) (meta -1) (meta 0) (meta 1)))
 
@@ -30,7 +28,7 @@ helper2 = '''#!r6rs
 
 helper3 = '''#!r6rs
 (library (sweet-macros)
-(export locally syntax-match def-syntax)
+(export syntax-match def-syntax)
 (import (rnrs) (for (sweet-macros helper2) run expand))
 
 %(DEF-SYNTAX)s
@@ -39,7 +37,7 @@ helper3 = '''#!r6rs
 
 main = '''#!r6rs
 (library (sweet-macros)
-(export locally syntax-match def-syntax syntax-expand)
+(export syntax-match def-syntax syntax-expand)
 (import (rnrs) (for (sweet-macros helper3) run expand))
 
 %(SYNTAX-EXPAND)s
diff --git a/scheme/sweet-macros/helper1.mzscheme.sls b/scheme/sweet-macros/helper1.mzscheme.sls
index 2e4065e..206f540 100644
--- a/scheme/sweet-macros/helper1.mzscheme.sls
+++ b/scheme/sweet-macros/helper1.mzscheme.sls
@@ -1,19 +1,8 @@
 #!r6rs
 (library (sweet-macros helper1)
-(export locally guarded-syntax-case)
+(export guarded-syntax-case)
 (import (rnrs))
 
-(define-syntax locally
-  (lambda (x)
-    (syntax-case x (syntax-match)
-      ((locally expr)
-       #'expr)
-      ((locally (let-form name value) ... (syntax-match b0 b1 b2 ...))
-       #'(syntax-match (locally (let-form name value) ...) b0 b1 b2 ...))
-      ((locally (let-form name value) (l n v) ... expr)
-       #'(let-form ((name value)) (locally (l n v) ... expr))))
-    ))
-
 (define-syntax guarded-syntax-case
   (let ((add-clause
          (lambda (clause acc)
diff --git a/scheme/sweet-macros/helper2.mzscheme.sls b/scheme/sweet-macros/helper2.mzscheme.sls
index 80a5aab..6a9a7de 100644
--- a/scheme/sweet-macros/helper2.mzscheme.sls
+++ b/scheme/sweet-macros/helper2.mzscheme.sls
@@ -1,35 +1,23 @@
 #!r6rs
 (library (sweet-macros helper2)
-(export locally syntax-match)
+(export 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 locally)
-    ((self (locally (let-form name value) ...) (literal ...)
-           (sub patt skel . rest) ...)
-     #'(locally (let-form name value) ...
-         (guarded-syntax-case ()
-           (<literals> <patterns> <source> <transformer> literal ...)
-           ((ctx <literals>)
-            #''(literal ...))
-           ((ctx <patterns>)
-            #''((... (... patt)) ...))
-           ((ctx <source>)
-            #''(self (locally (let-form name value) ...) (literal ...)
-                     (... (... (sub patt skel . rest))) ...))
-           ((ctx <transformer>)
-            #'(self (locally (let-form name value) ...) (literal ...)
-                    (... (... (sub patt skel . rest))) ...))
-           (patt skel . rest) ...))
+  (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 (literal ...) (sub patt skel . rest) ...)
-     #'(self (locally)(literal ...) (sub patt skel . rest) ...))
-
-    ((self x (literal ...) (sub patt skel . rest) ...)
-     #'(guarded-syntax-case x (literal ...) (patt skel . rest) ...))
+    ((self x (literal ...) (sub patt skel rest ...) ...)
+     #'(guarded-syntax-case x (literal ...) (patt skel rest ...) ...))
     ))
 )
diff --git a/scheme/sweet-macros/helper3.mzscheme.sls b/scheme/sweet-macros/helper3.mzscheme.sls
index f97124e..5e05485 100644
--- a/scheme/sweet-macros/helper3.mzscheme.sls
+++ b/scheme/sweet-macros/helper3.mzscheme.sls
@@ -1,20 +1,24 @@
 #!r6rs
 (library (sweet-macros)
-(export locally syntax-match def-syntax)
+(export syntax-match def-syntax)
 (import (rnrs) (for (sweet-macros helper2) run expand))
 
 (define-syntax def-syntax
-  (syntax-match (extends locally)
-    (sub (def-syntax name (extends parent)
-       (locally loc ...) (literal ...) 
-       clause ...)
+  (syntax-match (extends)
+    (sub (def-syntax name (extends parent) (literal ...) clause ...)
      #'(define-syntax name
-         (syntax-match (locally loc ...) (literal ...)
+         (syntax-match (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 . args) skel rest ...)
+     #'(def-syntax name (syntax-match () (sub (name . args) skel rest ...)))
+     (identifier? #'name) (syntax-violation 'def-syntax "Invalid name" #'name))
     (sub (def-syntax name transformer)
-     #'(define-syntax name transformer))
+     #'(define-syntax name
+         (syntax-match (<source> <transformer>)
+           (sub (name <transformer>) #'(... (... transformer)))
+           (sub (name <source>) #''(... (... transformer)))
+           (sub x (transformer #'x))))
+     (identifier? #'name) (syntax-violation 'def-syntax "Invalid name" #'name))
     ))
 )
diff --git a/scheme/sweet-macros/main.mzscheme.sls b/scheme/sweet-macros/main.mzscheme.sls
index ade973e..a3ac852 100644
--- a/scheme/sweet-macros/main.mzscheme.sls
+++ b/scheme/sweet-macros/main.mzscheme.sls
@@ -1,6 +1,6 @@
 #!r6rs
 (library (sweet-macros)
-(export locally syntax-match def-syntax syntax-expand)
+(export syntax-match def-syntax syntax-expand)
 (import (rnrs) (for (sweet-macros helper3) run expand))
 
 (def-syntax (syntax-expand (macro . args))
diff --git a/scheme/sweet-macros/main.sls b/scheme/sweet-macros/main.sls
index b64a4c3..10ce495 100644
--- a/scheme/sweet-macros/main.sls
+++ b/scheme/sweet-macros/main.sls
@@ -1,20 +1,7 @@
 (library (sweet-macros)
-(export syntax-match def-syntax syntax-expand locally)
+(export syntax-match def-syntax syntax-expand)
 (import (rnrs))
 
-;;LOCALLY
-(define-syntax locally
-  (lambda (x)
-    (syntax-case x (syntax-match)
-      ((locally expr)
-       #'expr)
-      ((locally (let-form name value) ... (syntax-match b0 b1 b2 ...))
-       #'(syntax-match (locally (let-form name value) ...) b0 b1 b2 ...))
-      ((locally (let-form name value) (l n v) ... expr)
-       #'(let-form ((name value)) (locally (l n v) ... expr))))
-    ))
-;;END
-
 ;;GUARDED-SYNTAX-CASE
 (define-syntax guarded-syntax-case
   (let ((add-clause
@@ -45,49 +32,41 @@
 
 ;;SYNTAX-MATCH
 (define-syntax syntax-match
-  (guarded-syntax-case () (sub locally)
-    ((self (locally (let-form name value) ...) (literal ...)
-           (sub patt skel . rest) ...)
-     #'(locally (let-form name value) ...
-         (guarded-syntax-case ()
-           (<literals> <patterns> <source> <transformer> literal ...)
-           ((ctx <literals>)
-            #''(literal ...))
-           ((ctx <patterns>)
-            #''((... (... patt)) ...))
-           ((ctx <source>)
-            #''(self (locally (let-form name value) ...) (literal ...)
-                     (... (... (sub patt skel . rest))) ...))
-           ((ctx <transformer>)
-            #'(self (locally (let-form name value) ...) (literal ...)
-                    (... (... (sub patt skel . rest))) ...))
-           (patt skel . rest) ...))
+  (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 (literal ...) (sub patt skel . rest) ...)
-     #'(self (locally)(literal ...) (sub patt skel . rest) ...))
-
-    ((self x (literal ...) (sub patt skel . rest) ...)
-     #'(guarded-syntax-case x (literal ...) (patt skel . rest) ...))
+    ((self x (literal ...) (sub patt skel rest ...) ...)
+     #'(guarded-syntax-case x (literal ...) (patt skel rest ...) ...))
     ))
 ;;END
 
 ;; DEF-SYNTAX
 (define-syntax def-syntax
-  (syntax-match (extends locally)
-    (sub (def-syntax name (extends parent)
-       (locally loc ...) (literal ...) 
-       clause ...)
+  (syntax-match (extends)
+    (sub (def-syntax name (extends parent) (literal ...) clause ...)
      #'(define-syntax name
-         (syntax-match (locally loc ...) (literal ...)
+         (syntax-match (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 . args) skel rest ...)
+     #'(def-syntax name (syntax-match () (sub (name . args) skel rest ...)))
+     (identifier? #'name) (syntax-violation 'def-syntax "Invalid name" #'name))
     (sub (def-syntax name transformer)
-     #'(define-syntax name transformer))
+     #'(define-syntax name
+         (syntax-match (<source> <transformer>)
+           (sub (name <transformer>) #'(... (... transformer)))
+           (sub (name <source>) #''(... (... transformer)))
+           (sub x (transformer #'x))))
+     (identifier? #'name) (syntax-violation 'def-syntax "Invalid name" #'name))
     ))
 ;;END