From a56c93345dbd094224be2eae2e6155c984ce299c Mon Sep 17 00:00:00 2001
From: diederik
Date: Mon, 29 Jul 2002 12:34:56 +0000
Subject: fixes for removing unused function arguments

git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@1178 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d
---
 frontend/trans.icl | 44 ++++++++++++++++++++++++++++++++++++--------
 1 file changed, 36 insertions(+), 8 deletions(-)

(limited to 'frontend')

diff --git a/frontend/trans.icl b/frontend/trans.icl
index 30a743d..b68a1fe 100644
--- a/frontend/trans.icl
+++ b/frontend/trans.icl
@@ -1390,6 +1390,8 @@ where
 				-> ([No:type_accu], ti_fun_defs, ti_fun_heap)
 			PR_Class _ _ class_type
 				-> ([No:type_accu], ti_fun_defs, ti_fun_heap)
+			PR_Unused
+				-> ([No:type_accu], ti_fun_defs, ti_fun_heap)
 			producer
 				# (symbol,_) = get_producer_symbol producer
 				  (symbol_type, ti_fun_defs, ti_fun_heap)
@@ -1510,7 +1512,11 @@ 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
+	# producer	= case cons_arg of
+					CActive		-> producers.[prod_index]
+					CUnused		-> producers.[prod_index]
+					_			-> PR_Empty
 	= determine_arg producer prod_atype form prod_index ((linear_bit,cons_arg), input) das
 
 determine_arg
@@ -1527,6 +1533,12 @@ determine_arg PR_Empty _ form=:{fv_name,fv_info_ptr} _ ((linear_bit,cons_arg), _
 		, das_var_heap			= das_var_heap
 		}
 
+determine_arg PR_Unused _ form=:{fv_name,fv_info_ptr} prod_index (_,ro) das=:{das_var_heap}
+	# no_arg_type				= { ats_types= [], ats_strictness = NotStrict }
+	=	{ das
+		& das_arg_types.[prod_index] = no_arg_type
+		}
+
 determine_arg (PR_Class class_app free_vars_and_types class_type) _ {fv_info_ptr,fv_name} prod_index (_,ro)
 			  das=:{das_arg_types, das_subst, das_type_heaps}
 	# (ws_arg_type, das_arg_types)
@@ -1711,16 +1723,28 @@ where
 						-> (No, fun_heap, ti_cons_args)
 		= case opt_cons_classes of
 			Yes cons_classes
-				-> ({ cc_size = symbol_arity, cc_args = take symbol_arity cons_classes.cc_args, 
-		  				cc_linear_bits = if curried (repeatn symbol_arity linear_bit) 
-		  									(take symbol_arity cons_classes.cc_linear_bits),
-		  				cc_producer = False}
+				# cc_args = copy_classes symbol_arity cons_classes.cc_args
+				-> ({ cc_size			= symbol_arity
+					, cc_args			= cc_args
+					, cc_linear_bits	= if curried
+											(repeatn symbol_arity linear_bit)
+											(take symbol_arity cons_classes.cc_linear_bits)
+					, cc_producer		= False
+					}
 		  			, fun_heap, ti_cons_args)
 			No
-				-> ({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)
+				-> ({ 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)
 
+	copy_classes 0 _ = []
+	copy_classes n [cc:ccs]
+		= case cc of
+			CUnused		-> [CActive:copy_classes (dec n) ccs]
+			cc			-> [cc:copy_classes (dec n) ccs]
 
 	build_application_type st_arity nr_context_args st_result st_args nr_of_applied_args
 		| st_arity+nr_context_args==nr_of_applied_args
@@ -1749,6 +1773,8 @@ max_group_index prod_index producers ro_main_dcl_module_n current_max fun_defs f
 where
 	max_group_index_of_producer PR_Empty current_max fun_defs fun_heap cons_args
 		= (current_max, cons_args, fun_defs, fun_heap)
+	max_group_index_of_producer PR_Unused current_max fun_defs fun_heap cons_args
+		= (current_max, cons_args, fun_defs, fun_heap)
 	max_group_index_of_producer (PR_Class {app_args} _ _) current_max fun_defs fun_heap cons_args
 		= foldSt (foldrExprSt max_group_index_of_member) app_args (current_max, cons_args, fun_defs, fun_heap)
 	max_group_index_of_producer (PR_Curried {symb_kind=SK_Function {glob_object=fun_index, glob_module}} _) current_max fun_defs fun_heap cons_args
@@ -3197,6 +3223,8 @@ where
 instance <<< Producer where
 	(<<<) file PR_Empty
 		= file <<< "(E)"
+	(<<<) file PR_Unused
+		= file <<< "(U)"
 	(<<<) file (PR_Function ident int index)
 		= file <<< "(F:" <<< ident <<< ")"
 	(<<<) file (PR_Class app binds type)
-- 
cgit v1.2.3