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
= beNormalNode (beBasicSymbol BEApplySymb) (convertArgs [f, a])
convertExpr (f @ [a:as])
= convertExpr (f @ [a] @ as)
convertExpr (Selection isUnique expression selections)
= convertSelections (convertExpr expression) (addKinds isUnique selections)
convertExpr (Selection selectorKind expression selections)
= convertSelections (convertExpr expression) (addKinds selectorKind selections)
where
addKinds No selections
addKinds NormalSelector selections
= [(BESelector, selection) \\ selection <- selections]
addKinds _ [selection]
= [(BESelector_U, selection)]
......@@ -1826,7 +1826,7 @@ where
convertExpr (Update expr1 [singleSelection] expr2)
= case singleSelection of
RecordSelection _ _
-> beUpdateNode (convertArgs [expr1, Selection No expr2 [singleSelection]])
-> beUpdateNode (convertArgs [expr1, Selection NormalSelector expr2 [singleSelection]])
ArraySelection {glob_object={ds_index}, glob_module} _ index
// RWS not used?, eleminate beSpecialArrayFunctionSymbol?
-> beNormalNode
......@@ -1834,11 +1834,11 @@ where
(convertArgs [expr1, index, expr2])
//
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)
= case lastSelection of
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
-> beNormalNode (beSpecialArrayFunctionSymbol BE_ArrayUpdateFun ds_index glob_module) (beArgs selection (convertArgs [index, expr2]))
DictionarySelection dictionaryVar dictionarySelections _ index
......@@ -1846,7 +1846,7 @@ where
(beArgs dictionary (beArgs selection (convertArgs [index, expr2])))
with
dictionary
= convertExpr (Selection No (Var dictionaryVar) dictionarySelections)
= convertExpr (Selection NormalSelector (Var dictionaryVar) dictionarySelections)
where
lastSelection
= last selections
......@@ -1902,7 +1902,7 @@ where
(beArgs dictionary (beArgs expression (convertArgs [index])))
where
dictionary
= convertExpr (Selection No (Var dictionaryVar) dictionarySelections)
= convertExpr (Selection NormalSelector (Var dictionaryVar) dictionarySelections)
caseVar :: Expression -> BoundVar
caseVar (Var var)
......
......@@ -1012,17 +1012,17 @@ checkExpression free_vars (PE_Selection is_unique expr [PS_Array index_expr]) e_
| is_unique
# (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
= (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
(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
# (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
# (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 No expr selectors, free_vars, e_state, e_info, 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)
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
......@@ -1836,7 +1836,7 @@ where
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
(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
= 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
......@@ -2181,13 +2181,13 @@ buildSelections e_input {ap_opt_var, ap_array_var, ap_selections}
= mapSt newPtr (repeatn dimension EI_Empty) es_expr_heap
(tuple_cons, 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
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
(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 & es_var_heap = es_var_heap, es_expr_heap = es_expr_heap }
(index_exprs, (free_vars, e_state, e_info, cs))
......@@ -2195,7 +2195,7 @@ buildSelections e_input {ap_opt_var, ap_array_var, ap_selections}
selections
= [ ArraySelection glob_select_symb new_expr_ptr index_expr \\ new_expr_ptr<-new_expr_ptrs & index_expr<-index_exprs ]
= ( 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 = array_element_var, lb_src = TupleSelect tuple_cons.glob_object 0 (Var bound_var_for_uselect_result), lb_position = NoPos }
: binds
......
......@@ -175,7 +175,7 @@ convertDynamicPatternsIntoUnifyAppls global_type_instances common_defs main_dcl_
, glob_module = pds_module2
}
#! 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
# ({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_
, glob_module = pds_module3
}
#! 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)
# (module_symb,module_id_app,predefined_symbols)
......@@ -600,7 +600,7 @@ where
convertTypecode cinp (TCE_Selector selections var_info_ptr) replace_tc_args 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
= (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 _ [] replace_tc_args binds placeholders_and_tc_args ci
......
......@@ -3883,7 +3883,7 @@ buildIsoToSelectionExpr record_expr predefs
# selector = {
glob_module = pds_module,
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 record_expr predefs
......@@ -3891,7 +3891,7 @@ buildIsoFromSelectionExpr record_expr predefs
# selector = {
glob_module = pds_module,
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 name heaps=:{hp_var_heap, hp_expression_heap}
......
......@@ -864,7 +864,7 @@ where
# (class_context, context_address, hp_type_heaps) = determineContextAddress contexts defs tc hp_type_heaps
| isEmpty context_address
= (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
= (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
......@@ -1302,7 +1302,7 @@ where
EI_Selection selectors record_var context_args
# (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
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
-> (select_expr, { ui & ui_var_heap = ui_var_heap, ui_error = ui_error })
-> (select_expr @ all_args, examine_calls context_args
......@@ -1595,7 +1595,7 @@ where
{ ui & ui_var_heap = ui_var_heap })
// ... MV
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
# (let_binds, ui) = createVariables uni_vars ui
(let_expr, ui) = convertTypecode type_code ui
......
......@@ -1099,6 +1099,12 @@ cNonUniqueSelection :== False
cIsStrict :== True
cIsNotStrict :== False
:: SelectorKind
= NormalSelector // .
| UniqueSelector // !
(Global DefinedSymbol) // tuple type
!Bool // is result element unique?
/*
:: SelectorKind = SEK_Normal | SEK_First | SEK_Next | SEK_Last
......@@ -1110,8 +1116,7 @@ cIsNotStrict :== False
| (@) infixl 9 !Expression ![Expression]
| Let !Let
| Case !Case
| Selection !(Optional (Global DefinedSymbol)) !Expression ![Selection]
// Yes: a "!" selection
| Selection !SelectorKind !Expression ![Selection]
| Update !Expression ![Selection] Expression
| RecordUpdate !(Global DefinedSymbol) !Expression ![Bind Expression (Global FieldSymbol)]
| TupleSelect !DefinedSymbol !Int !Expression
......@@ -1293,7 +1298,7 @@ instance == ModuleKind, Ident
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,
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
instance <<< FunctionBody
......
......@@ -1092,12 +1092,18 @@ cNonUniqueSelection :== False
cIsStrict :== True
cIsNotStrict :== False
:: SelectorKind
= NormalSelector // .
| UniqueSelector // !
(Global DefinedSymbol) // tuple type
!Bool // is result element unique?
:: Expression = Var !BoundVar
| App !App
| (@) infixl 9 !Expression ![Expression]
| Let !Let
| Case !Case
| Selection !(Optional (Global DefinedSymbol)) !Expression ![Selection]
| Selection !SelectorKind !Expression ![Selection]
| Update !Expression ![Selection] Expression
| RecordUpdate !(Global DefinedSymbol) !Expression ![Bind Expression (Global FieldSymbol)]
| TupleSelect !DefinedSymbol !Int !Expression
......@@ -1583,10 +1589,7 @@ where
else_part file No = file <<< '\n'
else_part file (Yes else) = file <<< "\nELSE\n" <<< else <<< '\n'
*/
(<<<) file (Selection opt_tuple expr selectors) = file <<< expr <<< selector_kind opt_tuple <<< selectors
where
selector_kind No = '.'
selector_kind (Yes _) = '!'
(<<<) file (Selection selector_kind expr selectors) = file <<< expr <<< selector_kind <<< selectors
(<<<) file (Update expr1 selections expr2) = file <<< '{' <<< expr1 <<< " & " <<< selections <<< " = " <<< expr2 <<< '}'
(<<<) file (RecordUpdate cons_symbol expression expressions) = file <<< '{' <<< cons_symbol <<< ' ' <<< expression <<< " & " <<< expressions <<< '}'
(<<<) file (TupleSelect field field_nr expr) = file <<< expr <<<'.' <<< field_nr
......@@ -1656,6 +1659,12 @@ where
(<<<) file ptr
= file <<< ptrToInt ptr
instance <<< SelectorKind
where
(<<<) file NormalSelector = file <<< "!"
(<<<) file (UniqueSelector _ False) = file <<< "!"
(<<<) file (UniqueSelector _ True) = file <<< "!*"
instance <<< Selection
where
(<<<) file (RecordSelection selector _) = file <<< selector
......
......@@ -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)
= (app_args !! 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
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
transformApplication app extra_args ro ti
= (App app @ extra_args, ti)
transformSelection :: (Optional .(Global DefinedSymbol)) [Selection] Expression *TransformInfo -> (!Expression,!*TransformInfo)
transformSelection No s=:[RecordSelection _ field_index : selectors]
transformSelection :: SelectorKind [Selection] Expression *TransformInfo -> (!Expression,!*TransformInfo)
transformSelection NormalSelector s=:[RecordSelection _ field_index : selectors]
app=:(App {app_symb={symb_kind= SK_Constructor _ }, app_args, app_info_ptr})
ti=:{ti_symbol_heap}
| 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
ti = { ti & ti_symbol_heap = ti_symbol_heap }
= case app_info of
EI_DictionaryType _
-> transformSelection No selectors (app_args !! field_index) ti
-> transformSelection NormalSelector selectors (app_args !! field_index) ti
_
-> (Selection No app s, ti)
transformSelection No [] expr ti
-> (Selection NormalSelector app s, ti)
transformSelection NormalSelector [] expr ti
= (expr, ti)
transformSelection opt_type selectors expr ti
= (Selection opt_type expr selectors, ti)
transformSelection selector_kind selectors expr ti
= (Selection selector_kind expr selectors, ti)
// XXX store linear_bits and cc_args together ?
......
......@@ -1467,10 +1467,10 @@ where
requirements ti (DynamicExpr 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
= case result_type_symb of
Yes {glob_object={ds_ident,ds_index,ds_arity}, glob_module}
= case selector_kind of
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)
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