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 ...@@ -284,7 +284,7 @@ where
| mark < cMAXINT | mark < cMAXINT
| is_synonym_or_new_type td_rhs | is_synonym_or_new_type td_rhs
# marks = { marks & [gi_module,gi_index] = cChecking } # 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 (group, marks, error) = check_cyclic_type_defs td_used_types type_defs [td : group] marks error
error = popErrorAdmin error error = popErrorAdmin error
= (group, { marks & [gi_module,gi_index] = cMAXINT }, error) = (group, { marks & [gi_module,gi_index] = cMAXINT }, error)
...@@ -705,7 +705,7 @@ where ...@@ -705,7 +705,7 @@ where
anal_type_def modules gi=:{gi_module,gi_index} (group_properties, conds, as=:{as_error}) anal_type_def modules gi=:{gi_module,gi_index} (group_properties, conds, as=:{as_error})
# {com_type_defs,com_cons_defs} = modules.[gi_module] # {com_type_defs,com_cons_defs} = modules.[gi_module]
{td_ident,td_pos,td_args,td_rhs} = com_type_defs.[gi_index] {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}) (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 }) = (combineTypeProperties group_properties type_properties, conds, {as & as_error = popErrorAdmin as.as_error })
where where
...@@ -833,7 +833,7 @@ where ...@@ -833,7 +833,7 @@ where
= as = as
with with
check_abstract_type spec_properties td_ident td_args td_pos as 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_coercibility spec_properties properties
| check_hyperstrictness spec_properties properties | check_hyperstrictness spec_properties properties
| spec_properties bitand cIsNonCoercible == 0 | spec_properties bitand cIsNonCoercible == 0
...@@ -935,7 +935,7 @@ where ...@@ -935,7 +935,7 @@ where
{class_args,class_context,class_members,class_arity,class_pos,class_ident} = com_class_defs.[class_index] {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 (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_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 = { class_infos & [class_module,class_index] = cyclicClassInfoMark }
(class_infos, as) = determine_kinds_of_context_classes class_context (class_infos, (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 }) { as & as_kind_heap = as_kind_heap, as_type_var_heap = as_type_var_heap, as_error = as_error })
...@@ -1105,7 +1105,7 @@ where ...@@ -1105,7 +1105,7 @@ where
check_kinds_of_class_instance :: !{#CommonDefs} !ClassInstance !*ClassDefInfos !*AnalyseState -> (!*ClassDefInfos, !*AnalyseState) 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 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=:{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_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 } 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}} 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 ...@@ -1121,7 +1121,7 @@ where
where where
check_kinds_of_generic :: !{#CommonDefs} !GenericDef !*ClassDefInfos !*GenericHeap !*AnalyseState -> (!*ClassDefInfos, !*GenericHeap, !*AnalyseState) 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 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 # (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 # (kinds, as) = mapSt retrieve_tv_kind gen_type.st_vars as
# as = check_kinds_of_generic_vars (take (length gen_vars) kinds) as # as = check_kinds_of_generic_vars (take (length gen_vars) kinds) as
...@@ -1173,7 +1173,7 @@ where ...@@ -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 (expression_heap,class_infos,as) = check_kinds_of_dynamics common_defs fun_info.fi_dynamics expression_heap class_infos as
= case fun_type of = case fun_type of
Yes symbol_type 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 } (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 }) -> (icl_fun_defs, class_infos, expression_heap, { as & as_error = popErrorAdmin as.as_error })
No No
...@@ -1187,7 +1187,7 @@ where ...@@ -1187,7 +1187,7 @@ where
where where
check_kinds_of_dcl_fuction common_defs dcl_functions fun_index (class_infos, as) check_kinds_of_dcl_fuction common_defs dcl_functions fun_index (class_infos, as)
# {ft_type,ft_ident,ft_pos} = dcl_functions.[fun_index] # {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) = 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}) = (class_infos, { as & as_error = popErrorAdmin as.as_error})
......
...@@ -21,7 +21,7 @@ where ...@@ -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}) 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 | 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] # (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) (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 = 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 }} class_defs = { class_defs & [class_index] = { class_def & class_context = class_context, class_args = class_args }}
...@@ -74,8 +74,7 @@ where ...@@ -74,8 +74,7 @@ where
= (next_inst_index, collected_funtypes, collected_instances, type_defs, class_defs, modules, heaps, cs) = (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 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 next_inst_index collected_funtypes collected_instances type_defs class_defs modules heaps cs
# position = newPosition ft_ident ft_pos # cs & cs_error = setErrorPosition ft_ident ft_pos cs.cs_error
cs = { cs & cs_error = setErrorAdmin position cs.cs_error }
(ft_type, ft_specials, type_defs, class_defs, modules, hp_type_heaps, cs) (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 = 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) (spec_types, next_inst_index, collected_instances, heaps, cs_predef_symbols,cs_error)
...@@ -116,8 +115,7 @@ where ...@@ -116,8 +115,7 @@ where
check_function_types :: !DclInstanceMemberTypeAndFunctions !ModuleIndex !v:{#CheckedTypeDef} !w:{#ClassDef} !v:{#DclModule} !*Heaps !*CheckState check_function_types :: !DclInstanceMemberTypeAndFunctions !ModuleIndex !v:{#CheckedTypeDef} !w:{#ClassDef} !v:{#DclModule} !*Heaps !*CheckState
-> (![FunType],!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 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_error = setErrorPosition ft_ident ft_pos cs.cs_error
cs = { cs & cs_error = setErrorAdmin position cs.cs_error }
(ft_type, ft_specials, type_defs, class_defs, modules, hp_type_heaps, cs) (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 = 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 (new_info_ptr, hp_var_heap) = newPtr VI_Empty heaps.hp_var_heap
...@@ -179,8 +177,7 @@ where ...@@ -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) 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] # (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 | has_to_be_checked opt_icl_info me_class
# position = newPosition me_ident me_pos # cs & cs_error = setErrorPosition me_ident me_pos cs.cs_error
cs & cs_error = setErrorAdmin position cs.cs_error
(me_type, type_defs, class_defs, modules, type_heaps, cs) (me_type, type_defs, class_defs, modules, type_heaps, cs)
= checkMemberType module_index 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 (me_default_implementation,cs) = check_generic_default me_default_implementation module_index cs
...@@ -260,7 +257,7 @@ where ...@@ -260,7 +257,7 @@ where
check_instance :: !ClassInstance !Index !u:InstanceSymbols !*TypeHeaps !*CheckState -> (!ClassInstance, !u:InstanceSymbols, !*TypeHeaps, !*CheckState) 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} 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 # ({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 # (ins, is, type_heaps, cs) = case ste_kind of
STE_Class STE_Class
# (class_def, is) = is!is_class_defs.[ste_index] # (class_def, is) = is!is_class_defs.[ste_index]
...@@ -272,7 +269,7 @@ where ...@@ -272,7 +269,7 @@ where
= (ins, is, type_heaps, popErrorAdmin cs) = (ins, is, type_heaps, popErrorAdmin cs)
check_instance ins=:{ins_class_ident={ci_ident=QualifiedIdent module_ident class_name},ins_pos,ins_ident} check_instance ins=:{ins_class_ident={ci_ident=QualifiedIdent module_ident class_name},ins_pos,ins_ident}
module_index is type_heaps cs 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 # (found,{decl_kind,decl_ident=type_ident,decl_index=class_index},cs) = search_qualified_ident module_ident class_name ClassNameSpaceN cs
| not found | not found
# cs = {cs & cs_error = checkError ("'"+++module_ident.id_name+++"'."+++class_name) "class undefined" cs.cs_error} # cs = {cs & cs_error = checkError ("'"+++module_ident.id_name+++"'."+++class_name) "class undefined" cs.cs_error}
...@@ -393,7 +390,7 @@ where ...@@ -393,7 +390,7 @@ where
# class_member = class_members.[class_member_n] # class_member = class_members.[class_member_n]
| instance_member_n < size ins_members | instance_member_n < size ins_members
# ins_member = ins_members.[instance_member_n] # 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 | 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) # (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 = add_default_instance_or_report_error_for_exported_instance class_member member_mod_index ins_type ins_pos
...@@ -936,7 +933,7 @@ where ...@@ -936,7 +933,7 @@ where
= ([], [], member_defs, modules, type_heaps, var_heap, cs_error) = ([], [], member_defs, modules, type_heaps, var_heap, cs_error)
# class_member = class_members.[mem_offset] # 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 ({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) (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 = 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) (instance_type, new_ins_specials, member_types, modules, type_heaps, cs_error)
...@@ -1163,7 +1160,7 @@ checkFunction :: !FunDef !Index !FunctionOrMacroIndex !Level !Int !*{#FunDef} !* ...@@ -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 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} 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 # 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) (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 = 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 ...@@ -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 = {icl_functions & [index_of_member_fun] = function}
-> (icl_functions, type_heaps, cs_error) -> (icl_functions, type_heaps, cs_error)
# ({fun_ident,fun_pos},icl_functions) = icl_functions![index_of_member_fun] # ({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 = specified_member_type_incorrect_error err_code cs_error
cs_error = popErrorAdmin cs_error cs_error = popErrorAdmin cs_error
icl_functions = {icl_functions & [index_of_member_fun].fun_type = Yes derived_symbol_type} 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 ...@@ -3439,7 +3436,7 @@ addImportedSymbolsToSymbolTable importing_mod opt_macro_range modules_in_compone
where where
add_impl_imported_symbols_with_new_error_pos opt_macro_range importing_mod modules_in_component_set imports_ikh 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) (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) (decls_accu, visited_modules, dcl_modules, cs)
= add_impl_imported_symbols opt_macro_range importing_mod modules_in_component_set imports_ikh = add_impl_imported_symbols opt_macro_range importing_mod modules_in_component_set imports_ikh
mod_index (decls_accu, visited_modules, dcl_modules, cs) mod_index (decls_accu, visited_modules, dcl_modules, cs)
...@@ -3473,7 +3470,7 @@ addImportedSymbolsToSymbolTable importing_mod opt_macro_range modules_in_compone ...@@ -3473,7 +3470,7 @@ addImportedSymbolsToSymbolTable importing_mod opt_macro_range modules_in_compone
(decls_accu, visited_modules, dcl_modules, cs) (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) 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, cs) = foldSt (add_expl_imp_declaration opt_macro_range importing_mod) decls (decls_accu, dcl_modules, cs)
= (decls_accu, dcl_modules, popErrorAdmin cs) = (decls_accu, dcl_modules, popErrorAdmin cs)
......
...@@ -190,7 +190,7 @@ checkFunctionBodies :: !FunctionBody !Ident !.ExpressionInput !*ExpressionState ...@@ -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} 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 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) (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} ([], []) = 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 {ps_var_heap = es_var_heap, ps_fun_defs = es_fun_defs} e_info cs
...@@ -239,7 +239,7 @@ where ...@@ -239,7 +239,7 @@ where
check_function_bodies free_vars fun_args [{pb_args,pb_rhs={rhs_alts,rhs_locals},pb_position} : bodies] 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 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) # (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 } ([], []) = 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 {ps_var_heap = es_var_heap,ps_fun_defs = es_fun_defs} e_info cs
...@@ -564,7 +564,7 @@ where ...@@ -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 :: [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 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 (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) = checkExpression free_vars bind_src e_input e_state e_info cs
(src_expr, free_vars, e_state, e_info, cs) (src_expr, free_vars, e_state, e_info, cs)
...@@ -753,7 +753,7 @@ where ...@@ -753,7 +753,7 @@ where
-> *(CasePatterns,CasePatterns,[(Bind Ident (Ptr VarInfo))],(Optional ((Optional FreeVar),Expression)),[FreeVar],*ExpressionState,*ExpressionInfo,*CheckState) -> *(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 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 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) (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 } ([], []) = 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 {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= ...@@ -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 # (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 {es_fun_defs,es_var_heap,es_expr_heap} = e_state
ps = {ps_var_heap = es_var_heap,ps_fun_defs = es_fun_defs} 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) (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 = 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 cs = popErrorAdmin cs
...@@ -2252,7 +2252,7 @@ convertSubPattern AP_Empty result_expr pattern_position var_store expr_heap opt_ ...@@ -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 = 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 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 (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 {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) (binds_of_bind, es_var_heap, es_expr_heap, e_info, cs)
...@@ -2999,11 +2999,11 @@ determinePatternVariable No var_heap ...@@ -2999,11 +2999,11 @@ determinePatternVariable No var_heap
# (new_info_ptr, var_heap) = newPtr VI_Empty var_heap # (new_info_ptr, var_heap) = newPtr VI_Empty var_heap
= ({ bind_src = newVarId "_x", bind_dst = new_info_ptr }, 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 // 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 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 :: !FreeVar !*ExpressionHeap -> (!BoundVar, !.ExpressionHeap)
allocate_bound_var {fv_ident, fv_info_ptr} expr_heap allocate_bound_var {fv_ident, fv_info_ptr} expr_heap
......
...@@ -29,7 +29,7 @@ where ...@@ -29,7 +29,7 @@ where
check_generic index mod_index gen_defs type_defs class_defs modules heaps cs 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] # (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 # (gen_def, heaps) = alloc_gen_info gen_def heaps
...@@ -230,7 +230,7 @@ where ...@@ -230,7 +230,7 @@ where
# (case_def=:{gc_pos,gc_type,gc_gcf}, gen_case_defs) = gen_case_defs![index] # (case_def=:{gc_pos,gc_type,gc_gcf}, gen_case_defs) = gen_case_defs![index]
= case gc_gcf of = case gc_gcf of
GCF gc_ident gcf=:{gcf_gident} 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) # (gc_type, gc_type_cons, type_defs, modules, heaps, cs)
= check_instance_type mod_index gc_type 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 # (generic_gi, cs) = get_generic_index gcf_gident mod_index cs
...@@ -242,7 +242,7 @@ where ...@@ -242,7 +242,7 @@ where
# cs = popErrorAdmin cs # cs = popErrorAdmin cs
-> (gen_case_defs, generic_defs, type_defs, class_defs, modules, heaps, cs) -> (gen_case_defs, generic_defs, type_defs, class_defs, modules, heaps, cs)
GCFS gcfs 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) # (gc_type, gc_type_cons, type_defs, modules, heaps, cs)
= check_instance_type mod_index gc_type type_defs modules heaps cs = check_instance_type mod_index gc_type type_defs modules heaps cs
| not cs.cs_error.ea_ok | not cs.cs_error.ea_ok
...@@ -254,7 +254,7 @@ where ...@@ -254,7 +254,7 @@ where
# gen_case_defs = {gen_case_defs & [index] = case_def} # gen_case_defs = {gen_case_defs & [index] = case_def}
-> (gen_case_defs, generic_defs, type_defs, class_defs, modules, heaps, cs) -> (gen_case_defs, generic_defs, type_defs, class_defs, modules, heaps, cs)
GCFC _ gcfc_class_ident=:{id_info} 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) # (gc_type, gc_type_cons, type_defs, modules, heaps, cs)
= check_instance_type mod_index gc_type type_defs modules heaps cs = check_instance_type mod_index gc_type type_defs modules heaps cs
| not cs.cs_error.ea_ok | not cs.cs_error.ea_ok
...@@ -283,7 +283,7 @@ where ...@@ -283,7 +283,7 @@ where
cs = popErrorAdmin cs cs = popErrorAdmin cs
= (gen_case_defs,cs) = (gen_case_defs,cs)
GCFCExcept _ gcfc_class_ident=:{id_info} except_class_names 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) # (gc_type, gc_type_cons, type_defs, modules, heaps, cs)
= check_instance_type mod_index gc_type type_defs modules heaps cs = check_instance_type mod_index gc_type type_defs modules heaps cs
| not cs.cs_error.ea_ok | not cs.cs_error.ea_ok
......
...@@ -57,8 +57,8 @@ cConversionTableSize :== 10 ...@@ -57,8 +57,8 @@ cConversionTableSize :== 10
class Erroradmin state class Erroradmin state
where where
pushErrorAdmin :: !IdentPos *state -> *state pushErrorPosition :: !Ident !Position *state -> *state
setErrorAdmin :: !IdentPos *state -> *state setErrorPosition :: !Ident !Position *state -> *state
popErrorAdmin :: *state -> *state popErrorAdmin :: *state -> *state
instance Erroradmin ErrorAdmin, CheckState instance Erroradmin ErrorAdmin, CheckState
......
...@@ -26,25 +26,25 @@ where ...@@ -26,25 +26,25 @@ where
instance Erroradmin ErrorAdmin instance Erroradmin ErrorAdmin
where where
pushErrorAdmin pos error=:{ea_loc} pushErrorPosition ident pos error=:{ea_loc}
= { error & ea_loc = [pos : ea_loc] } = {error & ea_loc = [newPosition ident pos : ea_loc]}
setErrorAdmin pos error setErrorPosition ident pos error
= { error & ea_loc = [pos] } = {error & ea_loc = [newPosition ident pos]}
popErrorAdmin error=:{ea_loc = [_:ea_locs]} popErrorAdmin error=:{ea_loc = [_:ea_locs]}
= { error & ea_loc = ea_locs } = {error & ea_loc = ea_locs}
instance Erroradmin CheckState instance Erroradmin CheckState
where where
pushErrorAdmin pos cs=:{cs_error} pushErrorPosition ident pos cs=:{cs_error}
= {cs & cs_error = pushErrorAdmin pos cs_error } = {cs & cs_error = pushErrorPosition ident pos cs_error}
setErrorAdmin pos cs=:{cs_error} setErrorPosition ident pos cs=:{cs_error}
= {cs & cs_error = setErrorAdmin pos cs_error } = {cs & cs_error = setErrorPosition ident pos cs_error}
popErrorAdmin cs=:{cs_error} popErrorAdmin cs=:{cs_error}
= {cs & cs_error = popErrorAdmin cs_error } //...PK = {cs & cs_error = popErrorAdmin cs_error}
newPosition :: !Ident !Position -> IdentPos newPosition :: !Ident !Position -> IdentPos
newPosition id (FunPos file_name line_nr _) newPosition id (FunPos file_name line_nr _)
......