added position information for better error messages

723922ac · Martin Wierich · bf18cb0e · 723922ac · 723922ac · 723922ac
Commit 723922ac authored Sep 13, 2000 by Martin Wierich
--- a/frontend/check.icl
+++ b/frontend/check.icl
@@ -1721,13 +1721,14 @@ checkRhssAndTransformLocalDefs free_vars loc_defs rhs_expr e_input e_state e_inf
 	  (rhs_expr, es_expr_heap) = buildLetExpression [] binds rhs_expr e_state.es_expr_heap
 	= (rhs_expr, free_vars, { e_state & es_expr_heap = es_expr_heap }, e_info, cs)

-checkAndTransformPatternIntoBind free_vars [{nd_dst,nd_alts,nd_locals} : local_defs] e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs
+checkAndTransformPatternIntoBind free_vars [{nd_dst,nd_alts,nd_locals,nd_position} : local_defs] e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs
+	# cs = pushErrorAdmin (newPosition {id_name="node definition", id_info=nilPtr} nd_position) cs
 	# (bind_src, free_vars, e_state, e_info, cs) = checkRhs free_vars nd_alts nd_locals e_input e_state e_info cs	
 	  (binds_of_bind, es_var_heap, es_expr_heap, e_info, cs)
 			= transfromPatternIntoBind ei_mod_index ei_expr_level nd_dst bind_src e_state.es_var_heap e_state.es_expr_heap e_info cs
 	  e_state = { e_state & es_var_heap = es_var_heap, es_expr_heap = es_expr_heap }
 	  (binds_of_local_defs, free_vars, e_state, e_info, cs) = checkAndTransformPatternIntoBind free_vars local_defs e_input e_state e_info cs
-	= (binds_of_bind ++ binds_of_local_defs, free_vars, e_state, e_info, cs)
+	= (binds_of_bind ++ binds_of_local_defs, free_vars, e_state, e_info, popErrorAdmin cs)
 checkAndTransformPatternIntoBind free_vars [] e_input e_state e_info cs
 	= ([], free_vars, e_state, e_info, cs)

@@ -1890,23 +1891,27 @@ where
 	check_guarded_expressions free_vars [] let_vars_list rev_guarded_exprs {ei_expr_level} e_state e_info cs
 		= (let_vars_list, rev_guarded_exprs, ei_expr_level, free_vars, e_state, e_info, cs)

-	check_guarded_expression free_vars {alt_nodes,alt_guard,alt_expr,alt_ident}
+	check_guarded_expression free_vars {alt_nodes,alt_guard,alt_expr,alt_ident,alt_position}
 			let_vars_list rev_guarded_exprs e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs
 		# (let_binds, let_vars_list, ei_expr_level, free_vars, e_state, e_info, cs) = check_sequential_lets free_vars alt_nodes let_vars_list
 		  		{ e_input & ei_expr_level = inc ei_expr_level } e_state e_info cs
 		  e_input = { e_input & ei_expr_level = ei_expr_level }
+		  cs = pushErrorAdmin (newPosition { id_name = "guard", id_info = nilPtr } alt_position) cs
 	  	  (guard, free_vars, e_state, e_info, cs) = checkExpression free_vars alt_guard e_input e_state e_info cs
+		  cs = popErrorAdmin cs
 		  (expr, free_vars, e_state, e_info, cs) = check_opt_guarded_alts free_vars alt_expr e_input e_state e_info cs
 	  	= (let_vars_list, [(let_binds, guard, expr, alt_ident) : rev_guarded_exprs], ei_expr_level, free_vars, e_state, e_info,  cs )

 	// JVG: added type
 	check_unguarded_expression :: [FreeVar] ExprWithLocalDefs ExpressionInput *ExpressionState *ExpressionInfo *CheckState -> *(!Expression,![FreeVar],!*ExpressionState,!*ExpressionInfo,!*CheckState);
-	check_unguarded_expression free_vars {ewl_nodes,ewl_expr,ewl_locals} e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs
+	check_unguarded_expression free_vars {ewl_nodes,ewl_expr,ewl_locals,ewl_position} e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs
 		# this_expr_level = inc ei_expr_level
 		  (loc_defs, (var_env, array_patterns), e_state, e_info, cs)
 		 		= checkLhssOfLocalDefs this_expr_level ei_mod_index ewl_locals e_state e_info cs
 		  (binds, let_vars_list, rhs_expr_level, free_vars, e_state, e_info, cs) = check_sequential_lets free_vars ewl_nodes [] { e_input & ei_expr_level = this_expr_level } e_state e_info cs
+		  cs = pushErrorAdmin (newPosition { id_name = "", id_info = nilPtr } ewl_position) cs
 	  	  (expr, free_vars, e_state, e_info, cs) = checkExpression free_vars ewl_expr { e_input & ei_expr_level = rhs_expr_level } e_state e_info cs
+		  cs = popErrorAdmin cs
 		  (expr, free_vars, e_state, e_info, cs)
 				= addArraySelections array_patterns expr free_vars e_input e_state e_info cs
 		  cs = { cs & cs_symbol_table = remove_seq_let_vars rhs_expr_level let_vars_list cs.cs_symbol_table }
@@ -1926,17 +1931,22 @@ where
 		= remove_seq_let_vars (dec level) let_vars_list (removeLocalIdentsFromSymbolTable level let_vars symbol_table)
 		
 	check_sequential_lets free_vars [seq_let:seq_lets] let_vars_list e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs
-		# ei_expr_level = inc ei_expr_level
-		  e_input = { e_input & ei_expr_level = ei_expr_level }
-		  (src_expr, pattern_expr, (let_vars, array_patterns), free_vars, e_state, e_info, cs) = check_sequential_let free_vars seq_let e_input e_state e_info cs
+		# ei_expr_level
+				= inc ei_expr_level
+		  e_input
+		  		= { e_input & ei_expr_level = ei_expr_level }
+		  (src_expr, pattern_expr, (let_vars, array_patterns), free_vars, e_state, e_info, cs)
+		  		= check_sequential_let free_vars seq_let e_input e_state e_info cs
 	      (binds, loc_envs, max_expr_level, free_vars, e_state, e_info, cs)
 	      		= check_sequential_lets free_vars seq_lets [let_vars : let_vars_list] e_input e_state e_info cs
 		  (let_binds, es_var_heap, es_expr_heap, e_info, cs)
 				= transfromPatternIntoBind ei_mod_index ei_expr_level pattern_expr src_expr e_state.es_var_heap e_state.es_expr_heap e_info cs
-		  e_state = { e_state & es_var_heap = es_var_heap, es_expr_heap = es_expr_heap }
+		  e_state
+		  		= { e_state & es_var_heap = es_var_heap, es_expr_heap = es_expr_heap }
 		  (strict_array_pattern_binds, lazy_array_pattern_binds, free_vars, e_state, e_info, cs)
 				= foldSt (buildSelections e_input) array_patterns ([], [], free_vars, e_state, e_info, cs)
-		  all_binds = [if seq_let.ndwl_strict (s, l) ([],let_binds), (strict_array_pattern_binds, lazy_array_pattern_binds) : binds]
+		  all_binds
+		  		= [if seq_let.ndwl_strict (s, l) ([],let_binds), (strict_array_pattern_binds, lazy_array_pattern_binds) : binds]
 		    with (l,s) = splitAt ((length let_binds)-1) let_binds
 	    = (all_binds, loc_envs, max_expr_level, free_vars, e_state, e_info, cs)
 	check_sequential_lets free_vars [] let_vars_list e_input=:{ei_expr_level} e_state e_info cs
@@ -1944,8 +1954,9 @@ where

 	// JVG: added type
 	check_sequential_let :: [FreeVar] NodeDefWithLocals ExpressionInput *ExpressionState *ExpressionInfo *CheckState -> *(!Expression,!AuxiliaryPattern,!(![Ident],![ArrayPattern]),![FreeVar],!*ExpressionState,!*ExpressionInfo,!*CheckState);
-	check_sequential_let free_vars {ndwl_def={bind_src,bind_dst},ndwl_locals} e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs
-		# (loc_defs, (loc_env, loc_array_patterns), e_state, e_info, cs) = checkLhssOfLocalDefs ei_expr_level ei_mod_index ndwl_locals e_state e_info cs
+	check_sequential_let free_vars {ndwl_def={bind_src,bind_dst},ndwl_locals, ndwl_position} e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs
+		# cs = pushErrorAdmin (newPosition {id_name="node definition", id_info=nilPtr} ndwl_position) cs
+		  (loc_defs, (loc_env, loc_array_patterns), e_state, e_info, cs) = checkLhssOfLocalDefs ei_expr_level ei_mod_index ndwl_locals e_state e_info cs
 		  (src_expr, free_vars, e_state, e_info, cs) = checkExpression free_vars bind_src e_input e_state e_info cs
 		  (src_expr, free_vars, e_state, e_info, cs)
 				= addArraySelections loc_array_patterns src_expr free_vars e_input e_state e_info cs
@@ -1958,7 +1969,7 @@ where
 				= checkPattern bind_dst No { pi_def_level = ei_expr_level, pi_mod_index = ei_mod_index, pi_is_node_pattern = True } ([], []) 
 					{ps_var_heap = hp_var_heap, ps_fun_defs = es_fun_defs } e_info { cs & cs_symbol_table = cs_symbol_table }
 		  e_state = { e_state & es_var_heap = ps_var_heap, es_expr_heap = hp_expression_heap, es_type_heaps = hp_type_heaps, es_fun_defs = ps_fun_defs }
-		= (src_expr, pattern, accus, free_vars, e_state, e_info, cs)
+		= (src_expr, pattern, accus, free_vars, e_state, e_info, popErrorAdmin cs)
 	
 	build_sequential_lets :: ![(![Bind Expression FreeVar],![Bind Expression FreeVar])] !Expression !*ExpressionHeap -> (!Expression, !*ExpressionHeap)
 	build_sequential_lets [] expr expr_heap
@@ -3230,9 +3241,7 @@ where
 				<=< adjust_predef_symbol PD_TypeConsSymbol		mod_index STE_Constructor
 				<=< adjust_predef_symbol PD_variablePlaceholder mod_index STE_Constructor
 				<=< adjust_predef_symbol PD_unify				mod_index STE_DclFunction
-// MV ..
 				<=< adjust_predef_symbol PD_coerce				mod_index STE_DclFunction
-// .. MV
 				<=< adjust_predef_symbol PD_undo_indirections	mod_index STE_DclFunction)
 			= (class_members, class_instances, fun_types, { cs & cs_predef_symbols = cs_predef_symbols})
 	where

--- a/frontend/parse.icl
+++ b/frontend/parse.icl
@@ -552,10 +552,12 @@ where
 wantCodeRhs :: !ParseState -> (Rhs, !ParseState)
 wantCodeRhs pState
 	# (expr, pState)	= want_code_expr pState
+	  (file_name, line_nr, pState)	= getFileAndLineNr pState // MW++
 	= (	{ rhs_alts		= UnGuardedExpr
 							{ ewl_nodes		= []
 							, ewl_locals	= LocalParsedDefs []
 							, ewl_expr		= expr
+							, ewl_position	= LinePos file_name line_nr // MW++
 							}
 		, rhs_locals	= LocalParsedDefs []
 		}
@@ -645,7 +647,7 @@ where
 	want_FunctionBody :: !Token ![NodeDefWithLocals] ![GuardedExpr] !(Token -> Bool) !ParseState -> (!OptGuardedAlts, !ParseState)
 	want_FunctionBody BarToken nodeDefs alts sep pState
 //		#	(lets, pState)				= want_StrictLet pState // removed from 2.0
-		#	(guard_position, pState)	= getPosition pState // MW4++
+		#	(file_name, line_nr, pState)= getFileAndLineNr pState // MW4++
 			(token, pState)				= nextToken FunctionContext pState
 		|	token == OtherwiseToken
 			#	(token, pState)				= nextToken FunctionContext pState
@@ -668,7 +670,7 @@ where
 				pState						= wantEndNestedGuard (default_found expr) offside pState
 // MW4 was:				alt							= { alt_nodes = nodeDefs, alt_guard = guard, alt_expr = expr }
 				alt							= { alt_nodes = nodeDefs, alt_guard = guard, alt_expr = expr,
-												alt_ident = guard_ident guard_position.fp_line }
+												alt_ident = guard_ident line_nr, alt_position = LinePos file_name line_nr }
 				(token, pState)				= nextToken FunctionContext pState
 				(nodeDefs, token, pState)	= want_LetBefores token pState
 			=	want_FunctionBody token nodeDefs [alt:alts] sep pState
@@ -676,7 +678,7 @@ where
 			#	(expr, pState)				= root_expression True token nodeDefs2 [] sep pState
 // MW4 was:				alt							= { alt_nodes = nodeDefs, alt_guard = guard, alt_expr = expr }
 				alt							= { alt_nodes = nodeDefs, alt_guard = guard, alt_expr = expr,
-												alt_ident = guard_ident guard_position.fp_line }
+												alt_ident = guard_ident line_nr, alt_position = LinePos file_name line_nr }
 				(token, pState)				= nextToken FunctionContext pState
 				(nodeDefs, token, pState)	= want_LetBefores token pState
 			=	want_FunctionBody token nodeDefs [alt:alts] sep pState
@@ -690,10 +692,12 @@ where
 	
 	root_expression :: !Bool !Token ![NodeDefWithLocals] ![GuardedExpr] !(Token -> Bool) !ParseState -> (!OptGuardedAlts, !ParseState)
 	root_expression withExpected token nodeDefs [] sep pState
-		#	(expr,pState) = want_OptExprWithLocals withExpected token nodeDefs sep pState
+		# (file_name, line_nr, pState)	= getFileAndLineNr pState // MW++
+		  (expr,pState) = want_OptExprWithLocals withExpected token nodeDefs sep pState
 		=	case expr of
 				Yes expr -> ( UnGuardedExpr expr, pState)
-				No		 -> ( UnGuardedExpr {ewl_nodes = [], ewl_expr = PE_Empty, ewl_locals = LocalParsedDefs []}
+				No		 -> ( UnGuardedExpr {ewl_nodes = [], ewl_expr = PE_Empty, ewl_locals = LocalParsedDefs [],
+												ewl_position = LinePos file_name line_nr}
 							, parseError "RHS: root expression" (Yes token) "= <ExprWithLocals>" pState
 							)
 	root_expression withExpected token nodeDefs alts sep pState
@@ -708,12 +712,14 @@ where
 		= want_OptExprWithLocals True EqualToken nodeDefs sep (replaceToken EqualToken pState)
 	want_OptExprWithLocals withExpected token nodeDefs sep pState
 		| sep token
-		# (expr, pState)	= wantExpression cIsNotAPattern pState
+		# (file_name, line_nr, pState)	= getFileAndLineNr pState // MW++
+		  (expr, pState)	= wantExpression cIsNotAPattern pState
 		  pState			= wantEndRootExpression pState
 		  (locals,pState)	= optionalLocals WithToken withExpected pState
 		= ( Yes	{ ewl_nodes		= nodeDefs
 				, ewl_expr		= expr
 				, ewl_locals	= locals
+				, ewl_position	= LinePos file_name line_nr // MW++
 				}
 		  , pState
 		  )
@@ -753,6 +759,8 @@ where
 		# (succ, lhs_exp, pState)	= trySimpleLhsExpression pState
 		| succ
 			# pState			= wantToken FunctionContext "let definition" EqualToken pState
+			  (file_name, line_nr, pState)
+			  					= getFileAndLineNr pState // MW++
 			  (rhs_exp, pState) = wantExpression cIsNotAPattern pState
 			  pState			= wantEndRootExpression pState -->> ("#",lhs_exp,"=",rhs_exp)
 	  	  	  (locals , pState) = optionalLocals WithToken localsExpected pState
@@ -762,6 +770,8 @@ where
 				  				  , bind_src = rhs_exp
 				  				  }
 				  , ndwl_locals	= locals
+				  , ndwl_position
+				  				= LinePos file_name line_nr // MW++
 				  }
 				, pState
 				)
@@ -2225,6 +2235,7 @@ buildNodeDef lhsExpr rhsExpr
 					{ ewl_nodes		= []
 					, ewl_locals	= LocalParsedDefs []
 					, ewl_expr		= rhsExpr
+					, ewl_position	= NoPos // MW++
 					}
 			, rhs_locals
 				= LocalParsedDefs []

--- a/frontend/postparse.icl
+++ b/frontend/postparse.icl
@@ -49,6 +49,7 @@ exprToRhs expr
 						{	ewl_nodes	= []
 						,	ewl_expr	= expr
 						,	ewl_locals = LocalParsedDefs []
+						,	ewl_position= NoPos
 						}
 		,	rhs_locals	= LocalParsedDefs []
 		}
@@ -304,7 +305,8 @@ NoCollectedLocalDefs :== CollectedLocalDefs { loc_functions = { ir_from = 0, ir_
 transformLambda :: Ident [ParsedExpr] ParsedExpr Position -> FunDef
 // MW was:transformLambda lam_ident args result
 transformLambda lam_ident args result pos
-	# lam_rhs = { rhs_alts = UnGuardedExpr { ewl_nodes = [], ewl_expr = result, ewl_locals = NoCollectedLocalDefs },
+	# lam_rhs = { rhs_alts = UnGuardedExpr { ewl_nodes = [], ewl_expr = result, ewl_locals = NoCollectedLocalDefs,
+												ewl_position = NoPos },
 	  			  rhs_locals = NoCollectedLocalDefs }
 // MW4 was:	  lam_body = [{pb_args = args, pb_rhs = lam_rhs }]
 	  lam_body = [{pb_args = args, pb_rhs = lam_rhs, pb_position = pos }]
@@ -589,8 +591,9 @@ makeComprehensions [{tq_generators, tq_filter, tq_end, tq_call, tq_lhs_args, tq_
 								->	optGuardedAltToRhs (GuardedAlts [
 										{alt_nodes = [], alt_guard = filter, alt_expr = UnGuardedExpr
 // MW4 was:												{ewl_nodes	= [], ewl_expr	= success, ewl_locals	= LocalParsedDefs []}}] No)
-												{ewl_nodes	= [], ewl_expr	= success, ewl_locals	= LocalParsedDefs []},
-											alt_ident = { id_name ="_f;" +++ toString line_nr +++ ";", id_info = nilPtr }}] No)
+												{ewl_nodes	= [], ewl_expr	= success, ewl_locals	= LocalParsedDefs [], ewl_position = NoPos },
+											alt_ident = { id_name ="_f;" +++ toString line_nr +++ ";", id_info = nilPtr },
+											alt_position = NoPos}] No)
 							No
 								->	exprToRhs success
 				(LinePos _ line_nr) = fun_pos
@@ -1012,7 +1015,7 @@ reorganiseDefinitions icl_module [] _ _ _ ca
 reorganiseLocalDefinitions :: [ParsedDefinition] *CollectAdmin -> ([FunDef],[(Optional SymbolType,NodeDef ParsedExpr)],*CollectAdmin)
 reorganiseLocalDefinitions [PD_NodeDef pos pattern {rhs_alts,rhs_locals} : defs] ca
 	# (fun_defs, node_defs, ca) = reorganiseLocalDefinitions defs ca
-	= (fun_defs, [(No, { nd_dst = pattern, nd_alts = rhs_alts, nd_locals = rhs_locals }) : node_defs], ca)
+	= (fun_defs, [(No, { nd_dst = pattern, nd_alts = rhs_alts, nd_locals = rhs_locals, nd_position = pos }) : node_defs], ca)
 reorganiseLocalDefinitions [PD_Function pos name is_infix args rhs fun_kind : defs] ca
 	# prio = if is_infix (Prio NoAssoc 9) NoPrio
 	  fun_arity = length args
@@ -1034,7 +1037,7 @@ reorganiseLocalDefinitions [PD_TypeSpec pos1 name1 prio type specials : defs] ca
 		[PD_NodeDef pos pattern=:(PE_Ident id)  {rhs_alts,rhs_locals} : defs]
 			| belongsToTypeSpec name1 prio id False
 				# (fun_defs, node_defs, ca) = reorganiseLocalDefinitions defs ca
-				-> (fun_defs, [(type, { nd_dst = pattern, nd_alts = rhs_alts, nd_locals = rhs_locals }) : node_defs], ca)
+				-> (fun_defs, [(type, { nd_dst = pattern, nd_alts = rhs_alts, nd_locals = rhs_locals, nd_position = pos }) : node_defs], ca)
 				-> reorganiseLocalDefinitions defs (postParseError pos "function body expected" ca)
 		_
 			-> reorganiseLocalDefinitions defs (postParseError pos1 "function body expected" ca)

--- a/frontend/syntax.dcl
+++ b/frontend/syntax.dcl
@@ -112,7 +112,8 @@ NotALevel 	:==  -1
 ::	NodeDef dst =
 	{	nd_dst		::!dst,
 		nd_alts		::!OptGuardedAlts,
-		nd_locals	::!LocalDefs
+		nd_locals	::!LocalDefs,
+		nd_position	::!Position		
 	}

 ::	Rhs =
@@ -882,18 +883,21 @@ cNonRecursiveAppl	:== False
 	,	alt_guard	:: !ParsedExpr
 	,	alt_expr	:: !OptGuardedAlts
 	,	alt_ident	:: !Ident
+	,	alt_position:: !Position
 	}

 ::	ExprWithLocalDefs = 
 	{	ewl_nodes	:: ![NodeDefWithLocals]
 	,	ewl_expr	:: !ParsedExpr
 	,	ewl_locals	:: !LocalDefs
+	,	ewl_position:: !Position
 	}

 ::	NodeDefWithLocals =
-	{	ndwl_strict	:: !Bool
-	,	ndwl_def	:: !Bind ParsedExpr ParsedExpr
-	,	ndwl_locals	:: !LocalDefs
+	{	ndwl_strict		:: !Bool
+	,	ndwl_def		:: !Bind ParsedExpr ParsedExpr
+	,	ndwl_locals		:: !LocalDefs
+	,	ndwl_position	:: !Position
 	}

 ::	CaseAlt =
@@ -985,6 +989,7 @@ cIsNotStrict	:== False
 				| Let !Let
 				| Case !Case
 				| Selection !(Optional (Global DefinedSymbol)) !Expression ![Selection]
+							// Yes: a "!" selection
 				| Update !Expression ![Selection] Expression
 				| RecordUpdate !(Global DefinedSymbol) !Expression ![Bind Expression (Global FieldSymbol)]
 				| TupleSelect !DefinedSymbol !Int !Expression

--- a/frontend/syntax.icl
+++ b/frontend/syntax.icl
@@ -115,7 +115,8 @@ NotALevel 	:==  -1
 ::	NodeDef dst =
 	{	nd_dst		::!dst,
 		nd_alts		::!OptGuardedAlts,
-		nd_locals	::!LocalDefs
+		nd_locals	::!LocalDefs,
+		nd_position	::!Position		
 	}

 ::	Rhs =
@@ -846,18 +847,21 @@ cNotVarNumber :== -1
 	,	alt_guard	:: !ParsedExpr
 	,	alt_expr	:: !OptGuardedAlts
 	,	alt_ident	:: !Ident
+	,	alt_position:: !Position
 	}

 ::	ExprWithLocalDefs = 
 	{	ewl_nodes	:: ![NodeDefWithLocals]
 	,	ewl_expr	:: !ParsedExpr
 	,	ewl_locals	:: !LocalDefs
+	,	ewl_position:: !Position
 	}

 ::	NodeDefWithLocals =
-	{	ndwl_strict	:: !Bool
-	,	ndwl_def	:: !Bind ParsedExpr ParsedExpr
-	,	ndwl_locals	:: !LocalDefs
+	{	ndwl_strict		:: !Bool
+	,	ndwl_def		:: !Bind ParsedExpr ParsedExpr
+	,	ndwl_locals		:: !LocalDefs
+	,	ndwl_position	:: !Position
 	}