Commit de27c3c0 authored by John van Groningen's avatar John van Groningen
Browse files

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
parent fb9c84a9
......@@ -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 =
......
......@@ -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 }
......
......@@ -1478,12 +1478,6 @@ instance == OverloadedPatternType
, ip_file :: !FileName
}
:: StringPos =
{ sp_name :: !String
, sp_line :: !Int
, sp_file :: !FileName
}
:: FileName :== String
:: FunctName :== String
......
......@@ -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)
......
......@@ -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}
......
......@@ -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 []
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment