X-Git-Url: https://ocean-lang.org/code/?p=ocean;a=blobdiff_plain;f=csrc%2Foceani.mdc;h=9720d222fac37ffced3f0494c446e3af2203eb19;hp=5bf754e8fe52ced6af10691f0519f2c47f2c18fc;hb=e4967da39aff091cd9dfa187cf77c84ba8643293;hpb=923ca343c74104bfa366b6d3adc09b14e11cadfa diff --git a/csrc/oceani.mdc b/csrc/oceani.mdc index 5bf754e..9720d22 100644 --- a/csrc/oceani.mdc +++ b/csrc/oceani.mdc @@ -246,7 +246,7 @@ structures can be used. prepare_types(&context); if (!context.parse_error && !analyse_funcs(&context)) { fprintf(stderr, "oceani: type error in program - not running.\n"); - context.parse_error = 1; + context.parse_error += 1; } if (doprint) { @@ -395,14 +395,14 @@ context so indicate that parsing failed. } } fputs("\n", stderr); - c->parse_error = 1; + c->parse_error += 1; } static void tok_err(struct parse_context *c, char *fmt, struct token *t) { fprintf(stderr, "%s:%d:%d: %s: %.*s\n", c->file_name, t->line, t->col, fmt, t->txt.len, t->txt.txt); - c->parse_error = 1; + c->parse_error += 1; } ## Entities: declared and predeclared. @@ -583,15 +583,18 @@ program and looking for errors. So `propagate_types` is passed an expected type (being a `struct type` pointer together with some `val_rules` flags) that the `exec` is -expected to return, and returns the type that it does return, either -of which can be `NULL` signifying "unknown". An `ok` flag is passed -by reference. It is set to `0` when an error is found, and `2` when -any change is made. If it remains unchanged at `1`, then no more -propagation is needed. +expected to return, and returns the type that it does return, either of +which can be `NULL` signifying "unknown". A `prop_err` flag set is +passed by reference. It has `Efail` set when an error is found, and +`Eretry` when the type for some element is set via propagation. If +any expression cannot be evaluated immediately, `Enoconst` is set. + +If it remains unchanged at `0`, then no more propagation is needed. ###### ast enum val_rules {Rnolabel = 1<<0, Rboolok = 1<<1, Rnoconstant = 1<<2}; + enum prop_err {Efail = 1<<0, Eretry = 1<<1, Enoconst = 1<<2}; ###### format cases case 'r': @@ -600,11 +603,11 @@ propagation is needed. break; ###### forward decls - static struct type *propagate_types(struct exec *prog, struct parse_context *c, int *ok, + static struct type *propagate_types(struct exec *prog, struct parse_context *c, enum prop_err *perr, struct type *type, int rules); ###### core functions - static struct type *__propagate_types(struct exec *prog, struct parse_context *c, int *ok, + static struct type *__propagate_types(struct exec *prog, struct parse_context *c, enum prop_err *perr, struct type *type, int rules) { struct type *t; @@ -626,13 +629,14 @@ propagation is needed. return Tnone; } - static struct type *propagate_types(struct exec *prog, struct parse_context *c, int *ok, + static struct type *propagate_types(struct exec *prog, struct parse_context *c, enum prop_err *perr, struct type *type, int rules) { - struct type *ret = __propagate_types(prog, c, ok, type, rules); + int pre_err = c->parse_error; + struct type *ret = __propagate_types(prog, c, perr, type, rules); - if (c->parse_error) - *ok = 0; + if (c->parse_error > pre_err) + *perr |= Efail; return ret; } @@ -1125,7 +1129,7 @@ A separate function encoding these cases will simplify some code later. mpf_t fl; mpf_init2(fl, 20); mpf_set_q(fl, v->num); - gmp_fprintf(f, "%Fg", fl); + gmp_fprintf(f, "%.10Fg", fl); mpf_clear(fl); break; } @@ -1239,6 +1243,7 @@ executable. struct val *v = cast(val, e); if (v->vtype == Tstr) printf("\""); + // FIXME how to ensure numbers have same precision. print_value(v->vtype, &v->val, stdout); if (v->vtype == Tstr) printf("\""); @@ -1870,7 +1875,7 @@ tell if it was set or not later. { if (!v->global) { if (!c->local || !v->type) - return NULL; + return NULL; // UNTESTED if (v->frame_pos + v->type->size > c->local_size) { printf("INVALID frame_pos\n"); // NOTEST exit(2); // NOTEST @@ -2071,7 +2076,11 @@ correctly. struct variable *v = var_ref(c, $1.txt); $0 = new_pos(var, $1); if (v == NULL) { - /* This might be a label - allocate a var just in case */ + /* This might be a global const or a label + * Allocate a var with impossible type Tnone, + * which will be adjusted when we find out what it is, + * or will trigger an error. + */ v = var_decl(c, $1.txt); if (v) { v->type = Tnone; @@ -2128,19 +2137,19 @@ correctly. type_err(c, "error: variable used but not declared: %v", prog, NULL, 0, NULL); if (v->type == NULL) { - if (type && *ok != 0) { + if (type && !(*perr & Efail)) { v->type = type; v->where_set = prog; - *ok = 2; + *perr |= Eretry; } - return type; - } - if (!type_compat(type, v->type, rules)) { + } else if (!type_compat(type, v->type, rules)) { type_err(c, "error: expected %1%r but variable '%v' is %2", prog, type, rules, v->type); type_err(c, "info: this is where '%v' was set to %1", v->where_set, v->type, rules, NULL); } + if (!v->global || v->frame_pos < 0) + *perr |= Enoconst; if (!type) return v->type; return type; @@ -2251,11 +2260,13 @@ with a const size by whether they are prepared at parse time or not. return; if (type->array.unspec && parse_time) return; + if (parse_time && type->array.vsize && !type->array.vsize->global) + return; if (type->array.vsize) { vsize = var_value(c, type->array.vsize); if (!vsize) - return; + return; // UNTESTED mpz_init(q); mpz_tdiv_q(q, mpq_numref(vsize->num), mpq_denref(vsize->num)); type->array.size = mpz_get_si(q); @@ -2444,8 +2455,8 @@ with a const size by whether they are prepared at parse time or not. /* left must be an array, right must be a number, * result is the member type of the array */ - propagate_types(b->right, c, ok, Tnum, 0); - t = propagate_types(b->left, c, ok, NULL, rules & Rnoconstant); + propagate_types(b->right, c, perr, Tnum, 0); + t = propagate_types(b->left, c, perr, NULL, rules & Rnoconstant); if (!t || t->compat != array_compat) { type_err(c, "error: %1 cannot be indexed", prog, t, 0, NULL); return NULL; @@ -2605,7 +2616,7 @@ function will be needed. return; for (f = t->structure.field_list; f; f=f->prev) { - int ok; + enum prop_err perr; cnt += 1; if (f->f.type->prepare_type) @@ -2613,11 +2624,11 @@ function will be needed. if (f->init == NULL) continue; do { - ok = 1; - propagate_types(f->init, c, &ok, f->f.type, 0); - } while (ok == 2); - if (!ok) - c->parse_error = 1; // NOTEST + perr = 0; + propagate_types(f->init, c, &perr, f->f.type, 0); + } while (perr & Eretry); + if (perr & Efail) + c->parse_error += 1; // NOTEST } t->structure.nfields = cnt; @@ -2707,7 +2718,7 @@ function will be needed. case Xfieldref: { struct fieldref *f = cast(fieldref, prog); - struct type *st = propagate_types(f->left, c, ok, NULL, 0); + struct type *st = propagate_types(f->left, c, perr, NULL, 0); if (!st) type_err(c, "error: unknown type for field access", f->left, // UNTESTED @@ -2913,7 +2924,7 @@ further detailed when Expression Lists are introduced. struct exec *function; ###### type functions - void (*check_args)(struct parse_context *c, int *ok, + void (*check_args)(struct parse_context *c, enum prop_err *perr, struct type *require, struct exec *args); ###### value functions @@ -2930,7 +2941,7 @@ further detailed when Expression Lists are introduced. return 0; } - static void function_check_args(struct parse_context *c, int *ok, + static void function_check_args(struct parse_context *c, enum prop_err *perr, struct type *require, struct exec *args) { /* This should be 'compat', but we don't have a 'tuple' type to @@ -2946,8 +2957,8 @@ further detailed when Expression Lists are introduced. args, NULL, 0, NULL); break; } - *ok = 1; - propagate_types(arg->left, c, ok, pv->var->type, 0); + *perr = 0; + propagate_types(arg->left, c, perr, pv->var->type, 0); param = cast(binode, param->right); arg = cast(binode, arg->right); } @@ -3146,7 +3157,8 @@ it in the "SimpleStatement Grammar" which will be described later. prog, NULL, 0, NULL); return NULL; } - v->var->type->check_args(c, ok, v->var->type, args); + *perr |= Enoconst; + v->var->type->check_args(c, perr, v->var->type, args); return v->var->type->function.return_type; } @@ -3259,9 +3271,9 @@ there. struct binode *b2 = cast(binode, b->right); struct type *t2; - propagate_types(b->left, c, ok, Tbool, 0); - t = propagate_types(b2->left, c, ok, type, Rnolabel); - t2 = propagate_types(b2->right, c, ok, type ?: t, Rnolabel); + propagate_types(b->left, c, perr, Tbool, 0); + t = propagate_types(b2->left, c, perr, type, Rnolabel); + t2 = propagate_types(b2->right, c, perr, type ?: t, Rnolabel); return t ?: t2; } @@ -3428,8 +3440,8 @@ evaluate the second expression if not necessary. case OrElse: case Not: /* both must be Tbool, result is Tbool */ - propagate_types(b->left, c, ok, Tbool, 0); - propagate_types(b->right, c, ok, Tbool, 0); + propagate_types(b->left, c, perr, Tbool, 0); + propagate_types(b->right, c, perr, Tbool, 0); if (type && type != Tbool) type_err(c, "error: %1 operation found where %2 expected", prog, Tbool, 0, type); @@ -3543,13 +3555,13 @@ expression operator, and the `CMPop` non-terminal will match one of them. case Eql: case NEql: /* Both must match but not be labels, result is Tbool */ - t = propagate_types(b->left, c, ok, NULL, Rnolabel); + t = propagate_types(b->left, c, perr, NULL, Rnolabel); if (t) - propagate_types(b->right, c, ok, t, 0); + propagate_types(b->right, c, perr, t, 0); else { - t = propagate_types(b->right, c, ok, NULL, Rnolabel); // UNTESTED + t = propagate_types(b->right, c, perr, NULL, Rnolabel); // UNTESTED if (t) // UNTESTED - t = propagate_types(b->left, c, ok, t, 0); // UNTESTED + t = propagate_types(b->left, c, perr, t, 0); // UNTESTED } if (!type_compat(type, Tbool, 0)) type_err(c, "error: Comparison returns %1 but %2 expected", prog, @@ -3713,8 +3725,8 @@ parentheses around an expression converts it into a Term, case Negate: /* as propagate_types ignores a NULL, * unary ops fit here too */ - propagate_types(b->left, c, ok, Tnum, 0); - propagate_types(b->right, c, ok, Tnum, 0); + propagate_types(b->left, c, perr, Tnum, 0); + propagate_types(b->right, c, perr, Tnum, 0); if (!type_compat(type, Tnum, 0)) type_err(c, "error: Arithmetic returns %1 but %2 expected", prog, Tnum, rules, type); @@ -3722,8 +3734,8 @@ parentheses around an expression converts it into a Term, case Concat: /* both must be Tstr, result is Tstr */ - propagate_types(b->left, c, ok, Tstr, 0); - propagate_types(b->right, c, ok, Tstr, 0); + propagate_types(b->left, c, perr, Tstr, 0); + propagate_types(b->right, c, perr, Tstr, 0); if (!type_compat(type, Tstr, 0)) type_err(c, "error: Concat returns %1 but %2 expected", prog, Tstr, rules, type); @@ -3731,7 +3743,7 @@ parentheses around an expression converts it into a Term, case StringConv: /* op must be string, result is number */ - propagate_types(b->left, c, ok, Tstr, 0); + propagate_types(b->left, c, perr, Tstr, 0); if (!type_compat(type, Tnum, 0)) type_err(c, // UNTESTED "error: Can only convert string to number, not %1", @@ -3739,7 +3751,7 @@ parentheses around an expression converts it into a Term, return Tnum; case Bracket: - return propagate_types(b->right, c, ok, type, 0); + return propagate_types(b->right, c, perr, type, 0); ###### interp binode cases @@ -4006,7 +4018,7 @@ the common header for all reductions to use. struct binode *e; for (e = b; e; e = cast(binode, e->right)) { - t = propagate_types(e->left, c, ok, NULL, rules); + t = propagate_types(e->left, c, perr, NULL, rules); if ((rules & Rboolok) && (t == Tbool || t == Tnone)) t = NULL; if (t == Tnone && e->right) @@ -4095,7 +4107,7 @@ printed. else b = cast(binode, b->right); while (b) { - propagate_types(b->left, c, ok, NULL, Rnolabel); + propagate_types(b->left, c, perr, NULL, Rnolabel); b = cast(binode, b->right); } break; @@ -4212,20 +4224,20 @@ it is declared, and error will be raised as the name is created as * For Assign, left must not be constant. * result is Tnone */ - t = propagate_types(b->left, c, ok, NULL, + t = propagate_types(b->left, c, perr, NULL, Rnolabel | (b->op == Assign ? Rnoconstant : 0)); if (!b->right) return Tnone; if (t) { - if (propagate_types(b->right, c, ok, t, 0) != t) + if (propagate_types(b->right, c, perr, t, 0) != t) if (b->left->type == Xvar) type_err(c, "info: variable '%v' was set as %1 here.", cast(var, b->left)->var->where_set, t, rules, NULL); } else { - t = propagate_types(b->right, c, ok, NULL, Rnolabel); + t = propagate_types(b->right, c, perr, NULL, Rnolabel); if (t) - propagate_types(b->left, c, ok, t, + propagate_types(b->left, c, perr, t, (b->op == Assign ? Rnoconstant : 0)); } if (t && t->dup == NULL && t->name.txt[0] != ' ') // HACK @@ -4302,7 +4314,7 @@ function which has a return type, and the "condition" code blocks in case Use: /* result matches value */ - return propagate_types(b->right, c, ok, type, 0); + return propagate_types(b->right, c, perr, type, 0); ###### interp binode cases @@ -4689,10 +4701,10 @@ casepart` to track a list of case parts. ###### propagate binode cases case Loop: - t = propagate_types(b->right, c, ok, Tnone, 0); + t = propagate_types(b->right, c, perr, Tnone, 0); if (!type_compat(Tnone, t, 0)) - *ok = 0; // UNTESTED - return propagate_types(b->left, c, ok, type, rules); + *perr |= Efail; // UNTESTED + return propagate_types(b->left, c, perr, type, rules); ###### propagate exec cases case Xcond_statement: @@ -4710,51 +4722,51 @@ casepart` to track a list of case parts. struct cond_statement *cs = cast(cond_statement, prog); struct casepart *cp; - t = propagate_types(cs->forpart, c, ok, Tnone, 0); + t = propagate_types(cs->forpart, c, perr, Tnone, 0); if (!type_compat(Tnone, t, 0)) - *ok = 0; // UNTESTED + *perr |= Efail; // UNTESTED if (cs->looppart) { - t = propagate_types(cs->thenpart, c, ok, Tnone, 0); + t = propagate_types(cs->thenpart, c, perr, Tnone, 0); if (!type_compat(Tnone, t, 0)) - *ok = 0; // UNTESTED + *perr |= Efail; // UNTESTED } if (cs->casepart == NULL) { - propagate_types(cs->condpart, c, ok, Tbool, 0); - propagate_types(cs->looppart, c, ok, Tbool, 0); + propagate_types(cs->condpart, c, perr, Tbool, 0); + propagate_types(cs->looppart, c, perr, Tbool, 0); } else { /* Condpart must match case values, with bool permitted */ t = NULL; for (cp = cs->casepart; cp && !t; cp = cp->next) - t = propagate_types(cp->value, c, ok, NULL, 0); + t = propagate_types(cp->value, c, perr, NULL, 0); if (!t && cs->condpart) - t = propagate_types(cs->condpart, c, ok, NULL, Rboolok); // UNTESTED + t = propagate_types(cs->condpart, c, perr, NULL, Rboolok); // UNTESTED if (!t && cs->looppart) - t = propagate_types(cs->looppart, c, ok, NULL, Rboolok); // UNTESTED + t = propagate_types(cs->looppart, c, perr, NULL, Rboolok); // UNTESTED // Now we have a type (I hope) push it down if (t) { for (cp = cs->casepart; cp; cp = cp->next) - propagate_types(cp->value, c, ok, t, 0); - propagate_types(cs->condpart, c, ok, t, Rboolok); - propagate_types(cs->looppart, c, ok, t, Rboolok); + propagate_types(cp->value, c, perr, t, 0); + propagate_types(cs->condpart, c, perr, t, Rboolok); + propagate_types(cs->looppart, c, perr, t, Rboolok); } } // (if)then, else, and case parts must return expected type. if (!cs->looppart && !type) - type = propagate_types(cs->thenpart, c, ok, NULL, rules); + type = propagate_types(cs->thenpart, c, perr, NULL, rules); if (!type) - type = propagate_types(cs->elsepart, c, ok, NULL, rules); + type = propagate_types(cs->elsepart, c, perr, NULL, rules); for (cp = cs->casepart; cp && !type; cp = cp->next) // UNTESTED - type = propagate_types(cp->action, c, ok, NULL, rules); // UNTESTED + type = propagate_types(cp->action, c, perr, NULL, rules); // UNTESTED if (type) { if (!cs->looppart) - propagate_types(cs->thenpart, c, ok, type, rules); - propagate_types(cs->elsepart, c, ok, type, rules); + propagate_types(cs->thenpart, c, perr, type, rules); + propagate_types(cs->elsepart, c, perr, type, rules); for (cp = cs->casepart; cp ; cp = cp->next) - propagate_types(cp->action, c, ok, type, rules); + propagate_types(cp->action, c, perr, type, rules); return type; } else return NULL; @@ -4917,9 +4929,17 @@ constants. v->global = 1; } else { v = var_ref(c, $1.txt); - tok_err(c, "error: name already declared", &$1); - type_err(c, "info: this is where '%v' was first declared", - v->where_decl, NULL, 0, NULL); + if (v->type == Tnone) { + v->where_decl = var; + v->where_set = var; + v->type = $constant = 1; + v->global = 1; + } else { + tok_err(c, "error: name already declared", &$1); + type_err(c, "info: this is where '%v' was first declared", + v->where_decl, NULL, 0, NULL); + } } var->var = v; @@ -4939,23 +4959,46 @@ constants. static void resolve_consts(struct parse_context *c) { struct binode *b; + int retry = 1; + enum { none, some, cannot } progress = none; + c->constlist = reorder_bilist(c->constlist); - for (b = cast(binode, c->constlist); b; - b = cast(binode, b->right)) { - int ok; - struct binode *vb = cast(binode, b->left); - struct var *v = cast(var, vb->left); - do { - ok = 1; - propagate_types(vb->right, c, &ok, - v->var->type, 0); - } while (ok == 2); - if (!ok) - c->parse_error = 1; - else { - struct value res = interp_exec( - c, vb->right, &v->var->type); - global_alloc(c, v->var->type, v->var, &res); + while (retry) { + retry = 0; + for (b = cast(binode, c->constlist); b; + b = cast(binode, b->right)) { + enum prop_err perr; + struct binode *vb = cast(binode, b->left); + struct var *v = cast(var, vb->left); + if (v->var->frame_pos >= 0) + continue; + do { + perr = 0; + propagate_types(vb->right, c, &perr, + v->var->type, 0); + } while (perr & Eretry); + if (perr & Efail) + c->parse_error += 1; + else if (!(perr & Enoconst)) { + progress = some; + struct value res = interp_exec( + c, vb->right, &v->var->type); + global_alloc(c, v->var->type, v->var, &res); + } else { + if (progress == cannot) + type_err(c, "error: const %v cannot be resolved.", + v, NULL, 0, NULL); + else + retry = 1; + } + } + switch (progress) { + case cannot: + retry = 0; break; + case none: + progress = cannot; break; + case some: + progress = none; break; } } } @@ -5140,20 +5183,20 @@ is a bit more interesting at this level. for (v = c->in_scope; v; v = v->in_scope) { struct value *val; struct type *ret; - int ok = 1; + enum prop_err perr; if (v->depth != 0 || !v->type || !v->type->check_args) continue; ret = v->type->function.inline_result ? Tnone : v->type->function.return_type; val = var_value(c, v); do { - ok = 1; - propagate_types(val->function, c, &ok, ret, 0); - } while (ok == 2); - if (ok) + perr = 0; + propagate_types(val->function, c, &perr, ret, 0); + } while (!(perr & Efail) && (perr & Eretry)); + if (!(perr & Efail)) /* Make sure everything is still consistent */ - propagate_types(val->function, c, &ok, ret, 0); - if (!ok) + propagate_types(val->function, c, &perr, ret, 0); + if (perr & Efail) all_ok = 0; if (!v->type->function.inline_result && !v->type->function.return_type->dup) { @@ -5170,7 +5213,7 @@ is a bit more interesting at this level. { struct binode *bp = type->function.params; struct binode *b; - int ok = 1; + enum prop_err perr; int arg = 0; struct type *argv_type; @@ -5179,16 +5222,16 @@ is a bit more interesting at this level. argv_type->array.unspec = 1; for (b = bp; b; b = cast(binode, b->right)) { - ok = 1; + perr = 0; switch (arg++) { case 0: /* argv */ - propagate_types(b->left, c, &ok, argv_type, 0); + propagate_types(b->left, c, &perr, argv_type, 0); break; default: /* invalid */ // NOTEST - propagate_types(b->left, c, &ok, Tnone, 0); // NOTEST + propagate_types(b->left, c, &perr, Tnone, 0); // NOTEST } - if (!ok) - c->parse_error = 1; + if (perr & Efail) + c->parse_error += 1; } return !c->parse_error; @@ -5209,12 +5252,12 @@ is a bit more interesting at this level. progp = var_value(c, mainv); if (!progp || !progp->function) { fprintf(stderr, "oceani: no main function found.\n"); - c->parse_error = 1; + c->parse_error += 1; return; } if (!analyse_main(mainv->type, c)) { fprintf(stderr, "oceani: main has wrong type.\n"); - c->parse_error = 1; + c->parse_error += 1; return; } al = mainv->type->function.params;