finish syntax-parameterize macro #210

CHANGELOG.md

@@ -8,6 +8,7 @@
 * add `typecheck-number` function
 * add `char-foldcase` and `string-foldcase` functions
 * add `SRFI-210`
+* add `syntax-parameterize` from SRFI-139 to the core [#210](https://github.com/jcubic/lips/issues/210)
 ### Bugfix
 * fix `let-values` to allow binding to list [#281](https://github.com/jcubic/lips/issues/281)
 * fix wrong strings in `string-fill!`

README.md

@@ -8,7 +8,7 @@
 [![npm](https://img.shields.io/badge/npm-1.0.0%E2%80%93beta.18.1-blue.svg)](https://www.npmjs.com/package/@jcubic/lips)
 ![1.0.0 Complete](https://img.shields.io/github/milestones/progress-percent/jcubic/lips/1?label=1.0.0%20Complete)
 [![Build and test](https://github.com/jcubic/lips/actions/workflows/build.yaml/badge.svg?branch=devel&event=push)](https://github.com/jcubic/lips/actions/workflows/build.yaml)
-[![Coverage Status](https://coveralls.io/repos/github/jcubic/lips/badge.svg?branch=devel&e8666578679e43d802ef1f3e4532bc35)](https://coveralls.io/github/jcubic/lips?branch=devel)
+[![Coverage Status](https://coveralls.io/repos/github/jcubic/lips/badge.svg?branch=devel&76d46a65a647b7cac8f5c678dcf07f0b)](https://coveralls.io/github/jcubic/lips?branch=devel)
 [![Join Gitter Chat](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/jcubic/lips)
 ![NPM Download Count](https://img.shields.io/npm/dm/@jcubic/lips)
 ![JSDelivr Download count](https://img.shields.io/jsdelivr/npm/hm/@jcubic/lips)

src/lips.js

@@ -3877,7 +3877,9 @@ function transform_syntax(options = {}) {
         symbols,
         names,
         ellipsis: ellipsis_symbol } = options;
-    var gensyms = {};
+    const gensyms = {};
+    // for SRFI-139
+    const syntax_parameters = [];
     function valid_symbol(symbol) {
         if (symbol instanceof LSymbol) {
             return true;
@@ -3910,7 +3912,7 @@ function transform_syntax(options = {}) {
                 }
             }
         }
-        if (symbols.includes(name)) {
+        if (symbols.includes(name) || syntax_parameters.includes(name)) {
             return LSymbol(name);
         }
         if (!(symbol instanceof LSymbol)) {
@@ -4077,6 +4079,13 @@ function transform_syntax(options = {}) {
                 LSymbol.is(expr.car.car, ellipsis_symbol)) {
                 return traverse(expr.car.cdr, { disabled: true });
             }
+            // SRFI-139 - this need to be hardcoded
+            if (LSymbol.is(expr.car, 'syntax-parameterize') &&
+                is_pair(expr.cdr) &&
+                is_pair(expr.cdr.car)) {
+                const names = expr.cdr.car.to_array(false).map(pair => pair.car.valueOf());
+                syntax_parameters.push(...names);
+            }
             if (expr.cdr instanceof Pair &&
                 LSymbol.is(expr.cdr.car, ellipsis_symbol) && !disabled) {
                 log('>> 1');

tests/core.scm

@@ -628,7 +628,6 @@
                  (string-set! (f) 0 #\x)))
               true)))
 
-
 (test "core: means"
       (lambda (t)
         ;; By Jussi Piitulainen <[email protected]>

tests/syntax.scm

@@ -1392,3 +1392,31 @@
                 ((_) "world"))))
          (t.is (string-append (it) " " (is))
                "hello world"))))
+(test "syntax: should create anaphofric macro with syntax-parameterize"
+      (lambda (t)
+        (define-syntax foo
+          (syntax-rules ()
+            ((_ body ...)
+             (syntax-parameterize
+              ((it (syntax-rules ()
+                     ((_) "hello, world"))))
+              body ...))))
+
+        (t.is (foo (string-append (it) "!"))
+              "hello, world!")))
+
+(test "syntax: should throw error when anaphoric variable is used outside"
+      (let (t)
+        (define-syntax foo
+          (syntax-rules ()
+            ((_ body ...)
+             (begin
+               (syntax-parameterize
+                ((it (syntax-rules ()
+                       ((_) "hello world")))))
+               body ...))))
+        (t.is (null? (--> (try (foo (it))
+                               (catch (e)
+                                      e.message))
+                          (match #/Error: Unbound variable `it' in macro:/)))
+              #f)))