Commit 284f0804 authored by Martin Wierich's avatar Martin Wierich
Browse files

extended array patterns for muitidimensional arrays

bugfix
parent 7a011c9c
...@@ -755,7 +755,7 @@ checkIdentPattern is_expr_list id=:{id_name,id_info} opt_var {pi_def_level, pi_m ...@@ -755,7 +755,7 @@ checkIdentPattern is_expr_list id=:{id_name,id_info} opt_var {pi_def_level, pi_m
:: ArrayPattern = :: ArrayPattern =
{ ap_opt_var :: !Optional (Bind Ident VarInfoPtr) { ap_opt_var :: !Optional (Bind Ident VarInfoPtr)
, ap_array_var :: !FreeVar , ap_array_var :: !FreeVar
, ap_selections :: ![Bind FreeVar ParsedExpr] , ap_selections :: ![Bind FreeVar [ParsedExpr]]
} }
buildPattern mod_index (APK_Constructor type_index) cons_symb args opt_var ps e_info cs buildPattern mod_index (APK_Constructor type_index) cons_symb args opt_var ps e_info cs
...@@ -967,7 +967,7 @@ checkPattern (PE_ArrayPattern selections) opt_var p_input (var_env, array_patter ...@@ -967,7 +967,7 @@ checkPattern (PE_ArrayPattern selections) opt_var p_input (var_env, array_patter
{ ps & ps_var_heap = ps_var_heap }, e_info, cs) { ps & ps_var_heap = ps_var_heap }, e_info, cs)
where where
check_array_selection def_level bind=:{bind_dst} states check_array_selection def_level bind=:{bind_dst} states
= check_rhs def_level bind (check_index_expr bind_dst states) = check_rhs def_level bind (foldSt check_index_expr bind_dst states)
check_index_expr (PE_Ident {id_name}) states check_index_expr (PE_Ident {id_name}) states
| isLowerCaseName id_name | isLowerCaseName id_name
...@@ -1895,7 +1895,7 @@ where ...@@ -1895,7 +1895,7 @@ where
= transfromPatternIntoBind ei_mod_index ei_expr_level pattern_expr src_expr e_state.es_var_heap e_state.es_expr_heap e_info cs = transfromPatternIntoBind ei_mod_index ei_expr_level pattern_expr src_expr e_state.es_var_heap e_state.es_expr_heap e_info cs
e_state = { e_state & es_var_heap = es_var_heap, es_expr_heap = es_expr_heap } e_state = { e_state & es_var_heap = es_var_heap, es_expr_heap = es_expr_heap }
(_, array_pattern_binds, free_vars, e_state, e_info, cs) // XXX arrays currently not strictly evaluated (_, array_pattern_binds, free_vars, e_state, e_info, cs) // XXX arrays currently not strictly evaluated
= foldSt (buildSelectCalls e_input) array_patterns ([], [], free_vars, e_state, e_info, cs) = foldSt (buildSelections e_input) array_patterns ([], [], free_vars, e_state, e_info, cs)
all_binds = [(seq_let.ndwl_strict, let_binds), (nOT_STRICT, array_pattern_binds) : binds] with nOT_STRICT = False all_binds = [(seq_let.ndwl_strict, let_binds), (nOT_STRICT, array_pattern_binds) : binds] with nOT_STRICT = False
= (all_binds, loc_envs, max_expr_level, free_vars, e_state, e_info, cs) = (all_binds, loc_envs, max_expr_level, free_vars, e_state, e_info, cs)
check_sequential_lets free_vars [] let_vars_list e_input=:{ei_expr_level} e_state e_info cs check_sequential_lets free_vars [] let_vars_list e_input=:{ei_expr_level} e_state e_info cs
...@@ -2000,7 +2000,7 @@ addArraySelections [] rhs_expr free_vars e_input e_state e_info cs ...@@ -2000,7 +2000,7 @@ addArraySelections [] rhs_expr free_vars e_input e_state e_info cs
= (rhs_expr, free_vars, e_state, e_info, cs) = (rhs_expr, free_vars, e_state, e_info, cs)
addArraySelections array_patterns rhs_expr free_vars e_input e_state e_info cs addArraySelections array_patterns rhs_expr free_vars e_input e_state e_info cs
# (let_strict_binds, let_lazy_binds, free_vars, e_state, e_info, cs) # (let_strict_binds, let_lazy_binds, free_vars, e_state, e_info, cs)
= foldSt (buildSelectCalls e_input) array_patterns ([], [], free_vars, e_state, e_info, cs) = foldSt (buildSelections e_input) array_patterns ([], [], free_vars, e_state, e_info, cs)
(let_expr_ptr, es_expr_heap) (let_expr_ptr, es_expr_heap)
= newPtr EI_Empty e_state.es_expr_heap = newPtr EI_Empty e_state.es_expr_heap
= ( Let {let_strict_binds = let_strict_binds, let_lazy_binds = let_lazy_binds, = ( Let {let_strict_binds = let_strict_binds, let_lazy_binds = let_lazy_binds,
...@@ -2011,7 +2011,7 @@ addArraySelections array_patterns rhs_expr free_vars e_input e_state e_info cs ...@@ -2011,7 +2011,7 @@ addArraySelections array_patterns rhs_expr free_vars e_input e_state e_info cs
, cs , cs
) )
buildSelectCalls e_input {ap_opt_var, ap_array_var, ap_selections} buildSelections e_input {ap_opt_var, ap_array_var, ap_selections}
(strict_binds, lazy_binds, free_vars, e_state, e_info, cs) (strict_binds, lazy_binds, free_vars, e_state, e_info, cs)
# (ap_array_var, strict_binds, lazy_binds, free_vars, e_state, e_info, cs) # (ap_array_var, strict_binds, lazy_binds, free_vars, e_state, e_info, cs)
= foldSt (build_sc e_input) ap_selections = foldSt (build_sc e_input) ap_selections
...@@ -2027,7 +2027,7 @@ buildSelectCalls e_input {ap_opt_var, ap_array_var, ap_selections} ...@@ -2027,7 +2027,7 @@ buildSelectCalls e_input {ap_opt_var, ap_array_var, ap_selections}
no -> (lazy_binds, e_state) no -> (lazy_binds, e_state)
= (strict_binds, lazy_binds, free_vars, e_state, e_info, cs) = (strict_binds, lazy_binds, free_vars, e_state, e_info, cs)
where where
build_sc e_input {bind_dst, bind_src=array_element_var} (ap_array_var, strict_binds, lazy_binds, free_vars, e_state, e_info, cs) build_sc e_input {bind_dst=parsed_index_exprs, bind_src=array_element_var} (ap_array_var, strict_binds, lazy_binds, free_vars, e_state, e_info, cs)
# (var_for_uselect_result, es_var_heap) # (var_for_uselect_result, es_var_heap)
= allocate_free_var { id_name = "_x", id_info = nilPtr } e_state.es_var_heap = allocate_free_var { id_name = "_x", id_info = nilPtr } e_state.es_var_heap
(new_array_var, es_var_heap) (new_array_var, es_var_heap)
...@@ -2036,21 +2036,27 @@ buildSelectCalls e_input {ap_opt_var, ap_array_var, ap_selections} ...@@ -2036,21 +2036,27 @@ buildSelectCalls e_input {ap_opt_var, ap_array_var, ap_selections}
= allocate_bound_var ap_array_var e_state.es_expr_heap = allocate_bound_var ap_array_var e_state.es_expr_heap
(bound_var_for_uselect_result, es_expr_heap) (bound_var_for_uselect_result, es_expr_heap)
= allocate_bound_var var_for_uselect_result es_expr_heap = allocate_bound_var var_for_uselect_result es_expr_heap
(new_expr_ptr, es_expr_heap) dimension = length parsed_index_exprs
= newPtr EI_Empty es_expr_heap (new_expr_ptrs, es_expr_heap)
= mapSt newPtr (repeatn dimension EI_Empty) es_expr_heap
(tuple_cons, cs) (tuple_cons, cs)
= getPredefinedGlobalSymbol (GetTupleConsIndex 2) PD_PredefinedModule STE_Constructor 2 cs = getPredefinedGlobalSymbol (GetTupleConsIndex 2) PD_PredefinedModule STE_Constructor 2 cs
(glob_select_symb, cs) (glob_select_symb, opt_tuple_type, cs)
= getPredefinedGlobalSymbol PD_UnqArraySelectFun PD_StdArray STE_Member 2 cs = case dimension of
1 # (unq_select_symb, cs) = getPredefinedGlobalSymbol PD_UnqArraySelectFun PD_StdArray STE_Member 2 cs
-> (unq_select_symb, No, cs)
_ # (select_symb, cs) = getPredefinedGlobalSymbol PD_ArraySelectFun PD_StdArray STE_Member 2 cs
(tuple_type, cs) = getPredefinedGlobalSymbol (GetTupleTypeIndex 2) PD_PredefinedModule STE_Type 2 cs
-> (select_symb, Yes tuple_type, cs)
e_state e_state
= { e_state & es_var_heap = es_var_heap, es_expr_heap = es_expr_heap } = { e_state & es_var_heap = es_var_heap, es_expr_heap = es_expr_heap }
(index_expr, free_vars, e_state, e_info, cs) (index_exprs, (free_vars, e_state, e_info, cs))
= checkExpression free_vars bind_dst e_input e_state e_info cs = mapSt (check_index_expr e_input) parsed_index_exprs (free_vars, e_state, e_info, cs)
selection selections
= ArraySelection glob_select_symb new_expr_ptr index_expr = [ ArraySelection glob_select_symb new_expr_ptr index_expr \\ new_expr_ptr<-new_expr_ptrs & index_expr<-index_exprs ]
= ( new_array_var = ( new_array_var
, strict_binds , strict_binds
, [ {bind_dst = var_for_uselect_result, bind_src = Selection No (Var bound_array_var) [selection]} , [ {bind_dst = var_for_uselect_result, bind_src = Selection opt_tuple_type (Var bound_array_var) selections}
, {bind_dst = new_array_var, bind_src = TupleSelect tuple_cons.glob_object 1 (Var bound_var_for_uselect_result)} , {bind_dst = new_array_var, bind_src = TupleSelect tuple_cons.glob_object 1 (Var bound_var_for_uselect_result)}
, {bind_dst = array_element_var, bind_src = TupleSelect tuple_cons.glob_object 0 (Var bound_var_for_uselect_result)} , {bind_dst = array_element_var, bind_src = TupleSelect tuple_cons.glob_object 0 (Var bound_var_for_uselect_result)}
: lazy_binds : lazy_binds
...@@ -2061,6 +2067,10 @@ buildSelectCalls e_input {ap_opt_var, ap_array_var, ap_selections} ...@@ -2061,6 +2067,10 @@ buildSelectCalls e_input {ap_opt_var, ap_array_var, ap_selections}
, cs , cs
) )
check_index_expr e_input parsed_index_expr (free_vars, e_state, e_info, cs)
# (index_expr, free_vars, e_state, e_info, cs) = checkExpression free_vars parsed_index_expr e_input e_state e_info cs
= (index_expr, (free_vars, e_state, e_info, cs))
allocate_free_var ident var_heap allocate_free_var ident var_heap
# (new_var_info_ptr, var_heap) = newPtr VI_Empty var_heap # (new_var_info_ptr, var_heap) = newPtr VI_Empty var_heap
= ({ fv_def_level = NotALevel, fv_name = ident, fv_info_ptr = new_var_info_ptr, fv_count = 0 }, var_heap) = ({ fv_def_level = NotALevel, fv_name = ident, fv_info_ptr = new_var_info_ptr, fv_count = 0 }, var_heap)
......
...@@ -2525,12 +2525,20 @@ where ...@@ -2525,12 +2525,20 @@ where
= ([ assign ], tokenBack pState) = ([ assign ], tokenBack pState)
where where
want_array_assignment is_pattern pState want_array_assignment is_pattern pState
# (index_exp, pState) = wantExpression cIsNotAPattern pState # (index_exprs, pState) = want_index_exprs pState
pState = wantToken FunctionContext "array assignment" SquareCloseToken pState
pState = wantToken FunctionContext "array assignment" EqualToken pState pState = wantToken FunctionContext "array assignment" EqualToken pState
(pattern_exp, pState) = wantExpression is_pattern pState (pattern_exp, pState) = wantExpression is_pattern pState
= ({bind_dst = index_exp, bind_src = pattern_exp}, pState) = ({bind_dst = index_exprs, bind_src = pattern_exp}, pState)
want_index_exprs pState
# (index_expr, pState) = wantExpression cIsNotAPattern pState
(token, pState) = nextToken GeneralContext pState
| token==CommaToken
# (index_exprs, pState) = want_index_exprs pState
= ([index_expr:index_exprs], pState)
| token==SquareCloseToken
= ([index_expr], pState)
= ([], parseError "" (Yes token) "] or ," pState)
/** /**
End of definitions End of definitions
**/ **/
......
...@@ -614,11 +614,11 @@ transformSequence (SQ_From frm) ...@@ -614,11 +614,11 @@ transformSequence (SQ_From frm)
transformSequence (SQ_FromTo frm to) transformSequence (SQ_FromTo frm to)
= predef PD_FromTo ` frm ` to = predef PD_FromTo ` frm ` to
transformArrayUpdate :: ParsedExpr [ElemAssignment] PredefinedIdents -> ParsedExpr transformArrayUpdate :: ParsedExpr [Bind ParsedExpr ParsedExpr] PredefinedIdents -> ParsedExpr
transformArrayUpdate expr updates pi transformArrayUpdate expr updates pi
= foldr (update pi (predef PD_ArrayUpdateFun)) expr updates = foldr (update pi (predef PD_ArrayUpdateFun)) expr updates
where where
update :: PredefinedIdents (PredefinedIdents -> ParsedExpr) ElemAssignment ParsedExpr -> ParsedExpr update :: PredefinedIdents (PredefinedIdents -> ParsedExpr) (Bind ParsedExpr ParsedExpr) ParsedExpr -> ParsedExpr
update pi updateIdent {bind_src=value, bind_dst=index} expr update pi updateIdent {bind_src=value, bind_dst=index} expr
= (updateIdent ` expr ` index ` value) pi = (updateIdent ` expr ` index ` value) pi
......
...@@ -949,7 +949,7 @@ cIsArrayGenerator :== False ...@@ -949,7 +949,7 @@ cIsArrayGenerator :== False
:: FieldAssignment :== Bind ParsedExpr Ident :: FieldAssignment :== Bind ParsedExpr Ident
:: ElemAssignment :== Bind ParsedExpr ParsedExpr :: ElemAssignment :== Bind ParsedExpr [ParsedExpr]
cIsStrict :== True cIsStrict :== True
......
...@@ -913,7 +913,7 @@ cIsArrayGenerator :== False ...@@ -913,7 +913,7 @@ cIsArrayGenerator :== False
:: FieldAssignment :== Bind ParsedExpr Ident :: FieldAssignment :== Bind ParsedExpr Ident
:: ElemAssignment :== Bind ParsedExpr ParsedExpr :: ElemAssignment :== Bind ParsedExpr [ParsedExpr]
//:: NodeDef :== Bind ParsedExpr ParsedExpr //:: NodeDef :== Bind ParsedExpr ParsedExpr
...@@ -1331,7 +1331,7 @@ where ...@@ -1331,7 +1331,7 @@ where
= file = file
write_binds file [bind : binds] write_binds file [bind : binds]
= write_binds (file <<< bind <<< '\n') binds = write_binds (file <<< bind <<< '\n') binds
(<<<) file (Case {case_expr,case_guards,case_default=No}) (<<<) file (Case {case_expr,case_guards,case_default=No})
= file <<< "case " <<< case_expr <<< " of\n" <<< case_guards = file <<< "case " <<< case_expr <<< " of\n" <<< case_guards
(<<<) file (Case {case_expr,case_guards,case_default= Yes def_expr}) (<<<) file (Case {case_expr,case_guards,case_default= Yes def_expr})
= file <<< "case " <<< case_expr <<< " of\n" <<< case_guards <<< "\n\t-> " <<< def_expr = file <<< "case " <<< case_expr <<< " of\n" <<< case_guards <<< "\n\t-> " <<< def_expr
......
...@@ -526,7 +526,7 @@ where ...@@ -526,7 +526,7 @@ where
# (VI_AccVar _ arg_position, var_heap) = readPtr var_info_ptr var_heap # (VI_AccVar _ arg_position, var_heap) = readPtr var_info_ptr var_heap
({cc_size, cc_args, cc_linear_bits},class_env) = class_env![fun_index] ({cc_size, cc_args, cc_linear_bits},class_env) = class_env![fun_index]
(aci_linearity_of_patterns, var_heap) = get_linearity_info cc_linear_bits case_guards var_heap (aci_linearity_of_patterns, var_heap) = get_linearity_info cc_linear_bits case_guards var_heap
| /*XXX*/arg_position<cc_size && (arg_position>=cc_size || cc_args!!arg_position==cActive) && cc_linear_bits!!arg_position | arg_position<cc_size && (arg_position>=cc_size || cc_args!!arg_position==cActive) && cc_linear_bits!!arg_position
// mark non multimatch cases whose case_expr is an active linear function argument // mark non multimatch cases whose case_expr is an active linear function argument
# aci = { aci_params = [], aci_opt_unfolder = No, aci_free_vars=No, aci_linearity_of_patterns = aci_linearity_of_patterns } # aci = { aci_params = [], aci_opt_unfolder = No, aci_free_vars=No, aci_linearity_of_patterns = aci_linearity_of_patterns }
= ([case_info_ptr:cleanup_acc], class_env, fun_defs, var_heap, = ([case_info_ptr:cleanup_acc], class_env, fun_defs, var_heap,
...@@ -869,7 +869,7 @@ transformCase this_case=:{case_expr,case_guards,case_default,case_ident,case_inf ...@@ -869,7 +869,7 @@ transformCase this_case=:{case_expr,case_guards,case_default,case_ident,case_inf
= ([guard_expr], ti) = ([guard_expr], ti)
lift_patterns_2 default_exists [guard_expr : guard_exprs] outer_case ro ti lift_patterns_2 default_exists [guard_expr : guard_exprs] outer_case ro ti
# us = { us_var_heap = ti.ti_var_heap, us_symbol_heap = ti.ti_symbol_heap, us_opt_type_heaps = No, # us = { us_var_heap = ti.ti_var_heap, us_symbol_heap = ti.ti_symbol_heap, us_opt_type_heaps = No,
us_cleanup_info=ti.ti_cleanup_info, us_subst_vars = False, us_handle_aci_free_vars = LeaveThem } us_cleanup_info=ti.ti_cleanup_info, us_handle_aci_free_vars = LeaveThem }
(outer_guards, us=:{us_cleanup_info}) = unfold outer_case.case_guards us (outer_guards, us=:{us_cleanup_info}) = unfold outer_case.case_guards us
(expr_info, ti_symbol_heap) = readPtr outer_case.case_info_ptr us.us_symbol_heap (expr_info, ti_symbol_heap) = readPtr outer_case.case_info_ptr us.us_symbol_heap
(new_info_ptr, ti_symbol_heap) = newPtr expr_info ti_symbol_heap (new_info_ptr, ti_symbol_heap) = newPtr expr_info ti_symbol_heap
...@@ -899,7 +899,7 @@ transformCase this_case=:{case_expr,case_guards,case_default,case_ident,case_inf ...@@ -899,7 +899,7 @@ transformCase this_case=:{case_expr,case_guards,case_default,case_ident,case_inf
ti_var_heap = foldSt (\({fv_info_ptr}, arg) -> writeVarInfo fv_info_ptr (VI_Expression arg)) unfoldable_args ti.ti_var_heap ti_var_heap = foldSt (\({fv_info_ptr}, arg) -> writeVarInfo fv_info_ptr (VI_Expression arg)) unfoldable_args ti.ti_var_heap
(new_expr, ti_symbol_heap) = possibly_add_let non_unfoldable_args ap_expr not_unfoldable glob_module ds_index ro ti.ti_symbol_heap (new_expr, ti_symbol_heap) = possibly_add_let non_unfoldable_args ap_expr not_unfoldable glob_module ds_index ro ti.ti_symbol_heap
unfold_state = { us_var_heap = ti_var_heap, us_symbol_heap = ti_symbol_heap, us_opt_type_heaps = No, unfold_state = { us_var_heap = ti_var_heap, us_symbol_heap = ti_symbol_heap, us_opt_type_heaps = No,
us_cleanup_info=ti.ti_cleanup_info, us_subst_vars = True, us_handle_aci_free_vars = LeaveThem } us_cleanup_info=ti.ti_cleanup_info, us_handle_aci_free_vars = LeaveThem }
(unfolded_expr, unfold_state) = unfold new_expr unfold_state (unfolded_expr, unfold_state) = unfold new_expr unfold_state
(final_expr, ti) = transform unfolded_expr { ro & ro_root_case_mode = NotRootCase } (unfold_state_to_ti unfold_state ti) (final_expr, ti) = transform unfolded_expr { ro & ro_root_case_mode = NotRootCase } (unfold_state_to_ti unfold_state ti)
= (Yes final_expr, ti) = (Yes final_expr, ti)
...@@ -935,7 +935,6 @@ transformCase this_case=:{case_expr,case_guards,case_default,case_ident,case_inf ...@@ -935,7 +935,6 @@ transformCase this_case=:{case_expr,case_guards,case_default,case_ident,case_inf
match_and_instantiate _ cons_index app_args [] default_expr ro ti match_and_instantiate _ cons_index app_args [] default_expr ro ti
= transform default_expr { ro & ro_root_case_mode = NotRootCase } ti = transform default_expr { ro & ro_root_case_mode = NotRootCase } ti
possibly_generate_case_function kees=:{case_info_ptr} aci=:{aci_free_vars} ro ti=:{ti_recursion_introduced=old_ti_recursion_introduced} possibly_generate_case_function kees=:{case_info_ptr} aci=:{aci_free_vars} ro ti=:{ti_recursion_introduced=old_ti_recursion_introduced}
// | False->>("possibly_generate_case_function") // | False->>("possibly_generate_case_function")
// = undef // = undef
...@@ -1000,7 +999,7 @@ possibly_generate_case_function kees=:{case_info_ptr} aci=:{aci_free_vars} ro ti ...@@ -1000,7 +999,7 @@ possibly_generate_case_function kees=:{case_info_ptr} aci=:{aci_free_vars} ro ti
types_from_outer_fun = [ st_arg \\ st_arg <- st_args & used <- used_mask | used ] types_from_outer_fun = [ st_arg \\ st_arg <- st_args & used <- used_mask | used ]
nr_of_lifted_vars = fun_arity-(length types_from_outer_fun) nr_of_lifted_vars = fun_arity-(length types_from_outer_fun)
(lifted_types, ti_var_heap) = mapSt get_type_of_local_var (take nr_of_lifted_vars ro_fun_args) ti.ti_var_heap (lifted_types, ti_var_heap) = mapSt get_type_of_local_var (take nr_of_lifted_vars ro_fun_args) ti.ti_var_heap
(EI_CaseType {ct_result_type}, ti_symbol_heap) = readExprInfo case_info_ptr ti.ti_symbol_heap (EI_CaseType {ct_result_type}, ti_symbol_heap) = readExprInfo case_info_ptr ti.ti_symbol_heap
(form_vars, ti_var_heap) = mapSt bind_to_fresh_var ro_fun_args ti_var_heap (form_vars, ti_var_heap) = mapSt bind_to_fresh_var ro_fun_args ti_var_heap
arg_types = lifted_types++types_from_outer_fun arg_types = lifted_types++types_from_outer_fun
type_variables = getTypeVars [ct_result_type:arg_types] type_variables = getTypeVars [ct_result_type:arg_types]
...@@ -1009,7 +1008,7 @@ possibly_generate_case_function kees=:{case_info_ptr} aci=:{aci_free_vars} ro ti ...@@ -1009,7 +1008,7 @@ possibly_generate_case_function kees=:{case_info_ptr} aci=:{aci_free_vars} ro ti
(fresh_arg_types, ti_type_heaps) = substitute arg_types { th_vars = th_vars, th_attrs = th_attrs } (fresh_arg_types, ti_type_heaps) = substitute arg_types { th_vars = th_vars, th_attrs = th_attrs }
(fresh_result_type, ti_type_heaps) = substitute ct_result_type ti_type_heaps (fresh_result_type, ti_type_heaps) = substitute ct_result_type ti_type_heaps
us = { us_var_heap = ti_var_heap, us_symbol_heap = ti_symbol_heap, us_opt_type_heaps = Yes ti_type_heaps, us = { us_var_heap = ti_var_heap, us_symbol_heap = ti_symbol_heap, us_opt_type_heaps = Yes ti_type_heaps,
us_cleanup_info=ti.ti_cleanup_info, us_subst_vars = True, us_handle_aci_free_vars = SubstituteThem } us_cleanup_info=ti.ti_cleanup_info, us_handle_aci_free_vars = SubstituteThem }
(copied_expr, {us_var_heap=ti_var_heap, us_symbol_heap=ti_symbol_heap, us_cleanup_info=ti_cleanup_info, (copied_expr, {us_var_heap=ti_var_heap, us_symbol_heap=ti_symbol_heap, us_cleanup_info=ti_cleanup_info,
us_opt_type_heaps = Yes ti_type_heaps}) = unfold new_expr us us_opt_type_heaps = Yes ti_type_heaps}) = unfold new_expr us
fun_type = { st_vars = fresh_type_vars, st_args = fresh_arg_types, st_arity = fun_arity, st_result = fresh_result_type, fun_type = { st_vars = fresh_type_vars, st_args = fresh_arg_types, st_arity = fun_arity, st_result = fresh_result_type,
...@@ -1226,13 +1225,7 @@ searchInstance prods1 (II_Node prods2 fun_info_ptr left right) ...@@ -1226,13 +1225,7 @@ searchInstance prods1 (II_Node prods2 fun_info_ptr left right)
= searchInstance prods1 right = searchInstance prods1 right
= searchInstance prods1 left = searchInstance prods1 left
*/ */
/* Fragen/to do:
- wird die neu generierte Funktion bereits in der folgenden Transformation gebraucht ?
Antwort: Ich verbiete das einfach, indem generierte funktionen,deren Koerper "Expanding" nicht als Produzent
klassifiziert werden.
- wie wird die neu generierte Funktion klassifiziert ? Antwort: Die Klassifikationen werden weitervererbt (auch die linear_bits)
- type attributes
*/
generateFunction :: !FunDef !ConsClasses !{! Producer} !FunctionInfoPtr !ReadOnlyTI !*TransformInfo -> (!Index, !Int, !*TransformInfo) generateFunction :: !FunDef !ConsClasses !{! Producer} !FunctionInfoPtr !ReadOnlyTI !*TransformInfo -> (!Index, !Int, !*TransformInfo)
generateFunction fd=:{fun_body = TransformedBody {tb_args,tb_rhs},fun_info = {fi_group_index}} generateFunction fd=:{fun_body = TransformedBody {tb_args,tb_rhs},fun_info = {fi_group_index}}
{cc_args,cc_linear_bits} prods fun_def_ptr ro {cc_args,cc_linear_bits} prods fun_def_ptr ro
...@@ -1263,7 +1256,7 @@ generateFunction fd=:{fun_body = TransformedBody {tb_args,tb_rhs},fun_info = {fi ...@@ -1263,7 +1256,7 @@ generateFunction fd=:{fun_body = TransformedBody {tb_args,tb_rhs},fun_info = {fi
gf_cons_args = {cc_args = new_cons_args, cc_size = length new_cons_args, cc_linear_bits=new_linear_bits} } gf_cons_args = {cc_args = new_cons_args, cc_size = length new_cons_args, cc_linear_bits=new_linear_bits} }
ti_fun_heap = writePtr fun_def_ptr (FI_Function new_gen_fd) ti_fun_heap ti_fun_heap = writePtr fun_def_ptr (FI_Function new_gen_fd) ti_fun_heap
us = { us_var_heap = ti_var_heap, us_symbol_heap = ti_symbol_heap, us_opt_type_heaps = Yes ti_type_heaps, us = { us_var_heap = ti_var_heap, us_symbol_heap = ti_symbol_heap, us_opt_type_heaps = Yes ti_type_heaps,
us_cleanup_info=ti_cleanup_info, us_subst_vars = True, us_handle_aci_free_vars = RemoveThem } us_cleanup_info=ti_cleanup_info, us_handle_aci_free_vars = RemoveThem }
(tb_rhs, {us_var_heap,us_symbol_heap,us_opt_type_heaps=Yes type_heaps, us_cleanup_info}) = unfold tb_rhs us (tb_rhs, {us_var_heap,us_symbol_heap,us_opt_type_heaps=Yes type_heaps, us_cleanup_info}) = unfold tb_rhs us
ro = { ro & ro_root_case_mode = case tb_rhs of {Case _ -> RootCase; _ -> NotRootCase}, ro = { ro & ro_root_case_mode = case tb_rhs of {Case _ -> RootCase; _ -> NotRootCase},
ro_fun= { symb_name = fd.fun_symb, symb_kind = SK_GeneratedFunction fun_def_ptr ti_next_fun_nr, symb_arity = fun_arity}, ro_fun= { symb_name = fd.fun_symb, symb_kind = SK_GeneratedFunction fun_def_ptr ti_next_fun_nr, symb_arity = fun_arity},
...@@ -2103,7 +2096,7 @@ where ...@@ -2103,7 +2096,7 @@ where
freeVariables (Selection _ expr selectors) fvi freeVariables (Selection _ expr selectors) fvi
= freeVariables expr fvi = freeVariables expr fvi
freeVariables (Update expr1 selectors expr2) fvi freeVariables (Update expr1 selectors expr2) fvi
= freeVariables expr2 (freeVariables expr1 fvi) = freeVariables expr2 (freeVariables selectors (freeVariables expr1 fvi))
freeVariables (RecordUpdate cons_symbol expression expressions) fvi freeVariables (RecordUpdate cons_symbol expression expressions) fvi
= free_variables_of_record_expression expression expressions fvi = free_variables_of_record_expression expression expressions fvi
where where
...@@ -2130,6 +2123,15 @@ where ...@@ -2130,6 +2123,15 @@ where
freeVariables _ fvi freeVariables _ fvi
= fvi = fvi
instance freeVariables Selection
where
freeVariables (RecordSelection _ _) fvi
= fvi
freeVariables (ArraySelection _ _ expr) fvi
= freeVariables expr fvi
freeVariables (DictionarySelection dict_var selections _ expr) fvi
= freeVariables dict_var (freeVariables selections (freeVariables expr fvi))
removeVariables global_variables var_heap removeVariables global_variables var_heap
= foldSt remove_variable global_variables ([], var_heap) = foldSt remove_variable global_variables ([], var_heap)
where where
......
...@@ -17,7 +17,6 @@ partitionateMacros :: !IndexRange !Index !*{# FunDef} !u:{# DclModule} !*VarHeap ...@@ -17,7 +17,6 @@ partitionateMacros :: !IndexRange !Index !*{# FunDef} !u:{# DclModule} !*VarHeap
, us_symbol_heap :: !.ExpressionHeap , us_symbol_heap :: !.ExpressionHeap
, us_opt_type_heaps :: !.Optional .TypeHeaps , us_opt_type_heaps :: !.Optional .TypeHeaps
, us_cleanup_info :: ![ExprInfoPtr] , us_cleanup_info :: ![ExprInfoPtr]
, us_subst_vars :: !Bool
, us_handle_aci_free_vars :: !AciFreeVarHandleMode , us_handle_aci_free_vars :: !AciFreeVarHandleMode
} }
......
...@@ -165,7 +165,6 @@ where ...@@ -165,7 +165,6 @@ where
, us_symbol_heap :: !.ExpressionHeap , us_symbol_heap :: !.ExpressionHeap
, us_opt_type_heaps :: !.Optional .TypeHeaps , us_opt_type_heaps :: !.Optional .TypeHeaps
, us_cleanup_info :: ![ExprInfoPtr] , us_cleanup_info :: ![ExprInfoPtr]
, us_subst_vars :: !Bool // XXX currently not used
, us_handle_aci_free_vars :: !AciFreeVarHandleMode , us_handle_aci_free_vars :: !AciFreeVarHandleMode
} }
...@@ -191,8 +190,6 @@ where ...@@ -191,8 +190,6 @@ where
unfoldVariable :: !BoundVar !*UnfoldState -> (!Expression, !*UnfoldState) unfoldVariable :: !BoundVar !*UnfoldState -> (!Expression, !*UnfoldState)
unfoldVariable var=:{var_name,var_info_ptr} us unfoldVariable var=:{var_name,var_info_ptr} us
// XXX | not us.us_subst_vars
// = (Var var, us)
#! (var_info, us) = readVarInfo var_info_ptr us #! (var_info, us) = readVarInfo var_info_ptr us
= case var_info of = case var_info of
VI_Expression expr VI_Expression expr
...@@ -497,7 +494,7 @@ examineFunctionCall {id_info} fc=:{fc_index} (calls, symbol_table) ...@@ -497,7 +494,7 @@ examineFunctionCall {id_info} fc=:{fc_index} (calls, symbol_table)
unfoldMacro {fun_body = TransformedBody {tb_args,tb_rhs}, fun_info = {fi_calls}} args fun_defs (calls, es=:{es_var_heap,es_symbol_heap, es_symbol_table}) unfoldMacro {fun_body = TransformedBody {tb_args,tb_rhs}, fun_info = {fi_calls}} args fun_defs (calls, es=:{es_var_heap,es_symbol_heap, es_symbol_table})
# (let_binds, var_heap) = bind_expressions tb_args args [] es_var_heap # (let_binds, var_heap) = bind_expressions tb_args args [] es_var_heap
us = { us_symbol_heap = es_symbol_heap, us_var_heap = var_heap, us_opt_type_heaps = No, us_cleanup_info = [], us = { us_symbol_heap = es_symbol_heap, us_var_heap = var_heap, us_opt_type_heaps = No, us_cleanup_info = [],
us_subst_vars = True, us_handle_aci_free_vars = RemoveThem } us_handle_aci_free_vars = RemoveThem }
(result_expr, {us_symbol_heap,us_var_heap}) = unfold tb_rhs us (result_expr, {us_symbol_heap,us_var_heap}) = unfold tb_rhs us
(calls, fun_defs, es_symbol_table) = updateFunctionCalls fi_calls calls fun_defs es_symbol_table (calls, fun_defs, es_symbol_table) = updateFunctionCalls fi_calls calls fun_defs es_symbol_table
| isEmpty let_binds | isEmpty let_binds
...@@ -861,7 +858,7 @@ where ...@@ -861,7 +858,7 @@ where
= (expr, var_heap, symbol_heap) = (expr, var_heap, symbol_heap)
replace_variables vars expr ap_vars var_heap symbol_heap replace_variables vars expr ap_vars var_heap symbol_heap
# us = { us_var_heap = build_aliases vars ap_vars var_heap, us_symbol_heap = symbol_heap, us_opt_type_heaps = No, # us = { us_var_heap = build_aliases vars ap_vars var_heap, us_symbol_heap = symbol_heap, us_opt_type_heaps = No,
us_cleanup_info=[], us_subst_vars = True, us_handle_aci_free_vars = RemoveThem } us_cleanup_info=[], us_handle_aci_free_vars = RemoveThem }
(expr, us) = unfold expr us (expr, us) = unfold expr us
= (expr, us.us_var_heap, us.us_symbol_heap) = (expr, us.us_var_heap, us.us_symbol_heap)
......
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