X-Git-Url: https://ocean-lang.org/code/?p=ocean;a=blobdiff_plain;f=csrc%2Foceani.mdc;h=f97652d025ca4c90ef8e183ac45bea0eed41a677;hp=f1c337fd688f2c94fafdfdf6389851cffa0dd252;hb=d58f04dc62ec58ed72c00db43b80122fbdfc0925;hpb=3c9b656474122721e7e0d57ba3e95b407b7cd3ba diff --git a/csrc/oceani.mdc b/csrc/oceani.mdc index f1c337f..f97652d 100644 --- a/csrc/oceani.mdc +++ b/csrc/oceani.mdc @@ -37,9 +37,9 @@ boolean operators. Some operators that have only recently been added, and so have not generated all that much experience yet are "and then" and "or else" as -short-circuit Boolean operators, and the "if ... else" trinary -operator which can select between two expressions based on a third -(which appears syntactically in the middle). +short-circuit Boolean operators (which have since been remove), and the +"if ... else" trinary operator which can select between two expressions +based on a third (which appears syntactically in the middle). The "func" clause currently only allows a "main" function to be declared. That will be extended when proper function support is added. @@ -367,14 +367,14 @@ context so indicate that parsing failed. static void fput_loc(struct exec *loc, FILE *f); static void type_err(struct parse_context *c, char *fmt, struct exec *loc, - struct type *t1, int rules, struct type *t2); + struct type *t1, enum val_rules rules, struct type *t2); static void tok_err(struct parse_context *c, char *fmt, struct token *t); ###### core functions static void type_err(struct parse_context *c, char *fmt, struct exec *loc, - struct type *t1, int rules, struct type *t2) + struct type *t1, enum val_rules rules, struct type *t2) { fprintf(stderr, "%s:", c->file_name); fput_loc(loc, stderr); @@ -589,24 +589,27 @@ 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. +any expression cannot be evaluated a compile time, `Eruntime` is set. If the expression can be copied, `Emaycopy` is set. -If it remains unchanged at `0`, then no more propagation is needed. +If `Erval` is set, then the value cannot be assigned to because it is +a temporary result. If `Erval` is clear but `Econst` is set, then +the value can only be assigned once, when the variable is declared. ###### ast - enum val_rules {Rboolok = 1<<1, Rnoconstant = 1<<2}; - enum prop_err {Efail = 1<<0, Eretry = 1<<1, Enoconst = 1<<2, - Emaycopy = 1<<3}; + 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}; ###### forward decls static struct type *propagate_types(struct exec *prog, struct parse_context *c, enum prop_err *perr, - struct type *type, int rules); + struct type *type, enum val_rules rules); ###### core functions static struct type *__propagate_types(struct exec *prog, struct parse_context *c, enum prop_err *perr, - struct type *type, int rules) + enum prop_err *perr_local, + struct type *type, enum val_rules rules) { struct type *t; @@ -628,11 +631,13 @@ If it remains unchanged at `0`, then no more propagation is needed. } static struct type *propagate_types(struct exec *prog, struct parse_context *c, enum prop_err *perr, - struct type *type, int rules) + struct type *type, enum val_rules rules) { int pre_err = c->parse_error; - struct type *ret = __propagate_types(prog, c, perr, type, rules); + enum prop_err perr_local = 0; + struct type *ret = __propagate_types(prog, c, perr, &perr_local, type, rules); + *perr |= perr_local & (Efail | Eretry); if (c->parse_error > pre_err) *perr |= Efail; return ret; @@ -986,7 +991,7 @@ which might be reported in error messages. ###### forward decls static void free_value(struct type *type, struct value *v); - static int type_compat(struct type *require, struct type *have, int rules); + static int type_compat(struct type *require, struct type *have, enum val_rules rules); static void type_print(struct type *type, FILE *f); static void val_init(struct type *type, struct value *v); static void dup_value(struct type *type, @@ -1051,11 +1056,12 @@ A separate function encoding these cases will simplify some code later. ###### type functions - int (*compat)(struct type *this, struct type *other); + int (*compat)(struct type *this, struct type *other, enum val_rules rules); ###### ast functions - static int type_compat(struct type *require, struct type *have, int rules) + static int type_compat(struct type *require, struct type *have, + enum val_rules rules) { if ((rules & Rboolok) && have == Tbool) return 1; // NOTEST @@ -1063,7 +1069,7 @@ A separate function encoding these cases will simplify some code later. return 1; if (require->compat) - return require->compat(require, have); + return require->compat(require, have, rules); return require == have; } @@ -1151,7 +1157,7 @@ A separate function encoding these cases will simplify some code later. { int cmp; if (tl != tr) - return tl - tr; // NOTEST + return tl - tr; switch (tl->vtype) { case Vlabel: cmp = left->label == right->label ? 0 : 1; break; case Vnum: cmp = mpq_cmp(left->num, right->num); break; @@ -1268,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]; @@ -1313,6 +1319,7 @@ executable. if (!type_compat(type, val->vtype, rules)) type_err(c, "error: expected %1 found %2", prog, type, rules, val->vtype); + *perr |= Erval; return val->vtype; } @@ -1435,6 +1442,7 @@ match "case". if (!type_compat(type, Tlabel, rules)) type_err(c, "error: expected %1 found %2", prog, type, rules, Tlabel); + *perr |= Erval; return Tlabel; } ###### interp exec cases @@ -2015,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 @@ -2041,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; @@ -2088,7 +2096,7 @@ stack. if (v->merged != v) continue; if (!t) - continue; + continue; // NOTEST if (v->frame_pos >= 0) continue; while (done && done->scope_end < v->scope_start) @@ -2266,13 +2274,6 @@ correctly. return Tnone; // NOTEST } v = v->merged; - if (v->constant && (rules & Rnoconstant)) { - type_err(c, "error: Cannot assign to a constant: %v", - prog, NULL, 0, NULL); - type_err(c, "info: name was defined as a constant here", - v->where_decl, NULL, 0, NULL); - return v->type; - } if (v->type == Tnone && v->where_decl == prog) type_err(c, "error: variable used but not declared: %v", prog, NULL, 0, NULL); @@ -2289,10 +2290,10 @@ correctly. v->type, rules, NULL); } if (!v->global || v->frame_pos < 0) - *perr |= Enoconst; - if (!type) - return v->type; - return type; + *perr |= Eruntime; + if (v->constant) + *perr |= Econst; + return v->type; } ###### interp exec cases @@ -2397,16 +2398,16 @@ with a const size by whether they are prepared at parse time or not. struct value *vsize; mpz_t q; if (type->array.static_size) - return 1; // UNTESTED + return 1; // NOTEST - guard against reentry if (type->array.unspec && parse_time) - return 1; // UNTESTED + return 1; // NOTEST - unspec is still incomplete if (parse_time && type->array.vsize && !type->array.vsize->global) - return 1; // UNTESTED + return 1; // NOTEST - should be impossible if (type->array.vsize) { vsize = var_value(c, type->array.vsize); if (!vsize) - return 1; // UNTESTED + return 1; // NOTEST - should be impossible mpz_init(q); mpz_tdiv_q(q, mpq_numref(vsize->num), mpq_denref(vsize->num)); type->array.size = mpz_get_si(q); @@ -2415,7 +2416,7 @@ with a const size by whether they are prepared at parse time or not. if (!parse_time) return 1; if (type->array.member->size <= 0) - return 0; // UNTESTED + return 0; // NOTEST - error caught before here type->array.static_size = 1; type->size = type->array.size * type->array.member->size; @@ -2459,26 +2460,23 @@ with a const size by whether they are prepared at parse time or not. free(ptr); } - static int array_compat(struct type *require, struct type *have) + static int array_compat(struct type *require, struct type *have, + enum val_rules rules) { if (have->compat != require->compat) return 0; /* 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) @@ -2552,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 @@ -2586,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); @@ -2594,13 +2588,18 @@ 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, * result is the member type of the array */ - propagate_types(b->right, c, perr, Tnum, 0); - t = propagate_types(b->left, c, perr, NULL, rules & Rnoconstant); + propagate_types(b->right, c, perr_local, Tnum, 0); + t = propagate_types(b->left, c, perr, NULL, 0); if (!t || t->compat != array_compat) { type_err(c, "error: %1 cannot be indexed", prog, t, 0, NULL); return NULL; @@ -2613,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; @@ -2638,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 @@ -2915,24 +2935,31 @@ function will be needed. } ###### top level grammar - DeclareStruct -> struct IDENTIFIER FieldBlock Newlines ${ { - struct type *t; - t = find_type(c, $ID.txt); - if (!t) - t = add_type(c, $ID.txt, &structure_prototype); - else if (t->size >= 0) { + $*type + StructName -> IDENTIFIER ${ { + struct type *t = find_type(c, $ID.txt); + + if (t && t->size >= 0) { tok_err(c, "error: type already declared", &$ID); tok_err(c, "info: this is location of declartion", &t->first_use); - /* Create a new one - duplicate */ - t = add_type(c, $ID.txt, &structure_prototype); - } else { - struct type tmp = *t; - *t = structure_prototype; - t->name = tmp.name; - t->next = tmp.next; + t = NULL; } - t->structure.field_list = $first_use = $ID; + $0 = t; + } }$ + $void + DeclareStruct -> struct StructName FieldBlock Newlines ${ { + struct type *t = $name = tmp.name; + t->next = tmp.next; + t->first_use = tmp.first_use; + + t->structure.field_list = $ 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"); } @@ -3116,8 +3150,12 @@ anything in the heap or on the stack. A reference can be assigned /* Nothing to do here */ } - static int reference_compat(struct type *require, struct type *have) + 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) @@ -3145,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, @@ -3257,6 +3294,7 @@ anything in the heap or on the stack. A reference can be assigned r->reftype = type; *perr |= Eretry; } + *perr |= Erval; return type; case RefNil: if (type && type->free != reference_free) @@ -3266,9 +3304,10 @@ anything in the heap or on the stack. A reference can be assigned r->reftype = type; *perr |= Eretry; } + *perr |= Erval; return type; case RefFree: - t = propagate_types(r->right, c, perr, NULL, 0); + t = propagate_types(r->right, c, perr_local, NULL, 0); if (t && t->free != reference_free) type_err(c, "error: @free can only be assigned a reference, not %1", prog, t, 0, NULL); @@ -3313,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 @@ -3329,25 +3368,46 @@ 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: /* left must be a reference, and we return what it refers to */ /* FIXME how can I pass the expected type down? */ t = propagate_types(b->left, c, perr, NULL, 0); + *perr &= ~Erval; if (!t || t->free != reference_free) type_err(c, "error: Cannot dereference %1", b, t, 0, NULL); else 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); // NOTEST impossible + 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 @@ -3440,12 +3500,21 @@ further detailed when Expression Lists are introduced. val->function = NULL; } - static int function_compat(struct type *require, struct type *have) + static int function_compat(struct type *require, struct type *have, + enum val_rules rules) { // FIXME can I do anything here yet? 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) { @@ -3457,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); } @@ -3474,6 +3552,7 @@ further detailed when Expression Lists are introduced. static void function_print(struct type *type, struct value *val, FILE *f) { + fprintf(f, "\n"); print_exec(val->function, 1, 0); } @@ -3507,7 +3586,6 @@ further detailed when Expression Lists are introduced. } else type_print(type->function.return_type, f); } - fprintf(f, "\n"); } static void function_free_type(struct type *t) @@ -3665,10 +3743,11 @@ it in the "SimpleStatement Grammar" which will be described later. prog, NULL, 0, NULL); return NULL; } - *perr |= Enoconst; - v->var->type->check_args(c, perr, v->var->type, args); + *perr |= Eruntime; + v->var->type->check_args(c, perr_local, v->var->type, args); if (v->var->type->function.inline_result) *perr |= Emaycopy; + *perr |= Erval; return v->var->type->function.return_type; } @@ -3781,7 +3860,7 @@ there. struct binode *b2 = cast(binode, b->right); struct type *t2; - propagate_types(b->left, c, perr, Tbool, 0); + propagate_types(b->left, c, perr_local, Tbool, 0); t = propagate_types(b2->left, c, perr, type, 0); t2 = propagate_types(b2->right, c, perr, type ?: t, 0); return t ?: t2; @@ -3793,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); } @@ -3853,15 +3932,12 @@ lists. In that case a separate function is used to print them. ### Expressions: Boolean The next class of expressions to use the `binode` will be Boolean -expressions. "`and then`" and "`or else`" are similar to `and` and `or` -have same corresponding precendence. The difference is that they don't +expressions. `and` and `or` are short-circuit operators that don't evaluate the second expression if not necessary. ###### Binode types And, - AndThen, Or, - OrElse, Not, ###### declare terminals @@ -3877,14 +3953,6 @@ evaluate the second expression if not necessary. b->right = $<3; $0 = b; } }$ - | Expression or else Expression ${ { - struct binode *b = new(binode); - b->op = OrElse; - b->left = $<1; - b->right = $<4; - $0 = b; - } }$ - | Expression and Expression ${ { struct binode *b = new(binode); b->op = And; @@ -3892,14 +3960,6 @@ evaluate the second expression if not necessary. b->right = $<3; $0 = b; } }$ - | Expression and then Expression ${ { - struct binode *b = new(binode); - b->op = AndThen; - b->left = $<1; - b->right = $<4; - $0 = b; - } }$ - | not Expression ${ { struct binode *b = new(binode); b->op = Not; @@ -3915,13 +3975,6 @@ evaluate the second expression if not necessary. print_exec(b->right, -1, bracket); if (bracket) printf(")"); break; - case AndThen: - if (bracket) printf("("); - print_exec(b->left, -1, bracket); - printf(" and then "); - print_exec(b->right, -1, bracket); - if (bracket) printf(")"); - break; case Or: if (bracket) printf("("); print_exec(b->left, -1, bracket); @@ -3929,13 +3982,6 @@ evaluate the second expression if not necessary. print_exec(b->right, -1, bracket); if (bracket) printf(")"); break; - case OrElse: - if (bracket) printf("("); - print_exec(b->left, -1, bracket); - printf(" or else "); - print_exec(b->right, -1, bracket); - if (bracket) printf(")"); - break; case Not: if (bracket) printf("("); printf("not "); @@ -3945,9 +3991,7 @@ evaluate the second expression if not necessary. ###### propagate binode cases case And: - case AndThen: case Or: - case OrElse: case Not: /* both must be Tbool, result is Tbool */ propagate_types(b->left, c, perr, Tbool, 0); @@ -3955,25 +3999,16 @@ evaluate the second expression if not necessary. if (type && type != Tbool) type_err(c, "error: %1 operation found where %2 expected", prog, Tbool, 0, type); + *perr |= Erval; return Tbool; ###### interp binode cases case And: - rv = interp_exec(c, b->left, &rvtype); - right = interp_exec(c, b->right, &rtype); - rv.bool = rv.bool && right.bool; - break; - case AndThen: rv = interp_exec(c, b->left, &rvtype); if (rv.bool) rv = interp_exec(c, b->right, NULL); break; case Or: - rv = interp_exec(c, b->left, &rvtype); - right = interp_exec(c, b->right, &rtype); - rv.bool = rv.bool || right.bool; - break; - case OrElse: rv = interp_exec(c, b->left, &rvtype); if (!rv.bool) rv = interp_exec(c, b->right, NULL); @@ -4069,13 +4104,14 @@ 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, Tbool, rules, type); + *perr |= Erval; return Tbool; ###### interp binode cases @@ -4232,9 +4268,10 @@ parentheses around an expression converts it into a Term, if (bracket) printf(")"); break; case Bracket: - printf("("); + /* Avoid double brackets... */ + if (!bracket) printf("("); print_exec(b->right, indent, bracket); - printf(")"); + if (!bracket) printf(")"); break; ###### propagate binode cases @@ -4253,6 +4290,7 @@ parentheses around an expression converts it into a Term, if (!type_compat(type, Tnum, 0)) type_err(c, "error: Arithmetic returns %1 but %2 expected", prog, Tnum, rules, type); + *perr |= Erval; return Tnum; case Concat: @@ -4262,15 +4300,17 @@ parentheses around an expression converts it into a Term, if (!type_compat(type, Tstr, 0)) type_err(c, "error: Concat returns %1 but %2 expected", prog, Tstr, rules, type); + *perr |= Erval; return Tstr; case StringConv: /* 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; return Tnum; case Test: @@ -4279,6 +4319,7 @@ parentheses around an expression converts it into a Term, if (!t || !t->test) type_err(c, "error: '?' requires a testable value, not %1", prog, t, 0, NULL); + *perr |= Erval; return Tbool; case Choose: @@ -4290,10 +4331,11 @@ parentheses around an expression converts it into a Term, if (t && t->test == NULL) type_err(c, "error: \"??\" requires a testable value, not %1", prog, t, 0, NULL); + *perr |= Erval; return t; case Bracket: - return propagate_types(b->right, c, perr, type, 0); + return propagate_types(b->right, c, perr, type, rules); ###### interp binode cases @@ -4355,19 +4397,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: @@ -4467,7 +4509,8 @@ the common header for all reductions to use. Block -> { IN OptNL Statementlist OUT OptNL } ${ $0 = $ OpenScope { IN OptNL Statementlist OUT OptNL } ${ $0 = $ { OpenScope IN OptNL Statementlist OUT OptNL } ${ $0 = $ { IN OpenScope OptNL Statementlist OUT OptNL } ${ $0 = $ ComplexStatements ComplexStatement ${ if ($2 == NULL) { - $0 = $<1; + $0 = $<1; // NOTEST - impossible } else { $0 = new(binode); $0->op = Block; @@ -4500,7 +4543,7 @@ the common header for all reductions to use. }$ | ComplexStatement ${ if ($1 == NULL) { - $0 = NULL; + $0 = NULL; // NOTEST - impossible } else { $0 = new(binode); $0->op = Block; @@ -4540,25 +4583,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 @@ -4574,7 +4605,9 @@ 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, perr, NULL, rules); + *perr |= *perr_local; + *perr_local = 0; + t = propagate_types(e->left, c, perr_local, NULL, rules); if ((rules & Rboolok) && (t == Tbool || t == Tnone)) t = NULL; if (t == Tnone && e->right) @@ -4663,7 +4696,7 @@ printed. else b = cast(binode, b->right); while (b) { - propagate_types(b->left, c, perr, NULL, 0); + propagate_types(b->left, c, perr_local, NULL, 0); b = cast(binode, b->right); } break; @@ -4775,29 +4808,53 @@ be declared at any time. case Assign: case Declare: - /* Both must match and not be labels, + /* 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 */ - t = propagate_types(b->left, c, perr, NULL, - (b->op == Assign ? Rnoconstant : 0)); + *perr &= ~(Erval | Econst); + t = propagate_types(b->left, c, perr, NULL, 0); if (!b->right) return Tnone; if (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); + 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)) + b->right = take_addr(b->right); + 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, NULL, 0); + t = propagate_types(b->right, c, perr_local, NULL, 0); if (t) - propagate_types(b->left, c, perr, t, - (b->op == Assign ? Rnoconstant : 0)); + propagate_types(b->left, c, perr, t, 0); + } + if (*perr & Erval) + type_err(c, "error: cannot assign to an rval", b, + NULL, 0, NULL); + else if (b->op == Assign && (*perr & Econst)) { + type_err(c, "error: Cannot assign to a constant: %v", + b->left, NULL, 0, NULL); + if (b->left->type == Xvar) { + struct var *var = cast(var, b->left); + struct variable *v = var->var; + type_err(c, "info: name was defined as a constant here", + v->where_decl, NULL, 0, NULL); + } } - if (t && t->dup == NULL && !(*perr & Emaycopy)) + if (t && t->dup == NULL && !(*perr_local & Emaycopy)) type_err(c, "error: cannot assign value of type %1", b, t, 0, NULL); + if (b->left->type == Xvar && (*perr_local & Efail)) + type_err(c, "info: variable '%v' was set as %1 here.", + cast(var, b->left)->var->where_set, t, rules, NULL); return Tnone; break; @@ -4819,10 +4876,10 @@ 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 + dinterp_exec(c, b->right, val, v->type, 0); break; } @@ -5246,9 +5303,7 @@ casepart` to track a list of case parts. ###### propagate binode cases case Loop: - t = propagate_types(b->right, c, perr, 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 @@ -5268,13 +5323,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); @@ -5286,9 +5337,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) @@ -5304,8 +5355,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); @@ -5403,7 +5454,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 @@ -5524,7 +5575,7 @@ constants. } while (perr & Eretry); if (perr & Efail) c->parse_error += 1; - else if (!(perr & Enoconst)) { + else if (!(perr & Eruntime)) { progress = some; struct value res = interp_exec( c, vb->right, &v->var->type); @@ -5632,8 +5683,8 @@ is a bit more interesting at this level. struct value fn = {.function = code}; struct type *t; var_block_close(c, CloseFunction, code); - t = add_anon_type(c, &function_prototype, - "func %.*s", name->name->name.len, + t = add_anon_type(c, &function_prototype, + "func %.*s", name->name->name.len, name->name->name.txt); name->type = t; t->function.params = reorder_bilist(args); @@ -5709,10 +5760,13 @@ is a bit more interesting at this level. struct value *val = var_value(&context, v); printf("func %.*s", v->name->name.len, v->name->name.txt); v->type->print_type_decl(v->type, stdout); - if (brackets) - print_exec(val->function, 0, brackets); - else + if (brackets) { + printf(" {\n"); + print_exec(val->function, 1, brackets); + printf("}\n"); + } else { print_value(v->type, val, stdout); + } printf("/* frame size %d */\n", v->type->function.local_size); target -= 1; } @@ -5745,7 +5799,7 @@ is a bit more interesting at this level. all_ok = 0; if (!v->type->function.inline_result && !v->type->function.return_type->dup) { - type_err(c, "error: function cannot return value of type %1", + type_err(c, "error: function cannot return value of type %1", v->where_decl, v->type->function.return_type, 0, NULL); } @@ -5814,15 +5868,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++) { @@ -5876,7 +5927,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 @@ -5904,7 +5955,7 @@ things which will likely grow as the languages grows. a : number a = A; b:number = B - if a > 0 and then b > 0: + if a > 0 and b > 0: while a != b: if a < b: b = b - a