+ static void reference_free(struct type *t, struct value *v)
+ {
+ /* Nothing to do here */
+ }
+
+ static int reference_compat(struct type *require, struct type *have)
+ {
+ 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;
+ }
+ 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;
+ }
+ return type;
+ case RefFree:
+ t = propagate_types(r->right, c, perr, 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,
+
+###### 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;
+
+###### 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);
+ if (!t || t->free != reference_free)
+ type_err(c, "error: Cannot dereference %1", b, t, 0, NULL);
+ else
+ return t->reference.referent;
+ break;
+
+###### interp binode cases
+ case Deref: {
+ left = interp_exec(c, b->left, <ype);
+ lrv = left.ref;
+ rvtype = ltype->reference.referent;
+ break;
+ }
+
+
+#### Functions
+
+A function is a chunk of code which can be passed parameters and can
+return results. 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 ';' separated
+list, such as
+
+##### Example: function 1
+
+ func main(av:[ac::number]string; env:[envc::number]string)
+ code block
+
+or as an indented list of one parameter per line (though each line can
+be a ';' separated list)
+
+##### Example: function 2
+
+ func main
+ argv:[argc::number]string
+ env:[envc::number]string
+ do
+ code block
+
+In the first case a return type can follow the parentheses after a colon,
+in the second it is given on a line starting with the word `return`.
+
+##### Example: functions that return
+
+ func add(a:number; b:number): number
+ code block
+
+ func catenate
+ a: string
+ b: string
+ return string
+ do
+ code block
+
+Rather than returning a type, the function can specify a set of local
+variables to return as a struct. The values of these variables when the
+function exits will be provided to the caller. For this the return type
+is replaced with a block of result declarations, either in parentheses
+or bracketed by `return` and `do`.
+
+##### Example: functions returning multiple variables
+
+ func to_cartesian(rho:number; theta:number):(x:number; y:number)
+ x = .....
+ y = .....
+
+ func to_polar
+ x:number; y:number
+ return
+ rho:number
+ theta:number