Commit a4cd7445 authored by Martijn Vervoort's avatar Martijn Vervoort
Browse files

bug fix: the let for a ModuleID was generated *after* copyExpression which

assumes that all variables are defined. For the time being the let is generated
for each function containing dynamics. In some special cases this is super-
fluous.
parent 70d5d767
......@@ -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)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment