X-Git-Url: https://ocean-lang.org/code/?a=blobdiff_plain;f=csrc%2Foceani.mdc;h=ebb69ade3d2a32f40e0e3666ed6416cf8d2cc4e9;hb=217a763da640550da7645c75adc0cd8424f6c452;hp=460e75ed103b1648c0c3947432cec801be07a1fa;hpb=5c5bce5b10dc2476374aea8264115089e713ca57;p=ocean

diff --git a/csrc/oceani.mdc b/csrc/oceani.mdc
index 460e75e..ebb69ad 100644
--- a/csrc/oceani.mdc
+++ b/csrc/oceani.mdc
@@ -109,6 +109,8 @@ option.
 	## ast
 	struct parse_context {
 		struct token_config config;
+		char *file_name;
+		int parse_error;
 		## parse context
 	};
 
@@ -197,6 +199,7 @@ option.
 			fprintf(stderr, "oceani: cannot open %s\n", argv[optind]);
 			exit(1);
 		}
+		context.file_name = argv[optind];
 		len = lseek(fd, 0, 2);
 		file = mmap(NULL, len, PROT_READ, MAP_SHARED, fd, 0);
 		s = code_extract(file, file+len, NULL);
@@ -224,11 +227,15 @@ option.
 		} else
 			prog = parse_oceani(s->code, &context.config,
 		                    dotrace ? stderr : NULL);
+		if (!prog) {
+			fprintf(stderr, "oceani: fatal parser error.\n");
+			context.parse_error = 1;
+		}
 		if (prog && doprint)
 			print_exec(*prog, 0, brackets);
-		if (prog && doexec) {
+		if (prog && doexec && !context.parse_error) {
 			if (!analyse_prog(*prog, &context)) {
-				fprintf(stderr, "oceani: type error in program\n");
+				fprintf(stderr, "oceani: type error in program - not running.\n");
 				exit(1);
 			}
 			interp_prog(*prog, argv+optind+1);
@@ -244,7 +251,7 @@ option.
 			s = t;
 		}
 		## free context
-		exit(0);
+		exit(context.parse_error ? 1 : 0);
 	}
 
 ### Analysis
@@ -290,10 +297,90 @@ These names are given a type of "label" and a unique value.
 This allows them to fill the role of a name in an enumerated type, which
 is useful for testing the `switch` statement.
 
+As we will see, the condition part of a `while` statement can return
+either a Boolean or some other type.  This requires that the expect
+type that gets passed around comprises a type (`enum vtype`) and a
+flag to indicate that `Vbool` is also permitted.
+
 As there are, as yet, no distinct types that are compatible, there
-isn't much subtlety in the analysis.  When we hav distinct number
+isn't much subtlety in the analysis.  When we have distinct number
 types, this will become more interesting.
 
+#### Error reporting
+
+When analysis discovers an inconsistency it needs to report an error;
+just refusing to run the code esure that the error doesn't cascade,
+but by itself it isn't very useful.  A clear understand of the sort of
+error message that are useful will help guide the process of analysis.
+
+At a simplistic level, the only sort of error that type analysis can
+report is that the type of some construct doesn't match a contextual
+requirement.  For example, in `4 + "hello"` the addition provides a
+contextual requirement for numbers, but `"hello"` is not a number.  In
+this particular example no further information is needed as the types
+are obvious from local information.  When a variable is involved that
+isn't the case.  It may be helpful to explain why the variable has a
+particular type, by indicating the location where the type was set,
+whether by declaration or usage.
+
+Using a recursive-descent analysis we can easily detect a problem at
+multiple locations. In "`hello:= "there"; 4 + hello`" the addition
+will detect that one argument is not a number and the usage of `hello`
+will detect that a number was wanted, but not provided.  In this
+(early) version of the language, we will generate error reports at
+multiple locations, to the use of `hello` will report an error and
+explain were the value was set, and the addition will report an error
+and say why numbers are needed.  To be able to report locations for
+errors, each language element will need to record a file location
+(line and column) and each variable will need to record the language
+element where its type was set.  For now we will assume that each line
+of an error message indicates one location in the file, and up to 2
+types.  So we provide a `printf`-like function which takes a format, a
+language (a `struct exec` which has not yet been introduced), and 2
+types. "`$1`" reports the first type, "`$2`" reports the second.  We
+will need a function to print the location, once we know how that is
+stored.
+
+###### forward decls
+
+	static void fput_loc(struct exec *loc, FILE *f);
+
+###### core functions
+
+	static void type_err(struct parse_context *c,
+	                     char *fmt, struct exec *loc,
+	                     enum vtype t1, enum vtype t2)
+	{
+		fprintf(stderr, "%s:", c->file_name);
+		fput_loc(loc, stderr);
+		for (; *fmt ; fmt++) {
+			if (*fmt != '%') {
+				fputc(*fmt, stderr);
+				continue;
+			}
+			fmt++;
+			switch (*fmt) {
+			case '%': fputc(*fmt, stderr); break;
+			default: fputc('?', stderr); break;
+			case '1':
+				fputs(vtype_names[t1], stderr);
+				break;
+			case '2':
+				fputs(vtype_names[t2], stderr);
+				break;
+			## format cases
+			}
+		}
+		fputs("\n", stderr);
+		c->parse_error = 1;
+	}
+
+	static void tok_err(struct parse_context *c, char *fmt, struct token *t)
+	{
+		fprintf(stderr, "%s:%d:%d: %s\n", c->file_name, t->line, t->col, fmt);
+		c->parse_error = 1;
+	}
+
 ## Data Structures
 
 One last introductory step before detailing the language elements and
@@ -350,6 +437,9 @@ to parse each type from a string.
 		char tail[2];
 	};
 
+	char *vtype_names[] = {"nolabel", "unknown", "none", "string",
+	                       "number", "Boolean", "label"};
+
 ###### ast functions
 	static void free_value(struct value v)
 	{
@@ -364,8 +454,10 @@ to parse each type from a string.
 		}
 	}
 
-	static int vtype_compat(enum vtype require, enum vtype have)
+	static int vtype_compat(enum vtype require, enum vtype have, int bool_permitted)
 	{
+		if (bool_permitted && have == Vbool)
+			return 1;
 		switch (require) {
 		case Vnolabel:
 			return have != Vlabel;
@@ -577,6 +669,8 @@ cannot nest, so a declaration while a name is in-scope is an error.
 		struct variable *previous;
 		struct value val;
 		struct binding *name;
+		struct exec *where_decl;// where name was declared
+		struct exec *where_set;	// where type was set
 		## variable fields
 	};
 
@@ -808,7 +902,7 @@ all pending-scope variables become conditionally scoped.
 
 		switch (v ? v->scope : OutScope) {
 		case InScope:
-			/* Signal error ... once I build error signalling support */
+			/* Caller will report the error */
 			return NULL;
 		case CondScope:
 			for (;
@@ -953,9 +1047,16 @@ subclasses, and to access these we need to be able to `cast` the
 		if (__mptr && *__mptr != X##structname) abort();		\
 		(struct structname *)( (char *)__mptr);})
 
-	#define new(structname) ({			\
+	#define new(structname) ({						\
 		struct structname *__ptr = ((struct structname *)calloc(1,sizeof(struct structname))); \
-		__ptr->type = X##structname;		\
+		__ptr->type = X##structname;						\
+		__ptr->line = -1; __ptr->column = -1;					\
+		__ptr;})
+
+	#define new_pos(structname, token) ({						\
+		struct structname *__ptr = ((struct structname *)calloc(1,sizeof(struct structname))); \
+		__ptr->type = X##structname;						\
+		__ptr->line = token.line; __ptr->column = token.col;			\
 		__ptr;})
 
 ###### ast
@@ -965,6 +1066,7 @@ subclasses, and to access these we need to be able to `cast` the
 	};
 	struct exec {
 		enum exec_types type;
+		int line, column;
 	};
 	struct binode {
 		struct exec;
@@ -974,6 +1076,25 @@ subclasses, and to access these we need to be able to `cast` the
 		struct exec *left, *right;
 	};
 
+###### ast functions
+
+	static int __fput_loc(struct exec *loc, FILE *f)
+	{
+		if (loc->line >= 0) {
+			fprintf(f, "%d:%d: ", loc->line, loc->column);
+			return 1;
+		}
+		if (loc->type == Xbinode)
+			return __fput_loc(cast(binode,loc)->left, f) ||
+			       __fput_loc(cast(binode,loc)->right, f);
+		return 0;
+	}
+	static void fput_loc(struct exec *loc, FILE *f)
+	{
+		if (!__fput_loc(loc, f))
+			fprintf(f, "??:??: ");
+	}
+
 Each different type of `exec` node needs a number of functions
 defined, a bit like methods.  We must be able to be able to free it,
 print it, analyse it and execute it.  Once we have specific `exec`
@@ -1041,6 +1162,8 @@ also want to know what sort of bracketing to use.
 
 	static void print_exec(struct exec *e, int indent, int bracket)
 	{
+		if (!e)
+			return;
 		switch (e->type) {
 		case Xbinode:
 			print_binode(cast(binode, e), indent, bracket); break;
@@ -1057,16 +1180,17 @@ also want to know what sort of bracketing to use.
 As discussed, analysis involves propagating type requirements around
 the program and looking for errors.
 
-So `propagate_types` is passed a type that the `exec` is expected to return,
-and returns the type that it does return, either of which can be `Vunknown`.
-An `ok` flag is passed by reference. It is set to `0` when an error is
-found, and `2` when any change is made.  If it remains unchanged at
-`1`, then no more propagation is needed.
+So `propagate_types` is passed an expected type (being a `vtype`
+together with a `bool_permitted` flag) that the `exec` is expected to
+return, and returns the type that it does return, either of which can
+be `Vunknown`.  An `ok` flag is passed by reference. It is set to `0`
+when an error is found, and `2` when any change is made.  If it
+remains unchanged at `1`, then no more propagation is needed.
 
 ###### core functions
 
-	static enum vtype propagate_types(struct exec *prog, enum vtype type,
-					  int *ok)
+	static enum vtype propagate_types(struct exec *prog, struct parse_context *c, int *ok,
+	                                  enum vtype type, int bool_permitted)
 	{
 		enum vtype t;
 
@@ -1149,30 +1273,39 @@ an executable.
 
 	$*val
 	Value ->  True ${
-			$0 = new(val);
+			$0 = new_pos(val, $1);
 			$0->val.vtype = Vbool;
 			$0->val.bool = 1;
 			}$
 		| False ${
-			$0 = new(val);
+			$0 = new_pos(val, $1);
 			$0->val.vtype = Vbool;
 			$0->val.bool = 0;
 			}$
 		| NUMBER ${
-			$0 = new(val);
+			$0 = new_pos(val, $1);
 			$0->val.vtype = Vnum;
 			if (number_parse($0->val.num, $0->val.tail, $1.txt) == 0)
 				mpq_init($0->val.num);
+				if ($0->val.tail[0])
+					tok_err(config2context(config), "error: unsupported number suffix.",
+					        &$1);
 			}$
 		| STRING ${
-			$0 = new(val);
+			$0 = new_pos(val, $1);
 			$0->val.vtype = Vstr;
 			string_parse(&$1, '\\', &$0->val.str, $0->val.tail);
+			if ($0->val.tail[0])
+				tok_err(config2context(config), "error: unsupported string suffix.",
+				        &$1);
 			}$
 		| MULTI_STRING ${
-			$0 = new(val);
+			$0 = new_pos(val, $1);
 			$0->val.vtype = Vstr;
 			string_parse(&$1, '\\', &$0->val.str, $0->val.tail);
+			if ($0->val.tail[0])
+				tok_err(config2context(config), "error: unsupported string suffix.",
+				        &$1);
 			}$
 
 ###### print exec cases
@@ -1191,8 +1324,11 @@ an executable.
 		case Xval:
 		{
 			struct val *val = cast(val, prog);
-			if (!vtype_compat(type, val->val.vtype))
+			if (!vtype_compat(type, val->val.vtype, bool_permitted)) {
+				type_err(c, "error: expected %1 found %2",
+				           prog, type, val->val.vtype);
 				*ok = 0;
+			}
 			return val->val.vtype;
 		}
 
@@ -1256,25 +1392,47 @@ link to find the primary instance.
 	$*var
 	VariableDecl -> IDENTIFIER := ${ {
 		struct variable *v = var_decl(config2context(config), $1.txt);
-		$0 = new(var);
+		$0 = new_pos(var, $1);
 		$0->var = v;
+		if (v)
+			v->where_decl = $0;
+		else {
+			v = var_ref(config2context(config), $1.txt);
+			$0->var = v;
+			type_err(config2context(config), "error: variable '%v' redeclared",
+			         $0, Vnone, Vnone);
+			type_err(config2context(config), "info: this is where '%v' was first declared",
+			         v->where_decl, Vnone, Vnone);
+		}
 	} }$
 	    | IDENTIFIER ::= ${ {
 		struct variable *v = var_decl(config2context(config), $1.txt);
-		v->constant = 1;
-		$0 = new(var);
+		$0 = new_pos(var, $1);
 		$0->var = v;
+		if (v) {
+			v->where_decl = $0;
+			v->constant = 1;
+		} else {
+			v = var_ref(config2context(config), $1.txt);
+			$0->var = v;
+			type_err(config2context(config), "error: variable '%v' redeclared",
+			         $0, Vnone, Vnone);
+			type_err(config2context(config), "info: this is where '%v' was first declared",
+			         v->where_decl, Vnone, Vnone);
+		}
 	} }$
 
 	Variable -> IDENTIFIER ${ {
 		struct variable *v = var_ref(config2context(config), $1.txt);
+		$0 = new_pos(var, $1);
 		if (v == NULL) {
 			/* This might be a label - allocate a var just in case */
 			v = var_decl(config2context(config), $1.txt);
-			if (v)
+			if (v) {
 				val_init(&v->val, Vlabel);
+				v->where_set = $0;
+			}
 		}
-		$0 = new(var);
 		$0->var = v;
 	} }$
 
@@ -1289,6 +1447,19 @@ link to find the primary instance.
 		break;
 	}
 
+###### format cases
+	case 'v':
+		if (loc->type == Xvar) {
+			struct var *v = cast(var, loc);
+			if (v->var) {
+				struct binding *b = v->var->name;
+				fprintf(stderr, "%.*s", b->name.len, b->name.txt);
+			} else
+				fputs("???", stderr);
+		} else
+			fputs("NOTVAR", stderr);
+		break;
+
 ###### propagate exec cases
 
 	case Xvar:
@@ -1296,6 +1467,7 @@ link to find the primary instance.
 		struct var *var = cast(var, prog);
 		struct variable *v = var->var;
 		if (!v) {
+			type_err(c, "%d:BUG: no variable!!", prog, Vnone, Vnone);
 			*ok = 0;
 			return Vnone;
 		}
@@ -1304,12 +1476,18 @@ link to find the primary instance.
 		if (v->val.vtype == Vunknown) {
 			if (type > Vunknown && *ok != 0) {
 				val_init(&v->val, type);
+				v->where_set = prog;
 				*ok = 2;
 			}
 			return type;
 		}
-		if (!vtype_compat(type, v->val.vtype))
+		if (!vtype_compat(type, v->val.vtype, bool_permitted)) {
+			type_err(c, "error: expected %1 but variable '%v' is %2", prog,
+			         type, v->val.vtype);
+			type_err(c, "info: this is where '%v' was set to %1", v->where_set,
+			         v->val.vtype, Vnone);
 			*ok = 0;
+		}
 		if (type <= Vunknown)
 			return v->val.vtype;
 		return type;
@@ -1352,28 +1530,31 @@ and `BFact`s.
 
 ####### Grammar
 
-	$*binode
-	Expression -> Expression or BTerm ${
-			$0 = new(binode);
-			$0->op = Or;
-			$0->left = $<1;
-			$0->right = $<3;
-		}$
+	$*exec
+	Expression -> Expression or BTerm ${ {
+			struct binode *b = new(binode);
+			b->op = Or;
+			b->left = $<1;
+			b->right = $<3;
+			$0 = b;
+		} }$
 		| BTerm ${ $0 = $<1; }$
 
-	BTerm -> BTerm and BFact ${
-			$0 = new(binode);
-			$0->op = And;
-			$0->left = $<1;
-			$0->right = $<3;
-		}$
+	BTerm -> BTerm and BFact ${ {
+			struct binode *b = new(binode);
+			b->op = And;
+			b->left = $<1;
+			b->right = $<3;
+			$0 = b;
+		} }$
 		| BFact ${ $0 = $<1; }$
 
-	BFact -> not BFact ${
-			$0 = new(binode);
-			$0->op = Not;
-			$0->right = $<2;
-			}$
+	BFact -> not BFact ${ {
+			struct binode *b = new(binode);
+			b->op = Not;
+			b->right = $<2;
+			$0 = b;
+		} }$
 		## other BFact
 
 ###### print binode cases
@@ -1397,10 +1578,13 @@ and `BFact`s.
 	case Or:
 	case Not:
 		/* both must be Vbool, result is Vbool */
-		propagate_types(b->left, Vbool, ok);
-		propagate_types(b->right, Vbool, ok);
-		if (type != Vbool && type > Vunknown)
+		propagate_types(b->left, c, ok, Vbool, 0);
+		propagate_types(b->right, c, ok, Vbool, 0);
+		if (type != Vbool && type > Vunknown) {
+			type_err(c, "error: %1 operation found where %2 expected", prog,
+				   Vbool, type);
 			*ok = 0;
+		}
 		return Vbool;
 
 ###### interp binode cases
@@ -1450,12 +1634,13 @@ expression operator.
 	NEql,
 
 ###### other BFact
-	| Expr CMPop Expr ${
-			$0 = new(binode);
-			$0->op = $2.op;
-			$0->left = $<1;
-			$0->right = $<3;
-		}$
+	| Expr CMPop Expr ${ {
+			struct binode *b = new(binode);
+			b->op = $2.op;
+			b->left = $<1;
+			b->right = $<3;
+			$0 = b;
+	} }$
 	| Expr ${ $0 = $<1; }$
 
 ###### Grammar
@@ -1497,16 +1682,19 @@ expression operator.
 	case Eql:
 	case NEql:
 		/* Both must match but not labels, result is Vbool */
-		t = propagate_types(b->left, Vnolabel, ok);
+		t = propagate_types(b->left, c, ok, Vnolabel, 0);
 		if (t > Vunknown)
-			propagate_types(b->right, t, ok);
+			propagate_types(b->right, c, ok, t, 0);
 		else {
-			t = propagate_types(b->right, Vnolabel, ok);
+			t = propagate_types(b->right, c, ok, Vnolabel, 0);
 			if (t > Vunknown)
-				t = propagate_types(b->left, t, ok);
+				t = propagate_types(b->left, c, ok, t, 0);
 		}
-		if (!vtype_compat(type, Vbool))
+		if (!vtype_compat(type, Vbool, 0)) {
+			type_err(c, "error: Comparison returns %1 but %2 expected", prog,
+			            Vbool, type);
 			*ok = 0;
+		}
 		return Vbool;
 
 ###### interp binode cases
@@ -1557,35 +1745,39 @@ precedence is handled better I might be able to discard this.
 
 ###### Grammar
 
-	$*binode
-	Expr -> Expr Eop Term ${
-			$0 = new(binode);
-			$0->op = $2.op;
-			$0->left = $<1;
-			$0->right = $<3;
-		}$
+	$*exec
+	Expr -> Expr Eop Term ${ {
+			struct binode *b = new(binode);
+			b->op = $2.op;
+			b->left = $<1;
+			b->right = $<3;
+			$0 = b;
+		} }$
 		| Term ${ $0 = $<1; }$
 
-	Term -> Term Top Factor ${
-			$0 = new(binode);
-			$0->op = $2.op;
-			$0->left = $<1;
-			$0->right = $<3;
-		}$
+	Term -> Term Top Factor ${ {
+			struct binode *b = new(binode);
+			b->op = $2.op;
+			b->left = $<1;
+			b->right = $<3;
+			$0 = b;
+		} }$
 		| Factor ${ $0 = $<1; }$
 
-	Factor -> ( Expression ) ${
-			$0 = new(binode);
-			$0->op = Bracket;
-			$0->right = $<2;
-		}$
-		| Uop Factor ${
-			$0 = new(binode);
-			$0->op = $1.op;
-			$0->right = $<2;
-		}$
-		| Value ${ $0 = (struct binode *)$<1; }$
-		| Variable ${ $0 = (struct binode *)$<1; }$
+	Factor -> ( Expression ) ${ {
+			struct binode *b = new_pos(binode, $1);
+			b->op = Bracket;
+			b->right = $<2;
+			$0 = b;
+		} }$
+		| Uop Factor ${ {
+			struct binode *b = new(binode);
+			b->op = $1.op;
+			b->right = $<2;
+			$0 = b;
+		} }$
+		| Value ${ $0 = $<1; }$
+		| Variable ${ $0 = $<1; }$
 
 	$eop
 	Eop ->    + ${ $0.op = Plus; }$
@@ -1639,22 +1831,28 @@ precedence is handled better I might be able to discard this.
 	case Negate:
 		/* as propagate_types ignores a NULL,
 		 * unary ops fit here too */
-		propagate_types(b->left, Vnum, ok);
-		propagate_types(b->right, Vnum, ok);
-		if (!vtype_compat(type, Vnum))
+		propagate_types(b->left, c, ok, Vnum, 0);
+		propagate_types(b->right, c, ok, Vnum, 0);
+		if (!vtype_compat(type, Vnum, 0)) {
+			type_err(c, "error: Arithmetic returns %1 but %2 expected", prog,
+			           Vnum, type);
 			*ok = 0;
+		}
 		return Vnum;
 
 	case Concat:
 		/* both must be Vstr, result is Vstr */
-		propagate_types(b->left, Vstr, ok);
-		propagate_types(b->right, Vstr, ok);
-		if (!vtype_compat(type, Vstr))
+		propagate_types(b->left, c, ok, Vstr, 0);
+		propagate_types(b->right, c, ok, Vstr, 0);
+		if (!vtype_compat(type, Vstr, 0)) {
+			type_err(c, "error: Concat returns %1 but %2 expected", prog,
+			           Vstr, type);
 			*ok = 0;
+		}
 		return Vstr;
 
 	case Bracket:
-		return propagate_types(b->right, type, ok);
+		return propagate_types(b->right, c, ok, type, 0);
 
 ###### interp binode cases
 
@@ -1839,20 +2037,26 @@ list.
 	case Block:
 	{
 		/* If any statement returns something other then Vnone
-		 * then all such must return same type.
+		 * or Vbool then all such must return same type.
 		 * As each statement may be Vnone or something else,
 		 * we must always pass Vunknown down, otherwise an incorrect
-		 * error might occur.
+		 * error might occur.  We never return Vnone unless it is
+		 * passed in.
 		 */
 		struct binode *e;
 
 		for (e = b; e; e = cast(binode, e->right)) {
-			t = propagate_types(e->left, Vunknown, ok);
-			if (t != Vunknown && t != Vnone) {
+			t = propagate_types(e->left, c, ok, Vunknown, bool_permitted);
+			if (bool_permitted && t == Vbool)
+				t = Vunknown;
+			if (t != Vunknown && t != Vnone && t != Vbool) {
 				if (type == Vunknown)
 					type = t;
-				else if (t != type)
+				else if (t != type) {
+					type_err(c, "error: expected %1, found %2",
+					         e->left, type, t);
 					*ok = 0;
+				}
 			}
 		}
 		return type;
@@ -1935,8 +2139,8 @@ same solution.
 
 	case Print:
 		/* don't care but all must be consistent */
-		propagate_types(b->left, Vnolabel, ok);
-		propagate_types(b->right, Vnolabel, ok);
+		propagate_types(b->left, c, ok, Vnolabel, 0);
+		propagate_types(b->right, c, ok, Vnolabel, 0);
 		break;
 
 ###### interp binode cases
@@ -2023,13 +2227,16 @@ it is declared, and error will be raised as the name is created as
 	case Assign:
 	case Declare:
 		/* Both must match and not be labels, result is Vnone */
-		t = propagate_types(b->left, Vnolabel, ok);
-		if (t > Vunknown)
-			propagate_types(b->right, t, ok);
-		else {
-			t = propagate_types(b->right, Vnolabel, ok);
+		t = propagate_types(b->left, c, ok, Vnolabel, 0);
+		if (t > Vunknown) {
+			if (propagate_types(b->right, c, ok, t, 0) != t)
+				if (b->left->type == Xvar)
+					type_err(c, "info: variable '%v' was set as %1 here.",
+					         cast(var, b->left)->var->where_set, t, Vnone);
+		} else {
+			t = propagate_types(b->right, c, ok, Vnolabel, 0);
 			if (t > Vunknown)
-				t = propagate_types(b->left, t, ok);
+				propagate_types(b->left, c, ok, t, 0);
 		}
 		return Vnone;
 
@@ -2062,7 +2269,7 @@ function.
 
 ###### SimpleStatement Grammar
 	| use Expression ${
-		$0 = new(binode);
+		$0 = new_pos(binode, $1);
 		$0->op = Use;
 		$0->right = $<2;
 	}$
@@ -2080,7 +2287,7 @@ function.
 
 	case Use:
 		/* result matches value */
-		return propagate_types(b->right, type, ok);
+		return propagate_types(b->right, c, ok, type, 0);
 
 ###### interp binode cases
 
@@ -2090,16 +2297,28 @@ function.
 
 ### The Conditional Statement
 
-This is the biggy and currently the only complex statement.
-This subsumes `if`, `while`, `do/while`, `switch`, and some parts of
-`for`.  It is comprised of a number of parts, all of which are
-optional though set combinations apply.
+This is the biggy and currently the only complex statement.  This
+subsumes `if`, `while`, `do/while`, `switch`, and some parts of `for`.
+It is comprised of a number of parts, all of which are optional though
+set combinations apply.  Each part is (usually) a key word (`then` is
+sometimes optional) followed by either an expression of a code block,
+except the `casepart` which is a "key word and an expression" followed
+by a code block.  The code-block option is valid for all parts and,
+where an expression is also allowed, the code block can use the `use`
+statement to report a value.  If the code block does no report a value
+the effect is similar to reporting `False`.
+
+The `else` and `case` parts, as well as `then` when combined with
+`if`, can contain a `use` statement which will apply to some
+containing conditional statement. `for` parts, `do` parts and `then`
+parts used with `for` can never contain a `use`, except in some
+subordinate conditional statement.
 
 If there is a `forpart`, it is executed first, only once.
 If there is a `dopart`, then it is executed repeatedly providing
 always that the `condpart` or `cond`, if present, does not return a non-True
 value.  `condpart` can fail to return any value if it simply executes
-to completion.  This is treated the same as returning True.
+to completion.  This is treated the same as returning `True`.
 
 If there is a `thenpart` it will be executed whenever the `condpart`
 or `cond` returns True (or does not return any value), but this will happen
@@ -2126,6 +2345,17 @@ condition following "`while`" is in a scope the covers the body
 extension.  Code following "`then`" (both looping and non-looping),
 "`else`" and "`case`" each get their own local scope.
 
+The type requirements on the code block in a `whilepart` are quite
+unusal.  It is allowed to return a value of some identifiable type, in
+which case the loop abort and an appropriate `casepart` is run, or it
+can return a Boolean, in which case the loop either continues to the
+`dopart` (on `True`) or aborts and runs the `elsepart` (on `False`).
+This is different both from the `ifpart` code block which is expected to
+return a Boolean, or the `switchpart` code block which is expected to
+return the same type as the casepart values.  The correct analysis of
+the type of the `whilepart` code block is the reason for the
+`bool_permitted` flag which is passed to `propagate_types()`.
+
 The `cond_statement` cannot fit into a `binode` so a new `exec` is
 defined.
 
@@ -2435,47 +2665,61 @@ defined.
 	case Xcond_statement:
 	{
 		// forpart and dopart must return Vnone
-		// condpart must be bool or match casepart->values
-		// thenpart, elsepart, casepart->action must match
-		// or be Vnone
+		// thenpart must return Vnone if there is a dopart,
+		// otherwise it is like elsepart.
+		// condpart must:
+		//    be bool if there is not casepart
+		//    match casepart->values if there is a switchpart
+		//    either be bool or match casepart->value if there
+		//             is a whilepart
+		// elsepart, casepart->action must match there return type
+		// expected of this statement.
 		struct cond_statement *cs = cast(cond_statement, prog);
-		struct casepart *c;
+		struct casepart *cp;
 
-		t = propagate_types(cs->forpart, Vnone, ok);
-		if (!vtype_compat(Vnone, t))
+		t = propagate_types(cs->forpart, c, ok, Vnone, 0);
+		if (!vtype_compat(Vnone, t, 0))
 			*ok = 0;
-		t = propagate_types(cs->dopart, Vnone, ok);
-		if (!vtype_compat(Vnone, t))
+		t = propagate_types(cs->dopart, c, ok, Vnone, 0);
+		if (!vtype_compat(Vnone, t, 0))
 			*ok = 0;
+		if (cs->dopart) {
+			t = propagate_types(cs->thenpart, c, ok, Vnone, 0);
+			if (!vtype_compat(Vnone, t, 0))
+				*ok = 0;
+		}
 		if (cs->casepart == NULL)
-			propagate_types(cs->condpart, Vbool, ok);
+			propagate_types(cs->condpart, c, ok, Vbool, 0);
 		else {
+			/* Condpart must match case values, with bool permitted */
 			t = Vunknown;
-			for (c = cs->casepart;
-			     c && (t == Vunknown); c = c->next)
-				t = propagate_types(c->value, Vunknown, ok);
+			for (cp = cs->casepart;
+			     cp && (t == Vunknown); cp = cp->next)
+				t = propagate_types(cp->value, c, ok, Vunknown, 0);
 			if (t == Vunknown && cs->condpart)
-				t = propagate_types(cs->condpart, Vunknown, ok);
+				t = propagate_types(cs->condpart, c, ok, Vunknown, 1);
 			// Now we have a type (I hope) push it down
 			if (t != Vunknown) {
-				for (c = cs->casepart; c; c = c->next)
-					propagate_types(c->value, t, ok);
-				propagate_types(cs->condpart, t, ok);
+				for (cp = cs->casepart; cp; cp = cp->next)
+					propagate_types(cp->value, c, ok, t, 0);
+				propagate_types(cs->condpart, c, ok, t, 1);
 			}
 		}
-		if (type == Vunknown || type == Vnone)
-			type = propagate_types(cs->thenpart, Vunknown, ok);
-		if (type == Vunknown || type == Vnone)
-			type = propagate_types(cs->elsepart, Vunknown, ok);
-		for (c = cs->casepart;
-		     c && (type == Vunknown || type == Vnone);
-		     c = c->next)
-			type = propagate_types(c->action, Vunknown, ok);
-		if (type != Vunknown && type != Vnone) {
-			propagate_types(cs->thenpart, type, ok);
-			propagate_types(cs->elsepart, type, ok);
-			for (c = cs->casepart; c ; c = c->next)
-				propagate_types(c->action, type, ok);
+		// (if)then, else, and case parts must return expected type.
+		if (!cs->dopart && type == Vunknown)
+			type = propagate_types(cs->thenpart, c, ok, Vunknown, bool_permitted);
+		if (type == Vunknown)
+			type = propagate_types(cs->elsepart, c, ok, Vunknown, bool_permitted);
+		for (cp = cs->casepart;
+		     cp && type == Vunknown;
+		     cp = cp->next)
+			type = propagate_types(cp->action, c, ok, Vunknown, bool_permitted);
+		if (type > Vunknown) {
+			if (!cs->dopart)
+				propagate_types(cs->thenpart, c, ok, type, bool_permitted);
+			propagate_types(cs->elsepart, c, ok, type, bool_permitted);
+			for (cp = cs->casepart; cp ; cp = cp->next)
+				propagate_types(cp->action, c, ok, type, bool_permitted);
 			return type;
 		} else
 			return Vunknown;
@@ -2551,7 +2795,11 @@ analysis is a bit more interesting at this level.
 		$0->right = $<4;
 		var_block_close(config2context(config), CloseSequential);
 		if (config2context(config)->scope_stack) abort();
-	}$
+		}$
+		| ERROR ${
+			tok_err(config2context(config),
+			        "error: unhandled parse error.", &$1);
+		}$
 
 	Varlist -> Varlist ArgDecl ${
 			$0 = new(binode);
@@ -2596,37 +2844,44 @@ analysis is a bit more interesting at this level.
 		struct binode *b = cast(binode, prog);
 		int ok = 1;
 
+		if (!b)
+			return 0;
 		do {
 			ok = 1;
-			propagate_types(b->right, Vnone, &ok);
+			propagate_types(b->right, c, &ok, Vnone, 0);
 		} while (ok == 2);
 		if (!ok)
 			return 0;
 
 		for (b = cast(binode, b->left); b; b = cast(binode, b->right)) {
 			struct var *v = cast(var, b->left);
-			if (v->var->val.vtype == Vunknown)
+			if (v->var->val.vtype == Vunknown) {
+				v->var->where_set = b;
 				val_init(&v->var->val, Vstr);
+			}
 		}
 		b = cast(binode, prog);
 		do {
 			ok = 1;
-			propagate_types(b->right, Vnone, &ok);
+			propagate_types(b->right, c, &ok, Vnone, 0);
 		} while (ok == 2);
 		if (!ok)
 			return 0;
 
 		/* Make sure everything is still consistent */
-		propagate_types(b->right, Vnone, &ok);
+		propagate_types(b->right, c, &ok, Vnone, 0);
 		return !!ok;
 	}
 
 	static void interp_prog(struct exec *prog, char **argv)
 	{
 		struct binode *p = cast(binode, prog);
-		struct binode *al = cast(binode, p->left);
+		struct binode *al;
 		struct value v;
 
+		if (!prog)
+			return;
+		al = cast(binode, p->left);
 		while (al) {
 			struct var *v = cast(var, al->left);
 			struct value *vl = &v->var->val;
@@ -2698,7 +2953,7 @@ Fibonacci, and performs a binary search for a number.
 
 		for:
 			togo := 10
-			f1 := 1; f2 := 1;
+			f1 := 1; f2 := 1
 			print "Fibonacci:", f1,f2,
 		then togo = togo - 1
 		while togo > 0:
@@ -2722,7 +2977,7 @@ Fibonacci, and performs a binary search for a number.
 				hi = mid
 			if hi - lo < 1:
 				use GiveUp
-
+			use True
 		do: pass
 		case Found:
 			print "Yay, I found", target