git » jacl.git » commit 9c431a4

diff --git a/boot.lisp b/boot.lisp
index 52518d4..d913cbd 100644
--- a/boot.lisp
+++ b/boot.lisp
@@ -27,15 +27,11 @@
 (\. *package* (|exportSymbol| (\. 'defmacro |name|)))
 (%js "(~{}.setMacro().fvalue = ~{})"
      'defmacro
-     (%lambda nil t (env form name params &rest body)
+     (%lambda nil t (name params &rest body)
        `(jacl:%progn
           (jacl:%js "(~{}.setMacro().fvalue = ~{})"
             ',name
-            ;; TODO Macro lambda list parsing. Also, consider
-            ;; incorportating a symbol's package into the name of its
-            ;; generated local.
-            (jacl:%lambda nil t (jacl::&environment jacl::&whole ,@params)
-              ,@body))
+            (jacl:%lambda nil t ,params ,@body))
           ',name)))
 
 (\. *package* (|exportSymbol| (\. 'defun |name|)))
diff --git a/jacl-tests.lisp b/jacl-tests.lisp
index 0c38608..835fe8a 100644
--- a/jacl-tests.lisp
+++ b/jacl-tests.lisp
@@ -25,20 +25,23 @@
   (jacl:\. *package* (|usePackage| jpkg)))
 
 (defvar *is*)
+(defvar *label* nil)
 
-(defmacro deftest (label &rest body)
-  (let ((is (gensym)))
+(defmacro deftest (label &body body)
+  (let ((is# (gensym)))
     `(\. @|QUnit| (|test| (\. ,label (|toString|))
-                   (lambda (,is)
+                   (lambda (,is#)
                      (declare (jacl:async))
-                     (let ((*is* ,is))
+                     (let ((*is* ,is#))
                        ,@body))))))
 
 (defun assert= (x y &optional (label ""))
-  (\. *is* (|strictEqual| x y (\. label (|toString|)))))
+  (\. *is* (|strictEqual| x y (or *label* (\. label (|toString|))))))
 
-(defmacro assert-throws (&rest body)
-  `(\. *is* (|throws| (lambda () ,@body))))
+(defmacro assert-throws (&body body)
+  `(\. *is* (|throws|
+             (lambda () ,@body)
+             (if *label* (\. *label* (|toString|)) @""))))
 
 (defun read1 (s)
   (let ((s (\. s (|toString|))))
@@ -48,16 +51,20 @@
   (declare (jacl:rest-array))
   (\. (jacl:%js "console") |log| (|apply| nil objects)))
 
-(\. @|QUnit| (|module| @"Reader"))
+(\. @|QUnit| (|module| @"Atoms"))
 
-(deftest "Integers"
+(deftest "Fixnums"
   (assert= (await (read1 "123 "))   123  "single integer")
   (assert= (await (read1 "+9912 ")) 9912 "integer with leading +")
   (assert= (await (read1 "0 "))     0    "zero")
   (assert= (await (read1 "-32 "))   -32  "negative number")
   (assert= (await (read1 "1. "))    1.   "number with trailing dot"))
 
-(deftest "Basic Symbols"
+(deftest "Symbols"
+  (assert= nil @|null|)
+  (assert= 'nil @|null|)
+  (assert= t @|true|)
+  (assert= 't @|true|)
   (let ((sym (await (read1 @"somesym "))))
     (assert= (\. sym |name|) @"SOMESYM" "simple symbol name")
     (assert= (\. sym |packageName|) @"COMMON-LISP-USER" "simple symbol package"))
@@ -202,17 +209,16 @@
 ;;        )))
 
 (defmacro time (memo &body body)
-  (let ((start (gensym))
-        (ret (gensym)))
-    `(let ((,start (progn
+  (let ((start# (gensym))
+        (ret# (gensym)))
+    `(let ((,start# (progn
                      (\. (%js "console") (|profile| ,memo))
                      (now)))
-           (,ret (progn ,@body)))
-       (\. (%js "console") (|profileEnd| ,memo))
-       (log ,memo (- (now) ,start))
-       ,ret)))
+           (,ret# (progn ,@body)))
+       (\. @|console| (|profileEnd| ,memo))
+       (log ,memo (- (now) ,start#))
+       ,ret#)))
 
 (deftest "Recursion"
   (assert= 7 (time @"tak" (tak 18 12 6))))
 
-
diff --git a/jacl.js b/jacl.js
index b37edc3..ac3cd7c 100644
--- a/jacl.js
+++ b/jacl.js
@@ -476,8 +476,7 @@ const JSCONSTS = new Map([
   ['+NAN+', NaN],
   ['+NULL+', null],
   ['+TRUE+', true],
-  ['+UNDEFINED+', undefined],
-  ['+THIS+', this]
+  ['+UNDEFINED+', undefined]
 ]);
 
 for (const [k,v] of JSCONSTS) {
@@ -602,8 +601,13 @@ const READTABLE = Package.intern('CL', '*READTABLE*');
 const interpretToken = (token, intern) => {
   const [isInt, intVal] = readInteger(token.str);
   if (isInt) return intVal;
-
-  return LispSymbol.createFromString(token, intern);
+  const sym = LispSymbol.createFromString(token, intern);
+  if (eqClSym(sym, 'NIL')) {
+    return null;
+  } else if (eqClSym(sym, 'T')) {
+    return true;
+  }
+  return sym;
 };
 
 const listSentinels = new Map([
@@ -775,7 +779,8 @@ const symCharNames = new Map([
   ['{', '_LBRACK_'],
   ['}', '_RBRACK_'],
   ['~', '_TILDE_'],
-  [' ', '_SPACE_']
+  [' ', '_SPACE_'],
+  ['#', '_SHARP_']
 ]);
 
 const munge = s => {
@@ -839,7 +844,9 @@ const readInteger = token => {
 
 const readSingleEscaped = async function(stream, token, intern = true) {
   for await(const y of stream) {
-    if (isConstituent(y)) {
+    // # is a "non-terminating macro char" and so may appear in the
+    // # middle of a token.
+    if (isConstituent(y) || y === '#') {
       token.add(y.toUpperCase());
       continue;
     } else if (y === '\\') {
@@ -1032,11 +1039,11 @@ const analyzeBlock = (env, parent, forms) => {
   return { statements: stmts, ret: ret, children: children };
 };
 
-const parseLambdaList = (list, isMacro) => {
-  const eqClSym = (x, name) => (x instanceof LispSymbol) &&
-    x.packageName === 'COMMON-LISP' &&
-    x.name === name;
+const eqClSym = (x, name) => (x instanceof LispSymbol) &&
+      x.packageName === 'COMMON-LISP' &&
+      x.name === name;
 
+const parseLambdaList = (list, isMacro) => {
   const checkValidLocal = x => {
     if (!(x instanceof LispSymbol) || x.packageName == 'KEYWORD')
       throw new Error(`${x} not a valid local variable`);
@@ -1082,11 +1089,13 @@ const parseLambdaList = (list, isMacro) => {
             || eqClSym(x, '&REST')
             || eqClSym(x, '&AUX')) {
           state = x.name.substring(1).toLowerCase();
-        } else if (eqClSym(x, '&BODY')) {
+        } else if (eqClSym(x, '&BODY')
+                   || eqClSym(x, '&ENVIRONMENT')
+                   || eqClSym(x, '&WHOLE')) {
           if (isMacro) {
             state = x.name.substring(1).toLowerCase();
           } else {
-            throw new Error(`&BODY may only appear in a macro lambda list`)
+            throw new Error(`&${x.name.substring(1).toUpperCase()} may only appear in a macro lambda list`)
           }
         } else if (eqClSym(x, '&ALLOW-OTHER-KEYS')) {
           throw new Error(`Misplaced ${x.name}`);
@@ -1196,6 +1205,42 @@ const parseLambdaList = (list, isMacro) => {
           throw new Error(`&KEY parameter not symbol or valid list`);
         }
         break;
+      case 'whole':
+        if (eqClSym(x, '&WHOLE')) {
+          throw new Error(`Repeated &WHOLE`);
+        } else if (eqClSym(x, '&OPTIONAL')
+            || eqClSym(x, '&KEY')
+            || eqClSym(x, '&REST')
+            || eqClSym(x, '&BODY')
+            || eqClSym(x, '&ENVIRONMENT')) {
+          throw new Error(`Misplaced ${x.name}`);
+        } else if (sections.whole) {
+          throw new Error(`Duplicate &WHOLE`);
+        } else if (x instanceof LispSymbol) {
+          sections.whole = x
+          state = 'required';
+        } else {
+          throw new Error(`&WHOLE parameter not a symbol`);
+        }
+        break;
+      case 'environment':
+        if (eqClSym(x, '&ENVIRONMENT')) {
+          throw new Error(`Repeated &ENVIRONMENT`);
+        } else if (eqClSym(x, '&OPTIONAL')
+            || eqClSym(x, '&KEY')
+            || eqClSym(x, '&REST')
+            || eqClSym(x, '&WHOLE')
+            || eqClSym(x, '&BODY')) {
+          throw new Error(`Misplaced ${x.name}`);
+        } else if (sections.environment) {
+          throw new Error(`Duplicate &ENVIRONMENT`);
+        } else if (x instanceof LispSymbol) {
+          sections.environment = x
+          state = 'required';
+        } else {
+          throw new Error(`&ENVIRONMENT parameter not a symbol`);
+        }
+        break;
       case 'aux':
         if (eqClSym(x, '&AUX')) {
           throw new Error(`Repeated &AUX`);
@@ -1240,6 +1285,10 @@ const analyzeLambdaList = (env, parent, list, isMacro) => {
     env = env.withLocals([sections.rest])
   if (sections.body)
     env = env.withLocals([sections.body])
+  if (sections.environment)
+    env = env.withLocals([sections.environment])
+  if (sections.whole)
+    env = env.withLocals([sections.whole])
   for (const spec of sections.key) {
     if (spec.initform !== UNDEFINED) {
       spec.initform = analyze(env, parent, spec.initform);
@@ -1311,6 +1360,7 @@ const analyzeSpecials = new Map([
       body = body.slice(1);
     }
     env = name ? env.withLocalFunctions([name]) : env;
+    name = name ? mungeSym(name, 'flocal') : "";
     node = makeNode('lambda', {
       env: env,
       parent: parent,
@@ -1905,19 +1955,23 @@ const emitNode = (print, node) => {
     }
     case 'lambda': {
       if (node.declarations.find(x => List.first(x) === JACLPKG.intern('ASYNC'))) {
-        print(`(async function ${mungeSym(node.name, 'flocal')}(`);
+        print(`(async function ${node.name}(`);
       } else {
-        print(`(function ${mungeSym(node.name, 'flocal')}(`);
+        print(`(function ${node.name}(`);
       }
       // Emit required argument names
       // TODO Move lambda list production to a function for use by macro ll,
       // destructuring-bind, etc. Similar to emitBlock.
-      for (let i = 0; i < node.lambdaList.required.length; i++) {
-        print(mungeSym(node.lambdaList.required[i], 'local'))
-        if (i < node.lambdaList.required.length-1) print(',');
+      const required = node.isMacro ? [
+        JACLPKG.intern('&ENVIRONMENT'),
+        JACLPKG.intern('&WHOLE')
+      ].concat(node.lambdaList.required) : node.lambdaList.required;
+      for (let i = 0; i < required.length; i++) {
+        print(mungeSym(required[i], 'local'))
+        if (i < required.length-1) print(',');
       }
       // Emit optional argument names
-      if (node.lambdaList.required.length && node.lambdaList.optional.length)
+      if (required.length && node.lambdaList.optional.length)
         print(',');
       for (let i = 0; i < node.lambdaList.optional.length; i++) {
         print(mungeSym(node.lambdaList.optional[i].name, 'local'))
@@ -1925,7 +1979,7 @@ const emitNode = (print, node) => {
       }
       print('){\n');
       // Emit argument length checks
-      const min = node.lambdaList.required.length,
+      const min = required.length,
         hasRest = node.lambdaList.rest || node.lambdaList.body || node.lambdaList.key.length,
         max = hasRest ? false : min + node.lambdaList.optional.length;
       if (min >= 0 && min === max) {
@@ -1938,6 +1992,15 @@ const emitNode = (print, node) => {
           print(`if (arguments.length > ${max}) throw new Error('Called with too many arguments: ' + arguments.length);\n`);
         }
       }
+      // Macro-specific and conditional assignment of &ENVIRONMENT and &WHOLE
+      if (node.isMacro) {
+        if (node.lambdaList.environment) {
+          print(`var ${mungeSym(node.lambdaList.environment, 'local')} = ${mungeSym(required[0], 'local')};\n`);
+        }
+        if (node.lambdaList.whole) {
+          print(`var ${mungeSym(node.lambdaList.whole, 'local')} = ${mungeSym(required[1], 'local')};\n`);
+        }
+      }
       // &optional
       if (node.lambdaList.optional.length) {
         if (node.lambdaList.optionalSvars.length) {
@@ -1972,7 +2035,7 @@ const emitNode = (print, node) => {
         print('}\n');
       }
       // &rest
-      const restStart = node.lambdaList.required.length
+      const restStart = required.length
         + node.lambdaList.optional.length;
       if (node.lambdaList.rest) {
         print(mungeSym(node.lambdaList.rest, 'local'));
@@ -2277,6 +2340,7 @@ let replInputStream = new BufferedStream(),
 const startRepl = async () => {
   try {
     for await(const obj of replReader) {
+      console.log("read", obj);
       const node = optimize(analyze(emptyEnv, null, obj));
       // console.log(node)
       const sb = new StringBuffer();