diff options
Diffstat (limited to 'frontend/overloading.icl')
| -rw-r--r-- | frontend/overloading.icl | 90 |
1 files changed, 82 insertions, 8 deletions
diff --git a/frontend/overloading.icl b/frontend/overloading.icl index c50e9af..a4def34 100644 --- a/frontend/overloading.icl +++ b/frontend/overloading.icl @@ -3,7 +3,7 @@ implementation module overloading import StdEnv import syntax, check, type, typesupport, utilities, unitype, predef, checktypes, convertDynamics -import generics +import generics, compilerSwitches :: InstanceTree = IT_Node !(Global Index) !InstanceTree !InstanceTree | IT_Empty @@ -900,6 +900,10 @@ where # {fi_group_index, fi_dynamics, fi_local_vars} = fun_info | isEmpty fi_dynamics = update_dynamics funs type_pattern_vars fun_defs fun_env symbol_heap type_code_info var_heap error predef_symbols +// MV ... + # (_,module_id_app,predef_symbols) + = get_module_id_app predef_symbols +// ... MV # (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 @@ -908,11 +912,15 @@ where = 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, - ui_x = {x_type_code_info=type_code_info, x_predef_symbols=predef_symbols,x_main_dcl_module_n=main_dcl_module_n}} +// 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}} +// ... 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}} + 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 - + removeOverloadedFunctions :: ![Index] ![LocalTypePatternVariable] !Int!*{#FunDef} !*{! FunctionType} !*ExpressionHeap !*TypeCodeInfo !*VarHeap !*ErrorAdmin !*{#PredefinedSymbol} -> (!*{#FunDef}, !*{! FunctionType}, !*ExpressionHeap, !*TypeCodeInfo, !*VarHeap, !*ErrorAdmin, !*{#PredefinedSymbol}) @@ -923,6 +931,10 @@ removeOverloadedFunctions group type_pattern_vars main_dcl_module_n fun_defs fun = (fun_defs, fun_env, symbol_heap, type_code_info, var_heap, error, predef_symbols) where remove_overloaded_function type_pattern_vars fun_index (fun_defs, fun_env, symbol_heap, type_code_info, var_heap, error, predef_symbols) +// MV ... + # (_,module_id_app,predef_symbols) + = get_module_id_app predef_symbols +// ... MV # (fun_def, fun_defs) = fun_defs![fun_index] (CheckedType st=:{st_context}, fun_env) = fun_env![fun_index] {fun_body = TransformedBody {tb_args,tb_rhs},fun_info,fun_arity,fun_symb,fun_pos} = fun_def @@ -934,7 +946,10 @@ where (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}}) = 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, - ui_x = {x_type_code_info = type_code_info, x_predef_symbols = predef_symbols,x_main_dcl_module_n=main_dcl_module_n}} +// 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}} +// ... 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}} (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, fun_info = { fun_info & fi_calls = fun_info.fi_calls ++ ui_instance_calls, fi_local_vars = ui_local_vars } } @@ -1131,6 +1146,10 @@ where { x_type_code_info :: !.TypeCodeInfo , x_predef_symbols :: !.{#PredefinedSymbol} , x_main_dcl_module_n :: !Int +// MV ... + , x_internal_type_id :: Expression + , x_module_id :: Optional LetBind +// ... MV } class updateExpression e :: !Index !e !*UpdateInfo -> (!e, !*UpdateInfo) @@ -1389,8 +1408,28 @@ where # (expr, ui) = adjustClassExpression symb_name expr ui = (Selection opt_type expr selectors, ui) adjustClassExpression symb_name (TypeCodeExpression type_code_expression) ui - = convertTypecode type_code_expression ui +// MV ... + # (type_code,ui) + = convertTypecode type_code_expression ui + = build_type_identification type_code ui +// ... MV 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) @@ -1399,13 +1438,48 @@ where convertTypecode (TCE_TypeTerm var_info_ptr) ui=:{ui_var_heap,ui_error} # (var_info_ptr, (ui_var_heap,ui_error)) = getTCDictionary symb_name var_info_ptr (ui_var_heap, ui_error) = (Var {var_name = v_tc_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr}, { ui & ui_var_heap = ui_var_heap, ui_error = ui_error}) - convertTypecode (TCE_Constructor index typecode_exprs) ui - # (typecons_symb,ui) = getSymbol PD_TypeConsSymbol SK_Constructor 2 ui +// MV ... + convertTypecode (TCE_Constructor index typecode_exprs) ui=:{ui_x={x_internal_type_id}} + # (typecons_symb,ui) = getSymbol PD_TypeConsSymbol SK_Constructor (USE_DummyModuleName 3 2) ui (constructor,ui) = get_constructor index ui (typecode_exprs, ui) = convertTypecodes typecode_exprs ui + # (ui_internal_type_id,ui) + = get_module_id ui = (App {app_symb = typecons_symb, - app_args = [constructor , typecode_exprs ], + app_args = USE_DummyModuleName [constructor , ui_internal_type_id, typecode_exprs] [constructor , typecode_exprs] , app_info_ptr = nilPtr}, ui) + where + get_module_id ui=:{ui_x={x_module_id=Yes {lb_dst}}} + = (Var (freeVarToVar lb_dst),ui) + + get_module_id ui + # (dst=:{var_info_ptr},ui) + = newVariable "module_id" VI_Empty ui + # dst_fv + = varToFreeVar dst 1 + + # let_bind + = { lb_src = x_internal_type_id + , lb_dst = dst_fv + , lb_position = NoPos + } + # ui + = { ui & + ui_local_vars = [ dst_fv : ui.ui_local_vars ] + , ui_x = { ui.ui_x & x_module_id = Yes let_bind} + } + = (Var dst,ui) + + freeVarToVar :: FreeVar -> BoundVar + freeVarToVar {fv_name, fv_info_ptr} + = { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = nilPtr} + + newVariable :: String !VarInfo !*UpdateInfo -> *(!BoundVar,!*UpdateInfo) + newVariable var_name var_info ui=:{ui_var_heap} + # (var_info_ptr, ui_var_heap) = newPtr var_info ui_var_heap + = ( { var_name = {id_name = var_name, id_info = nilPtr}, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr}, + { ui & ui_var_heap = ui_var_heap }) +// ... MV convertTypecode (TCE_Selector selections var_info_ptr) ui = (Selection No (Var { var_name = a_ij_var_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr }) selections, ui) convertTypecode (TCE_UniType uni_vars type_code) ui |