git » jacl.git » commit 9e5f173

quasiquote improvements

author Alan Dipert
2019-10-18 01:13:12 UTC
committer Alan Dipert
2019-10-18 01:13:12 UTC
parent e408cbd526e857981fa9326bb68d65b59f125573

quasiquote improvements

jacl.js +61 -61

diff --git a/jacl.js b/jacl.js
index b00299f..f7e1dd4 100644
--- a/jacl.js
+++ b/jacl.js
@@ -27,6 +27,17 @@ class Cons {
       return xs.reduce((a, b) => Cons.append(a,b));
     }
   }
+  static listStar(...xs) {
+    if (xs.length === 0) {
+      throw new Error(`LIST* requires at least one argument`);
+    } else if (xs.length == 1) {
+      return xs[0];
+    } else {
+      let list = xs[xs.length-1];
+      for (let i = xs.length-2; i >= 0; i--) list = new Cons(xs[i], list);
+      return list;
+    }
+  }
   [Symbol.iterator]() {
     let ptr    = this,
         proper = true,
@@ -256,6 +267,7 @@ Package.makePackage('COMMON-LISP-USER', 'CL-USER');
 Package.makePackage('KEYWORD');
 
 // CL package constants
+// TODO update this, look into constants
 const CLCONSTS = new Map([
   ['T', 'true'],
   ['NIL', 'null']
@@ -266,6 +278,18 @@ for (const [k,v] of CLCONSTS) {
   CLPKG.exportSymbol(k);
 }
 
+// CL package functions set early as used by QUASIQUOTE
+const CLFUNCS = new Map([
+  ['LIST', Cons.listOf],
+  ['APPEND', Cons.append],
+  ['LIST*', Cons.listStar]
+]);
+
+for (const [k,v] of CLFUNCS) {
+  CLPKG.intern(k).fvalue = v;
+  CLPKG.exportSymbol(k);
+}
+
 // JS package constants
 const JSCONSTS = new Map([
   ['+FALSE+', 'false'],
@@ -707,74 +731,50 @@ JACLPKG.intern('UNQUOTE').setMacro().fvalue = function(env, form) {
   throw new Error(`Comma not inside backquote`);
 };
 
+JACLPKG.intern('QUASIQUOTE').setMacro().fvalue = function(env, form) {
 
-const transform = (form, wrapInList = true) => {
-  const maybeWrap = x => {
-    if (wrapInList) {
-      return Cons.listOf(
-        JACLPKG.intern('%CALL'),
-        Cons.listOf(
-          JACLPKG.intern('%DOT'),
-          JSPKG.intern('Cons'),
-          new LispSymbol('listOf', null)
-        ),
-        x
-      );
-    } else {
-      return x;
-    }
-  }
-  if (form instanceof Cons && JACLPKG.intern('UNQUOTE') === form.car) {
-    return maybeWrap(form.cdr.car);
-  } else if (form instanceof Cons && JACLPKG.intern('UNQUOTE-SPLICING') === form.car) {
-    return form.cdr.car;
-  } else {
-    return maybeWrap(transformQuasiquoteArgument(form));
-  }
-};
-const transformCompound = compound => {
-  const rec = object => {
-    if (object instanceof Cons && JACLPKG.intern('UNQUOTE') === object.car) {
-      return Cons.listOf(transform(object.car), transform(object.cdr, false));
-    } else if (object instanceof Cons && JACLPKG.intern('UNQUOTE-SPLICING') === object.car) {
-      throw new Error(`UNQUOTE-SPLICING in dotted list`);
-    } else if (object === null) {
-      return null;
+  const callCL = (funcName, ...args) => {
+    return Cons.listOf(CLPKG.intern(funcName), ...args);
+  };
+
+  const transform = (form, wrapInList = true) => {
+    const maybeWrap = x => wrapInList ? callCL('LIST', x) : x;
+    if (form instanceof Cons && JACLPKG.intern('UNQUOTE') === form.car) {
+      return maybeWrap(form.cdr.car);
+    } else if (form instanceof Cons && JACLPKG.intern('UNQUOTE-SPLICING') === form.car) {
+      return form.cdr.car;
     } else {
-      return new Cons(transform(object.car), rec(object.cdr));
+      return maybeWrap(transformQuasiquoteArgument(form));
     }
   };
-  return rec(compound);
-};
 
-const ppr = x => {
-  if (x instanceof Cons) {
-    return Array.from(x).map(ppr);
-  } else if (x instanceof LispSymbol) {
-    return x.name;
-  } else {
-    return x.toString();
-  }
-};
+  const transformCompound = compound => {
+    const rec = object => {
+      if (object instanceof Cons && JACLPKG.intern('UNQUOTE') === object.car) {
+        return Cons.listOf(transform(object.car), transform(object.cdr, false));
+      } else if (object instanceof Cons && JACLPKG.intern('UNQUOTE-SPLICING') === object.car) {
+        throw new Error(`UNQUOTE-SPLICING in dotted list`);
+      } else if (object === null) {
+        return null;
+      } else {
+        return new Cons(transform(object.car), rec(object.cdr));
+      }
+    };
+    return rec(compound);
+  };
 
-const transformQuasiquoteArgument = argument => {
-  if (argument instanceof Cons && JACLPKG.intern('UNQUOTE') === argument.car) {
-    return argument.cdr.car;
-  } else if (argument instanceof Cons && JACLPKG.intern('UNQUOTE-SPLICING') === argument.car) {
-    throw new Error(`UNQUOTE-SPLICING at top`);
-  } else if (argument instanceof Cons) {
-    const foo = Cons.listOf(
-      JACLPKG.intern('%CALL'),
-      Cons.listOf(JACLPKG.intern('%DOT'), JSPKG.intern('Cons'), new LispSymbol('append', null)),
-      ...transformCompound(argument)
-    );
-    return foo;
-  } else {
-    return Cons.listOf(CLPKG.intern('QUOTE'), argument);
-  }
-};
+  const transformQuasiquoteArgument = argument => {
+    if (argument instanceof Cons && JACLPKG.intern('UNQUOTE') === argument.car) {
+      return argument.cdr.car;
+    } else if (argument instanceof Cons && JACLPKG.intern('UNQUOTE-SPLICING') === argument.car) {
+      throw new Error(`UNQUOTE-SPLICING at top`);
+    } else if (argument instanceof Cons) {
+      return callCL('APPEND', ...transformCompound(argument));
+    } else {
+      return callCL('QUOTE', argument);
+    }
+  };
 
-JACLPKG.intern('QUASIQUOTE').setMacro().fvalue = function(env, form) {
   const expand = form => {
     if (form instanceof Cons) {
       const expanded = new Cons(expand(form.car), expand(form.cdr));