diff options
Diffstat (limited to 'frontend/overloading.icl')
| -rw-r--r-- | frontend/overloading.icl | 73 |
1 files changed, 42 insertions, 31 deletions
diff --git a/frontend/overloading.icl b/frontend/overloading.icl index ec04b37..d3e42f8 100644 --- a/frontend/overloading.icl +++ b/frontend/overloading.icl @@ -1015,8 +1015,11 @@ where # (type_code_info, symbol_heap, type_pattern_vars, var_heap, error) = convertDynamicTypes fi_dynamics (type_code_info, symbol_heap, type_pattern_vars, var_heap, error) (TransformedBody tb) = fun_body - (tb_rhs, { ui_instance_calls, ui_local_vars, ui_symbol_heap, ui_var_heap, ui_fun_defs, ui_fun_env, ui_error, - ui_x = {x_type_code_info, x_predef_symbols = predef_symbols}}) +// MV (WAS) ... +// (tb_rhs, { ui_instance_calls, ui_local_vars, ui_symbol_heap, ui_var_heap, ui_fun_defs, ui_fun_env, ui_error, +// ui_x = {x_type_code_info, x_predef_symbols = predef_symbols}}) +// ... (WAS) MV + (tb_rhs,ui) = updateExpression fi_group_index tb.tb_rhs { ui_instance_calls = [], ui_symbol_heap = symbol_heap, ui_fun_defs = fun_defs, ui_local_vars = fi_local_vars, ui_fun_env = fun_env, ui_var_heap = var_heap, ui_error = error, @@ -1025,9 +1028,30 @@ where // ... MV // WAS: ui_x = {x_type_code_info=type_code_info, x_predef_symbols=predef_symbols,x_main_dcl_module_n=main_dcl_module_n}} +// MV ... + # (tb_rhs,{ ui_instance_calls, ui_local_vars, ui_symbol_heap, ui_var_heap, ui_fun_defs, ui_fun_env, ui_error, + ui_x = {x_type_code_info, x_predef_symbols = predef_symbols}}) + = build_type_identification tb_rhs ui +// ... MV + fun_def = { fun_def & fun_body = TransformedBody {tb & tb_rhs = tb_rhs}, fun_info = { fun_info & fi_local_vars = ui_local_vars}} = update_dynamics funs type_pattern_vars ({ ui_fun_defs & [fun] = fun_def }) ui_fun_env ui_symbol_heap x_type_code_info ui_var_heap ui_error predef_symbols + +// MV ... +build_type_identification dyn_type_code ui=:{ui_x={x_module_id=No}} + = (dyn_type_code,ui) +build_type_identification dyn_type_code ui=:{ui_x={x_module_id=Yes let_bind}} + # (let_info_ptr, ui) = let_ptr ui + # letje + = Let { let_strict_binds = [], + let_lazy_binds = [let_bind], + let_expr = dyn_type_code, + let_info_ptr = let_info_ptr, + let_expr_position = NoPos + } + = (letje,ui) +// ... MV removeOverloadedFunctions :: ![Index] ![LocalTypePatternVariable] !Int !*{#FunDef} !*{! FunctionType} !*ExpressionHeap !*TypeCodeInfo !*VarHeap !*ErrorAdmin !*{#PredefinedSymbol} @@ -1052,11 +1076,16 @@ where (type_code_info, symbol_heap, type_pattern_vars, var_heap, error) = convertDynamicTypes fun_info.fi_dynamics (type_code_info, symbol_heap, type_pattern_vars, var_heap, error) - (tb_rhs, {ui_instance_calls, ui_local_vars, ui_symbol_heap, ui_var_heap, ui_fun_defs, ui_fun_env, ui_error, ui_x = {x_type_code_info = type_code_info, x_predef_symbols = predef_symbols}}) +// (tb_rhs, {ui_instance_calls, ui_local_vars, ui_symbol_heap, ui_var_heap, ui_fun_defs, ui_fun_env, ui_error, ui_x = {x_type_code_info = type_code_info, x_predef_symbols = predef_symbols}}) + (tb_rhs, ui) = updateExpression fun_info.fi_group_index tb_rhs { ui_instance_calls = [], ui_local_vars = fun_info.fi_local_vars, ui_symbol_heap = symbol_heap, ui_var_heap = var_heap, ui_fun_defs = fun_defs, ui_fun_env = fun_env, ui_error = error, // MV ... ui_x = {x_type_code_info=type_code_info, x_predef_symbols=predef_symbols,x_main_dcl_module_n=main_dcl_module_n,x_internal_type_id = module_id_app,x_module_id = No}} + + # (tb_rhs, {ui_instance_calls, ui_local_vars, ui_symbol_heap, ui_var_heap, ui_fun_defs, ui_fun_env, ui_error, ui_x = {x_type_code_info = type_code_info, x_predef_symbols = predef_symbols}}) + = build_type_identification tb_rhs ui + # // ... MV (tb_args, var_heap) = foldSt retrieve_class_argument rev_variables (tb_args, ui_var_heap) fun_def = { fun_def & fun_body = TransformedBody {tb_args = tb_args, tb_rhs = tb_rhs}, fun_arity = length tb_args, @@ -1505,6 +1534,8 @@ where updateExpression group_index l ui = mapSt (updateExpression group_index) l ui +import RWSDebug + adjustClassExpressions symb_name exprs tail_exprs ui = mapAppendSt (adjustClassExpression symb_name) exprs tail_exprs ui where @@ -1518,29 +1549,8 @@ where # (expr, ui) = adjustClassExpression symb_name expr ui = (Selection opt_type expr selectors, ui) adjustClassExpression symb_name (TypeCodeExpression type_code_expression) ui -// MV ... - # (type_code,ui) - = convertTypecode type_code_expression ui - = build_type_identification type_code ui -// ... MV + = convertTypecode type_code_expression ui where - // MV ... - // identification of types generated by the compiler. If there is no TypeConsSymbol, then - // no identification is necessary. - build_type_identification dyn_type_code ui=:{ui_x={x_module_id=No}} - = (dyn_type_code,ui) - build_type_identification dyn_type_code ui=:{ui_x={x_module_id=Yes let_bind}} - # (let_info_ptr, ui) = let_ptr ui - # letje - = Let { let_strict_binds = [], - let_lazy_binds = [let_bind], - let_expr = dyn_type_code, - let_info_ptr = let_info_ptr, - let_expr_position = NoPos - } - = (letje,ui) - // ... MV - convertTypecode TCE_Empty ui = (EE, ui) convertTypecode (TCE_Var var_info_ptr) ui @@ -1663,16 +1673,17 @@ where varToFreeVar {var_name, var_info_ptr} count = {fv_def_level = NotALevel, fv_name = var_name, fv_info_ptr = var_info_ptr, fv_count = count} - let_ptr ui=:{ui_symbol_heap} - # (expr_info_ptr, ui_symbol_heap) = newPtr (EI_LetType (repeat empty_attributed_type)) ui_symbol_heap - = (expr_info_ptr, {ui & ui_symbol_heap = ui_symbol_heap}) - where - empty_attributed_type :: AType - empty_attributed_type = { at_attribute = TA_Multi, at_annotation = AN_None, at_type = TE } adjustClassExpression symb_name expr ui = (expr, ui) +let_ptr ui=:{ui_symbol_heap} + # (expr_info_ptr, ui_symbol_heap) = newPtr (EI_LetType (repeat empty_attributed_type)) ui_symbol_heap + = (expr_info_ptr, {ui & ui_symbol_heap = ui_symbol_heap}) +where + empty_attributed_type :: AType + empty_attributed_type = { at_attribute = TA_Multi, at_annotation = AN_None, at_type = TE } + class equalTypes a :: !a !a !*TypeVarHeap -> (!Bool, !*TypeVarHeap) instance equalTypes AType |