## macros
struct parse_context;
## ast
+ ## ast late
struct parse_context {
struct token_config config;
char *file_name;
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);
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,};
+ 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;
}
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;
};
};
+###### ast late
struct type {
struct text name;
struct type *next;
###### 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,
###### 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;
}
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)
val->bool = 0;
break;
case Vlabel:
- val->label = NULL;
- break;
+ val->label = 0; // NOTEST
+ break; // NOTEST
}
}
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;
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:
return v;
}
-###### Grammar
-
+###### declare terminals
$TERM True False
+###### Grammar
+
$*val
Value -> True ${
$0 = new_val(Tbool, $1);
{
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;
}
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
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) {
v->scope = InScope;
/* fallthrough */
case CloseSequential:
- if (v->type == Tlabel)
- v->scope = PendingScope;
switch (v->scope) {
case InScope:
v->scope = OutScope;
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;
if (init)
memcpy(ret, init, t->size);
else
- val_init(t, ret);
+ val_init(t, ret); // NOTEST
return ret;
}
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);
*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;
+ *perr |= Eruntime;
+ if (v->constant)
+ *perr |= Econst;
if (!type)
return v->type;
return type;
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;
/* 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;
###### 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
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
break;
###### declare terminals
- $TERM struct .
+ $TERM struct
###### term grammar
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 IndexInvalid;
- }
-
###### propagate exec cases
case Xfieldref:
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 == IndexUnknown) {
- 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;
}
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;
}
/* 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 (have->compat != require->compat)
return 0;
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,
.test = reference_test,
.free = reference_free,
.compat = reference_compat,
+ .fieldref = reference_fieldref,
.size = sizeof(void*),
.align = sizeof(void*),
};
r->reftype = type;
*perr |= Eretry;
}
+ *perr |= Erval;
return type;
case RefNil:
if (type && type->free != reference_free)
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);
/* 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
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;
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;
}
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;
}
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 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
+ t = propagate_types(b->right, c, perr, NULL, 0); // UNTESTED
if (t) // UNTESTED
t = propagate_types(b->left, c, perr, t, 0); // UNTESTED
}
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
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:
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:
type_err(c, // UNTESTED
"error: Can only convert string to number, not %1",
prog, type, 0, NULL);
+ *perr |= Erval;
return Tnum;
case Test:
if (!t || !t->test)
type_err(c, "error: '?' requires a testable value, not %1",
prog, t, 0, NULL);
+ *perr |= Erval;
return Tbool;
case Choose:
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
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);
}
}
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;
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,
* 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 (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);
} 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);
return Tnone;
$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
###### propagate binode cases
case Loop:
- t = propagate_types(b->right, c, perr, Tnone, 0);
+ t = propagate_types(b->right, c, perr_local, Tnone, 0);
if (!type_compat(Tnone, t, 0))
*perr |= Efail; // UNTESTED
return propagate_types(b->left, c, perr, type, rules);
} 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);
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);
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);
}
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
code / ocean / blobdiff