Commit e52f3653 authored by Ronny Wichers Schreur's avatar Ronny Wichers Schreur

different representation of selector kind in Selection

parent ba6d8915
...@@ -1791,10 +1791,10 @@ where ...@@ -1791,10 +1791,10 @@ where
= beNormalNode (beBasicSymbol BEApplySymb) (convertArgs [f, a]) = beNormalNode (beBasicSymbol BEApplySymb) (convertArgs [f, a])
convertExpr (f @ [a:as]) convertExpr (f @ [a:as])
= convertExpr (f @ [a] @ as) = convertExpr (f @ [a] @ as)
convertExpr (Selection isUnique expression selections) convertExpr (Selection selectorKind expression selections)
= convertSelections (convertExpr expression) (addKinds isUnique selections) = convertSelections (convertExpr expression) (addKinds selectorKind selections)
where where
addKinds No selections addKinds NormalSelector selections
= [(BESelector, selection) \\ selection <- selections] = [(BESelector, selection) \\ selection <- selections]
addKinds _ [selection] addKinds _ [selection]
= [(BESelector_U, selection)] = [(BESelector_U, selection)]
...@@ -1826,7 +1826,7 @@ where ...@@ -1826,7 +1826,7 @@ where
convertExpr (Update expr1 [singleSelection] expr2) convertExpr (Update expr1 [singleSelection] expr2)
= case singleSelection of = case singleSelection of
RecordSelection _ _ RecordSelection _ _
-> beUpdateNode (convertArgs [expr1, Selection No expr2 [singleSelection]]) -> beUpdateNode (convertArgs [expr1, Selection NormalSelector expr2 [singleSelection]])
ArraySelection {glob_object={ds_index}, glob_module} _ index ArraySelection {glob_object={ds_index}, glob_module} _ index
// RWS not used?, eleminate beSpecialArrayFunctionSymbol? // RWS not used?, eleminate beSpecialArrayFunctionSymbol?
-> beNormalNode -> beNormalNode
...@@ -1834,11 +1834,11 @@ where ...@@ -1834,11 +1834,11 @@ where
(convertArgs [expr1, index, expr2]) (convertArgs [expr1, index, expr2])
// //
DictionarySelection dictionaryVar dictionarySelections _ index DictionarySelection dictionaryVar dictionarySelections _ index
-> convertExpr (Selection No (Var dictionaryVar) dictionarySelections @ [expr1, index, expr2]) -> convertExpr (Selection NormalSelector (Var dictionaryVar) dictionarySelections @ [expr1, index, expr2])
convertExpr (Update expr1 selections expr2) convertExpr (Update expr1 selections expr2)
= case lastSelection of = case lastSelection of
RecordSelection _ _ RecordSelection _ _
-> beUpdateNode (beArgs selection (convertArgs [Selection No expr2 [lastSelection]])) -> beUpdateNode (beArgs selection (convertArgs [Selection NormalSelector expr2 [lastSelection]]))
ArraySelection {glob_object={ds_index}, glob_module} _ index ArraySelection {glob_object={ds_index}, glob_module} _ index
-> beNormalNode (beSpecialArrayFunctionSymbol BE_ArrayUpdateFun ds_index glob_module) (beArgs selection (convertArgs [index, expr2])) -> beNormalNode (beSpecialArrayFunctionSymbol BE_ArrayUpdateFun ds_index glob_module) (beArgs selection (convertArgs [index, expr2]))
DictionarySelection dictionaryVar dictionarySelections _ index DictionarySelection dictionaryVar dictionarySelections _ index
...@@ -1846,7 +1846,7 @@ where ...@@ -1846,7 +1846,7 @@ where
(beArgs dictionary (beArgs selection (convertArgs [index, expr2]))) (beArgs dictionary (beArgs selection (convertArgs [index, expr2])))
with with
dictionary dictionary
= convertExpr (Selection No (Var dictionaryVar) dictionarySelections) = convertExpr (Selection NormalSelector (Var dictionaryVar) dictionarySelections)
where where
lastSelection lastSelection
= last selections = last selections
...@@ -1902,7 +1902,7 @@ where ...@@ -1902,7 +1902,7 @@ where
(beArgs dictionary (beArgs expression (convertArgs [index]))) (beArgs dictionary (beArgs expression (convertArgs [index])))
where where
dictionary dictionary
= convertExpr (Selection No (Var dictionaryVar) dictionarySelections) = convertExpr (Selection NormalSelector (Var dictionaryVar) dictionarySelections)
caseVar :: Expression -> BoundVar caseVar :: Expression -> BoundVar
caseVar (Var var) caseVar (Var var)
......
...@@ -1012,17 +1012,17 @@ checkExpression free_vars (PE_Selection is_unique expr [PS_Array index_expr]) e_ ...@@ -1012,17 +1012,17 @@ checkExpression free_vars (PE_Selection is_unique expr [PS_Array index_expr]) e_
| is_unique | is_unique
# (glob_select_symb, cs) = getPredefinedGlobalSymbol PD_UnqArraySelectFun PD_StdArray STE_Member 2 cs # (glob_select_symb, cs) = getPredefinedGlobalSymbol PD_UnqArraySelectFun 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 (selector, free_vars, e_state, e_info, cs) = checkArraySelection glob_select_symb free_vars index_expr e_input e_state e_info cs
= (Selection No expr [selector], free_vars, 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 # (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 (selector, free_vars, e_state, e_info, cs) = checkArraySelection glob_select_symb free_vars index_expr e_input e_state e_info cs
= (Selection No expr [selector], free_vars, 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 checkExpression free_vars (PE_Selection is_unique 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 # (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 (expr, free_vars, e_state, e_info, cs) = checkExpression free_vars expr e_input e_state e_info cs
| is_unique | is_unique
# (tuple_type, cs) = getPredefinedGlobalSymbol (GetTupleTypeIndex 2) PD_PredefinedModule STE_Type 2 cs # (tuple_type, cs) = getPredefinedGlobalSymbol (GetTupleTypeIndex 2) PD_PredefinedModule STE_Type 2 cs
= (Selection (Yes tuple_type) expr selectors, free_vars, e_state, e_info, cs) = (Selection (UniqueSelector tuple_type False) expr selectors, free_vars, e_state, e_info, cs)
= (Selection No expr selectors, free_vars, e_state, e_info, cs) = (Selection NormalSelector expr selectors, free_vars, e_state, e_info, cs)
checkExpression free_vars (PE_Update expr1 selectors expr2) e_input 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 # (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 (selectors, free_vars, e_state, e_info, cs) = checkSelectors cEndWithUpdate free_vars selectors e_input e_state e_info cs
...@@ -1836,7 +1836,7 @@ where ...@@ -1836,7 +1836,7 @@ where
selector = { glob_module = field_module, glob_object = MakeDefinedSymbol fs_name fs_index 1} selector = { glob_module = field_module, glob_object = MakeDefinedSymbol fs_name fs_index 1}
(this_record_expr, expr_heap) = adjust_match_expression record_expr expr_heap (this_record_expr, expr_heap) = adjust_match_expression record_expr expr_heap
(binds, var_store, expr_heap, e_info, cs) (binds, var_store, expr_heap, e_info, cs)
= transfromPatternIntoBind mod_index def_level pattern (Selection No this_record_expr [ RecordSelection selector field_index ]) = transfromPatternIntoBind mod_index def_level pattern (Selection NormalSelector this_record_expr [ RecordSelection selector field_index ])
position var_store expr_heap e_info cs position var_store expr_heap e_info cs
= transform_sub_patterns_of_record mod_index def_level patterns fields field_module (inc field_index) record_expr = transform_sub_patterns_of_record mod_index def_level patterns fields field_module (inc field_index) record_expr
(binds ++ all_binds) position var_store expr_heap e_info cs (binds ++ all_binds) position var_store expr_heap e_info cs
...@@ -2181,13 +2181,13 @@ buildSelections e_input {ap_opt_var, ap_array_var, ap_selections} ...@@ -2181,13 +2181,13 @@ buildSelections e_input {ap_opt_var, ap_array_var, ap_selections}
= mapSt newPtr (repeatn dimension EI_Empty) 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, opt_tuple_type, cs) (glob_select_symb, selector_kind, cs)
= case dimension of = case dimension of
1 # (unq_select_symb, cs) = getPredefinedGlobalSymbol PD_UnqArraySelectFun PD_StdArray STE_Member 2 cs 1 # (unq_select_symb, cs) = getPredefinedGlobalSymbol PD_UnqArraySelectFun PD_StdArray STE_Member 2 cs
-> (unq_select_symb, No, cs) -> (unq_select_symb, NormalSelector, cs)
_ # (select_symb, cs) = getPredefinedGlobalSymbol PD_ArraySelectFun PD_StdArray STE_Member 2 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 (tuple_type, cs) = getPredefinedGlobalSymbol (GetTupleTypeIndex 2) PD_PredefinedModule STE_Type 2 cs
-> (select_symb, Yes tuple_type, cs) -> (select_symb, UniqueSelector tuple_type False, 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_exprs, (free_vars, e_state, e_info, cs)) (index_exprs, (free_vars, e_state, e_info, cs))
...@@ -2195,7 +2195,7 @@ buildSelections e_input {ap_opt_var, ap_array_var, ap_selections} ...@@ -2195,7 +2195,7 @@ buildSelections e_input {ap_opt_var, ap_array_var, ap_selections}
selections selections
= [ ArraySelection glob_select_symb new_expr_ptr index_expr \\ new_expr_ptr<-new_expr_ptrs & index_expr<-index_exprs ] = [ 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
, [ {lb_dst = var_for_uselect_result, lb_src = Selection opt_tuple_type (Var bound_array_var) selections, lb_position = NoPos } , [ {lb_dst = var_for_uselect_result, lb_src = Selection selector_kind (Var bound_array_var) selections, lb_position = NoPos }
, {lb_dst = new_array_var, lb_src = TupleSelect tuple_cons.glob_object 1 (Var bound_var_for_uselect_result), lb_position = NoPos } , {lb_dst = new_array_var, lb_src = TupleSelect tuple_cons.glob_object 1 (Var bound_var_for_uselect_result), lb_position = NoPos }
, {lb_dst = array_element_var, lb_src = TupleSelect tuple_cons.glob_object 0 (Var bound_var_for_uselect_result), lb_position = NoPos } , {lb_dst = array_element_var, lb_src = TupleSelect tuple_cons.glob_object 0 (Var bound_var_for_uselect_result), lb_position = NoPos }
: binds : binds
......
...@@ -175,7 +175,7 @@ convertDynamicPatternsIntoUnifyAppls global_type_instances common_defs main_dcl_ ...@@ -175,7 +175,7 @@ convertDynamicPatternsIntoUnifyAppls global_type_instances common_defs main_dcl_
, glob_module = pds_module2 , glob_module = pds_module2
} }
#! ci_sel_type_field #! ci_sel_type_field
= (\dynamic_expr -> Selection No dynamic_expr [RecordSelection type_defined_symbol sd_field_nr]) = (\dynamic_expr -> Selection NormalSelector dynamic_expr [RecordSelection type_defined_symbol sd_field_nr])
// value field // value field
# ({pds_module=pds_module3, pds_def=pds_def3} , predefined_symbols) = predefined_symbols![PD_DynamicValue] # ({pds_module=pds_module3, pds_def=pds_def3} , predefined_symbols) = predefined_symbols![PD_DynamicValue]
...@@ -192,7 +192,7 @@ convertDynamicPatternsIntoUnifyAppls global_type_instances common_defs main_dcl_ ...@@ -192,7 +192,7 @@ convertDynamicPatternsIntoUnifyAppls global_type_instances common_defs main_dcl_
, glob_module = pds_module3 , glob_module = pds_module3
} }
#! ci_sel_value_field #! ci_sel_value_field
= (\dynamic_expr -> Selection No dynamic_expr [RecordSelection value_defined_symbol sd_field_nr3]) = (\dynamic_expr -> Selection NormalSelector dynamic_expr [RecordSelection value_defined_symbol sd_field_nr3])
-> (dynamic_temp_symb_ident, ci_sel_value_field, ci_sel_type_field,predefined_symbols) -> (dynamic_temp_symb_ident, ci_sel_value_field, ci_sel_type_field,predefined_symbols)
# (module_symb,module_id_app,predefined_symbols) # (module_symb,module_id_app,predefined_symbols)
...@@ -600,7 +600,7 @@ where ...@@ -600,7 +600,7 @@ where
convertTypecode cinp (TCE_Selector selections var_info_ptr) replace_tc_args binds placeholders_and_tc_args ci convertTypecode cinp (TCE_Selector selections var_info_ptr) replace_tc_args binds placeholders_and_tc_args ci
#! (var,binds,placeholders_and_tc_args,ci) #! (var,binds,placeholders_and_tc_args,ci)
= convertTypecode cinp (TCE_Var var_info_ptr) replace_tc_args binds placeholders_and_tc_args ci = convertTypecode cinp (TCE_Var var_info_ptr) replace_tc_args binds placeholders_and_tc_args ci
= (Selection No var selections,binds,placeholders_and_tc_args,ci) = (Selection NormalSelector var selections,binds,placeholders_and_tc_args,ci)
//convertTypecodes :: !ConversionInput [TypeCodeExpression] !*ConversionInfo -> (Expression,!*ConversionInfo) //convertTypecodes :: !ConversionInput [TypeCodeExpression] !*ConversionInfo -> (Expression,!*ConversionInfo)
convertTypecodes _ [] replace_tc_args binds placeholders_and_tc_args ci convertTypecodes _ [] replace_tc_args binds placeholders_and_tc_args ci
......
...@@ -3883,7 +3883,7 @@ buildIsoToSelectionExpr record_expr predefs ...@@ -3883,7 +3883,7 @@ buildIsoToSelectionExpr record_expr predefs
# selector = { # selector = {
glob_module = pds_module, glob_module = pds_module,
glob_object = {ds_ident = pds_ident, ds_index = pds_def, ds_arity = 1}} glob_object = {ds_ident = pds_ident, ds_index = pds_def, ds_arity = 1}}
= Selection No record_expr [RecordSelection selector 0] = Selection NormalSelector record_expr [RecordSelection selector 0]
buildIsoFromSelectionExpr :: !Expression !PredefinedSymbols -> Expression buildIsoFromSelectionExpr :: !Expression !PredefinedSymbols -> Expression
buildIsoFromSelectionExpr record_expr predefs buildIsoFromSelectionExpr record_expr predefs
...@@ -3891,7 +3891,7 @@ buildIsoFromSelectionExpr record_expr predefs ...@@ -3891,7 +3891,7 @@ buildIsoFromSelectionExpr record_expr predefs
# selector = { # selector = {
glob_module = pds_module, glob_module = pds_module,
glob_object = {ds_ident = pds_ident, ds_index = pds_def, ds_arity = 1}} glob_object = {ds_ident = pds_ident, ds_index = pds_def, ds_arity = 1}}
= Selection No record_expr [RecordSelection selector 1] = Selection NormalSelector record_expr [RecordSelection selector 1]
buildVarExpr :: !String !*Heaps -> (!Expression, !FreeVar, !*Heaps) buildVarExpr :: !String !*Heaps -> (!Expression, !FreeVar, !*Heaps)
buildVarExpr name heaps=:{hp_var_heap, hp_expression_heap} buildVarExpr name heaps=:{hp_var_heap, hp_expression_heap}
......
...@@ -864,7 +864,7 @@ where ...@@ -864,7 +864,7 @@ where
# (class_context, context_address, hp_type_heaps) = determineContextAddress contexts defs tc hp_type_heaps # (class_context, context_address, hp_type_heaps) = determineContextAddress contexts defs tc hp_type_heaps
| isEmpty context_address | isEmpty context_address
= (ClassVariable class_context.tc_var, ({ heaps & hp_type_heaps = hp_type_heaps }, ptrs)) = (ClassVariable class_context.tc_var, ({ heaps & hp_type_heaps = hp_type_heaps }, ptrs))
= (Selection No (ClassVariable class_context.tc_var) (generateClassSelection context_address []), ({ heaps & hp_type_heaps = hp_type_heaps }, ptrs)) = (Selection NormalSelector (ClassVariable class_context.tc_var) (generateClassSelection context_address []), ({ heaps & hp_type_heaps = hp_type_heaps }, ptrs))
convert_class_appl_to_expression defs contexts (CA_LocalTypeCode new_var_ptr) heaps_and_ptrs convert_class_appl_to_expression defs contexts (CA_LocalTypeCode new_var_ptr) heaps_and_ptrs
= (TypeCodeExpression (TCE_Var new_var_ptr), heaps_and_ptrs) = (TypeCodeExpression (TCE_Var new_var_ptr), heaps_and_ptrs)
convert_class_appl_to_expression defs contexts (CA_GlobalTypeCode {tci_index,tci_contexts}) heaps_and_ptrs convert_class_appl_to_expression defs contexts (CA_GlobalTypeCode {tci_index,tci_contexts}) heaps_and_ptrs
...@@ -1302,7 +1302,7 @@ where ...@@ -1302,7 +1302,7 @@ where
EI_Selection selectors record_var context_args EI_Selection selectors record_var context_args
# (all_args, ui=:{ui_var_heap, ui_error}) = adjustClassExpressions symb_name context_args app_args ui # (all_args, ui=:{ui_var_heap, ui_error}) = adjustClassExpressions symb_name context_args app_args ui
(var_name, var_info_ptr, ui_var_heap, ui_error) = getClassVariable symb_name record_var ui_var_heap ui_error (var_name, var_info_ptr, ui_var_heap, ui_error) = getClassVariable symb_name record_var ui_var_heap ui_error
select_expr = Selection No (Var { var_name = var_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr }) selectors select_expr = Selection NormalSelector (Var { var_name = var_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr }) selectors
| isEmpty all_args | isEmpty all_args
-> (select_expr, { ui & ui_var_heap = ui_var_heap, ui_error = ui_error }) -> (select_expr, { ui & ui_var_heap = ui_var_heap, ui_error = ui_error })
-> (select_expr @ all_args, examine_calls context_args -> (select_expr @ all_args, examine_calls context_args
...@@ -1595,7 +1595,7 @@ where ...@@ -1595,7 +1595,7 @@ where
{ ui & ui_var_heap = ui_var_heap }) { ui & ui_var_heap = ui_var_heap })
// ... MV // ... MV
convertTypecode (TCE_Selector selections var_info_ptr) ui convertTypecode (TCE_Selector selections var_info_ptr) ui
= (Selection No (Var { var_name = a_ij_var_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr }) selections, ui) = (Selection NormalSelector (Var { var_name = a_ij_var_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr }) selections, ui)
convertTypecode (TCE_UniType uni_vars type_code) ui convertTypecode (TCE_UniType uni_vars type_code) ui
# (let_binds, ui) = createVariables uni_vars ui # (let_binds, ui) = createVariables uni_vars ui
(let_expr, ui) = convertTypecode type_code ui (let_expr, ui) = convertTypecode type_code ui
......
...@@ -1099,6 +1099,12 @@ cNonUniqueSelection :== False ...@@ -1099,6 +1099,12 @@ cNonUniqueSelection :== False
cIsStrict :== True cIsStrict :== True
cIsNotStrict :== False cIsNotStrict :== False
:: SelectorKind
= NormalSelector // .
| UniqueSelector // !
(Global DefinedSymbol) // tuple type
!Bool // is result element unique?
/* /*
:: SelectorKind = SEK_Normal | SEK_First | SEK_Next | SEK_Last :: SelectorKind = SEK_Normal | SEK_First | SEK_Next | SEK_Last
...@@ -1110,8 +1116,7 @@ cIsNotStrict :== False ...@@ -1110,8 +1116,7 @@ cIsNotStrict :== False
| (@) infixl 9 !Expression ![Expression] | (@) infixl 9 !Expression ![Expression]
| Let !Let | Let !Let
| Case !Case | Case !Case
| Selection !(Optional (Global DefinedSymbol)) !Expression ![Selection] | Selection !SelectorKind !Expression ![Selection]
// Yes: a "!" selection
| Update !Expression ![Selection] Expression | Update !Expression ![Selection] Expression
| RecordUpdate !(Global DefinedSymbol) !Expression ![Bind Expression (Global FieldSymbol)] | RecordUpdate !(Global DefinedSymbol) !Expression ![Bind Expression (Global FieldSymbol)]
| TupleSelect !DefinedSymbol !Int !Expression | TupleSelect !DefinedSymbol !Int !Expression
...@@ -1293,7 +1298,7 @@ instance == ModuleKind, Ident ...@@ -1293,7 +1298,7 @@ instance == ModuleKind, Ident
instance <<< (Module a) | <<< a, ParsedDefinition, InstanceType, AttributeVar, TypeVar, SymbolType, Expression, Type, Ident, (Global object) | <<< object, instance <<< (Module a) | <<< a, ParsedDefinition, InstanceType, AttributeVar, TypeVar, SymbolType, Expression, Type, Ident, (Global object) | <<< object,
Position, CaseAlt, AType, FunDef, ParsedExpr, TypeAttribute, (Bind a b) | <<< a & <<< b, ParsedConstructor, (TypeDef a) | <<< a, TypeVarInfo, Position, CaseAlt, AType, FunDef, ParsedExpr, TypeAttribute, (Bind a b) | <<< a & <<< b, ParsedConstructor, (TypeDef a) | <<< a, TypeVarInfo,
BasicValue, ATypeVar, TypeRhs, FunctionPattern, (Import from_symbol) | <<< from_symbol, ImportDeclaration, ImportedIdent, CasePatterns, BasicValue, ATypeVar, TypeRhs, FunctionPattern, (Import from_symbol) | <<< from_symbol, ImportDeclaration, ImportedIdent, CasePatterns,
(Optional a) | <<< a, ConsVariable, BasicType, Annotation, Selection, SelectorDef, ConsDef, LocalDefs, FreeVar, ClassInstance, SignClassification, (Optional a) | <<< a, ConsVariable, BasicType, Annotation, SelectorKind, Selection, SelectorDef, ConsDef, LocalDefs, FreeVar, ClassInstance, SignClassification,
TypeCodeExpression, CoercionPosition, AttrInequality, LetBind, Declaration, STE_Kind, BoundVar TypeCodeExpression, CoercionPosition, AttrInequality, LetBind, Declaration, STE_Kind, BoundVar
instance <<< FunctionBody instance <<< FunctionBody
......
...@@ -1092,12 +1092,18 @@ cNonUniqueSelection :== False ...@@ -1092,12 +1092,18 @@ cNonUniqueSelection :== False
cIsStrict :== True cIsStrict :== True
cIsNotStrict :== False cIsNotStrict :== False
:: SelectorKind
= NormalSelector // .
| UniqueSelector // !
(Global DefinedSymbol) // tuple type
!Bool // is result element unique?
:: Expression = Var !BoundVar :: Expression = Var !BoundVar
| App !App | App !App
| (@) infixl 9 !Expression ![Expression] | (@) infixl 9 !Expression ![Expression]
| Let !Let | Let !Let
| Case !Case | Case !Case
| Selection !(Optional (Global DefinedSymbol)) !Expression ![Selection] | Selection !SelectorKind !Expression ![Selection]
| Update !Expression ![Selection] Expression | Update !Expression ![Selection] Expression
| RecordUpdate !(Global DefinedSymbol) !Expression ![Bind Expression (Global FieldSymbol)] | RecordUpdate !(Global DefinedSymbol) !Expression ![Bind Expression (Global FieldSymbol)]
| TupleSelect !DefinedSymbol !Int !Expression | TupleSelect !DefinedSymbol !Int !Expression
...@@ -1583,10 +1589,7 @@ where ...@@ -1583,10 +1589,7 @@ where
else_part file No = file <<< '\n' else_part file No = file <<< '\n'
else_part file (Yes else) = file <<< "\nELSE\n" <<< else <<< '\n' else_part file (Yes else) = file <<< "\nELSE\n" <<< else <<< '\n'
*/ */
(<<<) file (Selection opt_tuple expr selectors) = file <<< expr <<< selector_kind opt_tuple <<< selectors (<<<) file (Selection selector_kind expr selectors) = file <<< expr <<< selector_kind <<< selectors
where
selector_kind No = '.'
selector_kind (Yes _) = '!'
(<<<) file (Update expr1 selections expr2) = file <<< '{' <<< expr1 <<< " & " <<< selections <<< " = " <<< expr2 <<< '}' (<<<) file (Update expr1 selections expr2) = file <<< '{' <<< expr1 <<< " & " <<< selections <<< " = " <<< expr2 <<< '}'
(<<<) file (RecordUpdate cons_symbol expression expressions) = file <<< '{' <<< cons_symbol <<< ' ' <<< expression <<< " & " <<< expressions <<< '}' (<<<) file (RecordUpdate cons_symbol expression expressions) = file <<< '{' <<< cons_symbol <<< ' ' <<< expression <<< " & " <<< expressions <<< '}'
(<<<) file (TupleSelect field field_nr expr) = file <<< expr <<<'.' <<< field_nr (<<<) file (TupleSelect field field_nr expr) = file <<< expr <<<'.' <<< field_nr
...@@ -1656,6 +1659,12 @@ where ...@@ -1656,6 +1659,12 @@ where
(<<<) file ptr (<<<) file ptr
= file <<< ptrToInt ptr = file <<< ptrToInt ptr
instance <<< SelectorKind
where
(<<<) file NormalSelector = file <<< "!"
(<<<) file (UniqueSelector _ False) = file <<< "!"
(<<<) file (UniqueSelector _ True) = file <<< "!*"
instance <<< Selection instance <<< Selection
where where
(<<<) file (RecordSelection selector _) = file <<< selector (<<<) file (RecordSelection selector _) = file <<< selector
......
...@@ -2369,7 +2369,7 @@ transformApplication app=:{app_symb=symb=:{symb_kind,symb_arity}, app_args} extr ...@@ -2369,7 +2369,7 @@ transformApplication app=:{app_symb=symb=:{symb_kind,symb_arity}, app_args} extr
// && trace_tn ("select_member "+++toString select_symb.glob_object.ds_ident.id_name) // && trace_tn ("select_member "+++toString select_symb.glob_object.ds_ident.id_name)
= (app_args !! me_offset,ti) = (app_args !! me_offset,ti)
select_member exp select_symb me_offset ti select_member exp select_symb me_offset ti
= (Selection No exp [RecordSelection select_symb me_offset],ti) = (Selection NormalSelector exp [RecordSelection select_symb me_offset],ti)
// XXX linear_bits field has to be added for generated functions // XXX linear_bits field has to be added for generated functions
transformApplication app=:{app_symb={symb_name,symb_kind = SK_GeneratedFunction fun_def_ptr fun_index}} extra_args transformApplication app=:{app_symb={symb_name,symb_kind = SK_GeneratedFunction fun_def_ptr fun_index}} extra_args
...@@ -2386,23 +2386,23 @@ transformApplication app [] ro ti ...@@ -2386,23 +2386,23 @@ transformApplication app [] ro ti
transformApplication app extra_args ro ti transformApplication app extra_args ro ti
= (App app @ extra_args, ti) = (App app @ extra_args, ti)
transformSelection :: (Optional .(Global DefinedSymbol)) [Selection] Expression *TransformInfo -> (!Expression,!*TransformInfo) transformSelection :: SelectorKind [Selection] Expression *TransformInfo -> (!Expression,!*TransformInfo)
transformSelection No s=:[RecordSelection _ field_index : selectors] transformSelection NormalSelector s=:[RecordSelection _ field_index : selectors]
app=:(App {app_symb={symb_kind= SK_Constructor _ }, app_args, app_info_ptr}) app=:(App {app_symb={symb_kind= SK_Constructor _ }, app_args, app_info_ptr})
ti=:{ti_symbol_heap} ti=:{ti_symbol_heap}
| isNilPtr app_info_ptr | isNilPtr app_info_ptr
= (Selection No app s, ti) = (Selection NormalSelector app s, ti)
# (app_info, ti_symbol_heap) = readPtr app_info_ptr ti_symbol_heap # (app_info, ti_symbol_heap) = readPtr app_info_ptr ti_symbol_heap
ti = { ti & ti_symbol_heap = ti_symbol_heap } ti = { ti & ti_symbol_heap = ti_symbol_heap }
= case app_info of = case app_info of
EI_DictionaryType _ EI_DictionaryType _
-> transformSelection No selectors (app_args !! field_index) ti -> transformSelection NormalSelector selectors (app_args !! field_index) ti
_ _
-> (Selection No app s, ti) -> (Selection NormalSelector app s, ti)
transformSelection No [] expr ti transformSelection NormalSelector [] expr ti
= (expr, ti) = (expr, ti)
transformSelection opt_type selectors expr ti transformSelection selector_kind selectors expr ti
= (Selection opt_type expr selectors, ti) = (Selection selector_kind expr selectors, ti)
// XXX store linear_bits and cc_args together ? // XXX store linear_bits and cc_args together ?
......
...@@ -1467,10 +1467,10 @@ where ...@@ -1467,10 +1467,10 @@ where
requirements ti (DynamicExpr dienamic) reqs_ts requirements ti (DynamicExpr dienamic) reqs_ts
= requirements ti dienamic reqs_ts = requirements ti dienamic reqs_ts
requirements ti (Selection result_type_symb expr selectors) reqs_ts requirements ti (Selection selector_kind expr selectors) reqs_ts
# (expr_type, opt_expr_ptr, (reqs, ts)) = requirements ti expr reqs_ts # (expr_type, opt_expr_ptr, (reqs, ts)) = requirements ti expr reqs_ts
= case result_type_symb of = case selector_kind of
Yes {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 # (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 var expr (reqs, ts)
tuple_type = MakeTypeSymbIdent { glob_object = ds_index, glob_module = glob_module } ds_ident ds_arity tuple_type = MakeTypeSymbIdent { glob_object = ds_index, glob_module = glob_module } ds_ident ds_arity
......
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