## macros
struct parse_context;
## ast
+ ## ast late
struct parse_context {
struct token_config config;
char *file_name;
prepare_types(&context);
if (!context.parse_error && !analyse_funcs(&context)) {
fprintf(stderr, "oceani: type error in program - not running.\n");
- context.parse_error = 1;
+ context.parse_error += 1;
}
if (doprint) {
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);
}
}
fputs("\n", stderr);
- c->parse_error = 1;
+ c->parse_error += 1;
}
static void tok_err(struct parse_context *c, char *fmt, struct token *t)
{
fprintf(stderr, "%s:%d:%d: %s: %.*s\n", c->file_name, t->line, t->col, fmt,
t->txt.len, t->txt.txt);
- c->parse_error = 1;
+ c->parse_error += 1;
}
## Entities: declared and predeclared.
if (loc->type == Xbinode)
return __fput_loc(cast(binode,loc)->left, f) ||
__fput_loc(cast(binode,loc)->right, f); // NOTEST
- return 0;
+ return 0; // NOTEST
}
static void fput_loc(struct exec *loc, FILE *f)
{
if (!__fput_loc(loc, f))
- fprintf(f, "??:??: ");
+ fprintf(f, "??:??: "); // NOTEST
}
Each different type of `exec` node needs a number of functions defined,
So `propagate_types` is passed an expected type (being a `struct type`
pointer together with some `val_rules` flags) that the `exec` is
-expected to return, and returns the type that it does return, either
-of which can be `NULL` signifying "unknown". An `ok` flag is passed
-by reference. It is set to `0` when an error is found, and `2` when
-any change is made. If it remains unchanged at `1`, then no more
-propagation is needed.
+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 a compile time, `Eruntime` is set.
+If the expression can be copied, `Emaycopy` is set.
-###### ast
+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.
- enum val_rules {Rnolabel = 1<<0, Rboolok = 1<<1, Rnoconstant = 1<<2};
+###### ast
-###### 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, int *ok,
- struct type *type, int rules);
+ static struct type *propagate_types(struct exec *prog, struct parse_context *c, enum prop_err *perr,
+ struct type *type, enum val_rules rules);
###### core functions
- static struct type *__propagate_types(struct exec *prog, struct parse_context *c, int *ok,
- struct type *type, int rules)
+ static struct type *__propagate_types(struct exec *prog, struct parse_context *c, enum prop_err *perr,
+ enum prop_err *perr_local,
+ struct type *type, enum val_rules rules)
{
struct type *t;
return Tnone;
}
- static struct type *propagate_types(struct exec *prog, struct parse_context *c, int *ok,
- struct type *type, int rules)
+ static struct type *propagate_types(struct exec *prog, struct parse_context *c, enum prop_err *perr,
+ struct type *type, enum val_rules rules)
{
- struct type *ret = __propagate_types(prog, c, ok, type, rules);
+ int pre_err = c->parse_error;
+ enum prop_err perr_local = 0;
+ struct type *ret = __propagate_types(prog, c, perr, &perr_local, type, rules);
- if (c->parse_error)
- *ok = 0;
+ *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;
+ struct token first_use;
int size, align;
int anon;
void (*init)(struct type *type, struct value *val);
- void (*prepare_type)(struct parse_context *c, struct type *type, int parse_time);
+ int (*prepare_type)(struct parse_context *c, struct type *type, int parse_time);
void (*print)(struct type *type, struct value *val, FILE *f);
void (*print_type)(struct type *type, FILE *f);
int (*cmp_order)(struct type *t1, struct type *t2,
int (*cmp_eq)(struct type *t1, struct type *t2,
struct value *v1, struct value *v2);
void (*dup)(struct type *type, struct value *vold, struct value *vnew);
+ int (*test)(struct type *type, struct value *val);
void (*free)(struct type *type, struct value *val);
void (*free_type)(struct type *t);
long long (*to_int)(struct value *v);
struct type *n;
n = calloc(1, sizeof(*n));
- *n = *proto;
+ if (proto)
+ *n = *proto;
+ else
+ n->size = -1;
n->name = s;
n->anon = anon;
n->next = c->typelist;
va_start(ap, name);
vasprintf(&t.txt, name, ap);
va_end(ap);
- t.len = strlen(name);
+ t.len = strlen(t.txt);
return _add_type(c, t, proto, 1);
}
+ static struct type *find_anon_type(struct parse_context *c,
+ struct type *proto, char *name, ...)
+ {
+ struct type *t = c->typelist;
+ struct text nm;
+ va_list ap;
+
+ va_start(ap, name);
+ vasprintf(&nm.txt, name, ap);
+ va_end(ap);
+ nm.len = strlen(name);
+
+ while (t && (!t->anon ||
+ text_cmp(t->name, nm) != 0))
+ t = t->next;
+ if (t) {
+ free(nm.txt);
+ return t;
+ }
+ return _add_type(c, nm, proto, 1);
+ }
+
static void free_type(struct type *t)
{
/* The type is always a reference to something in the
fprintf(f, "%.*s", type->name.len, type->name.txt);
else if (type->print_type)
type->print_type(type, f);
+ else if (type->name.len && type->anon)
+ fprintf(f, "\"%.*s\"", type->name.len, type->name.txt);
else
- fputs("*invalid*type*", f);
+ fputs("*invalid*type*", f); // NOTEST
}
static void val_init(struct type *type, struct value *val)
{
if (tl && tl->cmp_order)
return tl->cmp_order(tl, tr, left, right);
- if (tl && tl->cmp_eq) // NOTEST
- return tl->cmp_eq(tl, tr, left, right); // NOTEST
+ if (tl && tl->cmp_eq)
+ return tl->cmp_eq(tl, tr, left, right);
return -1; // NOTEST
}
static void prepare_types(struct parse_context *c)
{
struct type *t;
-
- for (t = c->typelist; t; t = t->next)
- if (t->prepare_type)
- t->prepare_type(c, t, 1);
+ int retry = 1;
+ enum { none, some, cannot } progress = none;
+
+ while (retry) {
+ retry = 0;
+
+ for (t = c->typelist; t; t = t->next) {
+ if (t->size < 0)
+ tok_err(c, "error: type used but not declared",
+ &t->first_use);
+ if (t->size == 0 && t->prepare_type) {
+ if (t->prepare_type(c, t, 1))
+ progress = some;
+ else if (progress == cannot)
+ tok_err(c, "error: type has recursive definition",
+ &t->first_use);
+ else
+ retry = 1;
+ }
+ }
+ switch (progress) {
+ case cannot:
+ retry = 0; break;
+ case none:
+ progress = cannot; break;
+ case some:
+ progress = none; break;
+ }
+ }
}
###### 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
Type -> IDENTIFIER ${
- $0 = find_type(c, $1.txt);
+ $0 = find_type(c, $ID.txt);
if (!$0) {
- tok_err(c,
- "error: undefined type", &$1);
-
- $0 = Tnone;
+ $0 = add_type(c, $ID.txt, NULL);
+ $0->first_use = $ID;
}
}$
## type grammar
###### 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:
static void _free_value(struct type *type, struct value *v);
+ static int bool_test(struct type *type, struct value *v)
+ {
+ return v->bool;
+ }
+
static struct type base_prototype = {
.init = _val_init,
.print = _print_value,
###### context initialization
Tbool = add_base_type(&context, "Boolean", Vbool, sizeof(char));
+ Tbool->test = bool_test;
Tstr = add_base_type(&context, "string", Vstr, sizeof(struct text));
Tnum = add_base_type(&context, "number", Vnum, sizeof(mpq_t));
Tnone = add_base_type(&context, "none", Vnone, 0);
return v;
}
-###### Grammar
-
+###### declare terminals
$TERM True False
+###### Grammar
+
$*val
Value -> True ${
$0 = new_val(Tbool, $1);
$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];
{
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 (!v->global) {
if (!c->local || !v->type)
- return NULL;
+ 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;
if (init)
memcpy(ret, init, t->size);
else
- val_init(t, ret);
+ val_init(t, ret); // NOTEST
return ret;
}
struct variable *v = var_ref(c, $1.txt);
$0 = new_pos(var, $1);
if (v == NULL) {
- /* This might be a label - allocate a var just in case */
+ /* This might be a global const or a label
+ * Allocate a var with impossible type Tnone,
+ * which will be adjusted when we find out what it is,
+ * or will trigger an error.
+ */
v = var_decl(c, $1.txt);
if (v) {
v->type = Tnone;
} else
fputs("???", stderr); // NOTEST
} else
- fputs("NOTVAR", stderr);
+ fputs("NOTVAR", stderr); // NOTEST
break;
###### propagate exec cases
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);
if (v->type == NULL) {
- if (type && *ok != 0) {
+ if (type && !(*perr & Efail)) {
v->type = type;
v->where_set = prog;
- *ok = 2;
+ *perr |= Eretry;
}
- return type;
- }
- if (!type_compat(type, v->type, rules)) {
- type_err(c, "error: expected %1%r but variable '%v' is %2", prog,
+ } else if (!type_compat(type, v->type, rules)) {
+ 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 (!type)
- return v->type;
- return type;
+ if (!v->global || v->frame_pos < 0)
+ *perr |= Eruntime;
+ if (v->constant)
+ *perr |= Econst;
+ return v->type;
}
###### interp exec cases
###### value functions
- static void array_prepare_type(struct parse_context *c, struct type *type,
+ static int array_prepare_type(struct parse_context *c, struct type *type,
int parse_time)
{
struct value *vsize;
mpz_t q;
if (type->array.static_size)
- return;
+ return 1; // NOTEST - guard against reentry
if (type->array.unspec && parse_time)
- return;
+ return 1; // NOTEST - unspec is still incomplete
+ if (parse_time && type->array.vsize && !type->array.vsize->global)
+ return 1; // NOTEST - should be impossible
if (type->array.vsize) {
vsize = var_value(c, type->array.vsize);
if (!vsize)
- return;
+ 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);
mpz_clear(q);
}
+ if (!parse_time)
+ return 1;
+ if (type->array.member->size <= 0)
+ return 0; // NOTEST - error caught before here
- if (parse_time && type->array.member->size) {
- type->array.static_size = 1;
- type->size = type->array.size * type->array.member->size;
- type->align = type->array.member->align;
- }
+ type->array.static_size = 1;
+ type->size = type->array.size * type->array.member->size;
+ type->align = type->array.member->align;
+
+ return 1;
}
static void array_init(struct type *type, struct value *val)
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)
$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,
* result is the member type of the array
*/
- propagate_types(b->right, c, ok, Tnum, 0);
- t = propagate_types(b->left, c, ok, 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;
}
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
###### 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
free_fieldlist(t->structure.field_list);
}
- static void structure_prepare_type(struct parse_context *c,
- struct type *t, int parse_time)
+ static int structure_prepare_type(struct parse_context *c,
+ struct type *t, int parse_time)
{
int cnt = 0;
struct fieldlist *f;
if (!parse_time || t->structure.fields)
- return;
+ return 1;
for (f = t->structure.field_list; f; f=f->prev) {
- int ok;
+ enum prop_err perr;
cnt += 1;
+ if (f->f.type->size <= 0)
+ return 0;
if (f->f.type->prepare_type)
- f->f.type->prepare_type(c, f->f.type, 1);
+ f->f.type->prepare_type(c, f->f.type, parse_time);
+
if (f->init == NULL)
continue;
do {
- ok = 1;
- propagate_types(f->init, c, &ok, f->f.type, 0);
- } while (ok == 2);
- if (!ok)
- c->parse_error = 1; // NOTEST
+ perr = 0;
+ propagate_types(f->init, c, &perr, f->f.type, 0);
+ } while (perr & Eretry);
+ if (perr & Efail)
+ c->parse_error += 1; // NOTEST
}
t->structure.nfields = cnt;
f = f->prev;
}
+ 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 = {
.free_type = structure_free_type,
.print_type_decl = structure_print_type,
.prepare_type = structure_prepare_type,
+ .fieldref = structure_fieldref,
};
###### exec type
int index;
struct text name;
};
+ enum { IndexUnknown = -1, IndexInvalid = -2 };
###### free exec cases
case Xfieldref:
break;
###### declare terminals
- $TERM struct .
+ $TERM struct
###### term grammar
struct fieldref *fr = new_pos(fieldref, $2);
fr->left = $<1;
fr->name = $3.txt;
- fr->index = -2;
+ fr->index = IndexUnknown;
$0 = fr;
} }$
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:
{
struct fieldref *f = cast(fieldref, prog);
- struct type *st = propagate_types(f->left, c, ok, NULL, 0);
+ 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;
}
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 =
- add_type(c, $2.txt, &structure_prototype);
+ $*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);
+ t = NULL;
+ }
+ 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;
} }$
| 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");
}
}
}
+#### References
+
+References, or pointers, are values that refer to another value. They
+can only refer to a `struct`, though as a struct can embed anything they
+can effectively refer to anything.
+
+References are potentially dangerous as they might refer to some
+variable which no longer exists - either because a stack frame
+containing it has been discarded or because the value was allocated on
+the heap and has now been free. Ocean does not yet provide any
+protection against these problems. It will in due course.
+
+With references comes the opportunity and the need to explicitly
+allocate values on the "heap" and to free them. We currently provide
+fairly basic support for this.
+
+Reference make use of the `@` symbol in various ways. A type that starts
+with `@` is a reference to whatever follows. A reference value
+followed by an `@` acts as the referred value, though the `@` is often
+not needed. Finally, an expression that starts with `@` is a special
+reference related expression. Some examples might help.
+
+##### Example: Reference examples
+
+ struct foo
+ a: number
+ b: string
+ ref: @foo
+ bar: foo
+ bar.number = 23; bar.string = "hello"
+ baz: foo
+ ref = bar
+ baz = @ref
+ baz.a = ref.a * 2
+
+ ref = @new()
+ ref@ = baz
+ @free = ref
+ ref = @nil
+
+Obviously this is very contrived. `ref` is a reference to a `foo` which
+is initially set to refer to the value stored in `bar` - no extra syntax
+is needed to "Take the address of" `bar` - the fact that `ref` is a
+reference means that only the address make sense.
+
+When `ref.a` is accessed, that is whatever value is stored in `bar.a`.
+The same syntax is used for accessing fields both in structs and in
+references to structs. It would be correct to use `ref@.a`, but not
+necessary.
+
+`@new()` creates an object of whatever type is needed for the program
+to by type-correct. In future iterations of Ocean, arguments a
+constructor will access arguments, so the the syntax now looks like a
+function call. `@free` can be assigned any reference that was returned
+by `@new()`, and it will be freed. `@nil` is a value of whatever
+reference type is appropriate, and is stable and never the address of
+anything in the heap or on the stack. A reference can be assigned
+`@nil` or compared against that value.
+
+###### declare terminals
+ $TERM @
+
+###### type union fields
+
+ struct {
+ struct type *referent;
+ } reference;
+
+###### value union fields
+ struct value *ref;
+
+###### value functions
+
+ static void reference_print_type(struct type *t, FILE *f)
+ {
+ fprintf(f, "@");
+ type_print(t->reference.referent, f);
+ }
+
+ static int reference_cmp(struct type *tl, struct type *tr,
+ struct value *left, struct value *right)
+ {
+ return left->ref == right->ref ? 0 : 1;
+ }
+
+ static void reference_dup(struct type *t,
+ struct value *vold, struct value *vnew)
+ {
+ vnew->ref = vold->ref;
+ }
+
+ static void reference_free(struct type *t, struct value *v)
+ {
+ /* Nothing to do here */
+ }
+
+ 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 0;
+ return 1;
+ }
+
+ static int reference_test(struct type *type, struct value *val)
+ {
+ 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,
+ .dup = reference_dup,
+ .test = reference_test,
+ .free = reference_free,
+ .compat = reference_compat,
+ .fieldref = reference_fieldref,
+ .size = sizeof(void*),
+ .align = sizeof(void*),
+ };
+
+###### type grammar
+
+ | @ IDENTIFIER ${ {
+ struct type *t = find_type(c, $ID.txt);
+ if (!t) {
+ t = add_type(c, $ID.txt, NULL);
+ t->first_use = $ID;
+ }
+ $0 = find_anon_type(c, &reference_prototype, "@%.*s",
+ $ID.txt.len, $ID.txt.txt);
+ $0->reference.referent = t;
+ } }$
+
+###### core functions
+ static int text_is(struct text t, char *s)
+ {
+ return (strlen(s) == t.len &&
+ strncmp(s, t.txt, t.len) == 0);
+ }
+
+###### exec type
+ Xref,
+
+###### ast
+ struct ref {
+ struct exec;
+ enum ref_func { RefNew, RefFree, RefNil } action;
+ struct type *reftype;
+ struct exec *right;
+ };
+
+###### SimpleStatement Grammar
+
+ | @ IDENTIFIER = Expression ${ {
+ struct ref *r = new_pos(ref, $ID);
+ // Must be "free"
+ if (!text_is($ID.txt, "free"))
+ tok_err(c, "error: only \"@free\" makes sense here",
+ &$ID);
+
+ $0 = r;
+ r->action = RefFree;
+ r->right = $<Exp;
+ } }$
+
+###### expression grammar
+ | @ IDENTIFIER ( ) ${
+ // Only 'new' valid here
+ if (!text_is($ID.txt, "new")) {
+ tok_err(c, "error: Only reference function is \"@new()\"",
+ &$ID);
+ } else {
+ struct ref *r = new_pos(ref,$ID);
+ $0 = r;
+ r->action = RefNew;
+ }
+ }$
+ | @ IDENTIFIER ${
+ // Only 'nil' valid here
+ if (!text_is($ID.txt, "nil")) {
+ tok_err(c, "error: Only reference value is \"@nil\"",
+ &$ID);
+ } else {
+ struct ref *r = new_pos(ref,$ID);
+ $0 = r;
+ r->action = RefNil;
+ }
+ }$
+
+###### print exec cases
+ case Xref: {
+ struct ref *r = cast(ref, e);
+ switch (r->action) {
+ case RefNew:
+ printf("@new()"); break;
+ case RefNil:
+ printf("@nil"); break;
+ case RefFree:
+ do_indent(indent, "@free = ");
+ print_exec(r->right, indent, bracket);
+ break;
+ }
+ break;
+ }
+
+###### propagate exec cases
+ case Xref: {
+ struct ref *r = cast(ref, prog);
+ switch (r->action) {
+ case RefNew:
+ if (type && type->free != reference_free) {
+ type_err(c, "error: @new() can only be used with references, not %1",
+ prog, type, 0, NULL);
+ return NULL;
+ }
+ if (type && !r->reftype) {
+ r->reftype = type;
+ *perr |= Eretry;
+ }
+ *perr |= Erval;
+ return type;
+ case RefNil:
+ if (type && type->free != reference_free)
+ type_err(c, "error: @nil can only be used with reference, not %1",
+ prog, type, 0, NULL);
+ if (type && !r->reftype) {
+ r->reftype = type;
+ *perr |= Eretry;
+ }
+ *perr |= Erval;
+ return type;
+ case RefFree:
+ 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);
+ r->reftype = Tnone;
+ return Tnone;
+ }
+ break; // NOTEST
+ }
+
+
+###### interp exec cases
+ case Xref: {
+ struct ref *r = cast(ref, e);
+ switch (r->action) {
+ case RefNew:
+ if (r->reftype)
+ rv.ref = calloc(1, r->reftype->reference.referent->size);
+ rvtype = r->reftype;
+ break;
+ case RefNil:
+ rv.ref = NULL;
+ rvtype = r->reftype;
+ break;
+ case RefFree:
+ rv = interp_exec(c, r->right, &rvtype);
+ free_value(rvtype->reference.referent, rv.ref);
+ free(rv.ref);
+ rvtype = Tnone;
+ break;
+ }
+ break;
+ }
+
+###### free exec cases
+ case Xref: {
+ struct ref *r = cast(ref, e);
+ free_exec(r->right);
+ free(r);
+ break;
+ }
+
+###### Expressions: dereference
+
+###### Binode types
+ Deref, AddressOf,
+
+###### term grammar
+
+ | Term @ ${ {
+ struct binode *b = new(binode);
+ b->op = Deref;
+ b->left = $<Trm;
+ $0 = b;
+ } }$
+
+###### print binode cases
+ case Deref:
+ 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:
+ 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
A function is a chunk of code which can be passed parameters and can
struct exec *function;
###### type functions
- void (*check_args)(struct parse_context *c, int *ok,
+ void (*check_args)(struct parse_context *c, enum prop_err *perr,
struct type *require, struct exec *args);
###### value functions
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 void function_check_args(struct parse_context *c, int *ok,
+ 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)
{
/* This should be 'compat', but we don't have a 'tuple' type to
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;
}
- *ok = 1;
- propagate_types(arg->left, c, ok, pv->var->type, 0);
+ *perr = 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);
}
e->var = v;
if (v) {
v->where_decl = e;
+ v->where_set = e;
$0 = v;
} else {
v = var_ref(c, $1.txt);
| Varlist ; ${ $0 = $<1; }$
Varlist -> Varlist ; ArgDecl ${
- $0 = new(binode);
+ $0 = new_pos(binode, $2);
$0->op = List;
$0->left = $<Vl;
$0->right = $<AD;
$*var
ArgDecl -> IDENTIFIER : FormalType ${ {
- struct variable *v = var_decl(c, $1.txt);
- $0 = new(var);
+ struct variable *v = var_decl(c, $ID.txt);
+ $0 = new_pos(var, $ID);
$0->var = v;
+ v->where_decl = $0;
+ v->where_set = $0;
v->type = $<FT;
} }$
prog, NULL, 0, NULL);
return NULL;
}
- v->var->type->check_args(c, ok, 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, ok, Tbool, 0);
- t = propagate_types(b2->left, c, ok, type, Rnolabel);
- t2 = propagate_types(b2->right, c, ok, 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;
}
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);
}
case OrElse:
case Not:
/* both must be Tbool, result is Tbool */
- propagate_types(b->left, c, ok, Tbool, 0);
- propagate_types(b->right, c, ok, Tbool, 0);
+ propagate_types(b->left, c, perr, Tbool, 0);
+ propagate_types(b->right, c, perr, Tbool, 0);
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, ok, NULL, Rnolabel);
+ t = propagate_types(b->left, c, perr, NULL, 0);
if (t)
- propagate_types(b->right, c, ok, t, 0);
+ propagate_types(b->right, c, perr, t, 0);
else {
- t = propagate_types(b->right, c, ok, NULL, Rnolabel); // UNTESTED
- if (t) // UNTESTED
- t = propagate_types(b->left, c, ok, 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
### Expressions: Arithmetic etc.
The remaining expressions with the highest precedence are arithmetic,
-string concatenation, and string conversion. String concatenation
+string concatenation, string conversion, and testing. String concatenation
(`++`) has the same precedence as multiplication and division, but lower
than the uniary.
+Testing comes in two forms. A single question mark (`?`) is a uniary
+operator which converts come types into Boolean. The general meaning is
+"is this a value value" and there will be more uses as the language
+develops. A double questionmark (`??`) is a binary operator (Choose),
+with same precedence as multiplication, which returns the LHS if it
+tests successfully, else returns the RHS.
+
String conversion is a temporary feature until I get a better type
system. `$` is a prefix operator which expects a string and returns
a number.
###### Binode types
Plus, Minus,
Times, Divide, Rem,
- Concat,
- Absolute, Negate,
+ Concat, Choose,
+ Absolute, Negate, Test,
StringConv,
Bracket,
###### declare terminals
$LEFT + - Eop
- $LEFT * / % ++ Top
- $LEFT Uop $
+ $LEFT * / % ++ ?? Top
+ $LEFT Uop $ ?
$TERM ( )
###### expression grammar
Uop -> + ${ $0.op = Absolute; }$
| - ${ $0.op = Negate; }$
| $ ${ $0.op = StringConv; }$
+ | ? ${ $0.op = Test; }$
Top -> * ${ $0.op = Times; }$
| / ${ $0.op = Divide; }$
| % ${ $0.op = Rem; }$
| ++ ${ $0.op = Concat; }$
+ | ?? ${ $0.op = Choose; }$
###### print binode cases
case Plus:
case Divide:
case Concat:
case Rem:
+ case Choose:
if (bracket) printf("(");
print_exec(b->left, indent, bracket);
switch(b->op) {
case Divide: fputs(" / ", stdout); break;
case Rem: fputs(" % ", stdout); break;
case Concat: fputs(" ++ ", stdout); break;
+ case Choose: fputs(" ?? ", stdout); break;
default: abort(); // NOTEST
} // NOTEST
print_exec(b->right, indent, bracket);
case Absolute:
case Negate:
case StringConv:
+ case Test:
if (bracket) printf("(");
switch (b->op) {
case Absolute: fputs("+", stdout); break;
case Negate: fputs("-", stdout); break;
case StringConv: fputs("$", stdout); break;
+ case Test: fputs("?", stdout); break;
default: abort(); // NOTEST
} // NOTEST
print_exec(b->right, indent, bracket);
case Negate:
/* as propagate_types ignores a NULL,
* unary ops fit here too */
- propagate_types(b->left, c, ok, Tnum, 0);
- propagate_types(b->right, c, ok, Tnum, 0);
+ propagate_types(b->left, c, perr, Tnum, 0);
+ propagate_types(b->right, c, perr, Tnum, 0);
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:
/* both must be Tstr, result is Tstr */
- propagate_types(b->left, c, ok, Tstr, 0);
- propagate_types(b->right, c, ok, Tstr, 0);
+ propagate_types(b->left, c, perr, Tstr, 0);
+ propagate_types(b->right, c, perr, Tstr, 0);
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, ok, Tstr, 0);
+ 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:
+ /* LHS must support ->test, result is Tbool */
+ t = propagate_types(b->right, c, perr, NULL, 0);
+ if (!t || !t->test)
+ type_err(c, "error: '?' requires a testable value, not %1",
+ prog, t, 0, NULL);
+ *perr |= Erval;
+ return Tbool;
+
+ case Choose:
+ /* LHS and RHS must match and are returned. Must support
+ * ->test
+ */
+ t = propagate_types(b->left, c, perr, type, rules);
+ t = propagate_types(b->right, c, perr, t, rules);
+ 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, ok, type, 0);
+ return propagate_types(b->right, c, perr, type, rules);
###### interp binode cases
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:
+ right = interp_exec(c, b->right, &rtype);
+ rvtype = Tbool;
+ rv.bool = !!rtype->test(rtype, &right);
+ break;
+ case Choose:
+ left = interp_exec(c, b->left, <ype);
+ if (ltype->test(ltype, &left)) {
+ rv = left;
+ rvtype = ltype;
+ ltype = NULL;
+ } else
+ rv = interp_exec(c, b->right, &rvtype);
+ break;
###### value functions
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
struct binode *e;
for (e = b; e; e = cast(binode, e->right)) {
- t = propagate_types(e->left, c, ok, NULL, rules);
+ t = propagate_types(e->left, c, perr, NULL, rules);
if ((rules & Rboolok) && (t == Tbool || t == Tnone))
t = NULL;
if (t == Tnone && e->right)
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);
}
}
###### SimpleStatement Grammar
| print ExpressionList ${
- $0 = b = new(binode);
+ $0 = b = new_pos(binode, $1);
b->op = Print;
b->right = NULL;
b->left = reorder_bilist($<EL);
}$
| print ExpressionList , ${ {
- $0 = b = new(binode);
+ $0 = b = new_pos(binode, $1);
b->op = Print;
b->right = reorder_bilist($<EL);
b->left = NULL;
} }$
| print ${
- $0 = b = new(binode);
+ $0 = b = new_pos(binode, $1);
b->op = Print;
b->left = NULL;
b->right = NULL;
else
b = cast(binode, b->right);
while (b) {
- propagate_types(b->left, c, ok, 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,
- Declare,
+ Assign, AssignRef,
+ Declare, DeclareRef,
###### declare terminals
$TERM =
###### print binode cases
case Assign:
+ case AssignRef:
do_indent(indent, "");
- print_exec(b->left, indent, bracket);
+ print_exec(b->left, -1, bracket);
printf(" = ");
- print_exec(b->right, indent, bracket);
+ print_exec(b->right, -1, bracket);
if (indent >= 0)
printf("\n");
break;
case Declare:
+ case DeclareRef:
{
struct variable *v = cast(var, b->left)->var;
do_indent(indent, "");
- print_exec(b->left, indent, bracket);
+ print_exec(b->left, -1, bracket);
if (cast(var, b->left)->var->constant) {
printf("::");
if (v->explicit_type) {
}
if (b->right) {
printf("= ");
- print_exec(b->right, indent, bracket);
+ print_exec(b->right, -1, bracket);
}
if (indent >= 0)
printf("\n");
###### 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
*/
- t = propagate_types(b->left, c, ok, 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, ok, 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, ok, NULL, Rnolabel);
+ t = propagate_types(b->right, c, perr_local, NULL, 0);
if (t)
- propagate_types(b->left, c, ok, t,
- (b->op == Assign ? Rnoconstant : 0));
+ propagate_types(b->left, c, perr, t, 0);
}
- if (t && t->dup == NULL && t->name.txt[0] != ' ') // HACK
+ if (*perr & Erval)
+ type_err(c, "error: cannot assign to an rval", b,
+ NULL, 0, NULL);
+ 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) {
+ 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;
###### 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;
}
$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
case Use:
/* result matches value */
- return propagate_types(b->right, c, ok, type, 0);
+ return propagate_types(b->right, c, perr, type, 0);
###### interp binode cases
###### propagate binode cases
case Loop:
- t = propagate_types(b->right, c, ok, Tnone, 0);
- if (!type_compat(Tnone, t, 0))
- *ok = 0; // UNTESTED
- return propagate_types(b->left, c, ok, type, rules);
+ propagate_types(b->right, c, perr_local, Tnone, 0);
+ return propagate_types(b->left, c, perr, type, rules);
###### propagate exec cases
case Xcond_statement:
struct cond_statement *cs = cast(cond_statement, prog);
struct casepart *cp;
- t = propagate_types(cs->forpart, c, ok, Tnone, 0);
- if (!type_compat(Tnone, t, 0))
- *ok = 0; // UNTESTED
+ t = propagate_types(cs->forpart, c, perr, Tnone, 0);
if (cs->looppart) {
- t = propagate_types(cs->thenpart, c, ok, Tnone, 0);
- if (!type_compat(Tnone, t, 0))
- *ok = 0; // UNTESTED
+ t = propagate_types(cs->thenpart, c, perr, Tnone, 0);
}
if (cs->casepart == NULL) {
- propagate_types(cs->condpart, c, ok, Tbool, 0);
- propagate_types(cs->looppart, c, ok, Tbool, 0);
+ propagate_types(cs->condpart, c, perr, Tbool, 0);
+ propagate_types(cs->looppart, c, perr, Tbool, 0);
} else {
/* Condpart must match case values, with bool permitted */
t = NULL;
for (cp = cs->casepart;
cp && !t; cp = cp->next)
- t = propagate_types(cp->value, c, ok, NULL, 0);
+ t = propagate_types(cp->value, c, perr, NULL, 0);
if (!t && cs->condpart)
- t = propagate_types(cs->condpart, c, ok, NULL, Rboolok); // UNTESTED
+ t = propagate_types(cs->condpart, c, perr, NULL, Rboolok); // NOTEST
if (!t && cs->looppart)
- t = propagate_types(cs->looppart, c, ok, 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)
- propagate_types(cp->value, c, ok, t, 0);
- propagate_types(cs->condpart, c, ok, t, Rboolok);
- propagate_types(cs->looppart, c, ok, t, Rboolok);
+ propagate_types(cp->value, c, perr, t, 0);
+ propagate_types(cs->condpart, c, perr, t, Rboolok);
+ propagate_types(cs->looppart, c, perr, t, Rboolok);
}
}
// (if)then, else, and case parts must return expected type.
if (!cs->looppart && !type)
- type = propagate_types(cs->thenpart, c, ok, NULL, rules);
+ type = propagate_types(cs->thenpart, c, perr, NULL, rules);
if (!type)
- type = propagate_types(cs->elsepart, c, ok, NULL, rules);
+ 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, ok, 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, ok, type, rules);
- propagate_types(cs->elsepart, c, ok, type, rules);
+ propagate_types(cs->thenpart, c, perr, type, rules);
+ propagate_types(cs->elsepart, c, perr, type, rules);
for (cp = cs->casepart; cp ; cp = cp->next)
- propagate_types(cp->action, c, ok, type, rules);
+ propagate_types(cp->action, c, perr, type, rules);
return type;
} else
return NULL;
| DeclarationList Declaration
Declaration -> ERROR Newlines ${
- tok_err(c, // UNTESTED
+ tok_err(c, // NOTEST
"error: unhandled parse error", &$1);
}$
| DeclareConstant
v->global = 1;
} else {
v = var_ref(c, $1.txt);
- tok_err(c, "error: name already declared", &$1);
- type_err(c, "info: this is where '%v' was first declared",
- v->where_decl, NULL, 0, NULL);
+ if (v->type == Tnone) {
+ v->where_decl = var;
+ v->where_set = var;
+ v->type = $<CT;
+ v->constant = 1;
+ v->global = 1;
+ } else {
+ tok_err(c, "error: name already declared", &$1);
+ type_err(c, "info: this is where '%v' was first declared",
+ v->where_decl, NULL, 0, NULL);
+ }
}
var->var = v;
static void resolve_consts(struct parse_context *c)
{
struct binode *b;
+ int retry = 1;
+ enum { none, some, cannot } progress = none;
+
c->constlist = reorder_bilist(c->constlist);
- for (b = cast(binode, c->constlist); b;
- b = cast(binode, b->right)) {
- int ok;
- struct binode *vb = cast(binode, b->left);
- struct var *v = cast(var, vb->left);
- do {
- ok = 1;
- propagate_types(vb->right, c, &ok,
- v->var->type, 0);
- } while (ok == 2);
- if (!ok)
- c->parse_error = 1;
- else {
- struct value res = interp_exec(
- c, vb->right, &v->var->type);
- global_alloc(c, v->var->type, v->var, &res);
+ while (retry) {
+ retry = 0;
+ for (b = cast(binode, c->constlist); b;
+ b = cast(binode, b->right)) {
+ enum prop_err perr;
+ struct binode *vb = cast(binode, b->left);
+ struct var *v = cast(var, vb->left);
+ if (v->var->frame_pos >= 0)
+ continue;
+ do {
+ perr = 0;
+ propagate_types(vb->right, c, &perr,
+ v->var->type, 0);
+ } while (perr & Eretry);
+ if (perr & Efail)
+ c->parse_error += 1;
+ else if (!(perr & Eruntime)) {
+ progress = some;
+ struct value res = interp_exec(
+ c, vb->right, &v->var->type);
+ global_alloc(c, v->var->type, v->var, &res);
+ } else {
+ if (progress == cannot)
+ type_err(c, "error: const %v cannot be resolved.",
+ v, NULL, 0, NULL);
+ else
+ retry = 1;
+ }
+ }
+ switch (progress) {
+ case cannot:
+ retry = 0; break;
+ case none:
+ progress = cannot; break;
+ case some:
+ progress = none; break;
}
}
}
* is a list for 'struct var'
*/
struct type *t = add_anon_type(c, &structure_prototype,
- " function result");
+ "function result");
int cnt = 0;
struct binode *b;
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);
for (v = c->in_scope; v; v = v->in_scope) {
struct value *val;
struct type *ret;
- int ok = 1;
+ enum prop_err perr;
if (v->depth != 0 || !v->type || !v->type->check_args)
continue;
ret = v->type->function.inline_result ?
Tnone : v->type->function.return_type;
val = var_value(c, v);
do {
- ok = 1;
- propagate_types(val->function, c, &ok, ret, 0);
- } while (ok == 2);
- if (ok)
+ perr = 0;
+ propagate_types(val->function, c, &perr, ret, 0);
+ } while (!(perr & Efail) && (perr & Eretry));
+ if (!(perr & Efail))
/* Make sure everything is still consistent */
- propagate_types(val->function, c, &ok, ret, 0);
- if (!ok)
+ propagate_types(val->function, c, &perr, ret, 0);
+ if (perr & Efail)
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);
}
{
struct binode *bp = type->function.params;
struct binode *b;
- int ok = 1;
+ enum prop_err perr;
int arg = 0;
struct type *argv_type;
argv_type->array.unspec = 1;
for (b = bp; b; b = cast(binode, b->right)) {
- ok = 1;
+ perr = 0;
switch (arg++) {
case 0: /* argv */
- propagate_types(b->left, c, &ok, argv_type, 0);
+ propagate_types(b->left, c, &perr, argv_type, 0);
break;
default: /* invalid */ // NOTEST
- propagate_types(b->left, c, &ok, Tnone, 0); // NOTEST
+ propagate_types(b->left, c, &perr, Tnone, 0); // NOTEST
}
- if (!ok)
- c->parse_error = 1;
+ if (perr & Efail)
+ c->parse_error += 1;
}
return !c->parse_error;
progp = var_value(c, mainv);
if (!progp || !progp->function) {
fprintf(stderr, "oceani: no main function found.\n");
- c->parse_error = 1;
+ c->parse_error += 1;
return;
}
if (!analyse_main(mainv->type, c)) {
fprintf(stderr, "oceani: main has wrong type.\n");
- c->parse_error = 1;
+ c->parse_error += 1;
return;
}
al = mainv->type->function.params;
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
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