diff options
Diffstat (limited to 'frontend')
| -rw-r--r-- | frontend/convertDynamics.icl | 109 |
1 files changed, 55 insertions, 54 deletions
diff --git a/frontend/convertDynamics.icl b/frontend/convertDynamics.icl index 994cd06..5992ff0 100644 --- a/frontend/convertDynamics.icl +++ b/frontend/convertDynamics.icl @@ -12,6 +12,7 @@ extended_unify_and_coerce no yes :== no; // change also _unify and _coerce in St //import pp; import type_io; +//import pp; //import RWSDebug; /*2.0 @@ -220,39 +221,70 @@ where # (group, groups) = groups![group_nr] = convert_groups (inc group_nr) groups global_type_instances (foldSt (convert_function group_nr global_type_instances) group.group_members fun_defs_and_ci) + convert_function group_nr global_type_instances fun (fun_defs, ci) # (fun_def, fun_defs) = fun_defs![fun] {fun_body, fun_type, fun_info} = fun_def | isEmpty fun_info.fi_dynamics = (fun_defs, ci) - # 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 - } - -*/ + // For each function which uses dynamics, a module id is constructed regardless + // of its use. In some very specific cases, the let generated here is superfluous. + # (TransformedBody fun_body=:{tb_rhs}) + = fun_body + # (_,ci) + = get_module_idN ci # (tb_rhs,ci) = build_type_identification tb_rhs ci # fun_body - = TransformedBody {fun_body & tb_rhs = tb_rhs} + = {fun_body & tb_rhs = tb_rhs} + # fun_body + = TransformedBody fun_body + # 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 + + # fun_body + = TransformedBody fun_body - // 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 = [] }) + where + get_module_idN ci=:{ci_internal_type_id} + # (dst=:{var_info_ptr},ci) + = newVariable "module_id" VI_Empty ci + # dst_fv + = varToFreeVar dst 1 + + # let_bind + = { lb_src = ci_internal_type_id + , lb_dst = dst_fv + , lb_position = NoPos + } + # ci + = { ci & + ci_new_variables = [ dst_fv : ci.ci_new_variables ] + , ci_module_id = Yes let_bind + } + = (Var dst,ci) + + // identification of types generated by the compiler. If there is no TypeConsSymbol, then + // no identification is necessary. + build_type_identification dyn_type_code ci=:{ci_module_id=No} + = abort "no ptr"; //(dyn_type_code,ci) + build_type_identification dyn_type_code ci=:{ci_module_id=Yes let_bind} + # (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 + } + = (letje,ci) + + // MV .. convert_dynamics_in_body global_type_instances (TransformedBody {tb_args,tb_rhs}) (Yes {st_context, st_args}) ci # vars_with_types = bindVarsToTypes2 st_context tb_args st_args [] common_defs @@ -472,21 +504,6 @@ where = (EE, ci) convertDynamics cinp bound_vars default_expr expression ci = abort "unexpected value in convertDynamics: 'convertDynamics.Expression'" - -// identification of types generated by the compiler. If there is no TypeConsSymbol, then -// no identification is necessary. -build_type_identification dyn_type_code ci=:{ci_module_id=No} - = (dyn_type_code,ci) -build_type_identification dyn_type_code ci=:{ci_module_id=Yes let_bind} - # (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 - } - = (letje,ci) //convertTypecode :: !ConversionInput TypeCodeExpression !*ConversionInfo -> (Expression,!*ConversionInfo) /* @@ -601,24 +618,6 @@ where get_module_id ci=:{ci_module_id=Yes {lb_dst}} = (Var (freeVarToVar lb_dst),ci) - get_module_id ci - # (dst=:{var_info_ptr},ci) - = newVariable "module_id" VI_Empty ci - # dst_fv - = varToFreeVar dst 1 - - # let_bind - = { lb_src = ci_internal_type_id - , lb_dst = dst_fv - , lb_position = NoPos - } - # ci - = { ci & - ci_new_variables = [ dst_fv : ci.ci_new_variables ] - , ci_module_id = Yes let_bind - } - = (Var dst,ci) - convertTypecode cinp (TCE_Selector selections var_info_ptr) replace_tc_args binds placeholders_and_tc_args ci #! (var,binds,placeholders_and_tc_args,ci) = convertTypecode cinp (TCE_Var var_info_ptr) replace_tc_args binds placeholders_and_tc_args ci @@ -1292,4 +1291,6 @@ get_module_id_app predef_symbols , app_args = [App module_symb] , app_info_ptr = nilPtr } - = (module_symb,App module_id_symb,predef_symbols)
\ No newline at end of file + = (module_symb,App module_id_symb,predef_symbols) + + |