wip macros

qic.c

@@ -1061,6 +1061,7 @@ struct _node_t {
 
     N_MIF,
     N_MFOR,
+    N_MREPEAT,
     N_MSET,
     N_MPUSH,
     N_MSTMT,
@@ -1308,6 +1309,8 @@ node_t *nodeb(buffer_t *buf) {
 }
 
 typedef struct {
+  char *name;
+
   list_t *params;
   list_t *body;
   int variable;
@@ -2613,6 +2616,17 @@ node_t *parse_mstmt(list_t *tokens, size_t *pos) {
     PARSE_ERROR("expected $endfor");
 
     return NODE1l(MFOR, a, l);
+  } else if (MATCHM("repeat")) {
+    node_t *a = parse_mexpr(tokens, pos);
+    list_t *l = list_new();
+
+    while (!AT(EOF) && !ATM("endrep"))
+      list_push(l, parse_mstmt(tokens, pos));
+
+    if (!MATCHM("endrep"))
+    PARSE_ERROR("expected $endrep");
+
+    return NODE1l(MREPEAT, a, l);
   } else if (MATCHM("set")) {
     if(!AT(NAME))
       PARSE_ERROR("expected identifier");
@@ -2652,9 +2666,12 @@ node_t *parse_mstmt(list_t *tokens, size_t *pos) {
   } else if (MATCHM(":"))
     return NODE1(MEXPR, parse_mexpr(tokens, pos));
 
-  PARSE_ERROR("expected m-statement");
+  node_t *a = parse_stmt(tokens, pos);
 
-  return NULL;
+  if (a->tag == N_EXPRSTMT)
+      a = a->a;
+
+  return a;
 }
 
 list_t *macros_get(char *name) {
@@ -2758,6 +2775,7 @@ node_t *parse_program(list_t *tokens, size_t *pos) {
       }
 
       macro_t *m = malloc_checked(sizeof(macro_t));
+      m->name = name;
       m->params = params;
       m->body = body;
       m->variable = variable;
@@ -2817,6 +2835,7 @@ node_t *parse(char *source) {
   });\
 }
 #define COMPILE_ERROR(fmt, ...) { format_error(GETFNAME(node->fi), GETSRC(node->fi), node->pos, fmt, ##__VA_ARGS__); exit(1); }
+#define COMPILE_NOTE(fmt, ...) { format_error(GETFNAME(node->fi), GETSRC(node->fi), node->pos, fmt, ##__VA_ARGS__); }
 
 void compile_node(buffer_t *gbuf, buffer_t *buf, list_t *ctx, table_t *ltab, int_stack_t *lstk, int_stack_t *sstk, list_t *lbl, node_t *node);
 
@@ -3758,6 +3777,16 @@ node_t *mf_newList(list_t *t) {
   return nodel(N_LIST, t);
 }
 
+node_t *mf_newBlock(list_t *t) {
+  for (size_t i = 0; i < t->length; i++)
+    if (!t->data[i])
+      return NULL;
+    else if (IS_EXPR(t->data[i]))
+      t->data[i] = node1(N_EXPRSTMT, t->data[i]);
+
+  return nodel(N_PROGRAM, t);
+}
+
 node_t *mf_newName(list_t *t) {
   if (t->length != 1)
     return NULL;
@@ -3860,6 +3889,7 @@ struct {
 
   { "newName", mf_newName },
   { "newList", mf_newList },
+  { "newBlock", mf_newBlock },
   { "newVar", mf_newVar },
 
   { "len", mf_len },
@@ -3903,7 +3933,7 @@ macro_t *find_macro(char *name, size_t argc, int *res) {
 }
 
 typedef struct {
-  char *mvar;
+  node_t *mvar;
   int code;
 } mvar_expand_err_t;
 
@@ -4052,16 +4082,40 @@ node_t *run_mnode(node_t *node) {
         if ((r = run_mnodes(node->l))) break;
       break;
 
+    case N_MREPEAT: {
+      list_t *l = list_new();
+
+      while (run_mexpr(node->a)) {
+        node_t *n = run_mnodes(node->l);
+
+        if (!n) return NULL;
+
+        if (IS_EXPR(n))
+          n = node1(N_EXPRSTMT, n);
+
+        list_push(l, n);
+      }
+
+      r = nodel(N_PROGRAM, l);
+      } break;
+
     case N_MSET:
       table_set(list_index(MVARS, -1), node->t->text, run_mexpr(node->a));
       break;
 
     case N_MPUSH: {
       node_t *l = table_get(list_index(MVARS, -1), node->t->text);
-      if (l && l->tag == N_LIST) {
+      if (l && (l->tag == N_LIST || l->tag == N_PROGRAM)) {
         node_t *n = run_mexpr(node->a);
-        if (IS_EXPR(n))
-          list_push(l->l, n);
+        if (!n) break;
+
+        if (IS_EXPR(n)) {
+          if (l->tag == N_PROGRAM)
+            n = node1(N_EXPRSTMT, n);
+          else break;
+        }
+
+        list_push(l->l, n);
       }
       } break;
 
@@ -4074,13 +4128,22 @@ node_t *run_mnode(node_t *node) {
       break;
 
     default:
-      COMPILE_ERROR("not yet implemented");
+      r = node;
   }
 
   return r;
 }
 
+list_t *macro_stk;
+size_t expand_depth = 0;
+size_t macro_rlimit = 100;
+
 node_t *run_macro(macro_t *macro, list_t *args) {
+  if (macro_stk->length >= macro_rlimit)
+    return NULL;
+
+  list_push(macro_stk, macro);
+
   table_t *mvars = list_index(MVARS, -1);
   table_set(mvars, "nil", NULL);
   table_set(mvars, "*", nodel(N_LIST, args));
@@ -4097,6 +4160,8 @@ node_t *run_macro(macro_t *macro, list_t *args) {
     if (r) break;
   }
 
+  list_pop(macro_stk);
+
   return r;
 }
 
@@ -4105,7 +4170,7 @@ node_t *_expand_mvars(node_t *node, int expr, mvar_expand_err_t *err) {
 
   if (node->tag == N_MVAR) {
     char *name = node->t->text;
-    err->mvar = name;
+    err->mvar = node;
 
     table_t *mvars = list_index(MVARS, -1);
 
@@ -4159,6 +4224,56 @@ node_t *_expand_mvars(node_t *node, int expr, mvar_expand_err_t *err) {
       node->l->data[i] = n;
     }
 
+    return node;
+  } else if (node->tag == N_IF) {
+    node = node_copy(node);
+
+    node->a = _expand_mvars(node->a, 1, err);
+    if (err->code != 0) return NULL;
+
+    node->b = _expand_mvars(node->b, 1, err);
+    if (err->code != 0) return NULL;
+
+    if (node->c) {
+      node->c = _expand_mvars(node->c, 1, err);
+      if (err->code != 0) return NULL;
+    }
+
+    return node;
+  } else if (node->tag == N_CALL) {
+    node = node_copy(node);
+
+    node->a = _expand_mvars(node->a, 1, err);
+    if (err->code != 0) return NULL;
+
+    node->l = list_copy(node->l);
+
+    for (size_t i = 0; i < node->l->length; i++) {
+      node_t *n = _expand_mvars(node->l->data[i], 1, err);
+      if (err->code != 0) return NULL;
+
+      node->l->data[i] = n;
+    }
+
+    return node;
+  } else if (node->tag == N_MACRO_CALL) {
+    node = node_copy(node);
+    node->l = list_copy(node->l);
+
+    for (size_t i = 0; i < node->l->length; i++) {
+      node_t *n = _expand_mvars(node->l->data[i], 1, err);
+      if (err->code != 0) return NULL;
+
+      node->l->data[i] = n;
+    }
+
+    return node;
+  } else if (node->tag == N_INC || node->tag == N_DEC) {
+    node = node_copy(node);
+
+    node->a = _expand_mvars(node->a, 1, err);
+    if (err->code != 0) return NULL;
+
     return node;
   }
 
@@ -4171,12 +4286,18 @@ node_t *expand_mvars(node_t *node, node_t *_node, int expr) {
   mvar_expand_err_t err = {NULL, 0};
 
   node_t *r = _expand_mvars(_node, expr, &err);
+  if ((!r || err.code != 0) && err.mvar) {
+    COMPILE_NOTE("macro expansion failed");
+
+    node = err.mvar;
+  }
+
   if (err.code == 1) {
-    COMPILE_ERROR("undefined macro variable: '%s'", err.mvar);
+    COMPILE_ERROR("undefined macro variable: '%s'", err.mvar->t->text);
   } else if (err.code == 2) {
-    COMPILE_ERROR("macro variable '%s' expanded to non-expression in expression context", err.mvar);
+    COMPILE_ERROR("macro variable '%s' expanded to non-expression in expression context", err.mvar->t->text);
   } else if (err.code == 3) {
-    COMPILE_ERROR("macro variable '%s' expanded to nil", err.mvar);
+    COMPILE_ERROR("macro variable '%s' expanded to nil", err.mvar->t->text);
   } else if (err.code == 4) {
     COMPILE_ERROR("macro variable expansion failed because it is not yet implemented for this context");
   }
@@ -4203,11 +4324,29 @@ void compile_macro_call(buffer_t *gbuf, buffer_t *buf, list_t *ctx, table_t *lta
 
   list_push(MVARS, table_new());
 
+  if (macro_stk->length >= macro_rlimit)
+    COMPILE_ERROR("recursion depth limit exceeded while expanding macro: '%s'", name);
+
   node_t *r = run_macro(m, node->l);
 
   if (r) {
     r = expand_mvars(node, r, expr);
 
+    if (r->tag == N_MACRO_CALL) {
+      list_pop(MVARS);
+
+      if (expand_depth >= macro_rlimit)
+        COMPILE_ERROR("recursion depth limit exceeded while expanding macro: '%s'", name);
+
+      expand_depth++;
+
+      compile_macro_call(gbuf, buf, ctx, ltab, lstk, sstk, lbl, r, expr);
+
+      expand_depth--;
+
+      return;
+    }
+
     if (expr && !IS_EXPR(r))
       COMPILE_ERROR("macro '%s' expanded to non-expression in expression context", name);
 
@@ -5297,6 +5436,8 @@ int main(int argc, char **argv) {
   MACROS = list_new();
   list_push(MACROS, table_new());
 
+  macro_stk = list_new();
+
   HBUF = buffer_new();
   MVARS = list_new();