Commit b3caffdb authored by Sjaak Smetsers's avatar Sjaak Smetsers
Browse files

bug fix

parent cacf53a0
......@@ -48,11 +48,13 @@ where
= 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]
# {fun_body, fun_type, fun_info} = fun_def
(fun_body, ci) = convert_dynamics_in_body {cinp_glob_type_inst = global_type_instances, cinp_group_index = group_nr} fun_body fun_type ci
= ({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 = [] }) ---> ("convert_function", ci.ci_new_variables ++ fun_info.fi_local_vars)
# (fun_def, fun_defs) = fun_defs![fun]
{fun_body, fun_type, fun_info} = fun_def
| isEmpty fun_info.fi_dynamics
= (fun_defs, ci)
# (fun_body, ci) = convert_dynamics_in_body {cinp_glob_type_inst = global_type_instances, cinp_group_index = group_nr} fun_body fun_type ci
= ({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 = [] })
convert_dynamics_in_body global_type_instances (TransformedBody {tb_args,tb_rhs}) (Yes {st_args}) ci
# vars_with_types = bindVarsToTypes tb_args st_args []
......@@ -295,17 +297,16 @@ where
/*** convert the elements of this pattern ***/
x_i_bind = { bind_src = opened_dynamic.opened_dynamic_expr, bind_dst = dp_var }
(a_ij_binds, ci) = createVariables dp_type_patterns_vars [] ci
(type_code, ci) = convertTypecode cinp dp_type_code ci
(dp_rhs, ci) = convertDynamics cinp bound_vars this_default dp_rhs ci
(a_ij_binds, ci) = createVariables dp_type_patterns_vars [] ci
(type_code, ci) = convertTypecode cinp dp_type_code ci
(dp_rhs, ci) = convertDynamics cinp bound_vars this_default dp_rhs ci
/*** recursively convert the other patterns ***/
(binds, ci) = convert_other_patterns cinp bound_vars this_default pattern_number opened_dynamic result_type last_default patterns ci
(binds, ci) = convert_other_patterns cinp bound_vars this_default pattern_number opened_dynamic result_type last_default patterns ci
/*** generate the expression ***/
(unify_symb, ci) = getSymbol PD_unify SK_Function 2 ci
(twotuple, ci) = getTupleSymbol 2 ci
(let_info_ptr, ci) = let_ptr ci
......@@ -313,10 +314,11 @@ where
(default_expr, ci) = toExpression this_default ci
(unify_result_var, ci) = newVariable "result" VI_Empty ci
unify_result_fv = varToFreeVar unify_result_var 1
(unify_bool_var, ci) = newVariable "unify_bool" VI_Empty ci
(unify_bool_var, ci) = newVariable "unify_bool" VI_Empty ci
unify_bool_fv = varToFreeVar unify_bool_var 1
(let_binds, ci) = bind_indirection_var ind_var unify_result_var twotuple ci
(let_binds, ci) = bind_indirection_var ind_var unify_result_var twotuple ci
a_ij_binds = add_x_i_bind opened_dynamic.opened_dynamic_expr dp_var a_ij_binds
let_expr = Let { let_strict = False,
let_binds = [{ bind_src = App { app_symb = unify_symb, app_args = [opened_dynamic.opened_dynamic_type, type_code], app_info_ptr = nilPtr },
......@@ -330,7 +332,7 @@ where
case_ident = No,
case_info_ptr = case_info_ptr },
let_info_ptr = let_info_ptr }
= ([x_i_bind : a_ij_binds ++ binds], let_expr, { ci & ci_new_variables = [unify_result_fv, unify_bool_fv : ci.ci_new_variables]})
= (a_ij_binds ++ binds, let_expr, { ci & ci_new_variables = [unify_result_fv, unify_bool_fv : ci.ci_new_variables]})
where
bind_indirection_var var=:{var_info_ptr} unify_result_var twotuple ci=:{ci_var_heap,ci_new_variables}
# (VI_Indirection ref_count, ci_var_heap) = readPtr var_info_ptr ci_var_heap
......@@ -340,6 +342,11 @@ where
{ ci & ci_var_heap = ci_var_heap, ci_new_variables = [ ind_fv : ci_new_variables ]})
= ([], {ci & ci_var_heap = ci_var_heap})
add_x_i_bind bind_src bind_dst=:{fv_count} binds
| fv_count > 0
= [ { bind_src = bind_src, bind_dst = bind_dst } : binds ]
= binds
convert_other_patterns :: ConversionInput BoundVariables DefaultExpression Int OpenedDynamic AType !(Optional Expression) ![DynamicPattern] !*ConversionInfo
-> (Env Expression FreeVar, *ConversionInfo)
convert_other_patterns _ _ _ _ _ _ No [] ci
......
......@@ -196,7 +196,7 @@ not_an_unsafe_pattern (cc, _, ai) = (cc, False, ai)
instance consumerRequirements BoundVar
where
consumerRequirements {var_info_ptr} _ ai=:{ai_var_heap}
consumerRequirements {var_name,var_info_ptr} _ ai=:{ai_var_heap}
# (var_info, ai_var_heap) = readPtr var_info_ptr ai_var_heap
= continuation var_info { ai & ai_var_heap=ai_var_heap }
where
......@@ -206,6 +206,8 @@ where
#! ref_count = ai_cur_ref_counts.[arg_position]
ai_cur_ref_counts = { ai_cur_ref_counts & [arg_position]=min (ref_count+1) 2 }
= (temp_var, False, { ai & ai_cur_ref_counts=ai_cur_ref_counts })
continuation var_info ai=:{ai_cur_ref_counts}
= abort ("consumerRequirements" ---> (var_name <<- var_info))
// continuation vi ai
// = (cPassive, ai)
......@@ -224,7 +226,7 @@ instance consumerRequirements Expression where
{ ai & ai_next_var = new_next_var, ai_next_var_of_fun = new_ai_next_var_of_fun, ai_var_heap = ai_var_heap }
= consumerRequirements let_expr common_defs ai // XXX why not not_an_unsafe_pattern
where
init_variables [{bind_dst={fv_count, fv_info_ptr}} : binds] ai_next_var ai_next_var_of_fun ai_var_heap
init_variables [{bind_dst={fv_name, fv_count, fv_info_ptr}} : binds] ai_next_var ai_next_var_of_fun ai_var_heap
/* Sjaak ... */
| fv_count > 0
= init_variables binds (inc ai_next_var) (inc ai_next_var_of_fun)
......@@ -1561,7 +1563,7 @@ where
transformApplication :: !App ![Expression] !ReadOnlyTI !*TransformInfo -> *(!Expression,!*TransformInfo)
transformApplication app=:{app_symb=symb=:{symb_kind = SK_Function {glob_module, glob_object},symb_arity}, app_args} extra_args
ro ti=:{ti_cons_args,ti_instances,ti_fun_defs}
ro ti=:{ti_cons_args,ti_instances,ti_fun_defs}
| glob_module == cIclModIndex
| glob_object < size ti_cons_args
#! cons_class = ti_cons_args.[glob_object]
......@@ -1587,9 +1589,17 @@ transformApplication app=:{app_symb=symb=:{symb_kind = SK_Function {glob_module,
/* ... Sjaak */
// XXX linear_bits field has to be added for generated functions
transformApplication app=:{app_symb={symb_kind = SK_GeneratedFunction fun_def_ptr _}} extra_args ro ti=:{ti_fun_heap}
# (FI_Function {gf_fun_def,gf_instance_info,gf_cons_args}, ti_fun_heap) = readPtr fun_def_ptr ti_fun_heap
= transformFunctionApplication gf_fun_def gf_instance_info gf_cons_args app extra_args ro { ti & ti_fun_heap = ti_fun_heap }
/* Sjaak ... */
transformApplication app=:{app_symb={symb_name,symb_kind = SK_GeneratedFunction fun_def_ptr fun_index}} extra_args
ro ti=:{ti_cons_args,ti_instances,ti_fun_defs,ti_fun_heap}
| fun_index < size ti_cons_args
#! cons_class = ti_cons_args.[fun_index]
instances = ti_instances.[fun_index]
fun_def = ti_fun_defs.[fun_index]
= transformFunctionApplication fun_def instances cons_class app extra_args ro ti
# (FI_Function {gf_fun_def,gf_instance_info,gf_cons_args}, ti_fun_heap) = readPtr fun_def_ptr ti_fun_heap
= transformFunctionApplication gf_fun_def gf_instance_info gf_cons_args app extra_args ro { ti & ti_fun_heap = ti_fun_heap }
/* ... Sjaak */
transformApplication app [] ro ti
= (App app, ti)
transformApplication app extra_args ro ti
......@@ -1790,14 +1800,15 @@ where
(foldSt (transform_function common_defs imported_funs) group_members
{ ti & ti_fun_defs = ti_fun_defs, ti_type_heaps = ti_type_heaps, ti_var_heap = ti_var_heap })
= (groups, imported_types, collected_imports, ti)
transform_function common_defs imported_funs fun ti=:{ti_fun_defs}
#! fun_def = ti_fun_defs.[fun]
# {fun_body = TransformedBody tb} = fun_def
ro = { ro_imported_funs = imported_funs
, ro_common_defs = common_defs
, ro_root_case_mode = case tb of {{tb_rhs=Case _} -> RootCase; _ -> NotRootCase}
, ro_fun = fun_def_to_symb_ident fun fun_def
, ro_fun_args = tb.tb_args
ro = { ro_imported_funs = imported_funs
, ro_common_defs = common_defs
, ro_root_case_mode = case tb of {{tb_rhs=Case _} -> RootCase; _ -> NotRootCase}
, ro_fun = fun_def_to_symb_ident fun fun_def
, ro_fun_args = tb.tb_args
}
(fun_rhs, ti) = transform tb.tb_rhs ro ti
= { ti & ti_fun_defs = {ti.ti_fun_defs & [fun] = { fun_def & fun_body = TransformedBody { tb & tb_rhs = fun_rhs }}}}
......
......@@ -1247,13 +1247,14 @@ where
= collect_variables_in_binds binds collected_binds free_vars cos
= (collected_binds, free_vars, cos)
examine_reachable_binds bind_found [bind=:{bind_dst={fv_info_ptr},bind_src} : binds] collected_binds free_vars cos
examine_reachable_binds bind_found [bind=:{bind_dst=fv=:{fv_info_ptr},bind_src} : binds] collected_binds free_vars cos
# (bind_found, binds, collected_binds, free_vars, cos) = examine_reachable_binds bind_found binds collected_binds free_vars cos
#! var_info = sreadPtr fv_info_ptr cos.cos_var_heap
# (VI_Count count is_global) = var_info
| count > 0
# (bind_src, free_vars, cos) = collectVariables bind_src free_vars cos
= (True, binds, [ { bind & bind_src = bind_src } : collected_binds ], free_vars, cos)
/* Sjaak */
= (True, binds, [ { bind_dst = { fv & fv_count = count }, bind_src = bind_src } : collected_binds ], free_vars, cos)
= (bind_found, [bind : binds], collected_binds, free_vars, cos)
examine_reachable_binds bind_found [] collected_binds free_vars cos
= (bind_found, [], collected_binds, free_vars, cos)
......
......@@ -5,7 +5,7 @@ import checksupport, StdCompare
from unitype import Coercions, CoercionTree, AttributePartition
// MW: this switch is used to en(dis)able the fusion algorithm
SwitchFusion fuse dont_fuse :== fuse
SwitchFusion fuse dont_fuse :== dont_fuse
errorHeading :: !String !*ErrorAdmin -> *ErrorAdmin
......
......@@ -4,7 +4,7 @@ import StdEnv, StdCompare
import syntax, parse, check, unitype, utilities, RWSDebug
// MW: this switch is used to en(dis)able the fusion algorithm
SwitchFusion fuse dont_fuse :== fuse
SwitchFusion fuse dont_fuse :== dont_fuse
:: Store :== Int
......
Supports Markdown
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