Commit c814e59a authored by johnvg@science.ru.nl's avatar johnvg@science.ru.nl

Merge remote-tracking branch 'origin/master' into itask

parents cf08eba2 ab86763f
......@@ -38,9 +38,9 @@ check_class_instances class_n module_n class_instances common_defs tvh error_adm
(tvh,error_admin) = check_if_sorted_instances_overlap default_instances common_defs tvh error_admin
(tvh,error_admin) = check_if_other_instances_overlap normal_instances default_instances other_instances common_defs tvh error_admin
(instance_tree,error_admin) = add_sorted_instances_to_instance_tree default_instances common_defs IT_Empty error_admin
(instance_tree,error_admin) = add_instances_to_instance_tree other_instances common_defs instance_tree error_admin
class_instances & [module_n].[class_n] = IT_Trees normal_instances instance_tree
(other_instance_tree,error_admin) = add_instances_to_instance_tree other_instances common_defs IT_Empty error_admin
(default_instance_tree,error_admin) = add_sorted_instances_to_instance_tree default_instances common_defs IT_Empty error_admin
class_instances & [module_n].[class_n] = IT_Trees normal_instances other_instance_tree default_instance_tree
= (class_instances,tvh,error_admin)
# (normal_instances,default_instances,other_instances,tvh)
......@@ -50,9 +50,9 @@ check_class_instances class_n module_n class_instances common_defs tvh error_adm
(tvh,error_admin)
= check_if_other_instances_with_fundeps_overlap normal_instances default_instances other_instances class_fun_dep_vars common_defs tvh error_admin
(instance_tree,error_admin) = add_sorted_fun_dep_instances_to_instance_tree default_instances class_fun_dep_vars common_defs IT_Empty error_admin
(instance_tree,error_admin) = add_fun_dep_instances_to_instance_tree other_instances class_fun_dep_vars common_defs instance_tree error_admin
class_instances & [module_n].[class_n] = IT_Trees normal_instances instance_tree
(other_instance_tree,error_admin) = add_fun_dep_instances_to_instance_tree other_instances class_fun_dep_vars common_defs IT_Empty error_admin
(default_instance_tree,error_admin) = add_sorted_fun_dep_instances_to_instance_tree default_instances class_fun_dep_vars common_defs IT_Empty error_admin
class_instances & [module_n].[class_n] = IT_Trees normal_instances other_instance_tree default_instance_tree
= (class_instances,tvh,error_admin)
......@@ -67,7 +67,7 @@ classify_and_sort_instances (IT_Node instance_index=:{glob_module,glob_object} l
| is_normal_instance
# (normal_instances,tvh) = add_to_sorted_instances instance_index it_types normal_instances common_defs tvh
= classify_and_sort_left_and_right_instances left right normal_instances default_instances other_instances common_defs tvh
# (is_default_instance,tvh) = instance_root_types_specified_or_polymorphic it_types [] common_defs tvh
# (is_default_instance,tvh) = check_if_default_instance_types it_types [] common_defs False tvh
| is_default_instance
# (default_instances,tvh) = add_to_sorted_instances instance_index it_types default_instances common_defs tvh
= classify_and_sort_left_and_right_instances left right normal_instances default_instances other_instances common_defs tvh
......@@ -91,7 +91,7 @@ classify_and_sort_instances_with_fundeps (IT_Node instance_index=:{glob_module,g
| is_normal_instance
# (normal_instances,tvh) = add_to_sorted_instances_with_fundeps instance_index it_types normal_instances class_fun_dep_vars common_defs tvh
= classify_and_sort_left_and_right_instances_with_fundeps left right class_fun_dep_vars normal_instances default_instances other_instances common_defs tvh
# (is_default_instance,tvh) = instance_root_types_specified_or_polymorphic it_types [] common_defs tvh
# (is_default_instance,tvh) = check_if_default_instance_with_fun_deps_types it_types [] class_fun_dep_vars common_defs False tvh
| is_default_instance
# (default_instances,tvh) = add_to_sorted_instances_with_fundeps instance_index it_types default_instances class_fun_dep_vars common_defs tvh
= classify_and_sort_left_and_right_instances_with_fundeps left right class_fun_dep_vars normal_instances default_instances other_instances common_defs tvh
......@@ -755,18 +755,6 @@ instance_with_fundeps_root_types_specified [type:types] class_fun_dep_vars commo
instance_with_fundeps_root_types_specified [] class_fun_dep_vars common_defs tvh
= (True,tvh)
instance_root_types_specified_or_polymorphic :: ![Type] ![TypeVarInfoPtr] !{#CommonDefs} !*TypeVarHeap -> (!Bool,!*TypeVarHeap)
instance_root_types_specified_or_polymorphic [type:types] previous_type_vars common_defs tvh
# (can_be_compared,tvh) = root_type_can_be_compared type common_defs tvh
| can_be_compared
= instance_root_types_specified_or_polymorphic types previous_type_vars common_defs tvh
# (is_polymorphic,previous_type_vars,tvh) = root_type_polymorphic type previous_type_vars common_defs tvh
| is_polymorphic
= instance_root_types_specified_or_polymorphic types previous_type_vars common_defs tvh
= (False,tvh)
instance_root_types_specified_or_polymorphic [] previous_type_vars common_defs tvh
= (True,tvh)
root_type_can_be_compared :: !Type !{#CommonDefs} !*TypeVarHeap -> (!Bool,!*TypeVarHeap)
root_type_can_be_compared (TA {type_index={glob_object,glob_module}} type_args) common_defs tvh
#! {td_rhs,td_args} = common_defs.[glob_module].com_type_defs.[glob_object]
......@@ -801,21 +789,68 @@ type_is_basic_or_function_type TArrow = True
type_is_basic_or_function_type (TArrow1 _) = True
type_is_basic_or_function_type _ = False
root_type_polymorphic :: !Type ![TypeVarInfoPtr] !{#CommonDefs} !*TypeVarHeap -> (!Bool,![TypeVarInfoPtr],!*TypeVarHeap)
root_type_polymorphic (TA {type_index={glob_object,glob_module}} type_args) previous_type_vars common_defs tvh
check_if_default_instance_types :: ![Type] ![TypeVarInfoPtr] !{#CommonDefs} !Bool !*TypeVarHeap -> (!Bool,!*TypeVarHeap)
check_if_default_instance_types [type:types] previous_type_vars common_defs has_root_type_var tvh
# (is_polymorphic,previous_type_vars,has_root_type_var,tvh) = check_if_default_instance_type_arg type previous_type_vars common_defs has_root_type_var tvh
| is_polymorphic
= check_if_default_instance_types types previous_type_vars common_defs has_root_type_var tvh
= (False,tvh)
check_if_default_instance_types [] previous_type_vars common_defs has_root_type_var tvh
= (has_root_type_var,tvh)
check_if_default_instance_with_fun_deps_types :: ![Type] ![TypeVarInfoPtr] !BITVECT !{#CommonDefs} !Bool !*TypeVarHeap -> (!Bool,!*TypeVarHeap)
check_if_default_instance_with_fun_deps_types [type:types] previous_type_vars class_fun_dep_vars common_defs has_root_type_var tvh
| class_fun_dep_vars bitand 1==0
# (is_polymorphic,previous_type_vars,has_root_type_var,tvh) = check_if_default_instance_type_arg type previous_type_vars common_defs has_root_type_var tvh
| is_polymorphic
= check_if_default_instance_with_fun_deps_types types previous_type_vars (class_fun_dep_vars>>1) common_defs has_root_type_var tvh
= (False,tvh)
= check_if_default_instance_with_fun_deps_types types previous_type_vars (class_fun_dep_vars>>1) common_defs has_root_type_var tvh
check_if_default_instance_with_fun_deps_types [] previous_type_vars class_fun_dep_vars common_defs has_root_type_var tvh
= (has_root_type_var,tvh)
check_if_default_instance_type_arg :: !Type ![TypeVarInfoPtr] !{#CommonDefs} !Bool !*TypeVarHeap -> (!Bool,[TypeVarInfoPtr],!Bool,!*TypeVarHeap)
check_if_default_instance_type_arg (TV {tv_info_ptr}) previous_type_vars common_defs has_root_type_var tvh
| IsMember tv_info_ptr previous_type_vars
= (False,previous_type_vars,has_root_type_var,tvh)
# has_root_type_var = True
= (True,[tv_info_ptr:previous_type_vars],has_root_type_var,tvh)
check_if_default_instance_type_arg (TA {type_index={glob_object,glob_module}} type_args) previous_type_vars common_defs has_root_type_var tvh
#! {td_rhs,td_args} = common_defs.[glob_module].com_type_defs.[glob_object]
= case td_rhs of
SynType {at_type=syn_type_rhs=:TV _}
SynType {at_type=syn_type_rhs}
# (expanded_type, tvh) = substitute_instance_type td_args type_args syn_type_rhs tvh
-> root_type_polymorphic expanded_type previous_type_vars common_defs tvh
SynType {at_type=syn_type_rhs=:(CV _ :@: _)}
# (expanded_type, tvh) = substitute_instance_type td_args type_args syn_type_rhs tvh
-> root_type_polymorphic expanded_type previous_type_vars common_defs tvh
-> check_if_default_instance_type_arg expanded_type previous_type_vars common_defs has_root_type_var tvh
_
-> (False,previous_type_vars,tvh)
root_type_polymorphic (TV {tv_info_ptr}) previous_type_vars common_defs tvh
-> only_used_once_type_variables type_args previous_type_vars common_defs has_root_type_var tvh
check_if_default_instance_type_arg (TAS _ type_args _) previous_type_vars common_defs has_root_type_var tvh
= only_used_once_type_variables type_args previous_type_vars common_defs has_root_type_var tvh
check_if_default_instance_type_arg (TB _) previous_type_vars common_defs has_root_type_var tvh
= (True,previous_type_vars,has_root_type_var,tvh)
check_if_default_instance_type_arg (type1 --> type2) previous_type_vars common_defs has_root_type_var tvh
= only_used_once_type_variables [type1,type2] previous_type_vars common_defs has_root_type_var tvh
check_if_default_instance_type_arg TArrow previous_type_vars common_defs has_root_type_var tvh
= (True,previous_type_vars,has_root_type_var,tvh)
check_if_default_instance_type_arg (TArrow1 type) previous_type_vars common_defs has_root_type_var tvh
= only_used_once_type_variables [type] previous_type_vars common_defs has_root_type_var tvh
check_if_default_instance_type_arg type previous_type_vars common_defs has_root_type_var tvh
= (False,previous_type_vars,has_root_type_var,tvh)
only_used_once_type_variables :: ![AType] ![TypeVarInfoPtr] !{#CommonDefs} !Bool !*TypeVarHeap -> (!Bool,[TypeVarInfoPtr],!Bool,!*TypeVarHeap)
only_used_once_type_variables [{at_type=TV {tv_info_ptr}}:type_args] previous_type_vars common_defs has_root_type_var tvh
| IsMember tv_info_ptr previous_type_vars
= (False,previous_type_vars,tvh);
= (True,[tv_info_ptr:previous_type_vars],tvh)
root_type_polymorphic type previous_type_vars common_defs tvh
= (False,previous_type_vars,tvh)
= (False,previous_type_vars,has_root_type_var,tvh)
# previous_type_vars = [tv_info_ptr:previous_type_vars]
= only_used_once_type_variables type_args previous_type_vars common_defs has_root_type_var tvh
only_used_once_type_variables [type_arg1=:{at_type=TA {type_index={glob_object,glob_module}} type_args_TA}:type_args] previous_type_vars common_defs has_root_type_var tvh
#! {td_rhs,td_args} = common_defs.[glob_module].com_type_defs.[glob_object]
= case td_rhs of
SynType {at_type=syn_type_rhs}
# (expanded_type, tvh) = substitute_instance_type td_args type_args_TA syn_type_rhs tvh
-> only_used_once_type_variables [{type_arg1 & at_type=expanded_type}:type_args] previous_type_vars common_defs has_root_type_var tvh
_
-> (False,previous_type_vars,has_root_type_var,tvh)
only_used_once_type_variables [_:_] previous_type_vars common_defs has_root_type_var tvh
= (False,previous_type_vars,has_root_type_var,tvh)
only_used_once_type_variables [] previous_type_vars common_defs has_root_type_var tvh
= (True,previous_type_vars,has_root_type_var,tvh)
......@@ -8,7 +8,7 @@ from check_instances import ::SortedInstances
:: InstanceTree
= IT_Node !(Global Index) !InstanceTree !InstanceTree
| IT_Empty
| IT_Trees !SortedInstances !InstanceTree
| IT_Trees !SortedInstances !InstanceTree !InstanceTree
:: ClassInstanceInfo :== {# .{! .InstanceTree}}
......
......@@ -1095,11 +1095,15 @@ where
= find_unboxed_array_instance element_type right defs predef_symbols
find_unboxed_array_instance element_type IT_Empty defs predef_symbols
= (ObjectNotFound,predef_symbols)
find_unboxed_array_instance element_type (IT_Trees sorted_instances instances) defs predef_symbols
find_unboxed_array_instance element_type (IT_Trees sorted_instances other_instances default_instances) defs predef_symbols
# (index,predef_symbols) = find_sorted_unboxed_array_instance element_type sorted_instances defs predef_symbols
| FoundObject index
= (index,predef_symbols)
= find_unboxed_array_instance element_type instances defs predef_symbols
# (index,predef_symbols)
= find_unboxed_array_instance element_type other_instances defs predef_symbols
| FoundObject index
= (index,predef_symbols)
= find_unboxed_array_instance element_type default_instances defs predef_symbols
where
find_sorted_unboxed_array_instance element_type (SI_Node instances left right) defs predef_symbols
# (left_index,predef_symbols) = find_sorted_unboxed_array_instance element_type left defs predef_symbols
......@@ -1137,11 +1141,14 @@ where
= find_unboxed_list_instance element_type right defs
find_unboxed_list_instance element_type IT_Empty defs
= ObjectNotFound
find_unboxed_list_instance element_type (IT_Trees sorted_instances instances) defs
find_unboxed_list_instance element_type (IT_Trees sorted_instances other_instances default_instances) defs
# index = find_sorted_unboxed_list_instance element_type sorted_instances defs
| FoundObject index
= index
= find_unboxed_list_instance element_type instances defs
# index = find_unboxed_list_instance element_type other_instances defs
| FoundObject index
= index
= find_unboxed_list_instance element_type default_instances defs
where
find_sorted_unboxed_list_instance element_type (SI_Node instances left right) defs
# left_index = find_sorted_unboxed_list_instance element_type left defs
......@@ -1375,11 +1382,17 @@ where
= mapSt (reduceTCorNormalContext info rdla) ftcs {prs_state & prs_type_heaps = prs_type_heaps}
find_instance :: [Type] !InstanceTree {#CommonDefs} *TypeHeaps !*Subst -> *(!Global Int, ![TypeContext], !*TypeHeaps, !*Subst)
find_instance co_types (IT_Trees sorted_instances instance_tree) defs type_heaps subst
# (found, instances, type_heaps, subst) = find_instance_group co_types sorted_instances defs type_heaps subst
find_instance co_types (IT_Trees sorted_instances other_instance_tree default_instance_tree) defs type_heaps subst
# (found,instances,type_heaps,subst) = find_instance_group co_types sorted_instances defs type_heaps subst
| found
= find_root_monomorphic_instance_in_group co_types instances defs type_heaps subst
= find_root_polymorphic_instance co_types instance_tree defs type_heaps subst
# (instance_index,context,type_heaps,subst) = find_instance_in_group co_types instances defs type_heaps subst
| FoundObject instance_index
= (instance_index,context,type_heaps,subst)
= find_instance_in_tree co_types other_instance_tree defs type_heaps subst
# (instance_index,context,type_heaps,subst) = find_instance_in_tree co_types other_instance_tree defs type_heaps subst
| FoundObject instance_index
= (instance_index,context,type_heaps,subst)
= find_instance_in_tree co_types default_instance_tree defs type_heaps subst
find_instance_group :: [Type] !SortedInstances !{#CommonDefs} !*TypeHeaps !*Subst -> *(!Bool, ![Global Int], !*TypeHeaps, !*Subst)
find_instance_group co_types (SI_Node instances=:[this_inst_index=:{glob_object,glob_module}:_] left right) defs type_heaps subst
......@@ -1398,8 +1411,8 @@ where
find_instance_group co_types SI_Empty defs type_heaps subst
= (False, [], type_heaps, subst)
find_root_monomorphic_instance_in_group :: [Type] ![Global Index] {#CommonDefs} *TypeHeaps !*Subst -> *(!Global Int, ![TypeContext], !*TypeHeaps, !*Subst)
find_root_monomorphic_instance_in_group co_types [this_inst_index=:{glob_object,glob_module}:instances] defs type_heaps subst
find_instance_in_group :: [Type] ![Global Index] {#CommonDefs} *TypeHeaps !*Subst -> *(!Global Int, ![TypeContext], !*TypeHeaps, !*Subst)
find_instance_in_group co_types [this_inst_index=:{glob_object,glob_module}:instances] defs type_heaps subst
# {ins_type={it_vars,it_types,it_context}, ins_specials} = defs.[glob_module].com_instance_defs.[glob_object]
th_vars = clear_binding_of_type_vars it_vars type_heaps.th_vars
substc = {substc_changes=[#!], substc_array=subst.subst_array, substc_next_var_n=subst.subst_next_var_n}
......@@ -1417,13 +1430,13 @@ where
= (spec_inst, [], type_heaps, subst)
= (this_inst_index, subst_context, type_heaps, subst)
# subst & subst_array=undo_substitutions substc
= find_root_monomorphic_instance_in_group co_types instances defs type_heaps subst
find_root_monomorphic_instance_in_group co_types [] defs heaps subst
= find_instance_in_group co_types instances defs type_heaps subst
find_instance_in_group co_types [] defs heaps subst
= (ObjectNotFound, [], heaps, subst)
find_root_polymorphic_instance :: [Type] !InstanceTree {#CommonDefs} *TypeHeaps !*Subst -> *(!Global Int, ![TypeContext], !*TypeHeaps, !*Subst)
find_root_polymorphic_instance co_types (IT_Node this_inst_index=:{glob_object,glob_module} left right) defs type_heaps subst
# (left_index, inst_contexts, type_heaps, subst) = find_root_polymorphic_instance co_types left defs type_heaps subst
find_instance_in_tree :: [Type] !InstanceTree {#CommonDefs} *TypeHeaps !*Subst -> *(!Global Int, ![TypeContext], !*TypeHeaps, !*Subst)
find_instance_in_tree co_types (IT_Node this_inst_index=:{glob_object,glob_module} left right) defs type_heaps subst
# (left_index, inst_contexts, type_heaps, subst) = find_instance_in_tree co_types left defs type_heaps subst
| FoundObject left_index
= (left_index, inst_contexts, type_heaps, subst)
# {ins_type={it_vars,it_types,it_context}, ins_specials} = defs.[glob_module].com_instance_defs.[glob_object]
......@@ -1434,8 +1447,8 @@ where
# subst & subst_array=substc.substc_array, subst_next_var_n=substc.substc_next_var_n
= found_instance substc.substc_changes it_context ins_specials this_inst_index type_heaps subst
# subst & subst_array=undo_substitutions substc
= find_root_polymorphic_instance co_types right defs type_heaps subst
find_root_polymorphic_instance co_types IT_Empty defs heaps subst
= find_instance_in_tree co_types right defs type_heaps subst
find_instance_in_tree co_types IT_Empty defs heaps subst
= (ObjectNotFound, [], heaps, subst)
found_instance :: ![#Int!] ![TypeContext] !Specials !(Global Index) !*TypeHeaps !*Subst -> *(!Global Int, ![TypeContext], !*TypeHeaps, !*Subst)
......@@ -1455,11 +1468,17 @@ where
find_fun_dep_instance :: [Type] !InstanceTree BITVECT {#CommonDefs} *TypeHeaps !*Subst
-> *(!Global Int, ![TypeContext], ![(TypeVarInfoPtr,Int)], !*TypeHeaps,!*Subst)
find_fun_dep_instance co_types (IT_Trees sorted_instances instance_tree) class_fun_dep_vars defs type_heaps subst
# (found, instances, type_heaps, subst) = find_fun_dep_instance_group co_types sorted_instances class_fun_dep_vars defs type_heaps subst
find_fun_dep_instance co_types (IT_Trees sorted_instances other_instance_tree default_instance_tree) class_fun_dep_vars defs type_heaps subst
# (found,instances,type_heaps,subst) = find_fun_dep_instance_group co_types sorted_instances class_fun_dep_vars defs type_heaps subst
| found
= find_root_monomorphic_fun_dep_instance_in_group co_types instances class_fun_dep_vars defs type_heaps subst
= find_root_polymorphic_fun_dep_instance co_types instance_tree class_fun_dep_vars defs type_heaps subst
# (instance_index,context,new_vars,type_heaps,subst) = find_fun_dep_instance_in_group co_types instances class_fun_dep_vars defs type_heaps subst
| FoundObject instance_index
= (instance_index,context,new_vars,type_heaps,subst)
= find_fun_dep_instance_in_tree co_types other_instance_tree class_fun_dep_vars defs type_heaps subst
# (instance_index,context,new_vars,type_heaps,subst)= find_fun_dep_instance_in_tree co_types other_instance_tree class_fun_dep_vars defs type_heaps subst
| FoundObject instance_index
= (instance_index,context,new_vars,type_heaps,subst)
= find_fun_dep_instance_in_tree co_types default_instance_tree class_fun_dep_vars defs type_heaps subst
find_fun_dep_instance_group :: [Type] !SortedInstances !BITVECT !{#CommonDefs} !*TypeHeaps !*Subst -> *(!Bool, ![Global Int], !*TypeHeaps, !*Subst)
find_fun_dep_instance_group co_types (SI_Node instances=:[this_inst_index=:{glob_object,glob_module}:_] left right) class_fun_dep_vars defs type_heaps subst
......@@ -1478,9 +1497,9 @@ where
find_fun_dep_instance_group co_types SI_Empty class_fun_dep_vars defs type_heaps subst
= (False, [], type_heaps, subst)
find_root_monomorphic_fun_dep_instance_in_group :: [Type] ![Global Index] BITVECT {#CommonDefs} *TypeHeaps !*Subst
-> *(!Global Int, ![TypeContext], ![(TypeVarInfoPtr,Int)], !*TypeHeaps,!*Subst)
find_root_monomorphic_fun_dep_instance_in_group co_types [this_inst_index=:{glob_object,glob_module}:instances] class_fun_dep_vars defs type_heaps subst
find_fun_dep_instance_in_group :: [Type] ![Global Index] BITVECT {#CommonDefs} *TypeHeaps !*Subst
-> *(!Global Int, ![TypeContext], ![(TypeVarInfoPtr,Int)], !*TypeHeaps,!*Subst)
find_fun_dep_instance_in_group co_types [this_inst_index=:{glob_object,glob_module}:instances] class_fun_dep_vars defs type_heaps subst
# {ins_type={it_vars,it_types,it_context}, ins_specials} = defs.[glob_module].com_instance_defs.[glob_object]
th_vars = clear_binding_of_type_vars it_vars type_heaps.th_vars
substc = {substc_changes=[#!], substc_array=subst.subst_array, substc_next_var_n=subst.subst_next_var_n}
......@@ -1493,23 +1512,23 @@ where
(False, substc)
| maybe_non_termination
# subst & subst_array=undo_substitutions substc
= find_root_monomorphic_fun_dep_instance_in_group co_types instances class_fun_dep_vars defs type_heaps subst
= find_fun_dep_instance_in_group co_types instances class_fun_dep_vars defs type_heaps subst
# (matched, type_heaps, substc) = matchListsOfFunDepTypes defs it_types co_types class_fun_dep_vars type_heaps substc
| not matched
# subst & subst_array=undo_substitutions substc
= find_root_monomorphic_fun_dep_instance_in_group co_types instances class_fun_dep_vars defs type_heaps subst
= find_fun_dep_instance_in_group co_types instances class_fun_dep_vars defs type_heaps subst
# subst & subst_array=substc.substc_array, subst_next_var_n=substc.substc_next_var_n
= found_fun_dep_instance substc.substc_changes all_vars_defined it_vars it_context ins_specials this_inst_index type_heaps subst
# subst & subst_array=undo_substitutions substc
= find_root_monomorphic_fun_dep_instance_in_group co_types instances class_fun_dep_vars defs type_heaps subst
find_root_monomorphic_fun_dep_instance_in_group co_types [] class_fun_dep_vars defs heaps subst
= find_fun_dep_instance_in_group co_types instances class_fun_dep_vars defs type_heaps subst
find_fun_dep_instance_in_group co_types [] class_fun_dep_vars defs heaps subst
= (ObjectNotFound, [], [], heaps, subst)
find_root_polymorphic_fun_dep_instance :: [Type] !InstanceTree BITVECT {#CommonDefs} *TypeHeaps !*Subst
-> *(!Global Int, ![TypeContext], ![(TypeVarInfoPtr,Int)], !*TypeHeaps,!*Subst)
find_root_polymorphic_fun_dep_instance co_types (IT_Node this_inst_index=:{glob_object,glob_module} left right) class_fun_dep_vars defs type_heaps subst
# (left_index, inst_contexts, new_vars, type_heaps, subst) = find_root_polymorphic_fun_dep_instance co_types left class_fun_dep_vars defs type_heaps subst
find_fun_dep_instance_in_tree :: [Type] !InstanceTree BITVECT {#CommonDefs} *TypeHeaps !*Subst
-> *(!Global Int, ![TypeContext], ![(TypeVarInfoPtr,Int)], !*TypeHeaps,!*Subst)
find_fun_dep_instance_in_tree co_types (IT_Node this_inst_index=:{glob_object,glob_module} left right) class_fun_dep_vars defs type_heaps subst
# (left_index, inst_contexts, new_vars, type_heaps, subst) = find_fun_dep_instance_in_tree co_types left class_fun_dep_vars defs type_heaps subst
| FoundObject left_index
= (left_index, inst_contexts, new_vars, type_heaps, subst)
# {ins_type={it_vars,it_types,it_context}, ins_specials} = defs.[glob_module].com_instance_defs.[glob_object]
......@@ -1524,17 +1543,17 @@ where
(False, substc)
| maybe_non_termination
# subst & subst_array=undo_substitutions substc
= find_root_polymorphic_fun_dep_instance co_types right class_fun_dep_vars defs type_heaps subst
= find_fun_dep_instance_in_tree co_types right class_fun_dep_vars defs type_heaps subst
# (matched, type_heaps, substc) = matchListsOfFunDepTypes defs it_types co_types class_fun_dep_vars type_heaps substc
| not matched
# subst & subst_array=undo_substitutions substc
= find_root_polymorphic_fun_dep_instance co_types right class_fun_dep_vars defs type_heaps subst
= find_fun_dep_instance_in_tree co_types right class_fun_dep_vars defs type_heaps subst
# subst & subst_array=substc.substc_array, subst_next_var_n=substc.substc_next_var_n
= found_fun_dep_instance substc.substc_changes all_vars_defined it_vars it_context ins_specials this_inst_index type_heaps subst
# subst & subst_array=undo_substitutions substc
= find_root_polymorphic_fun_dep_instance co_types right class_fun_dep_vars defs type_heaps subst
find_root_polymorphic_fun_dep_instance co_types IT_Empty class_fun_dep_vars defs heaps subst
= find_fun_dep_instance_in_tree co_types right class_fun_dep_vars defs type_heaps subst
find_fun_dep_instance_in_tree co_types IT_Empty class_fun_dep_vars defs heaps subst
= (ObjectNotFound, [], [], heaps, subst)
found_fun_dep_instance :: ![#Int!] !Bool ![TypeVar] ![TypeContext] !Specials !(Global Index) !*TypeHeaps !*Subst
......
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