More syntax support

README.md

@@ -61,18 +61,27 @@ BSDScheme v0.0.0
 2
 ```
 
-### Compiler
+### Compiler (and Macros)
 
 ```
-$ cat examples/compile-basic.scm
-(define (plus a b)
-  (+ a b))
+$ cat examples/my-let.scm
+(define-syntax my-let*
+  (syntax-rules ()
+    ((_ ((p v)) b ...)
+     (let ((p v)) b ...))
+    ((_ ((p1 v1) (p2 v2) ...) b ...)
+     (let ((p1 v1))
+       (my-let* ((p2 v2) ...)
+		b ...)))))
 
 (define (main)
-  (display (plus 1 2)))
-$ ./bin/bsdc examples/compile-basic.scm
+  (my-let* ((a 1)
+            (b (+ a 2)))
+           (display (+ a b))
+           (newline)))
+$ ./bin/bsdc examples/my-let.scm
 $ ./a
-3
+4
 ```
 
 ## Current state
@@ -84,7 +93,7 @@ $ ./a
   * Command-line REPL
   * `if`, `let`, `define`, `begin` tail calls optimized (interpreter only)
   * R7RS Libraries (interpreter only)
-  * Basic define-syntax/syntax-rules support
+  * Basic define-syntax/syntax-rules support (not hygienic)
 * Missing (but planned, R7RS is the obvious goal):
   * Labelled let
   * D FFI

examples/my-let.scm

@@ -0,0 +1,14 @@
+(define-syntax my-let*
+  (syntax-rules ()
+    ((_ ((p v)) b ...)
+     (let ((p v)) b ...))
+    ((_ ((p1 v1) (p2 v2) ...) b ...)
+     (let ((p1 v1))
+       (my-let* ((p2 v2) ...)
+		b ...)))))
+
+(define (main)
+  (my-let* ((a 1)
+            (b (+ a 2)))
+           (display (+ a b))
+           (newline)))

src/expand.d

@@ -26,78 +26,75 @@ alias Extensions = Extension[string];
  * (when #t (display "here\n"))
  */
 
-Nullable!(Value[string]) matchRuleAndBind(Value rule, string[] keywords, Value args) {
-  Nullable!(Value[string]) ctx = [" ": nilValue].nullable;
-
+bool matchRuleAndBind(Value rule, string[] keywords, Value args, ref Value[][string] ctx) {
   if (valueIsNil(rule)) {
-    return ctx;
+    if (!valueIsNil(args)) {
+      return false;
+    }
+
+    return true;
   }
 
   if (valueIsList(rule)) {
-    if (!valueIsList(args)) {
-      ctx.nullify();
-      return ctx;
+    auto a1 = args;
+    if (valueIsList(args)) {
+      a1 = car(args);
     }
 
     auto r1 = car(rule);
-    auto a1 = car(args);
-
-    auto carCtx = [" ": nilValue].nullable;
 
+    auto ellipsisMatched = false;
     if (valueIsSymbol(r1)) {
       auto sym = valueToSymbol(r1);
       if (sym == "...") {
-        carCtx["..."] = args;
+        if (sym !in ctx) {
+          ctx["..."] = [];
+          ellipsisMatched = true;
+        }
+
+        ctx["..."] ~= args;
+
+        return true;
       }
     }
 
-    if ("..." !in carCtx) {
-      carCtx = matchRuleAndBind(r1, keywords, a1);
+    if (!matchRuleAndBind(r1, keywords, a1, ctx)) {
+      return false;
     }
-
-    if (carCtx.isNull) {
-      return carCtx;
-    } else {
-      auto cdrCtx = matchRuleAndBind(cdr(rule), keywords, cdr(args));
-      if (cdrCtx.isNull) {
-        return cdrCtx;
-      }
-
-      foreach (key, value; cdrCtx) {
-        carCtx[key] = value;
-      }
 
-      return carCtx;
+    if (valueIsList(args) && !matchRuleAndBind(cdr(rule), keywords, cdr(args), ctx)) {
+      return false;
     }
+
+    return true;
   } else {
     auto rSym = valueToSymbol(rule);
 
     // Match keyword
     if (keywords.canFind(rSym)) {
       if (valueIsSymbol(args) && valueToSymbol(args) == rSym) {
-        ctx.nullify();
-        return ctx;
+        return false;
       }
 
-      return ctx;
+      return true;
     }
 
     switch (rSym) {
     case "_": // Match anything/nothing;
-      break;
-    case "...": // Match rest
-      ctx[rSym] = args;
-      break;
+      return true;
+    case "...":
+      // Already handled in the above case.
+      return true;
     default:
-      ctx[rSym] = args;
-      break;
+      ctx[rSym] = [args];
+      return true;
     }
   }
 
-  return ctx;
+  return false;
 }
 
-Value bindTransformation(Value tfm, Value[string] bindings) {
+Value bindTransformation(Value tfm, Value[][string] bindings) {
   if (valueIsNil(tfm)) {
     return tfm;
   } else if (valueIsList(tfm)) {
@@ -107,14 +104,24 @@ Value bindTransformation(Value tfm, Value[string] bindings) {
     if (valueIsList(_cdr)) {
       auto cadr = car(cdr(tfm));
       if (valueIsSymbol(cadr) && valueToSymbol(cadr) == "...") {
+        if ("..." !in bindings) {
+          exError(format("No matching ellipsis to bind near '%s'", formatValue(tfm)));
+          assert(0);
+        }
+
+        if (bindings["..."].length == 1) {
+          bindings["..."] = [];
+        } else {
+          bindings["..."] = bindings["..."][1 .. bindings["..."].length];
+        }
         return appendList(makeListValue(_car, nilValue), car(_cdr));
       }
     }
     return makeListValue(_car, _cdr);
   } else {
     auto sym = valueToSymbol(tfm);
     if (sym in bindings) {
-      return bindings[sym];
+      return bindings[sym][0];
     }
 
     return tfm;
@@ -131,16 +138,17 @@ Extension syntaxRules(Value ast) {
   }
 
   return delegate Value (Value ast) {
-    foreach (ruleAndTransformation; rules) {
+    foreach (i, ruleAndTransformation; rules) {
       auto rule = car(ruleAndTransformation);
       auto tfm = car(cdr(ruleAndTransformation));
-      auto ctx = matchRuleAndBind(rule, keywords, ast);
-      if (!ctx.isNull) {
+      Value[][string] ctx = [" ": [nilValue]];
+      auto matched = matchRuleAndBind(rule, keywords, ast, ctx);
+      if (matched) {
         return bindTransformation(tfm, ctx);
       }
     }
 
-    exError(format("Syntax error: %s", formatValue(ast)));
+    exError(format("Syntax did not match any patterns: %s", formatValue(ast)));
     assert(0);
   };
 }

tests/my-let.yaml

@@ -0,0 +1,22 @@
+cases:
+  - name: syntax extensions with multiple rules and multiple ellipsis
+    status: 0
+    stdout: 4
+
+templates:
+- test.scm: |
+    (import (scheme base) (scheme write))
+
+    (define-syntax my-let*
+      (syntax-rules ()
+        ((_ ((p v)) b ...)
+         (let ((p v)) b ...))
+        ((_ ((p1 v1) (p2 v2) ...) b ...)
+         (let ((p1 v1))
+           (my-let* ((p2 v2) ...)
+    		b ...)))))
+
+    (define (main)
+      (my-let* ((a 1)
+                (b (+ a 2)))
+               (display (+ a b))))