X-Git-Url: https://ocean-lang.org/code/?p=ocean;a=blobdiff_plain;f=csrc%2Foceani.mdc;h=f257736edc328baf8ba313d28f3bd7826e4e5004;hp=3aa170bd28978a117f7dc27603339437a37727ca;hb=17b2c8c16fd6dadf052fefc20e2ee8c7f8c3da0b;hpb=6526e62830ba607ffd914cfc44e2bb90c5405f86

diff --git a/csrc/oceani.mdc b/csrc/oceani.mdc
index 3aa170b..f257736 100644
--- a/csrc/oceani.mdc
+++ b/csrc/oceani.mdc
@@ -114,7 +114,6 @@ structures can be used.
 		struct token_config config;
 		char *file_name;
 		int parse_error;
-		struct exec *prog;
 		## parse context
 	};
 
@@ -243,24 +242,18 @@ structures can be used.
 
 		parse_oceani(ss->code, &context.config, dotrace ? stderr : NULL);
 
-		if (!context.prog) {
-			fprintf(stderr, "oceani: no main function found.\n");
+		if (!context.parse_error && !analyse_funcs(&context)) {
+			fprintf(stderr, "oceani: type error in program - not running.\n");
 			context.parse_error = 1;
 		}
-		if (context.prog && !context.parse_error) {
-			if (!analyse_prog(context.prog, &context)) {
-				fprintf(stderr, "oceani: type error in program - not running.\n");
-				context.parse_error = 1;
-			}
-		}
-		if (context.prog && doprint) {
+
+		if (doprint) {
 			## print const decls
 			## print type decls
-			print_exec(context.prog, 0, brackets);
+			## print func decls
 		}
-		if (context.prog && doexec && !context.parse_error)
-			interp_prog(&context, context.prog, argc - optind, argv+optind);
-		free_exec(context.prog);
+		if (doexec && !context.parse_error)
+			interp_main(&context, argc - optind, argv + optind);
 
 		while (s) {
 			struct section *t = s->next;
@@ -268,7 +261,9 @@ structures can be used.
 			free(s);
 			s = t;
 		}
-		## free global vars
+		if (!context.parse_error) {
+			## free global vars
+		}
 		## free context types
 		## free context storage
 		exit(context.parse_error ? 1 : 0);
@@ -365,6 +360,9 @@ context so indicate that parsing failed.
 ###### forward decls
 
 	static void fput_loc(struct exec *loc, FILE *f);
+	static void type_err(struct parse_context *c,
+	                     char *fmt, struct exec *loc,
+	                     struct type *t1, int rules, struct type *t2);
 
 ###### core functions
 
@@ -1212,7 +1210,7 @@ all pending-scope variables become conditionally scoped.
 				 */
 				continue;
 			v->min_depth = c->scope_depth;
-			if (v->scope == InScope) {
+			if (v->scope == InScope && e) {
 				/* This variable gets cleaned up when 'e' finishes */
 				variable_unlink_exec(v);
 				v->cleanup_exec = e;
@@ -1349,7 +1347,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);	// UNTESTED
+			c->global_size = (c->global_size + t->align) & ~(t->align-1);
 		if (!v) {
 			v = &scratch;
 			v->type = t;
@@ -1370,14 +1368,15 @@ As global values are found -- struct field initializers, labels etc --
 
 When the program is fully parsed, we need to walk the list of variables
 to find any that weren't merged away and that aren't global, and to
-calculate the frame size and assign a frame position for each variable.
-For this we have `scope_finalize()`.
+calculate the frame size and assign a frame position for each
+variable.  For this we have `scope_finalize()`.
 
 ###### ast functions
 
-	static void scope_finalize(struct parse_context *c)
+	static int scope_finalize(struct parse_context *c)
 	{
 		struct binding *b;
+		int size = 0;
 
 		for (b = c->varlist; b; b = b->next) {
 			struct variable *v;
@@ -1387,18 +1386,19 @@ For this we have `scope_finalize()`.
 					continue;
 				if (v->global)
 					continue;
-				if (c->local_size & (t->align - 1))
-					c->local_size = (c->local_size + t->align) & ~(t->align-1);
-				v->frame_pos = c->local_size;
-				c->local_size += v->type->size;
+				if (!t)
+					continue;
+				if (size & (t->align - 1))
+					size = (size + t->align) & ~(t->align-1);
+				v->frame_pos = size;
+				size += v->type->size;
 			}
 		}
-		c->local = calloc(1, c->local_size);
+		return size;
 	}
 
 ###### free context storage
 	free(context.global);
-	free(context.local);
 
 ### Executables
 
@@ -1462,12 +1462,12 @@ from the `exec_types` enum.
 		if (loc->type == Xbinode)
 			return __fput_loc(cast(binode,loc)->left, f) ||
 			       __fput_loc(cast(binode,loc)->right, f);	// NOTEST
-		return 0;			// NOTEST
+		return 0;
 	}
 	static void fput_loc(struct exec *loc, FILE *f)
 	{
 		if (!__fput_loc(loc, f))
-			fprintf(f, "??:??: ");	// NOTEST
+			fprintf(f, "??:??: ");
 	}
 
 Each different type of `exec` node needs a number of functions defined,
@@ -1520,7 +1520,7 @@ also want to know what sort of bracketing to use.
 
 	static void do_indent(int i, char *str)
 	{
-		while (i--)
+		while (i-- > 0)
 			printf("    ");
 		printf("%s", str);
 	}
@@ -1583,10 +1583,11 @@ propagation is needed.
 			fputs(" (labels not permitted)", stderr);
 		break;
 
-###### core functions
-
+###### forward decls
 	static struct type *propagate_types(struct exec *prog, struct parse_context *c, int *ok,
 	                                    struct type *type, int rules);
+###### core functions
+
 	static struct type *__propagate_types(struct exec *prog, struct parse_context *c, int *ok,
 	                                      struct type *type, int rules)
 	{
@@ -1817,7 +1818,7 @@ with a const size by whether they are prepared at parse time or not.
 	static int array_compat(struct type *require, struct type *have)
 	{
 		if (have->compat != require->compat)
-			return 0;	// UNTESTED
+			return 0;
 		/* Both are arrays, so we can look at details */
 		if (!type_compat(require->array.member, have->array.member, 0))
 			return 0;
@@ -2316,7 +2317,7 @@ function will be needed.
 		while (target != 0) {
 			int i = 0;
 			for (t = context.typelist; t ; t=t->next)
-				if (t->print_type_decl) {
+				if (t->print_type_decl && !t->check_args) {
 					i += 1;
 					if (i == target)
 						break;
@@ -2331,16 +2332,13 @@ function will be needed.
 		}
 	}
 
-### Functions
-
-A function is a named chunk of code which can be passed parameters and
-can return results.  Each function has an implicit type which includes
-the set of parameters and the return value.  As yet these types cannot
-be declared separate from the function itself.
+#### Functions
 
-In fact, only one function is currently possible - `main`.  `main` is
-passed an array of strings together with the size of the array, and
-doesn't return anything.  The strings are command line arguments.
+A function is a chunk of code which can be passed parameters and can
+return results (though results are not yet implemented).  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 list, such as
 
@@ -2361,39 +2359,126 @@ or as an indented list of one parameter per line
 For constructing these lists we use a `List` binode, which will be
 further detailed when Expression Lists are introduced.
 
+###### type union fields
+
+	struct {
+		struct binode *params;
+		int local_size;
+	} function;
+
+###### value union fields
+	struct exec *function;
+
+###### type functions
+	void (*check_args)(struct parse_context *c, int *ok,
+	                   struct type *require, struct exec *args);
+
+###### value functions
+
+	static void function_free(struct type *type, struct value *val)
+	{
+		free_exec(val->function);
+		val->function = NULL;
+	}
+
+	static int function_compat(struct type *require, struct type *have)
+	{
+		// FIXME can I do anything here yet?
+		return 0;
+	}
+
+	static void function_check_args(struct parse_context *c, int *ok,
+	                                struct type *require, struct exec *args)
+	{
+		/* This should be 'compat', but we don't have a 'tuple' type to
+		 * hold the type of 'args'
+		 */
+		struct binode *arg = cast(binode, args);
+		struct binode *param = require->function.params;
+
+		while (param) {
+			struct var *pv = cast(var, param->left);
+			if (!arg) {
+				type_err(c, "error: insufficient arguments to function.",
+					 args, NULL, 0, NULL);
+				break;
+			}
+			*ok = 1;
+			propagate_types(arg->left, c, ok, pv->var->type, 0);
+			param = cast(binode, param->right);
+			arg = cast(binode, arg->right);
+		}
+		if (arg)
+			type_err(c, "error: too many arguments to function.",
+				 args, NULL, 0, NULL);
+	}
+
+	static void function_print(struct type *type, struct value *val)
+	{
+		print_exec(val->function, 1, 0);
+	}
+
+	static void function_print_type_decl(struct type *type, FILE *f)
+	{
+		struct binode *b;
+		fprintf(f, "(");
+		for (b = type->function.params; b; b = cast(binode, b->right)) {
+			struct variable *v = cast(var, b->left)->var;
+			fprintf(f, "%.*s%s", v->name->name.len, v->name->name.txt,
+			        v->constant ? "::" : ":");
+			type_print(v->type, f);
+			if (b->right)
+				fprintf(f, "; ");
+		}
+		fprintf(f, ")\n");
+	}
+
+	static void function_free_type(struct type *t)
+	{
+		free_exec(t->function.params);
+	}
+
+	static struct type function_prototype = {
+		.size = sizeof(void*),
+		.align = sizeof(void*),
+		.free = function_free,
+		.compat = function_compat,
+		.check_args = function_check_args,
+		.print = function_print,
+		.print_type_decl = function_print_type_decl,
+		.free_type = function_free_type,
+	};
+
+###### declare terminals
+
+	$TERM func
+
 ###### Binode types
-	Func, List,
+	List,
 
 ###### Grammar
 
-	$TERM func main
+	$*variable
+	FuncName -> IDENTIFIER ${ {
+			struct variable *v = var_decl(c, $1.txt);
+			struct var *e = new_pos(var, $1);
+			e->var = v;
+			if (v) {
+				v->where_decl = e;
+				$0 = v;
+			} else {
+				v = var_ref(c, $1.txt);
+				e->var = v;
+				type_err(c, "error: function '%v' redeclared",
+					e, NULL, 0, NULL);
+				type_err(c, "info: this is where '%v' was first declared",
+					v->where_decl, NULL, 0, NULL);
+				free_exec(e);
+			}
+		} }$
 
-	$*binode
-	MainFunction -> func main ( OpenScope Args ) Block Newlines ${
-			$0 = new(binode);
-			$0->op = Func;
-			$0->left = reorder_bilist($<Ar);
-			$0->right = $<Bl;
-			var_block_close(c, CloseSequential, $0);
-			if (c->scope_stack && !c->parse_error) abort();
-		}$
-		| func main IN OpenScope OptNL Args OUT OptNL do Block Newlines ${
-			$0 = new(binode);
-			$0->op = Func;
-			$0->left = reorder_bilist($<Ar);
-			$0->right = $<Bl;
-			var_block_close(c, CloseSequential, $0);
-			if (c->scope_stack && !c->parse_error) abort();
-		}$
-		| func main NEWLINE OpenScope OptNL do Block Newlines ${
-			$0 = new(binode);
-			$0->op = Func;
-			$0->left = NULL;
-			$0->right = $<Bl;
-			var_block_close(c, CloseSequential, $0);
-			if (c->scope_stack && !c->parse_error) abort();
-		}$
 
+	$*binode
 	Args -> ${ $0 = NULL; }$
 		| Varlist ${ $0 = $<1; }$
 		| Varlist ; ${ $0 = $<1; }$
@@ -2684,7 +2769,7 @@ link to find the primary instance.
 			} else
 				fputs("???", stderr);	// NOTEST
 		} else
-			fputs("NOTVAR", stderr);	// NOTEST
+			fputs("NOTVAR", stderr);
 		break;
 
 ###### propagate exec cases
@@ -3128,7 +3213,7 @@ expression operator, and the `CMPop` non-terminal will match one of them.
 		break;
 	}
 
-### Expressions: The rest
+### Expressions: Arithmetic etc.
 
 The remaining expressions with the highest precedence are arithmetic,
 string concatenation, and string conversion.  String concatenation
@@ -3192,6 +3277,8 @@ should only insert brackets were needed for precedence.
 		| Value ${ $0 = $<1; }$
 		| Variable ${ $0 = $<1; }$
 
+###### Grammar
+
 	$eop
 	Eop ->    + ${ $0.op = Plus; }$
 		| - ${ $0.op = Minus; }$
@@ -3372,6 +3459,110 @@ should only insert brackets were needed for precedence.
 		return rv;
 	}
 
+### Function calls
+
+A function call can appear either as an expression or as a statement.
+As functions cannot yet return values, only the statement version will work.
+We use a new 'Funcall' binode type to link the function with a list of
+arguments, form with the 'List' nodes.
+
+###### Binode types
+	Funcall,
+
+###### expression grammar
+	| Variable ( ExpressionList ) ${ {
+		struct binode *b = new(binode);
+		b->op = Funcall;
+		b->left = $<V;
+		b->right = reorder_bilist($<EL);
+		$0 = b;
+	} }$
+	| Variable ( ) ${ {
+		struct binode *b = new(binode);
+		b->op = Funcall;
+		b->left = $<V;
+		b->right = NULL;
+		$0 = b;
+	} }$
+
+###### SimpleStatement Grammar
+
+	| Variable ( ExpressionList ) ${ {
+		struct binode *b = new(binode);
+		b->op = Funcall;
+		b->left = $<V;
+		b->right = reorder_bilist($<EL);
+		$0 = b;
+	} }$
+
+###### print binode cases
+
+	case Funcall:
+		do_indent(indent, "");
+		print_exec(b->left, -1, bracket);
+		printf("(");
+		for (b = cast(binode, b->right); b; b = cast(binode, b->right)) {
+			if (b->left) {
+				printf(" ");
+				print_exec(b->left, -1, bracket);
+				if (b->right)
+					printf(",");
+			}
+		}
+		printf(")");
+		if (indent >= 0)
+			printf("\n");
+		break;
+
+###### propagate binode cases
+
+	case Funcall: {
+		/* Every arg must match formal parameter, and result
+		 * is return type of function (currently Tnone).
+		 */
+		struct binode *args = cast(binode, b->right);
+		struct var *v = cast(var, b->left);
+
+		if (!v->var->type || v->var->type->check_args == NULL) {
+			type_err(c, "error: attempt to call a non-function.",
+				 prog, NULL, 0, NULL);
+			return NULL;
+		}
+		v->var->type->check_args(c, ok, v->var->type, args);
+		return Tnone;
+	}
+
+###### interp binode cases
+
+	case Funcall: {
+		struct var *v = cast(var, b->left);
+		struct type *t = v->var->type;
+		void *oldlocal = c->local;
+		int old_size = c->local_size;
+		void *local = calloc(1, t->function.local_size);
+		struct value *fbody = var_value(c, v->var);
+		struct binode *arg = cast(binode, b->right);
+		struct binode *param = t->function.params;
+
+		while (param) {
+			struct var *pv = cast(var, param->left);
+			struct type *vtype = NULL;
+			struct value val = interp_exec(c, arg->left, &vtype);
+			struct value *lval;
+			c->local = local; c->local_size = t->function.local_size;
+			lval = var_value(c, pv->var);
+			c->local = oldlocal; c->local_size = old_size;
+			memcpy(lval, &val, vtype->size);
+			param = cast(binode, param->right);
+			arg = cast(binode, arg->right);
+		}
+		c->local = local; c->local_size = t->function.local_size;
+		right = interp_exec(c, fbody->function, &rtype);
+		c->local = oldlocal; c->local_size = old_size;
+		free(local);
+		break;
+	}
+
 ### Blocks, Statements, and Statement lists.
 
 Now that we have expressions out of the way we need to turn to
@@ -4473,7 +4664,7 @@ searching through for the Nth constant for decreasing N.
 		while (target != 0) {
 			int i = 0;
 			for (v = context.in_scope; v; v=v->in_scope)
-				if (v->depth == 0) {
+				if (v->depth == 0 && v->constant) {
 					i += 1;
 					if (i == target)
 						break;
@@ -4499,11 +4690,12 @@ searching through for the Nth constant for decreasing N.
 		}
 	}
 
-### Finally the whole `main` function.
+### Function declarations
+
+The code in an Ocean program is all stored in function declarations.
+One of the functions must be named `main` and it must accept an array of
+strings as a parameter - the command line arguments.
 
-An Ocean program can currently have only one function - `main` - and
-that must exist.  It expects an array of strings with a provided size.
-Following this is a `block` which is the code to execute.
 
 As this is the top level, several things are handled a bit
 differently.
@@ -4513,55 +4705,112 @@ analysis is a bit more interesting at this level.
 
 ###### top level grammar
 
-	DeclareFunction -> MainFunction ${ {
-		if (c->prog)
-			type_err(c, "\"main\" defined a second time",
-			         $1, NULL, 0, NULL);
-		else
-			c->prog = $<1;
-	} }$
+	$*variable
+	DeclareFunction -> func FuncName ( OpenScope Args ) Block Newlines ${ {
+			struct text funcname = { " func", 5};
+			$0 = $<FN;
+			if ($0) {
+				struct value fn = {.function = $<Bl};
+				$0->type = add_type(c, funcname, &function_prototype);
+				$0->type->function.params = reorder_bilist($<Ar);
+				global_alloc(c, $0->type, $0, &fn);
+				var_block_close(c, CloseSequential, fn.function);
+			} else
+				var_block_close(c, CloseSequential, NULL);
+		} }$
+		| func FuncName then IN OpenScope OptNL Args OUT OptNL do Block Newlines ${ {
+			// FIXME that 'then' should not be there.
+			struct text funcname = { " func", 5};
+			$0 = $<FN;
+			if ($0) {
+				struct value fn = {.function = $<Bl};
+				$0->type = add_type(c, funcname, &function_prototype);
+				$0->type->function.params = reorder_bilist($<Ar);
+				global_alloc(c, $0->type, $0, &fn);
+				var_block_close(c, CloseSequential, fn.function);
+			} else
+				var_block_close(c, CloseSequential, NULL);
+		} }$
+		| func FuncName NEWLINE OpenScope OptNL do Block Newlines ${ {
+			struct text funcname = { " func", 5};
+			$0 = $<FN;
+			if ($0) {
+				struct value fn = {.function = $<Bl};
+				$0->type = add_type(c, funcname, &function_prototype);
+				$0->type->function.params = NULL;
+				global_alloc(c, $0->type, $0, &fn);
+				var_block_close(c, CloseSequential, fn.function);
+			} else
+				var_block_close(c, CloseSequential, NULL);
+		} }$
 
-###### print binode cases
-	case Func:
-		do_indent(indent, "func main(");
-		for (b2 = cast(binode, b->left); b2; b2 = cast(binode, b2->right)) {
-			struct variable *v = cast(var, b2->left)->var;
-			printf(" ");
-			print_exec(b2->left, 0, 0);
-			printf(":");
-			type_print(v->type, stdout);
-		}
-		if (bracket)
-			printf(") {\n");
-		else
-			printf(")\n");
-		print_exec(b->right, indent+1, bracket);
-		if (bracket)
-			do_indent(indent, "}\n");
-		break;
+###### print func decls
+	{
+		struct variable *v;
+		int target = -1;
 
-###### propagate binode cases
-	case Func: abort();		// NOTEST
+		while (target != 0) {
+			int i = 0;
+			for (v = context.in_scope; v; v=v->in_scope)
+				if (v->depth == 0 && v->type && v->type->check_args) {
+					i += 1;
+					if (i == target)
+						break;
+				}
+
+			if (target == -1) {
+				target = i;
+			} else {
+				struct value *val = var_value(&context, v);
+				printf("func %.*s", v->name->name.len, v->name->name.txt);
+				v->type->print_type_decl(v->type, stdout);
+				if (brackets)
+					print_exec(val->function, 0, brackets);
+				else
+					print_value(v->type, val);
+				printf("/* frame size %d */\n", v->type->function.local_size);
+				target -= 1;
+			}
+		}
+	}
 
 ###### core functions
 
-	static int analyse_prog(struct exec *prog, struct parse_context *c)
+	static int analyse_funcs(struct parse_context *c)
 	{
-		struct binode *bp = cast(binode, prog);
+		struct variable *v;
+		int ok = 1;
+		for (v = c->in_scope; ok && v; v = v->in_scope) {
+			struct value *val;
+			if (v->depth != 0 || !v->type || !v->type->check_args)
+				continue;
+			val = var_value(c, v);
+			do {
+				ok = 1;
+				propagate_types(val->function, c, &ok, Tnone, 0);
+			} while (ok == 2);
+			if (ok)
+				/* Make sure everything is still consistent */
+				propagate_types(val->function, c, &ok, Tnone, 0);
+			v->type->function.local_size = scope_finalize(c);
+		}
+		return ok;
+	}
+
+	static int analyse_main(struct type *type, struct parse_context *c)
+	{
+		struct binode *bp = type->function.params;
 		struct binode *b;
 		int ok = 1;
 		int arg = 0;
 		struct type *argv_type;
 		struct text argv_type_name = { " argv", 5 };
 
-		if (!bp)
-			return 0;	// NOTEST
-
 		argv_type = add_type(c, argv_type_name, &array_prototype);
 		argv_type->array.member = Tstr;
 		argv_type->array.unspec = 1;
 
-		for (b = cast(binode, bp->left); b; b = cast(binode, b->right)) {
+		for (b = bp; b; b = cast(binode, b->right)) {
 			ok = 1;
 			switch (arg++) {
 			case 0: /* argv */
@@ -4570,35 +4819,40 @@ analysis is a bit more interesting at this level.
 			default: /* invalid */	// NOTEST
 				propagate_types(b->left, c, &ok, Tnone, 0);	// NOTEST
 			}
+			if (!ok)
+				c->parse_error = 1;
 		}
 
-		do {
-			ok = 1;
-			propagate_types(bp->right, c, &ok, Tnone, 0);
-		} while (ok == 2);
-		if (!ok)
-			return 0;
-
-		/* Make sure everything is still consistent */
-		propagate_types(bp->right, c, &ok, Tnone, 0);
-		if (!ok)
-			return 0;	// UNTESTED
-		scope_finalize(c);
-		return 1;
+		return !c->parse_error;
 	}
 
-	static void interp_prog(struct parse_context *c, struct exec *prog, 
-				int argc, char **argv)
+	static void interp_main(struct parse_context *c, int argc, char **argv)
 	{
-		struct binode *p = cast(binode, prog);
+		struct value *progp = NULL;
+		struct text main_name = { "main", 4 };
+		struct variable *mainv;
 		struct binode *al;
 		int anum = 0;
 		struct value v;
 		struct type *vtype;
 
-		if (!prog)
-			return;		// NOTEST
-		al = cast(binode, p->left);
+		mainv = var_ref(c, main_name);
+		if (mainv)
+			progp = var_value(c, mainv);
+		if (!progp || !progp->function) {
+			fprintf(stderr, "oceani: no main function found.\n");
+			c->parse_error = 1;
+			return;
+		}
+		if (!analyse_main(mainv->type, c)) {
+			fprintf(stderr, "oceani: main has wrong type.\n");
+			c->parse_error = 1;
+			return;
+		}
+		al = mainv->type->function.params;
+
+		c->local_size = mainv->type->function.local_size;
+		c->local = calloc(1, c->local_size);
 		while (al) {
 			struct var *v = cast(var, al->left);
 			struct value *vl = var_value(c, v->var);
@@ -4628,14 +4882,16 @@ analysis is a bit more interesting at this level.
 			}
 			al = cast(binode, al->right);
 		}
-		v = interp_exec(c, p, &vtype);
+		v = interp_exec(c, progp->function, &vtype);
 		free_value(vtype, &v);
+		free(c->local);
+		c->local = NULL;
 	}
 
-###### interp binode cases
-	case Func:
-		rv = interp_exec(c, b->right, &rvtype);
-		break;
+###### ast functions
+	void free_variable(struct variable *v)
+	{
+	}
 
 ## And now to test it out.
 
@@ -4665,9 +4921,7 @@ things which will likely grow as the languages grows.
 		name:string
 		alive:Boolean
 
-	func main
-		argv:[argc::]string
-	do
+	func main(argv:[argc::]string)
 		print "Hello World, what lovely oceans you have!"
 		print "Are there", five, "?"
 		print pi, pie, "but", cake