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

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

parent efdb5ba1
......@@ -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)
......
......@@ -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}
......
......@@ -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)
......
......@@ -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
......
......@@ -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})
......
......@@ -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
......
......@@ -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
......
......@@ -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 []
......
Supports Markdown
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