Commit 9062456a authored by John van Groningen's avatar John van Groningen
Browse files

bug fix in comparing type contexts of specified and derived types of local...

bug fix in comparing type contexts of specified and derived types of local functions with specified type constraints and derived constraints using type variables in the types of lifted arguments
parent 0200a5da
......@@ -2658,7 +2658,6 @@ where
-> (out, th_attrs)
Yes show_attributes
# form = { form_properties = if show_attributes cAttributed cNoProperties, form_attr_position = No }
// out = out <<< show_attributes <<< "\n"
(printable_type, th_attrs)
= case show_attributes of
True
......@@ -2673,7 +2672,7 @@ where
check_function_type fun_type tmp_fun_type=:{tst_lifted} clean_fun_type=:{st_arity, st_args, st_vars, st_attr_vars, st_context} type_ptrs
defs fun_env attr_var_env type_heaps expr_heap error
# (equi, attr_var_env, type_heaps) = equivalent clean_fun_type tmp_fun_type (length fun_type.st_context) defs attr_var_env type_heaps
# (equi, attr_var_env, type_heaps) = equivalent clean_fun_type tmp_fun_type defs attr_var_env type_heaps
| equi
# type_with_lifted_arg_types = addLiftedArgumentsToSymbolType fun_type tst_lifted st_args st_vars st_attr_vars st_context
(type_heaps, expr_heap) = updateExpressionTypes clean_fun_type type_with_lifted_arg_types type_ptrs type_heaps expr_heap
......
......@@ -45,7 +45,7 @@ cleanUpSymbolType :: !Bool !Bool !TempSymbolType ![TypeContext] ![ExprInfoPtr] !
set_class_args_types :: !ClassArgs ![Type] !*TypeVarHeap -> *TypeVarHeap
equivalent :: !SymbolType !TempSymbolType !Int !{# CommonDefs} !*AttributeEnv !*TypeHeaps -> (!Bool, !*AttributeEnv, !*TypeHeaps)
equivalent :: !SymbolType !TempSymbolType !{#CommonDefs} !*AttributeEnv !*TypeHeaps -> (!Bool, !*AttributeEnv, !*TypeHeaps)
NewAttrVar :: !Int !*AttrVarHeap -> (!AttributeVar,!*AttrVarHeap)
......
......@@ -1333,12 +1333,12 @@ set_class_arg_pattern [{atv_variable={tv_info_ptr}}:pattern_vars] [{at_type}:a_t
set_class_arg_pattern [] [] type_var_heap
= type_var_heap
equivalent :: !SymbolType !TempSymbolType !Int !{# CommonDefs} !*AttributeEnv !*TypeHeaps -> (!Bool, !*AttributeEnv, !*TypeHeaps)
equivalent st=:{st_args,st_result,st_context,st_attr_env} tst=:{tst_args,tst_result,tst_context,tst_attr_env,tst_lifted} nr_of_contexts defs attr_env heaps
# nr_of_lifted_contexts = length st_context - nr_of_contexts
equivalent :: !SymbolType !TempSymbolType !{#CommonDefs} !*AttributeEnv !*TypeHeaps -> (!Bool, !*AttributeEnv, !*TypeHeaps)
equivalent {st_args,st_result,st_context,st_attr_env} {tst_args,tst_result,tst_context,tst_attr_env,tst_lifted} defs attr_env heaps
# nr_of_lifted_contexts = length st_context - length tst_context
# (ok, heaps) = equiv (drop tst_lifted st_args,st_result) (drop tst_lifted tst_args,tst_result) heaps
| ok
# (ok, heaps) = equivalent_list_of_contexts (drop nr_of_lifted_contexts st_context) (drop nr_of_lifted_contexts tst_context) defs heaps
# (ok, heaps) = equivalent_list_of_contexts (drop nr_of_lifted_contexts st_context) tst_context defs heaps
| ok
# (ok, attr_env, attr_var_heap) = equivalent_environments st_attr_env (fill_environment tst_attr_env attr_env) heaps.th_attrs
= (ok, clear_environment tst_attr_env attr_env, { heaps & th_attrs = attr_var_heap })
......
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