refactor, replace type StringPos and function stringPosition by type...

refactor, replace type StringPos and function stringPosition by type StringPosition, add function for 'cannot unify demanded type with offered type' error

frontend/checksupport.dcl

@@ -65,7 +65,7 @@ where
 
 instance Erroradmin ErrorAdmin, CheckState
 
-stringPosition :: !String !Position -> StringPos
+instance <<< ErrorPosition
 
 checkError :: !a !b !*ErrorAdmin -> *ErrorAdmin | <<< a & <<< b
 	special a={#Char},b={#Char}; a=Ident,b={#Char}
@@ -92,7 +92,7 @@ instance toIdent ConsDef, (TypeDef a), ClassDef, MemberDef, FunDef, SelectorDef
 instance toIdent SymbIdent, TypeSymbIdent, BoundVar, TypeVar, ATypeVar, Ident
 
 instance toInt STE_Kind
-instance <<< IdentPos, StringPos
+instance <<< IdentPos
 writePositionModuleName :: !Position !*File -> *File
 
 ::	ExpressionInfo =

frontend/checksupport.icl

@@ -46,13 +46,27 @@ where
 	popErrorAdmin cs=:{cs_error}
 		= {cs & cs_error = popErrorAdmin cs_error}
 
-stringPosition :: !String !Position -> StringPos
-stringPosition id (LinePos file_name line_nr)
-	= { sp_name = id, sp_line = line_nr, sp_file = file_name }
-stringPosition id (PreDefPos file_name)
-	= { sp_name = id, sp_line = cNotALineNumber, sp_file = file_name.id_name }
-stringPosition id NoPos
-	= { sp_name = id, sp_line = cNotALineNumber, sp_file = "???" }
+instance <<< ErrorPosition
+where
+	(<<<) file {ep_ident,ep_position}
+		= writeErrorPosition ep_position ep_ident.id_name (file <<< '[') <<< ']'
+
+::	StringPosition = { sp_name :: !String, sp_position :: !Position }
+
+instance <<< StringPosition
+where
+	(<<<) file {sp_name,sp_position}
+		= writeErrorPosition sp_position sp_name (file <<< '[') <<< ']'
+
+writeErrorPosition :: !Position !{#Char} !*File -> *File
+writeErrorPosition (LinePos module_name line_n) name file
+	| line_n == cNotALineNumber
+		= file <<< module_name <<< ',' <<< name
+		= file <<< module_name <<< ',' <<< line_n <<< ',' <<< name
+writeErrorPosition (PreDefPos {id_name}) name file
+	= file <<< id_name <<< ',' <<< name
+writeErrorPosition _ name file
+	= file <<< "???" <<< ',' <<< name
 
 writePositionModuleName :: !Position !*File -> *File
 writePositionModuleName (LinePos file_name _) file
@@ -65,14 +79,14 @@ writePositionModuleName NoPos 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=[{ep_ident,ep_position}:_]}
-	= { error & ea_file = ea_file <<< "Error " <<< stringPosition ep_ident.id_name ep_position <<< ": " <<< id  <<< " " <<< mess <<< '\n', ea_ok = False }
+checkError id mess error=:{ea_file,ea_loc=[ep:_]}
+	= { error & ea_file = ea_file <<< "Error " <<< ep <<< ": " <<< id  <<< " " <<< mess <<< '\n', ea_ok = False }
 
 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=[{ep_ident,ep_position}:_]}
-	= { error & ea_file = ea_file <<< "Warning " <<< stringPosition ep_ident.id_name ep_position <<< ": " <<< id  <<< " " <<< mess <<< '\n' }
+checkWarning id mess error=:{ea_file,ea_loc=[ep:_]}
+	= { error & ea_file = ea_file <<< "Warning " <<< ep <<< ": " <<< id  <<< " " <<< mess <<< '\n' }
 
 checkErrorIdentWithIdentPos :: !IdentPos !Ident !a !*ErrorAdmin -> .ErrorAdmin | <<< a;
 checkErrorIdentWithIdentPos ident_pos id mess error=:{ea_file}
@@ -80,7 +94,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}
-	= { error & ea_file = ea_file <<< "Error " <<< stringPosition ident.id_name pos <<< ": " <<< id  <<< ' ' <<< mess <<< '\n', ea_ok = False }
+	= { error & ea_file = ea_file <<< "Error " <<< {ep_ident=ident,ep_position=pos} <<< ": " <<< id <<< ' ' <<< mess <<< '\n', ea_ok = False }
 
 checkErrorWithIdentPos :: !IdentPos !a !*ErrorAdmin -> .ErrorAdmin | <<< a;
 checkErrorWithIdentPos ident_pos mess error=:{ea_file}
@@ -88,16 +102,15 @@ checkErrorWithIdentPos ident_pos mess error=:{ea_file}
 
 checkErrorWithPosition :: !Ident !Position !a !*ErrorAdmin -> .ErrorAdmin | <<< a;
 checkErrorWithPosition ident pos mess error=:{ea_file}
-	= { error & ea_file = ea_file <<< "Error " <<< stringPosition ident.id_name pos <<< ": " <<< mess <<< '\n', ea_ok = False }
+	= { error & ea_file = ea_file <<< "Error " <<< {ep_ident=ident,ep_position=pos} <<< ": " <<< mess <<< '\n', ea_ok = False }
 
 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 }
+	= { error & ea_file = ea_file <<< "Error " <<< {sp_name=string,sp_position=pos} <<< ": " <<< mess <<< '\n', ea_ok = False }
 
 checkWarningWithPosition :: !Ident !Position !a !*ErrorAdmin -> .ErrorAdmin | <<< a;
 checkWarningWithPosition ident pos mess error=:{ea_file}
-	= { error & ea_file = ea_file <<< "Warning " <<< stringPosition ident.id_name pos <<< ": " <<< mess <<< '\n' }
+	= { error & ea_file = ea_file <<< "Warning " <<< {ep_ident=ident,ep_position=pos} <<< ": " <<< mess <<< '\n' }
 
 class envLookUp a :: !a !(Env Ident .b) -> (!Bool,.b)
 
@@ -586,12 +599,6 @@ where
 		= file <<< '[' <<< ip_file <<< ',' <<< ip_ident <<< ']'
 		= file <<< '[' <<< ip_file <<< ',' <<< ip_line <<< ',' <<< ip_ident <<< ']'
 
-instance <<< StringPos where
-	(<<<) file {sp_file,sp_line,sp_name}
-	| sp_line == cNotALineNumber
-		= file <<< '[' <<< sp_file <<< ',' <<< sp_name <<< ']'
-		= file <<< '[' <<< sp_file <<< ',' <<< sp_line <<< ',' <<< sp_name <<< ']'
-
 import_ident :: Ident
 import_ident =: { id_name = "import", id_info = nilPtr }
 

frontend/syntax.dcl

@@ -1478,12 +1478,6 @@ instance == OverloadedPatternType
 	,	ip_file		:: !FileName
 	}
 
-::	StringPos =
-	{	sp_name		:: !String
-	,	sp_line		:: !Int
-	,	sp_file		:: !FileName
-	}
-
 :: FileName			:== String
 
 :: FunctName		:== String

frontend/type.icl

@@ -255,10 +255,8 @@ type_error_format =: { form_properties = cNoProperties, form_attr_position = No
 cannotUnify t1 t2 position=:(CP_Expression expr) common_defs err=:{ea_loc=[{ep_position}:_]}
 	= case tryToOptimizePosition expr of
 		Yes (id_name, line)
-			# 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' }
+			# (err=:{ea_file}) = errorHeadingWithPositionNameAndLine type_error ep_position id_name line err
+			  err & ea_file = write_cannot_unify_error_message t1 t2 type_error_format ea_file
 			-> err
 		_
 			-> cannot_unify t1 t2 position common_defs err
@@ -289,11 +287,15 @@ cannot_unify t1 t2 position common_defs err
 	  				-> ea_file <<< " near " <<< position <<< " :"
 	  			_
 	  				-> ea_file
-	  ea_file = ea_file <<< " cannot unify demanded type with offered type:\n"
-	  ea_file = ea_file <<< " " <:: (type_error_format, t1, No) <<< "\n"
-	  ea_file = ea_file <<< " " <:: (type_error_format, t2, No) <<< "\n"
+	  ea_file = write_cannot_unify_error_message t1 t2 type_error_format ea_file
 	= { err & ea_file = ea_file}
 
+write_cannot_unify_error_message t1 t2 type_error_format error_file
+	# error_file = error_file <<< " cannot unify demanded type with offered type:\n"
+	  error_file = error_file <<< " " <:: (type_error_format, t1, No) <<< '\n'
+	  error_file = error_file <<< " " <:: (type_error_format, t2, No) <<< '\n'
+	= error_file
+
 existentialError position=:(CP_Expression expr) err=:{ea_loc=[{ep_position}:_]}
 	= case tryToOptimizePosition expr of
 		Yes (id_name, line)

frontend/typesupport.icl

@@ -293,8 +293,8 @@ where
 errorHeading :: !String !*ErrorAdmin -> *ErrorAdmin
 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 = [{ep_ident,ep_position} : _ ]}
-	= { err & ea_file = ea_file <<< error_kind <<< ' ' <<< stringPosition ep_ident.id_name ep_position <<< ':', ea_ok = False }
+errorHeading error_kind err=:{ea_file,ea_loc = [ep : _]}
+	= { err & ea_file = ea_file <<< error_kind <<< ' ' <<< ep <<< ':', ea_ok = False }
 
 errorHeadingWithPositionNameAndLine :: !String !Position !String !Int !*ErrorAdmin -> *ErrorAdmin
 errorHeadingWithPositionNameAndLine error_kind pos ident_name line_n err=:{ea_file}

frontend/unitype.icl

@@ -1013,14 +1013,14 @@ uniquenessErrorVar {fv_info_ptr,fv_ident} (TransformedBody {tb_args,tb_rhs}) mes
 	# 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 " <<< {sp_file=file_name,sp_line=line_n,sp_name=fv_ident.id_name} <<< '\"' <<< mess <<< '\n'
+			# ea_file = err.ea_file <<< "Uniqueness error " <<< {ep_ident=fv_ident,ep_position=position} <<< '\"' <<< mess <<< '\n'
 			-> {err & ea_file = ea_file, ea_ok = False}
 		_
 			-> uniquenessErrorFreeVar fv_ident mess err
 
 uniquenessErrorFreeVar :: !Ident !String !*ErrorAdmin -> *ErrorAdmin
-uniquenessErrorFreeVar ident mess err=:{ea_file,ea_loc=[{ep_ident,ep_position}:_]}
-	# ea_file = ea_file <<< "Uniqueness error " <<< stringPosition ep_ident.id_name ep_position <<< ": \"" <<< ident <<< '\"' <<< mess <<< '\n'
+uniquenessErrorFreeVar ident mess err=:{ea_file,ea_loc=[ep:_]}
+	# ea_file = ea_file <<< "Uniqueness error " <<< ep <<< ": \"" <<< ident <<< '\"' <<< mess <<< '\n'
 	= {err & ea_file = ea_file, ea_ok = False}
 
 var_in_free_vars var_ptr []