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

diff --git a/csrc/oceani.mdc b/csrc/oceani.mdc
index 2398fb3..12be60c 100644
--- a/csrc/oceani.mdc
+++ b/csrc/oceani.mdc
@@ -871,6 +871,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 +940,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
 	}
 
@@ -2906,6 +2928,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