diff options
| -rw-r--r-- | frontend/overloading.dcl | 2 | ||||
| -rw-r--r-- | frontend/overloading.icl | 28 | ||||
| -rw-r--r-- | frontend/type.icl | 17 |
3 files changed, 30 insertions, 17 deletions
diff --git a/frontend/overloading.dcl b/frontend/overloading.dcl index 9bcec75..d89baac 100644 --- a/frontend/overloading.dcl +++ b/frontend/overloading.dcl @@ -47,7 +47,9 @@ tryToSolveOverloading :: ![(Optional [TypeContext], [ExprInfoPtr], IdentPos, Ind { tci_next_index :: !Index , tci_instances :: ![GlobalTCInstance] , tci_type_var_heap :: !.TypeVarHeap + , tci_attr_var_heap :: !.AttrVarHeap , tci_dcl_modules :: !{# DclModule} + , tci_common_defs :: !{# CommonDefs } , tci_type_constructors_in_patterns :: ![Index] } diff --git a/frontend/overloading.icl b/frontend/overloading.icl index 84d52ce..bed43e4 100644 --- a/frontend/overloading.icl +++ b/frontend/overloading.icl @@ -1313,28 +1313,35 @@ getTCDictionary symb_name var_info_ptr (var_heap, error) { tci_next_index :: !Index , tci_instances :: ![GlobalTCInstance] , tci_type_var_heap :: !.TypeVarHeap + , tci_attr_var_heap :: !.AttrVarHeap , tci_dcl_modules :: !{# DclModule} + , tci_common_defs :: !{# CommonDefs } , tci_type_constructors_in_patterns :: ![Index] } - + class toTypeCodeExpression type :: !Ident type !(!*TypeCodeInfo,!*VarHeap,!*ErrorAdmin) -> (!TypeCodeExpression, !(!*TypeCodeInfo,!*VarHeap,!*ErrorAdmin)) instance toTypeCodeExpression Type where - toTypeCodeExpression symb_name (TA cons_id=:{type_index={glob_module}} type_args) (tci=:{tci_next_index,tci_instances,tci_dcl_modules},var_heap,error) - # defining_module_name - = tci_dcl_modules.[glob_module].dcl_name.id_name - # (inst_index, (tci_next_index, tci_instances)) - = addGlobalTCInstance (GTT_Constructor cons_id defining_module_name False) (tci_next_index, tci_instances) - (type_code_args, tci) = mapSt (toTypeCodeExpression symb_name) type_args ({ tci & tci_next_index = tci_next_index, tci_instances = tci_instances },var_heap,error) - = (TCE_Constructor inst_index type_code_args, tci) - toTypeCodeExpression symb_name (TAS cons_id=:{type_index={glob_module}} type_args _) (tci=:{tci_next_index,tci_instances,tci_dcl_modules},var_heap,error) + toTypeCodeExpression symb_name type=:(TA cons_id=:{type_index={glob_module}} type_args) (tci=:{tci_next_index,tci_instances,tci_dcl_modules,tci_common_defs},var_heap,error) # defining_module_name = tci_dcl_modules.[glob_module].dcl_name.id_name +// RWS ... + # type_heaps + = {th_vars = tci.tci_type_var_heap, th_attrs = tci.tci_attr_var_heap} + # (expanded, type, type_heaps) + = tryToExpandTypeSyn tci_common_defs type cons_id type_args type_heaps + # tci + = {tci & tci_type_var_heap = type_heaps.th_vars, tci_attr_var_heap = type_heaps.th_attrs} + | expanded + = toTypeCodeExpression symb_name type (tci,var_heap,error) +// ... RWS # (inst_index, (tci_next_index, tci_instances)) = addGlobalTCInstance (GTT_Constructor cons_id defining_module_name False) (tci_next_index, tci_instances) (type_code_args, tci) = mapSt (toTypeCodeExpression symb_name) type_args ({ tci & tci_next_index = tci_next_index, tci_instances = tci_instances },var_heap,error) = (TCE_Constructor inst_index type_code_args, tci) + toTypeCodeExpression symb_name (TAS cons_id type_args _) state + = toTypeCodeExpression symb_name (TA cons_id type_args) state toTypeCodeExpression symb_name (TB basic_type) (tci=:{tci_next_index,tci_instances},var_heap,error) # (inst_index, (tci_next_index, tci_instances)) = addGlobalTCInstance (GTT_Basic basic_type) (tci_next_index, tci_instances) @@ -1356,11 +1363,10 @@ where # (new_vars, (tci_type_var_heap, var_heap)) = newTypeVariables vars (tci_type_var_heap, var_heap) (type_code, tci) = toTypeCodeExpression symb_name type ({tci & tci_type_var_heap = tci_type_var_heap}, var_heap, error) = (TCE_UniType new_vars type_code, tci) - instance toTypeCodeExpression AType where toTypeCodeExpression symb_ident {at_type} tci_and_var_heap_and_error = toTypeCodeExpression symb_ident at_type tci_and_var_heap_and_error - + :: UpdateInfo = { ui_instance_calls :: ![FunCall] , ui_local_vars :: ![FreeVar] diff --git a/frontend/type.icl b/frontend/type.icl index f5a3366..09fc100 100644 --- a/frontend/type.icl +++ b/frontend/type.icl @@ -2352,25 +2352,30 @@ where | isEmpty over_info # ts_type_heaps = ts.ts_type_heaps type_code_info = { tci_next_index = os_special_instances.si_next_TC_member_index, tci_instances = os_special_instances.si_TC_instances, - tci_type_var_heap = ts_type_heaps.th_vars, tci_dcl_modules = dcl_modules, tci_type_constructors_in_patterns = os_special_instances.si_type_constructors_in_patterns } - # (fun_defs, ts_fun_env, ts_expr_heap, {tci_next_index,tci_instances,tci_type_var_heap,tci_type_constructors_in_patterns}, ts_var_heap, ts_error, os_predef_symbols) + tci_type_var_heap = ts_type_heaps.th_vars, tci_attr_var_heap = ts_type_heaps.th_attrs, + tci_dcl_modules = dcl_modules, tci_common_defs = ti_common_defs, + tci_type_constructors_in_patterns = os_special_instances.si_type_constructors_in_patterns } + # (fun_defs, ts_fun_env, ts_expr_heap, {tci_next_index,tci_instances,tci_type_var_heap,tci_attr_var_heap,tci_type_constructors_in_patterns}, ts_var_heap, ts_error, os_predef_symbols) = updateDynamics comp local_pattern_variables main_dcl_module_n ts.ts_fun_defs ts.ts_fun_env ts.ts_expr_heap type_code_info ts.ts_var_heap ts.ts_error os_predef_symbols = ( type_error || not ts_error.ea_ok, os_predef_symbols, { os_special_instances & si_next_TC_member_index = tci_next_index, si_TC_instances = tci_instances, si_type_constructors_in_patterns = tci_type_constructors_in_patterns }, out, { ts & ts_var_store = 0, ts_attr_store = FirstAttrVar, ts_cons_variables = [], ts_exis_variables = [], ts_expr_heap = ts_expr_heap, ts_error = { ts_error & ea_ok = True }, - ts_var_heap = ts_var_heap, ts_type_heaps = { ts_type_heaps & th_vars = tci_type_var_heap }, ts_fun_env = ts_fun_env, ts_fun_defs=fun_defs}) + ts_var_heap = ts_var_heap, ts_type_heaps = { ts_type_heaps & th_vars = tci_type_var_heap, th_attrs = tci_attr_var_heap }, + ts_fun_env = ts_fun_env, ts_fun_defs=fun_defs}) # ts_type_heaps = ts.ts_type_heaps type_code_info = { tci_next_index = os_special_instances.si_next_TC_member_index, tci_instances = os_special_instances.si_TC_instances, tci_type_constructors_in_patterns = os_special_instances.si_type_constructors_in_patterns, - tci_type_var_heap = ts_type_heaps.th_vars, tci_dcl_modules = dcl_modules } - (fun_defs, ts_fun_env, ts_expr_heap, {tci_next_index,tci_instances,tci_type_var_heap,tci_type_constructors_in_patterns}, ts_var_heap, ts_error, os_predef_symbols) + tci_type_var_heap = ts_type_heaps.th_vars, tci_attr_var_heap = ts_type_heaps.th_attrs, + tci_dcl_modules = dcl_modules, tci_common_defs = ti_common_defs } + (fun_defs, ts_fun_env, ts_expr_heap, {tci_next_index,tci_instances,tci_type_var_heap,tci_attr_var_heap, tci_type_constructors_in_patterns}, ts_var_heap, ts_error, os_predef_symbols) = removeOverloadedFunctions comp local_pattern_variables main_dcl_module_n ts.ts_fun_defs ts.ts_fun_env ts.ts_expr_heap type_code_info ts.ts_var_heap ts.ts_error os_predef_symbols = ( type_error || not ts_error.ea_ok, os_predef_symbols, { os_special_instances & si_next_TC_member_index = tci_next_index, si_TC_instances = tci_instances, si_type_constructors_in_patterns = tci_type_constructors_in_patterns }, out, { ts & ts_var_store = 0, ts_attr_store = FirstAttrVar, ts_cons_variables = [], ts_exis_variables = [], ts_expr_heap = ts_expr_heap, ts_error = { ts_error & ea_ok = True }, - ts_var_heap = ts_var_heap, ts_type_heaps = { ts_type_heaps & th_vars = tci_type_var_heap }, ts_fun_env = ts_fun_env, ts_fun_defs=fun_defs}) + ts_var_heap = ts_var_heap, ts_type_heaps = { ts_type_heaps & th_vars = tci_type_var_heap, th_attrs = tci_attr_var_heap }, + ts_fun_env = ts_fun_env, ts_fun_defs=fun_defs}) add_unicity_of_essentially_unique_types_for_function ti_common_defs fun (ts_fun_env, coercions) # (env_type, ts_fun_env) = ts_fun_env![fun] |