X-Git-Url: https://ocean-lang.org/code/?p=ocean;a=blobdiff_plain;f=csrc%2Foceani.mdc;h=e1a2cb076b49c43fc8c5dd95dc2e822929ff875c;hp=2398fb3bb87b4f8c04c1ddb49f67baa64ce64071;hb=1f2bd5d4d22797071a344647191e63c7d2fa6f67;hpb=9c3c0e628883128ce89c34c177c1b5bb534ea69d

diff --git a/csrc/oceani.mdc b/csrc/oceani.mdc
index 2398fb3..e1a2cb0 100644
--- a/csrc/oceani.mdc
+++ b/csrc/oceani.mdc
@@ -110,6 +110,7 @@ structures can be used.
 	## macros
 	struct parse_context;
 	## ast
+	## ast late
 	struct parse_context {
 		struct token_config config;
 		char *file_name;
@@ -789,6 +790,7 @@ which might be reported in error messages.
 		};
 	};
 
+###### ast late
 	struct type {
 		struct text name;
 		struct type *next;
@@ -871,6 +873,28 @@ which might be reported in error messages.
 		return _add_type(c, t, proto, 1);
 	}
 
+	static struct type *find_anon_type(struct parse_context *c,
+					   struct type *proto, char *name, ...)
+	{
+		struct type *t = c->typelist;
+		struct text nm;
+		va_list ap;
+
+		va_start(ap, name);
+		vasprintf(&nm.txt, name, ap);
+		va_end(ap);
+		nm.len = strlen(name);
+
+		while (t && (!t->anon ||
+			     text_cmp(t->name, nm) != 0))
+				t = t->next;
+		if (t) {
+			free(nm.txt);
+			return t;
+		}
+		return _add_type(c, nm, proto, 1);
+	}
+
 	static void free_type(struct type *t)
 	{
 		/* The type is always a reference to something in the
@@ -918,8 +942,8 @@ which might be reported in error messages.
 	{
 		if (tl && tl->cmp_order)
 			return tl->cmp_order(tl, tr, left, right);
-		if (tl && tl->cmp_eq)			// NOTEST
-			return tl->cmp_eq(tl, tr, left, right);	// NOTEST
+		if (tl && tl->cmp_eq)
+			return tl->cmp_eq(tl, tr, left, right);
 		return -1;				// NOTEST
 	}
 
@@ -2598,6 +2622,8 @@ function will be needed.
 
 ###### type functions
 	void (*print_type_decl)(struct type *type, FILE *f);
+	struct type *(*fieldref)(struct type *t, struct parse_context *c,
+				 struct fieldref *f, struct value **vp);
 
 ###### value functions
 
@@ -2702,12 +2728,41 @@ function will be needed.
 		return 1;
 	}
 
+	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 IndexInvalid;
+	}
+
+	static struct type *structure_fieldref(struct type *t, struct parse_context *c,
+					       struct fieldref *f, struct value **vp)
+	{
+		if (f->index == IndexUnknown) {
+			f->index = find_struct_index(t, f->name);
+			if (f->index < 0)
+				type_err(c, "error: cannot find requested field in %1",
+				         f->left, t, 0, NULL);
+		}
+		if (f->index < 0)
+			return NULL;
+		if (vp) {
+			struct value *v = *vp;
+			v = (void*)v->ptr + t->structure.fields[f->index].offset;
+			*vp = v;
+		}
+		return t->structure.fields[f->index].type;
+	}
+
 	static struct type structure_prototype = {
 		.init = structure_init,
 		.free = structure_free,
 		.free_type = structure_free_type,
 		.print_type_decl = structure_print_type,
 		.prepare_type = structure_prepare_type,
+		.fieldref = structure_fieldref,
 	};
 
 ###### exec type
@@ -2720,6 +2775,7 @@ function will be needed.
 		int index;
 		struct text name;
 	};
+	enum { IndexUnknown = -1, IndexInvalid = -2 };
 
 ###### free exec cases
 	case Xfieldref:
@@ -2736,7 +2792,7 @@ function will be needed.
 		struct fieldref *fr = new_pos(fieldref, $2);
 		fr->left = $<1;
 		fr->name = $3.txt;
-		fr->index = -2;
+		fr->index = IndexUnknown;
 		$0 = fr;
 	} }$
 
@@ -2750,16 +2806,6 @@ function will be needed.
 		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:
@@ -2767,24 +2813,15 @@ function will be needed.
 		struct fieldref *f = cast(fieldref, prog);
 		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
-			         NULL, 0, NULL);
-		else if (st->init != structure_init)
-			type_err(c, "error: field reference attempted on %1, not a struct",
+		if (!st || !st->fieldref)
+			type_err(c, "error: field reference on %1 is not supported",
 			         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))
+		else {
+			t = st->fieldref(st, c, f, NULL);
+			if (t && !type_compat(type, t, rules))
 				type_err(c, "error: have %1 but need %2", prog,
-				         ft, rules, type);
-			return ft;
+				         t, rules, type);
+			return t;
 		}
 		break;
 	}
@@ -2795,8 +2832,8 @@ function will be needed.
 		struct fieldref *f = cast(fieldref, e);
 		struct type *ltype;
 		struct value *lleft = linterp_exec(c, f->left, &ltype);
-		lrv = (void*)lleft->ptr + ltype->structure.fields[f->index].offset;
-		rvtype = ltype->structure.fields[f->index].type;
+		lrv = lleft;
+		rvtype = ltype->fieldref(ltype, c, f, &lrv);
 		break;
 	}
 
@@ -2906,6 +2943,319 @@ function will be needed.
 		}
 	}
 
+#### References
+
+References, or pointers, are values that refer to another value.  They
+can only refer to a `struct`, though as a struct can embed anything they
+can effectively refer to anything.
+
+References are potentially dangerous as they might refer to some
+variable which no longer exists - either because a stack frame
+containing it has been discarded or because the value was allocated on
+the heap and has now been free.  Ocean does not yet provide any
+protection against these problems.  It will in due course.
+
+With references comes the opportunity and the need to explicitly
+allocate values on the "heap" and to free them.  We currently provide
+fairly basic support for this.
+
+Reference make use of the `@` symbol in various ways.  A type that starts
+with `@` is a reference to whatever follows.  A reference value
+followed by an `@` acts as the referred value, though the `@` is often
+not needed.  Finally, an expression that starts with `@` is a special
+reference related expression.  Some examples might help.
+
+##### Example: Reference examples
+
+	struct foo
+		a: number
+		b: string
+	ref: @foo
+	bar: foo
+	bar.number = 23; bar.string = "hello"
+	baz: foo
+	ref = bar
+	baz = @ref
+	baz.a = ref.a * 2
+
+	ref = @new()
+	ref@ = baz
+	@free = ref
+	ref = @nil
+
+Obviously this is very contrived.  `ref` is a reference to a `foo` which
+is initially set to refer to the value stored in `bar` - no extra syntax
+is needed to "Take the address of" `bar` - the fact that `ref` is a
+reference means that only the address make sense.
+
+When `ref.a` is accessed, that is whatever value is stored in `bar.a`.
+The same syntax is used for accessing fields both in structs and in
+references to structs.  It would be correct to use `ref@.a`, but not
+necessary.
+
+`@new()` creates an object of whatever type is needed for the program
+to by type-correct.  In future iterations of Ocean, arguments a
+constructor will access arguments, so the the syntax now looks like a
+function call.  `@free` can be assigned any reference that was returned
+by `@new()`, and it will be freed.  `@nil` is a value of whatever
+reference type is appropriate, and is stable and never the address of
+anything in the heap or on the stack.  A reference can be assigned
+`@nil` or compared against that value.
+
+###### declare terminals
+	$TERM @
+
+###### type union fields
+
+	struct {
+		struct type *referent;
+	} reference;
+
+###### value union fields
+	struct value *ref;
+
+###### value functions
+
+	static void reference_print_type(struct type *t, FILE *f)
+	{
+		fprintf(f, "@");
+		type_print(t->reference.referent, f);
+	}
+
+	static int reference_cmp(struct type *tl, struct type *tr,
+				 struct value *left, struct value *right)
+	{
+		return left->ref == right->ref ? 0 : 1;
+	}
+
+	static void reference_dup(struct type *t,
+				  struct value *vold, struct value *vnew)
+	{
+		vnew->ref = vold->ref;
+	}
+
+	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_prototype = {
+		.print_type = reference_print_type,
+		.cmp_eq = reference_cmp,
+		.dup = reference_dup,
+		.test = reference_test,
+		.free = reference_free,
+		.compat = reference_compat,
+		.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, &ltype);
+		lrv = left.ref;
+		rvtype = ltype->reference.referent;
+		break;
+	}
+
+
 #### Functions
 
 A function is a chunk of code which can be passed parameters and can