Commit 61fc0103 authored by Ronny Wichers Schreur's avatar Ronny Wichers Schreur

bug fix: uniqueness error in nested record/array updates

parent d00fe0ec
......@@ -1796,6 +1796,8 @@ where
where
addKinds NormalSelector selections
= [(BESelector, selection) \\ selection <- selections]
addKinds NormalSelectorUniqueElementResult selections
= [(BESelector, selection) \\ selection <- selections]
addKinds _ [selection]
= [(BESelector_U, selection)]
addKinds _ [selection : selections]
......
......@@ -1009,22 +1009,26 @@ where
cons_optional No variables
= variables
checkExpression free_vars (PE_Selection is_unique expr [PS_Array index_expr]) e_input e_state e_info cs
checkExpression free_vars (PE_Selection selector_kind expr [PS_Array index_expr]) e_input e_state e_info cs
# (expr, free_vars, e_state, e_info, cs) = checkExpression free_vars expr e_input e_state e_info cs
| is_unique
# (glob_select_symb, cs) = getPredefinedGlobalSymbol PD_UnqArraySelectFun PD_StdArray STE_Member 2 cs
# (select_fun, selector_kind)
= case selector_kind of
ParsedNormalSelector
-> (PD_ArraySelectFun, NormalSelector)
ParsedUniqueSelector _
-> (PD_UnqArraySelectFun, NormalSelectorUniqueElementResult)
# (glob_select_symb, cs) = getPredefinedGlobalSymbol select_fun PD_StdArray STE_Member 2 cs
(selector, free_vars, e_state, e_info, cs) = checkArraySelection glob_select_symb free_vars index_expr e_input e_state e_info cs
= (Selection NormalSelector expr [selector], free_vars, e_state, e_info, cs)
# (glob_select_symb, cs) = getPredefinedGlobalSymbol PD_ArraySelectFun PD_StdArray STE_Member 2 cs
(selector, free_vars, e_state, e_info, cs) = checkArraySelection glob_select_symb free_vars index_expr e_input e_state e_info cs
= (Selection NormalSelector expr [selector], free_vars, e_state, e_info, cs)
checkExpression free_vars (PE_Selection is_unique expr selectors) e_input e_state e_info cs
= (Selection selector_kind expr [selector], free_vars, e_state, e_info, cs)
checkExpression free_vars (PE_Selection selector_kind expr selectors) e_input e_state e_info cs
# (selectors, free_vars, e_state, e_info, cs) = checkSelectors cEndWithSelection free_vars selectors e_input e_state e_info cs
(expr, free_vars, e_state, e_info, cs) = checkExpression free_vars expr e_input e_state e_info cs
| is_unique
= case selector_kind of
ParsedNormalSelector
-> (Selection NormalSelector expr selectors, free_vars, e_state, e_info, cs)
ParsedUniqueSelector unique_element
# (tuple_type, cs) = getPredefinedGlobalSymbol (GetTupleTypeIndex 2) PD_PredefinedModule STE_Type 2 cs
= (Selection (UniqueSelector tuple_type False) expr selectors, free_vars, e_state, e_info, cs)
= (Selection NormalSelector expr selectors, free_vars, e_state, e_info, cs)
-> (Selection (UniqueSelector tuple_type) expr selectors, free_vars, e_state, e_info, cs)
checkExpression free_vars (PE_Update expr1 selectors expr2) e_input e_state e_info cs
# (expr1, free_vars, e_state, e_info, cs) = checkExpression free_vars expr1 e_input e_state e_info cs
(selectors, free_vars, e_state, e_info, cs) = checkSelectors cEndWithUpdate free_vars selectors e_input e_state e_info cs
......@@ -2191,7 +2195,7 @@ buildSelections e_input {ap_opt_var, ap_array_var, ap_selections}
-> (unq_select_symb, NormalSelector, 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, UniqueSelector tuple_type False, cs)
-> (select_symb, UniqueSelector tuple_type, cs)
e_state
= { e_state & es_var_heap = es_var_heap, es_expr_heap = es_expr_heap }
(index_exprs, (free_vars, e_state, e_info, cs))
......
......@@ -2175,7 +2175,7 @@ where
| token == DotToken
# (token, pState) = nextToken FunctionContext pState
(selectors, pState) = wantSelectors token pState
= (PE_Selection cNonUniqueSelection exp selectors, pState)
= (PE_Selection ParsedNormalSelector exp selectors, pState)
| token == ExclamationToken
# (token, pState) = nextToken FunctionContext pState
// JVG added for strict lists:
......@@ -2183,7 +2183,7 @@ where
= (exp, tokenBack (tokenBack pState))
//
# (selectors, pState) = wantSelectors token pState
= (PE_Selection cUniqueSelection exp selectors, pState)
= (PE_Selection (ParsedUniqueSelector False) exp selectors, pState)
| otherwise
= (exp, tokenBack pState)
......@@ -2869,7 +2869,7 @@ where
# (shareIdent, pState)
= make_ident optionalIdent level pState
select
= PE_Selection cNonUniqueSelection (PE_Ident shareIdent) [PS_Record fieldIdent final_record_type]
= PE_Selection ParsedNormalSelector (PE_Ident shareIdent) [PS_Record fieldIdent final_record_type]
(update_expr, pState)
= transform_record_or_array_update No select (map sub_update updates) (level+1) pState
= ({bind_dst = fieldIdent, bind_src = update_expr}, (Yes shareIdent,record_type,pState))
......@@ -2941,7 +2941,7 @@ where
select_def
= buildNodeDef
(PE_Tuple [PE_Ident element_id, PE_Ident array_id])
(PE_Selection cUniqueSelection expr (reverse [PS_Array (PE_Ident index_id) : initial_selectors]))
(PE_Selection (ParsedUniqueSelector True) expr (reverse [PS_Array (PE_Ident index_id) : initial_selectors]))
(updated_element, pState)
= transform_record_update No
(PE_Ident element_id)
......
......@@ -1028,8 +1028,10 @@ instance toString KindInfo
:: LocalDef :== ParsedDefinition
cUniqueSelection :== True
cNonUniqueSelection :== False
:: ParsedSelectorKind
= ParsedNormalSelector // .
| ParsedUniqueSelector // !
!Bool // is result element unique?
:: ParsedExpr = PE_List ![ParsedExpr]
| PE_Ident !Ident
......@@ -1041,7 +1043,7 @@ cNonUniqueSelection :== False
| PE_ArrayPattern ![ElemAssignment]
| PE_UpdateComprehension !ParsedExpr !ParsedExpr !ParsedExpr ![Qualifier]
| PE_ArrayDenot ![ParsedExpr]
| PE_Selection !Bool !ParsedExpr ![ParsedSelection]
| PE_Selection !ParsedSelectorKind !ParsedExpr ![ParsedSelection]
| PE_Update !ParsedExpr [ParsedSelection] ParsedExpr
| PE_Case !Ident !ParsedExpr [CaseAlt]
| PE_If !Ident !ParsedExpr !ParsedExpr !ParsedExpr
......@@ -1100,10 +1102,10 @@ cIsStrict :== True
cIsNotStrict :== False
:: SelectorKind
= NormalSelector // .
= NormalSelector
| NormalSelectorUniqueElementResult
| UniqueSelector // !
(Global DefinedSymbol) // tuple type
!Bool // is result element unique?
/*
:: SelectorKind = SEK_Normal | SEK_First | SEK_Next | SEK_Last
......
......@@ -1020,8 +1020,10 @@ cNotVarNumber :== -1
:: LocalDef :== ParsedDefinition
cUniqueSelection :== True
cNonUniqueSelection :== False
:: ParsedSelectorKind
= ParsedNormalSelector // .
| ParsedUniqueSelector // !
!Bool // is result element unique?
:: ParsedExpr = PE_List ![ParsedExpr]
| PE_Ident !Ident
......@@ -1033,7 +1035,7 @@ cNonUniqueSelection :== False
| PE_ArrayPattern ![ElemAssignment]
| PE_UpdateComprehension !ParsedExpr !ParsedExpr !ParsedExpr ![Qualifier]
| PE_ArrayDenot ![ParsedExpr]
| PE_Selection !Bool !ParsedExpr ![ParsedSelection]
| PE_Selection !ParsedSelectorKind !ParsedExpr ![ParsedSelection]
| PE_Update !ParsedExpr [ParsedSelection] ParsedExpr
| PE_Case !Ident !ParsedExpr [CaseAlt]
| PE_If !Ident !ParsedExpr !ParsedExpr !ParsedExpr
......@@ -1093,10 +1095,10 @@ cIsStrict :== True
cIsNotStrict :== False
:: SelectorKind
= NormalSelector // .
= NormalSelector
| NormalSelectorUniqueElementResult
| UniqueSelector // !
(Global DefinedSymbol) // tuple type
!Bool // is result element unique?
:: Expression = Var !BoundVar
| App !App
......@@ -1661,9 +1663,9 @@ where
instance <<< SelectorKind
where
(<<<) file NormalSelector = file <<< "!"
(<<<) file (UniqueSelector _ False) = file <<< "!"
(<<<) file (UniqueSelector _ True) = file <<< "!*"
(<<<) file NormalSelector = file <<< "."
(<<<) file NormalSelectorUniqueElementResult = file <<< "!*"
(<<<) file (UniqueSelector _) = file <<< "!"
instance <<< Selection
where
......@@ -1695,7 +1697,7 @@ where
(<<<) file (PE_List exprs) = file <<< exprs
(<<<) file (PE_Tuple args) = file <<< '(' <<< args <<< ')'
(<<<) file (PE_Basic basic_value) = file <<< basic_value
(<<<) file (PE_Selection is_unique expr selectors) = file <<< expr <<< (if is_unique '!' '.') <<< selectors
(<<<) file (PE_Selection selector_kind expr selectors) = file <<< expr <<< selector_kind <<< selectors
(<<<) file (PE_Update expr1 selections expr2) = file <<< '{' <<< expr1 <<< " & " <<< selections <<< " = " <<< expr2 <<< '}'
(<<<) file (PE_Record PE_Empty _ fields) = file <<< '{' <<< fields <<< '}'
(<<<) file (PE_Record rec _ fields) = file <<< '{' <<< rec <<< " & " <<< fields <<< '}'
......@@ -1718,6 +1720,11 @@ where
-> file <<< "dynamic " <<< expr
(<<<) file _ = file <<< "some expression"
instance <<< ParsedSelectorKind
where
(<<<) file ParsedNormalSelector = file <<< "."
(<<<) file (ParsedUniqueSelector False) = file <<< "!"
(<<<) file (ParsedUniqueSelector True) = file <<< "!*"
instance <<< ParsedSelection
where
......
......@@ -1470,9 +1470,9 @@ where
requirements ti (Selection selector_kind expr selectors) reqs_ts
# (expr_type, opt_expr_ptr, (reqs, ts)) = requirements ti expr reqs_ts
= case selector_kind of
UniqueSelector {glob_object={ds_ident,ds_index,ds_arity}, glob_module} _
UniqueSelector {glob_object={ds_ident,ds_index,ds_arity}, glob_module}
# (var, ts) = freshAttributedVariable ts
(_, result_type, (reqs, ts)) = requirementsOfSelectors ti No expr selectors False var expr (reqs, ts)
(_, result_type, (reqs, ts)) = requirementsOfSelectors ti No expr selectors False False var expr (reqs, ts)
tuple_type = MakeTypeSymbIdent { glob_object = ds_index, glob_module = glob_module } ds_ident ds_arity
non_unique_type_var = { at_attribute = TA_Multi, at_annotation = AN_None, at_type = TempV ts.ts_var_store }
req_type_coercions
......@@ -1482,13 +1482,16 @@ where
result_type = { at_type = TA tuple_type [non_unique_type_var,var], at_attribute = TA_Unique, at_annotation = AN_None }
-> (result_type, No, ({ reqs & req_type_coercions = req_type_coercions },
{ts & ts_var_store = inc ts.ts_var_store, ts_expr_heap = storeAttribute opt_expr_ptr TA_Multi ts.ts_expr_heap}))
_
# (_, result_type, reqs_ts) = requirementsOfSelectors ti No expr selectors True expr_type expr (reqs, ts)
NormalSelectorUniqueElementResult
# (_, result_type, reqs_ts) = requirementsOfSelectors ti No expr selectors True True expr_type expr (reqs, ts)
-> (result_type, opt_expr_ptr, reqs_ts)
NormalSelector
# (_, result_type, reqs_ts) = requirementsOfSelectors ti No expr selectors True False expr_type expr (reqs, ts)
-> (result_type, opt_expr_ptr, reqs_ts)
requirements ti (Update composite_expr selectors elem_expr) reqs_ts
# (composite_expr_type, opt_composite_expr_ptr, reqs_ts) = requirements ti composite_expr reqs_ts
(has_array_selection, result_type, (reqs, ts))
= requirementsOfSelectors ti (Yes elem_expr) composite_expr selectors True composite_expr_type composite_expr reqs_ts
= requirementsOfSelectors ti (Yes elem_expr) composite_expr selectors True False composite_expr_type composite_expr reqs_ts
| has_array_selection
# ts = { ts & ts_expr_heap = storeAttribute opt_composite_expr_ptr TA_Unique ts.ts_expr_heap }
= (composite_expr_type, No, (reqs, ts))
......@@ -1560,21 +1563,29 @@ where
= (abort ("Error in requirements\n" ---> expr), No, reqs_ts)
requirementsOfSelectors ti opt_expr expr [selector] tc_coercible sel_expr_type sel_expr reqs_ts
= requirementsOfSelector ti opt_expr expr selector tc_coercible sel_expr_type sel_expr reqs_ts
requirementsOfSelectors ti opt_expr expr [selector : selectors] tc_coercible sel_expr_type sel_expr reqs_ts
# (has_array_selection, result_type, reqs_ts) = requirementsOfSelector ti No expr selector tc_coercible sel_expr_type sel_expr reqs_ts
# (have_array_selection, result_type, reqs_ts) = requirementsOfSelectors ti opt_expr expr selectors tc_coercible result_type sel_expr reqs_ts
requirementsOfSelectors ti opt_expr expr [selector] tc_coercible change_uselect sel_expr_type sel_expr reqs_ts
= requirementsOfSelector ti opt_expr expr selector tc_coercible change_uselect sel_expr_type sel_expr reqs_ts
requirementsOfSelectors ti opt_expr expr [selector : selectors] tc_coercible change_uselect sel_expr_type sel_expr reqs_ts
# (has_array_selection, result_type, reqs_ts) = requirementsOfSelector ti No expr selector tc_coercible change_uselect sel_expr_type sel_expr reqs_ts
# (have_array_selection, result_type, reqs_ts) = requirementsOfSelectors ti opt_expr expr selectors tc_coercible False result_type sel_expr reqs_ts
= (has_array_selection || have_array_selection, result_type, reqs_ts)
requirementsOfSelector ti _ expr (RecordSelection field _) tc_coercible sel_expr_type sel_expr (reqs, ts )
requirementsOfSelector ti _ expr (RecordSelection field _) tc_coercible change_uselect sel_expr_type sel_expr (reqs, ts )
# ({tst_args, tst_result, tst_attr_env}, ts) = standardFieldSelectorType (CP_Expression sel_expr) field ti ts
req_type_coercions = [{ tc_demanded = hd tst_args, tc_offered = sel_expr_type, tc_position = CP_Expression sel_expr, tc_coercible = tc_coercible } :
reqs.req_type_coercions ]
= (False, tst_result, ({ reqs & req_type_coercions = req_type_coercions }, ts))
requirementsOfSelector ti opt_expr expr (ArraySelection {glob_object = {ds_ident,ds_index,ds_arity},glob_module} expr_ptr index_expr) tc_coercible sel_expr_type sel_expr (reqs, ts)
requirementsOfSelector ti opt_expr expr (ArraySelection {glob_object = {ds_ident,ds_index,ds_arity},glob_module} expr_ptr index_expr) tc_coercible change_uselect sel_expr_type sel_expr (reqs, ts)
# {me_type} = ti.ti_common_defs.[glob_module].com_member_defs.[ds_index]
({tst_attr_env,tst_args,tst_result,tst_context}, ts) = freshSymbolType (Yes (CP_Expression expr)) cWithFreshContextVars me_type ti.ti_common_defs ts
# (tst_args, tst_result, ts)
= case ds_ident.id_name of
// RWS FIXME: use predef symbols
"uselect"
| change_uselect
-> change_uselect_attributes tst_args tst_result ts
_
-> (tst_args, tst_result, ts)
(dem_array_type, dem_index_type, rest_type) = array_and_index_type tst_args
reqs ={ reqs & req_attr_coercions = tst_attr_env ++ reqs.req_attr_coercions}
(index_type, opt_expr_ptr, (reqs, ts)) = requirements ti index_expr (reqs, ts)
......@@ -1601,6 +1612,24 @@ where
tc_position = CP_Expression elem_expr, tc_coercible = True } : reqs.req_type_coercions ]}
= (reqs, ts)
/*
change
uselect :: !u:(a e) !Int -> ( e, !u:(a e)) | uselect_u e
to
uselect :: !u:(a .e) !Int -> (.e, !u:(a .e)) | uselect_u e
(necessary for uselects in updates)
*/
change_uselect_attributes :: [AType] AType u:TypeState -> ([AType], AType, u:TypeState)
change_uselect_attributes args=:[arg_array=:{at_type=aa :@: [ae]}, arg_int]
result=:{at_type=TA tuple_symb [result_element, result_array=:{at_type=ra :@: [re]}]} ts
# (attribute, ts) = freshAttribute ts
# args = [{arg_array & at_type = aa :@: [{ae & at_attribute = attribute}]}, arg_int]
# result = {result & at_type = TA tuple_symb [{result_element & at_attribute = attribute}, {result_array & at_type=ra :@: [{re & at_attribute = attribute}]}]}
= (args, result, ts)
change_uselect_attributes _ _ ts
= abort "type.icl, change_uselect_attributes: wrong type for uselect"
possibly_accumulate_reqs_in_new_group position state_transition reqs_ts
:== possibly_accumulate_reqs position reqs_ts
where
......
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