readableizing error messages

git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@147 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d

6 files changed, 28 insertions, 18 deletions

diff --git a/frontend/check.icl b/frontend/check.icl
index f5d115e..81bb88d 100644
--- a/frontend/check.icl
+++ b/frontend/check.icl
@@ -2642,7 +2642,7 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs
 	  (icl_functions, e_info, heaps, cs) = checkMacros cIclModIndex cdefs.def_macros icl_functions e_info heaps cs
 	  (icl_functions, e_info, heaps, cs) = checkFunctions cIclModIndex cGlobalScope icl_global_function_range.ir_from icl_global_function_range.ir_to icl_functions e_info heaps cs
 
-	  cs = check_start_rule mod_type icl_global_function_range cs
+	  cs = check_start_rule mod_type mod_name icl_global_function_range cs
 	  cs = check_needed_modules_are_imported mod_name ".icl" cs
 
 	  (icl_functions, e_info, heaps, {cs_symbol_table, cs_predef_symbols, cs_error})
@@ -2686,7 +2686,7 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs
 	    		  			icl_declared = {dcls_local = local_defs, dcls_import = icl_imported, dcls_explicit = dcls_explicit} }
 		= (False, icl_mod, dcl_modules, {}, No, heaps, cs_predef_symbols, cs_symbol_table, cs_error.ea_file)
 	where
-		check_start_rule mod_kind {ir_from, ir_to} cs=:{cs_predef_symbols,cs_symbol_table}
+		check_start_rule mod_kind mod_name {ir_from, ir_to} cs=:{cs_predef_symbols,cs_symbol_table}
 			# (pre_symb, cs_predef_symbols) = cs_predef_symbols![PD_Start]
 			  ({ste_kind, ste_index}, cs_symbol_table) = readPtr pre_symb.pds_ident.id_info cs_symbol_table
 			  cs = { cs & cs_predef_symbols = cs_predef_symbols, cs_symbol_table = cs_symbol_table }
@@ -2699,7 +2699,8 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs
 				_
 					-> case mod_kind of
 							MK_Main
-								-> { cs & cs_error = checkError "Start" " function not defined" cs.cs_error }
+								# pos = newPosition pre_symb.pds_ident (LinePos (mod_name.id_name+++".icl") 1)
+								-> { cs & cs_error = checkErrorWithIdentPos pos " has not been declared" cs.cs_error }
 							_
 								-> cs
 
diff --git a/frontend/checksupport.icl b/frontend/checksupport.icl
index f693445..98ebe58 100644
--- a/frontend/checksupport.icl
+++ b/frontend/checksupport.icl
@@ -159,10 +159,8 @@ checkWarning id mess error=:{ea_file,ea_loc}
 	= { error & ea_file = ea_file <<< "Check Warning " <<< hd ea_loc <<< ":\"" <<< id  <<< "\" " <<< mess <<< '\n' }
 
 checkErrorWithIdentPos :: !IdentPos !a !*ErrorAdmin -> .ErrorAdmin | <<< a;
-checkErrorWithIdentPos ident_pos mess error_admin
-	# error_admin = pushErrorAdmin ident_pos error_admin
-	  error_admin = checkError ident_pos.ip_ident mess error_admin
-	= popErrorAdmin error_admin
+checkErrorWithIdentPos ident_pos mess error=:{ea_file}
+	= { error & ea_file = ea_file <<< "Check Error " <<< ident_pos <<< ":" <<< mess <<< '\n', ea_ok = False }
 
 class envLookUp a :: !a !(Env Ident .b) -> (!Bool,.b)
 
diff --git a/frontend/parse.icl b/frontend/parse.icl
index 9470322..cceb5bb 100644
--- a/frontend/parse.icl
+++ b/frontend/parse.icl
@@ -1944,7 +1944,13 @@ trySimpleNonLhsExpressionT BackSlashToken pState
 	  (lam_args, pState) 	= wantList "arguments" trySimpleLhsExpression pState
 	  pState				= want_lambda_sep pState
 	  (exp, pState)			= wantExpression cIsNotAPattern pState
-	= (True, PE_Lambda lam_ident lam_args exp, pState)
+// MW9..
+	  (file_name, line_nr, pState)	
+	  						= getFileAndLineNr pState
+	  position				= FunPos file_name line_nr lam_ident.id_name
+// ..MW9
+// MW9 was	= (True, PE_Lambda lam_ident lam_args exp, pState)
+	= (True, PE_Lambda lam_ident lam_args exp position, pState)
 	where
 		want_lambda_sep pState
 			# (token, pState) = nextToken FunctionContext pState
diff --git a/frontend/postparse.icl b/frontend/postparse.icl
index 19bfb35..f4b8735 100644
--- a/frontend/postparse.icl
+++ b/frontend/postparse.icl
@@ -129,9 +129,11 @@ where
 	collectFunctions (PE_Bound bound_expr) ca
 		# (bound_expr, ca) = collectFunctions bound_expr ca
 		= (PE_Bound bound_expr, ca)
-	collectFunctions (PE_Lambda lam_ident args res) ca
+// MW was:	collectFunctions (PE_Lambda lam_ident args res) ca
+	collectFunctions (PE_Lambda lam_ident args res pos) ca
 		# ((args,res), ca) = collectFunctions (args,res) ca
-		# (range, ca) = addFunctionsRange [transformLambda lam_ident args res] ca
+// MW was:		# (range, ca) = addFunctionsRange [transformLambda lam_ident args res] ca
+		# (range, ca) = addFunctionsRange [transformLambda lam_ident args res pos] ca
 		= (PE_Let cIsStrict (CollectedLocalDefs { loc_functions = range, loc_nodes = [] })
 				(PE_Ident lam_ident), ca)
 	collectFunctions (PE_Record rec_expr type_name fields) ca
@@ -297,12 +299,15 @@ where
 
 NoCollectedLocalDefs :== CollectedLocalDefs { loc_functions = { ir_from = 0, ir_to = 0 }, loc_nodes = [] }
 
-transformLambda :: Ident [ParsedExpr] ParsedExpr -> FunDef
-transformLambda lam_ident args result
+// MW was:transformLambda :: Ident [ParsedExpr] ParsedExpr -> FunDef
+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 },
 	  			  rhs_locals = NoCollectedLocalDefs }
 	  lam_body = [{pb_args = args, pb_rhs = lam_rhs }]
-	  fun_def = MakeNewFunction lam_ident (length args) lam_body (FK_Function cNameLocationDependent) NoPrio No NoPos
+// MW was:	  fun_def = MakeNewFunction lam_ident (length args) lam_body (FK_Function cNameLocationDependent) NoPrio No NoPos
+	  fun_def = MakeNewFunction lam_ident (length args) lam_body (FK_Function cNameLocationDependent) NoPrio No pos
 	= fun_def
 
 makeNilExpression :: *CollectAdmin -> (ParsedExpr,*CollectAdmin)
diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl
index 362dabd..8fdccc5 100644
--- a/frontend/syntax.dcl
+++ b/frontend/syntax.dcl
@@ -894,7 +894,7 @@ cNonUniqueSelection	:== False
 				| PE_Ident !Ident
 				| PE_Basic !BasicValue
 				| PE_Bound !BoundExpr
-				| PE_Lambda !Ident ![ParsedExpr] !ParsedExpr
+				| PE_Lambda !Ident ![ParsedExpr] !ParsedExpr !Position
 				| PE_Tuple ![ParsedExpr]				
 				| PE_Record !ParsedExpr !(Optional Ident) ![FieldAssignment]
 				| PE_ArrayPattern ![ElemAssignment]
diff --git a/frontend/syntax.icl b/frontend/syntax.icl
index 171f2b8..0230f48 100644
--- a/frontend/syntax.icl
+++ b/frontend/syntax.icl
@@ -516,10 +516,10 @@ cNotVarNumber :== -1
 ::	FunctionInfo	= FI_Empty | FI_Function !GeneratedFunction
 
 ::	Producer	= PR_Empty
-				| PR_Function !SymbIdent !Index !Int // Int: number of actual arguments in application
+				| PR_Function !SymbIdent !Index !Int // Int: number of actual arguments in application (XXX possibly superfluous (already contained in SymbIdent))
 				| PR_Class !App ![BoundVar] !Type
 //				| PR_Constructor !SymbIdent ![Expression]
-				| PR_GeneratedFunction !SymbIdent !Index !Int // Int: number of actual arguments in application
+				| PR_GeneratedFunction !SymbIdent !Index !Int // Int: number of actual arguments in application (XXX possibly superfluous (already contained in SymbIdent))
 
 ::	InstanceInfo = II_Empty | II_Node !{! Producer} !FunctionInfoPtr !InstanceInfo !InstanceInfo
 
@@ -859,7 +859,7 @@ cNonUniqueSelection	:== False
 				| PE_Ident !Ident
 				| PE_Basic !BasicValue
 				| PE_Bound !BoundExpr
-				| PE_Lambda !Ident ![ParsedExpr] !ParsedExpr
+				| PE_Lambda !Ident ![ParsedExpr] !ParsedExpr !Position
 				| PE_Tuple ![ParsedExpr]				
 				| PE_Record !ParsedExpr !(Optional Ident) ![FieldAssignment]
 				| PE_ArrayPattern ![ElemAssignment]
@@ -1455,7 +1455,7 @@ where
 	(<<<) file PE_Empty = file <<< "** E **"
 	(<<<) file (PE_Ident symb) = file <<< symb
 	(<<<) file PE_WildCard = file <<< '_'
-	(<<<) file (PE_Lambda _ exprs expr) = file <<< '\\' <<< exprs <<< " -> " <<< expr
+	(<<<) file (PE_Lambda _ exprs expr _) = file <<< '\\' <<< exprs <<< " -> " <<< expr
 	(<<<) file (PE_Bound bind) = file <<< bind
 	(<<<) file (PE_Case _ expr alts) = file <<< "case " <<< expr <<< " of\n" <<< alts
 	(<<<) file (PE_Let _ defs expr) = file <<< "let " <<< defs <<< " in\n" <<< expr