git » jacl.git » commit ac8086b

diff --git a/boot.lisp b/boot.lisp
index c18febf..a971d1e 100644
--- a/boot.lisp
+++ b/boot.lisp
@@ -27,14 +27,14 @@
 (\. *package* (|exportSymbol| (\. 'defmacro |name|)))
 (%js "(~{}.setMacro().fvalue = ~{})"
      'defmacro
-     (%lambda nil (env form name params &rest body)
+     (%lambda nil t (env form 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 (jacl::&environment jacl::&whole ,@params)
+            (jacl:%lambda nil t (jacl::&environment jacl::&whole ,@params)
               ,@body))
           ',name)))
 
@@ -43,7 +43,7 @@
   `(jacl:%progn
      (jacl:%js "(~{}.fvalue = ~{})"
        ',name
-       (jacl:%lambda ,name ,params ,@body))
+       (jacl:%lambda ,name nil ,params ,@body))
      ',name))
 
 (defun %export (symbol &optional (package *package*))
@@ -289,7 +289,7 @@
 
 (%export 'lambda)
 (defmacro lambda (params &rest body)
-  `(jacl:%lambda nil ,params ,@body))
+  `(jacl:%lambda nil nil ,params ,@body))
 
 (%export 'list)
 (defun list (&rest objects)
diff --git a/jacl-tests.lisp b/jacl-tests.lisp
index df8425c..0c38608 100644
--- a/jacl-tests.lisp
+++ b/jacl-tests.lisp
@@ -174,7 +174,7 @@
 
 (deftest "Named JACL:%LAMBDA"
   (let* ((invocations 0)
-         (f (jacl:%lambda self (x y)
+         (f (jacl:%lambda self nil (x y)
                           (let ((self nil))
                             (when (< x y)
                               (setq invocations (1+ invocations))
@@ -201,7 +201,7 @@
 ;;          )
 ;;        )))
 
-(defmacro time (memo &rest body)
+(defmacro time (memo &body body)
   (let ((start (gensym))
         (ret (gensym)))
     `(let ((,start (progn
diff --git a/jacl.js b/jacl.js
index 292db18..b37edc3 100644
--- a/jacl.js
+++ b/jacl.js
@@ -1061,7 +1061,15 @@ const parseLambdaList = (list, isMacro) => {
       // :allow-other-keys t etc
       keyAllowOthers: false,
       // Array of [symbol, expr] for [name, init]
-      aux: []
+      aux: [],
+
+      // Macro lambda list only
+      // null or symbol
+      body: null,
+      // null or symbol
+      environment: null,
+      // null or symbol
+      whole: null
     },
     state = 'required';
 
@@ -1074,6 +1082,12 @@ const parseLambdaList = (list, isMacro) => {
             || eqClSym(x, '&REST')
             || eqClSym(x, '&AUX')) {
           state = x.name.substring(1).toLowerCase();
+        } else if (eqClSym(x, '&BODY')) {
+          if (isMacro) {
+            state = x.name.substring(1).toLowerCase();
+          } else {
+            throw new Error(`&BODY may only appear in a macro lambda list`)
+          }
         } else if (eqClSym(x, '&ALLOW-OTHER-KEYS')) {
           throw new Error(`Misplaced ${x.name}`);
         } else if (x instanceof LispSymbol) {
@@ -1115,29 +1129,31 @@ const parseLambdaList = (list, isMacro) => {
           throw new Error(`&OPTIONAL parameter not symbol or valid list`);
         }
         break;
+      case 'body':
       case 'rest':
-        if (sections.rest)
-          throw new Error(`Repeated &REST`);
+        if (sections.body || sections.rest)
+          throw new Error(`Too many &REST/&BODY`);
         if (eqClSym(x, '&ALLOW-OTHER-KEYS'))
-          throw new Error(`Expected variable after &REST, got ${x.name}`);
+          throw new Error(`Expected variable after &${state.toUpperCase()}, got ${x.name}`);
         if (!(x instanceof LispSymbol))
-          throw new Error(`&REST parameter not a symbol`);
-        sections.rest = x;
-        state = 'after-rest';
+          throw new Error(`&${state.toUpperCase()} parameter not a symbol`);
+        sections[state] = x;
+        state = 'after-${state}';
         break;
+      case 'after-body':
       case 'after-rest':
-        if (eqClSym(x, '&OPTIONAL')
+        if (eqClSym(x, '&REST') || eqClSym(x, '&BODY')) {
+          throw new Error(`Too many &REST/&BODY`)
+        } else if (eqClSym(x, '&OPTIONAL')
             || eqClSym(x, '&KEY')
             || eqClSym(x, '&AUX')) {
           state = x.name.substring(1).toLowerCase();
           if (sections[state].length)
             throw new Error(`Duplicate ${x.name}`);
         } else if (eqClSym(x, '&ALLOW-OTHER-KEYS')) {
-          throw new Error(`Misplaced ${x.name} after &REST`);
-        } else if (eqClSym(x, '&REST')) {
-          throw new Error(`Repeated &REST`);
+          throw new Error(`Misplaced ${x.name} after &${state.split("-")[1].toUpperCase()}`);
         } else {
-          throw new Error(`Expected keyword after &REST param`);
+          throw new Error(`Expected keyword after &${state.split("-")[1].toUpperCase()} param`);
         }
         break;
       case 'key':
@@ -1148,7 +1164,7 @@ const parseLambdaList = (list, isMacro) => {
           if (sections.keyAllowOther)
             throw new Error(`Duplicate &ALLOW-OTHER-KEYS`);
           sections.keyAllowOthers = true;
-        } else if (eqClSym(x, '&OPTIONAL') || eqClSym(x, '&REST')) {
+        } else if (eqClSym(x, '&OPTIONAL') || eqClSym(x, '&REST') || eqClSym(x, '&BODY')) {
           throw new Error(`Misplaced ${x.name}`);
         } else if (eqClSym(x, '&AUX')) {
           state = 'aux';
@@ -1185,7 +1201,8 @@ const parseLambdaList = (list, isMacro) => {
           throw new Error(`Repeated &AUX`);
         } else if (eqClSym(x, '&OPTIONAL')
             || eqClSym(x, '&KEY')
-            || eqClSym(x, '&REST')) {
+            || eqClSym(x, '&REST')
+            || eqClSym(x, '&BODY')) {
           throw new Error(`Misplaced ${x.name}`);
         } else if (x instanceof LispSymbol) {
           sections.aux.push({ name: checkValidLocal(x), initform: UNDEFINED });
@@ -1221,6 +1238,8 @@ const analyzeLambdaList = (env, parent, list, isMacro) => {
   }
   if (sections.rest)
     env = env.withLocals([sections.rest])
+  if (sections.body)
+    env = env.withLocals([sections.body])
   for (const spec of sections.key) {
     if (spec.initform !== UNDEFINED) {
       spec.initform = analyze(env, parent, spec.initform);
@@ -1283,7 +1302,7 @@ const analyzeSpecials = new Map([
     return node;
   }],
   [JACLPKG.intern('%LAMBDA'), (env, parent, form) => {
-    let [, name, list, ...body] = form;
+    let [, name, isMacro, list, ...body] = form;
     let declarations = [];
     if (body.length > 0
         && List.isProperList(body[0])
@@ -1297,10 +1316,11 @@ const analyzeSpecials = new Map([
       parent: parent,
       form: form,
       name: name,
-      declarations: declarations
+      declarations: declarations,
+      isMacro: isMacro
     });
     const { lambdaList, initforms, bodyEnv } = analyzeLambdaList(
-      env.withContext('expr'), node, list, false
+      env.withContext('expr'), node, list, isMacro
     );
     node.lambdaList = lambdaList;
     node = merge(node, analyzeBlock(bodyEnv, node, body));
@@ -1906,7 +1926,7 @@ const emitNode = (print, node) => {
       print('){\n');
       // Emit argument length checks
       const min = node.lambdaList.required.length,
-        hasRest = node.lambdaList.rest || node.lambdaList.key.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) {
         print(`if (arguments.length !== ${min}) throw new Error('Called with invalid number of arguments: ' + arguments.length);\n`);
@@ -1951,11 +1971,15 @@ const emitNode = (print, node) => {
         print('break;\n');
         print('}\n');
       }
+      // &rest
       const restStart = node.lambdaList.required.length
         + node.lambdaList.optional.length;
-      // &rest
       if (node.lambdaList.rest) {
         print(mungeSym(node.lambdaList.rest, 'local'));
+      } else if (node.lambdaList.body) {
+        print(mungeSym(node.lambdaList.body, 'local'));
+      }
+      if (node.lambdaList.rest || node.lambdaList.body) {
         print('=');
         if (node.declarations.find(x => List.first(x) === JACLPKG.intern('REST-ARRAY'))) {
           print(`Array.prototype.slice.call(arguments, ${restStart});\n`);