+###### 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);
+
+ 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",
+ 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))
+ type_err(c, "error: have %1 but need %2", prog,
+ ft, rules, type);
+ return ft;
+ }
+ break;
+ }
+
+###### interp exec cases
+ case Xfieldref:
+ {
+ 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;
+ 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;
+ }
+ } }$
+
+ $*fieldlist
+ FieldBlock -> { IN OptNL FieldLines OUT OptNL } ${ $0 = $<FL; }$
+ | { 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;
+ }$
+
+ SimpleFieldList -> Field ${ $0 = $<F; }$
+ | 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; // UNTESTED
+
+ $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);
+ }$
+
+###### forward decls
+ static void structure_print_type(struct type *t, FILE *f);
+
+###### value functions
+ static void structure_print_type(struct type *t, FILE *f) // UNTESTED
+ { // UNTESTED
+ int i; // UNTESTED
+
+ fprintf(f, "struct %.*s\n", t->name.len, t->name.txt);
+
+ for (i = 0; i < t->structure.nfields; i++) {
+ struct field *fl = t->structure.fields + i;
+ fprintf(f, " %.*s : ", fl->name.len, fl->name.txt);
+ type_print(fl->type, f);
+ if (fl->type->print && fl->init) {
+ fprintf(f, " = ");
+ if (fl->type == Tstr)
+ fprintf(f, "\""); // UNTESTED
+ print_value(fl->type, fl->init);
+ if (fl->type == Tstr)
+ fprintf(f, "\""); // UNTESTED
+ }
+ printf("\n");
+ }
+ }
+
+###### print type decls
+ { // UNTESTED
+ struct type *t; // UNTESTED
+ int target = -1;
+
+ while (target != 0) {
+ int i = 0;
+ for (t = context.typelist; t ; t=t->next)
+ if (t->print_type_decl && !t->check_args) {
+ i += 1;
+ if (i == target)
+ break;
+ }
+
+ if (target == -1) {
+ target = i;
+ } else {
+ t->print_type_decl(t, stdout);
+ target -= 1;
+ }
+ }
+ }
+
+#### Functions
+
+A function is a chunk of code which can be passed parameters and can
+return results (though results are not yet implemented). Each function
+has a type which includes the set of parameters and the return value.
+As yet these types cannot be declared separately from the function
+itself.
+
+The parameters can be specified either in parentheses as a list, such as
+
+##### Example: function 1
+
+ func main(av:[ac::number]string)
+ code block
+
+or as an indented list of one parameter per line
+
+##### Example: function 2
+
+ func main
+ argv:[argc::number]string
+ do
+ code block
+
+For constructing these lists we use a `List` binode, which will be
+further detailed when Expression Lists are introduced.
+
+###### type union fields
+
+ struct {
+ struct binode *params;
+ int local_size;
+ } function;
+
+###### value union fields
+ struct exec *function;
+
+###### type functions
+ void (*check_args)(struct parse_context *c, int *ok,
+ struct type *require, struct exec *args);
+
+###### value functions
+
+ static void function_free(struct type *type, struct value *val)
+ {
+ free_exec(val->function);
+ val->function = NULL;
+ }
+
+ static int function_compat(struct type *require, struct type *have)
+ {
+ // FIXME can I do anything here yet?
+ return 0;
+ }
+
+ static void function_check_args(struct parse_context *c, int *ok,
+ struct type *require, struct exec *args)
+ {
+ /* This should be 'compat', but we don't have a 'tuple' type to
+ * hold the type of 'args'
+ */
+ struct binode *arg = cast(binode, args);
+ struct binode *param = require->function.params;
+
+ while (param) {
+ struct var *pv = cast(var, param->left);
+ 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);
+ param = cast(binode, param->right);
+ arg = cast(binode, arg->right);
+ }
+ if (arg)
+ type_err(c, "error: too many arguments to function.",
+ args, NULL, 0, NULL);
+ }
+
+ static void function_print(struct type *type, struct value *val)
+ {
+ print_exec(val->function, 1, 0);
+ }
+
+ static void function_print_type_decl(struct type *type, FILE *f)
+ {
+ struct binode *b;
+ fprintf(f, "(");
+ for (b = type->function.params; b; b = cast(binode, b->right)) {
+ struct variable *v = cast(var, b->left)->var;
+ fprintf(f, "%.*s%s", v->name->name.len, v->name->name.txt,
+ v->constant ? "::" : ":");
+ type_print(v->type, f);
+ if (b->right)
+ fprintf(f, "; ");
+ }
+ fprintf(f, ")\n");
+ }
+
+ static void function_free_type(struct type *t)
+ {
+ free_exec(t->function.params);
+ }
+
+ static struct type function_prototype = {
+ .size = sizeof(void*),
+ .align = sizeof(void*),
+ .free = function_free,
+ .compat = function_compat,
+ .check_args = function_check_args,
+ .print = function_print,
+ .print_type_decl = function_print_type_decl,
+ .free_type = function_free_type,
+ };
+
+###### declare terminals
+
+ $TERM func
+
+###### Binode types
+ List,
+
+###### Grammar
+
+ $*variable
+ FuncName -> IDENTIFIER ${ {
+ 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;
+ 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 -> ${ $0 = NULL; }$
+ | Varlist ${ $0 = $<1; }$
+ | Varlist ; ${ $0 = $<1; }$
+ | Varlist NEWLINE ${ $0 = $<1; }$
+
+ Varlist -> Varlist ; ArgDecl ${ // UNTESTED
+ $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 ${ {
+ struct variable *v = var_decl(c, $1.txt);
+ $0 = new(var);
+ $0->var = v;
+ v->type = $<FT;
+ } }$
+
+## Executables: the elements of code