X-Git-Url: https://ocean-lang.org/code/?p=ocean;a=blobdiff_plain;f=csrc%2Foceani.mdc;h=2f3c9731e9ed703ad095a954855bd85cd43c20e7;hp=e032a7d5a268e76c5f6e459e666859640fbcab22;hb=0fff05884fe4b40c86252e89fb16f307309299cd;hpb=68bdd0987d4fc7c888f8f416d14a6ec70e49a7a8 diff --git a/csrc/oceani.mdc b/csrc/oceani.mdc index e032a7d..2f3c973 100644 --- a/csrc/oceani.mdc +++ b/csrc/oceani.mdc @@ -598,7 +598,7 @@ the value can only be assigned once, when the variable is declared. ###### ast - enum val_rules {Rboolok = 1<<0,}; + enum val_rules {Rboolok = 1<<0, Rrefok = 1<<1,}; enum prop_err {Efail = 1<<0, Eretry = 1<<1, Eruntime = 1<<2, Emaycopy = 1<<3, Erval = 1<<4, Econst = 1<<5}; @@ -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"); } @@ -3128,6 +3153,9 @@ anything in the heap or on the stack. A reference can be assigned static int reference_compat(struct type *require, struct type *have, enum val_rules rules) { + if (rules & Rrefok) + if (require->reference.referent == have) + return 1; if (have->compat != require->compat) return 0; if (have->reference.referent != require->reference.referent) @@ -3155,7 +3183,6 @@ anything in the heap or on the stack. A reference can be assigned return Tnone; } - static struct type reference_prototype = { .print_type = reference_print_type, .cmp_eq = reference_cmp, @@ -3173,8 +3200,8 @@ anything in the heap or on the stack. A reference can be assigned | @ IDENTIFIER ${ { struct type *t = find_type(c, $ID.txt); if (!t) { - t = add_type(c, $ID.txt, NULL); // UNTESTED - t->first_use = $ID; // UNTESTED + t = add_type(c, $ID.txt, NULL); + t->first_use = $ID; } $0 = find_anon_type(c, &reference_prototype, "@%.*s", $ID.txt.len, $ID.txt.txt); @@ -3325,7 +3352,7 @@ anything in the heap or on the stack. A reference can be assigned ###### Expressions: dereference ###### Binode types - Deref, + Deref, AddressOf, ###### term grammar @@ -3341,6 +3368,9 @@ anything in the heap or on the stack. A reference can be assigned print_exec(b->left, -1, bracket); printf("@"); break; + case AddressOf: + print_exec(b->left, -1, bracket); + break; ###### propagate binode cases case Deref: @@ -3354,13 +3384,30 @@ anything in the heap or on the stack. A reference can be assigned return t->reference.referent; break; + case AddressOf: + /* left must be lval, we create reference to it */ + if (!type || type->free != reference_free) + t = propagate_types(b->left, c, perr, type, 0); // UNTESTED + else + t = propagate_types(b->left, c, perr, + type->reference.referent, 0); + if (t) + t = find_anon_type(c, &reference_prototype, "@%.*s", + t->name.len, t->name.txt); + return t; + ###### interp binode cases - case Deref: { + case Deref: left = interp_exec(c, b->left, <ype); lrv = left.ref; rvtype = ltype->reference.referent; break; - } + + case AddressOf: + rv.ref = linterp_exec(c, b->left, &rvtype); + rvtype = find_anon_type(c, &reference_prototype, "@%.*s", + rvtype->name.len, rvtype->name.txt); + break; #### Functions @@ -3460,6 +3507,14 @@ further detailed when Expression Lists are introduced. return 0; } + static struct exec *take_addr(struct exec *e) + { + struct binode *rv = new(binode); + rv->op = AddressOf; + rv->left = e; + return rv; + } + static void function_check_args(struct parse_context *c, enum prop_err *perr, struct type *require, struct exec *args) { @@ -3471,13 +3526,22 @@ further detailed when Expression Lists are introduced. while (param) { struct var *pv = cast(var, param->left); + struct type *t = pv->var->type, *t2; if (!arg) { type_err(c, "error: insufficient arguments to function.", args, NULL, 0, NULL); break; } *perr = 0; - propagate_types(arg->left, c, perr, pv->var->type, 0); + t2 = propagate_types(arg->left, c, perr, t, Rrefok); + if (t->free == reference_free && + t->reference.referent == t2 && + !(*perr & Erval)) { + arg->left = take_addr(arg->left); + } else if (!(*perr & Efail) && !type_compat(t2, t, 0)) { + type_err(c, "error: cannot pass rval when reference expected", + arg->left, NULL, 0, NULL); + } param = cast(binode, param->right); arg = cast(binode, arg->right); } @@ -3808,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); } @@ -4085,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, @@ -4287,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; @@ -4377,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: @@ -4562,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 @@ -4721,8 +4773,8 @@ it is declared, it is assumed to be a global constant which are allowed to be declared at any time. ###### Binode types - Assign, - Declare, + Assign, AssignRef, + Declare, DeclareRef, ###### declare terminals $TERM = @@ -4758,6 +4810,7 @@ be declared at any time. ###### print binode cases case Assign: + case AssignRef: do_indent(indent, ""); print_exec(b->left, -1, bracket); printf(" = "); @@ -4767,6 +4820,7 @@ be declared at any time. break; case Declare: + case DeclareRef: { struct variable *v = cast(var, b->left)->var; do_indent(indent, ""); @@ -4796,8 +4850,10 @@ be declared at any time. ###### propagate binode cases case Assign: + case AssignRef: case Declare: - /* Both must match and not be labels, + case DeclareRef: + /* Both must match, or left may be ref and right an lval * Type must support 'dup', * For Assign, left must not be constant. * result is Tnone @@ -4808,7 +4864,23 @@ be declared at any time. return Tnone; if (t) { - propagate_types(b->right, c, perr_local, t, 0); + struct type *t2 = propagate_types(b->right, c, perr_local, + t, Rrefok); + if (!t2 || t2 == t || (*perr_local & Efail)) + ; // No more effort needed + else if (t->free == reference_free && + t->reference.referent == t2 && + !(*perr_local & Erval)) { + if (b->op == Assign) + b->op = AssignRef; + if (b->op == Declare) + b->op = DeclareRef; + } + else if (t->free == reference_free && + t->reference.referent == t2 && + (*perr_local & Erval)) + type_err(c, "error: Cannot assign an rval to a reference.", + b, NULL, 0, NULL); } else { t = propagate_types(b->right, c, perr_local, NULL, 0); if (t) @@ -4817,7 +4889,7 @@ be declared at any time. if (*perr & Erval) type_err(c, "error: cannot assign to an rval", b, NULL, 0, NULL); - else if (b->op == Assign && (*perr & Econst)) { + else if ((b->op == Assign || b->op == AssignRef) && (*perr & Econst)) { type_err(c, "error: Cannot assign to a constant: %v", b->left, NULL, 0, NULL); if (b->left->type == Xvar) { @@ -4839,13 +4911,21 @@ be declared at any time. ###### interp binode cases case Assign: + case AssignRef: lleft = linterp_exec(c, b->left, <ype); - if (lleft) + if (!lleft) + // FIXME lleft==NULL probably means illegal array ref + // should that cause a runtime error + ; + else if (b->op == AssignRef) + lleft->ref = linterp_exec(c, b->right, &rtype); + else dinterp_exec(c, b->right, lleft, ltype, 1); ltype = Tnone; break; case Declare: + case DeclareRef: { struct variable *v = cast(var, b->left)->var; struct value *val; @@ -4853,10 +4933,12 @@ be declared at any time. val = var_value(c, v); if (v->type->prepare_type) v->type->prepare_type(c, v->type, 0); - if (b->right) - dinterp_exec(c, b->right, val, v->type, 0); - else + if (!b->right) val_init(v->type, val); + else if (b->op == DeclareRef) + val->ref = linterp_exec(c, b->right, &rtype); + else + dinterp_exec(c, b->right, val, v->type, 0); break; } @@ -5280,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 @@ -5302,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); @@ -5320,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) @@ -5338,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); @@ -5437,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 @@ -5848,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++) { @@ -5910,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