parse_oceani(ss->code, &context.config, dotrace ? stderr : NULL);
+ resolve_consts(&context);
+ 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) {
while (context.scope_depth > 0)
scope_pop(&context);
## free global vars
+ ## free const decls
## free context types
## free context storage
exit(context.parse_error ? 1 : 0);
static void type_err(struct parse_context *c,
char *fmt, struct exec *loc,
struct type *t1, int rules, struct type *t2);
+ static void tok_err(struct parse_context *c, char *fmt, struct token *t);
###### core functions
}
}
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.
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 immediately, `Enoconst` is set.
+If the expression can be copied, `Emaycopy` is set.
+
+If it remains unchanged at `0`, then no more propagation is needed.
###### 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':
break;
###### forward decls
- static struct type *propagate_types(struct exec *prog, struct parse_context *c, int *ok,
+ static struct type *propagate_types(struct exec *prog, struct parse_context *c, enum prop_err *perr,
struct type *type, int rules);
###### core functions
- static struct type *__propagate_types(struct exec *prog, struct parse_context *c, int *ok,
+ static struct type *__propagate_types(struct exec *prog, struct parse_context *c, enum prop_err *perr,
struct type *type, int rules)
{
struct type *t;
return Tnone;
}
- static struct type *propagate_types(struct exec *prog, struct parse_context *c, int *ok,
+ static struct type *propagate_types(struct exec *prog, struct parse_context *c, enum prop_err *perr,
struct type *type, int rules)
{
- struct type *ret = __propagate_types(prog, c, ok, type, rules);
+ int pre_err = c->parse_error;
+ struct type *ret = __propagate_types(prog, c, perr, type, rules);
- if (c->parse_error)
- *ok = 0;
+ if (c->parse_error > pre_err)
+ *perr |= Efail;
return ret;
}
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,
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;
fprintf(f, "*Unknown*"); // NOTEST
}
+ static void prepare_types(struct parse_context *c)
+ {
+ struct type *t;
+ 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);
$*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
mpf_t fl;
mpf_init2(fl, 20);
mpf_set_q(fl, v->num);
- gmp_fprintf(f, "%Fg", fl);
+ gmp_fprintf(f, "%.10Fg", fl);
mpf_clear(fl);
break;
}
struct val *v = cast(val, e);
if (v->vtype == Tstr)
printf("\"");
+ // FIXME how to ensure numbers have same precision.
print_value(v->vtype, &v->val, stdout);
if (v->vtype == Tstr)
printf("\"");
while (v) {
struct variable *next = v->previous;
- if (v->global) {
+ if (v->global && v->frame_pos >= 0) {
free_value(v->type, var_value(&context, v));
- if (v->depth == 0)
- // This is a global constant
+ if (v->depth == 0 && v->type->free == function_free)
+ // This is a function constant
free_exec(v->where_decl);
}
free(v);
{
if (!v->global) {
if (!c->local || !v->type)
- return NULL; // NOTEST
+ return NULL; // UNTESTED
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);
+ c->global_size = (c->global_size + t->align) & ~(t->align-1); // NOTEST
if (!v) {
v = &scratch;
v->type = t;
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;
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)) {
+ } else if (!type_compat(type, v->type, rules)) {
type_err(c, "error: expected %1%r but variable '%v' is %2", prog,
type, rules, v->type);
type_err(c, "info: this is where '%v' was set to %1", v->where_set,
v->type, rules, NULL);
}
+ if (!v->global || v->frame_pos < 0)
+ *perr |= Enoconst;
if (!type)
return v->type;
return type;
###### 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; // NOTEST
+ return 1; // UNTESTED
if (type->array.unspec && parse_time)
- return; // NOTEST
+ return 1; // UNTESTED
+ if (parse_time && type->array.vsize && !type->array.vsize->global)
+ return 1; // UNTESTED
if (type->array.vsize) {
vsize = var_value(c, type->array.vsize);
if (!vsize)
- return; // NOTEST
+ return 1; // UNTESTED
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;
- 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)
/* 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, Tnum, 0);
+ t = propagate_types(b->left, c, perr, NULL, rules & Rnoconstant);
if (!t || t->compat != array_compat) {
type_err(c, "error: %1 cannot be indexed", prog, t, 0, NULL);
return NULL;
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 struct type structure_prototype = {
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
###### top level grammar
DeclareStruct -> struct IDENTIFIER FieldBlock Newlines ${ {
- struct type *t =
- add_type(c, $2.txt, &structure_prototype);
+ struct type *t;
+ t = find_type(c, $ID.txt);
+ if (!t)
+ t = add_type(c, $ID.txt, &structure_prototype);
+ else if (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->structure.field_list = $<FB;
- if (t->prepare_type)
- t->prepare_type(c, t, 1);
-
+ t->first_use = $ID;
} }$
$*fieldlist
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
return 0;
}
- static void function_check_args(struct parse_context *c, int *ok,
+ 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
args, NULL, 0, NULL);
break;
}
- *ok = 1;
- propagate_types(arg->left, c, ok, pv->var->type, 0);
+ *perr = 0;
+ propagate_types(arg->left, c, perr, pv->var->type, 0);
param = cast(binode, param->right);
arg = cast(binode, arg->right);
}
prog, NULL, 0, NULL);
return NULL;
}
- v->var->type->check_args(c, ok, v->var->type, args);
+ *perr |= Enoconst;
+ v->var->type->check_args(c, perr, v->var->type, args);
+ if (v->var->type->function.inline_result)
+ *perr |= Emaycopy;
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, Tbool, 0);
+ t = propagate_types(b2->left, c, perr, type, Rnolabel);
+ t2 = propagate_types(b2->right, c, perr, type ?: t, Rnolabel);
return t ?: t2;
}
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);
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, Rnolabel);
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
+ t = propagate_types(b->right, c, perr, NULL, Rnolabel); // UNTESTED
if (t) // UNTESTED
- t = propagate_types(b->left, c, ok, t, 0); // 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,
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);
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);
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
"error: Can only convert string to number, not %1",
return Tnum;
case Bracket:
- return propagate_types(b->right, c, ok, type, 0);
+ return propagate_types(b->right, c, perr, type, 0);
###### interp 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)
else
b = cast(binode, b->right);
while (b) {
- propagate_types(b->left, c, ok, NULL, Rnolabel);
+ propagate_types(b->left, c, perr, NULL, Rnolabel);
b = cast(binode, b->right);
}
break;
* For Assign, left must not be constant.
* result is Tnone
*/
- t = propagate_types(b->left, c, ok, NULL,
+ t = propagate_types(b->left, c, perr, NULL,
Rnolabel | (b->op == Assign ? Rnoconstant : 0));
if (!b->right)
return Tnone;
if (t) {
- if (propagate_types(b->right, c, ok, t, 0) != t)
+ if (propagate_types(b->right, c, perr, t, 0) != t)
if (b->left->type == Xvar)
type_err(c, "info: variable '%v' was set as %1 here.",
cast(var, b->left)->var->where_set, t, rules, NULL);
} else {
- t = propagate_types(b->right, c, ok, NULL, Rnolabel);
+ t = propagate_types(b->right, c, perr, NULL, Rnolabel);
if (t)
- propagate_types(b->left, c, ok, t,
+ propagate_types(b->left, c, perr, t,
(b->op == Assign ? Rnoconstant : 0));
}
- if (t && t->dup == NULL && t->name.txt[0] != ' ') // HACK
+ if (t && t->dup == NULL && !(*perr & Emaycopy))
type_err(c, "error: cannot assign value of type %1", b, t, 0, NULL);
return Tnone;
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);
+ t = propagate_types(b->right, c, perr, Tnone, 0);
if (!type_compat(Tnone, t, 0))
- *ok = 0; // UNTESTED
- return propagate_types(b->left, c, ok, type, rules);
+ *perr |= Efail; // UNTESTED
+ 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);
+ t = propagate_types(cs->forpart, c, perr, Tnone, 0);
if (!type_compat(Tnone, t, 0))
- *ok = 0; // UNTESTED
+ *perr |= Efail; // UNTESTED
if (cs->looppart) {
- t = propagate_types(cs->thenpart, c, ok, Tnone, 0);
+ t = propagate_types(cs->thenpart, c, perr, Tnone, 0);
if (!type_compat(Tnone, t, 0))
- *ok = 0; // UNTESTED
+ *perr |= Efail; // UNTESTED
}
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); // UNTESTED
if (!t && cs->looppart)
- t = propagate_types(cs->looppart, c, ok, NULL, Rboolok); // UNTESTED
+ t = propagate_types(cs->looppart, c, perr, NULL, Rboolok); // UNTESTED
// 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
+ type = propagate_types(cp->action, c, perr, NULL, rules); // UNTESTED
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;
### The `const` section
-As well as being defined in with the code that uses them, constants
-can be declared at the top level. These have full-file scope, so they
-are always `InScope`. The value of a top level constant can be given
-as an expression, and this is evaluated immediately rather than in the
-later interpretation stage. Once we add functions to the language, we
-will need rules concern which, if any, can be used to define a top
-level constant.
+As well as being defined in with the code that uses them, constants can
+be declared at the top level. These have full-file scope, so they are
+always `InScope`, even before(!) they have been declared. The value of
+a top level constant can be given as an expression, and this is
+evaluated after parsing and before execution.
+
+A function call can be used to evaluate a constant, but it will not have
+access to any program state, once such statement becomes meaningful.
+e.g. arguments and filesystem will not be visible.
Constants are defined in a section that starts with the reserved word
`const` and then has a block with a list of assignment statements.
not, the type will be determined during analysis, as with other
constants.
-As the types constants are inserted at the head of a list, printing
-them in the same order that they were read is not straight forward.
-We take a quadratic approach here and count the number of constants
-(variables of depth 0), then count down from there, each time
-searching through for the Nth constant for decreasing N.
+###### parse context
+ struct binode *constlist;
###### top level grammar
$void
Const -> IDENTIFIER :: CType = Expression ${ {
- int ok;
struct variable *v;
+ struct binode *bl, *bv;
+ struct var *var = new_pos(var, $ID);
- v = var_decl(c, $1.txt);
+ v = var_decl(c, $ID.txt);
if (v) {
- struct var *var = new_pos(var, $1);
v->where_decl = var;
v->where_set = var;
- var->var = v;
+ v->type = $<CT;
v->constant = 1;
v->global = 1;
} else {
- struct variable *vorig = var_ref(c, $1.txt);
- tok_err(c, "error: name already declared", &$1);
- type_err(c, "info: this is where '%v' was first declared",
- vorig->where_decl, NULL, 0, NULL);
- }
- do {
- ok = 1;
- propagate_types($5, c, &ok, $3, 0);
- } while (ok == 2);
- if (!ok)
- c->parse_error = 1;
- else if (v) {
- struct value res = interp_exec(c, $5, &v->type);
- global_alloc(c, v->type, v, &res);
+ v = var_ref(c, $1.txt);
+ 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;
+
+ bv = new(binode);
+ bv->op = Declare;
+ bv->left = var;
+ bv->right= $<Exp;
+
+ bl = new(binode);
+ bl->op = List;
+ bl->left = c->constlist;
+ bl->right = bv;
+ c->constlist = bl;
} }$
-###### print const decls
+###### core functions
+ static void resolve_consts(struct parse_context *c)
{
- struct variable *v;
- int target = -1;
-
- while (target != 0) {
- int i = 0;
- for (v = context.in_scope; v; v=v->in_scope)
- if (v->depth == 0 && v->constant) {
- i += 1;
- if (i == target)
- break;
+ struct binode *b;
+ int retry = 1;
+ enum { none, some, cannot } progress = none;
+
+ c->constlist = reorder_bilist(c->constlist);
+ 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 & Enoconst)) {
+ 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;
}
-
- if (target == -1) {
- if (i)
- printf("const\n");
- target = i;
- } else {
- struct value *val = var_value(&context, v);
- printf(" %.*s :: ", v->name->name.len, v->name->name.txt);
- type_print(v->type, stdout);
- printf(" = ");
- if (v->type == Tstr)
- printf("\"");
- print_value(v->type, val, stdout);
- if (v->type == Tstr)
- printf("\"");
- printf("\n");
- target -= 1;
+ }
+ switch (progress) {
+ case cannot:
+ retry = 0; break;
+ case none:
+ progress = cannot; break;
+ case some:
+ progress = none; break;
}
}
}
+###### print const decls
+ {
+ struct binode *b;
+ int first = 1;
+
+ for (b = cast(binode, context.constlist); b;
+ b = cast(binode, b->right)) {
+ struct binode *vb = cast(binode, b->left);
+ struct var *vr = cast(var, vb->left);
+ struct variable *v = vr->var;
+
+ if (first)
+ printf("const\n");
+ first = 0;
+
+ printf(" %.*s :: ", v->name->name.len, v->name->name.txt);
+ type_print(v->type, stdout);
+ printf(" = ");
+ print_exec(vb->right, -1, 0);
+ printf("\n");
+ }
+ }
+
+###### free const decls
+ free_binode(context.constlist);
+
### Function declarations
The code in an Ocean program is all stored in function declarations.
* 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;
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) {
{
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;
code / ocean / blobdiff