###### 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};
$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];
{
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
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;
*perr |= Eruntime;
if (v->constant)
*perr |= Econst;
- if (!type)
- return v->type;
- return type;
+ return v->type;
}
###### interp exec cases
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);
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;
/* 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)
$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 = $<OT;
- v->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 = $<Type;
$0->array.size = 0;
$0->array.unspec = 1;
- $0->array.vsize = v;
+ $0->array.vsize = NULL;
} }$
###### Binode types
- Index,
+ Index, Length,
###### term grammar
$0 = b;
} }$
+ | Term [ ] ${ {
+ struct binode *b = new(binode);
+ b->op = Length;
+ b->left = $<Term;
+ $0 = b;
+ } }$
+
###### print binode cases
case Index:
print_exec(b->left, -1, bracket);
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,
}
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;
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
}
###### 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 = $<FB;
+ if (!t)
+ t = add_type(c, $ID.txt, NULL);
t->first_use = $ID;
+ $0 = t;
+ } }$
+ $void
+ DeclareStruct -> struct StructName FieldBlock Newlines ${ {
+ struct type *t = $<SN;
+ struct type tmp = *t;
+
+ *t = structure_prototype;
+ t->name = tmp.name;
+ t->next = tmp.next;
+ t->first_use = tmp.first_use;
+
+ t->structure.field_list = $<FB;
} }$
$*fieldlist
| SimpleFieldList EOL ${ $0 = $<SFL; }$
FieldLines -> SimpleFieldList Newlines ${ $0 = $<SFL; }$
- | FieldLines SimpleFieldList Newlines ${
- $SFL->prev = $<FL;
- $0 = $<SFL;
- }$
+ | FieldLines SimpleFieldList Newlines ${ {
+ struct fieldlist *f = $<SFL;
+
+ if (f) {
+ $0 = f;
+ while (f->prev)
+ f = f->prev;
+ f->prev = $<FL;
+ } else
+ $0 = $<FL;
+ } }$
SimpleFieldList -> Field ${ $0 = $<F; }$
| SimpleFieldList ; Field ${
if (fl->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");
}
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)
return Tnone;
}
-
static struct type reference_prototype = {
.print_type = reference_print_type,
.cmp_eq = reference_cmp,
###### Expressions: dereference
###### Binode types
- Deref,
+ Deref, AddressOf,
###### term grammar
print_exec(b->left, -1, bracket);
printf("@");
break;
+ case AddressOf:
+ print_exec(b->left, -1, bracket);
+ break;
###### propagate binode cases
case Deref:
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
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)
{
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);
}
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);
}
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,
/* 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;
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:
ComplexStatements -> ComplexStatements ComplexStatement ${
if ($2 == NULL) {
- $0 = $<1;
+ $0 = $<1; // NOTEST - impossible
} else {
$0 = new(binode);
$0->op = Block;
}$
| ComplexStatement ${
if ($1 == NULL) {
- $0 = NULL;
+ $0 = NULL; // NOTEST - impossible
} else {
$0 = new(binode);
$0->op = Block;
###### 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
be declared at any time.
###### Binode types
- Assign,
- Declare,
+ Assign, AssignRef,
+ Declare, DeclareRef,
###### declare terminals
$TERM =
###### print binode cases
case Assign:
+ case AssignRef:
do_indent(indent, "");
print_exec(b->left, -1, bracket);
printf(" = ");
break;
case Declare:
+ case DeclareRef:
{
struct variable *v = cast(var, b->left)->var;
do_indent(indent, "");
###### 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
return Tnone;
if (t) {
- if (propagate_types(b->right, c, perr_local, 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)) {
+ 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)
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) {
}
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;
###### 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;
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;
}
###### 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
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);
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)
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);
| DeclarationList Declaration
Declaration -> ERROR Newlines ${
- tok_err(c, // UNTESTED
+ tok_err(c, // NOTEST
"error: unhandled parse error", &$1);
}$
| DeclareConstant
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++) {
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