rename consumer classifications and add CUnused

git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@1170 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d

4 files changed, 82 insertions, 58 deletions

diff --git a/frontend/classify.dcl b/frontend/classify.dcl
index e72fcf6..0e35558 100644
--- a/frontend/classify.dcl
+++ b/frontend/classify.dcl
@@ -2,10 +2,11 @@ definition module classify
 
 import syntax, checksupport, transform
 
-cPassive   				:== -1
-cActive					:== -2
-cAccumulating   		:== -3
-cVarOfMultimatchCase	:== -4
+CUnused					:== -1
+CPassive   				:== -2
+CActive					:== -3
+CAccumulating   		:== -4
+CVarOfMultimatchCase	:== -5
 
 ::	CleanupInfo :== [ExprInfoPtr]
 
diff --git a/frontend/classify.icl b/frontend/classify.icl
index fa1abbf..16469f6 100644
--- a/frontend/classify.icl
+++ b/frontend/classify.icl
@@ -29,9 +29,9 @@ IsAVariable cons_class	:== cons_class >= 0
 combineClasses :: !ConsClass !ConsClass -> ConsClass
 combineClasses cc1 cc2
 	| IsAVariable cc1
-		= cAccumulating
+		= CAccumulating
 	| IsAVariable cc2
-		= cAccumulating
+		= CAccumulating
 		= min cc1 cc2
  
 aiUnifyClassifications cc1 cc2 ai
@@ -118,10 +118,11 @@ where
 ::	ConsClass		:== Int
 */
 
-cPassive   				:== -1
-cActive					:== -2
-cAccumulating   		:== -3
-cVarOfMultimatchCase	:== -4
+CUnused					:== -1
+CPassive   				:== -2
+CActive					:== -3
+CAccumulating   		:== -4
+CVarOfMultimatchCase	:== -5
 
 /*
 	NOTE: ordering of above values is relevant since unification
@@ -171,7 +172,7 @@ where
 				   ai				= { ai & ai_cur_ref_counts.[arg_position] = min (ref_count+1) 2 }
 				-> (temp_var, False, ai)
 			_
-				-> abort ("consumerRequirements" ---> (var_name))
+				-> abort ("consumerRequirements [BoundVar] " ---> (var_name))
 
 instance consumerRequirements Expression where
 	consumerRequirements (Var var) common_defs ai
@@ -180,7 +181,7 @@ instance consumerRequirements Expression where
 		= consumerRequirements app common_defs ai
 	consumerRequirements (fun_expr @ exprs) common_defs ai
 		# (cc_fun, _, ai)			= consumerRequirements fun_expr common_defs ai
-		  ai						= aiUnifyClassifications cActive cc_fun ai
+		  ai						= aiUnifyClassifications CActive cc_fun ai
 		= consumerRequirements exprs common_defs ai
 	consumerRequirements (Let {let_strict_binds, let_lazy_binds,let_expr}) common_defs ai=:{ai_next_var,ai_next_var_of_fun,ai_var_heap}
 		# let_binds					= let_strict_binds ++ let_lazy_binds
@@ -211,39 +212,45 @@ instance consumerRequirements Expression where
 	consumerRequirements (Case case_expr) common_defs ai
 		= consumerRequirements case_expr common_defs ai
 	consumerRequirements (BasicExpr _) _ ai
-		= (cPassive, False, ai)
+		= (CPassive, False, ai)
 	consumerRequirements (MatchExpr _ expr) common_defs ai
 		= consumerRequirements expr common_defs ai
 	consumerRequirements (Selection _ expr selectors) common_defs ai
 		# (cc, _, ai) = consumerRequirements expr common_defs ai
-		  ai = aiUnifyClassifications cActive cc ai
+		  ai = aiUnifyClassifications CActive cc ai
 		  ai = requirementsOfSelectors selectors common_defs ai
-		= (cPassive, False, ai)
+		= (CPassive, False, ai)
 	consumerRequirements (Update expr1 selectors expr2) common_defs ai
 		# (cc, _, ai) = consumerRequirements expr1 common_defs ai
 		  ai = requirementsOfSelectors selectors common_defs ai
 		  (cc, _, ai) = consumerRequirements expr2 common_defs ai
-		= (cPassive, False, ai)
+		= (CPassive, False, ai)
 	consumerRequirements (RecordUpdate cons_symbol expression expressions) common_defs ai
 		# (cc, _, ai) = consumerRequirements expression common_defs ai
 		  (cc, _, ai) = consumerRequirements expressions common_defs ai
-		= (cPassive, False, ai)
+		= (CPassive, False, ai)
 	consumerRequirements (TupleSelect tuple_symbol arg_nr expr) common_defs ai
 		= consumerRequirements expr common_defs ai
-	consumerRequirements (AnyCodeExpr _ _ _) _ ai
-		= (cPassive, False, ai)
-	consumerRequirements (ABCCodeExpr _ _) _ ai
-		= (cPassive, False, ai)
+	consumerRequirements (AnyCodeExpr _ _ _) _ ai=:{ai_cur_ref_counts}
+		#! s							= size ai_cur_ref_counts
+		   twos_array					= createArray s 2
+		   ai							= { ai & ai_cur_ref_counts=twos_array }
+		= (CPassive, False, ai)
+	consumerRequirements (ABCCodeExpr _ _) _ ai=:{ai_cur_ref_counts}
+		#! s							= size ai_cur_ref_counts
+		   twos_array					= createArray s 2
+		   ai							= { ai & ai_cur_ref_counts=twos_array }
+		= (CPassive, False, ai)
 	consumerRequirements (DynamicExpr dynamic_expr) common_defs ai
 		= consumerRequirements dynamic_expr common_defs ai
 	consumerRequirements (TypeCodeExpression _) _ ai
-		= (cPassive, False, ai)
+		= (CPassive, False, ai)
 	consumerRequirements EE _ ai
-		= (cPassive, False, ai)
+		= (CPassive, False, ai)
 	consumerRequirements (NoBind _) _ ai
-		= (cPassive, False, ai)
+		= (CPassive, False, ai)
 	consumerRequirements expr _ ai
-		= abort ("consumerRequirements ") // <<- expr)
+		= abort ("consumerRequirements [Expression]" ---> expr)
 
 requirementsOfSelectors selectors common_defs ai
 	= foldSt (reqs_of_selector common_defs) selectors ai
@@ -254,30 +261,35 @@ where
 	reqs_of_selector common_defs (DictionarySelection dict_var _ _ index_expr) ai
 		# (_, _, ai) = consumerRequirements index_expr common_defs ai
 		  (cc_var, _, ai) = consumerRequirements dict_var common_defs ai
-		= aiUnifyClassifications cActive cc_var ai
+		= aiUnifyClassifications CActive cc_var ai
+	// record selection missing?!
 	reqs_of_selector _ _ ai
 		= ai
 			
 instance consumerRequirements App where
-	consumerRequirements {app_symb={symb_kind = SK_Function {glob_module,glob_object}, symb_name}, app_args} common_defs=:(ConsumerAnalysisRO {main_dcl_module_n,stdStrictLists_module_n,imported_funs}) ai=:{ai_cons_class/*,ai_main_dcl_module_n*/}
-		| glob_module == main_dcl_module_n//ai_main_dcl_module_n
+	consumerRequirements {app_symb={symb_kind = SK_Function {glob_module,glob_object}, symb_name}, app_args} 
+			common_defs=:(ConsumerAnalysisRO {main_dcl_module_n,stdStrictLists_module_n,imported_funs})
+			ai=:{ai_cons_class}
+
+		| glob_module == main_dcl_module_n
 			| glob_object < size ai_cons_class
 				#! fun_class = ai_cons_class.[glob_object]
-				= reqs_of_args fun_class.cc_args app_args cPassive common_defs ai
+				= reqs_of_args fun_class.cc_args app_args CPassive common_defs ai
 				= consumerRequirements app_args common_defs ai
 
-		| glob_module==stdStrictLists_module_n && (not (isEmpty app_args)) && is_nil_cons_or_decons_of_UList_or_UTSList glob_object glob_module imported_funs
-//			&& trace_tn ("consumerRequirements "+++symb_name.id_name+++" "+++toString imported_funs.[glob_module].[glob_object].ft_type.st_arity)
+		| glob_module==stdStrictLists_module_n && (not (isEmpty app_args)) 
+				&& is_nil_cons_or_decons_of_UList_or_UTSList glob_object glob_module imported_funs
 			# [app_arg:app_args]=app_args;
 			# (cc, _, ai) = consumerRequirements app_arg common_defs ai
-			# ai = aiUnifyClassifications cActive cc ai
+			# ai = aiUnifyClassifications CActive cc ai
 			= consumerRequirements app_args common_defs ai
-
 			= consumerRequirements app_args common_defs ai
-	consumerRequirements {app_symb={symb_kind = SK_LocalMacroFunction glob_object, symb_name}, app_args} common_defs=:(ConsumerAnalysisRO {main_dcl_module_n}) ai=:{ai_cons_class/*,ai_main_dcl_module_n*/}
+	consumerRequirements {app_symb={symb_kind = SK_LocalMacroFunction glob_object, symb_name}, app_args}
+			common_defs=:(ConsumerAnalysisRO {main_dcl_module_n})
+			ai=:{ai_cons_class}
 		| glob_object < size ai_cons_class
 			#! fun_class = ai_cons_class.[glob_object]
-			= reqs_of_args fun_class.cc_args app_args cPassive common_defs ai
+			= reqs_of_args fun_class.cc_args app_args CPassive common_defs ai
 			= consumerRequirements app_args common_defs ai
 	consumerRequirements {app_args} common_defs ai
 		=  not_an_unsafe_pattern (consumerRequirements app_args common_defs ai)
@@ -302,7 +314,7 @@ instance consumerRequirements Case where
 		  (ccd, default_is_unsafe, ai) = consumerRequirements case_default common_defs ai
 		  (every_constructor_appears_in_safe_pattern, may_be_active) = inspect_patterns common_defs_parameter has_default case_guards unsafe_bits
 		  safe = (has_default && not default_is_unsafe) || every_constructor_appears_in_safe_pattern
-		  ai = aiUnifyClassifications (if may_be_active cActive cVarOfMultimatchCase) cce ai
+		  ai = aiUnifyClassifications (if may_be_active CActive CVarOfMultimatchCase) cce ai
 		  ai = case case_expr of
 				Var {var_info_ptr}
 					| may_be_active
@@ -313,7 +325,7 @@ instance consumerRequirements Case where
 					OverloadedListPatterns (OverloadedList _ _ _ _) decons_expr=:(App {app_symb={symb_kind=SK_Function _},app_args=[app_arg]}) patterns
 						// decons_expr will be optimized to a decons_u Selector in transform
 						# (cc, _, ai) = consumerRequirements app_arg common_defs ai
-						# ai = aiUnifyClassifications cActive cc ai
+						# ai = aiUnifyClassifications CActive cc ai
 						-> ai
 					OverloadedListPatterns _ decons_expr _
 						# (_,_,ai) = consumerRequirements decons_expr common_defs ai
@@ -424,8 +436,11 @@ consumer_requirements_of_guards (OverloadedListPatterns type _ patterns) common_
 bindPatternVars :: !.[FreeVar] !Int !Int !*VarHeap -> (!Int,!Int,!*VarHeap)
 bindPatternVars [fv=:{fv_info_ptr,fv_count} : vars] next_var next_var_of_fun var_heap
 	| fv_count > 0
-		= bindPatternVars vars (inc next_var) (inc next_var_of_fun) (writePtr fv_info_ptr (VI_AccVar next_var next_var_of_fun) var_heap)
-		= bindPatternVars vars next_var next_var_of_fun (writePtr fv_info_ptr (VI_Count 0 False) var_heap)
+		# var_heap	= writePtr fv_info_ptr (VI_AccVar next_var next_var_of_fun) var_heap
+		= bindPatternVars vars (inc next_var) (inc next_var_of_fun) var_heap
+	// otherwise
+		# var_heap	= writePtr fv_info_ptr (VI_Count 0 False) var_heap
+		= bindPatternVars vars next_var next_var_of_fun var_heap
 bindPatternVars [] next_var next_var_of_fun var_heap
 	= (next_var, next_var_of_fun, var_heap)
 
@@ -434,7 +449,7 @@ independentConsumerRequirements exprs common_defs ai=:{ai_cur_ref_counts}
 // reference counting happens independently for each pattern expression
 	#! s = size ai_cur_ref_counts
 	   zero_array = createArray s 0
-	   (_, cc, r_unsafe_bits ,ai) = foldSt (independent_consumer_requirements common_defs) exprs (zero_array, cPassive, [], ai)
+	   (_, cc, r_unsafe_bits ,ai) = foldSt (independent_consumer_requirements common_defs) exprs (zero_array, CPassive, [], ai)
 	= (cc, reverse r_unsafe_bits, ai)
   where	
 	independent_consumer_requirements common_defs expr (zero_array, cc, unsafe_bits_accu, ai=:{ai_cur_ref_counts})
@@ -450,7 +465,8 @@ independentConsumerRequirements exprs common_defs ai=:{ai_cur_ref_counts}
 		#! i1 = dec i
 		   rc1 = src1.[i1]
 		   rc2 = src2_dest.[i1]
-		= unify_ref_count_arrays i1 src1 { src2_dest & [i1]= unify_ref_counts rc1 rc2} 
+		   src2_dest	= { src2_dest & [i1] = unify_ref_counts rc1 rc2 }
+		= unify_ref_count_arrays i1 src1 src2_dest
 
 	// unify_ref_counts outer_ref_count ref_count_in_pattern
 	unify_ref_counts 0 x = if (x==2) 2 0
@@ -469,7 +485,7 @@ instance consumerRequirements (Optional a) | consumerRequirements a where
 	consumerRequirements (Yes x) common_defs ai
 		= consumerRequirements x common_defs ai
 	consumerRequirements No _ ai
-		= (cPassive, False, ai)
+		= (CPassive, False, ai)
 
 instance consumerRequirements (!a,!b) | consumerRequirements a & consumerRequirements b where
 	consumerRequirements (x, y) common_defs ai
@@ -483,7 +499,7 @@ instance consumerRequirements [a] | consumerRequirements a where
 		  (ccxs, _, ai) = consumerRequirements xs common_defs ai
 		= (combineClasses ccx ccxs, False, ai)
 	consumerRequirements [] _ ai
-		= (cPassive, False, ai)
+		= (CPassive, False, ai)
 
 instance consumerRequirements (Bind a b) | consumerRequirements a where
 	consumerRequirements {bind_src} common_defs ai
@@ -497,14 +513,20 @@ analyseGroups	:: !{# CommonDefs} !{#{#FunType}} !IndexRange !Int !Int !*{! Group
 analyseGroups common_defs imported_funs {ir_from, ir_to} main_dcl_module_n stdStrictLists_module_n groups fun_defs var_heap expr_heap
 	#! nr_of_funs = size fun_defs + ir_from - ir_to /* Sjaak */
 	   nr_of_groups = size groups
-	# consumerAnalysisRO=ConsumerAnalysisRO {common_defs=common_defs,imported_funs=imported_funs,main_dcl_module_n=main_dcl_module_n,stdStrictLists_module_n=stdStrictLists_module_n}
+	# consumerAnalysisRO=ConsumerAnalysisRO
+		{ common_defs				= common_defs
+		, imported_funs				= imported_funs
+		, main_dcl_module_n			= main_dcl_module_n
+		, stdStrictLists_module_n	= stdStrictLists_module_n
+		}
+	# class_env = createArray nr_of_funs { cc_size = 0, cc_args = [], cc_linear_bits = [], cc_producer=False}
 	= iFoldSt (analyse_group consumerAnalysisRO) 0 nr_of_groups
-				([], createArray nr_of_funs { cc_size = 0, cc_args = [], cc_linear_bits = [], cc_producer=False}, groups, fun_defs, var_heap, expr_heap)
+				([], class_env, groups, fun_defs, var_heap, expr_heap)
 where	
 	analyse_group common_defs group_nr (cleanup_info, class_env, groups, fun_defs, var_heap, expr_heap)
 		# ({group_members}, groups) = groups![group_nr]
 		# (nr_of_vars, nr_of_local_vars, var_heap, class_env, fun_defs) = initial_cons_class group_members 0 0 var_heap class_env fun_defs
-		  initial_subst = createArray (nr_of_vars + nr_of_local_vars) cPassive
+		  initial_subst = createArray (nr_of_vars + nr_of_local_vars) CPassive
 		  (ai_cases_of_vars_for_group, ai, fun_defs)
 				 = analyse_functions common_defs group_members []
 						{	ai_var_heap = var_heap,
@@ -562,7 +584,7 @@ where
 			# (VI_AccVar _ arg_position, var_heap) = readPtr var_info_ptr var_heap
 			  ({cc_size, cc_args, cc_linear_bits},class_env) = class_env![fun_index]
 			  (aci_linearity_of_patterns, var_heap) = get_linearity_info cc_linear_bits case_guards var_heap
-			| arg_position<cc_size && (arg_position>=cc_size || cc_args!!arg_position==cActive) && cc_linear_bits!!arg_position
+			| arg_position<cc_size && (arg_position>=cc_size || cc_args!!arg_position==CActive) && cc_linear_bits!!arg_position
 				// mark non multimatch cases whose case_expr is an active linear function argument
 				# aci = { aci_params = [], aci_opt_unfolder = No, aci_free_vars=No, aci_linearity_of_patterns = aci_linearity_of_patterns }
 				= ([case_info_ptr:cleanup_acc], class_env, fun_defs, var_heap, 
diff --git a/frontend/frontend.icl b/frontend/frontend.icl
index e166dee..9ecb140 100644
--- a/frontend/frontend.icl
+++ b/frontend/frontend.icl
@@ -57,7 +57,6 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an
 		= wantModule cWantIclFile mod_ident NoPos options.feo_generics(hash_table /* ---> ("Parsing:", mod_ident)*/) error search_paths modtimefunction files
 	| not ok
 		= (No,{},{},0,0,predef_symbols, hash_table, files, error, io, out, tcl_file, heaps)
-
 	# cached_module_idents = [dcl_mod.dcl_name \\ dcl_mod<-:cached_dcl_modules]
 	# (ok, mod, global_fun_range, mod_functions, optional_dcl_mod, modules, dcl_module_n_in_cache,n_functions_and_macros_in_dcl_modules,hash_table, error, files)
 		= scanModule (mod -*-> "Scanning") cached_module_idents options.feo_generics hash_table error search_paths modtimefunction files
@@ -342,14 +341,16 @@ where
 			= file <<< "-:"
 	
 	show_accumulating_arguments [ cc : ccs] file
-		| cc == cPassive
+		| cc == CPassive
 			= show_accumulating_arguments ccs (file <<< 'p')
-		| cc == cActive
+		| cc == CActive
 			= show_accumulating_arguments ccs (file <<< 'c')
-		| cc == cAccumulating
+		| cc == CAccumulating
 			= show_accumulating_arguments ccs (file <<< 'a')
-		| cc == cVarOfMultimatchCase
+		| cc == CVarOfMultimatchCase
 			= show_accumulating_arguments ccs (file <<< 'm')
+		| cc == CUnused
+			= show_accumulating_arguments ccs (file <<< 'u')
 			= show_accumulating_arguments ccs (file <<< '?')
 	show_accumulating_arguments [] file
 		= file
diff --git a/frontend/trans.icl b/frontend/trans.icl
index 0095497..dfeb053 100644
--- a/frontend/trans.icl
+++ b/frontend/trans.icl
@@ -725,7 +725,7 @@ generate_case_function fun_index case_info_ptr new_expr outer_fun_def outer_cons
 	  cc_linear_bits_from_outer_fun	= [ cons_arg \\ cons_arg <- outer_cons_args.cc_linear_bits & used <- used_mask | used ]
 	  new_cons_args =
 	  			{ cc_size			= fun_arity
-	  			, cc_args			= repeatn nr_of_lifted_vars cPassive ++ cc_args_from_outer_fun
+	  			, cc_args			= repeatn nr_of_lifted_vars CPassive ++ cc_args_from_outer_fun
 	  			, cc_linear_bits	= repeatn nr_of_lifted_vars    False ++ cc_linear_bits_from_outer_fun
 	  			, cc_producer		= False
 	  			}
@@ -1502,7 +1502,7 @@ where
 determine_args [linear_bit : linear_bits] [cons_arg : cons_args] prod_index producers [prod_atype:prod_atypes]
 				[form : forms] input das
 	# das = determine_args linear_bits cons_args (inc prod_index) producers prod_atypes forms input das
-	# producer	= if (cons_arg == cActive) (producers.[prod_index]) PR_Empty
+	# producer	= if (cons_arg == CActive) (producers.[prod_index]) PR_Empty
 	= determine_arg producer prod_atype form prod_index ((linear_bit,cons_arg), input) das
 
 determine_arg
@@ -1567,7 +1567,7 @@ determine_arg (PR_Class class_app free_vars_and_types class_type) _ {fv_info_ptr
 				  			  free_vars_and_types das.das_vars
 		, das_arg_types			= {das_arg_types & [prod_index] = ws_arg_type` }
 		, das_new_linear_bits	= mapAppend (\_ -> True) free_vars_and_types das.das_new_linear_bits
-		, das_new_cons_args		= mapAppend (\_ -> cActive) free_vars_and_types das.das_new_cons_args
+		, das_new_cons_args		= mapAppend (\_ -> CActive) free_vars_and_types das.das_new_cons_args
 		, das_subst				= das_subst
 		, das_type_heaps		= das_type_heaps
 		, das_var_heap			= writeVarInfo fv_info_ptr (VI_Dictionary class_app.app_symb class_app.app_args class_type) das.das_var_heap
@@ -1709,7 +1709,7 @@ where
 		  				cc_producer = False}
 		  			, fun_heap, ti_cons_args)
 			No
-				-> ({cc_size = symbol_arity, cc_args = repeatn symbol_arity cPassive,
+				-> ({cc_size = symbol_arity, cc_args = repeatn symbol_arity CPassive,
 						cc_linear_bits = repeatn symbol_arity linear_bit,
 						cc_producer = False}, fun_heap, ti_cons_args)
 
@@ -2045,7 +2045,7 @@ determineProducers _ _ _ [] _ producers _ ti
 	= (producers, [], ti)
 determineProducers is_applied_to_macro_fun [linear_bit : linear_bits] [ cons_arg : cons_args ] [ arg : args ] prod_index producers ro ti
 	# (producers, new_args, ti) = determineProducers is_applied_to_macro_fun linear_bits cons_args args (inc prod_index) producers ro ti
- 	| cons_arg == cActive
+ 	| cons_arg == CActive
 		= determine_producer is_applied_to_macro_fun linear_bit arg new_args prod_index producers ro ti
 	= (producers, [arg : new_args], ti)
 where
@@ -2912,7 +2912,7 @@ instance producerRequirements Expression where
 						-> check_app_arguments ca.cc_args ca.cc_linear_bits app_args prs
 	where
 		check_app_arguments [cc_arg:cc_args] [cc_linear_bit:cc_bits] [app_arg:app_args] prs
-			| cc_arg == cActive && cc_linear_bit
+			| cc_arg == CActive && cc_linear_bit
 				# (rec,prs)	= is_recursive_app app_arg prs
 				| rec		= (False,prs)
 				# (safe,prs)= producerRequirements app_arg prs