diff options
| -rw-r--r-- | backend/backendconvert.icl | 16 | ||||
| -rw-r--r-- | frontend/checkFunctionBodies.icl | 18 | ||||
| -rw-r--r-- | frontend/convertDynamics.icl | 6 | ||||
| -rw-r--r-- | frontend/generics.icl | 4 | ||||
| -rw-r--r-- | frontend/overloading.icl | 6 | ||||
| -rw-r--r-- | frontend/syntax.dcl | 11 | ||||
| -rw-r--r-- | frontend/syntax.icl | 19 | ||||
| -rw-r--r-- | frontend/trans.icl | 18 | ||||
| -rw-r--r-- | frontend/type.icl | 6 |
9 files changed, 59 insertions, 45 deletions
diff --git a/backend/backendconvert.icl b/backend/backendconvert.icl index 794cc77..b80b0e6 100644 --- a/backend/backendconvert.icl +++ b/backend/backendconvert.icl @@ -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) diff --git a/frontend/checkFunctionBodies.icl b/frontend/checkFunctionBodies.icl index e50d91a..8591fa1 100644 --- a/frontend/checkFunctionBodies.icl +++ b/frontend/checkFunctionBodies.icl @@ -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 diff --git a/frontend/convertDynamics.icl b/frontend/convertDynamics.icl index 23be72a..aab9f70 100644 --- a/frontend/convertDynamics.icl +++ b/frontend/convertDynamics.icl @@ -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 diff --git a/frontend/generics.icl b/frontend/generics.icl index 1386f08..40c2d0f 100644 --- a/frontend/generics.icl +++ b/frontend/generics.icl @@ -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} diff --git a/frontend/overloading.icl b/frontend/overloading.icl index a50210c..bdc55d0 100644 --- a/frontend/overloading.icl +++ b/frontend/overloading.icl @@ -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 diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl index a0df396..b022af6 100644 --- a/frontend/syntax.dcl +++ b/frontend/syntax.dcl @@ -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 diff --git a/frontend/syntax.icl b/frontend/syntax.icl index 22bba06..e73457c 100644 --- a/frontend/syntax.icl +++ b/frontend/syntax.icl @@ -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 diff --git a/frontend/trans.icl b/frontend/trans.icl index 47616fc..62f613c 100644 --- a/frontend/trans.icl +++ b/frontend/trans.icl @@ -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 ? diff --git a/frontend/type.icl b/frontend/type.icl index 01474a7..b1f62b3 100644 --- a/frontend/type.icl +++ b/frontend/type.icl @@ -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 |