Commit 54b93c86 authored by John van Groningen's avatar John van Groningen
Browse files

refactor ErrorAdmin class, change setErrorAdmin and pushErrorAdmin to...

refactor ErrorAdmin class, change setErrorAdmin and pushErrorAdmin to setErrorPosition and pushErrorPosition with Ident and Position arguments instead of IdentPos, add function errorHeadingWithStringPos
parent e6ded727
......@@ -284,7 +284,7 @@ where
| mark < cMAXINT
| is_synonym_or_new_type td_rhs
# marks = { marks & [gi_module,gi_index] = cChecking }
error = pushErrorAdmin (newPosition td_ident td_pos) error
error = pushErrorPosition td_ident td_pos error
(group, marks, error) = check_cyclic_type_defs td_used_types type_defs [td : group] marks error
error = popErrorAdmin error
= (group, { marks & [gi_module,gi_index] = cMAXINT }, error)
......@@ -705,7 +705,7 @@ where
anal_type_def modules gi=:{gi_module,gi_index} (group_properties, conds, as=:{as_error})
# {com_type_defs,com_cons_defs} = modules.[gi_module]
{td_ident,td_pos,td_args,td_rhs} = com_type_defs.[gi_index]
as_error = pushErrorAdmin (newPosition td_ident td_pos) as_error
as_error = pushErrorPosition td_ident td_pos as_error
(type_properties, (conds, as)) = anal_rhs_of_type_def modules com_cons_defs td_rhs (conds, {as & as_error = as_error})
= (combineTypeProperties group_properties type_properties, conds, {as & as_error = popErrorAdmin as.as_error })
where
......@@ -833,7 +833,7 @@ where
= as
with
check_abstract_type spec_properties td_ident td_args td_pos as
# as_error = pushErrorAdmin (newPosition td_ident td_pos) as.as_error
# as_error = pushErrorPosition td_ident td_pos as.as_error
| check_coercibility spec_properties properties
| check_hyperstrictness spec_properties properties
| spec_properties bitand cIsNonCoercible == 0
......@@ -935,7 +935,7 @@ where
{class_args,class_context,class_members,class_arity,class_pos,class_ident} = com_class_defs.[class_index]
(class_kind_vars, as_kind_heap) = fresh_kind_vars class_arity [] as.as_kind_heap
(as_type_var_heap,as_kind_heap) = bind_kind_vars class_args class_kind_vars as.as_type_var_heap as_kind_heap
as_error = pushErrorAdmin (newPosition class_ident class_pos) as.as_error
as_error = pushErrorPosition class_ident class_pos as.as_error
class_infos = { class_infos & [class_module,class_index] = cyclicClassInfoMark }
(class_infos, as) = determine_kinds_of_context_classes class_context (class_infos,
{ as & as_kind_heap = as_kind_heap, as_type_var_heap = as_type_var_heap, as_error = as_error })
......@@ -1105,7 +1105,7 @@ where
check_kinds_of_class_instance :: !{#CommonDefs} !ClassInstance !*ClassDefInfos !*AnalyseState -> (!*ClassDefInfos, !*AnalyseState)
check_kinds_of_class_instance common_defs {ins_class_index,ins_class_ident={ci_ident=Ident class_ident,ci_arity},ins_ident,ins_pos,ins_type={it_vars,it_types,it_context}} class_infos
as=:{as_type_var_heap,as_kind_heap,as_error}
# as_error = pushErrorAdmin (newPosition ins_ident ins_pos) as_error
# as_error = pushErrorPosition ins_ident ins_pos as_error
(as_type_var_heap, as_kind_heap) = bindFreshKindVariablesToTypeVars it_vars as_type_var_heap as_kind_heap
as = { as & as_type_var_heap = as_type_var_heap, as_kind_heap = as_kind_heap, as_error = as_error }
ins_class = {glob_module=ins_class_index.gi_module,glob_object={ds_index=ins_class_index.gi_index,ds_ident=class_ident,ds_arity=ci_arity}}
......@@ -1121,7 +1121,7 @@ where
where
check_kinds_of_generic :: !{#CommonDefs} !GenericDef !*ClassDefInfos !*GenericHeap !*AnalyseState -> (!*ClassDefInfos, !*GenericHeap, !*AnalyseState)
check_kinds_of_generic common_defs {gen_type, gen_ident, gen_pos, gen_vars, gen_info_ptr} class_infos gen_heap as
# as = {as & as_error = pushErrorAdmin (newPosition gen_ident gen_pos) as.as_error}
# as = {as & as_error = pushErrorPosition gen_ident gen_pos as.as_error}
# (class_infos, as) = check_kinds_of_symbol_type common_defs gen_type class_infos as
# (kinds, as) = mapSt retrieve_tv_kind gen_type.st_vars as
# as = check_kinds_of_generic_vars (take (length gen_vars) kinds) as
......@@ -1173,7 +1173,7 @@ where
(expression_heap,class_infos,as) = check_kinds_of_dynamics common_defs fun_info.fi_dynamics expression_heap class_infos as
= case fun_type of
Yes symbol_type
# as_error = pushErrorAdmin (newPosition fun_ident fun_pos) as.as_error
# as_error = pushErrorPosition fun_ident fun_pos as.as_error
(class_infos, as) = check_kinds_of_symbol_type common_defs symbol_type class_infos { as & as_error = as_error }
-> (icl_fun_defs, class_infos, expression_heap, { as & as_error = popErrorAdmin as.as_error })
No
......@@ -1187,7 +1187,7 @@ where
where
check_kinds_of_dcl_fuction common_defs dcl_functions fun_index (class_infos, as)
# {ft_type,ft_ident,ft_pos} = dcl_functions.[fun_index]
as_error = pushErrorAdmin (newPosition ft_ident ft_pos) as.as_error
as_error = pushErrorPosition ft_ident ft_pos as.as_error
(class_infos, as) = check_kinds_of_symbol_type common_defs ft_type class_infos {as & as_error = as_error}
= (class_infos, { as & as_error = popErrorAdmin as.as_error})
......
......@@ -21,7 +21,7 @@ where
check_type_class module_index opt_icl_info class_index (class_defs, member_defs, type_defs, modules, type_heaps, cs=:{cs_symbol_table,cs_error})
| has_to_be_checked module_index opt_icl_info class_index
# (class_def=:{class_ident,class_pos,class_args,class_context,class_members}, class_defs) = class_defs![class_index]
cs = {cs & cs_error = setErrorAdmin (newPosition class_ident class_pos) cs_error }
cs & cs_error = setErrorPosition class_ident class_pos cs_error
(class_args, class_context, type_defs, class_defs, modules, type_heaps, cs)
= checkSuperClasses class_args class_context module_index type_defs class_defs modules type_heaps cs
class_defs = { class_defs & [class_index] = { class_def & class_context = class_context, class_args = class_args }}
......@@ -74,8 +74,7 @@ where
= (next_inst_index, collected_funtypes, collected_instances, type_defs, class_defs, modules, heaps, cs)
check_dcl_functions module_index [fun_type=:{ft_ident,ft_type,ft_pos,ft_specials} : fun_types] fun_index
next_inst_index collected_funtypes collected_instances type_defs class_defs modules heaps cs
# position = newPosition ft_ident ft_pos
cs = { cs & cs_error = setErrorAdmin position cs.cs_error }
# cs & cs_error = setErrorPosition ft_ident ft_pos cs.cs_error
(ft_type, ft_specials, type_defs, class_defs, modules, hp_type_heaps, cs)
= checkFunctionType module_index ft_type ft_specials type_defs class_defs modules heaps.hp_type_heaps cs
(spec_types, next_inst_index, collected_instances, heaps, cs_predef_symbols,cs_error)
......@@ -116,8 +115,7 @@ where
check_function_types :: !DclInstanceMemberTypeAndFunctions !ModuleIndex !v:{#CheckedTypeDef} !w:{#ClassDef} !v:{#DclModule} !*Heaps !*CheckState
-> (![FunType],!v:{#CheckedTypeDef},!w:{#ClassDef},!v:{#DclModule},!*Heaps,!*CheckState)
check_function_types (DclInstanceMemberTypes fun_type=:{ft_ident,ft_type,ft_pos,ft_specials} fun_types) module_index type_defs class_defs modules heaps cs
# position = newPosition ft_ident ft_pos
cs = { cs & cs_error = setErrorAdmin position cs.cs_error }
# cs & cs_error = setErrorPosition ft_ident ft_pos cs.cs_error
(ft_type, ft_specials, type_defs, class_defs, modules, hp_type_heaps, cs)
= checkFunctionType module_index ft_type ft_specials type_defs class_defs modules heaps.hp_type_heaps cs
(new_info_ptr, hp_var_heap) = newPtr VI_Empty heaps.hp_var_heap
......@@ -179,8 +177,7 @@ where
check_class_member module_index opt_icl_info member_index (member_defs, type_defs, class_defs, modules, type_heaps, var_heap, cs)
# (member_def=:{me_ident,me_type,me_pos,me_class,me_default_implementation}, member_defs) = member_defs![member_index]
| has_to_be_checked opt_icl_info me_class
# position = newPosition me_ident me_pos
cs & cs_error = setErrorAdmin position cs.cs_error
# cs & cs_error = setErrorPosition me_ident me_pos cs.cs_error
(me_type, type_defs, class_defs, modules, type_heaps, cs)
= checkMemberType module_index me_type type_defs class_defs modules type_heaps cs
(me_default_implementation,cs) = check_generic_default me_default_implementation module_index cs
......@@ -260,7 +257,7 @@ where
check_instance :: !ClassInstance !Index !u:InstanceSymbols !*TypeHeaps !*CheckState -> (!ClassInstance, !u:InstanceSymbols, !*TypeHeaps, !*CheckState)
check_instance ins=:{ins_class_ident={ci_ident=Ident {id_name,id_info}},ins_pos,ins_ident} module_index is type_heaps cs=:{cs_symbol_table}
# ({ste_index,ste_kind}, cs_symbol_table) = readPtr id_info cs_symbol_table
# cs = pushErrorAdmin (newPosition ins_ident ins_pos) { cs & cs_symbol_table = cs_symbol_table }
# cs = pushErrorPosition ins_ident ins_pos {cs & cs_symbol_table = cs_symbol_table}
# (ins, is, type_heaps, cs) = case ste_kind of
STE_Class
# (class_def, is) = is!is_class_defs.[ste_index]
......@@ -272,7 +269,7 @@ where
= (ins, is, type_heaps, popErrorAdmin cs)
check_instance ins=:{ins_class_ident={ci_ident=QualifiedIdent module_ident class_name},ins_pos,ins_ident}
module_index is type_heaps cs
# cs = pushErrorAdmin (newPosition ins_ident ins_pos) cs
# cs = pushErrorPosition ins_ident ins_pos cs
# (found,{decl_kind,decl_ident=type_ident,decl_index=class_index},cs) = search_qualified_ident module_ident class_name ClassNameSpaceN cs
| not found
# cs = {cs & cs_error = checkError ("'"+++module_ident.id_name+++"'."+++class_name) "class undefined" cs.cs_error}
......@@ -393,7 +390,7 @@ where
# class_member = class_members.[class_member_n]
| instance_member_n < size ins_members
# ins_member = ins_members.[instance_member_n]
cs = setErrorAdmin (newPosition class_ident ins_pos) cs
cs = setErrorPosition class_ident ins_pos cs
| ins_member.cim_arity== -1 // already added by add_possible_default_instance
# (instance_member_n,ins_members,ins_member_types_and_functions,instance_types,member_defs,type_defs,icl_functions,modules,var_heap,type_heaps,cs)
= add_default_instance_or_report_error_for_exported_instance class_member member_mod_index ins_type ins_pos
......@@ -936,7 +933,7 @@ where
= ([], [], member_defs, modules, type_heaps, var_heap, cs_error)
# class_member = class_members.[mem_offset]
({me_ident,me_type,me_priority,me_class_vars}, member_defs, modules) = getMemberDef member_mod_index class_member.ds_index module_index member_defs modules
cs_error = pushErrorAdmin (newPosition class_ident ins_pos) cs_error
cs_error = pushErrorPosition class_ident ins_pos cs_error
(instance_type, new_ins_specials, type_heaps, Yes (modules, _), cs_error)
= determineTypeOfMemberInstance me_type me_class_vars ins_type ins_specials type_heaps (Yes (modules, {}, cUndef)) cs_error
(instance_type, new_ins_specials, member_types, modules, type_heaps, cs_error)
......@@ -1163,7 +1160,7 @@ checkFunction :: !FunDef !Index !FunctionOrMacroIndex !Level !Int !*{#FunDef} !*
checkFunction fun_def=:{fun_ident,fun_pos,fun_body,fun_type,fun_kind,fun_info={fi_properties}} mod_index fun_index def_level local_functions_index_offset
fun_defs e_info=:{ef_type_defs,ef_modules,ef_class_defs,ef_is_macro_fun} heaps=:{hp_var_heap,hp_expression_heap,hp_type_heaps,hp_generic_heap} cs=:{cs_error}
# function_ident_for_errors = ident_for_errors_from_fun_symb_and_fun_kind fun_ident fun_kind
# cs = {cs & cs_error = pushErrorAdmin (newPosition function_ident_for_errors fun_pos) cs_error}
# cs = {cs & cs_error = pushErrorPosition function_ident_for_errors fun_pos cs_error}
(fun_type, ef_type_defs, ef_class_defs, ef_modules, hp_var_heap, hp_type_heaps, cs)
= check_function_type fun_type mod_index (fun_kind == FK_Caf) ef_type_defs ef_class_defs ef_modules hp_var_heap hp_type_heaps cs
......@@ -3221,7 +3218,7 @@ check_module2 mod_ident mod_modification_time mod_imported_objects mod_imports m
# icl_functions = {icl_functions & [index_of_member_fun] = function}
-> (icl_functions, type_heaps, cs_error)
# ({fun_ident,fun_pos},icl_functions) = icl_functions![index_of_member_fun]
cs_error = pushErrorAdmin (newPosition fun_ident fun_pos) cs_error
cs_error = pushErrorPosition fun_ident fun_pos cs_error
cs_error = specified_member_type_incorrect_error err_code cs_error
cs_error = popErrorAdmin cs_error
icl_functions = {icl_functions & [index_of_member_fun].fun_type = Yes derived_symbol_type}
......@@ -3439,7 +3436,7 @@ addImportedSymbolsToSymbolTable importing_mod opt_macro_range modules_in_compone
where
add_impl_imported_symbols_with_new_error_pos opt_macro_range importing_mod modules_in_component_set imports_ikh
(mod_index, position) (decls_accu, visited_modules, dcl_modules, cs)
# cs = pushErrorAdmin (newPosition import_ident position) cs
# cs = pushErrorPosition import_ident position cs
(decls_accu, visited_modules, dcl_modules, cs)
= add_impl_imported_symbols opt_macro_range importing_mod modules_in_component_set imports_ikh
mod_index (decls_accu, visited_modules, dcl_modules, cs)
......@@ -3473,7 +3470,7 @@ addImportedSymbolsToSymbolTable importing_mod opt_macro_range modules_in_compone
(decls_accu, visited_modules, dcl_modules, cs)
add_expl_imported_symbols_with_new_error_pos opt_macro_range importing_mod (decls, position) (decls_accu, dcl_modules, cs)
# cs = pushErrorAdmin (newPosition import_ident position) cs
# cs = pushErrorPosition import_ident position cs
(decls_accu, dcl_modules, cs) = foldSt (add_expl_imp_declaration opt_macro_range importing_mod) decls (decls_accu, dcl_modules, cs)
= (decls_accu, dcl_modules, popErrorAdmin cs)
......
......@@ -190,7 +190,7 @@ checkFunctionBodies :: !FunctionBody !Ident !.ExpressionInput !*ExpressionState
checkFunctionBodies (ParsedBody [{pb_args,pb_rhs={rhs_alts,rhs_locals}, pb_position} : bodies]) function_ident_for_errors e_input=:{ei_expr_level,ei_mod_index}
e_state=:{es_var_heap, es_fun_defs} e_info cs
# cs = pushErrorAdmin (newPosition function_ident_for_errors pb_position) cs
# cs = pushErrorPosition function_ident_for_errors pb_position cs
(aux_patterns, (var_env, array_patterns), {ps_var_heap,ps_fun_defs}, e_info, cs)
= check_patterns pb_args {pi_def_level = ei_expr_level, pi_mod_index = ei_mod_index, pi_is_node_pattern = False} ([], [])
{ps_var_heap = es_var_heap, ps_fun_defs = es_fun_defs} e_info cs
......@@ -239,7 +239,7 @@ where
check_function_bodies free_vars fun_args [{pb_args,pb_rhs={rhs_alts,rhs_locals},pb_position} : bodies]
e_input=:{ei_expr_level,ei_mod_index} e_state=:{es_var_heap,es_fun_defs} e_info cs
# cs = pushErrorAdmin (newPosition function_ident_for_errors pb_position) cs
# cs = pushErrorPosition function_ident_for_errors pb_position cs
# (aux_patterns, (var_env, array_patterns), {ps_var_heap,ps_fun_defs}, e_info, cs)
= check_patterns pb_args { pi_def_level = ei_expr_level, pi_mod_index = ei_mod_index, pi_is_node_pattern = False } ([], [])
{ps_var_heap = es_var_heap,ps_fun_defs = es_fun_defs} e_info cs
......@@ -564,7 +564,7 @@ where
check_sequential_let :: [FreeVar] NodeDefWithLocals ExpressionInput *ExpressionState *ExpressionInfo *CheckState -> *(!Expression,!AuxiliaryPattern,!(![Ident],![ArrayPattern]),![FreeVar],!*ExpressionState,!*ExpressionInfo,!*CheckState);
check_sequential_let free_vars {ndwl_def={bind_src,bind_dst},ndwl_locals, ndwl_position} e_input=:{ei_expr_level,ei_mod_index,ei_local_functions_index_offset} e_state e_info cs
# cs = pushErrorAdmin (newPosition {id_name="<node definition>", id_info=nilPtr} ndwl_position) cs
# cs = pushErrorPosition {id_name="<node definition>", id_info=nilPtr} ndwl_position cs
(loc_defs, (loc_env, loc_array_patterns), e_state, e_info, cs) = checkLhssOfLocalDefs ei_expr_level ei_mod_index ndwl_locals ei_local_functions_index_offset e_state e_info cs
(src_expr, free_vars, e_state, e_info, cs) = checkExpression free_vars bind_src e_input e_state e_info cs
(src_expr, free_vars, e_state, e_info, cs)
......@@ -753,7 +753,7 @@ where
-> *(CasePatterns,CasePatterns,[(Bind Ident (Ptr VarInfo))],(Optional ((Optional FreeVar),Expression)),[FreeVar],*ExpressionState,*ExpressionInfo,*CheckState)
check_case_alt free_vars {calt_pattern,calt_rhs={rhs_alts,rhs_locals},calt_position} patterns pattern_scheme pattern_variables defaul case_name
e_input=:{ei_expr_level,ei_mod_index} e_state=:{es_fun_defs,es_var_heap,es_dynamics=outer_dynamics} e_info cs
# cs = pushErrorAdmin (newPosition {id_name="<case pattern>", id_info=nilPtr} calt_position) cs
# cs = pushErrorPosition {id_name="<case pattern>", id_info=nilPtr} calt_position cs
(pattern, (var_env, array_patterns), {ps_fun_defs,ps_var_heap}, e_info, cs)
= checkPattern calt_pattern No { pi_def_level = ei_expr_level, pi_mod_index = ei_mod_index, pi_is_node_pattern = False } ([], [])
{ps_var_heap = es_var_heap,ps_fun_defs = es_fun_defs} e_info cs
......@@ -979,7 +979,7 @@ checkExpression free_vars (PE_Matches case_ident expr pattern position) e_input=
# (expr, free_vars, e_state, e_info, cs) = checkExpression free_vars expr e_input e_state e_info cs
{es_fun_defs,es_var_heap,es_expr_heap} = e_state
ps = {ps_var_heap = es_var_heap,ps_fun_defs = es_fun_defs}
cs = pushErrorAdmin (newPosition {id_name="<pattern>", id_info=nilPtr} position) cs
cs = pushErrorPosition {id_name="<pattern>", id_info=nilPtr} position cs
(pattern, (_/*var_env*/, _/*array_patterns*/), {ps_fun_defs,ps_var_heap}, e_info, cs)
= checkPattern pattern No { pi_def_level = ei_expr_level, pi_mod_index = ei_mod_index, pi_is_node_pattern = False } ([], []) ps e_info cs
cs = popErrorAdmin cs
......@@ -2252,7 +2252,7 @@ convertSubPattern AP_Empty result_expr pattern_position var_store expr_heap opt_
= convertSubPattern (AP_WildCard No) EE pattern_position var_store expr_heap opt_dynamics cs
checkAndTransformPatternIntoBind free_vars [{nd_dst,nd_alts,nd_locals,nd_position} : local_defs] e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs
# cs = pushErrorAdmin (newPosition {id_name="<node definition>", id_info=nilPtr} nd_position) cs
# cs = pushErrorPosition {id_name="<node definition>", id_info=nilPtr} nd_position cs
(bind_src, free_vars, e_state, e_info, cs) = checkRhs free_vars nd_alts nd_locals
{e_input & ei_expr_level = ei_expr_level + 1} e_state e_info cs
(binds_of_bind, es_var_heap, es_expr_heap, e_info, cs)
......@@ -2999,11 +2999,11 @@ determinePatternVariable No var_heap
# (new_info_ptr, var_heap) = newPtr VI_Empty var_heap
= ({ bind_src = newVarId "_x", bind_dst = new_info_ptr }, var_heap)
pushErrorAdmin2 _ NoPos cs=:{cs_error={ea_loc=[top_of_stack:_]}}
pushErrorAdmin2 _ NoPos cs=:{cs_error={ea_loc=ea_loc=:[top_of_stack:_]}}
// there is no position info, push current position to balance pop calls
= pushErrorAdmin top_of_stack cs
= {cs & cs_error.ea_loc=[top_of_stack:ea_loc]}
pushErrorAdmin2 string pos=:(LinePos _ _) cs
= pushErrorAdmin (newPosition {id_name=string, id_info=nilPtr} pos) cs
= pushErrorPosition {id_name=string, id_info=nilPtr} pos cs
allocate_bound_var :: !FreeVar !*ExpressionHeap -> (!BoundVar, !.ExpressionHeap)
allocate_bound_var {fv_ident, fv_info_ptr} expr_heap
......
......@@ -29,7 +29,7 @@ where
check_generic index mod_index gen_defs type_defs class_defs modules heaps cs
# (gen_def=:{gen_ident, gen_pos}, gen_defs) = gen_defs![index]
# cs = pushErrorAdmin (newPosition gen_ident gen_pos) cs
# cs = pushErrorPosition gen_ident gen_pos cs
# (gen_def, heaps) = alloc_gen_info gen_def heaps
......@@ -230,7 +230,7 @@ where
# (case_def=:{gc_pos,gc_type,gc_gcf}, gen_case_defs) = gen_case_defs![index]
= case gc_gcf of
GCF gc_ident gcf=:{gcf_gident}
# cs = pushErrorAdmin (newPosition gc_ident gc_pos) cs
# cs = pushErrorPosition gc_ident gc_pos cs
# (gc_type, gc_type_cons, type_defs, modules, heaps, cs)
= check_instance_type mod_index gc_type type_defs modules heaps cs
# (generic_gi, cs) = get_generic_index gcf_gident mod_index cs
......@@ -242,7 +242,7 @@ where
# cs = popErrorAdmin cs
-> (gen_case_defs, generic_defs, type_defs, class_defs, modules, heaps, cs)
GCFS gcfs
# cs = pushErrorAdmin (newPosition {id_name="derive generic superclass",id_info=nilPtr} gc_pos) cs
# cs = pushErrorPosition {id_name="derive generic superclass",id_info=nilPtr} gc_pos cs
# (gc_type, gc_type_cons, type_defs, modules, heaps, cs)
= check_instance_type mod_index gc_type type_defs modules heaps cs
| not cs.cs_error.ea_ok
......@@ -254,7 +254,7 @@ where
# gen_case_defs = {gen_case_defs & [index] = case_def}
-> (gen_case_defs, generic_defs, type_defs, class_defs, modules, heaps, cs)
GCFC _ gcfc_class_ident=:{id_info}
# cs = pushErrorAdmin (newPosition {id_name="derive generic superclass",id_info=nilPtr} gc_pos) cs
# cs = pushErrorPosition {id_name="derive generic superclass",id_info=nilPtr} gc_pos cs
# (gc_type, gc_type_cons, type_defs, modules, heaps, cs)
= check_instance_type mod_index gc_type type_defs modules heaps cs
| not cs.cs_error.ea_ok
......@@ -283,7 +283,7 @@ where
cs = popErrorAdmin cs
= (gen_case_defs,cs)
GCFCExcept _ gcfc_class_ident=:{id_info} except_class_names
# cs = pushErrorAdmin (newPosition {id_name="derive generic superclass",id_info=nilPtr} gc_pos) cs
# cs = pushErrorPosition {id_name="derive generic superclass",id_info=nilPtr} gc_pos cs
# (gc_type, gc_type_cons, type_defs, modules, heaps, cs)
= check_instance_type mod_index gc_type type_defs modules heaps cs
| not cs.cs_error.ea_ok
......
......@@ -57,8 +57,8 @@ cConversionTableSize :== 10
class Erroradmin state
where
pushErrorAdmin :: !IdentPos *state -> *state
setErrorAdmin :: !IdentPos *state -> *state
pushErrorPosition :: !Ident !Position *state -> *state
setErrorPosition :: !Ident !Position *state -> *state
popErrorAdmin :: *state -> *state
instance Erroradmin ErrorAdmin, CheckState
......
......@@ -26,25 +26,25 @@ where
instance Erroradmin ErrorAdmin
where
pushErrorAdmin pos error=:{ea_loc}
= { error & ea_loc = [pos : ea_loc] }
pushErrorPosition ident pos error=:{ea_loc}
= {error & ea_loc = [newPosition ident pos : ea_loc]}
setErrorAdmin pos error
= { error & ea_loc = [pos] }
setErrorPosition ident pos error
= {error & ea_loc = [newPosition ident pos]}
popErrorAdmin error=:{ea_loc = [_:ea_locs]}
= { error & ea_loc = ea_locs }
= {error & ea_loc = ea_locs}
instance Erroradmin CheckState
where
pushErrorAdmin pos cs=:{cs_error}
= {cs & cs_error = pushErrorAdmin pos cs_error }
pushErrorPosition ident pos cs=:{cs_error}
= {cs & cs_error = pushErrorPosition ident pos cs_error}
setErrorAdmin pos cs=:{cs_error}
= {cs & cs_error = setErrorAdmin pos cs_error }
setErrorPosition ident pos cs=:{cs_error}
= {cs & cs_error = setErrorPosition ident pos cs_error}
popErrorAdmin cs=:{cs_error}
= {cs & cs_error = popErrorAdmin cs_error } //...PK
= {cs & cs_error = popErrorAdmin cs_error}
newPosition :: !Ident !Position -> IdentPos
newPosition id (FunPos file_name line_nr _)
......
......@@ -475,8 +475,7 @@ checkTypeDef type_index module_index class_defs ts=:{ts_type_defs} ti=:{ti_type_
# (type_def, ts_type_defs) = ts_type_defs![type_index]
# {td_ident,td_pos,td_args,td_attribute,td_index} = type_def
| td_index == NoIndex
# position = newPosition td_ident td_pos
cs_error = pushErrorAdmin position cs_error
# cs_error = pushErrorPosition td_ident td_pos cs_error
(td_attribute, attr_vars, th_attrs) = determine_root_attribute td_attribute td_ident.id_name ti_type_heaps.th_attrs
(type_vars, (attr_vars, ti_type_heaps, cs))
= addTypeVariablesToSymbolTable cGlobalScope td_args attr_vars { ti_type_heaps & th_attrs = th_attrs } { cs & cs_error = cs_error }
......
......@@ -827,8 +827,7 @@ compareTwoMacroFuns macro_module_index dclIndex iclIndex ec_state=:{ec_icl_funct
_ -> True
| not need_to_be_compared
= ec_state
# ident_pos = newPosition dcl_function.fun_ident dcl_function.fun_pos
ec_error_admin = pushErrorAdmin ident_pos ec_state.ec_error_admin
# ec_error_admin = pushErrorPosition dcl_function.fun_ident dcl_function.fun_pos ec_state.ec_error_admin
ec_state = { ec_state & ec_error_admin = ec_error_admin }
| (dcl_function.fun_info.fi_properties bitand FI_IsMacroFun <> icl_function.fun_info.fi_properties bitand FI_IsMacroFun
&& (ec_state.ec_tc_state.tc_strictness_flags bitand CompareGenericCaseMacro==0 && dcl_function.fun_info.fi_properties bitand FI_IsMacroFun<>0)) ||
......@@ -846,8 +845,7 @@ compare_generic_case_def_macro_and_function dclIndex iclIndex generic_info ec_st
(icl_function, ec_icl_functions) = ec_icl_functions![iclIndex]
ec_state & ec_icl_correspondences.[iclIndex]=dclIndex, ec_dcl_correspondences.[dclIndex]=iclIndex,
ec_icl_functions = ec_icl_functions,ec_macro_defs=ec_macro_defs
ident_pos = newPosition dcl_function.fun_ident dcl_function.fun_pos
ec_state & ec_error_admin = pushErrorAdmin ident_pos ec_state.ec_error_admin
ec_state & ec_error_admin = pushErrorPosition dcl_function.fun_ident dcl_function.fun_pos ec_state.ec_error_admin
dcl_args_and_rhs = from_body dcl_function.fun_body
icl_args_and_rhs = from_body icl_function.fun_body
......
......@@ -1807,7 +1807,7 @@ where
{fun_body = TransformedBody {tb_args,tb_rhs},fun_info,fun_arity,fun_ident,fun_pos} = fun_def
var_heap = mark_FPC_arguments st_args tb_args var_heap
error = setErrorAdmin (newPosition fun_ident fun_pos) error
error = setErrorPosition fun_ident fun_pos error
var_heap = store_ambiguous_and_missing_contexts_for_errors error_contexts var_heap
(rev_variables,var_heap,error) = foldSt determine_class_argument st_context ([],var_heap,error)
......
......@@ -854,9 +854,9 @@ where
# variables = tb_args ++ fi_local_vars
(subst, type_def_infos, var_heap, expr_heap) = clear_occurrences variables subst type_def_infos var_heap expr_heap
{rms_var_heap} = fullRefMarkOfRootOrLetExpr [tb_args] NotASelector No (tb_rhs ===> ("makeSharedReferencesNonUnique", fun_ident, tb_rhs)) [] var_heap
position = newPosition fun_ident fun_pos
error = setErrorPosition fun_ident fun_pos error
(coercion_env, var_heap, expr_heap, error)
= make_shared_vars_non_unique variables fun_body coercion_env rms_var_heap expr_heap (setErrorAdmin position error)
= make_shared_vars_non_unique variables fun_body coercion_env rms_var_heap expr_heap error
#! var_heap = empty_occurrences variables var_heap
= (coercion_env, subst, type_def_infos, var_heap, expr_heap, error)
where
......
......@@ -970,9 +970,8 @@ reset_body_of_rhs_macros ps_deps fun_defs macro_defs
expand_simple_macro mod_index macro=:{fun_body = CheckedBody body, fun_info, fun_ident, fun_pos,fun_kind}
predef_symbols_for_transform ps=:{ps_symbol_table,ps_symbol_heap,ps_var_heap,ps_fun_defs,ps_macro_defs,ps_error}
# identPos = newPosition fun_ident fun_pos
# es = { es_symbol_table = ps_symbol_table, es_var_heap = ps_var_heap,
es_expression_heap = ps_symbol_heap, es_error = setErrorAdmin identPos ps_error,
es_expression_heap = ps_symbol_heap, es_error = setErrorPosition fun_ident fun_pos ps_error,
es_fun_defs=ps_fun_defs, es_macro_defs=ps_macro_defs, es_new_fun_def_numbers=[]
}
# (tb_args, tb_rhs, local_vars, fi_calls, fi_dynamics,{es_symbol_table, es_var_heap, es_expression_heap, es_error,es_fun_defs,es_macro_defs})
......@@ -1516,8 +1515,7 @@ where
| es.es_fun_defs.[fun_index].fun_info.fi_properties bitand FI_DefaultMemberWithDerive==0
# (fun_def,es) = es!es_fun_defs.[fun_index]
{fun_ident,fun_body = PartitioningFunction body _, fun_info, fun_pos,fun_kind} = fun_def
identPos = newPosition fun_ident fun_pos
es & es_error = setErrorAdmin identPos es.es_error
es & es_error = setErrorPosition fun_ident fun_pos es.es_error
(tb_args, tb_rhs, fi_local_vars, fi_calls,fi_dynamics, es)
= expandMacrosInBody fun_info.fi_calls body pi.pi_predef_symbols_for_transform pi.pi_reset_body_of_rhs_macros es
fun_def & fun_body = TransformedBody { tb_args = tb_args, tb_rhs = tb_rhs},
......@@ -1525,8 +1523,7 @@ where
= {es & es_fun_defs.[fun_index] = fun_def}
# (fun_def,es) = es!es_fun_defs.[fun_index]
{fun_ident,fun_body = PartitioningFunction body _, fun_info, fun_pos,fun_kind} = fun_def
identPos = newPosition fun_ident fun_pos
es & es_error = setErrorAdmin identPos es.es_error
es & es_error = setErrorPosition fun_ident fun_pos es.es_error
#! n_fun_defs_0 = size es.es_fun_defs
# (tb_args, tb_rhs, fi_local_vars, fi_calls,fi_dynamics, es)
= expandMacrosInBody fun_info.fi_calls body pi.pi_predef_symbols_for_transform pi.pi_reset_body_of_rhs_macros es
......@@ -1540,8 +1537,7 @@ where
expand_macros (DclMacroIndex macro_module_index fun_index) es
# (old_fun_def,es) = es!es_macro_defs.[macro_module_index,fun_index]
{fun_ident,fun_body = PartitioningFunction body _, fun_info, fun_pos,fun_kind} = old_fun_def
identPos = newPosition fun_ident fun_pos
# es={ es & es_error = setErrorAdmin identPos es.es_error }
es & es_error = setErrorPosition fun_ident fun_pos es.es_error
# (tb_args, tb_rhs, fi_local_vars, fi_calls,fi_dynamics, es)
= expandMacrosInBody fun_info.fi_calls body pi.pi_predef_symbols_for_transform pi.pi_reset_body_of_rhs_macros es
fun_def = { old_fun_def & fun_body = TransformedBody { tb_args = tb_args, tb_rhs = tb_rhs},
......
......@@ -251,12 +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:_]}
cannotUnify t1 t2 position=:(CP_Expression expr) common_defs err=:{ea_loc=[{ip_file}:_]}
= case tryToOptimizePosition expr of
Yes (id_name, line)
# err = pushErrorAdmin { ip & ip_ident.id_name = id_name, ip_line = line } err
err = errorHeading type_error err
err = popErrorAdmin err
# err = errorHeadingWithStringPos {sp_file=ip_file, sp_name=id_name, sp_line=line} type_error 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' }
......@@ -295,12 +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:_]}
existentialError position=:(CP_Expression expr) err=:{ea_loc=[{ip_file}:_]}
= case tryToOptimizePosition expr of
Yes (id_name, line)
# err = pushErrorAdmin { ip & ip_ident.id_name = id_name, ip_line = line } err
err = errorHeading type_error err
err = popErrorAdmin err
# err = errorHeadingWithStringPos {sp_file=ip_file, sp_name=id_name, sp_line=line} type_error err
-> { err & ea_file = err.ea_file <<< " attribute variable could not be universally quantified"<<< '\n' }
_
# err = errorHeading type_error err
......@@ -2438,8 +2434,7 @@ where
initial_symbol_type is_start_rule common_defs
{fun_type=Yes ft=:{st_arity,st_args,st_result,st_attr_vars,st_attr_env},fun_ident,fun_lifted,fun_info={fi_dynamics},fun_pos}
(pre_def_symbols, ts=:{ts_type_heaps,ts_expr_heap,ts_td_infos,ts_error})
# fe_location = newPosition fun_ident fun_pos
ts_error = setErrorAdmin fe_location ts_error
# ts_error = setErrorPosition fun_ident fun_pos ts_error
(st_args, ps) = addPropagationAttributesToATypes common_defs st_args
{ prop_type_heaps = ts_type_heaps, prop_td_infos = ts_td_infos,
prop_attr_vars = st_attr_vars, prop_attr_env = st_attr_env, prop_error = Yes ts_error}
......@@ -2645,7 +2640,7 @@ where
clean_up_and_check_function_type {fun_ident,fun_kind,fun_pos,fun_type = opt_fun_type} fun is_start_rule list_inferred_types defs type_contexts type_ptrs
coercion_env attr_partition type_var_env attr_var_env out ts
# (env_type, ts) = ts!ts_fun_env.[fun]
# ts = { ts & ts_error = setErrorAdmin (newPosition fun_ident fun_pos) ts.ts_error}
ts & ts_error = setErrorPosition fun_ident fun_pos ts.ts_error
= case env_type of
ExpandedType fun_type tmp_fun_type exp_fun_type
# (clean_fun_type, ambiguous_or_missing_contexts, type_var_env, attr_var_env, ts_type_heaps, ts_var_heap, ts_expr_heap, ts_error)
......@@ -3097,10 +3092,10 @@ where
unify_requirements_within_one_position _ ti {tcg_type_coercions, tcg_position=NoPos} (subst, heaps, ts_error)
= unify_coercions (reverse tcg_type_coercions) ti subst heaps ts_error
unify_requirements_within_one_position fun_ident ti {tcg_type_coercions, tcg_position} (subst, heaps, ts_error)
# ts_error = setErrorAdmin (newPosition fun_ident tcg_position) ts_error
# ts_error = setErrorPosition fun_ident tcg_position ts_error
= unify_coercions (reverse tcg_type_coercions) ti subst heaps ts_error
build_initial_coercion_env [{fe_requirements={req_attr_coercions},fe_location} : reqs_list] coercion_env
build_initial_coercion_env [{fe_requirements={req_attr_coercions}} : reqs_list] coercion_env
= build_initial_coercion_env reqs_list (add_to_initial_coercion_env req_attr_coercions coercion_env)
build_initial_coercion_env [] coercion_env
= coercion_env
......@@ -3135,7 +3130,7 @@ where
build_coercion_env_for_alternative fun_ident common_defs cons_var_vects {tcg_position, tcg_type_coercions}
(subst, coercion_env, type_signs, type_var_heap, error)
# error = setErrorAdmin (newPosition fun_ident tcg_position) error
# error = setErrorPosition fun_ident tcg_position error
= add_to_coercion_env tcg_type_coercions subst coercion_env common_defs cons_var_vects type_signs type_var_heap error
add_to_coercion_env [{tc_offered,tc_demanded,tc_coercible,tc_position} : attr_coercions] subst coercion_env common_defs cons_var_vects type_signs type_var_heap error
......@@ -3305,7 +3300,7 @@ where
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 = setErrorAdmin fe_location ts_error
ts_error = setErrorPosition fun_ident fun_pos ts_error
// ts = { ts & ts_var_heap = ts_var_heap, ts_error = ts_error}
ts = { 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 = [],
......
......@@ -5,6 +5,7 @@ import checksupport,utilities
from unitype import ::Coercions, ::CoercionTree, ::AttributePartition, CT_Empty
errorHeading :: !String !*ErrorAdmin -> *ErrorAdmin
errorHeadingWithStringPos :: !StringPos !String !*ErrorAdmin -> *ErrorAdmin
(<::) infixl :: !*File !(!Format, !a, !Optional TypeVarBeautifulizer) -> *File | writeType a
......
......@@ -296,6 +296,10 @@ errorHeading error_kind err=:{ea_file,ea_loc = []}
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