X-Git-Url: https://ocean-lang.org/code/?p=ocean;a=blobdiff_plain;f=csrc%2Foceani.mdc;h=2f3c9731e9ed703ad095a954855bd85cd43c20e7;hp=891ce74c2e4d097b0cb9e4143f9dac97c0ec1e77;hb=0fff05884fe4b40c86252e89fb16f307309299cd;hpb=038c114a1ceec224aeaa6c15c025c6bb4b3c2b6d diff --git a/csrc/oceani.mdc b/csrc/oceani.mdc index 891ce74..2f3c973 100644 --- a/csrc/oceani.mdc +++ b/csrc/oceani.mdc @@ -1274,13 +1274,13 @@ executable. $0->val.bool = 0; }$ | NUMBER ${ { - char tail[3]; + char tail[3] = ""; $0 = new_val(Tnum, $1); - if (number_parse($0->val.num, tail, $1.txt) == 0) - mpq_init($0->val.num); // UNTESTED - if (tail[0]) - tok_err(c, "error: unsupported number suffix", - &$1); + if (number_parse($0->val.num, tail, $1.txt) == 0) { + mpq_init($0->val.num); + tok_err(c, "error: unsupported number format", &$NUM); + } else if (tail[0]) + tok_err(c, "error: unsupported number suffix", &$1); } }$ | STRING ${ { char tail[3]; @@ -2023,7 +2023,7 @@ tell if it was set or not later. { if (!v->global) { if (!c->local || !v->type) - return NULL; // UNTESTED + return NULL; // NOTEST if (v->frame_pos + v->type->size > c->local_size) { printf("INVALID frame_pos\n"); // NOTEST exit(2); // NOTEST @@ -2049,7 +2049,7 @@ tell if it was set or not later. 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); // NOTEST + c->global_size = (c->global_size + t->align) & ~(t->align-1); if (!v) { v = &scratch; v->type = t; @@ -2468,19 +2468,15 @@ with a const size by whether they are prepared at parse time or not. /* 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) // UNTESTED - /* sizes might not be the same */ - return 0; // UNTESTED - return 1; - } + if (have->array.unspec && require->array.unspec && + have->array.size != require->array.size) + return 0; // NOTEST if (have->array.unspec || require->array.unspec) - return 1; // UNTESTED + return 1; if (require->array.vsize == NULL && have->array.vsize == NULL) return require->array.size == have->array.size; - return require->array.vsize == have->array.vsize; // UNTESTED + return require->array.vsize == have->array.vsize; } static void array_print_type(struct type *type, FILE *f) @@ -2554,29 +2550,18 @@ with a const size by whether they are prepared at parse time or not. $0->array.vsize = v; } }$ -###### Grammar - $*type - OptType -> Type ${ $0 = $<1; }$ - | ${ $0 = NULL; }$ - ###### formal type grammar - | [ IDENTIFIER :: OptType ] Type ${ { - struct variable *v = var_decl(c, $ID.txt); - - v->type = $constant = 1; - if (!v->type) - v->type = Tnum; - $0 = add_anon_type(c, &array_prototype, "array[var]"); - $0->array.member = $<6; + | [ ] Type ${ { + $0 = add_anon_type(c, &array_prototype, "array[]"); + $0->array.member = $array.size = 0; $0->array.unspec = 1; - $0->array.vsize = v; + $0->array.vsize = NULL; } }$ ###### Binode types - Index, + Index, Length, ###### term grammar @@ -2588,6 +2573,13 @@ with a const size by whether they are prepared at parse time or not. $0 = b; } }$ + | Term [ ] ${ { + struct binode *b = new(binode); + b->op = Length; + b->left = $left, -1, bracket); @@ -2596,6 +2588,11 @@ with a const size by whether they are prepared at parse time or not. printf("]"); break; + case Length: + print_exec(b->left, -1, bracket); + printf("[]"); + break; + ###### propagate binode cases case Index: /* left must be an array, right must be a number, @@ -2615,6 +2612,20 @@ with a const size by whether they are prepared at parse time or not. } break; + case Length: + /* left must be an array, result is a number + */ + t = propagate_types(b->left, c, perr, NULL, 0); + if (!t || t->compat != array_compat) { + type_err(c, "error: %1 cannot provide length", prog, t, 0, NULL); + return NULL; + } + if (!type_compat(type, Tnum, rules)) + type_err(c, "error: have %1 but need %2", prog, + Tnum, rules, type); + return Tnum; + break; + ###### interp binode cases case Index: { mpz_t q; @@ -2640,6 +2651,13 @@ with a const size by whether they are prepared at parse time or not. ltype = NULL; break; } + case Length: { + lleft = linterp_exec(c, b->left, <ype); + mpq_set_ui(rv.num, ltype->array.size, 1); + ltype = NULL; + rvtype = Tnum; + break; + } #### Structs @@ -2951,10 +2969,17 @@ function will be needed. | SimpleFieldList EOL ${ $0 = $ SimpleFieldList Newlines ${ $0 = $prev = $prev) + f = f->prev; + f->prev = $ Field ${ $0 = $type->print && fl->init) { fprintf(f, " = "); if (fl->type == Tstr) - fprintf(f, "\""); // UNTESTED + fprintf(f, "\""); print_value(fl->type, fl->init, f); if (fl->type == Tstr) - fprintf(f, "\""); // UNTESTED + fprintf(f, "\""); } fprintf(f, "\n"); } @@ -3847,7 +3872,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); // UNTESTED + rv = interp_exec(c, b2->left, &rvtype); else rv = interp_exec(c, b2->right, &rvtype); } @@ -4124,9 +4149,9 @@ expression operator, and the `CMPop` non-terminal will match one of them. if (t) propagate_types(b->right, c, perr, t, 0); else { - t = propagate_types(b->right, c, perr, NULL, 0); // UNTESTED - if (t) // UNTESTED - t = propagate_types(b->left, c, perr, t, 0); // UNTESTED + t = propagate_types(b->right, c, perr, NULL, 0); // NOTEST + if (t) // NOTEST + t = propagate_types(b->left, c, perr, t, 0); // NOTEST } if (!type_compat(type, Tbool, 0)) type_err(c, "error: Comparison returns %1 but %2 expected", prog, @@ -4326,7 +4351,7 @@ parentheses around an expression converts it into a Term, /* op must be string, result is number */ propagate_types(b->left, c, perr, Tstr, 0); if (!type_compat(type, Tnum, 0)) - type_err(c, // UNTESTED + type_err(c, "error: Can only convert string to number, not %1", prog, type, 0, NULL); *perr |= Erval; @@ -4416,19 +4441,19 @@ parentheses around an expression converts it into a Term, rvtype = Tnum; struct text tx = right.str; - char tail[3]; + char tail[3] = ""; int neg = 0; if (tx.txt[0] == '-') { - neg = 1; // UNTESTED - tx.txt++; // UNTESTED - tx.len--; // UNTESTED + neg = 1; + tx.txt++; + tx.len--; } if (number_parse(rv.num, tail, tx) == 0) - mpq_init(rv.num); // UNTESTED + mpq_init(rv.num); else if (neg) - mpq_neg(rv.num, rv.num); // UNTESTED + mpq_neg(rv.num, rv.num); if (tail[0]) - printf("Unsupported suffix: %.*s\n", tx.len, tx.txt); // UNTESTED + printf("Unsupported suffix: %.*s\n", tx.len, tx.txt); break; case Test: @@ -4601,25 +4626,13 @@ the common header for all reductions to use. ###### print binode cases case Block: - if (indent < 0) { - // simple statement - if (b->left == NULL) // UNTESTED - printf("pass"); // UNTESTED - else - 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 - if (b->left == NULL) - do_indent(indent, "pass\n"); - else - print_exec(b->left, indent, bracket); - if (b->right) - print_exec(b->right, indent, bracket); - } + // block, one per line + if (b->left == NULL) + do_indent(indent, "pass\n"); + else + print_exec(b->left, indent, bracket); + if (b->right) + print_exec(b->right, indent, bracket); break; ###### propagate binode cases @@ -5349,9 +5362,7 @@ casepart` to track a list of case parts. ###### propagate binode cases case Loop: - t = propagate_types(b->right, c, perr_local, Tnone, 0); - if (!type_compat(Tnone, t, 0)) - *perr |= Efail; // UNTESTED + propagate_types(b->right, c, perr_local, Tnone, 0); return propagate_types(b->left, c, perr, type, rules); ###### propagate exec cases @@ -5371,13 +5382,9 @@ casepart` to track a list of case parts. struct casepart *cp; t = propagate_types(cs->forpart, c, perr, Tnone, 0); - if (!type_compat(Tnone, t, 0)) - *perr |= Efail; // UNTESTED if (cs->looppart) { t = propagate_types(cs->thenpart, c, perr, Tnone, 0); - if (!type_compat(Tnone, t, 0)) - *perr |= Efail; // UNTESTED } if (cs->casepart == NULL) { propagate_types(cs->condpart, c, perr, Tbool, 0); @@ -5389,9 +5396,9 @@ casepart` to track a list of case parts. cp && !t; cp = cp->next) t = propagate_types(cp->value, c, perr, NULL, 0); if (!t && cs->condpart) - t = propagate_types(cs->condpart, c, perr, NULL, Rboolok); // UNTESTED + t = propagate_types(cs->condpart, c, perr, NULL, Rboolok); // NOTEST if (!t && cs->looppart) - t = propagate_types(cs->looppart, c, perr, NULL, Rboolok); // UNTESTED + t = propagate_types(cs->looppart, c, perr, NULL, Rboolok); // NOTEST // Now we have a type (I hope) push it down if (t) { for (cp = cs->casepart; cp; cp = cp->next) @@ -5407,8 +5414,8 @@ casepart` to track a list of case parts. 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, perr, NULL, rules); // UNTESTED + cp = cp->next) // NOTEST + type = propagate_types(cp->action, c, perr, NULL, rules); // NOTEST if (type) { if (!cs->looppart) propagate_types(cs->thenpart, c, perr, type, rules); @@ -5506,7 +5513,7 @@ various declarations in the parse context. | DeclarationList Declaration Declaration -> ERROR Newlines ${ - tok_err(c, // UNTESTED + tok_err(c, // NOTEST "error: unhandled parse error", &$1); }$ | DeclareConstant @@ -5917,15 +5924,12 @@ is a bit more interesting at this level. struct value *vl = var_value(c, v->var); struct value arg; struct type *t; - mpq_t argcq; int i; switch (anum++) { case 0: /* argv */ t = v->var->type; - mpq_init(argcq); - mpq_set_ui(argcq, argc, 1); - memcpy(var_value(c, t->array.vsize), &argcq, sizeof(argcq)); + t->array.size = argc; t->prepare_type(c, t, 0); array_init(v->var->type, vl); for (i = 0; i < argc; i++) { @@ -5979,7 +5983,7 @@ things which will likely grow as the languages grows. name:string alive:Boolean - func main(argv:[argc::]string) + func main(argv:[]string) print "Hello World, what lovely oceans you have!" print "Are there", five, "?" print pi, pie, "but", cake