Lots of work on my adventures

4 files changed, 33 insertions, 27 deletions

diff --git a/scheme/aps/lang.sls b/scheme/aps/lang.sls
index fd0ec4d..85308c1 100644
--- a/scheme/aps/lang.sls
+++ b/scheme/aps/lang.sls
@@ -1,9 +1,19 @@
 #!r6rs
 (library (aps lang)
-(export literal-replace : identifier-append identifier-prepend
+(export literal-replace : raw-identifier=? identifier-append identifier-prepend
         get-name-from-define)
 (import (rnrs) (sweet-macros))
 
+;;RAW-IDENTIFIER=?
+(define (raw-identifier=? id1 id2)
+  (symbol=? (syntax->datum id1) (syntax->datum id2)))
+;;END
+
+;;RAW-ID=?
+(define (raw-id=? raw-id x)
+    (and (identifier? x) (raw-identifier=? raw-id x)))
+;;END
+
 ;;LITERAL-REPLACE
 (def-syntax literal-replace
   (syntax-match ()
@@ -16,9 +26,9 @@
 ;;END
 
 ;;COLON
-(def-syntax :
+(def-syntax : ; colon macro
   (syntax-match ()
-    (sub (: let-form e)
+    (sub (: let-form e); do nothing
          #'e)
     (sub (: let-form e1 e2)
          (syntax-violation ': "Odd number of arguments" #'let-form))
diff --git a/scheme/aps/list-match.sls b/scheme/aps/list-match.sls
index 7e115f5..20e8d95 100644
--- a/scheme/aps/list-match.sls
+++ b/scheme/aps/list-match.sls
@@ -9,30 +9,29 @@
       (cond
        ((_match obj pattern (list template) guard ...) => car) ...
        (else (error 'list-match "pattern failure" obj))))
-  (for-all (lambda (s) (eq? (syntax->datum s) 'sub)) #'(sub ...)))
+  (for-all (cut raw-id=? #'sub <>) #'(sub ...)))
 
 (def-syntax _match
   (syntax-match (quote quasiquote)
-      (sub (_ obj pattern template)
+      (sub (_match obj pattern template)
        #'(_match obj pattern template #t))
-      (sub (_ obj () template guard)
-       #'(and (null? obj) guard template))
-      (sub (_ obj underscore template guard)
-        #'(and guard template)
-        (and (identifier? #'underscore) (free-identifier=? #'underscore #'_)))
-      (sub (_ obj var template guard)
-        #'(let ((var obj)) (and guard template))
-        (identifier? (syntax var)))
-      (sub (_ obj (quote datum) template guard)
-        #'(and (equal? obj (quote datum)) template))
-      (sub (_ obj (quasiquote datum) template guard )
-        #'(and (equal? obj (quasiquote datum)) guard template))
-      (sub (_ obj (kar . kdr) template guard)
+      (sub (_match obj () template guard?)
+       #'(and (null? obj) guard? template))
+      (sub (_match obj underscore template guard?)
+        #'(and guard? template)
+        (raw-id=? #'_ #'underscore))
+      (sub (_match obj var template guard?)
+        #'(let ((var obj)) (and guard? template))
+        (identifier? #'var))
+      (sub (_match obj 'datum template guard?)
+        #'(and (equal? obj 'datum) template))
+      (sub (_match obj `datum template guard? )
+        #'(and (equal? obj `datum) guard? template))
+      (sub (_match obj (kar . kdr) template guard?)
         #'(let ((ob obj))
             (and (pair? ob)
                (let ((kar-obj (car ob)) (kdr-obj (cdr ob)))
-                 (_match kar-obj kar
-                    (_match kdr-obj kdr template guard))))))
-      (sub (_ obj const template guard)
-        #'(and (equal? obj const) guard template))))
+                 (_match kar-obj kar (_match kdr-obj kdr template guard?))))))
+      (sub (_match obj const template guard?)
+        #'(and (equal? obj const) guard? template))))
 )
diff --git a/scheme/make_sweet_macros.py b/scheme/make_sweet_macros.py
index b026ffd..a7c295b 100644
--- a/scheme/make_sweet_macros.py
+++ b/scheme/make_sweet_macros.py
@@ -52,6 +52,7 @@ def makefiles(name, snippet):
     write_on(name + '/main.sls', ikarus_code)
     write_on(name + '/main.mzscheme.sls', main % snippet)
     write_on('sweet-macros.larceny.sls', main % snippet)
+    write_on('sweet-macros.mosh.sls', ikarus_code)
     write_on(name + '/helper1.sls', helper1 % snippet)
     write_on(name + '/helper2.sls', helper2 % snippet)
     write_on(name + '/helper3.sls', helper3 % snippet)
diff --git a/scheme/sweet-macros/main.sls b/scheme/sweet-macros/main.sls
index 5ba2912..3f1f7ea 100644
--- a/scheme/sweet-macros/main.sls
+++ b/scheme/sweet-macros/main.sls
@@ -4,13 +4,9 @@
 ;;; Email: michele.simionato@gmail.com
 ;;; Date: 23-Apr-2009
 ;;; Licence: BSD
-(export syntax-match def-syntax syntax-expand sub)
+(export syntax-match def-syntax syntax-expand)
 (import (rnrs))
 
-(define-syntax sub ; needed to make Ikarus REPL happy
-  (lambda (x)
-    (syntax-violation #f "incorrect use of auxiliary keyword" x)))
-
 ;;GUARDED-SYNTAX-CASE
 (define-syntax guarded-syntax-case
   (let ((add-clause