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

diff --git a/csrc/oceani.mdc b/csrc/oceani.mdc
index e1a2cb0..dca2055 100644
--- a/csrc/oceani.mdc
+++ b/csrc/oceani.mdc
@@ -589,23 +589,17 @@ expected to return, and returns the type that it does return, either of
 which can be `NULL` signifying "unknown".  A `prop_err` flag set is
 passed by reference.  It has `Efail` set when an error is found, and
 `Eretry` when the type for some element is set via propagation.  If
-any expression cannot be evaluated immediately, `Enoconst` is set.
+any expression cannot be evaluated a compile time, `Eruntime` is set.
 If the expression can be copied, `Emaycopy` is set.
 
 If it remains unchanged at `0`, then no more propagation is needed.
 
 ###### ast
 
-	enum val_rules {Rnolabel = 1<<0, Rboolok = 1<<1, Rnoconstant = 1<<2};
-	enum prop_err {Efail = 1<<0, Eretry = 1<<1, Enoconst = 1<<2,
+	enum val_rules {Rboolok = 1<<1, Rnoconstant = 1<<2};
+	enum prop_err {Efail = 1<<0, Eretry = 1<<1, Eruntime = 1<<2,
 		       Emaycopy = 1<<3};
 
-###### format cases
-	case 'r':
-		if (rules & Rnolabel)
-			fputs(" (labels not permitted)", stderr);
-		break;
-
 ###### forward decls
 	static struct type *propagate_types(struct exec *prog, struct parse_context *c, enum prop_err *perr,
 	                                    struct type *type, int rules);
@@ -1065,8 +1059,6 @@ A separate function encoding these cases will simplify some code later.
 	{
 		if ((rules & Rboolok) && have == Tbool)
 			return 1;	// NOTEST
-		if ((rules & Rnolabel) && have == Tlabel)
-			return 0;	// NOTEST
 		if (!require || !have)
 			return 1;
 
@@ -1092,7 +1084,7 @@ A separate function encoding these cases will simplify some code later.
 	struct text str;
 	mpq_t num;
 	unsigned char bool;
-	void *label;
+	int label;
 
 ###### ast functions
 	static void _free_value(struct type *type, struct value *v)
@@ -1125,8 +1117,8 @@ A separate function encoding these cases will simplify some code later.
 			val->bool = 0;
 			break;
 		case Vlabel:
-			val->label = NULL;
-			break;
+			val->label = 0;	// NOTEST
+			break;		// NOTEST
 		}
 	}
 
@@ -1137,8 +1129,8 @@ A separate function encoding these cases will simplify some code later.
 		case Vnone:		// NOTEST
 			break;		// NOTEST
 		case Vlabel:
-			vnew->label = vold->label;
-			break;
+			vnew->label = vold->label;	// NOTEST
+			break;		// NOTEST
 		case Vbool:
 			vnew->bool = vold->bool;
 			break;
@@ -1176,7 +1168,7 @@ A separate function encoding these cases will simplify some code later.
 		case Vnone:				// NOTEST
 			fprintf(f, "*no-value*"); break;	// NOTEST
 		case Vlabel:				// NOTEST
-			fprintf(f, "*label-%p*", v->label); break; // NOTEST
+			fprintf(f, "*label-%d*", v->label); break; // NOTEST
 		case Vstr:
 			fprintf(f, "%.*s", v->str.len, v->str.txt); break;
 		case Vbool:
@@ -1261,10 +1253,11 @@ executable.
 		return v;
 	}
 
-###### Grammar
-
+###### declare terminals
 	$TERM True False
 
+###### Grammar
+
 	$*val
 	Value ->  True ${
 		$0 = new_val(Tbool, $1);
@@ -1318,7 +1311,7 @@ executable.
 	{
 		struct val *val = cast(val, prog);
 		if (!type_compat(type, val->vtype, rules))
-			type_err(c, "error: expected %1%r found %2",
+			type_err(c, "error: expected %1 found %2",
 			           prog, type, rules, val->vtype);
 		return val->vtype;
 	}
@@ -1361,6 +1354,98 @@ executable.
 		return rv;
 	}
 
+#### Labels
+
+Labels are a temporary concept until I implement enums.  There are an
+anonymous enum which is declared by usage.  Thet are only allowed in
+`use` statements and corresponding `case` entries.  They appear as a
+period followed by an identifier.  All identifiers that are "used" must
+have a "case".
+
+For now, we have a global list of labels, and don't check that all "use"
+match "case".
+
+###### exec type
+	Xlabel,
+
+###### ast
+	struct label {
+		struct exec;
+		struct text name;
+		int value;
+	};
+###### free exec cases
+	case Xlabel:
+		free(e);
+		break;
+###### print exec cases
+	case Xlabel: {
+		struct label *l = cast(label, e);
+		printf(".%.*s", l->name.len, l->name.txt);
+		break;
+	}
+
+###### ast
+	struct labels {
+		struct labels *next;
+		struct text name;
+		int value;
+	};
+###### parse context
+	struct labels *labels;
+	int next_label;
+###### ast functions
+	static int label_lookup(struct parse_context *c, struct text name)
+	{
+		struct labels *l, **lp = &c->labels;
+		while (*lp && text_cmp((*lp)->name, name) < 0)
+			lp = &(*lp)->next;
+		if (*lp && text_cmp((*lp)->name, name) == 0)
+			return (*lp)->value;
+		l = calloc(1, sizeof(*l));
+		l->next = *lp;
+		l->name = name;
+		if (c->next_label == 0)
+			c->next_label = 2;
+		l->value = c->next_label;
+		c->next_label += 1;
+		*lp = l;
+		return l->value;
+	}
+
+###### free context storage
+	while (context.labels) {
+		struct labels *l = context.labels;
+		context.labels = l->next;
+		free(l);
+	}
+
+###### declare terminals
+	$TERM .
+###### term grammar
+	| . IDENTIFIER ${ {
+		struct label *l = new_pos(label, $ID);
+		l->name = $ID.txt;
+		$0 = l;
+	} }$
+###### propagate exec cases
+	case Xlabel: {
+		struct label *l = cast(label, prog);
+		l->value = label_lookup(c, l->name);
+		if (!type_compat(type, Tlabel, rules))
+			type_err(c, "error: expected %1 found %2",
+				 prog, type, rules, Tlabel);
+		return Tlabel;
+	}
+###### interp exec cases
+	case Xlabel : {
+		struct label *l = cast(label, e);
+		rv.label = l->value;
+		rvtype = Tlabel;
+		break;
+	}
+
+
 ### Variables
 
 Variables are scoped named values.  We store the names in a linked list
@@ -1838,9 +1923,6 @@ all pending-scope variables become conditionally scoped.
 					         v->previous->scope == PendingScope)
 						/* all previous branches used name */
 						v->scope = PendingScope;
-					else if (v->type == Tlabel)
-						/* Labels remain pending even when not used */
-						v->scope = PendingScope;	// UNTESTED
 					else
 						v->scope = OutScope;
 					if (ct == CloseElse) {
@@ -1871,8 +1953,6 @@ all pending-scope variables become conditionally scoped.
 					v->scope = InScope;
 				/* fallthrough */
 			case CloseSequential:
-				if (v->type == Tlabel)
-					v->scope = PendingScope;
 				switch (v->scope) {
 				case InScope:
 					v->scope = OutScope;
@@ -1886,10 +1966,7 @@ all pending-scope variables become conditionally scoped.
 					for (v2 = v;
 					     v2 && v2->scope == PendingScope;
 					     v2 = v2->previous)
-						if (v2->type == Tlabel)
-							v2->scope = CondScope;
-						else
-							v2->scope = OutScope;
+						v2->scope = OutScope;
 					break;
 				case CondScope:
 				case OutScope: break;
@@ -1976,7 +2053,7 @@ tell if it was set or not later.
 		if (init)
 			memcpy(ret, init, t->size);
 		else
-			val_init(t, ret);
+			val_init(t, ret);	// NOTEST
 		return ret;
 	}
 
@@ -2206,13 +2283,13 @@ correctly.
 				*perr |= Eretry;
 			}
 		} else if (!type_compat(type, v->type, rules)) {
-			type_err(c, "error: expected %1%r but variable '%v' is %2", prog,
+			type_err(c, "error: expected %1 but variable '%v' is %2", prog,
 			         type, rules, v->type);
 			type_err(c, "info: this is where '%v' was set to %1", v->where_set,
 			         v->type, rules, NULL);
 		}
 		if (!v->global || v->frame_pos < 0)
-			*perr |= Enoconst;
+			*perr |= Eruntime;
 		if (!type)
 			return v->type;
 		return type;
@@ -2784,7 +2861,7 @@ function will be needed.
 		break;
 
 ###### declare terminals
-	$TERM struct .
+	$TERM struct
 
 ###### term grammar
 
@@ -3053,6 +3130,22 @@ anything in the heap or on the stack.  A reference can be assigned
 		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,
@@ -3060,6 +3153,7 @@ anything in the heap or on the stack.  A reference can be assigned
 		.test = reference_test,
 		.free = reference_free,
 		.compat = reference_compat,
+		.fieldref = reference_fieldref,
 		.size = sizeof(void*),
 		.align = sizeof(void*),
 	};
@@ -3571,7 +3665,7 @@ it in the "SimpleStatement Grammar" which will be described later.
 				 prog, NULL, 0, NULL);
 			return NULL;
 		}
-		*perr |= Enoconst;
+		*perr |= Eruntime;
 		v->var->type->check_args(c, perr, v->var->type, args);
 		if (v->var->type->function.inline_result)
 			*perr |= Emaycopy;
@@ -3688,8 +3782,8 @@ there.
 		struct type *t2;
 
 		propagate_types(b->left, c, perr, Tbool, 0);
-		t = propagate_types(b2->left, c, perr, type, Rnolabel);
-		t2 = propagate_types(b2->right, c, perr, type ?: t, Rnolabel);
+		t = propagate_types(b2->left, c, perr, type, 0);
+		t2 = propagate_types(b2->right, c, perr, type ?: t, 0);
 		return t ?: t2;
 	}
 
@@ -3971,11 +4065,11 @@ expression operator, and the `CMPop` non-terminal will match one of them.
 	case Eql:
 	case NEql:
 		/* Both must match but not be labels, result is Tbool */
-		t = propagate_types(b->left, c, perr, NULL, Rnolabel);
+		t = propagate_types(b->left, c, perr, NULL, 0);
 		if (t)
 			propagate_types(b->right, c, perr, t, 0);
 		else {
-			t = propagate_types(b->right, c, perr, NULL, Rnolabel);	// UNTESTED
+			t = propagate_types(b->right, c, perr, NULL, 0);	// UNTESTED
 			if (t)	// UNTESTED
 				t = propagate_types(b->left, c, perr, t, 0);	// UNTESTED
 		}
@@ -4492,7 +4586,7 @@ the common header for all reductions to use.
 				if (!type)
 					type = t;
 				else if (t != type)
-					type_err(c, "error: expected %1%r, found %2",
+					type_err(c, "error: expected %1, found %2",
 					         e->left, type, rules, t);
 			}
 		}
@@ -4569,7 +4663,7 @@ printed.
 		else
 			b = cast(binode, b->right);
 		while (b) {
-			propagate_types(b->left, c, perr, NULL, Rnolabel);
+			propagate_types(b->left, c, perr, NULL, 0);
 			b = cast(binode, b->right);
 		}
 		break;
@@ -4600,9 +4694,9 @@ An assignment will assign a value to a variable, providing it hasn't
 been declared as a constant.  The analysis phase ensures that the type
 will be correct so the interpreter just needs to perform the
 calculation.  There is a form of assignment which declares a new
-variable as well as assigning a value.  If a name is assigned before
-it is declared, and error will be raised as the name is created as
-`Tlabel` and it is illegal to assign to such names.
+variable as well as assigning a value.  If a name is used before
+it is declared, it is assumed to be a global constant which are allowed to
+be declared at any time.
 
 ###### Binode types
 	Assign,
@@ -4687,7 +4781,7 @@ it is declared, and error will be raised as the name is created as
 		 * result is Tnone
 		 */
 		t = propagate_types(b->left, c, perr, NULL,
-		                    Rnolabel | (b->op == Assign ? Rnoconstant : 0));
+		                    (b->op == Assign ? Rnoconstant : 0));
 		if (!b->right)
 			return Tnone;
 
@@ -4697,7 +4791,7 @@ it is declared, and error will be raised as the name is created as
 					type_err(c, "info: variable '%v' was set as %1 here.",
 					         cast(var, b->left)->var->where_set, t, rules, NULL);
 		} else {
-			t = propagate_types(b->right, c, perr, NULL, Rnolabel);
+			t = propagate_types(b->right, c, perr, NULL, 0);
 			if (t)
 				propagate_types(b->left, c, perr, t,
 				                (b->op == Assign ? Rnoconstant : 0));
@@ -4750,17 +4844,6 @@ function which has a return type, and the "condition" code blocks in
 		$0 = b = new_pos(binode, $1);
 		b->op = Use;
 		b->right = $<2;
-		if (b->right->type == Xvar) {
-			struct var *v = cast(var, b->right);
-			if (v->var->type == Tnone) {
-				/* Convert this to a label */
-				struct value *val;
-
-				v->var->type = Tlabel;
-				val = global_alloc(c, Tlabel, v->var, NULL);
-				val->label = val;
-			}
-		}
 	}$
 
 ###### print binode cases
@@ -5441,7 +5524,7 @@ constants.
 				} while (perr & Eretry);
 				if (perr & Efail)
 					c->parse_error += 1;
-				else if (!(perr & Enoconst)) {
+				else if (!(perr & Eruntime)) {
 					progress = some;
 					struct value res = interp_exec(
 						c, vb->right, &v->var->type);
@@ -5852,19 +5935,19 @@ things which will likely grow as the languages grows.
 		while
 			mid := (lo + hi) / 2
 			if mid == target:
-				use Found
+				use .Found
 			if mid < target:
 				lo = mid
 			else
 				hi = mid
 			if hi - lo < 1:
 				lo = mid
-				use GiveUp
+				use .GiveUp
 			use True
 		do pass
-		case Found:
+		case .Found:
 			print "Yay, I found", target
-		case GiveUp:
+		case .GiveUp:
 			print "Closest I found was", lo
 
 		size::= 10