git » jacl.git » commit 282e2aa

WIP CL:DOLIST

author Alan Dipert
2020-06-09 05:23:52 UTC
committer Alan Dipert
2020-06-09 05:23:52 UTC
parent 563fda1c6c71b205ee2ba10c17c03dfda8669b10

WIP CL:DOLIST

boot.lisp +24 -1
jacl-tests.lisp +14 -0
jacl.js +13 -8

diff --git a/boot.lisp b/boot.lisp
index 5725a70..4be5d51 100644
--- a/boot.lisp
+++ b/boot.lisp
@@ -28,7 +28,6 @@
 (%js "(~{}.setMacro().fvalue = ~{})"
      'defmacro
      (%lambda (env form name params &rest body)
-       ;; TODO Use %PROGN instead of %LET
        `(jacl:%progn
           (jacl:%js "(~{}.setMacro().fvalue = ~{})"
             ',name
@@ -125,6 +124,10 @@
 (defun cadar (x)
   (car (cdr (car x))))
 
+(%export 'caddr)
+(defun caddr (x)
+  (car (cdr (cdr x))))
+
 (%export 'cond)
 (defmacro cond (&rest clauses)
   (when clauses
@@ -338,6 +341,26 @@
      end)
     ret))
 
+(%export 'dolist)
+(defmacro dolist (binding &rest body)
+  (let ((var (car binding))
+        (list-form (cadr binding))
+        (result-form (caddr binding))
+        (glist (gensym))
+        (gstart (gensym))
+        (gend (gensym)))
+    `(let* ((,var nil)
+            (,glist ,list-form))
+       (tagbody
+        ,gstart
+        (if (null ,glist) (go ,gend))
+        (setq ,var (car ,glist) ,glist (cdr ,glist))
+        ,@body
+        (go ,gstart)
+        ,gend)
+       (setq ,var nil)
+       ,result-form)))
+
 ;;(defun %designated-string (x)
 ;;  (cond ((stringp x) x)
 ;;        ((symbolp x)
diff --git a/jacl-tests.lisp b/jacl-tests.lisp
index 87136e6..d802c3b 100644
--- a/jacl-tests.lisp
+++ b/jacl-tests.lisp
@@ -94,6 +94,14 @@
 
 (\. @|QUnit| (|module| @"Control operators"))
 
+(deftest "JACL:%IF and CL:IF"
+  (assert= (jacl:%if t 1) 1)
+  (assert= (jacl:%if nil 1 123) 123)
+  (assert= (jacl:%if nil 1) nil)
+  (assert= (if t 1) 1)
+  (assert= (if nil 1 123) 123)
+  (assert= (if nil 1) nil))
+
 (deftest "Local TAGBODY"
   (let ((x 10)
         (y 0))
@@ -115,6 +123,12 @@
      end)
     (assert= x 0)))
 
+(deftest "CL:DOLIST"
+  (let ((sum 0))
+    (dolist (x '(1 1 1))
+      (setq sum (1+ sum)))
+    (assert= sum 3)))
+
 (defun countdown (from)
   (tagbody
    start
diff --git a/jacl.js b/jacl.js
index 8569af2..8f878ed 100644
--- a/jacl.js
+++ b/jacl.js
@@ -1197,9 +1197,11 @@ const parseLambdaList = list => {
 const analyzeLambdaList = (env, parent, list) => {
   const sections = parseLambdaList(list);
   env = env.withLocals(sections.required);
+  const initforms = [];
   for (const spec of sections.optional) {
     if (spec.initform !== UNDEFINED) {
       spec.initform = analyze(env, parent, spec.initform);
+      initforms.push(spec.initform)
     }
     env = env.withLocals([spec.name]);
     if (spec.svar !== UNDEFINED) {
@@ -1211,6 +1213,7 @@ const analyzeLambdaList = (env, parent, list) => {
   for (const spec of sections.key) {
     if (spec.initform !== UNDEFINED) {
       spec.initform = analyze(env, parent, spec.initform);
+      initforms.push(spec.initform)
     }
     env = env.withLocals([spec.name]);
     if (spec.svar !== UNDEFINED) {
@@ -1220,11 +1223,13 @@ const analyzeLambdaList = (env, parent, list) => {
   for (const spec of sections.aux) {
     if (spec.initform !== UNDEFINED) {
       spec.initform = analyze(env, parent, spec.initform);
+      initforms.push(spec.initform)
     }
     env = env.withLocals([spec.name]);
   }
   return {
     lambdaList: sections,
+    initforms: initforms,
     bodyEnv: env
   };
 };
@@ -1276,13 +1281,11 @@ const analyzeSpecials = new Map([
       body = body.slice(1);
     }
     node = makeNode('lambda', { env: env, parent: parent, form: form, declarations: declarations });
-    // TODO Lambda list initforms should be considered children.
-    const { lambdaList, bodyEnv } = analyzeLambdaList(env.withContext('expr'), node, list);
+    const { lambdaList, initforms, bodyEnv } = analyzeLambdaList(env.withContext('expr'), node, list);
     node.lambdaList = lambdaList;
-    return merge(
-      node,
-      analyzeBlock(bodyEnv, node, body)
-    );
+    node = merge(node, analyzeBlock(bodyEnv, node, body));
+    node.children = [...node.children, ...initforms];
+    return node;
   }],
   [JACLPKG.intern('%JS'), (env, parent, form) => {
     const [, template, ...args] = form,
@@ -1445,8 +1448,10 @@ const analyzeSpecials = new Map([
     });
   }],
   [JACLPKG.intern('%IF'), (env, parent, form) => {
-    if ([...form].length < 4) throw new Error(`IF requires at least 3 args`);
-    const [, pred, expr0, expr1] = form;
+    if ([...form].length < 3) throw new Error(`IF requires at least 2 args`);
+    let [, pred, expr0, expr1] = form;
+    if (expr1 === undefined)
+      expr1 = null;
     const childEnv = env.context === 'return' ? env.withContext('expr') : env;
 
     const node = makeNode('if', {