refactor, change type of ea_loc in ErrorAdmin, store Ident and Position instead of an IdentPos

frontend/checkFunctionBodies.icl

@@ -1713,7 +1713,7 @@ checkErrorWithOptionalPosition ident position error_message cs_error
 checkStringErrorWithOptionalPosition string NoPos error_message cs_error
 	= checkError string error_message cs_error
 checkStringErrorWithOptionalPosition string position error_message cs_error
-	= checkStringErrorWithPosition string position error_message cs_error
+	= checkErrorWithStringPosition string position error_message cs_error
 
 checkPattern :: !ParsedExpr !(Optional (Bind Ident VarInfoPtr)) !PatternInput !(![Ident], ![ArrayPattern]) !*PatternState !*ExpressionInfo !*CheckState
 									-> (!AuxiliaryPattern, !(![Ident], ![ArrayPattern]), !*PatternState, !*ExpressionInfo, !*CheckState)

frontend/checksupport.dcl

@@ -25,7 +25,9 @@ cNeedStdStrictMaybes	:== 64
 	,	hp_generic_heap		::!.GenericHeap
 	}
 
-::	ErrorAdmin = { ea_file :: !.File, ea_loc :: ![IdentPos], ea_ok :: !Bool }
+::	ErrorPosition = { ep_ident :: !Ident, ep_position :: !Position }
+
+::	ErrorAdmin = { ea_file :: !.File, ea_loc :: ![ErrorPosition], ea_ok :: !Bool }
 
 ::	CheckState = { cs_symbol_table :: !.SymbolTable, cs_predef_symbols :: !.PredefinedSymbols, cs_error :: !.ErrorAdmin,cs_x :: !.CheckStateX }
 
@@ -63,7 +65,6 @@ where
 
 instance Erroradmin ErrorAdmin, CheckState
 
-newPosition :: !Ident !Position -> IdentPos 
 stringPosition :: !String !Position -> StringPos
 
 checkError :: !a !b !*ErrorAdmin -> *ErrorAdmin | <<< a & <<< b
@@ -77,7 +78,7 @@ checkErrorWithIdentPos :: !IdentPos !a !*ErrorAdmin -> .ErrorAdmin | <<< a
 	special a={#Char};
 checkErrorWithPosition :: !Ident !Position !a !*ErrorAdmin -> .ErrorAdmin | <<< a
 	special a={#Char};
-checkStringErrorWithPosition :: !{#Char} !Position !a !*ErrorAdmin -> *ErrorAdmin | <<< a
+checkErrorWithStringPosition :: !{#Char} !Position !a !*ErrorAdmin -> *ErrorAdmin | <<< a
 	special a={#Char};
 checkWarningWithPosition :: !Ident !Position !a !*ErrorAdmin -> .ErrorAdmin | <<< a;
 
@@ -92,6 +93,7 @@ instance toIdent SymbIdent, TypeSymbIdent, BoundVar, TypeVar, ATypeVar, Ident
 
 instance toInt STE_Kind
 instance <<< IdentPos, StringPos
+writePositionModuleName :: !Position !*File -> *File
 
 ::	ExpressionInfo =
 	{	ef_type_defs		:: !.{# CheckedTypeDef}

frontend/checksupport.icl

@@ -27,13 +27,13 @@ where
 instance Erroradmin ErrorAdmin
 where
 	pushErrorPosition ident pos error=:{ea_loc}
-		= {error & ea_loc = [newPosition ident pos : ea_loc]}
+		= {error & ea_loc = [{ep_ident=ident,ep_position=pos} : ea_loc]}
 	
 	setErrorPosition ident pos error
-		= {error & ea_loc = [newPosition ident pos]}
+		= {error & ea_loc = [{ep_ident=ident,ep_position=pos}]}
 	
 	popErrorAdmin error=:{ea_loc = [_:ea_locs]}
-		=  {error & ea_loc = ea_locs}
+		= {error & ea_loc = ea_locs}
 
 instance Erroradmin CheckState
 where
@@ -46,16 +46,6 @@ where
 	popErrorAdmin cs=:{cs_error}
 		= {cs & cs_error = popErrorAdmin cs_error}
 
-newPosition :: !Ident !Position -> IdentPos
-newPosition id (FunPos file_name line_nr _)
-	= { ip_ident = id, ip_line = line_nr, ip_file = file_name }
-newPosition id (LinePos file_name line_nr)
-	= { ip_ident = id, ip_line = line_nr, ip_file = file_name }
-newPosition id (PreDefPos file_name)
-	= { ip_ident = id, ip_line = cNotALineNumber, ip_file = file_name.id_name }
-newPosition id NoPos
-	= { ip_ident = id, ip_line = cNotALineNumber, ip_file = "???" }
-
 stringPosition :: !String !Position -> StringPos
 stringPosition id (FunPos file_name line_nr _)
 	= { sp_name = id, sp_line = line_nr, sp_file = file_name }
@@ -66,17 +56,27 @@ stringPosition id (PreDefPos file_name)
 stringPosition id NoPos
 	= { sp_name = id, sp_line = cNotALineNumber, sp_file = "???" }
 
-checkError :: !a !b !*ErrorAdmin -> *ErrorAdmin | <<< a & <<< b // PK
+writePositionModuleName :: !Position !*File -> *File
+writePositionModuleName (FunPos file_name _ _) file
+	= file <<< file_name
+writePositionModuleName (LinePos file_name _) file
+	= file <<< file_name
+writePositionModuleName (PreDefPos file_name) file
+	= file <<< file_name.id_name
+writePositionModuleName NoPos file
+	= file <<< "???"
+
+checkError :: !a !b !*ErrorAdmin -> *ErrorAdmin | <<< a & <<< b
 checkError id mess error=:{ea_file,ea_loc=[]}
 	= { error & ea_file = ea_file <<< "Error " <<< " " <<< id <<< " " <<< mess <<< '\n', ea_ok = False }
-checkError id mess error=:{ea_file,ea_loc}
-	= { error & ea_file = ea_file <<< "Error " <<< hd ea_loc <<< ": " <<< id  <<< " " <<< mess <<< '\n', ea_ok = False }
+checkError id mess error=:{ea_file,ea_loc=[{ep_ident,ep_position}:_]}
+	= { error & ea_file = ea_file <<< "Error " <<< stringPosition ep_ident.id_name ep_position <<< ": " <<< id  <<< " " <<< mess <<< '\n', ea_ok = False }
 
-checkWarning :: !a !b !*ErrorAdmin -> *ErrorAdmin | <<< a & <<< b // PK
+checkWarning :: !a !b !*ErrorAdmin -> *ErrorAdmin | <<< a & <<< b
 checkWarning id mess error=:{ea_file,ea_loc=[]}
 	= { error & ea_file = ea_file <<< "Warning " <<< " " <<< id <<< " " <<< mess <<< '\n' }
-checkWarning id mess error=:{ea_file,ea_loc}
-	= { error & ea_file = ea_file <<< "Warning " <<< hd ea_loc <<< ": " <<< id  <<< " " <<< mess <<< '\n' }
+checkWarning id mess error=:{ea_file,ea_loc=[{ep_ident,ep_position}:_]}
+	= { error & ea_file = ea_file <<< "Warning " <<< stringPosition ep_ident.id_name ep_position <<< ": " <<< id  <<< " " <<< mess <<< '\n' }
 
 checkErrorIdentWithIdentPos :: !IdentPos !Ident !a !*ErrorAdmin -> .ErrorAdmin | <<< a;
 checkErrorIdentWithIdentPos ident_pos id mess error=:{ea_file}
@@ -84,8 +84,7 @@ checkErrorIdentWithIdentPos ident_pos id mess error=:{ea_file}
 
 checkErrorIdentWithPosition :: !Ident !Position !Ident !a !*ErrorAdmin -> .ErrorAdmin | <<< a;
 checkErrorIdentWithPosition ident pos id mess error=:{ea_file}
-	# ident_pos = newPosition ident pos
-	= { error & ea_file = ea_file <<< "Error " <<< ident_pos <<< ": " <<< id  <<< ' ' <<< mess <<< '\n', ea_ok = False }
+	= { error & ea_file = ea_file <<< "Error " <<< stringPosition ident.id_name pos <<< ": " <<< id  <<< ' ' <<< mess <<< '\n', ea_ok = False }
 
 checkErrorWithIdentPos :: !IdentPos !a !*ErrorAdmin -> .ErrorAdmin | <<< a;
 checkErrorWithIdentPos ident_pos mess error=:{ea_file}
@@ -93,18 +92,16 @@ checkErrorWithIdentPos ident_pos mess error=:{ea_file}
 
 checkErrorWithPosition :: !Ident !Position !a !*ErrorAdmin -> .ErrorAdmin | <<< a;
 checkErrorWithPosition ident pos mess error=:{ea_file}
-	# ident_pos = newPosition ident pos
-	= { error & ea_file = ea_file <<< "Error " <<< ident_pos <<< ": " <<< mess <<< '\n', ea_ok = False }
+	= { error & ea_file = ea_file <<< "Error " <<< stringPosition ident.id_name pos <<< ": " <<< mess <<< '\n', ea_ok = False }
 
-checkStringErrorWithPosition :: !{#Char} !Position !a !*ErrorAdmin -> *ErrorAdmin | <<< a;
-checkStringErrorWithPosition string pos mess error=:{ea_file}
+checkErrorWithStringPosition :: !{#Char} !Position !a !*ErrorAdmin -> *ErrorAdmin | <<< a;
+checkErrorWithStringPosition string pos mess error=:{ea_file}
 	# string_pos = stringPosition string pos
 	= { error & ea_file = ea_file <<< "Error " <<< string_pos <<< ": " <<< mess <<< '\n', ea_ok = False }
 
 checkWarningWithPosition :: !Ident !Position !a !*ErrorAdmin -> .ErrorAdmin | <<< a;
 checkWarningWithPosition ident pos mess error=:{ea_file}
-	# ident_pos = newPosition ident pos
-	= { error & ea_file = ea_file <<< "Warning " <<< ident_pos <<< ": " <<< mess <<< '\n' }
+	= { error & ea_file = ea_file <<< "Warning " <<< stringPosition ident.id_name pos <<< ": " <<< mess <<< '\n' }
 
 class envLookUp a :: !a !(Env Ident .b) -> (!Bool,.b)
 

frontend/generics1.icl

@@ -5447,14 +5447,9 @@ where
 			= No
 	*/
 
-reportError name pos msg error=:{ea_file} 
-	# ea_file = ea_file <<< "Error " <<< (stringPosition name pos) <<< ":" <<< msg <<< '\n'
-	= { error & ea_file = ea_file , ea_ok = False }
+reportError name pos msg error
+	:== checkErrorWithStringPosition name pos msg error
 
-reportWarning name pos msg error=:{ea_file}
-	# ea_file = ea_file <<< "Warning " <<< (newPosition name pos) <<< ":" <<< msg <<< '\n'
-	= { error & ea_file = ea_file }
-	
 //	Type Helpers
 
 makeAType :: !Type !TypeAttribute -> AType

frontend/type.icl

@@ -251,10 +251,10 @@ where
 type_error =: "Type error"
 type_error_format =: { form_properties = cNoProperties, form_attr_position = No }
 
-cannotUnify t1 t2 position=:(CP_Expression expr) common_defs err=:{ea_loc=[{ip_file}:_]}
+cannotUnify t1 t2 position=:(CP_Expression expr) common_defs err=:{ea_loc=[{ep_position}:_]}
 	= case tryToOptimizePosition expr of
 		Yes (id_name, line)
-			# err = errorHeadingWithStringPos {sp_file=ip_file, sp_name=id_name, sp_line=line} type_error err
+			# err = errorHeadingWithPositionNameAndLine type_error ep_position id_name line err
 			  err = { err & ea_file = err.ea_file <<< " cannot unify demanded type with offered type:\n" }
 			  err = { err & ea_file = err.ea_file <<< " " <:: (type_error_format, t1, No) <<< '\n' }
 			  err = { err & ea_file = err.ea_file <<< " " <:: (type_error_format, t2, No) <<< '\n' }
@@ -293,10 +293,10 @@ cannot_unify t1 t2 position common_defs err
 	  ea_file = ea_file <<< " " <:: (type_error_format, t2, No) <<< "\n"
 	= { err & ea_file = ea_file}
 
-existentialError position=:(CP_Expression expr) err=:{ea_loc=[{ip_file}:_]}
+existentialError position=:(CP_Expression expr) err=:{ea_loc=[{ep_position}:_]}
 	= case tryToOptimizePosition expr of
 		Yes (id_name, line)
-			# err = errorHeadingWithStringPos {sp_file=ip_file, sp_name=id_name, sp_line=line} type_error err
+			# err = errorHeadingWithPositionNameAndLine type_error ep_position id_name line err
 			-> { err & ea_file = err.ea_file <<< " attribute variable could not be universally quantified"<<< '\n' }
 		_
 			# err = errorHeading type_error err
@@ -2830,7 +2830,7 @@ where
 	{	fe_requirements	:: !Requirements
 	,	fe_context		:: !Optional [TypeContext]
 	,	fe_index		:: !Index
-	,	fe_location		:: !IdentPos
+	,	fe_ident		:: !Ident
 	}
 
 typeProgram :: !{! Group} !Int !*{# FunDef} !IndexRange  !(Optional Bool) !CommonDefs ![!GlobalInstanceIndex!] !{# DclModule} !NumberSet
@@ -3081,8 +3081,8 @@ where
 			= {err & ea_file = err.ea_file <<< "* annotated type " <<< type_name <<< " occurs non unique in inferred function type"<<< '\n'}
 
 	unify_requirements_of_functions :: ![FunctionRequirements] !TypeInput !*{!Type} !*TypeHeaps !*ErrorAdmin -> (!*{!Type},!*TypeHeaps,!*ErrorAdmin)
-	unify_requirements_of_functions [{fe_requirements={req_type_coercion_groups},fe_location={ip_ident}} : reqs_list] ti subst heaps ts_error
-		# (subst, heaps, ts_error) = foldSt (unify_requirements_within_one_position ip_ident ti) (reverse req_type_coercion_groups) (subst, heaps, ts_error)
+	unify_requirements_of_functions [{fe_requirements={req_type_coercion_groups},fe_ident} : reqs_list] ti subst heaps ts_error
+		# (subst, heaps, ts_error) = foldSt (unify_requirements_within_one_position fe_ident ti) (reverse req_type_coercion_groups) (subst, heaps, ts_error)
 		= unify_requirements_of_functions reqs_list ti subst heaps ts_error
 	unify_requirements_of_functions [] ti subst heaps ts_error
 		= (subst, heaps, ts_error)
@@ -3119,9 +3119,9 @@ where
 					-> (bitvects, subst)
 
 	build_coercion_env :: [FunctionRequirements] *{!Type} *Coercions {#CommonDefs} {#Int} *{#*{#TypeDefInfo}} *TypeHeaps !*ErrorAdmin -> (!.{!Type},!.Coercions,!.{#.{#TypeDefInfo}},!.TypeHeaps,!.ErrorAdmin);
-	build_coercion_env [{fe_requirements={req_type_coercion_groups},fe_location={ip_ident}} : reqs_list] subst coercion_env common_defs cons_var_vects type_signs type_var_heap error
+	build_coercion_env [{fe_requirements={req_type_coercion_groups},fe_ident} : reqs_list] subst coercion_env common_defs cons_var_vects type_signs type_var_heap error
 		# (subst, coercion_env, type_signs, type_var_heap, error)
-			= foldSt (build_coercion_env_for_alternative ip_ident common_defs cons_var_vects)
+			= foldSt (build_coercion_env_for_alternative fe_ident common_defs cons_var_vects)
 					req_type_coercion_groups
 					(subst, coercion_env, type_signs, type_var_heap, error)
 		= build_coercion_env reqs_list subst coercion_env common_defs cons_var_vects  type_signs type_var_heap error
@@ -3178,12 +3178,12 @@ where
 
 	collect_and_expand_overloaded_calls [] calls subst_and_heap
 		= (calls, subst_and_heap)
-	collect_and_expand_overloaded_calls [{fe_context=Yes context, fe_requirements={req_overloaded_calls,req_case_and_let_exprs}, fe_location, fe_index}:reqs] calls (subst, expr_heap)
+	collect_and_expand_overloaded_calls [{fe_context=Yes context, fe_requirements={req_overloaded_calls,req_case_and_let_exprs}, fe_index}:reqs] calls (subst, expr_heap)
 		# (_, context, subst) = arraySubst context subst
 		  subst_expr_heap = expand_case_or_let_types req_case_and_let_exprs (subst, expr_heap)
 		= collect_and_expand_overloaded_calls reqs [(Yes context, req_overloaded_calls, fe_index) : calls]
 				(foldSt expand_type_contexts req_overloaded_calls subst_expr_heap)
-	collect_and_expand_overloaded_calls [{fe_context, fe_requirements={req_overloaded_calls,req_case_and_let_exprs}, fe_location, fe_index}:reqs] calls subst_expr_heap
+	collect_and_expand_overloaded_calls [{fe_context, fe_requirements={req_overloaded_calls,req_case_and_let_exprs}, fe_index}:reqs] calls subst_expr_heap
 		# subst_expr_heap = expand_case_or_let_types req_case_and_let_exprs subst_expr_heap
 		= collect_and_expand_overloaded_calls reqs [(fe_context, req_overloaded_calls, fe_index) : calls]
 				(foldSt expand_type_contexts req_overloaded_calls subst_expr_heap) 
@@ -3299,7 +3299,6 @@ where
 		  {fun_ident,fun_arity,fun_body=TransformedBody {tb_args,tb_rhs},fun_pos, fun_info, fun_type} = fd
 		  temp_fun_type = type_of type
 		  ts_var_heap = makeBase fun_ident tb_args temp_fun_type.tst_args ts_var_heap
-		  fe_location = newPosition fun_ident fun_pos
 		  ts_error = setErrorPosition fun_ident fun_pos ts_error
 		  ts & ts_var_heap = ts_var_heap, ts_error = ts_error, ts_fun_defs = ts_fun_defs, ts_fun_env = ts_fun_env
 		  reqs = { req_overloaded_calls = [], req_type_coercion_groups = [], req_type_coercions = [],
@@ -3310,7 +3309,7 @@ where
 		  ts_expr_heap = storeAttribute rhs_expr_ptr temp_fun_type.tst_result.at_attribute ts.ts_expr_heap
 		  type_coercion_group_from_accu = { tcg_type_coercions = req_type_coercions, tcg_position = fun_pos }
 		  req_type_coercion_groups = [type_coercion_group_from_accu:rhs_reqs.req_type_coercion_groups]
-		= ( { fe_location = fe_location, fe_context = if (has_option fun_type) (Yes temp_fun_type.tst_context) No, fe_index = fun_index,
+		= ( { fe_ident = fun_ident, fe_context = if (has_option fun_type) (Yes temp_fun_type.tst_context) No, fe_index = fun_index,
 			  fe_requirements = { rhs_reqs & req_type_coercions = [], req_type_coercion_groups = req_type_coercion_groups }
 		    },
 		    {ts & ts_expr_heap = ts_expr_heap})

frontend/typesupport.dcl

@@ -5,7 +5,7 @@ import checksupport,utilities
 from unitype import ::Coercions, ::CoercionTree, ::AttributePartition, CT_Empty
 
 errorHeading :: !String !*ErrorAdmin -> *ErrorAdmin
-errorHeadingWithStringPos :: !StringPos !String !*ErrorAdmin -> *ErrorAdmin
+errorHeadingWithPositionNameAndLine :: !String !Position !String !Int !*ErrorAdmin -> *ErrorAdmin
 
 (<::) infixl :: !*File !(!Format, !a, !Optional TypeVarBeautifulizer) -> *File | writeType a
 

frontend/typesupport.icl

@@ -291,14 +291,17 @@ where
 		= (cur, [t:ts], env)
 
 errorHeading :: !String !*ErrorAdmin -> *ErrorAdmin
-errorHeading  error_kind err=:{ea_file,ea_loc = []}
+errorHeading error_kind err=:{ea_file,ea_loc = []}
 	= { err & ea_file = ea_file <<< error_kind <<< ':', ea_ok = False }
-errorHeading  error_kind err=:{ea_file,ea_loc = [ loc : _ ]}
-	= { err & ea_file = ea_file <<< error_kind <<< ' ' <<< loc <<< ':', ea_ok = False }
-
-errorHeadingWithStringPos :: !StringPos !String !*ErrorAdmin -> *ErrorAdmin
-errorHeadingWithStringPos string_pos error_kind err=:{ea_file}
-	= {err & ea_file = ea_file <<< error_kind <<< ' ' <<< string_pos <<< ':', ea_ok = False}
+errorHeading error_kind err=:{ea_file,ea_loc = [{ep_ident,ep_position} : _ ]}
+	= { err & ea_file = ea_file <<< error_kind <<< ' ' <<< stringPosition ep_ident.id_name ep_position <<< ':', ea_ok = False }
+
+errorHeadingWithPositionNameAndLine :: !String !Position !String !Int !*ErrorAdmin -> *ErrorAdmin
+errorHeadingWithPositionNameAndLine error_kind pos ident_name line_n err=:{ea_file}
+	# ea_file = (writePositionModuleName pos (ea_file <<< error_kind <<< " [")) <<< ','
+	| line_n == cNotALineNumber
+		= {err & ea_file = ea_file <<< ident_name <<< "]:", ea_ok = False}
+		= {err & ea_file = ea_file <<< line_n <<< ',' <<< ident_name <<< "]:", ea_ok = False}
 
 contextError class_symb err
 	# err = errorHeading "Overloading error" err

frontend/unitype.icl

@@ -1013,17 +1013,17 @@ uniquenessErrorVar free_var=:{fv_info_ptr} (TransformedBody {tb_args,tb_rhs}) me
 	# position = find_var_position_in_expression fv_info_ptr tb_rhs
 	= case position of
 		LinePos file_name line_n
-			# ea_file = err.ea_file <<< "Uniqueness error " <<< {ip_file=file_name,ip_line=line_n,ip_ident=free_var.fv_ident} <<< '\"' <<< mess <<< '\n'
+			# ea_file = err.ea_file <<< "Uniqueness error " <<< {sp_file=file_name,sp_line=line_n,sp_name=free_var.fv_ident.id_name} <<< '\"' <<< mess <<< '\n'
 			-> { err & ea_file = ea_file, ea_ok = False}
 		FunPos file_name line_n fun_name
-			# ea_file = err.ea_file <<< "Uniqueness error " <<< {ip_file=file_name,ip_line=line_n,ip_ident=free_var.fv_ident} <<< '\"' <<< mess <<< '\n'
+			# ea_file = err.ea_file <<< "Uniqueness error " <<< {sp_file=file_name,sp_line=line_n,sp_name=free_var.fv_ident.id_name} <<< '\"' <<< mess <<< '\n'
 			-> { err & ea_file = ea_file, ea_ok = False}			
 		_
 			-> uniquenessError (CP_Expression (FreeVar free_var)) mess err
 
 uniquenessError :: !CoercionPosition !String !*ErrorAdmin -> *ErrorAdmin
-uniquenessError position mess err=:{ea_file,ea_loc}
-	# ea_file = ea_file <<< "Uniqueness error " <<< hd ea_loc <<< ": \"" <<<  position <<< '\"' <<< mess <<< '\n'
+uniquenessError position mess err=:{ea_file,ea_loc=[{ep_ident,ep_position}:_]}
+	# ea_file = ea_file <<< "Uniqueness error " <<< stringPosition ep_ident.id_name ep_position <<< ": \"" <<<  position <<< '\"' <<< mess <<< '\n'
 	= { err & ea_file = ea_file, ea_ok = False}
 
 var_in_free_vars var_ptr []