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;
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);
set `lval` to NULL indicating that there is a value of appropriate type
in `rval`.
+###### forward decls
+ static struct value interp_exec(struct parse_context *c, struct exec *e,
+ struct type **typeret);
###### core functions
struct lrval {
fprintf(f, "*Unknown*"); // 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);
+ }
+
###### forward decls
static void free_value(struct type *type, struct value *v);
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;
}
$*val
Value -> True ${
- $0 = new_val(Tbool, $1);
- $0->val.bool = 1;
- }$
- | False ${
- $0 = new_val(Tbool, $1);
- $0->val.bool = 0;
- }$
- | NUMBER ${
- $0 = new_val(Tnum, $1);
- {
- char tail[3];
- 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);
- }
- }$
- | STRING ${
- $0 = new_val(Tstr, $1);
- {
- char tail[3];
- string_parse(&$1, '\\', &$0->val.str, tail);
- if (tail[0])
- tok_err(c, "error: unsupported string suffix",
- &$1);
- }
- }$
- | MULTI_STRING ${
- $0 = new_val(Tstr, $1);
- {
- char tail[3];
- string_parse(&$1, '\\', &$0->val.str, tail);
+ $0 = new_val(Tbool, $1);
+ $0->val.bool = 1;
+ }$
+ | False ${
+ $0 = new_val(Tbool, $1);
+ $0->val.bool = 0;
+ }$
+ | NUMBER ${ {
+ 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 string suffix",
+ tok_err(c, "error: unsupported number suffix",
&$1);
- }
- }$
+ } }$
+ | STRING ${ {
+ char tail[3];
+ $0 = new_val(Tstr, $1);
+ string_parse(&$1, '\\', &$0->val.str, tail);
+ if (tail[0])
+ tok_err(c, "error: unsupported string suffix",
+ &$1);
+ } }$
+ | MULTI_STRING ${ {
+ char tail[3];
+ $0 = new_val(Tstr, $1);
+ string_parse(&$1, '\\', &$0->val.str, tail);
+ if (tail[0])
+ tok_err(c, "error: unsupported string suffix",
+ &$1);
+ } }$
###### print exec cases
case Xval:
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);
short local_size;
void *global, *local;
+###### forward decls
+ static struct value *global_alloc(struct parse_context *c, struct type *t,
+ struct variable *v, struct value *init);
+
###### ast functions
static struct value *var_value(struct parse_context *c, struct variable *v)
{
if (!v->global) {
if (!c->local || !v->type)
- return NULL; // NOTEST
+ return NULL;
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;
v->where_decl, NULL, 0, NULL);
}
} }$
- | IDENTIFIER :: ${ {
+ | IDENTIFIER :: ${ {
struct variable *v = var_decl(c, $1.txt);
$0 = new_pos(var, $1);
$0->var = v;
v->where_decl, NULL, 0, NULL);
}
} }$
- | IDENTIFIER : Type ${ {
+ | IDENTIFIER : Type ${ {
struct variable *v = var_decl(c, $1.txt);
$0 = new_pos(var, $1);
$0->var = v;
v->where_decl, NULL, 0, NULL);
}
} }$
- | IDENTIFIER :: Type ${ {
+ | IDENTIFIER :: Type ${ {
struct variable *v = var_decl(c, $1.txt);
$0 = new_pos(var, $1);
$0->var = v;
}
}
cast(var, $0)->var = v;
- } }$
+ } }$
###### print exec cases
case Xvar:
###### Grammar
$*exec
Term -> Value ${ $0 = $<1; }$
- | Variable ${ $0 = $<1; }$
- ## term grammar
+ | Variable ${ $0 = $<1; }$
+ ## term grammar
Thus far the complex types we have are arrays and structs.
{
struct value *vsize;
mpz_t q;
- if (!type->array.vsize || type->array.static_size)
+ if (type->array.static_size)
+ return;
+ if (type->array.unspec && parse_time)
return;
- vsize = var_value(c, type->array.vsize);
- 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 (type->array.vsize) {
+ vsize = var_value(c, type->array.vsize);
+ if (!vsize)
+ return;
+ 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) {
+ 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;
t->array.size = elements;
t->array.member = $<4;
t->array.vsize = NULL;
- t->array.static_size = 1;
- t->size = t->array.size * t->array.member->size;
- t->align = t->array.member->align;
} }$
| [ IDENTIFIER ] Type ${ {
struct type *type;
struct value *init;
int offset;
- } *fields;
+ } *fields; // This is created when field_list is analysed.
+ struct fieldlist {
+ struct fieldlist *prev;
+ struct field f;
+ struct exec *init;
+ } *field_list; // This is created during parsing
} structure;
###### type functions
}
}
+ static void free_fieldlist(struct fieldlist *f)
+ {
+ if (!f)
+ return;
+ free_fieldlist(f->prev);
+ free_exec(f->init);
+ free(f);
+ }
+
static void structure_free_type(struct type *t)
{
int i;
t->structure.fields[i].init);
}
free(t->structure.fields);
+ free_fieldlist(t->structure.field_list);
+ }
+
+ static void 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;
+
+ for (f = t->structure.field_list; f; f=f->prev) {
+ int ok;
+ cnt += 1;
+
+ if (f->f.type->prepare_type)
+ f->f.type->prepare_type(c, f->f.type, 1);
+ 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
+ }
+
+ t->structure.nfields = cnt;
+ t->structure.fields = calloc(cnt, sizeof(struct field));
+ f = t->structure.field_list;
+ while (cnt > 0) {
+ int a = f->f.type->align;
+ cnt -= 1;
+ t->structure.fields[cnt] = f->f;
+ if (t->size & (a-1))
+ t->size = (t->size | (a-1)) + 1;
+ t->structure.fields[cnt].offset = t->size;
+ t->size += ((f->f.type->size - 1) | (a-1)) + 1;
+ if (a > t->align)
+ t->align = a;
+
+ if (f->init && !c->parse_error) {
+ struct value vl = interp_exec(c, f->init, NULL);
+ t->structure.fields[cnt].init =
+ global_alloc(c, f->f.type, NULL, &vl);
+ }
+
+ f = f->prev;
+ }
}
static struct type structure_prototype = {
.free = structure_free,
.free_type = structure_free_type,
.print_type_decl = structure_print_type,
+ .prepare_type = structure_prepare_type,
};
###### exec type
break;
}
-###### ast
- struct fieldlist {
- struct fieldlist *prev;
- struct field f;
- };
-
-###### ast functions
- static void free_fieldlist(struct fieldlist *f)
- {
- if (!f)
- return;
- free_fieldlist(f->prev);
- if (f->f.init) {
- free_value(f->f.type, f->f.init); // UNTESTED
- free(f->f.init); // UNTESTED
- }
- free(f);
- }
-
###### top level grammar
DeclareStruct -> struct IDENTIFIER FieldBlock Newlines ${ {
- struct type *t =
- add_type(c, $2.txt, &structure_prototype);
- int cnt = 0;
- struct fieldlist *f;
-
- for (f = $3; f; f=f->prev)
- cnt += 1;
-
- t->structure.nfields = cnt;
- t->structure.fields = calloc(cnt, sizeof(struct field));
- f = $3;
- while (cnt > 0) {
- int a = f->f.type->align;
- cnt -= 1;
- t->structure.fields[cnt] = f->f;
- if (t->size & (a-1))
- t->size = (t->size | (a-1)) + 1;
- t->structure.fields[cnt].offset = t->size;
- t->size += ((f->f.type->size - 1) | (a-1)) + 1;
- if (a > t->align)
- t->align = a;
- f->f.init = NULL;
- f = f->prev;
- }
- } }$
+ struct type *t =
+ add_type(c, $2.txt, &structure_prototype);
+ t->structure.field_list = $<FB;
+ } }$
$*fieldlist
FieldBlock -> { IN OptNL FieldLines OUT OptNL } ${ $0 = $<FL; }$
- | { SimpleFieldList } ${ $0 = $<SFL; }$
- | IN OptNL FieldLines OUT ${ $0 = $<FL; }$
- | SimpleFieldList EOL ${ $0 = $<SFL; }$
+ | { SimpleFieldList } ${ $0 = $<SFL; }$
+ | IN OptNL FieldLines OUT ${ $0 = $<FL; }$
+ | SimpleFieldList EOL ${ $0 = $<SFL; }$
FieldLines -> SimpleFieldList Newlines ${ $0 = $<SFL; }$
- | FieldLines SimpleFieldList Newlines ${
- $SFL->prev = $<FL;
- $0 = $<SFL;
- }$
+ | FieldLines SimpleFieldList Newlines ${
+ $SFL->prev = $<FL;
+ $0 = $<SFL;
+ }$
SimpleFieldList -> Field ${ $0 = $<F; }$
- | SimpleFieldList ; Field ${
- $F->prev = $<SFL;
- $0 = $<F;
- }$
- | SimpleFieldList ; ${
- $0 = $<SFL;
- }$
- | ERROR ${ tok_err(c, "Syntax error in struct field", &$1); }$
+ | SimpleFieldList ; Field ${
+ $F->prev = $<SFL;
+ $0 = $<F;
+ }$
+ | SimpleFieldList ; ${
+ $0 = $<SFL;
+ }$
+ | ERROR ${ tok_err(c, "Syntax error in struct field", &$1); }$
Field -> IDENTIFIER : Type = Expression ${ {
- int ok;
-
- $0 = calloc(1, sizeof(struct fieldlist));
- $0->f.name = $1.txt;
- $0->f.type = $<3;
- $0->f.init = NULL;
- do {
- ok = 1;
- propagate_types($<5, c, &ok, $3, 0);
- } while (ok == 2);
- if (!ok)
- c->parse_error = 1; // UNTESTED
- else {
- struct value vl = interp_exec(c, $5, NULL);
- $0->f.init = global_alloc(c, $0->f.type, NULL, &vl);
- }
- } }$
- | IDENTIFIER : Type ${
- $0 = calloc(1, sizeof(struct fieldlist));
- $0->f.name = $1.txt;
- $0->f.type = $<3;
- if ($0->f.type->prepare_type)
- $0->f.type->prepare_type(c, $0->f.type, 1);
- }$
+ $0 = calloc(1, sizeof(struct fieldlist));
+ $0->f.name = $ID.txt;
+ $0->f.type = $<Type;
+ $0->f.init = NULL;
+ $0->init = $<Expr;
+ } }$
+ | IDENTIFIER : Type ${
+ $0 = calloc(1, sizeof(struct fieldlist));
+ $0->f.name = $ID.txt;
+ $0->f.type = $<Type;
+ }$
###### forward decls
static void structure_print_type(struct type *t, FILE *f);
$*variable
FuncName -> IDENTIFIER ${ {
- struct variable *v = var_decl(c, $1.txt);
- struct var *e = new_pos(var, $1);
+ struct variable *v = var_decl(c, $1.txt);
+ struct var *e = new_pos(var, $1);
+ e->var = v;
+ if (v) {
+ v->where_decl = e;
+ $0 = v;
+ } else {
+ v = var_ref(c, $1.txt);
e->var = v;
- if (v) {
- v->where_decl = e;
- $0 = v;
- } else {
- v = var_ref(c, $1.txt);
- e->var = v;
- type_err(c, "error: function '%v' redeclared",
- e, NULL, 0, NULL);
- type_err(c, "info: this is where '%v' was first declared",
- v->where_decl, NULL, 0, NULL);
- free_exec(e);
- }
- } }$
+ type_err(c, "error: function '%v' redeclared",
+ e, NULL, 0, NULL);
+ type_err(c, "info: this is where '%v' was first declared",
+ v->where_decl, NULL, 0, NULL);
+ free_exec(e);
+ }
+ } }$
$*binode
Args -> ArgsLine NEWLINE ${ $0 = $<AL; }$
- | Args ArgsLine NEWLINE ${ {
-
struct binode *b = $<AL;
- struct binode **bp = &b;
- while (*bp)
- bp = (struct binode **)&(*bp)->left;
- $0 = b;
- } }$
+ | Args ArgsLine NEWLINE ${ {
+ struct binode *b = $<AL;
+ struct binode **bp = &b;
+ while (*bp)
+ bp = (struct binode **)&(*bp)->left;
+ *bp = $<A;
+ $0 = b;
+ } }$
ArgsLine -> ${ $0 = NULL; }$
- | Varlist ${ $0 = $<1; }$
- | Varlist ; ${ $0 = $<1; }$
+ | Varlist ${ $0 = $<1; }$
+ | Varlist ; ${ $0 = $<1; }$
Varlist -> Varlist ; ArgDecl ${
- $0 = new(binode);
- $0->op = List;
- $0->left = $<Vl;
- }$
- | ArgDecl ${
- $0 = new(binode);
- $0->op = List;
- $0->left = NULL;
- }$
+ $0 = new(binode);
+ $0->op = List;
+ $0->left = $<Vl;
+ $0->right = $<AD;
+ }$
+ | ArgDecl ${
+ $0 = new(binode);
+ $0->op = List;
+ $0->left = NULL;
+ $0->right = $<AD;
+ }$
$*var
ArgDecl -> IDENTIFIER : FormalType ${ {
$*exec
Expression -> Term ${ $0 = $<Term; }$
- ## expression grammar
+ ## expression grammar
### Expressions: Conditional
$*binode
ExpressionList -> ExpressionList , Expression ${
- $0 = new(binode);
- $0->op = List;
- $0->left = $<1;
- $0->right = $<3;
- }$
- | Expression ${
- $0 = new(binode);
- $0->op = List;
- $0->left = NULL;
- $0->right = $<1;
- }$
+ $0 = new(binode);
+ $0->op = List;
+ $0->left = $<1;
+ $0->right = $<3;
+ }$
+ | Expression ${
+ $0 = new(binode);
+ $0->op = List;
+ $0->left = NULL;
+ $0->right = $<1;
+ }$
### Expressions: Boolean
$LEFT not
###### expression grammar
- | Expression or Expression ${ {
- struct binode *b = new(binode);
- b->op = Or;
- b->left = $<1;
- b->right = $<3;
- $0 = b;
- } }$
- | Expression or else Expression ${ {
- struct binode *b = new(binode);
- b->op = OrElse;
- b->left = $<1;
- b->right = $<4;
- $0 = b;
- } }$
+ | Expression or Expression ${ {
+ struct binode *b = new(binode);
+ b->op = Or;
+ b->left = $<1;
+ b->right = $<3;
+ $0 = b;
+ } }$
+ | Expression or else Expression ${ {
+ struct binode *b = new(binode);
+ b->op = OrElse;
+ b->left = $<1;
+ b->right = $<4;
+ $0 = b;
+ } }$
- | Expression and Expression ${ {
- struct binode *b = new(binode);
- b->op = And;
- b->left = $<1;
- b->right = $<3;
- $0 = b;
- } }$
- | Expression and then Expression ${ {
- struct binode *b = new(binode);
- b->op = AndThen;
- b->left = $<1;
- b->right = $<4;
- $0 = b;
- } }$
+ | Expression and Expression ${ {
+ struct binode *b = new(binode);
+ b->op = And;
+ b->left = $<1;
+ b->right = $<3;
+ $0 = b;
+ } }$
+ | Expression and then Expression ${ {
+ struct binode *b = new(binode);
+ b->op = AndThen;
+ b->left = $<1;
+ b->right = $<4;
+ $0 = b;
+ } }$
- | not Expression ${ {
- struct binode *b = new(binode);
- b->op = Not;
- b->right = $<2;
- $0 = b;
- } }$
+ | not Expression ${ {
+ struct binode *b = new(binode);
+ b->op = Not;
+ b->right = $<2;
+ $0 = b;
+ } }$
###### print binode cases
case And:
###### Grammar
$eop
- CMPop -> < ${ $0.op = Less; }$
- | > ${ $0.op = Gtr; }$
- | <= ${ $0.op = LessEq; }$
- | >= ${ $0.op = GtrEq; }$
- | == ${ $0.op = Eql; }$
- | != ${ $0.op = NEql; }$
+ CMPop -> < ${ $0.op = Less; }$
+ | > ${ $0.op = Gtr; }$
+ | <= ${ $0.op = LessEq; }$
+ | >= ${ $0.op = GtrEq; }$
+ | == ${ $0.op = Eql; }$
+ | != ${ $0.op = NEql; }$
###### print binode cases
###### Grammar
$eop
- Eop -> + ${ $0.op = Plus; }$
- | - ${ $0.op = Minus; }$
+ Eop -> + ${ $0.op = Plus; }$
+ | - ${ $0.op = Minus; }$
- Uop -> + ${ $0.op = Absolute; }$
- | - ${ $0.op = Negate; }$
- | $ ${ $0.op = StringConv; }$
+ Uop -> + ${ $0.op = Absolute; }$
+ | - ${ $0.op = Negate; }$
+ | $ ${ $0.op = StringConv; }$
- Top -> * ${ $0.op = Times; }$
- | / ${ $0.op = Divide; }$
- | % ${ $0.op = Rem; }$
- | ++ ${ $0.op = Concat; }$
+ Top -> * ${ $0.op = Times; }$
+ | / ${ $0.op = Divide; }$
+ | % ${ $0.op = Rem; }$
+ | ++ ${ $0.op = Concat; }$
###### print binode cases
case Plus:
$*binode
Block -> { IN OptNL Statementlist OUT OptNL } ${ $0 = $<Sl; }$
- | { SimpleStatements } ${ $0 = reorder_bilist($<SS); }$
- | SimpleStatements ; ${ $0 = reorder_bilist($<SS); }$
- | SimpleStatements EOL ${ $0 = reorder_bilist($<SS); }$
- | IN OptNL Statementlist OUT ${ $0 = $<Sl; }$
+ | { SimpleStatements } ${ $0 = reorder_bilist($<SS); }$
+ | SimpleStatements ; ${ $0 = reorder_bilist($<SS); }$
+ | SimpleStatements EOL ${ $0 = reorder_bilist($<SS); }$
+ | IN OptNL Statementlist OUT ${ $0 = $<Sl; }$
OpenBlock -> OpenScope { IN OptNL Statementlist OUT OptNL } ${ $0 = $<Sl; }$
- | OpenScope { SimpleStatements } ${ $0 = reorder_bilist($<SS); }$
- | OpenScope SimpleStatements ; ${ $0 = reorder_bilist($<SS); }$
- | OpenScope SimpleStatements EOL ${ $0 = reorder_bilist($<SS); }$
- | IN OpenScope OptNL Statementlist OUT ${ $0 = $<Sl; }$
+ | OpenScope { SimpleStatements } ${ $0 = reorder_bilist($<SS); }$
+ | OpenScope SimpleStatements ; ${ $0 = reorder_bilist($<SS); }$
+ | OpenScope SimpleStatements EOL ${ $0 = reorder_bilist($<SS); }$
+ | IN OpenScope OptNL Statementlist OUT ${ $0 = $<Sl; }$
UseBlock -> { OpenScope IN OptNL Statementlist OUT OptNL } ${ $0 = $<Sl; }$
- | { OpenScope SimpleStatements } ${ $0 = reorder_bilist($<SS); }$
- | IN OpenScope OptNL Statementlist OUT ${ $0 = $<Sl; }$
+ | { OpenScope SimpleStatements } ${ $0 = reorder_bilist($<SS); }$
+ | IN OpenScope OptNL Statementlist OUT ${ $0 = $<Sl; }$
ColonBlock -> { IN OptNL Statementlist OUT OptNL } ${ $0 = $<Sl; }$
- | { SimpleStatements } ${ $0 = reorder_bilist($<SS); }$
- | : SimpleStatements ; ${ $0 = reorder_bilist($<SS); }$
- | : SimpleStatements EOL ${ $0 = reorder_bilist($<SS); }$
- | : IN OptNL Statementlist OUT ${ $0 = $<Sl; }$
+ | { SimpleStatements } ${ $0 = reorder_bilist($<SS); }$
+ | : SimpleStatements ; ${ $0 = reorder_bilist($<SS); }$
+ | : SimpleStatements EOL ${ $0 = reorder_bilist($<SS); }$
+ | : IN OptNL Statementlist OUT ${ $0 = $<Sl; }$
Statementlist -> ComplexStatements ${ $0 = reorder_bilist($<CS); }$
ComplexStatements -> ComplexStatements ComplexStatement ${
- if ($2 == NULL) {
- $0 = $<1;
- } else {
- $0 = new(binode);
- $0->op = Block;
- $0->left = $<1;
- $0->right = $<2;
- }
- }$
- | ComplexStatement ${
- if ($1 == NULL) {
- $0 = NULL;
- } else {
- $0 = new(binode);
- $0->op = Block;
- $0->left = NULL;
- $0->right = $<1;
- }
- }$
-
- $*exec
- ComplexStatement -> SimpleStatements Newlines ${
- $0 = reorder_bilist($<SS);
- }$
- | SimpleStatements ; Newlines ${
- $0 = reorder_bilist($<SS);
- }$
- ## ComplexStatement Grammar
-
- $*binode
- SimpleStatements -> SimpleStatements ; SimpleStatement ${
+ if ($2 == NULL) {
+ $0 = $<1;
+ } else {
$0 = new(binode);
$0->op = Block;
$0->left = $<1;
- $0->right = $<3;
- }$
- | SimpleStatement ${
+ $0->right = $<2;
+ }
+ }$
+ | ComplexStatement ${
+ if ($1 == NULL) {
+ $0 = NULL;
+ } else {
$0 = new(binode);
$0->op = Block;
$0->left = NULL;
$0->right = $<1;
- }$
+ }
+ }$
+
+ $*exec
+ ComplexStatement -> SimpleStatements Newlines ${
+ $0 = reorder_bilist($<SS);
+ }$
+ | SimpleStatements ; Newlines ${
+ $0 = reorder_bilist($<SS);
+ }$
+ ## ComplexStatement Grammar
+
+ $*binode
+ SimpleStatements -> SimpleStatements ; SimpleStatement ${
+ $0 = new(binode);
+ $0->op = Block;
+ $0->left = $<1;
+ $0->right = $<3;
+ }$
+ | SimpleStatement ${
+ $0 = new(binode);
+ $0->op = Block;
+ $0->left = NULL;
+ $0->right = $<1;
+ }$
$TERM pass
$*exec
SimpleStatement -> pass ${ $0 = NULL; }$
- | ERROR ${ tok_err(c, "Syntax error in statement", &$1); }$
- ## SimpleStatement Grammar
+ | ERROR ${ tok_err(c, "Syntax error in statement", &$1); }$
+ ## SimpleStatement Grammar
###### print binode cases
case Block:
###### SimpleStatement Grammar
| Term = Expression ${
- $0 = b= new(binode);
- b->op = Assign;
- b->left = $<1;
- b->right = $<3;
- }$
+ $0 = b= new(binode);
+ b->op = Assign;
+ b->left = $<1;
+ b->right = $<3;
+ }$
| VariableDecl = Expression ${
- $0 = b= new(binode);
- b->op = Declare;
- b->left = $<1;
- b->right =$<3;
- }$
+ $0 = b= new(binode);
+ b->op = Declare;
+ b->left = $<1;
+ b->right =$<3;
+ }$
| VariableDecl ${
- if ($1->var->where_set == NULL) {
- type_err(c,
- "Variable declared with no type or value: %v",
- $1, NULL, 0, NULL);
- free_var($1);
- } else {
- $0 = b = new(binode);
- b->op = Declare;
- b->left = $<1;
- b->right = NULL;
- }
- }$
+ if ($1->var->where_set == NULL) {
+ type_err(c,
+ "Variable declared with no type or value: %v",
+ $1, NULL, 0, NULL);
+ free_var($1);
+ } else {
+ $0 = b = new(binode);
+ b->op = Declare;
+ b->left = $<1;
+ b->right = NULL;
+ }
+ }$
###### print binode cases
// ForPart, SwitchPart, and IfPart open scopes, o we have to close
// them. WhilePart opens and closes its own scope.
CondStatement -> ForPart OptNL ThenPart OptNL WhilePart CondSuffix ${
- $0 = $<CS;
- $0->forpart = $<FP;
- $0->thenpart = $<TP;
- $0->looppart = $<WP;
- var_block_close(c, CloseSequential, $0);
- }$
- | ForPart OptNL WhilePart CondSuffix ${
- $0 = $<CS;
- $0->forpart = $<FP;
- $0->looppart = $<WP;
- var_block_close(c, CloseSequential, $0);
- }$
- | WhilePart CondSuffix ${
- $0 = $<CS;
- $0->looppart = $<WP;
- }$
- | SwitchPart OptNL CasePart CondSuffix ${
- $0 = $<CS;
- $0->condpart = $<SP;
- $CP->next = $0->casepart;
- $0->casepart = $<CP;
- var_block_close(c, CloseSequential, $0);
- }$
- | SwitchPart : IN OptNL CasePart CondSuffix OUT Newlines ${
- $0 = $<CS;
- $0->condpart = $<SP;
- $CP->next = $0->casepart;
- $0->casepart = $<CP;
- var_block_close(c, CloseSequential, $0);
- }$
- | IfPart IfSuffix ${
- $0 = $<IS;
- $0->condpart = $IP.condpart; $IP.condpart = NULL;
- $0->thenpart = $IP.thenpart; $IP.thenpart = NULL;
- // This is where we close an "if" statement
- var_block_close(c, CloseSequential, $0);
- }$
+ $0 = $<CS;
+ $0->forpart = $<FP;
+ $0->thenpart = $<TP;
+ $0->looppart = $<WP;
+ var_block_close(c, CloseSequential, $0);
+ }$
+ | ForPart OptNL WhilePart CondSuffix ${
+ $0 = $<CS;
+ $0->forpart = $<FP;
+ $0->looppart = $<WP;
+ var_block_close(c, CloseSequential, $0);
+ }$
+ | WhilePart CondSuffix ${
+ $0 = $<CS;
+ $0->looppart = $<WP;
+ }$
+ | SwitchPart OptNL CasePart CondSuffix ${
+ $0 = $<CS;
+ $0->condpart = $<SP;
+ $CP->next = $0->casepart;
+ $0->casepart = $<CP;
+ var_block_close(c, CloseSequential, $0);
+ }$
+ | SwitchPart : IN OptNL CasePart CondSuffix OUT Newlines ${
+ $0 = $<CS;
+ $0->condpart = $<SP;
+ $CP->next = $0->casepart;
+ $0->casepart = $<CP;
+ var_block_close(c, CloseSequential, $0);
+ }$
+ | IfPart IfSuffix ${
+ $0 = $<IS;
+ $0->condpart = $IP.condpart; $IP.condpart = NULL;
+ $0->thenpart = $IP.thenpart; $IP.thenpart = NULL;
+ // This is where we close an "if" statement
+ var_block_close(c, CloseSequential, $0);
+ }$
CondSuffix -> IfSuffix ${
- $0 = $<1;
- }$
- | Newlines CasePart CondSuffix ${
- $0 = $<CS;
- $CP->next = $0->casepart;
- $0->casepart = $<CP;
- }$
- | CasePart CondSuffix ${
- $0 = $<CS;
- $CP->next = $0->casepart;
- $0->casepart = $<CP;
- }$
+ $0 = $<1;
+ }$
+ | Newlines CasePart CondSuffix ${
+ $0 = $<CS;
+ $CP->next = $0->casepart;
+ $0->casepart = $<CP;
+ }$
+ | CasePart CondSuffix ${
+ $0 = $<CS;
+ $CP->next = $0->casepart;
+ $0->casepart = $<CP;
+ }$
IfSuffix -> Newlines ${ $0 = new(cond_statement); }$
- | Newlines ElsePart ${ $0 = $<EP; }$
- | ElsePart ${$0 = $<EP; }$
+ | Newlines ElsePart ${ $0 = $<EP; }$
+ | ElsePart ${$0 = $<EP; }$
ElsePart -> else OpenBlock Newlines ${
- $0 = new(cond_statement);
- $0->elsepart = $<OB;
- var_block_close(c, CloseElse, $0->elsepart);
- }$
- | else OpenScope CondStatement ${
- $0 = new(cond_statement);
- $0->elsepart = $<CS;
- var_block_close(c, CloseElse, $0->elsepart);
- }$
+ $0 = new(cond_statement);
+ $0->elsepart = $<OB;
+ var_block_close(c, CloseElse, $0->elsepart);
+ }$
+ | else OpenScope CondStatement ${
+ $0 = new(cond_statement);
+ $0->elsepart = $<CS;
+ var_block_close(c, CloseElse, $0->elsepart);
+ }$
$*casepart
CasePart -> case Expression OpenScope ColonBlock ${
- $0 = calloc(1,sizeof(struct casepart));
- $0->value = $<Ex;
- $0->action = $<Bl;
- var_block_close(c, CloseParallel, $0->action);
- }$
+ $0 = calloc(1,sizeof(struct casepart));
+ $0->value = $<Ex;
+ $0->action = $<Bl;
+ var_block_close(c, CloseParallel, $0->action);
+ }$
$*exec
// These scopes are closed in CondStatement
ForPart -> for OpenBlock ${
- $0 = $<Bl;
- }$
+ $0 = $<Bl;
+ }$
ThenPart -> then OpenBlock ${
- $0 = $<OB;
- var_block_close(c, CloseSequential, $0);
- }$
+ $0 = $<OB;
+ var_block_close(c, CloseSequential, $0);
+ }$
$*binode
// This scope is closed in CondStatement
WhilePart -> while UseBlock OptNL do OpenBlock ${
- $0 = new(binode);
- $0->op = Loop;
- $0->left = $<UB;
- $0->right = $<OB;
- var_block_close(c, CloseSequential, $0->right);
- var_block_close(c, CloseSequential, $0);
- }$
- | while OpenScope Expression OpenScope ColonBlock ${
- $0 = new(binode);
- $0->op = Loop;
- $0->left = $<Exp;
- $0->right = $<CB;
- var_block_close(c, CloseSequential, $0->right);
- var_block_close(c, CloseSequential, $0);
- }$
+ $0 = new(binode);
+ $0->op = Loop;
+ $0->left = $<UB;
+ $0->right = $<OB;
+ var_block_close(c, CloseSequential, $0->right);
+ var_block_close(c, CloseSequential, $0);
+ }$
+ | while OpenScope Expression OpenScope ColonBlock ${
+ $0 = new(binode);
+ $0->op = Loop;
+ $0->left = $<Exp;
+ $0->right = $<CB;
+ var_block_close(c, CloseSequential, $0->right);
+ var_block_close(c, CloseSequential, $0);
+ }$
$cond_statement
IfPart -> if UseBlock OptNL then OpenBlock ${
- $0.condpart = $<UB;
- $0.thenpart = $<OB;
- var_block_close(c, CloseParallel, $0.thenpart);
- }$
- | if OpenScope Expression OpenScope ColonBlock ${
- $0.condpart = $<Ex;
- $0.thenpart = $<CB;
- var_block_close(c, CloseParallel, $0.thenpart);
- }$
- | if OpenScope Expression OpenScope OptNL then Block ${
- $0.condpart = $<Ex;
- $0.thenpart = $<Bl;
- var_block_close(c, CloseParallel, $0.thenpart);
- }$
+ $0.condpart = $<UB;
+ $0.thenpart = $<OB;
+ var_block_close(c, CloseParallel, $0.thenpart);
+ }$
+ | if OpenScope Expression OpenScope ColonBlock ${
+ $0.condpart = $<Ex;
+ $0.thenpart = $<CB;
+ var_block_close(c, CloseParallel, $0.thenpart);
+ }$
+ | if OpenScope Expression OpenScope OptNL then Block ${
+ $0.condpart = $<Ex;
+ $0.thenpart = $<Bl;
+ var_block_close(c, CloseParallel, $0.thenpart);
+ }$
$*exec
// This scope is closed in CondStatement
SwitchPart -> switch OpenScope Expression ${
- $0 = $<Ex;
- }$
- | switch UseBlock ${
- $0 = $<Bl;
- }$
+ $0 = $<Ex;
+ }$
+ | switch UseBlock ${
+ $0 = $<Bl;
+ }$
###### print binode cases
case Loop:
## declare terminals
OptNL ->
- | OptNL NEWLINE
+ | OptNL NEWLINE
+
Newlines -> NEWLINE
- | Newlines NEWLINE
+ | Newlines NEWLINE
DeclarationList -> Declaration
- | DeclarationList Declaration
+ | DeclarationList Declaration
Declaration -> ERROR Newlines ${
- tok_err(c, // UNTESTED
- "error: unhandled parse error", &$1);
- }$
- | DeclareConstant
- | DeclareFunction
- | DeclareStruct
+ tok_err(c, // UNTESTED
+ "error: unhandled parse error", &$1);
+ }$
+ | DeclareConstant
+ | DeclareFunction
+ | DeclareStruct
## top level grammar
### 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
$TERM const
DeclareConstant -> const { IN OptNL ConstList OUT OptNL } Newlines
- | const { SimpleConstList } Newlines
- | const IN OptNL ConstList OUT Newlines
- | const SimpleConstList Newlines
+ | const { SimpleConstList } Newlines
+ | const IN OptNL ConstList OUT Newlines
+ | const SimpleConstList Newlines
ConstList -> ConstList SimpleConstLine
- | SimpleConstLine
+ | SimpleConstLine
+
SimpleConstList -> SimpleConstList ; Const
- | Const
- | SimpleConstList ;
+ | Const
+ | SimpleConstList ;
+
SimpleConstLine -> SimpleConstList Newlines
- | ERROR Newlines ${ tok_err(c, "Syntax error in constant", &$1); }$
+ | ERROR Newlines ${ tok_err(c, "Syntax error in constant", &$1); }$
$*type
CType -> Type ${ $0 = $<1; }$
- | ${ $0 = NULL; }$
+ | ${ $0 = NULL; }$
+
$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);
+ 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",
- 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->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;
- }
-
- 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;
+ struct binode *b;
+ 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);
}
}
}
+###### 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.
$*variable
DeclareFunction -> func FuncName ( OpenScope ArgsLine ) Block Newlines ${
-
$0 = declare_function(c, $<FN, $<Ar, Tnone, NULL, $<Bl);
- }$
- | func FuncName IN OpenScope Args OUT OptNL do Block Newlines ${
-
$0 = declare_function(c, $<FN, $<Ar, Tnone, NULL, $<Bl);
- }$
- | func FuncName NEWLINE OpenScope OptNL do Block Newlines ${
- $0 = declare_function(c, $<FN, NULL, Tnone, NULL, $<Bl);
- }$
- | func FuncName ( OpenScope ArgsLine ) : Type Block Newlines ${
-
$0 = declare_function(c, $<FN, $<Ar, $<Ty, NULL, $<Bl);
- }$
- | func FuncName ( OpenScope ArgsLine ) : ( ArgsLine ) Block Newlines ${
-
$0 = declare_function(c, $<FN, $<AL, NULL, $<AL2, $<Bl);
- }$
- | func FuncName IN OpenScope Args OUT OptNL return Type Newlines do Block Newlines ${
-
$0 = declare_function(c, $<FN, $<Ar, $<Ty, NULL, $<Bl);
- }$
- | func FuncName NEWLINE OpenScope return Type Newlines do Block Newlines ${
- $0 = declare_function(c, $<FN, NULL, $<Ty, NULL, $<Bl);
- }$
- | func FuncName IN OpenScope Args OUT OptNL return IN Args OUT OptNL do Block Newlines ${
-
$0 = declare_function(c, $<FN, $<Ar, NULL, $<Ar2, $<Bl);
- }$
- | func FuncName NEWLINE OpenScope return IN Args OUT OptNL do Block Newlines ${
-
$0 = declare_function(c, $<FN, NULL, NULL, $<Ar, $<Bl);
- }$
+ $0 = declare_function(c, $<FN, $<Ar, Tnone, NULL, $<Bl);
+ }$
+ | func FuncName IN OpenScope Args OUT OptNL do Block Newlines ${
+ $0 = declare_function(c, $<FN, $<Ar, Tnone, NULL, $<Bl);
+ }$
+ | func FuncName NEWLINE OpenScope OptNL do Block Newlines ${
+ $0 = declare_function(c, $<FN, NULL, Tnone, NULL, $<Bl);
+ }$
+ | func FuncName ( OpenScope ArgsLine ) : Type Block Newlines ${
+ $0 = declare_function(c, $<FN, $<Ar, $<Ty, NULL, $<Bl);
+ }$
+ | func FuncName ( OpenScope ArgsLine ) : ( ArgsLine ) Block Newlines ${
+ $0 = declare_function(c, $<FN, $<AL, NULL, $<AL2, $<Bl);
+ }$
+ | func FuncName IN OpenScope Args OUT OptNL return Type Newlines do Block Newlines ${
+ $0 = declare_function(c, $<FN, $<Ar, $<Ty, NULL, $<Bl);
+ }$
+ | func FuncName NEWLINE OpenScope return Type Newlines do Block Newlines ${
+ $0 = declare_function(c, $<FN, NULL, $<Ty, NULL, $<Bl);
+ }$
+ | func FuncName IN OpenScope Args OUT OptNL return IN Args OUT OptNL do Block Newlines ${
+ $0 = declare_function(c, $<FN, $<Ar, NULL, $<Ar2, $<Bl);
+ }$
+ | func FuncName NEWLINE OpenScope return IN Args OUT OptNL do Block Newlines ${
+ $0 = declare_function(c, $<FN, NULL, NULL, $<Ar, $<Bl);
+ }$
###### print func decls
{
code / ocean / blobdiff