X-Git-Url: https://ocean-lang.org/code/?p=ocean;a=blobdiff_plain;f=csrc%2Foceani.mdc;h=f97652d025ca4c90ef8e183ac45bea0eed41a677;hp=12be60cff7e066d9cfc9bf032047510a8701976d;hb=d58f04dc62ec58ed72c00db43b80122fbdfc0925;hpb=b57589e699a72debfbbe6a29983dfe7ed707a148 diff --git a/csrc/oceani.mdc b/csrc/oceani.mdc index 12be60c..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. @@ -110,6 +110,7 @@ structures can be used. ## macros struct parse_context; ## ast + ## ast late struct parse_context { struct token_config config; char *file_name; @@ -366,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); @@ -588,30 +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 {Rnolabel = 1<<0, Rboolok = 1<<1, Rnoconstant = 1<<2}; - enum prop_err {Efail = 1<<0, Eretry = 1<<1, Enoconst = 1<<2, - Emaycopy = 1<<3}; - -###### format cases - case 'r': - if (rules & Rnolabel) - fputs(" (labels not permitted)", stderr); - break; + 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; @@ -633,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; @@ -789,6 +789,7 @@ which might be reported in error messages. }; }; +###### ast late struct type { struct text name; struct type *next; @@ -990,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, @@ -1055,21 +1056,20 @@ 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 - if ((rules & Rnolabel) && have == Tlabel) - return 0; // NOTEST if (!require || !have) return 1; if (require->compat) - return require->compat(require, have); + return require->compat(require, have, rules); return require == have; } @@ -1090,7 +1090,7 @@ A separate function encoding these cases will simplify some code later. struct text str; mpq_t num; unsigned char bool; - void *label; + int label; ###### ast functions static void _free_value(struct type *type, struct value *v) @@ -1123,8 +1123,8 @@ A separate function encoding these cases will simplify some code later. val->bool = 0; break; case Vlabel: - val->label = NULL; - break; + val->label = 0; // NOTEST + break; // NOTEST } } @@ -1135,8 +1135,8 @@ A separate function encoding these cases will simplify some code later. case Vnone: // NOTEST break; // NOTEST case Vlabel: - vnew->label = vold->label; - break; + vnew->label = vold->label; // NOTEST + break; // NOTEST case Vbool: vnew->bool = vold->bool; break; @@ -1157,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; @@ -1174,7 +1174,7 @@ A separate function encoding these cases will simplify some code later. case Vnone: // NOTEST fprintf(f, "*no-value*"); break; // NOTEST case Vlabel: // NOTEST - fprintf(f, "*label-%p*", v->label); break; // NOTEST + fprintf(f, "*label-%d*", v->label); break; // NOTEST case Vstr: fprintf(f, "%.*s", v->str.len, v->str.txt); break; case Vbool: @@ -1259,10 +1259,11 @@ executable. return v; } -###### Grammar - +###### declare terminals $TERM True False +###### Grammar + $*val Value -> True ${ $0 = new_val(Tbool, $1); @@ -1273,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]; @@ -1316,8 +1317,9 @@ executable. { struct val *val = cast(val, prog); if (!type_compat(type, val->vtype, rules)) - type_err(c, "error: expected %1%r found %2", + type_err(c, "error: expected %1 found %2", prog, type, rules, val->vtype); + *perr |= Erval; return val->vtype; } @@ -1359,6 +1361,99 @@ executable. return rv; } +#### Labels + +Labels are a temporary concept until I implement enums. There are an +anonymous enum which is declared by usage. Thet are only allowed in +`use` statements and corresponding `case` entries. They appear as a +period followed by an identifier. All identifiers that are "used" must +have a "case". + +For now, we have a global list of labels, and don't check that all "use" +match "case". + +###### exec type + Xlabel, + +###### ast + struct label { + struct exec; + struct text name; + int value; + }; +###### free exec cases + case Xlabel: + free(e); + break; +###### print exec cases + case Xlabel: { + struct label *l = cast(label, e); + printf(".%.*s", l->name.len, l->name.txt); + break; + } + +###### ast + struct labels { + struct labels *next; + struct text name; + int value; + }; +###### parse context + struct labels *labels; + int next_label; +###### ast functions + static int label_lookup(struct parse_context *c, struct text name) + { + struct labels *l, **lp = &c->labels; + while (*lp && text_cmp((*lp)->name, name) < 0) + lp = &(*lp)->next; + if (*lp && text_cmp((*lp)->name, name) == 0) + return (*lp)->value; + l = calloc(1, sizeof(*l)); + l->next = *lp; + l->name = name; + if (c->next_label == 0) + c->next_label = 2; + l->value = c->next_label; + c->next_label += 1; + *lp = l; + return l->value; + } + +###### free context storage + while (context.labels) { + struct labels *l = context.labels; + context.labels = l->next; + free(l); + } + +###### declare terminals + $TERM . +###### term grammar + | . IDENTIFIER ${ { + struct label *l = new_pos(label, $ID); + l->name = $ID.txt; + $0 = l; + } }$ +###### propagate exec cases + case Xlabel: { + struct label *l = cast(label, prog); + l->value = label_lookup(c, l->name); + 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 + case Xlabel : { + struct label *l = cast(label, e); + rv.label = l->value; + rvtype = Tlabel; + break; + } + + ### Variables Variables are scoped named values. We store the names in a linked list @@ -1836,9 +1931,6 @@ all pending-scope variables become conditionally scoped. v->previous->scope == PendingScope) /* all previous branches used name */ v->scope = PendingScope; - else if (v->type == Tlabel) - /* Labels remain pending even when not used */ - v->scope = PendingScope; // UNTESTED else v->scope = OutScope; if (ct == CloseElse) { @@ -1869,8 +1961,6 @@ all pending-scope variables become conditionally scoped. v->scope = InScope; /* fallthrough */ case CloseSequential: - if (v->type == Tlabel) - v->scope = PendingScope; switch (v->scope) { case InScope: v->scope = OutScope; @@ -1884,10 +1974,7 @@ all pending-scope variables become conditionally scoped. for (v2 = v; v2 && v2->scope == PendingScope; v2 = v2->previous) - if (v2->type == Tlabel) - v2->scope = CondScope; - else - v2->scope = OutScope; + v2->scope = OutScope; break; case CondScope: case OutScope: break; @@ -1936,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 @@ -1962,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; @@ -1974,7 +2061,7 @@ tell if it was set or not later. if (init) memcpy(ret, init, t->size); else - val_init(t, ret); + val_init(t, ret); // NOTEST return ret; } @@ -2009,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) @@ -2187,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); @@ -2204,16 +2284,16 @@ correctly. *perr |= Eretry; } } else if (!type_compat(type, v->type, rules)) { - type_err(c, "error: expected %1%r but variable '%v' is %2", prog, + type_err(c, "error: expected %1 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; + *perr |= Eruntime; + if (v->constant) + *perr |= Econst; + return v->type; } ###### interp exec cases @@ -2318,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); @@ -2336,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; @@ -2380,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) @@ -2473,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 @@ -2507,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); @@ -2515,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; @@ -2534,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; @@ -2559,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 @@ -2620,6 +2719,8 @@ function will be needed. ###### type functions void (*print_type_decl)(struct type *type, FILE *f); + struct type *(*fieldref)(struct type *t, struct parse_context *c, + struct fieldref *f, struct value **vp); ###### value functions @@ -2724,12 +2825,41 @@ function will be needed. return 1; } + static int find_struct_index(struct type *type, struct text field) + { + int i; + for (i = 0; i < type->structure.nfields; i++) + if (text_cmp(type->structure.fields[i].name, field) == 0) + return i; + return IndexInvalid; + } + + static struct type *structure_fieldref(struct type *t, struct parse_context *c, + struct fieldref *f, struct value **vp) + { + if (f->index == IndexUnknown) { + f->index = find_struct_index(t, f->name); + if (f->index < 0) + type_err(c, "error: cannot find requested field in %1", + f->left, t, 0, NULL); + } + if (f->index < 0) + return NULL; + if (vp) { + struct value *v = *vp; + v = (void*)v->ptr + t->structure.fields[f->index].offset; + *vp = v; + } + return t->structure.fields[f->index].type; + } + static struct type structure_prototype = { .init = structure_init, .free = structure_free, .free_type = structure_free_type, .print_type_decl = structure_print_type, .prepare_type = structure_prepare_type, + .fieldref = structure_fieldref, }; ###### exec type @@ -2742,6 +2872,7 @@ function will be needed. int index; struct text name; }; + enum { IndexUnknown = -1, IndexInvalid = -2 }; ###### free exec cases case Xfieldref: @@ -2750,7 +2881,7 @@ function will be needed. break; ###### declare terminals - $TERM struct . + $TERM struct ###### term grammar @@ -2758,7 +2889,7 @@ function will be needed. struct fieldref *fr = new_pos(fieldref, $2); fr->left = $<1; fr->name = $3.txt; - fr->index = -2; + fr->index = IndexUnknown; $0 = fr; } }$ @@ -2772,16 +2903,6 @@ function will be needed. break; } -###### ast functions - static int find_struct_index(struct type *type, struct text field) - { - int i; - for (i = 0; i < type->structure.nfields; i++) - if (text_cmp(type->structure.fields[i].name, field) == 0) - return i; - return -1; - } - ###### propagate exec cases case Xfieldref: @@ -2789,24 +2910,15 @@ function will be needed. struct fieldref *f = cast(fieldref, prog); 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 - NULL, 0, NULL); - else if (st->init != structure_init) - type_err(c, "error: field reference attempted on %1, not a struct", + if (!st || !st->fieldref) + type_err(c, "error: field reference on %1 is not supported", f->left, st, 0, NULL); - else if (f->index == -2) { - f->index = find_struct_index(st, f->name); - if (f->index < 0) - type_err(c, "error: cannot find requested field in %1", - f->left, st, 0, NULL); - } - if (f->index >= 0) { - struct type *ft = st->structure.fields[f->index].type; - if (!type_compat(type, ft, rules)) + else { + t = st->fieldref(st, c, f, NULL); + if (t && !type_compat(type, t, rules)) type_err(c, "error: have %1 but need %2", prog, - ft, rules, type); - return ft; + t, rules, type); + return t; } break; } @@ -2817,30 +2929,37 @@ function will be needed. struct fieldref *f = cast(fieldref, e); struct type *ltype; struct value *lleft = linterp_exec(c, f->left, <ype); - lrv = (void*)lleft->ptr + ltype->structure.fields[f->index].offset; - rvtype = ltype->structure.fields[f->index].type; + lrv = lleft; + rvtype = ltype->fieldref(ltype, c, f, &lrv); break; } ###### 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"); } @@ -3024,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) @@ -3038,6 +3168,21 @@ anything in the heap or on the stack. A reference can be assigned return val->ref != NULL; } + static struct type *reference_fieldref(struct type *t, struct parse_context *c, + struct fieldref *f, struct value **vp) + { + struct type *rt = t->reference.referent; + + if (rt->fieldref) { + if (vp) + *vp = (*vp)->ref; + return rt->fieldref(rt, c, f, vp); + } + type_err(c, "error: field reference on %1 is not supported", + f->left, rt, 0, NULL); + return Tnone; + } + static struct type reference_prototype = { .print_type = reference_print_type, .cmp_eq = reference_cmp, @@ -3045,6 +3190,7 @@ anything in the heap or on the stack. A reference can be assigned .test = reference_test, .free = reference_free, .compat = reference_compat, + .fieldref = reference_fieldref, .size = sizeof(void*), .align = sizeof(void*), }; @@ -3148,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) @@ -3157,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); @@ -3204,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 @@ -3220,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 @@ -3331,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) { @@ -3348,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); } @@ -3365,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); } @@ -3398,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) @@ -3556,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; } @@ -3672,9 +3860,9 @@ there. struct binode *b2 = cast(binode, b->right); struct type *t2; - 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); + 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; } @@ -3684,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); } @@ -3744,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 @@ -3768,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; @@ -3783,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; @@ -3806,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); @@ -3820,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 "); @@ -3836,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); @@ -3846,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); @@ -3956,17 +4100,18 @@ 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, perr, NULL, Rnolabel); + t = propagate_types(b->left, c, perr, NULL, 0); if (t) propagate_types(b->right, c, perr, t, 0); else { - t = propagate_types(b->right, c, perr, NULL, Rnolabel); // 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 @@ -4123,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 @@ -4144,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: @@ -4153,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: @@ -4170,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: @@ -4181,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 @@ -4246,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: @@ -4358,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; @@ -4391,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; @@ -4431,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 @@ -4465,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) @@ -4477,7 +4619,7 @@ the common header for all reductions to use. if (!type) type = t; else if (t != type) - type_err(c, "error: expected %1%r, found %2", + type_err(c, "error: expected %1, found %2", e->left, type, rules, t); } } @@ -4554,7 +4696,7 @@ printed. else b = cast(binode, b->right); while (b) { - propagate_types(b->left, c, perr, NULL, Rnolabel); + propagate_types(b->left, c, perr_local, NULL, 0); b = cast(binode, b->right); } break; @@ -4585,9 +4727,9 @@ An assignment will assign a value to a variable, providing it hasn't been declared as a constant. The analysis phase ensures that the type will be correct so the interpreter just needs to perform the calculation. There is a form of assignment which declares a new -variable as well as assigning a value. If a name is assigned before -it is declared, and error will be raised as the name is created as -`Tlabel` and it is illegal to assign to such names. +variable as well as assigning a value. If a name is used before +it is declared, it is assumed to be a global constant which are allowed to +be declared at any time. ###### Binode types Assign, @@ -4666,29 +4808,53 @@ it is declared, and error will be raised as the name is created as 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, - Rnolabel | (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, Rnolabel); + 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 (t && t->dup == NULL && !(*perr & Emaycopy)) + 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_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; @@ -4710,10 +4876,10 @@ it is declared, and error will be raised as the name is created as 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; } @@ -4735,17 +4901,6 @@ function which has a return type, and the "condition" code blocks in $0 = b = new_pos(binode, $1); b->op = Use; b->right = $<2; - if (b->right->type == Xvar) { - struct var *v = cast(var, b->right); - if (v->var->type == Tnone) { - /* Convert this to a label */ - struct value *val; - - v->var->type = Tlabel; - val = global_alloc(c, Tlabel, v->var, NULL); - val->label = val; - } - } }$ ###### print binode cases @@ -5148,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 @@ -5170,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); @@ -5188,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) @@ -5206,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); @@ -5305,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 @@ -5426,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); @@ -5534,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); @@ -5611,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; } @@ -5647,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); } @@ -5716,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++) { @@ -5778,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 @@ -5806,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 @@ -5837,19 +5986,19 @@ things which will likely grow as the languages grows. while mid := (lo + hi) / 2 if mid == target: - use Found + use .Found if mid < target: lo = mid else hi = mid if hi - lo < 1: lo = mid - use GiveUp + use .GiveUp use True do pass - case Found: + case .Found: print "Yay, I found", target - case GiveUp: + case .GiveUp: print "Closest I found was", lo size::= 10