different representation of selector kind in Selection

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)

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

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

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} 

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

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

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

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 ?
 

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