wip macros

qic.c

@@ -1062,6 +1062,7 @@ struct _node_t {
     N_MIF,
     N_MFOR,
     N_MSET,
+    N_MPUSH,
     N_MSTMT,
     N_MEXPR
   } tag;
@@ -1312,7 +1313,7 @@ typedef struct {
   int variable;
 } macro_t;
 
-table_t *MACROS;
+list_t *MACROS;
 
 #define LABELLOOP(n)\
   node_t *ln = (n);\
@@ -2448,7 +2449,17 @@ node_t *parse_mexpr(list_t *tokens, size_t *pos);
 node_t *parse_mprimary(list_t *tokens, size_t *pos) {
   if (MATCH(STAR))
     return NODET(LITERAL, token(T_NAME, strdup("*")));
-  else if (MATCH(LPAR)) {
+  else if (MATCHM("{")) {
+    node_t *a = parse_stmt(tokens, pos);
+
+    if (!MATCHM("}"))
+      PARSE_ERROR("expected }$");
+
+    if (a->tag == N_EXPRSTMT)
+      a = a->a;
+
+    return NODE1(MSTMT, a);
+  } else if (MATCH(LPAR)) {
     node_t *a = parse_mexpr(tokens, pos);
 
     EXPECT(RPAR, ")");
@@ -2535,7 +2546,19 @@ node_t *parse_mexpr(list_t *tokens, size_t *pos) {
       a = NODE2(EQUALS, a, b);
 
       continue;
-    }
+    } else if (MATCH(LT)) {
+      node_t *b = parse_mprimary(tokens, pos);
+
+      a = NODE2(LT, a, b);
+
+      continue;
+    } else if (MATCH(GT)) {
+      node_t *b = parse_mprimary(tokens, pos);
+
+      a = NODE2(GT, a, b);
+
+      continue;
+    } 
 
     break;
   } while (1);
@@ -2592,6 +2615,14 @@ node_t *parse_mstmt(list_t *tokens, size_t *pos) {
     node_t *a = parse_mexpr(tokens, pos);
 
     return NODE1t(MSET, a, t);
+  } else if (MATCHM("push")) {
+    if(!AT(NAME))
+      PARSE_ERROR("expected identifier");
+
+    token_t *t = tokens->data[(*pos)++];
+    node_t *a = parse_mexpr(tokens, pos);
+
+    return NODE1t(MPUSH, a, t);
   } else if (MATCHM("$")) {
     node_t *a = parse_stmt(tokens, pos);
 
@@ -2620,6 +2651,16 @@ node_t *parse_mstmt(list_t *tokens, size_t *pos) {
   return NULL;
 }
 
+list_t *macros_get(char *name) {
+  list_t *val = NULL;
+
+  for (ssize_t i = MACROS->length-1; i >= 0; i--)
+    if ((val = table_get(MACROS->data[i], name)))
+      break;
+
+  return val;
+}
+
 node_t *parse_program(list_t *tokens, size_t *pos) {
   if (AT(EOF))
     PARSE_ERROR("empty program");
@@ -2703,11 +2744,11 @@ node_t *parse_program(list_t *tokens, size_t *pos) {
         EXPECT(RCB, "}");
       }
 
-      list_t *ms = table_get(MACROS, name);
+      list_t *ms = macros_get(name);
       if (!ms) {
         ms = list_new();
 
-        table_set(MACROS, name, ms);
+        table_set(list_index(MACROS, -1), name, ms);
       }
 
       macro_t *m = malloc_checked(sizeof(macro_t));
@@ -2967,6 +3008,7 @@ void compile_func(buffer_t *gbuf, buffer_t *buf, list_t *ctx, table_t *ltab, int
   CTXPUSH("gap");
   CTXPUSH("func");
   list_push(CONSTANTS, table_new());
+  list_push(MACROS, table_new());
   list_push(FUNCNAMES, funname);
 
   if (DEBUG) emit_debug(tbuf, node);
@@ -2995,6 +3037,7 @@ void compile_func(buffer_t *gbuf, buffer_t *buf, list_t *ctx, table_t *ltab, int
   compile_node(gbuf, tbuf, ctx, table_new(), stack_new(), stack_new(), lbl, node->a);
 
   list_pop(FUNCNAMES);
+  list_pop(MACROS);
   list_pop(CONSTANTS);
   CTXPOP();
   CTXPOP();
@@ -3579,6 +3622,73 @@ node_t *mexpr_mul(node_t *a, node_t *b) {
   return make_number(TO_DOUBLE(a) * TO_DOUBLE(b));
 }
 
+int mexpr_equals(node_t *a, node_t *b) {
+  if (!a && !b) return 1;
+  if (!a && b) return 0;
+  if (a && !b) return 0;
+
+  if (a->tag != b->tag) return 0;
+
+  switch (a->tag) {
+    case N_LITERAL:
+      return a->t->tag == b->t->tag && strcmp(a->t->text, b->t->text) == 0;
+
+    default: break;
+  }
+
+  return 0;
+}
+
+int mexpr_less(node_t *a, node_t *b) {
+  if (!IS_NUMBER(a))
+    return 0;
+
+  if (!IS_NUMBER(b))
+    return 0;
+
+  return TO_DOUBLE(a) < TO_DOUBLE(b);
+}
+
+int mexpr_greater(node_t *a, node_t *b) {
+  if (!IS_NUMBER(a))
+    return 0;
+
+  if (!IS_NUMBER(b))
+    return 0;
+
+  return TO_DOUBLE(a) > TO_DOUBLE(b);
+}
+
+node_t *mexpr_eval(node_t *n) {
+  if (n)
+    switch (n->tag) {
+      case N_UNARY_PLUS: return mexpr_eval(n->a); break;
+      case N_NEGATE: {
+        node_t *a = mexpr_eval(n->a);
+
+        return mexpr_negate(a);
+      }
+
+      case N_ADD: {
+        node_t *a = mexpr_eval(n->a);
+        node_t *b = mexpr_eval(n->b);
+
+        return mexpr_add(a, b);
+      }
+
+      case N_SUB: {
+        node_t *a = mexpr_eval(n->a);
+        node_t *b = mexpr_eval(n->b);
+
+        return mexpr_sub(a, b);
+      }
+
+      default: break;
+    }
+
+  return n;
+}
+
 node_t *mf_isExpr(list_t *t) {
   if (t->length != 1)
     return NULL;
@@ -3682,6 +3792,15 @@ node_t *mf_nth(list_t *t) {
   return NULL;
 }
 
+node_t *mf_E(list_t *t) {
+  if (t->length != 1)
+    return NULL;
+
+  node_t *a = t->data[0];
+
+  return mexpr_eval(a);
+}
+
 struct {
   char *name;
   node_t *(*handler)(list_t *);
@@ -3696,11 +3815,13 @@ struct {
   { "len", mf_len },
   { "nth", mf_nth },
 
+  { "E", mf_E },
+
   { NULL, NULL }
 };
 
 macro_t *find_macro(char *name, size_t argc, int *res) {
-  list_t *ms = table_get(MACROS, name);
+  list_t *ms = macros_get(name);
 
   if (!ms) {
     if (res) *res = 1;
@@ -3730,23 +3851,12 @@ macro_t *find_macro(char *name, size_t argc, int *res) {
   return m;
 }
 
-int mexpr_equals(node_t *a, node_t *b) {
-  if (!a && !b) return 1;
-  if (!a && b) return 0;
-  if (a && !b) return 0;
-
-  if (a->tag != b->tag) return 0;
-
-  switch (a->tag) {
-    case N_LITERAL:
-      return a->t->tag == b->t->tag && strcmp(a->t->text, b->t->text) == 0;
-
-    default: break;
-  }
-
-  return 0;
-}
+typedef struct {
+  char *mvar;
+  int code;
+} mvar_expand_err_t;
 
+node_t *_expand_mvars(node_t *node, int expr, mvar_expand_err_t *err);
 node_t *run_macro(macro_t *macro, list_t *args);
 
 node_t *run_mexpr(node_t *node) {
@@ -3764,6 +3874,16 @@ node_t *run_mexpr(node_t *node) {
       }
       break;
 
+    case N_MSTMT: {
+      mvar_expand_err_t err = {NULL, 0};
+      node_t *n = _expand_mvars(node->a, 1, &err);
+
+      if (!n || err.code != 0)
+        return NULL;
+
+      return n;
+    } break;
+
     case N_CALL: case N_MACRO_CALL: {
       list_t *args = list_new();
 
@@ -3825,6 +3945,20 @@ node_t *run_mexpr(node_t *node) {
       return mexpr_equals(a, b)? YES: NULL;
     }
 
+    case N_LT: {
+      node_t *a = run_mexpr(node->a);
+      node_t *b = run_mexpr(node->b);
+
+      return mexpr_less(a, b)? YES: NULL;
+    }
+
+    case N_GT: {
+      node_t *a = run_mexpr(node->a);
+      node_t *b = run_mexpr(node->b);
+
+      return mexpr_greater(a, b)? YES: NULL;
+    }
+    
     default:
       COMPILE_ERROR("not yet implemented");
   }
@@ -3864,6 +3998,15 @@ node_t *run_mnode(node_t *node) {
       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) {
+        node_t *n = run_mexpr(node->a);
+        if (IS_EXPR(n))
+          list_push(l->l, n);
+      }
+      } break;
+
     case N_MSTMT:
       r = node->a;
       break;
@@ -3882,10 +4025,9 @@ node_t *run_mnode(node_t *node) {
 node_t *run_macro(macro_t *macro, list_t *args) {
   table_t *mvars = list_index(MVARS, -1);
   table_set(mvars, "nil", NULL);
+  table_set(mvars, "*", nodel(N_LIST, args));
 
-  if (macro->variable)
-    table_set(mvars, "*", nodel(N_LIST, args));
-  else 
+  if (!macro->variable)
     for (size_t i = 0; i < args->length; i++)
       table_set(mvars, ((token_t *)macro->params->data[i])->text, args->data[i]);
 
@@ -3900,11 +4042,6 @@ node_t *run_macro(macro_t *macro, list_t *args) {
   return r;
 }
 
-typedef struct {
-  char *mvar;
-  int code;
-} mvar_expand_err_t;
-
 node_t *_expand_mvars(node_t *node, int expr, mvar_expand_err_t *err) {
   if (node->tag == N_LITERAL) return node;
 
@@ -3953,12 +4090,12 @@ node_t *_expand_mvars(node_t *node, int expr, mvar_expand_err_t *err) {
     if (err->code != 0) return NULL;
 
     return node;
-  } else if (node->tag == N_PROGRAM || node->tag == N_LIST) {
+  } else if (node->tag == N_PROGRAM || node->tag == N_LIST || node->tag == N_TUPLE) {
     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], node->tag == N_LIST, err);
+      node_t *n = _expand_mvars(node->l->data[i], node->tag == N_LIST || node->tag == N_TUPLE, err);
       if (err->code != 0) return NULL;
 
       node->l->data[i] = n;
@@ -3975,7 +4112,7 @@ node_t *_expand_mvars(node_t *node, int expr, mvar_expand_err_t *err) {
 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_copy(_node), expr, &err);
+  node_t *r = _expand_mvars(_node, expr, &err);
   if (err.code == 1) {
     COMPILE_ERROR("undefined macro variable: '%s'", err.mvar);
   } else if (err.code == 2) {
@@ -4048,9 +4185,11 @@ void compile_node(buffer_t *gbuf, buffer_t *buf, list_t *ctx, table_t *ltab, int
       LBPUSH();
       CTXPUSH("scope");
       list_push(CONSTANTS, table_new());
+      list_push(MACROS, table_new());
       EMIT("qi_new_scope(state);\n");
       compile_block(gbuf, buf, ctx, ltab, lstk, sstk, lbl, node->l);
       EMIT("qi_old_scope(state);");
+      list_pop(MACROS);
       list_pop(CONSTANTS);
       CTXPOP();
       LBPOP();
@@ -4703,7 +4842,9 @@ void compile_node(buffer_t *gbuf, buffer_t *buf, list_t *ctx, table_t *ltab, int
       LBPUSH();
       CTXPUSH("gap");
       list_push(CONSTANTS, table_new());
+      list_push(MACROS, table_new());
       compile_node(gbuf, tbuf, ctx, table_new(), stack_new(), stack_new(), lbl, node->a);
+      list_pop(MACROS);
       list_pop(CONSTANTS);
       CTXPOP();
       LBPOP();
@@ -5094,12 +5235,12 @@ int main(int argc, char **argv) {
 
   CONSTANTS = list_new();
   list_push(CONSTANTS, table_new());
+  MACROS = list_new();
+  list_push(MACROS, table_new());
 
   HBUF = buffer_new();
   MVARS = list_new();
 
-  MACROS = table_new();
-
   genmathlib();
 
   char *out;