X-Git-Url: https://ocean-lang.org/code/?p=ocean;a=blobdiff_plain;f=csrc%2Foceani.mdc;h=2a40ff203efa442fa148610521cb016070c13974;hp=59b8540122e2f75cd6ee471c3482a8bb8810380d;hb=6a546ea265d0ee30152298463e9e7b7c2f53b3b0;hpb=73aaa11833e35b28c84696f4d69739adbb14467d diff --git a/csrc/oceani.mdc b/csrc/oceani.mdc index 59b8540..2a40ff2 100644 --- a/csrc/oceani.mdc +++ b/csrc/oceani.mdc @@ -167,10 +167,10 @@ structures can be used. }; const char *options = "tpnbs"; - static void pr_err(char *msg) + static void pr_err(char *msg) // NOTEST { fprintf(stderr, "%s\n", msg); // NOTEST - } + } // NOTEST int main(int argc, char *argv[]) { @@ -264,6 +264,7 @@ structures can be used. } ## free context vars ## free context types + ## free context storage exit(context.parse_error ? 1 : 0); } @@ -530,8 +531,8 @@ Named type are stored in a simple linked list. Objects of each type are { if (tl && tl->cmp_order) return tl->cmp_order(tl, tr, left, right); - if (tl && tl->cmp_eq) - return tl->cmp_eq(tl, tr, left, right); + if (tl && tl->cmp_eq) // NOTEST + return tl->cmp_eq(tl, tr, left, right); // NOTEST return -1; // NOTEST } @@ -618,9 +619,9 @@ A separate function encoding these cases will simplify some code later. static int type_compat(struct type *require, struct type *have, int rules) { if ((rules & Rboolok) && have == Tbool) - return 1; + return 1; // NOTEST if ((rules & Rnolabel) && have == Tlabel) - return 0; + return 0; // NOTEST if (!require || !have) return 1; @@ -772,7 +773,7 @@ A separate function encoding these cases will simplify some code later. t->size = size; t->align = size > sizeof(void*) ? sizeof(void*) : size; if (t->size & (t->align - 1)) - t->size = (t->size | (t->align - 1)) + 1; + t->size = (t->size | (t->align - 1)) + 1; // NOTEST return t; } @@ -1001,14 +1002,12 @@ need to be freed. For this we need to be able to find it, so assume that { struct variable *v; - if (primary->merged) - // shouldn't happen - primary = primary->merged; // NOTEST + primary = primary->merged; for (v = primary->previous; v; v=v->previous) if (v == secondary || v == secondary->merged || v->merged == secondary || - (v->merged && v->merged == secondary->merged)) { + v->merged == secondary->merged) { v->scope = OutScope; v->merged = primary; } @@ -1104,6 +1103,7 @@ all pending-scope variables become conditionally scoped. v->previous = b->var; b->var = v; v->name = b; + v->merged = v; v->min_depth = v->depth = c->scope_depth; v->scope = InScope; v->in_scope = c->in_scope; @@ -1146,9 +1146,17 @@ all pending-scope variables become conditionally scoped. scope_pop(c); for (vp = &c->in_scope; - v = *vp, v && v->depth > c->scope_depth && v->min_depth > c->scope_depth; - ) { - if (v->name->var == v) switch (ct) { + (v = *vp) && v->min_depth > c->scope_depth; + (v->scope == OutScope || v->name->var != v) + ? (*vp = v->in_scope, 0) + : ( vp = &v->in_scope, 0)) { + if (v->name->var != v) { + /* This is still in scope, but we haven't just + * closed the scope. + */ + continue; + } + switch (ct) { case CloseElse: case CloseParallel: /* handle PendingScope */ switch(v->scope) { @@ -1159,10 +1167,10 @@ all pending-scope variables become conditionally scoped. else if (v->previous && v->previous->scope == PendingScope) v->scope = PendingScope; - else if (v->type == Tlabel) - v->scope = PendingScope; - else if (v->name->var == v) - v->scope = OutScope; + else if (v->type == Tlabel) // UNTESTED + v->scope = PendingScope; // UNTESTED + else if (v->name->var == v) // UNTESTED + v->scope = OutScope; // UNTESTED if (ct == CloseElse) { /* All Pending variables with this name * are now Conditional */ @@ -1179,7 +1187,7 @@ all pending-scope variables become conditionally scoped. if (v2->type != Tlabel) v2->scope = OutScope; break; - case OutScope: break; + case OutScope: break; // UNTESTED } break; case CloseSequential: @@ -1209,10 +1217,6 @@ all pending-scope variables become conditionally scoped. } break; } - if (v->scope == OutScope || v->name->var != v) - *vp = v->in_scope; - else - vp = &v->in_scope; } } @@ -1268,10 +1272,10 @@ is started, so there is no need to allocate until the size is known. struct variable scratch; if (t->prepare_type) - t->prepare_type(c, t, 1); + t->prepare_type(c, t, 1); // NOTEST if (c->global_size & (t->align - 1)) - c->global_size = (c->global_size + t->align) & ~(t->align-1); + c->global_size = (c->global_size + t->align) & ~(t->align-1); // UNTESTED if (!v) { v = &scratch; v->type = t; @@ -1305,7 +1309,7 @@ For this we have `scope_finalize()`. struct variable *v; for (v = b->var; v; v = v->previous) { struct type *t = v->type; - if (v->merged && v->merged != v) + if (v->merged != v) continue; if (v->global) continue; @@ -1318,7 +1322,7 @@ For this we have `scope_finalize()`. c->local = calloc(1, c->local_size); } -###### free context vars +###### free context storage free(context.global); free(context.local); @@ -1375,7 +1379,7 @@ from the `exec_types` enum. static int __fput_loc(struct exec *loc, FILE *f) { if (!loc) - return 0; // NOTEST + return 0; if (loc->line >= 0) { fprintf(f, "%d:%d: ", loc->line, loc->column); return 1; @@ -1585,9 +1589,9 @@ in `rval`. rvtype = ret.type = Tnone; if (!e) { - ret.lval = lrv; - ret.rval = rv; - return ret; + ret.lval = lrv; // UNTESTED + ret.rval = rv; // UNTESTED + return ret; // UNTESTED } switch(e->type) { @@ -1694,9 +1698,9 @@ with a const size by whether they are prepared at parse time or not. void *ptr = val->ptr; if (!val) - return; + return; // NOTEST if (!type->array.static_size) { - val->array = calloc(type->array.size, + val->array = calloc(type->array.size, type->array.member->size); ptr = val->array; } @@ -1726,23 +1730,23 @@ with a const size by whether they are prepared at parse time or not. static int array_compat(struct type *require, struct type *have) { if (have->compat != require->compat) - return 0; + return 0; // UNTESTED /* Both are arrays, so we can look at details */ if (!type_compat(require->array.member, have->array.member, 0)) return 0; if (have->array.unspec && require->array.unspec) { if (have->array.vsize && require->array.vsize && - have->array.vsize != require->array.vsize) + have->array.vsize != require->array.vsize) // UNTESTED /* sizes might not be the same */ - return 0; + return 0; // UNTESTED return 1; } if (have->array.unspec || require->array.unspec) - return 1; + return 1; // UNTESTED if (require->array.vsize == NULL && have->array.vsize == NULL) return require->array.size == have->array.size; - return require->array.vsize == have->array.vsize; + return require->array.vsize == have->array.vsize; // UNTESTED } static void array_print_type(struct type *type, FILE *f) @@ -2064,7 +2068,7 @@ function will be needed. struct type *st = propagate_types(f->left, c, ok, NULL, 0); if (!st) - type_err(c, "error: unknown type for field access", f->left, + type_err(c, "error: unknown type for field access", f->left, // UNTESTED NULL, 0, NULL); else if (st->init != structure_init) type_err(c, "error: field reference attempted on %1, not a struct", @@ -2109,8 +2113,8 @@ function will be needed. return; free_fieldlist(f->prev); if (f->f.init) { - free_value(f->f.type, f->f.init); - free(f->f.init); + free_value(f->f.type, f->f.init); // UNTESTED + free(f->f.init); // UNTESTED } free(f); } @@ -2166,7 +2170,7 @@ function will be needed. | ERROR ${ tok_err(c, "Syntax error in struct field", &$1); }$ Field -> IDENTIFIER : Type = Expression ${ { - int ok; + int ok; // UNTESTED $0 = calloc(1, sizeof(struct fieldlist)); $0->f.name = $1.txt; @@ -2177,7 +2181,7 @@ function will be needed. propagate_types($<5, c, &ok, $3, 0); } while (ok == 2); if (!ok) - c->parse_error = 1; + c->parse_error = 1; // UNTESTED else { struct value vl = interp_exec(c, $5, NULL); $0->f.init = global_alloc(c, $0->f.type, NULL, &vl); @@ -2195,9 +2199,9 @@ function will be needed. static void structure_print_type(struct type *t, FILE *f); ###### value functions - static void structure_print_type(struct type *t, FILE *f) - { - int i; + static void structure_print_type(struct type *t, FILE *f) // UNTESTED + { // UNTESTED + int i; // UNTESTED fprintf(f, "struct %.*s\n", t->name.len, t->name.txt); @@ -2208,18 +2212,18 @@ function will be needed. if (fl->type->print && fl->init) { fprintf(f, " = "); if (fl->type == Tstr) - fprintf(f, "\""); + fprintf(f, "\""); // UNTESTED print_value(fl->type, fl->init); if (fl->type == Tstr) - fprintf(f, "\""); + fprintf(f, "\""); // UNTESTED } printf("\n"); } } ###### print type decls - { - struct type *t; + { // UNTESTED + struct type *t; // UNTESTED int target = -1; while (target != 0) { @@ -2305,7 +2309,7 @@ or as an indented list of one parameter per line | Varlist ; ${ $0 = $<1; }$ | Varlist NEWLINE ${ $0 = $<1; }$ - Varlist -> Varlist ; ArgDecl ${ + Varlist -> Varlist ; ArgDecl ${ // UNTESTED $0 = new(binode); $0->op = List; $0->left = $val.num, tail, $1.txt) == 0) - mpq_init($0->val.num); + mpq_init($0->val.num); // UNTESTED if (tail[0]) tok_err(c, "error: unsupported number suffix", &$1); @@ -2603,8 +2607,7 @@ link to find the primary instance. type_err(c, "%d:BUG: no variable!!", prog, NULL, 0, NULL); // NOTEST return Tnone; // NOTEST } - if (v->merged) - v = v->merged; + v = v->merged; if (v->constant && (rules & Rnoconstant)) { type_err(c, "error: Cannot assign to a constant: %v", prog, NULL, 0, NULL); @@ -2640,8 +2643,7 @@ link to find the primary instance. struct var *var = cast(var, e); struct variable *v = var->var; - if (v->merged) - v = v->merged; + v = v->merged; lrv = var_value(c, v); rvtype = v->type; break; @@ -2726,7 +2728,7 @@ there. struct binode *b2 = cast(binode, b->right); left = interp_exec(c, b->left, <ype); if (left.bool) - rv = interp_exec(c, b2->left, &rvtype); + rv = interp_exec(c, b2->left, &rvtype); // UNTESTED else rv = interp_exec(c, b2->right, &rvtype); } @@ -2951,9 +2953,9 @@ expression operator, and the `CMPop` non-terminal will match one of them. if (t) propagate_types(b->right, c, ok, t, 0); else { - t = propagate_types(b->right, c, ok, NULL, Rnolabel); - if (t) - t = propagate_types(b->left, c, ok, t, 0); + t = propagate_types(b->right, c, ok, NULL, Rnolabel); // UNTESTED + if (t) // UNTESTED + t = propagate_types(b->left, c, ok, t, 0); // UNTESTED } if (!type_compat(type, Tbool, 0)) type_err(c, "error: Comparison returns %1 but %2 expected", prog, @@ -3133,7 +3135,7 @@ should only insert brackets were needed for precedence. /* op must be string, result is number */ propagate_types(b->left, c, ok, Tstr, 0); if (!type_compat(type, Tnum, 0)) - type_err(c, + type_err(c, // UNTESTED "error: Can only convert string to number, not %1", prog, type, 0, NULL); return Tnum; @@ -3204,16 +3206,16 @@ should only insert brackets were needed for precedence. char tail[3]; int neg = 0; if (tx.txt[0] == '-') { - neg = 1; - tx.txt++; - tx.len--; + neg = 1; // UNTESTED + tx.txt++; // UNTESTED + tx.len--; // UNTESTED } if (number_parse(rv.num, tail, tx) == 0) - mpq_init(rv.num); + mpq_init(rv.num); // UNTESTED else if (neg) - mpq_neg(rv.num, rv.num); + mpq_neg(rv.num, rv.num); // UNTESTED if (tail[0]) - printf("Unsupported suffix: %.*s\n", tx.len, tx.txt); + printf("Unsupported suffix: %.*s\n", tx.len, tx.txt); // UNTESTED break; @@ -3367,13 +3369,13 @@ is in-place. case Block: if (indent < 0) { // simple statement - if (b->left == NULL) - printf("pass"); + if (b->left == NULL) // UNTESTED + printf("pass"); // UNTESTED else - print_exec(b->left, indent, bracket); - if (b->right) { - printf("; "); - print_exec(b->right, indent, bracket); + print_exec(b->left, indent, bracket); // UNTESTED + if (b->right) { // UNTESTED + printf("; "); // UNTESTED + print_exec(b->right, indent, bracket); // UNTESTED } } else { // block, one per line @@ -3651,8 +3653,7 @@ it is declared, and error will be raised as the name is created as { struct variable *v = cast(var, b->left)->var; struct value *val; - if (v->merged) - v = v->merged; + v = v->merged; val = var_value(c, v); free_value(v->type, val); if (v->type->prepare_type) @@ -3872,12 +3873,14 @@ defined. $0->condpart = $next = $0->casepart; $0->casepart = $condpart = $next = $0->casepart; $0->casepart = $ IfSuffix ${ $0 = $<1; - // This is where we close scope of the whole - // "for" or "while" statement - var_block_close(c, CloseSequential); }$ | Newlines CasePart CondSuffix ${ $0 = $ for OpenBlock ${ $0 = $ while UseBlock OptNL do Block ${ $0.condpart = $ if UseBlock OptNL then OpenBlock ClosePara ${ @@ -3963,7 +3965,7 @@ defined. }$ $*exec - // This scope is closed in CondSuffix + // This scope is closed in CondStatement SwitchPart -> switch OpenScope Expression ${ $0 = $condpart && cs->condpart->type == Xbinode && cast(binode, cs->condpart)->op == Block) { - if (bracket) - printf(" {\n"); + if (bracket) // UNTESTED + printf(" {\n"); // UNTESTED else - printf(":\n"); - print_exec(cs->condpart, indent+1, bracket); - if (bracket) - do_indent(indent, "}\n"); - if (cs->thenpart) { - do_indent(indent, "then:\n"); - print_exec(cs->thenpart, indent+1, bracket); + printf(":\n"); // UNTESTED + print_exec(cs->condpart, indent+1, bracket); // UNTESTED + if (bracket) // UNTESTED + do_indent(indent, "}\n"); // UNTESTED + if (cs->thenpart) { // UNTESTED + do_indent(indent, "then:\n"); // UNTESTED + print_exec(cs->thenpart, indent+1, bracket); // UNTESTED } } else { printf(" "); @@ -4093,14 +4095,14 @@ defined. t = propagate_types(cs->forpart, c, ok, Tnone, 0); if (!type_compat(Tnone, t, 0)) - *ok = 0; + *ok = 0; // UNTESTED t = propagate_types(cs->dopart, c, ok, Tnone, 0); if (!type_compat(Tnone, t, 0)) - *ok = 0; + *ok = 0; // UNTESTED if (cs->dopart) { t = propagate_types(cs->thenpart, c, ok, Tnone, 0); if (!type_compat(Tnone, t, 0)) - *ok = 0; + *ok = 0; // UNTESTED } if (cs->casepart == NULL) propagate_types(cs->condpart, c, ok, Tbool, 0); @@ -4111,7 +4113,7 @@ defined. cp && !t; cp = cp->next) t = propagate_types(cp->value, c, ok, NULL, 0); if (!t && cs->condpart) - t = propagate_types(cs->condpart, c, ok, NULL, Rboolok); + t = propagate_types(cs->condpart, c, ok, NULL, Rboolok); // UNTESTED // Now we have a type (I hope) push it down if (t) { for (cp = cs->casepart; cp; cp = cp->next) @@ -4126,8 +4128,8 @@ defined. type = propagate_types(cs->elsepart, c, ok, NULL, rules); for (cp = cs->casepart; cp && !type; - cp = cp->next) - type = propagate_types(cp->action, c, ok, NULL, rules); + cp = cp->next) // UNTESTED + type = propagate_types(cp->action, c, ok, NULL, rules); // UNTESTED if (type) { if (!cs->dopart) propagate_types(cs->thenpart, c, ok, type, rules); @@ -4153,7 +4155,7 @@ defined. if (cs->condpart) cnd = interp_exec(c, cs->condpart, &cndtype); else - cndtype = Tnone; + cndtype = Tnone; // UNTESTED if (!(cndtype == Tnone || (cndtype == Tbool && cnd.bool != 0))) break; @@ -4221,7 +4223,7 @@ various declarations in the parse context. | DeclarationList Declaration Declaration -> ERROR Newlines ${ - tok_err(c, + tok_err(c, // UNTESTED "error: unhandled parse error", &$1); }$ | DeclareConstant @@ -4424,7 +4426,7 @@ analysis is a bit more interesting at this level. /* Make sure everything is still consistent */ propagate_types(bp->right, c, &ok, Tnone, 0); if (!ok) - return 0; + return 0; // UNTESTED scope_finalize(c); return 1; } @@ -4573,13 +4575,14 @@ things which will likely grow as the languages grows. else hi = mid if hi - lo < 1: + lo = mid use GiveUp use True do pass case Found: print "Yay, I found", target case GiveUp: - print "Closest I found was", mid + print "Closest I found was", lo size::= 10 list:[size]number