git » jacl.git » commit 62717dc

diff --git a/jacl.js b/jacl.js
index 85d7e66..1e64993 100644
--- a/jacl.js
+++ b/jacl.js
@@ -722,12 +722,12 @@ const analyzeSpecials = new Map([
       op: "js-field",
       env: env,
       form: form,
-      target: analyze(env.withContext("expr"), target),
+      target: analyze(env.withContext("sval"), target),
       field: field instanceof LispSymbol ? field.name : field.toString()
     };
   }],
   [JACLPKG.intern("%CALL"), (env, form) => {
-    env = env.withContext("expr");
+    env = env.withContext("sval");
     const [, func, ...args] = form;
     return {
       op: "call",
@@ -754,7 +754,7 @@ const analyzeSpecials = new Map([
     }
 
     const bodyEnv = env.withContext("return");
-    argNames.forEach(s => bodyEnv.locals.val.add(s));
+    argNames.forEach(s => bodyEnv.localVals.add(s));
 
     return merge({
         op: "lambda",
@@ -766,6 +766,45 @@ const analyzeSpecials = new Map([
         argNames: argNames,
       },
       analyzeBlock(bodyEnv, exprs));
+  }],
+  [JACLPKG.intern("%TAGBODY"), (env, form) => {
+    const [, ...tagsStmts] = form;
+    const isTag = x => x instanceof LispSymbol 
+      || typeof x === 'number'
+      || x instanceof Number;
+    const asTagName = x => x instanceof LispSymbol ? x.name : x.valueOf();
+    // Map from tag names (string or int) to arrays of statements
+    // Any statements that appear before a tag are stored with the null tag
+    // Tags/statements are processed in multiple passes because any parent tag
+    // can be jumped to from any child even if the child appears after the tag
+    
+    // First pass: gather tags and statements, don't analyze
+    const newEnv = env.clone().withContext("statement");
+    const tags = new Map();
+    let currentTag = null, currentStmts = [];
+    for (const x of tagsStmts) {
+      if (isTag(x)) {
+        tags.set(currentTag, currentStmts);
+        if (currentTag !== null) newEnv.tagbodyTags.add(currentTag);
+        currentTag = asTagName(x);
+        currentStmts = [];
+      } else {
+        currentStmts.push(x);
+      }
+    }
+    if (currentTag !== null) newEnv.tagbodyTags.add(currentTag);
+    tags.set(currentTag, currentStmts);
+
+    // Second pass: analyze statements
+    const ana = analyze.bind(null, newEnv);
+    for (const [tag, stmts] of tags) tags.set(tag, stmts.map(ana));
+
+    return {
+      op: "tagbody",
+      env: env,
+      form: form,
+      tags: tags
+    };
   }]
 ]);
 
@@ -774,7 +813,7 @@ const parseCall = (env, form) => {
   let f;
   if (isLambdaForm(func)) {
     f = analyze(env, func);
-  } else if (func instanceof LispSymbol && env.locals.fun.has(func.name)) {
+  } else if (func instanceof LispSymbol && env.localFuns.has(func.name)) {
     f = { env: env, form: func, op: "local", name: munge(func.name) };
   } else if (func instanceof LispSymbol) {
     f = { env: env, form: func, op: "global", slot: "function" };
@@ -783,7 +822,7 @@ const parseCall = (env, form) => {
     env: env,
     op: "call",
     f: f,
-    args: args.map(analyze.bind(null, env.withContext("expr")))
+    args: args.map(analyze.bind(null, env.withContext("sval")))
   };
 };
 
@@ -809,7 +848,7 @@ const analyzeSymbol = (env, form) => {
     return ret({ op: "constant" });
   } else if (form.packageName === 'JS' && !form.getPackage().isExported(form.name)) {
     return ret({ op: "js-var", name: form.name });
-  } else if (env.locals.val.has(form.name)) {
+  } else if (env.localVals.has(form.name)) {
     return ret({ op: "local", name: munge(form.name) });
   } else {
     return ret({ op: "global", slot: "value" });
@@ -818,27 +857,29 @@ const analyzeSymbol = (env, form) => {
 
 class Env {
   constructor(init = true) {
-    this.locals = {}
     if (init) Env.init(this);
     return this;
   }
   static init(env) {
-    env.locals.fun = new Set();
-    env.locals.val = new Set();
-    env.context = "expr";
+    env.localFuns = new Set();
+    env.localVals = new Set();
+    env.tagbodyTags = new Set();
+    env.context = "sval";
     return env;
   }
   clone() {
     const newEnv = new Env(false);
-    newEnv.locals.fun = new Set(this.locals.fun);
-    newEnv.locals.val = new Set(this.locals.val);
+    newEnv.localFuns = new Set(this.localFuns);
+    newEnv.localVals = new Set(this.localVals);
+    newEnv.tagbodyTags = new Set(this.tagbodyTags);
     newEnv.context = this.context;
     return newEnv;
   }
   withContext(context) {
     const newEnv = new Env(false);
-    newEnv.locals.fun = this.locals.fun;
-    newEnv.locals.val = this.locals.val;
+    newEnv.localFuns = this.localFuns;
+    newEnv.localVals = this.localVals;
+    newEnv.tagbodyTags = this.tagbodyTags;
     newEnv.context = context;
     return newEnv;
   }