X-Git-Url: https://ocean-lang.org/code/?p=ocean;a=blobdiff_plain;f=csrc%2Foceani.mdc;h=180c36fb4d9bb059f30ca0f2b101f6d1b4a1946c;hp=7371535bf7c555ec127028eb89f3113901be0561;hb=1633bb8942f3f573322a48f49e0e0dec96352d01;hpb=57c69adf13069b9daf3ed59f4401f16de3312975

diff --git a/csrc/oceani.mdc b/csrc/oceani.mdc
index 7371535..180c36f 100644
--- a/csrc/oceani.mdc
+++ b/csrc/oceani.mdc
@@ -242,6 +242,8 @@ structures can be used.
 
 		parse_oceani(ss->code, &context.config, dotrace ? stderr : NULL);
 
+		resolve_consts(&context);
+		prepare_types(&context);
 		if (!context.parse_error && !analyse_funcs(&context)) {
 			fprintf(stderr, "oceani: type error in program - not running.\n");
 			context.parse_error = 1;
@@ -265,6 +267,7 @@ structures can be used.
 		while (context.scope_depth > 0)
 			scope_pop(&context);
 		## free global vars
+		## free const decls
 		## free context types
 		## free context storage
 		exit(context.parse_error ? 1 : 0);
@@ -647,6 +650,9 @@ the location of a value, which can be updated, in `lval`.  Others will
 set `lval` to NULL indicating that there is a value of appropriate type
 in `rval`.
 
+###### forward decls
+	static struct value interp_exec(struct parse_context *c, struct exec *e,
+					struct type **typeret);
 ###### core functions
 
 	struct lrval {
@@ -911,6 +917,15 @@ which might be reported in error messages.
 			fprintf(f, "*Unknown*");		// NOTEST
 	}
 
+	static void prepare_types(struct parse_context *c)
+	{
+		struct type *t;
+
+		for (t = c->typelist; t; t = t->next)
+			if (t->prepare_type)
+				t->prepare_type(c, t, 1);
+	}
+
 ###### forward decls
 
 	static void free_value(struct type *type, struct value *v);
@@ -1110,7 +1125,7 @@ A separate function encoding these cases will simplify some code later.
 			mpf_t fl;
 			mpf_init2(fl, 20);
 			mpf_set_q(fl, v->num);
-			gmp_fprintf(f, "%Fg", fl);
+			gmp_fprintf(f, "%.10Fg", fl);
 			mpf_clear(fl);
 			break;
 			}
@@ -1224,6 +1239,7 @@ executable.
 		struct val *v = cast(val, e);
 		if (v->vtype == Tstr)
 			printf("\"");
+		// FIXME how to ensure numbers have same precision.
 		print_value(v->vtype, &v->val, stdout);
 		if (v->vtype == Tstr)
 			printf("\"");
@@ -1575,10 +1591,10 @@ need to be freed.  For this we need to be able to find it, so assume that
 		while (v) {
 			struct variable *next = v->previous;
 
-			if (v->global) {
+			if (v->global && v->frame_pos >= 0) {
 				free_value(v->type, var_value(&context, v));
-				if (v->depth == 0)
-					// This is a global constant
+				if (v->depth == 0 && v->type->free == function_free)
+					// This is a function constant
 					free_exec(v->where_decl);
 			}
 			free(v);
@@ -1845,13 +1861,17 @@ tell if it was set or not later.
 	short local_size;
 	void *global, *local;
 
+###### forward decls
+	static struct value *global_alloc(struct parse_context *c, struct type *t,
+					  struct variable *v, struct value *init);
+
 ###### ast functions
 
 	static struct value *var_value(struct parse_context *c, struct variable *v)
 	{
 		if (!v->global) {
 			if (!c->local || !v->type)
-				return NULL;			// NOTEST
+				return NULL;
 			if (v->frame_pos + v->type->size > c->local_size) {
 				printf("INVALID frame_pos\n");	// NOTEST
 				exit(2);			// NOTEST
@@ -1877,7 +1897,7 @@ tell if it was set or not later.
 			t->prepare_type(c, t, 1);	// NOTEST
 
 		if (c->global_size & (t->align - 1))
-			c->global_size = (c->global_size + t->align) & ~(t->align-1);
+			c->global_size = (c->global_size + t->align) & ~(t->align-1);	// NOTEST
 		if (!v) {
 			v = &scratch;
 			v->type = t;
@@ -2228,16 +2248,22 @@ with a const size by whether they are prepared at parse time or not.
 	{
 		struct value *vsize;
 		mpz_t q;
-		if (!type->array.vsize || type->array.static_size)
+		if (type->array.static_size)
+			return;
+		if (type->array.unspec && parse_time)
 			return;
 
-		vsize = var_value(c, type->array.vsize);
-		mpz_init(q);
-		mpz_tdiv_q(q, mpq_numref(vsize->num), mpq_denref(vsize->num));
-		type->array.size = mpz_get_si(q);
-		mpz_clear(q);
+		if (type->array.vsize) {
+			vsize = var_value(c, type->array.vsize);
+			if (!vsize)
+				return;
+			mpz_init(q);
+			mpz_tdiv_q(q, mpq_numref(vsize->num), mpq_denref(vsize->num));
+			type->array.size = mpz_get_si(q);
+			mpz_clear(q);
+		}
 
-		if (parse_time) {
+		if (parse_time && type->array.member->size) {
 			type->array.static_size = 1;
 			type->size = type->array.size * type->array.member->size;
 			type->align = type->array.member->align;
@@ -2356,9 +2382,6 @@ with a const size by whether they are prepared at parse time or not.
 		t->array.size = elements;
 		t->array.member = $<4;
 		t->array.vsize = NULL;
-		t->array.static_size = 1;
-		t->size = t->array.size * t->array.member->size;
-		t->align = t->array.member->align;
 	} }$
 
 	| [ IDENTIFIER ] Type ${ {
@@ -2512,7 +2535,12 @@ function will be needed.
 			struct type *type;
 			struct value *init;
 			int offset;
-		} *fields;
+		} *fields; // This is created when field_list is analysed.
+		struct fieldlist {
+			struct fieldlist *prev;
+			struct field f;
+			struct exec *init;
+		} *field_list; // This is created during parsing
 	} structure;
 
 ###### type functions
@@ -2547,6 +2575,15 @@ function will be needed.
 		}
 	}
 
+	static void free_fieldlist(struct fieldlist *f)
+	{
+		if (!f)
+			return;
+		free_fieldlist(f->prev);
+		free_exec(f->init);
+		free(f);
+	}
+
 	static void structure_free_type(struct type *t)
 	{
 		int i;
@@ -2556,6 +2593,56 @@ function will be needed.
 				           t->structure.fields[i].init);
 			}
 		free(t->structure.fields);
+		free_fieldlist(t->structure.field_list);
+	}
+
+	static void structure_prepare_type(struct parse_context *c,
+					   struct type *t, int parse_time)
+	{
+		int cnt = 0;
+		struct fieldlist *f;
+
+		if (!parse_time || t->structure.fields)
+			return;
+
+		for (f = t->structure.field_list; f; f=f->prev) {
+			int ok;
+			cnt += 1;
+
+			if (f->f.type->prepare_type)
+				f->f.type->prepare_type(c, f->f.type, 1);
+			if (f->init == NULL)
+				continue;
+			do {
+				ok = 1;
+				propagate_types(f->init, c, &ok, f->f.type, 0);
+			} while (ok == 2);
+			if (!ok)
+				c->parse_error = 1;	// NOTEST
+		}
+
+		t->structure.nfields = cnt;
+		t->structure.fields = calloc(cnt, sizeof(struct field));
+		f = t->structure.field_list;
+		while (cnt > 0) {
+			int a = f->f.type->align;
+			cnt -= 1;
+			t->structure.fields[cnt] = f->f;
+			if (t->size & (a-1))
+				t->size = (t->size | (a-1)) + 1;
+			t->structure.fields[cnt].offset = t->size;
+			t->size += ((f->f.type->size - 1) | (a-1)) + 1;
+			if (a > t->align)
+				t->align = a;
+
+			if (f->init && !c->parse_error) {
+				struct value vl = interp_exec(c, f->init, NULL);
+				t->structure.fields[cnt].init =
+					global_alloc(c, f->f.type, NULL, &vl);
+			}
+
+			f = f->prev;
+		}
 	}
 
 	static struct type structure_prototype = {
@@ -2563,6 +2650,7 @@ function will be needed.
 		.free = structure_free,
 		.free_type = structure_free_type,
 		.print_type_decl = structure_print_type,
+		.prepare_type = structure_prepare_type,
 	};
 
 ###### exec type
@@ -2655,51 +2743,11 @@ function will be needed.
 		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);
-		if (f->f.init) {
-			free_value(f->f.type, f->f.init);	// UNTESTED
-			free(f->f.init);	// UNTESTED
-		}
-		free(f);
-	}
-
 ###### top level grammar
 	DeclareStruct -> struct IDENTIFIER FieldBlock Newlines ${ {
 		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) {
-			int a = f->f.type->align;
-			cnt -= 1;
-			t->structure.fields[cnt] = f->f;
-			if (t->size & (a-1))
-				t->size = (t->size | (a-1)) + 1;
-			t->structure.fields[cnt].offset = t->size;
-			t->size += ((f->f.type->size - 1) | (a-1)) + 1;
-			if (a > t->align)
-				t->align = a;
-			f->f.init = NULL;
-			f = f->prev;
-		}
+		t->structure.field_list = $<FB;
 	} }$
 
 	$*fieldlist
@@ -2725,29 +2773,16 @@ function will be needed.
 	| ERROR ${ tok_err(c, "Syntax error in struct field", &$1); }$
 
 	Field -> IDENTIFIER : Type = Expression ${ {
-		int ok;
-
 		$0 = calloc(1, sizeof(struct fieldlist));
-		$0->f.name = $1.txt;
-		$0->f.type = $<3;
+		$0->f.name = $ID.txt;
+		$0->f.type = $<Type;
 		$0->f.init = NULL;
-		do {
-			ok = 1;
-			propagate_types($<5, c, &ok, $3, 0);
-		} while (ok == 2);
-		if (!ok)
-			c->parse_error = 1;	// UNTESTED
-		else {
-			struct value vl = interp_exec(c, $5, NULL);
-			$0->f.init = global_alloc(c, $0->f.type, NULL, &vl);
-		}
+		$0->init = $<Expr;
 	} }$
 	| IDENTIFIER : Type ${
 		$0 = calloc(1, sizeof(struct fieldlist));
-		$0->f.name = $1.txt;
-		$0->f.type = $<3;
-		if ($0->f.type->prepare_type)
-			$0->f.type->prepare_type(c, $0->f.type, 1);
+		$0->f.name = $ID.txt;
+		$0->f.type = $<Type;
 	}$
 
 ###### forward decls
@@ -4825,13 +4860,15 @@ various declarations in the parse context.
 
 ### The `const` section
 
-As well as being defined in with the code that uses them, constants
-can be declared at the top level.  These have full-file scope, so they
-are always `InScope`.  The value of a top level constant can be given
-as an expression, and this is evaluated immediately rather than in the
-later interpretation stage.  Once we add functions to the language, we
-will need rules concern which, if any, can be used to define a top
-level constant.
+As well as being defined in with the code that uses them, constants can
+be declared at the top level.  These have full-file scope, so they are
+always `InScope`, even before(!) they have been declared.  The value of
+a top level constant can be given as an expression, and this is
+evaluated after parsing and before execution.
+
+A function call can be used to evaluate a constant, but it will not have
+access to any program state, once such statement becomes meaningful.
+e.g.  arguments and filesystem will not be visible.
 
 Constants are defined in a section that starts with the reserved word
 `const` and then has a block with a list of assignment statements.
@@ -4840,11 +4877,8 @@ make it clear that they are constants.  Type can also be given: if
 not, the type will be determined during analysis, as with other
 constants.
 
-As the types constants are inserted at the head of a list, printing
-them in the same order that they were read is not straight forward.
-We take a quadratic approach here and count the number of constants
-(variables of depth 0), then count down from there, each time
-searching through for the Nth constant for decreasing N.
+###### parse context
+	struct binode *constlist;
 
 ###### top level grammar
 
@@ -4871,69 +4905,88 @@ searching through for the Nth constant for decreasing N.
 
 	$void
 	Const -> IDENTIFIER :: CType = Expression ${ {
-		int ok;
 		struct variable *v;
+		struct binode *bl, *bv;
+		struct var *var = new_pos(var, $ID);
 
-		v = var_decl(c, $1.txt);
+		v = var_decl(c, $ID.txt);
 		if (v) {
-			struct var *var = new_pos(var, $1);
 			v->where_decl = var;
 			v->where_set = var;
-			var->var = v;
+			v->type = $<CT;
 			v->constant = 1;
 			v->global = 1;
 		} else {
-			struct variable *vorig = var_ref(c, $1.txt);
+			v = var_ref(c, $1.txt);
 			tok_err(c, "error: name already declared", &$1);
 			type_err(c, "info: this is where '%v' was first declared",
-			         vorig->where_decl, NULL, 0, NULL);
-		}
-		do {
-			ok = 1;
-			propagate_types($5, c, &ok, $3, 0);
-		} while (ok == 2);
-		if (!ok)
-			c->parse_error = 1;
-		else if (v) {
-			struct value res = interp_exec(c, $5, &v->type);
-			global_alloc(c, v->type, v, &res);
+			         v->where_decl, NULL, 0, NULL);
 		}
+		var->var = v;
+
+		bv = new(binode);
+		bv->op = Declare;
+		bv->left = var;
+		bv->right= $<Exp;
+
+		bl = new(binode);
+		bl->op = List;
+		bl->left = c->constlist;
+		bl->right = bv;
+		c->constlist = bl;
 	} }$
 
-###### print const decls
+###### core functions
+	static void resolve_consts(struct parse_context *c)
 	{
-		struct variable *v;
-		int target = -1;
-
-		while (target != 0) {
-			int i = 0;
-			for (v = context.in_scope; v; v=v->in_scope)
-				if (v->depth == 0 && v->constant) {
-					i += 1;
-					if (i == target)
-						break;
-				}
-
-			if (target == -1) {
-				if (i)
-					printf("const\n");
-				target = i;
-			} else {
-				struct value *val = var_value(&context, v);
-				printf("    %.*s :: ", v->name->name.len, v->name->name.txt);
-				type_print(v->type, stdout);
-				printf(" = ");
-				if (v->type == Tstr)
-					printf("\"");
-				print_value(v->type, val, stdout);
-				if (v->type == Tstr)
-					printf("\"");
-				printf("\n");
-				target -= 1;
+		struct binode *b;
+		c->constlist = reorder_bilist(c->constlist);
+		for (b = cast(binode, c->constlist); b;
+		     b = cast(binode, b->right)) {
+			int ok;
+			struct binode *vb = cast(binode, b->left);
+			struct var *v = cast(var, vb->left);
+			do {
+				ok = 1;
+				propagate_types(vb->right, c, &ok,
+					        v->var->type, 0);
+			} while (ok == 2);
+			if (!ok)
+				c->parse_error = 1;
+			else {
+				struct value res = interp_exec(
+					c, vb->right, &v->var->type);
+				global_alloc(c, v->var->type, v->var, &res);
 			}
 		}
 	}
 
+###### print const decls
+	{
+		struct binode *b;
+		int first = 1;
+
+		for (b = cast(binode, context.constlist); b;
+		     b = cast(binode, b->right)) {
+			struct binode *vb = cast(binode, b->left);
+			struct var *vr = cast(var, vb->left);
+			struct variable *v = vr->var;
+
+			if (first)
+				printf("const\n");
+			first = 0;
+
+			printf("    %.*s :: ", v->name->name.len, v->name->name.txt);
+			type_print(v->type, stdout);
+			printf(" = ");
+			print_exec(vb->right, -1, 0);
+			printf("\n");
+		}
+	}
+
+###### free const decls
+	free_binode(context.constlist);
+
 ### Function declarations
 
 The code in an Ocean program is all stored in function declarations.