+ ret.lval = lrv;
+ ret.val = rv;
+ return ret;
+ }
+
+### Complex types
+
+Now that we have the shape of the interpreter in place we can add some
+complex types and connected them in to the data structures and the
+different phases of parse, analyse, print, interpret.
+
+Thus far we have arrays and structs.
+
+#### Arrays
+
+Arrays can be declared by giving a size and a type, as `[size]type' so
+`freq:[26]number` declares `freq` to be an array of 26 numbers. The
+size can be an arbitrary expression which is evaluated when the name
+comes into scope.
+
+Arrays cannot be assigned. When pointers are introduced we will also
+introduce array slices which can refer to part or all of an array -
+the assignment syntax will create a slice. For now, an array can only
+ever be referenced by the name it is declared with. It is likely that
+a "`copy`" primitive will eventually be define which can be used to
+make a copy of an array with controllable depth.
+
+###### type union fields
+
+ struct {
+ int size;
+ struct variable *vsize;
+ struct type *member;
+ } array;
+
+###### value union fields
+ struct {
+ struct value *elmnts;
+ } array;
+
+###### value functions
+
+ static struct value array_prepare(struct type *type)
+ {
+ struct value ret;
+
+ ret.type = type;
+ ret.array.elmnts = NULL;
+ return ret;
+ }
+
+ static struct value array_init(struct type *type)
+ {
+ struct value ret;
+ int i;
+
+ ret.type = type;
+ if (type->array.vsize) {
+ mpz_t q;
+ mpz_init(q);
+ mpz_tdiv_q(q, mpq_numref(type->array.vsize->val.num),
+ mpq_denref(type->array.vsize->val.num));
+ type->array.size = mpz_get_si(q);
+ mpz_clear(q);
+ }
+ ret.array.elmnts = calloc(type->array.size,
+ sizeof(ret.array.elmnts[0]));
+ for (i = 0; ret.array.elmnts && i < type->array.size; i++)
+ ret.array.elmnts[i] = val_init(type->array.member);
+ return ret;
+ }
+
+ static void array_free(struct value val)
+ {
+ int i;
+
+ if (val.array.elmnts)
+ for (i = 0; i < val.type->array.size; i++)
+ free_value(val.array.elmnts[i]);
+ free(val.array.elmnts);
+ }
+
+ static int array_compat(struct type *require, struct type *have)
+ {
+ 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 (require->array.vsize == NULL && have->array.vsize == NULL)
+ return require->array.size == have->array.size;
+
+ return require->array.vsize == have->array.vsize;
+ }
+
+ static void array_print_type(struct type *type, FILE *f)
+ {
+ fputs("[", f);
+ if (type->array.vsize) {
+ struct binding *b = type->array.vsize->name;
+ fprintf(f, "%.*s]", b->name.len, b->name.txt);
+ } else
+ fprintf(f, "%d]", type->array.size);
+ type_print(type->array.member, f);
+ }
+
+ static struct type array_prototype = {
+ .prepare = array_prepare,
+ .init = array_init,
+ .print_type = array_print_type,
+ .compat = array_compat,
+ .free = array_free,
+ };
+
+###### type grammar
+
+ | [ NUMBER ] Type ${
+ $0 = calloc(1, sizeof(struct type));
+ *($0) = array_prototype;
+ $0->array.member = $<4;
+ $0->array.vsize = NULL;
+ {
+ char tail[3];
+ mpq_t num;
+ if (number_parse(num, tail, $2.txt) == 0)
+ tok_err(c, "error: unrecognised number", &$2);
+ else if (tail[0])
+ tok_err(c, "error: unsupported number suffix", &$2);
+ else {
+ $0->array.size = mpz_get_ui(mpq_numref(num));
+ if (mpz_cmp_ui(mpq_denref(num), 1) != 0) {
+ tok_err(c, "error: array size must be an integer",
+ &$2);
+ } else if (mpz_cmp_ui(mpq_numref(num), 1UL << 30) >= 0)
+ tok_err(c, "error: array size is too large",
+ &$2);
+ mpq_clear(num);
+ }
+ $0->next= c->anon_typelist;
+ c->anon_typelist = $0;
+ }
+ }$
+
+ | [ IDENTIFIER ] Type ${ {
+ struct variable *v = var_ref(c, $2.txt);
+
+ if (!v)
+ tok_err(c, "error: name undeclared", &$2);
+ else if (!v->constant)
+ tok_err(c, "error: array size must be a constant", &$2);
+
+ $0 = calloc(1, sizeof(struct type));
+ *($0) = array_prototype;
+ $0->array.member = $<4;
+ $0->array.size = 0;
+ $0->array.vsize = v;
+ $0->next= c->anon_typelist;
+ c->anon_typelist = $0;
+ } }$
+
+###### parse context
+
+ struct type *anon_typelist;
+
+###### free context types
+
+ while (context.anon_typelist) {
+ struct type *t = context.anon_typelist;
+
+ context.anon_typelist = t->next;
+ free(t);
+ }
+
+###### Binode types
+ Index,
+
+###### variable grammar
+
+ | Variable [ Expression ] ${ {
+ struct binode *b = new(binode);
+ b->op = Index;
+ b->left = $<1;
+ b->right = $<3;
+ $0 = b;
+ } }$
+
+###### print binode cases
+ case Index:
+ print_exec(b->left, -1, bracket);
+ printf("[");
+ print_exec(b->right, -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);
+ if (!t || t->compat != array_compat) {
+ type_err(c, "error: %1 cannot be indexed", prog, t, 0, NULL);
+ return NULL;
+ } else {
+ if (!type_compat(type, t->array.member, rules)) {
+ type_err(c, "error: have %1 but need %2", prog,
+ t->array.member, rules, type);
+ }
+ return t->array.member;
+ }
+ break;
+
+###### interp binode cases
+ case Index: {
+ mpz_t q;
+ long i;
+
+ lleft = linterp_exec(b->left);
+ right = interp_exec(b->right);
+ mpz_init(q);
+ mpz_tdiv_q(q, mpq_numref(right.num), mpq_denref(right.num));
+ i = mpz_get_si(q);
+ mpz_clear(q);
+
+ if (i >= 0 && i < lleft->type->array.size)
+ lrv = &lleft->array.elmnts[i];
+ else
+ rv = val_init(lleft->type->array.member);
+ break;
+ }
+
+#### Structs
+
+A `struct` is a data-type that contains one or more other data-types.
+It differs from an array in that each member can be of a different
+type, and they are accessed by name rather than by number. Thus you
+cannot choose an element by calculation, you need to know what you
+want up-front.
+
+The language makes no promises about how a given structure will be
+stored in memory - it is free to rearrange fields to suit whatever
+criteria seems important.
+
+Structs are declared separately from program code - they cannot be
+declared in-line in a variable declaration like arrays can. A struct
+is given a name and this name is used to identify the type - the name
+is not prefixed by the word `struct` as it would be in C.
+
+Structs are only treated as the same if they have the same name.
+Simply having the same fields in the same order is not enough. This
+might change once we can create structure initializes from a list of
+values.
+
+Each component datum is identified much like a variable is declared,
+with a name, one or two colons, and a type. The type cannot be omitted
+as there is no opportunity to deduce the type from usage. An initial
+value can be given following an equals sign, so
+
+##### Example: a struct type
+
+ struct complex:
+ x:number = 0
+ y:number = 0
+
+would declare a type called "complex" which has two number fields,
+each initialised to zero.
+
+Struct will need to be declared separately from the code that uses
+them, so we will need to be able to print out the declaration of a
+struct when reprinting the whole program. So a `print_type_decl` type
+function will be needed.
+
+###### type union fields
+
+ struct {
+ int nfields;
+ struct field {
+ struct text name;
+ struct type *type;
+ struct value init;
+ } *fields;
+ } structure;
+
+###### value union fields
+ struct {
+ struct value *fields;
+ } structure;
+
+###### type functions
+ void (*print_type_decl)(struct type *type, FILE *f);
+
+###### value functions
+
+ static struct value structure_prepare(struct type *type)
+ {
+ struct value ret;
+
+ ret.type = type;
+ ret.structure.fields = NULL;
+ return ret;
+ }
+
+ static struct value structure_init(struct type *type)
+ {
+ struct value ret;
+ int i;
+
+ ret.type = type;
+ ret.structure.fields = calloc(type->structure.nfields,
+ sizeof(ret.structure.fields[0]));
+ for (i = 0; ret.structure.fields && i < type->structure.nfields; i++)
+ ret.structure.fields[i] = val_init(type->structure.fields[i].type);
+ return ret;
+ }
+
+ static void structure_free(struct value val)
+ {
+ int i;
+
+ if (val.structure.fields)
+ for (i = 0; i < val.type->structure.nfields; i++)
+ free_value(val.structure.fields[i]);
+ free(val.structure.fields);
+ }
+
+ static void structure_free_type(struct type *t)
+ {
+ int i;
+ for (i = 0; i < t->structure.nfields; i++)
+ free_value(t->structure.fields[i].init);
+ free(t->structure.fields);
+ }
+
+ static struct type structure_prototype = {
+ .prepare = structure_prepare,
+ .init = structure_init,
+ .free = structure_free,
+ .free_type = structure_free_type,
+ .print_type_decl = structure_print_type,
+ };
+
+###### exec type
+ Xfieldref,
+
+###### ast
+ struct fieldref {
+ struct exec;
+ struct exec *left;
+ int index;
+ struct text name;
+ };
+
+###### free exec cases
+ case Xfieldref:
+ free_exec(cast(fieldref, e)->left);
+ free(e);
+ break;
+
+###### variable grammar
+
+ | Variable . IDENTIFIER ${ {
+ struct fieldref *fr = new_pos(fieldref, $2);
+ fr->left = $<1;
+ fr->name = $3.txt;
+ fr->index = -2;
+ $0 = fr;
+ } }$
+
+###### print exec cases
+
+ case Xfieldref:
+ {
+ struct fieldref *f = cast(fieldref, e);
+ print_exec(f->left, -1, bracket);
+ printf(".%.*s", f->name.len, f->name.txt);
+ 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);
+
+ if (!st)
+ type_err(c, "error: unknown type for field access", f->left,
+ NULL, 0, NULL);
+ else if (st->prepare != structure_prepare)
+ 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 value *lleft = linterp_exec(f->left);
+ lrv = &lleft->structure.fields[f->index];
+ 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);
+ free_value(f->f.init);
+ free(f);
+ }
+
+###### top level grammar
+ DeclareStruct -> struct IDENTIFIER FieldBlock ${ {
+ 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) {
+ cnt -= 1;
+ t->structure.fields[cnt] = f->f;
+ f->f.init = val_prepare(Tnone);
+ f = f->prev;
+ }
+ } }$
+
+ $void
+ Open -> {
+ | NEWLINE Open
+ Close -> }
+ | NEWLINE Close
+ $*fieldlist
+ FieldBlock -> Open FieldList Close ${ $0 = $<2; }$
+ | Open SimpleFieldList } ${ $0 = $<2; }$
+ | : FieldList ${ $0 = $<2; }$
+
+ FieldList -> SimpleFieldList NEWLINE ${ $0 = $<1; }$
+ | FieldList SimpleFieldList NEWLINE ${
+ $2->prev = $<1;
+ $0 = $<2;
+ }$
+
+ SimpleFieldList -> Field ${ $0 = $<1; }$
+ | SimpleFieldList ; Field ${
+ $3->prev = $<1;
+ $0 = $<3;
+ }$
+ | SimpleFieldList ; ${
+ $0 = $<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 = val_prepare($0->f.type);
+ do {
+ ok = 1;
+ propagate_types($<5, c, &ok, $3, 0);
+ } while (ok == 2);
+ if (!ok)
+ c->parse_error = 1;
+ else
+ $0->f.init = interp_exec($5);
+ } }$
+ | IDENTIFIER : Type ${
+ $0 = calloc(1, sizeof(struct fieldlist));
+ $0->f.name = $1.txt;
+ $0->f.type = $<3;
+ $0->f.init = val_init($3);
+ }$
+ | ERROR ${ tok_err(c, "Syntax error in struct field", &$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)
+ {
+ int i;
+
+ 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->init.type->print) {
+ fprintf(f, " = ");
+ if (fl->init.type == Tstr)
+ fprintf(f, "\"");
+ print_value(fl->init);
+ if (fl->init.type == Tstr)
+ fprintf(f, "\"");
+ }
+ printf("\n");
+ }
+ }
+
+###### print type decls
+ {
+ struct type *t;
+ int target = -1;
+
+ while (target != 0) {
+ int i = 0;
+ for (t = context.typelist; t ; t=t->next)
+ if (t->print_type_decl) {
+ i += 1;
+ if (i == target)
+ break;
+ }
+
+ if (target == -1) {
+ target = i;
+ } else {
+ t->print_type_decl(t, stdout);
+ target -= 1;
+ }
+ }