aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--backend/backendconvert.icl9
-rw-r--r--frontend/checkFunctionBodies.icl6
-rw-r--r--frontend/syntax.dcl4
-rw-r--r--frontend/syntax.icl4
-rw-r--r--frontend/type.icl56
5 files changed, 45 insertions, 34 deletions
diff --git a/backend/backendconvert.icl b/backend/backendconvert.icl
index 8867253..2830592 100644
--- a/backend/backendconvert.icl
+++ b/backend/backendconvert.icl
@@ -1594,8 +1594,7 @@ convertRootExpr aliasDummyId (Conditional {if_cond=cond, if_then=then, if_else=N
convertRootExpr aliasDummyId (Case kees=:{case_expr, case_guards}) main_dcl_module_n
= beSwitchNode (convertVar var.var_info_ptr) (convertCases case_guards aliasDummyId var (defaultCase kees) main_dcl_module_n)
where
- var
- = caseVar case_expr
+ var = caseVar case_expr
defaultCase {case_default=Yes defaul}
= DefaultCase defaul
@@ -1728,7 +1727,9 @@ where
where
addKinds NormalSelector selections
= [(BESelector, selection) \\ selection <- selections]
- addKinds NormalSelectorUniqueElementResult selections
+ addKinds UniqueSingleArraySelector selections
+ = [(BESelector, selection) \\ selection <- selections]
+ addKinds UniqueSingleArraySelectorUniqueElementResult selections
= [(BESelector, selection) \\ selection <- selections]
addKinds _ [selection]
= [(BESelector_U, selection)]
@@ -1818,7 +1819,7 @@ where
convertSelections :: (BEMonad BENodeP) [(BESelectorKind, Selection)] -> (BEMonad BENodeP)
convertSelections expression selections
- = foldl (convertSelection) expression selections
+ = foldl convertSelection expression selections
convertSelection :: (BEMonad BENodeP) (BESelectorKind, Selection) -> (BEMonad BENodeP)
convertSelection expression (kind, RecordSelection {glob_object={ds_index}, glob_module} _)
diff --git a/frontend/checkFunctionBodies.icl b/frontend/checkFunctionBodies.icl
index 21ad9c1..3d1daf0 100644
--- a/frontend/checkFunctionBodies.icl
+++ b/frontend/checkFunctionBodies.icl
@@ -1019,9 +1019,9 @@ checkExpression free_vars (PE_Selection selector_kind expr [PS_Array index_expr]
ParsedNormalSelector
-> (PD_ArraySelectFun, NormalSelector)
ParsedUniqueSelector False
- -> (PD_UnqArraySelectFun, NormalSelector)
+ -> (PD_UnqArraySelectFun, UniqueSingleArraySelector/*NormalSelector*/)
ParsedUniqueSelector True
- -> (PD_UnqArraySelectFun, NormalSelectorUniqueElementResult)
+ -> (PD_UnqArraySelectFun, UniqueSingleArraySelectorUniqueElementResult)
# (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 selector_kind expr [selector], free_vars, e_state, e_info, cs)
@@ -2592,7 +2592,7 @@ buildSelections e_input {ap_opt_var, ap_array_var, ap_selections}
(glob_select_symb, selector_kind, cs)
= case dimension of
1 # (unq_select_symb, cs) = getPredefinedGlobalSymbol PD_UnqArraySelectFun PD_StdArray STE_Member 2 cs
- -> (unq_select_symb, NormalSelector, cs)
+ -> (unq_select_symb, UniqueSingleArraySelector, cs)
_ # (select_symb, cs) = getPredefinedGlobalSymbol PD_ArraySelectFun PD_StdArray STE_Member 2 cs
-> (select_symb, UniqueSelector, cs)
e_state
diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl
index 71e3d06..3bdedff 100644
--- a/frontend/syntax.dcl
+++ b/frontend/syntax.dcl
@@ -1253,8 +1253,10 @@ cIsNotStrict :== False
:: SelectorKind
= NormalSelector
- | NormalSelectorUniqueElementResult
| UniqueSelector // !
+ | UniqueSelectorUniqueElementResult
+ | UniqueSingleArraySelector
+ | UniqueSingleArraySelectorUniqueElementResult
:: Expression = Var !BoundVar
| App !App
diff --git a/frontend/syntax.icl b/frontend/syntax.icl
index 8d98cc5..102b743 100644
--- a/frontend/syntax.icl
+++ b/frontend/syntax.icl
@@ -444,8 +444,10 @@ where
instance <<< SelectorKind
where
(<<<) file NormalSelector = file <<< "."
- (<<<) file NormalSelectorUniqueElementResult = file <<< "!*"
(<<<) file UniqueSelector = file <<< "!"
+ (<<<) file UniqueSelectorUniqueElementResult = file <<< "!*"
+ (<<<) file UniqueSingleArraySelector = file <<< "!"
+ (<<<) file UniqueSingleArraySelectorUniqueElementResult = file <<< "!*"
instance <<< Selection
where
diff --git a/frontend/type.icl b/frontend/type.icl
index 991c646..7a52c0f 100644
--- a/frontend/type.icl
+++ b/frontend/type.icl
@@ -104,14 +104,11 @@ where
| ok
-> (True, simplified_type, subst)
-> (False, tcv, subst)
-//AA..
arraySubst type=:(TArrow1 arg_type) subst
# (changed, arg_type, subst) = arraySubst arg_type subst
| changed
= (changed, TArrow1 arg_type, subst)
= (False, type, subst)
-//..AA
-
arraySubst tfa_type=:(TFA vars type) subst
# (changed, type, subst) = arraySubst type subst
| changed
@@ -642,11 +639,9 @@ where
# (arg_type, type_heaps) = freshCopy arg_type type_heaps
(res_type, type_heaps) = freshCopy res_type type_heaps
= (arg_type --> res_type, type_heaps)
-//AA..
freshCopy (TArrow1 arg_type) type_heaps
# (arg_type, type_heaps) = freshCopy arg_type type_heaps
= (TArrow1 arg_type, type_heaps)
-//..AA
freshCopy (TFA vars type) type_heaps
= freshCopyOfTFAType vars type type_heaps
freshCopy type type_heaps
@@ -1678,9 +1673,12 @@ 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
+ NormalSelector
+ # (_, result_type, reqs_ts) = requirementsOfSelectors ti No expr selectors True expr_type expr (reqs, ts)
+ -> (result_type, opt_expr_ptr, reqs_ts)
UniqueSelector
# (var, ts) = freshAttributedVariable ts
- (_, result_type, (reqs, ts)) = requirementsOfSelectors ti No expr selectors False False var expr (reqs, ts)
+ (_, result_type, (reqs, ts)) = requirementsOfSelectors ti No expr selectors False var expr (reqs, ts)
non_unique_type_var = { at_attribute = TA_Multi, at_type = TempV ts.ts_var_store }
req_type_coercions
= [ { tc_demanded = non_unique_type_var, tc_offered = result_type, tc_position = CP_Expression expr, tc_coercible = False },
@@ -1689,16 +1687,27 @@ where
result_type = { at_type = TA tuple2TypeSymbIdent [non_unique_type_var,var], at_attribute = TA_Unique }
-> (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}))
- 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)
+ UniqueSelectorUniqueElementResult
+ # (var, ts) = freshAttributedVariable ts
+ (_, selection_type, (reqs, ts)) = requirementsOfSelectors ti No expr selectors True /*False*/ var expr (reqs, ts)
+ req_type_coercions = [ { tc_demanded = var, tc_offered = expr_type, tc_position = CP_Expression expr, tc_coercible = True } : reqs.req_type_coercions]
+ result_type = { at_type = TA tuple2TypeSymbIdent [selection_type,var], at_attribute = TA_Unique }
+ -> (result_type, No, ({ reqs & req_type_coercions = req_type_coercions },
+ {ts & ts_expr_heap = storeAttribute opt_expr_ptr selection_type.at_attribute ts.ts_expr_heap}))
+ UniqueSingleArraySelector
+ -> case selectors of
+ [selector]
+ # (_, result_type, reqs_ts) = requirementsOfSelector ti No expr selector True False expr_type expr (reqs, ts)
+ -> (result_type, opt_expr_ptr, reqs_ts)
+ UniqueSingleArraySelectorUniqueElementResult
+ -> case selectors of
+ [selector]
+ # (_, result_type, reqs_ts) = requirementsOfSelector ti No expr selector True True 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 False composite_expr_type composite_expr reqs_ts
+ = requirementsOfSelectors ti (Yes elem_expr) composite_expr selectors True 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))
@@ -1825,11 +1834,11 @@ basicStringType =: {box=TA (MakeTypeSymbIdent { glob_object = PD_StringTypeIndex
tuple2TypeSymbIdent =: MakeTypeSymbIdent { glob_object = PD_Arity2TupleTypeIndex, glob_module = cPredefinedModuleIndex } predefined_idents.[PD_Arity2TupleType] 2
-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
+requirementsOfSelectors ti opt_expr expr [selector] tc_coercible sel_expr_type sel_expr reqs_ts
+ = requirementsOfSelector ti opt_expr expr selector tc_coercible False 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 False 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
= (has_array_selection || have_array_selection, result_type, reqs_ts)
requirementsOfSelector ti _ expr (RecordSelection field _) tc_coercible change_uselect sel_expr_type sel_expr (reqs, ts )
@@ -1841,13 +1850,10 @@ requirementsOfSelector ti opt_expr expr (ArraySelection {glob_object = {ds_ident
# {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)
+ = if 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)
generated by cgit v1.2.3 (git 2.39.1) at 2025-03-13 17:00:16 +0000