Skip to content
GitLab
Commit 284f0804 authored by Martin Wierich's avatar Martin Wierich
Browse files

extended array patterns for muitidimensional arrays 

bugfix
parent 7a011c9c
Hide whitespace changes
Inline Side-by-side
frontend/check.icl
View file @ 284f0804
......@@ -755,7 +755,7 @@ checkIdentPattern is_expr_list id=:{id_name,id_info} opt_var {pi_def_level, pi_m
:: ArrayPattern =
{ ap_opt_var :: !Optional (Bind Ident VarInfoPtr)
, 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
......@@ -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)
where
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
| isLowerCaseName id_name
......@@ -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
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
= 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, 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
......@@ -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)
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)
= 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)
= newPtr EI_Empty e_state.es_expr_heap
= ( 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
, 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)
# (ap_array_var, strict_binds, lazy_binds, free_vars, e_state, e_info, cs)
= foldSt (build_sc e_input) ap_selections
......@@ -2027,7 +2027,7 @@ buildSelectCalls e_input {ap_opt_var, ap_array_var, ap_selections}
no -> (lazy_binds, e_state)
= (strict_binds, lazy_binds, free_vars, e_state, e_info, cs)
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)
= allocate_free_var { id_name = "_x", id_info = nilPtr } e_state.es_var_heap
(new_array_var, es_var_heap)
......@@ -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
(bound_var_for_uselect_result, es_expr_heap)
= allocate_bound_var var_for_uselect_result es_expr_heap
(new_expr_ptr, es_expr_heap)
= newPtr EI_Empty es_expr_heap
dimension = length parsed_index_exprs
(new_expr_ptrs, es_expr_heap)
= mapSt newPtr (repeatn dimension EI_Empty) es_expr_heap
(tuple_cons, cs)
= getPredefinedGlobalSymbol (GetTupleConsIndex 2) PD_PredefinedModule STE_Constructor 2 cs
(glob_select_symb, cs)
= getPredefinedGlobalSymbol PD_UnqArraySelectFun PD_StdArray STE_Member 2 cs
(glob_select_symb, opt_tuple_type, 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 & es_var_heap = es_var_heap, es_expr_heap = es_expr_heap }
(index_expr, free_vars, e_state, e_info, cs)
= checkExpression free_vars bind_dst e_input e_state e_info cs
selection
= ArraySelection glob_select_symb new_expr_ptr index_expr
(index_exprs, (free_vars, e_state, e_info, cs))
= mapSt (check_index_expr e_input) parsed_index_exprs (free_vars, e_state, e_info, cs)
selections
= [ ArraySelection glob_select_symb new_expr_ptr index_expr \\ new_expr_ptr<-new_expr_ptrs & index_expr<-index_exprs ]
= ( new_array_var
, 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 = array_element_var, bind_src = TupleSelect tuple_cons.glob_object 0 (Var bound_var_for_uselect_result)}
: lazy_binds
......@@ -2061,6 +2067,10 @@ buildSelectCalls e_input {ap_opt_var, ap_array_var, ap_selections}
, 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
# (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)
......
frontend/parse.icl
View file @ 284f0804
......@@ -2525,12 +2525,20 @@ where
= ([ assign ], tokenBack pState)
where
want_array_assignment is_pattern pState
# (index_exp, pState) = wantExpression cIsNotAPattern pState
pState = wantToken FunctionContext "array assignment" SquareCloseToken pState
# (index_exprs, pState) = want_index_exprs pState
pState = wantToken FunctionContext "array assignment" EqualToken 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
**/
......
frontend/postparse.icl
View file @ 284f0804
......@@ -614,11 +614,11 @@ transformSequence (SQ_From frm)
transformSequence (SQ_FromTo frm to)
= predef PD_FromTo ` frm ` to
transformArrayUpdate :: ParsedExpr [ElemAssignment] PredefinedIdents -> ParsedExpr
transformArrayUpdate :: ParsedExpr [Bind ParsedExpr ParsedExpr] PredefinedIdents -> ParsedExpr
transformArrayUpdate expr updates pi
= foldr (update pi (predef PD_ArrayUpdateFun)) expr updates
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
= (updateIdent ` expr ` index ` value) pi
......
frontend/syntax.dcl
View file @ 284f0804
......@@ -949,7 +949,7 @@ cIsArrayGenerator :== False
:: FieldAssignment :== Bind ParsedExpr Ident
:: ElemAssignment :== Bind ParsedExpr ParsedExpr
:: ElemAssignment :== Bind ParsedExpr [ParsedExpr]
cIsStrict :== True
......
frontend/syntax.icl
View file @ 284f0804
......@@ -913,7 +913,7 @@ cIsArrayGenerator :== False
:: FieldAssignment :== Bind ParsedExpr Ident
:: ElemAssignment :== Bind ParsedExpr ParsedExpr
:: ElemAssignment :== Bind ParsedExpr [ParsedExpr]
//:: NodeDef :== Bind ParsedExpr ParsedExpr
......@@ -1331,7 +1331,7 @@ where
= file
write_binds file [bind : 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,case_guards,case_default= Yes def_expr})
= file <<< "case " <<< case_expr <<< " of\n" <<< case_guards <<< "\n\t-> " <<< def_expr
......
frontend/trans.icl
View file @ 284f0804
......@@ -526,7 +526,7 @@ where
# (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]
(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
# 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,
......@@ -869,7 +869,7 @@ transformCase this_case=:{case_expr,case_guards,case_default,case_ident,case_inf
= ([guard_expr], 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_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
(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
......@@ -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
(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,
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
(final_expr, ti) = transform unfolded_expr { ro & ro_root_case_mode = NotRootCase } (unfold_state_to_ti unfold_state ti)
= (Yes final_expr, ti)
......@@ -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
= 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}
// | False->>("possibly_generate_case_function")
// = undef
......@@ -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 ]
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
(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
arg_types = lifted_types++types_from_outer_fun
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
(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
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,
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,
......@@ -1226,13 +1225,7 @@ searchInstance prods1 (II_Node prods2 fun_info_ptr left right)
= searchInstance prods1 right
= 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 fd=:{fun_body = TransformedBody {tb_args,tb_rhs},fun_info = {fi_group_index}}
{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
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
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
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},
......@@ -2103,7 +2096,7 @@ where
freeVariables (Selection _ expr selectors) fvi
= freeVariables expr 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
= free_variables_of_record_expression expression expressions fvi
where
......@@ -2130,6 +2123,15 @@ where
freeVariables _ 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
= foldSt remove_variable global_variables ([], var_heap)
where
......
frontend/transform.dcl
View file @ 284f0804
......@@ -17,7 +17,6 @@ partitionateMacros :: !IndexRange !Index !*{# FunDef} !u:{# DclModule} !*VarHeap
, us_symbol_heap :: !.ExpressionHeap
, us_opt_type_heaps :: !.Optional .TypeHeaps
, us_cleanup_info :: ![ExprInfoPtr]
, us_subst_vars :: !Bool
, us_handle_aci_free_vars :: !AciFreeVarHandleMode
}
......
frontend/transform.icl
View file @ 284f0804
......@@ -165,7 +165,6 @@ where
, us_symbol_heap :: !.ExpressionHeap
, us_opt_type_heaps :: !.Optional .TypeHeaps
, us_cleanup_info :: ![ExprInfoPtr]
, us_subst_vars :: !Bool // XXX currently not used
, us_handle_aci_free_vars :: !AciFreeVarHandleMode
}
......@@ -191,8 +190,6 @@ where
unfoldVariable :: !BoundVar !*UnfoldState -> (!Expression, !*UnfoldState)
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
= case var_info of
VI_Expression expr
......@@ -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})
# (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_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
(calls, fun_defs, es_symbol_table) = updateFunctionCalls fi_calls calls fun_defs es_symbol_table
| isEmpty let_binds
......@@ -861,7 +858,7 @@ where
= (expr, 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_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.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