|
@@ -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;
|