Other work on the module system; added indexer and indexer-syntax

3 files changed, 49 insertions, 8 deletions

diff --git a/scheme/aps/lang.sls b/scheme/aps/lang.sls
index 89f8527..653cd6d 100644
--- a/scheme/aps/lang.sls
+++ b/scheme/aps/lang.sls
@@ -1,8 +1,19 @@
 #!r6rs
 (library (aps lang)
-(export : identifier-append identifier-prepend get-name-from-define)
+(export define-ct : identifier-append identifier-prepend get-name-from-define)
 (import (rnrs) (sweet-macros))
 
+;;DEFINE-CT
+(def-syntax define-ct
+  (syntax-match ()
+    (sub (define-ct name expr)
+         #'(def-syntax name (identifier-syntax expr))
+         (identifier? #'name))
+    (sub (define-ct (name . args) body body* ...)
+         #'(define-ct name (lambda args body body* ...)))
+    ))
+;;END
+
 ;;COLON
 (def-syntax :
   (syntax-match ()
@@ -35,9 +46,8 @@
 ;;IDENTIFIER-APPEND
 ;; take an identifier and return a new one with an appended suffix
 (define (identifier-append id . strings)
-  (datum->syntax id (string->symbol
-                     (apply string-append
-                            (symbol->string (syntax->datum id)) strings))))
+  (define id-str (symbol->string (syntax->datum id)))
+  (datum->syntax id (string->symbol (apply string-append id-str strings))))
 ;;END
 
 ;;IDENTIFIER-PREPEND
diff --git a/scheme/aps/list-utils.sls b/scheme/aps/list-utils.sls
index 1f564a5..835c9e8 100644
--- a/scheme/aps/list-utils.sls
+++ b/scheme/aps/list-utils.sls
@@ -1,7 +1,7 @@
 #!r6rs
 (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 alist)
+        remove-dupl append-unique fold flatten list-of normalize symbol-table)
 (import (rnrs) (sweet-macros) (aps cut) (for (aps lang) expand))
 
 ;;; macros
@@ -58,15 +58,15 @@
 (def-syntax (list-for decl ... expr)
   #'(list-of-aux expr '() decl ...))
 
-;;ALIST
-(def-syntax (alist arg ...)
+;;SYMBOL-TABLE
+(def-syntax (symbol-table arg ...)
   (: with-syntax
      ((name value) ...)
      (map (syntax-match ()
             (sub n #'(n n) (identifier? #'n))
             (sub (n v) #'(n v) (identifier? #'n)))
           #'(arg ...))
-     #'(let* ((name value) ...)
+     #'(letrec ((name value) ...)
          (list (list 'name name) ...))))
 ;;END
 
diff --git a/scheme/sweet-macros/test-all.ss b/scheme/sweet-macros/test-all.ss
new file mode 100644
index 0000000..56cf745
--- /dev/null
+++ b/scheme/sweet-macros/test-all.ss
@@ -0,0 +1,31 @@
+#!r6rs
+(import (rnrs) (aps compat) (sweet-macros) (aps list-utils)
+        (aps easy-test) (for (only (aps list-utils) distinct?) expand))
+
+;(def-syntax (quot x ...)
+;  #''(x ...))
+
+(def-syntax quot
+  (syntax-match () (sub (quot x ...) #''(x ...))))
+
+(display (syntax-expand (quot 1 2 3)))
+
+(display (quot <patterns>))
+
+(display "\nSuccess!\n")
+
+
+(def-syntax (multi-define (name1 name2 ...) (value1 value2 ...))
+  #'(begin (define name1 value1) (define name2 value2) ...)
+  (distinct? bound-identifier=? #'(name1 name2 ...))
+  (syntax-violation 'multi-define "Found duplicated in"
+                    #'(name1 name2 ...)))
+
+(run
+ (test "md1"
+       (multi-define <literals>)
+       '())
+ (test "md2"
+       (multi-define <patterns>)
+       '((multi-define (name1 name2 ...) (value1 value2 ...))))
+ )