diff options
Diffstat (limited to 'frontend')
| -rw-r--r-- | frontend/convertDynamics.icl | 56 | ||||
| -rw-r--r-- | frontend/overloading.icl | 73 |
2 files changed, 69 insertions, 60 deletions
diff --git a/frontend/convertDynamics.icl b/frontend/convertDynamics.icl index 70363d9..994cd06 100644 --- a/frontend/convertDynamics.icl +++ b/frontend/convertDynamics.icl @@ -226,8 +226,31 @@ where | isEmpty fun_info.fi_dynamics = (fun_defs, ci) # ci - = { ci & ci_used_tcs = [], ci_generated_global_tc_placeholders = False } - # (fun_body, ci) = convert_dynamics_in_body {cinp_st_args = [], cinp_glob_type_inst = global_type_instances, cinp_group_index = group_nr} fun_body fun_type ci + = { ci & ci_used_tcs = [], ci_generated_global_tc_placeholders = False, ci_module_id = No } + # (TransformedBody fun_body=:{tb_rhs}, ci) = convert_dynamics_in_body {cinp_st_args = [], cinp_glob_type_inst = global_type_instances, cinp_group_index = group_nr} fun_body fun_type ci + +/* +:: TransformedBody = + { tb_args :: ![FreeVar] + , tb_rhs :: !Expression + } + # (let_info_ptr, ci) = let_ptr 1 ci + # 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 + } + +*/ + # (tb_rhs,ci) + = build_type_identification tb_rhs ci + # fun_body + = TransformedBody {fun_body & tb_rhs = tb_rhs} + + + // TransformedBody = ({fun_defs & [fun] = { fun_def & fun_body = fun_body, fun_info = { fun_info & fi_local_vars = ci.ci_new_variables ++ fun_info.fi_local_vars }}}, { ci & ci_new_variables = [] }) // MV .. @@ -418,9 +441,7 @@ where /* Sjaak ... */ convertDynamics cinp bound_vars default_expr (DynamicExpr {dyn_expr, dyn_info_ptr, dyn_type_code}) ci=:{ci_symb_ident} # (dyn_expr, ci) = convertDynamics cinp bound_vars default_expr dyn_expr ci - (_,dyn_type_code, _, _, ci) = convertTypecode2 cinp dyn_type_code False [] [] {ci & ci_module_id = No} - # (dyn_type_code,ci) - = build_type_identification dyn_type_code ci + (_,dyn_type_code, _, _, ci) = convertTypecode2 cinp dyn_type_code False [] [] ci = (App { app_symb = ci_symb_ident, app_args = [dyn_expr, dyn_type_code], app_info_ptr = nilPtr }, ci) @@ -861,9 +882,7 @@ where /*** convert the elements of this pattern ***/ (a_ij_binds, ci) = createVariables dp_type_patterns_vars [] ci - (generate_coerce,type_code,_,martijn, ci) = convertTypecode2 cinp dp_type_code True /* should be changed to True for type dependent functions */ /* WAS: a_ij_binds*/ [] [] {ci & ci_module_id = No} // ci - # (type_code,ci) - = build_type_identification type_code ci + (generate_coerce,type_code,_,martijn, ci) = convertTypecode2 cinp dp_type_code True /* should be changed to True for type dependent functions */ /* WAS: a_ij_binds*/ [] [] ci //{ci & ci_module_id = No} // ci // collect ... # (is_last_dynamic_pattern,dp_rhs) @@ -928,27 +947,6 @@ where // sel_type = Selection No (Var unify_result_var) [RecordSelection type_defined_symbol sd_type_field_nr] - -/* -// TIJDELIJK... - - # (ci=:{ci_predef_symb}) - = ci; - # ({pds_module, pds_def}, ci_predef_symb) = ci_predef_symb![PD_ModuleConsSymbol] - # pds_ident = predefined_idents.[PD_ModuleConsSymbol] - # module_symb1 = { symb_name = pds_ident, symb_kind = SK_Constructor { glob_module = pds_module, glob_object = pds_def} } - # ci - = { ci & ci_predef_symb = ci_predef_symb }; - - # module_symb = - { app_symb = module_symb1 - , app_args = [] - , app_info_ptr = nilPtr - } - # module_symb = - App module_symb - // ...TIJDELIJK -*/ /* Sjaak ... */ (let_info_ptr, ci) = let_ptr (2 + length let_binds) ci (case_info_ptr, ci) = bool_case_ptr ci 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 |