iterate fusion per component

new recursive fun implementation
use FailExpr for neverMatchingCase
strip and dump commandline args


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

4 files changed, 336 insertions, 172 deletions

diff --git a/frontend/frontend.dcl b/frontend/frontend.dcl
index 171d1c3..cd760bd 100644
--- a/frontend/frontend.dcl
+++ b/frontend/frontend.dcl
@@ -11,6 +11,8 @@ import checksupport, transform, overloading
 	=	{	feo_up_to_phase			:: !FrontEndPhase
 		,	feo_generics 			:: !Bool
 		,	feo_fusion	 			:: !Bool
+		,	feo_dump_core			:: !Bool
+		,	feo_strip_unused		:: !Bool
 		}
 
 :: FrontEndSyntaxTree
diff --git a/frontend/frontend.icl b/frontend/frontend.icl
index bf6f110..56e71ba 100644
--- a/frontend/frontend.icl
+++ b/frontend/frontend.icl
@@ -6,6 +6,8 @@ implementation module frontend
 import scanner, parse, postparse, check, type, trans, convertcases, overloading, utilities, convertDynamics,
 		convertimportedtypes, /*checkKindCorrectness, */ compilerSwitches, analtypes, generics1
 
+//import coredump
+
 //import print
 
 // trace macro
@@ -149,15 +151,6 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an
 	| not ok
 		= (No,{},{},0,main_dcl_module_n,predef_symbols, hash_table, files, error, io, out, tcl_file, heaps)
 
-/*
-	# (components, fun_defs) = partitionateFunctions (fun_defs -*-> "partitionateFunctions") (icl_global_functions++icl_instances ++ [icl_specials] ++ icl_gencases ++ generic_ranges)
-	# (_,f,files) = fopen "components" FWriteText files
-	  (components, fun_defs, f) = showComponents {x\\x<-:components} 0 True fun_defs f
-	  (ok,files) = fclose f files
-	| ok<>ok
-		= abort "";
-*/
-	
 	# (ok, fun_defs, array_instances, type_code_instances, common_defs, imported_funs, type_def_infos, heaps, predef_symbols, error,out)
 		= typeProgram (components -*-> "Typing") main_dcl_module_n fun_defs/*icl_functions*/ icl_specials list_inferred_types icl_common [a\\a<-:icl_import] dcl_mods icl_used_module_numbers td_infos heaps predef_symbols error out dcl_mods
 
@@ -166,11 +159,8 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an
 			
 
 	# (fun_def_size, fun_defs) = usize fun_defs
-	# (components, fun_defs) 	= partitionateFunctions (fun_defs -*-> "partitionateFunctions") (icl_global_functions++icl_instances ++ [icl_specials] ++ icl_gencases ++ generic_ranges)
-		
-//	  (components, fun_defs, error)	= showTypes components 0 fun_defs error
-//	  (components, fun_defs, out)	= showComponents components 0 True fun_defs out
-//	  (fun_defs, error)	= showFunctions array_instances fun_defs error
+	# (components, fun_defs) 	= partitionateFunctions (fun_defs -*-> "partitionateFunctions") 
+									(icl_global_functions++icl_instances ++ [icl_specials] ++ icl_gencases ++ generic_ranges)
 		
 	| options.feo_up_to_phase == FrontEndPhaseTypeCheck
 		=	frontSyntaxTree cached_dcl_macros cached_dcl_mods n_functions_and_macros_in_dcl_modules main_dcl_module_n
@@ -179,16 +169,12 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an
 	# (components, fun_defs, predef_symbols, dcl_types, used_conses_in_dynamics, var_heap, type_heaps, expression_heap, tcl_file)
 	  		= convertDynamicPatternsIntoUnifyAppls type_code_instances common_defs main_dcl_module_n (components -*-> "convertDynamics") fun_defs predef_symbols
 					heaps.hp_var_heap heaps.hp_type_heaps heaps.hp_expression_heap tcl_file dcl_mods icl_mod directly_imported_dcl_modules
-//	#  (components, fun_defs, error) = showComponents3 components 0 False fun_defs error
-//	  (components, fun_defs, error)	= showComponents components 0 True fun_defs error
 
 	| options.feo_up_to_phase == FrontEndPhaseConvertDynamics
 		# heaps = {hp_var_heap=var_heap, hp_type_heaps=type_heaps, hp_expression_heap=expression_heap, hp_generic_heap=newHeap}
 		=	frontSyntaxTree cached_dcl_macros cached_dcl_mods n_functions_and_macros_in_dcl_modules main_dcl_module_n
 							predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs components array_instances heaps
 
-//	  (components, fun_defs, error) = showComponents components 0 True fun_defs error
-
 	#  (stdStrictLists_module_n,predef_symbols) = get_StdStrictLists_module_n predef_symbols
 	  	with
 	  		get_StdStrictLists_module_n predef_symbols
@@ -198,10 +184,48 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an
 					= (-1,predef_symbols)
 	# (cleanup_info, acc_args, components, fun_defs, var_heap, expression_heap)
 		 = analyseGroups common_defs imported_funs array_instances.ali_instances_range main_dcl_module_n stdStrictLists_module_n (components -*-> "Analyse") fun_defs var_heap expression_heap
-//	# (components, fun_defs, error) = showComponents2 components 0 fun_defs acc_args error
 
-	  (components, fun_defs, dcl_types, used_conses, var_heap, type_heaps, expression_heap, acc_args)
-	  	= transformGroups cleanup_info main_dcl_module_n stdStrictLists_module_n (components -*-> "Transform") fun_defs acc_args common_defs imported_funs dcl_types used_conses_in_dynamics type_def_infos var_heap type_heaps expression_heap options.feo_fusion
+	# (def_max, acc_args)		= usize acc_args
+	# (def_min, fun_defs)		= usize fun_defs
+
+	  (components, fun_defs, dcl_types, used_conses, var_heap, type_heaps, expression_heap, acc_args, error, predef_symbols)
+	  	= transformGroups cleanup_info main_dcl_module_n stdStrictLists_module_n def_min def_max (components -*-> "Transform") fun_defs acc_args common_defs imported_funs dcl_types used_conses_in_dynamics type_def_infos var_heap type_heaps expression_heap options.feo_fusion error predef_symbols
+
+	# error_admin = {ea_file = error, ea_loc = [], ea_ok = True }
+	# {dcl_instances,dcl_specials,dcl_gencases} = dcl_mods.[main_dcl_module_n]
+	# (start_rule_index,predef_symbols) = get_index_of_start_rule predef_symbols
+		with
+			get_index_of_start_rule predef_symbols
+				# ({pds_def, pds_module}, predef_symbols) = predef_symbols![PD_Start]
+				| pds_def <> NoIndex && pds_module == main_dcl_module_n
+					= (pds_def, predef_symbols)
+					= (NoIndex, predef_symbols)
+
+	# [icl_exported_global_functions,icl_not_exported_global_functions:_] = icl_global_functions
+	# exported_global_functions = case start_rule_index of
+				NoIndex	-> [icl_exported_global_functions]
+				sri		-> [{ir_from=sri,ir_to=inc sri},icl_exported_global_functions]
+	# exported_functions = exported_global_functions ++  [dcl_instances,dcl_specials,dcl_gencases]
+	# (components, fun_defs, predef_symbols, var_heap, expression_heap, error_admin) 
+		= case options.feo_strip_unused of
+			True -> partitionateFunctions` (fun_defs -*-> "partitionateFunctions`")
+						exported_functions
+						main_dcl_module_n def_min def_max predef_symbols var_heap expression_heap error_admin
+			_ 
+				# (fun_defs,predef_symbols,var_heap,expression_heap,error_admin)
+						= stripStrictLets fun_defs predef_symbols var_heap expression_heap error_admin
+				-> (components, fun_defs, predef_symbols, var_heap, expression_heap, error_admin)
+
+	# error = error_admin.ea_file
+	| not error_admin.ea_ok
+		# heaps = {hp_var_heap=var_heap, hp_type_heaps=type_heaps, hp_expression_heap=expression_heap,hp_generic_heap=heaps.hp_generic_heap}
+		= (No,{},{},0,main_dcl_module_n,predef_symbols, hash_table, files, error, io, out, tcl_file, heaps)
+
+	# (components,fun_defs,files) = case options.feo_dump_core of
+//		True
+//			-> dumpCore components start_rule_index exported_global_functions icl_mod dcl_mods.[main_dcl_module_n] fun_defs acc_args def_min def_max files
+		_
+			-> (components,fun_defs,files)
 
 	| options.feo_up_to_phase == FrontEndPhaseTransformGroups
 		# heaps = {hp_var_heap=var_heap, hp_type_heaps=type_heaps, hp_expression_heap=expression_heap,hp_generic_heap=heaps.hp_generic_heap}
@@ -302,54 +326,6 @@ where
 			= show_component funs show_types fun_defs (file <<< fun_def)
 //		= show_component funs show_types fun_defs (file <<< fun_def.fun_symb)
 
-showComponents2 :: !*{! Group} !Int !*{# FunDef} !{! ConsClasses} !*File  -> (!*{! Group},!*{# FunDef},!*File)
-showComponents2 comps comp_index fun_defs acc_args file
-	| comp_index >= (size comps)
-		= (comps, fun_defs, file)
-	# (comp, comps) = comps![comp_index]
-	# (fun_defs, file) = show_component comp.group_members fun_defs acc_args file
-	= showComponents2 comps (inc comp_index) fun_defs acc_args file
-where
-	show_component [] fun_defs _ file
-		= (fun_defs, file <<< '\n')
-	show_component [fun:funs] fun_defs acc_args file
-		# (fd, fun_defs) = fun_defs![fun]
-		| fun >= size acc_args
-			# file = file <<< fd.fun_symb <<< '.' <<< fun <<< " ???"
-			= show_component funs fun_defs acc_args file
-		# file = file <<< fd.fun_symb <<< '.' <<< fun <<< " ("
-		# file = show_producer_status acc_args.[fun].cc_producer file
-		# file = show_accumulating_arguments acc_args.[fun].cc_args file
-		# file = show_linear_arguments acc_args.[fun].cc_linear_bits file
-		= show_component funs fun_defs acc_args (file <<< ") ")
-	
-	show_producer_status pc file
-		| pc == True
-			= file <<< "+:"
-			= file <<< "-:"
-	
-	show_accumulating_arguments [ cc : ccs] file
-		| cc == CPassive
-			= show_accumulating_arguments ccs (file <<< 'p')
-		| cc == CActive
-			= show_accumulating_arguments ccs (file <<< 'c')
-		| cc == CAccumulating
-			= show_accumulating_arguments ccs (file <<< 'a')
-		| 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
-
-	show_linear_arguments [ cc : ccs] file
-		| cc == True
-			= show_linear_arguments ccs (file <<< 'l')
-			= show_linear_arguments ccs (file <<< 'n')
-	show_linear_arguments [] file
-		= file
-
 //show_components comps fun_defs = map (show_component fun_defs) comps
 
 show_component fun_defs [] = []
@@ -408,4 +384,3 @@ instance == ListTypesKind where
 		=	True
 	(==) _ _
 		=	False
-		  			
\ No newline at end of file
diff --git a/frontend/trans.dcl b/frontend/trans.dcl
index d23c9ff..796892a 100644
--- a/frontend/trans.dcl
+++ b/frontend/trans.dcl
@@ -5,9 +5,9 @@ import StdEnv
 import syntax, transform
 import classify, partition
 
-transformGroups :: !CleanupInfo !Int !Int !*{! Group} !*{#FunDef} !*{!.ConsClasses} !{# CommonDefs}  !{# {# FunType} }
-					!*ImportedTypes !ImportedConstructors !*TypeDefInfos !*VarHeap !*TypeHeaps !*ExpressionHeap !Bool
-				-> (!*{! Group}, !*{#FunDef}, !*ImportedTypes, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap, !*{!ConsClasses})
+transformGroups :: !CleanupInfo !Int !Int !Int !Int !*{!Group} !*{#FunDef} !*{!.ConsClasses} !{# CommonDefs}  !{# {# FunType} }
+		!*ImportedTypes !ImportedConstructors !*TypeDefInfos !*VarHeap !*TypeHeaps !*ExpressionHeap !Bool !*File !*PredefinedSymbols
+			-> (!*{!Group}, !*{#FunDef}, !*ImportedTypes, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap, !*{!ConsClasses}, !*File, !*PredefinedSymbols)
 
 convertSymbolType :: !Bool !{# CommonDefs} !SymbolType !Int !*ImportedTypes !ImportedConstructors !*TypeHeaps !*VarHeap 
 	-> (!SymbolType, !*ImportedTypes, !ImportedConstructors, !*TypeHeaps, !*VarHeap)
diff --git a/frontend/trans.icl b/frontend/trans.icl
index ff5728a..33e0c8b 100644
--- a/frontend/trans.icl
+++ b/frontend/trans.icl
@@ -8,18 +8,32 @@ import StdEnv
 import syntax, transform, checksupport, StdCompare, check, utilities, unitype, typesupport, type
 import classify, partition
 
-SwitchCaseFusion			fuse dont_fuse :== dont_fuse // fuse
+SwitchCaseFusion			fuse dont_fuse :== fuse
 SwitchGeneratedFusion		fuse dont_fuse :== fuse
 SwitchFunctionFusion		fuse dont_fuse :== fuse
-SwitchConstructorFusion		fuse dont_fuse :== dont_fuse // fuse
-SwitchCurriedFusion			fuse dont_fuse :== fuse
+SwitchConstructorFusion		fuse dont_fuse :== dont_fuse
+SwitchRnfConstructorFusion  rnf  linear	   :== rnf
+SwitchCurriedFusion			fuse xtra dont_fuse :== fuse //&& xtra
+SwitchExtraCurriedFusion	fuse dont_fuse :== fuse//dont_fuse
 SwitchTrivialFusion			fuse dont_fuse :== fuse
 SwitchUnusedFusion			fuse dont_fuse :== fuse
-SwitchTransformConstants	tran dont_tran :== dont_tran // can argue that if you want constant functions to be inlined you should define them as a macro
+SwitchReanalyseFunction		rean dont_rean :== dont_rean
+SwitchTransformConstants	tran dont_tran :== tran
 SwitchSpecialFusion			fuse dont_fuse :== fuse
+SwitchArityChecks			check dont_check :== check
+SwitchNWayFusion			fuse dont_fuse :== dont_fuse//fuse
+SwitchDirectConsumerUnfold	unfold dont    :== dont//unfold
+SwitchAutoFoldCaseInCase	fold dont	   :== fold
+SwitchAutoFoldAppInCase		fold dont	   :== fold
+SwitchAlwaysIntroduceCaseFunction yes no   :== yes
+SwitchNonRecFusion			fuse dont_fuse :== dont_fuse
+SwitchHOFusion				fuse dont_fuse :== fuse
+SwitchHOFusion`				fuse dont_fuse :== fuse
 
 (-!->) infix
-(-!->) a b :== a // ---> b
+(-!->) a b :== a  // ---> b
+(<-!-) infix
+(<-!-) a b :== a  // <--- b
 
 fromYes (Yes x) = x
 
@@ -109,20 +123,22 @@ cleanup_attributes expr_info_ptr symbol_heap
  *	TRANSFORM
  */
 
-::	TransformInfo =
-	{	ti_fun_defs				:: !.{# FunDef}
-	,	ti_instances 			:: !.{! InstanceInfo }
-	,	ti_cons_args 			:: !.{! ConsClasses}
+::	*TransformInfo =
+	{	ti_fun_defs				:: !*{# FunDef}
+	,	ti_instances 			:: !*{! InstanceInfo }
+	,	ti_cons_args 			:: !*{! ConsClasses}
 	,	ti_new_functions 		:: ![FunctionInfoPtr]
-	,	ti_fun_heap				:: !.FunctionHeap
-	,	ti_var_heap				:: !.VarHeap
-	,	ti_symbol_heap			:: !.ExpressionHeap
-	,	ti_type_heaps			:: !.TypeHeaps
-	,	ti_type_def_infos		:: !.TypeDefInfos
+	,	ti_fun_heap				:: !*FunctionHeap
+	,	ti_var_heap				:: !*VarHeap
+	,	ti_symbol_heap			:: !*ExpressionHeap
+	,	ti_type_heaps			:: !*TypeHeaps
+	,	ti_type_def_infos		:: !*TypeDefInfos
 	,	ti_next_fun_nr			:: !Index
 	,	ti_cleanup_info			:: !CleanupInfo
 	,	ti_recursion_introduced	:: !Optional Index
 //	,	ti_trace				:: !Bool // XXX just for tracing
+	,	ti_error_file			:: !*File
+	,	ti_predef_symbols		:: !*PredefinedSymbols
 	}
 
 ::	ReadOnlyTI = 
@@ -133,6 +149,7 @@ cleanup_attributes expr_info_ptr symbol_heap
 	,	ro_fun_root				:: !SymbIdent		// original function
 	,	ro_fun_case				:: !SymbIdent		// original function or possibly generated case
 	,	ro_fun_args				:: ![FreeVar]		// args of above
+	,	ro_fun_orig				:: !SymbIdent		// original consumer
 
 	,	ro_main_dcl_module_n 	:: !Int
 
@@ -143,12 +160,20 @@ cleanup_attributes expr_info_ptr symbol_heap
 
 ::	RootCaseMode = NotRootCase | RootCase | RootCaseOfZombie
 
-neverMatchingCase = { case_expr = EE, case_guards = NoPattern, case_default = No, case_ident = No, case_info_ptr = nilPtr, 
+neverMatchingCase (Yes ident)
+	# ident = ident -!-> ("neverMatchingCase",ident)
+	= FailExpr ident
+neverMatchingCase _ 
+	# ident = {id_name = "neverMatchingCase", id_info = nilPtr}  -!-> "neverMatchingCase without ident\n"
+	= FailExpr ident
+/*
+	= Case { case_expr = EE, case_guards = NoPattern, case_default = No, case_ident = ident, case_info_ptr = nilPtr, 
 // RWS ...
 						case_explicit = False,
+				//		case_explicit = True,	// DvA better?
 // ... RWS
 						case_default_pos = NoPos }
-
+*/
 class transform a :: !a !ReadOnlyTI !*TransformInfo -> (!a, !*TransformInfo)
 
 instance transform Expression
@@ -272,7 +297,7 @@ transformCase this_case=:{case_expr,case_guards,case_default,case_ident,case_inf
 									_			-> transCase True (Yes aci) this_case ro ti
 							_	-> transCase False No this_case ro ti
 	  ti = { ti & ti_symbol_heap = remove_aci_free_vars_info case_info_ptr ti.ti_symbol_heap }
-	= (removeNeverMatchingSubcases result_expr, ti)
+	= (removeNeverMatchingSubcases result_expr ro, ti)
 where
 	is_variable (Var _) = True
 	is_variable _ 		= False
@@ -366,7 +391,11 @@ transCase is_active opt_aci this_case=:{case_expr = (App app=:{app_symb,app_args
 				Yes match_expr
 					-> (match_expr, ti)
 				No
-					-> (Case neverMatchingCase, ti)
+					-> (neverMatchingCase never_ident, ti) <-!- ("transCase:App:neverMatchingCase",never_ident)
+					with
+						never_ident = case ro.ro_root_case_mode of
+							NotRootCase -> this_case.case_ident
+							_ -> Yes ro.ro_fun_case.symb_name
 		// otherwise it's a function application
 		_	-> case opt_aci of
 				Yes aci=:{ aci_params, aci_opt_unfolder }
@@ -385,9 +414,15 @@ transCase is_active opt_aci this_case=:{case_expr = (App app=:{app_symb,app_args
 											# (ro_fun=:{symb_kind=SK_GeneratedFunction fun_info_ptr _}) = ro.ro_fun_case
 											-> (inc ti_next_fun_nr,
 											    { ro_fun & symb_kind=SK_GeneratedFunction fun_info_ptr ti_next_fun_nr })
+												-!-> ("Recursion","RootCaseOfZombie",ti_next_fun_nr,ti.ti_recursion_introduced)
 										RootCase
 											-> (ti_next_fun_nr, ro.ro_fun_root)
-							  ti = { ti & ti_next_fun_nr = new_next_fun_nr, ti_recursion_introduced = Yes ti_next_fun_nr }
+												-!-> ("Recursion","RootCase",ti_next_fun_nr,ro.ro_fun_root,ti.ti_recursion_introduced)
+							  ti = case ro.ro_root_case_mode of
+										RootCaseOfZombie
+											-> { ti & ti_next_fun_nr = new_next_fun_nr, ti_recursion_introduced = Yes ti_next_fun_nr }
+										RootCase
+											-> { ti & ti_next_fun_nr = new_next_fun_nr, ti_recursion_introduced = No }
 							  app_args1 = replace_arg [ fv_info_ptr \\ {fv_info_ptr}<-aci_params ] app_args variables
 							  (app_args2, ti) = transform app_args1 { ro & ro_root_case_mode = NotRootCase } ti
 							-> (App {app_symb=app_symb, app_args=app_args2, app_info_ptr=nilPtr}, ti)
@@ -495,7 +530,11 @@ transCase is_active opt_aci this_case=:{case_expr = (BasicExpr basic_value),case
 	| isEmpty may_be_match_pattern
 		= case case_default of
 			Yes default_expr-> transform default_expr { ro & ro_root_case_mode = NotRootCase } ti
-			No				-> (Case neverMatchingCase, ti)
+			No				-> (neverMatchingCase never_ident, ti) <-!- ("transCase:BasicExpr:neverMatchingCase",never_ident)
+					with
+						never_ident = case ro.ro_root_case_mode of
+							NotRootCase -> this_case.case_ident
+							_ -> Yes ro.ro_fun_case.symb_name
 	= transform (hd may_be_match_pattern).bp_expr { ro & ro_root_case_mode = NotRootCase } ti
 where
 	getBasicPatterns (BasicPatterns _ basicPatterns)
@@ -554,6 +593,7 @@ possibly_generate_case_function kees=:{case_info_ptr} aci=:{aci_free_vars} ro ti
 	  		= { id_name = ro.ro_fun_root.symb_name.id_name+++"_case", id_info = nilPtr }
 	  fun_symb
 	  		= { symb_name = fun_ident, symb_kind=SK_GeneratedFunction fun_info_ptr undeff }
+	  			<-!- ("<<<transformCaseFunction",fun_ident)
 	  new_ro
 	  		= { ro & ro_root_case_mode = RootCaseOfZombie , ro_fun_case = fun_symb, ro_fun_args = all_args }
 	  ti
@@ -562,6 +602,7 @@ possibly_generate_case_function kees=:{case_info_ptr} aci=:{aci_free_vars} ro ti
 	  		= transformCase kees new_ro ti
 	  (ti_recursion_introduced, ti)
 	  		= ti!ti_recursion_introduced
+	  			<-!- ("transformCaseFunction>>>",fun_ident)
 	  ti	= { ti & ti_recursion_introduced = old_ti_recursion_introduced }
 	= case ti_recursion_introduced of
 		Yes fun_index
@@ -668,8 +709,8 @@ where
 	free_var_to_bound_var {fv_name, fv_info_ptr}
 		= Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = nilPtr}
 
-removeNeverMatchingSubcases :: Expression -> Expression
-removeNeverMatchingSubcases keesExpr=:(Case kees)
+removeNeverMatchingSubcases :: Expression !.ReadOnlyTI -> Expression
+removeNeverMatchingSubcases keesExpr=:(Case kees) ro
 	// remove those case guards whose right hand side is a never matching case
 	| is_never_matching_case keesExpr
 		= keesExpr
@@ -681,7 +722,7 @@ removeNeverMatchingSubcases keesExpr=:(Case kees)
 				-> keesExpr // frequent case: all subexpressions can't fail
 			# filtered_case_guards = filter (not o is_never_matching_case o get_alg_rhs) alg_patterns
 			| has_become_never_matching filtered_default filtered_case_guards
-				-> Case neverMatchingCase
+				-> neverMatchingCase never_ident <-!- ("removeNeverMatchingSubcases:AlgebraicPatterns:neverMatchingCase",never_ident)
 			| is_default_only filtered_default filtered_case_guards
 				-> fromYes case_default
 			-> Case {kees & case_guards = AlgebraicPatterns i filtered_case_guards, case_default = filtered_default }
@@ -690,7 +731,7 @@ removeNeverMatchingSubcases keesExpr=:(Case kees)
 				-> keesExpr // frequent case: all subexpressions can't fail
 			# filtered_case_guards = filter (not o is_never_matching_case o get_basic_rhs) basic_patterns
 			| has_become_never_matching filtered_default filtered_case_guards
-				-> Case neverMatchingCase
+				-> neverMatchingCase never_ident <-!- ("removeNeverMatchingSubcases:BasicPatterns:neverMatchingCase",never_ident)
 			| is_default_only filtered_default filtered_case_guards
 				-> fromYes case_default
 			-> Case {kees & case_guards = BasicPatterns bt filtered_case_guards, case_default = filtered_default }
@@ -699,7 +740,7 @@ removeNeverMatchingSubcases keesExpr=:(Case kees)
 				-> keesExpr // frequent case: all subexpressions can't fail
 			# filtered_case_guards = filter (not o is_never_matching_case o get_alg_rhs) alg_patterns
 			| has_become_never_matching filtered_default filtered_case_guards
-				-> Case neverMatchingCase
+				-> neverMatchingCase never_ident <-!- ("removeNeverMatchingSubcases:OverloadedListPatterns:neverMatchingCase",never_ident)
 			| is_default_only filtered_default filtered_case_guards
 				-> fromYes case_default
 			-> Case {kees & case_guards = OverloadedListPatterns i decons_expr filtered_case_guards, case_default = filtered_default }
@@ -725,7 +766,10 @@ where
 		= False
 	is_never_matching_default (Yes expr)
 		= is_never_matching_case expr
-removeNeverMatchingSubcases expr
+	never_ident = case ro.ro_root_case_mode of
+		NotRootCase -> kees.case_ident
+		_ -> Yes ro.ro_fun_case.symb_name
+removeNeverMatchingSubcases expr ro
 	= expr
 
 	
@@ -1183,14 +1227,17 @@ generateFunction fd=:{fun_body = TransformedBody {tb_args,tb_rhs},fun_info = {fi
 	  		= unfold tb_rhs ui us
 //	| False ---> ("unfolded:", tb_rhs) = undef
 	# ro_fun= { symb_name = fd.fun_symb, symb_kind = SK_GeneratedFunction fun_def_ptr ti_next_fun_nr }
-	# ro 	=	{ ro &	ro_root_case_mode = case tb_rhs of 
+	# ro_root_case_mode = case tb_rhs of 
 	  						Case _
 	  							-> RootCase
-	  						_	-> NotRootCase,
+	  						_	-> NotRootCase
+	# ro 	=	{ ro &	ro_root_case_mode = ro_root_case_mode,
 						ro_fun_root = ro_fun,
 						ro_fun_case = ro_fun,
 						ro_fun_args = new_fun_args
 				}
+//	| False ---> ("transform generated function:",ti_next_fun_nr,ro_root_case_mode)		= undef
+//	| False -!-> ("transforming new function:",ti_next_fun_nr)		= undef
 //	| False -!-> ("transforming new function:",tb_rhs)		= undef
 	# ti
 			= { ti & ti_var_heap = us_var_heap, ti_fun_heap = ti_fun_heap, ti_symbol_heap = us_symbol_heap,
@@ -1341,8 +1388,6 @@ where
 			No
 				-> (subst, coercions, ti_type_def_infos, ti_type_heaps)
 
-// expand_type converts 'pointer' type representation to 'integer' type representation
-// inverse of class replaceIntegers?
 	expand_type ro_common_defs cons_vars atype (coercions, subst, ti_type_heaps, ti_type_def_infos)
 		| is_dictionary atype ti_type_def_infos
 			# (_, atype, subst) = arraySubst atype subst
@@ -2195,7 +2240,7 @@ transformApplication app=:{app_symb=symb=:{symb_kind}, app_args} extra_args
 					= (App { app & app_args = app_args ++ extra_args}, ti)
 
 		| glob_module==ro.ro_stdStrictLists_module_n && is_cons_or_decons_of_UList_or_UTSList glob_object glob_module ro.ro_imported_funs && (not (isEmpty app_args))
-//			&& trace_tn ("transformApplication "+++toString symb.symb_name)
+//			&& True ---> ("transformApplication "+++toString symb.symb_name)
 			# {ft_type} = ro.ro_imported_funs.[glob_module].[glob_object] // type of cons instance of instance List [#] a | U(TS)List a
 			# [{tc_class=TCClass {glob_module,glob_object={ds_index}}}:_] = ft_type.st_context			
 			# member_n=find_member_n 0 symb.symb_name.id_name ro.ro_common_defs.[glob_module].com_class_defs.[ds_index].class_members
@@ -2404,7 +2449,7 @@ determineProducer is_applied_to_macro_fun consumer_is_curried linear_bit app=:{a
 		| is_applied_to_macro_fun
 			= ({ producers & [prod_index] = PR_Curried symb (length app_args)}, app_args ++ new_args, ti)
 				-!-> ("Produce1cc_macro",symb.symb_name)
-		| SwitchCurriedFusion (ro.ro_transform_fusion && cc_producer) False
+		| SwitchCurriedFusion ro.ro_transform_fusion cc_producer False
 			= ({ producers & [prod_index] = PR_Curried symb (length app_args)}, app_args ++ new_args, ti)
 				-!-> ("Produce1cc_curried",symb.symb_name)
 		= (producers, [App app : new_args ], ti)
@@ -2441,7 +2486,7 @@ determineProducer is_applied_to_macro_fun consumer_is_curried linear_bit app=:{a
 				= ({ producers & [prod_index] = PR_Curried symb (length app_args)}, app_args ++ new_args, ti)
 					-!-> ("Produce2cc_macro",symb.symb_name)
 			# ({cc_producer},ti) = ti!ti_cons_args.[glob_object]
-			| SwitchCurriedFusion (ro.ro_transform_fusion && cc_producer) False
+			| SwitchCurriedFusion ro.ro_transform_fusion cc_producer False
 				= ({ producers & [prod_index] = PR_Curried symb (length app_args)}, app_args ++ new_args, ti)
 					-!-> ("Produce2cc_curried",symb.symb_name)
 			= (producers, [App app : new_args ], ti)
@@ -2634,11 +2679,11 @@ add_let_binds free_vars rhss original_binds
 
 //@	transformGroups
 
-transformGroups :: !CleanupInfo !Int !Int !*{! Group} !*{#FunDef} !*{!.ConsClasses} !{# CommonDefs}  !{# {# FunType} }
-		!*ImportedTypes !ImportedConstructors !*TypeDefInfos !*VarHeap !*TypeHeaps !*ExpressionHeap !Bool
-			-> (!*{! Group}, !*{#FunDef}, !*ImportedTypes, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap, !*{!ConsClasses})
-transformGroups cleanup_info main_dcl_module_n stdStrictLists_module_n groups fun_defs cons_args common_defs imported_funs
-		imported_types collected_imports type_def_infos var_heap type_heaps symbol_heap compile_with_fusion
+transformGroups :: !CleanupInfo !Int !Int !Int !Int !*{!Group} !*{#FunDef} !*{!.ConsClasses} !{# CommonDefs}  !{# {# FunType} }
+		!*ImportedTypes !ImportedConstructors !*TypeDefInfos !*VarHeap !*TypeHeaps !*ExpressionHeap !Bool !*File !*PredefinedSymbols
+			-> (!*{!Group}, !*{#FunDef}, !*ImportedTypes, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap, !*{!ConsClasses}, !*File, !*PredefinedSymbols)
+transformGroups cleanup_info main_dcl_module_n stdStrictLists_module_n def_min def_max groups fun_defs cons_args common_defs imported_funs
+		imported_types collected_imports type_def_infos var_heap type_heaps symbol_heap compile_with_fusion error predef_symbols
 	#! nr_of_funs = size fun_defs
 	# initial_ti =
 				{ ti_fun_defs		= fun_defs
@@ -2653,62 +2698,199 @@ transformGroups cleanup_info main_dcl_module_n stdStrictLists_module_n groups fu
 				, ti_next_fun_nr	= nr_of_funs
 				, ti_cleanup_info	= cleanup_info
 				, ti_recursion_introduced	= No
+				, ti_error_file		= error
+				, ti_predef_symbols	= predef_symbols
 				}
+	# groups = [group \\ group <-: groups]
 	# (groups, imported_types, collected_imports, fun_indices_with_abs_syn_types, ti)
-		= transform_groups 0 groups common_defs imported_funs imported_types collected_imports [] initial_ti
-	  {ti_fun_defs,ti_new_functions,ti_var_heap,ti_symbol_heap,ti_fun_heap,ti_next_fun_nr,ti_type_heaps,ti_cleanup_info,ti_cons_args} = ti
+		= transform_groups 0 groups [] common_defs imported_funs imported_types collected_imports [] initial_ti
+	# groups = {group \\ group <- reverse groups}
 
+	  {ti_fun_defs,ti_new_functions,ti_var_heap,ti_symbol_heap,ti_fun_heap,ti_next_fun_nr,ti_type_heaps,ti_cleanup_info} = ti
 	# (fun_defs, imported_types, collected_imports, type_heaps, var_heap) 
 			= foldSt (expand_abstract_syn_types_in_function_type common_defs) (reverse fun_indices_with_abs_syn_types)
 					(ti_fun_defs, imported_types, collected_imports, ti_type_heaps, ti_var_heap)
 
-	  (groups, new_fun_defs, imported_types, collected_imports, type_heaps, var_heap) 
+	  (groups, new_fun_defs, new_cons_classes, imported_types, collected_imports, type_heaps, var_heap) 
 	  		= foldSt (add_new_function_to_group common_defs ti_fun_heap) ti_new_functions
-	  				(groups, [], imported_types, collected_imports, type_heaps, var_heap)
-	  symbol_heap = foldSt cleanup_attributes ti_cleanup_info ti_symbol_heap
+	  				(groups, [], [], imported_types, collected_imports, type_heaps, var_heap)
+	  symbol_heap = foldSt cleanup_attributes ti.ti_cleanup_info ti.ti_symbol_heap
 	  fun_defs = { fundef \\ fundef <- [ fundef \\ fundef <-: fun_defs ] ++ new_fun_defs }
-	= (groups, fun_defs, imported_types, collected_imports,	var_heap, type_heaps, symbol_heap, ti_cons_args)
+	  cons_args	= { consarg \\ consarg <- [ consarg \\ consarg <-: ti.ti_cons_args ] ++ new_cons_classes }
+	= (groups, fun_defs, imported_types, collected_imports,	var_heap, type_heaps, symbol_heap, cons_args, ti.ti_error_file, ti.ti_predef_symbols)
 where
-	transform_groups group_nr groups common_defs imported_funs imported_types collected_imports fun_indices_with_abs_syn_types ti
-		| group_nr < size groups
-			# (group, groups) = groups![group_nr]
+	transform_groups group_nr [] acc_groups common_defs imported_funs imported_types collected_imports fun_indices_with_abs_syn_types ti
+		= (acc_groups, imported_types, collected_imports, fun_indices_with_abs_syn_types, ti)
+	transform_groups group_nr [group:groups] acc_groups common_defs imported_funs imported_types collected_imports fun_indices_with_abs_syn_types ti
 			# {group_members} = group
 			# (ti_fun_defs, imported_types, collected_imports, fun_indices_with_abs_syn_types, ti_type_heaps, ti_var_heap) 
 					= foldSt (convert_function_type common_defs) group_members
 							(ti.ti_fun_defs, imported_types, collected_imports, fun_indices_with_abs_syn_types, ti.ti_type_heaps, ti.ti_var_heap)
 			# ti = { ti & ti_fun_defs = ti_fun_defs, ti_type_heaps = ti_type_heaps, ti_var_heap = ti_var_heap }
+			# (group_nr,acc_groups,ti) = transform_group common_defs imported_funs group_nr group_members acc_groups ti
+			= transform_groups group_nr groups acc_groups common_defs imported_funs imported_types collected_imports fun_indices_with_abs_syn_types ti
+
+	transform_groups` common_defs imported_funs group_nr [] acc_groups ti
+			= (group_nr, acc_groups, ti)
+	transform_groups` common_defs imported_funs group_nr [{group_members}:groups] acc_groups ti
+			# (group_nr,acc_groups,ti) = transform_group common_defs imported_funs group_nr group_members acc_groups ti
+			= transform_groups` common_defs imported_funs group_nr groups acc_groups ti
+	
+	transform_group common_defs imported_funs group_nr group_members acc_groups ti
+			// assign group_nr to group_members
+			# ti = ti <-!- ("transform_group",group_nr)
+			# ti = foldSt (assign_group group_nr) group_members ti
+			// store old consumer classification			
+			# (before,ti) = ti!ti_next_fun_nr
+			// transform group_members
 			# ti = foldSt (transform_function common_defs imported_funs) group_members ti
-			# ti = reannotate_producers group_nr (group_members -!-> ("reannotate_producers",group_nr)) ti
-			= transform_groups (inc  group_nr) groups common_defs imported_funs imported_types collected_imports fun_indices_with_abs_syn_types ti
-			= (groups, imported_types, collected_imports, fun_indices_with_abs_syn_types, ti)
+			// partitionate group: need to know added functions for this...
+			# (after,ti) = ti!ti_next_fun_nr
+			# (new_groups,ti) = partition_group group_nr (group_members++[before..after-1]) ti
+			// reanalyse consumers
+			# (cleanup,ti_fun_defs,ti_var_heap,ti_symbol_heap,ti_fun_heap,ti_cons_args,same)
+					= reanalyseGroups common_defs imported_funs main_dcl_module_n stdStrictLists_module_n ti.ti_new_functions
+						new_groups
+						ti.ti_fun_defs ti.ti_var_heap ti.ti_symbol_heap ti.ti_fun_heap ti.ti_cons_args
+			# ti = {ti 
+					& ti_cleanup_info = cleanup ++ ti.ti_cleanup_info
+					, ti_fun_defs = ti_fun_defs
+					, ti_var_heap = ti_var_heap
+					, ti_symbol_heap = ti_symbol_heap
+					, ti_fun_heap = ti_fun_heap
+					, ti_cons_args = ti_cons_args
+					}
+			// if wanted reapply transform_group to all found groups
+			| (after>before) || (length new_groups > 1) || not same
+				= transform_groups` common_defs imported_funs group_nr new_groups acc_groups ti
+			// producer annotation for finished components!
+			# ti = reannotate_producers group_nr group_members ti
+			= (inc group_nr,(reverse new_groups)++acc_groups,ti)
+	
+	changed_group_classification [] ti
+		= (False,ti)
+	changed_group_classification [fun:funs] ti
+		= (False,ti)
+	
+	assign_group group_number fun ti
+		# (fd,ti)		= get_fun_def fun ti
+		# fd			= { fd & fun_info.fi_group_index = group_number }
+		# ti			= set_fun_def fun fd ti
+		= ti
+	
+	get_fun_def fun ti=:{ti_fun_defs}
+		| fun < size ti_fun_defs
+			# (fun_def, ti)						= ti!ti_fun_defs.[fun]
+			= (fun_def,ti)
+		# (fun_def_ptr,ti_fun_heap)			= lookup_ptr fun ti.ti_new_functions ti.ti_fun_heap
+			with
+				lookup_ptr fun [] ti_fun_heap = abort "drat"
+				lookup_ptr fun [fun_def_ptr:new_functions] ti_fun_heap
+					# (FI_Function {gf_fun_index}, ti_fun_heap)
+							= readPtr fun_def_ptr ti_fun_heap
+					| gf_fun_index == fun
+						= (fun_def_ptr, ti_fun_heap)
+						= lookup_ptr fun new_functions ti_fun_heap
+		# (FI_Function {gf_fun_def}, ti_fun_heap)
+											= readPtr fun_def_ptr ti_fun_heap
+		  ti								= { ti & ti_fun_heap = ti_fun_heap }
+		= (gf_fun_def,ti)
 
-	transform_function common_defs imported_funs fun ti=:{ti_fun_defs, ti_var_heap}
-		# (fun_def, ti_fun_defs) = ti_fun_defs![fun]
-		  (Yes {st_args}) = fun_def.fun_type
+	set_fun_def fun fun_def ti=:{ti_fun_defs}
+		| fun < size ti_fun_defs
+			= {ti & ti_fun_defs.[fun] = fun_def}
+		# (fun_def_ptr,ti_fun_heap)			= lookup_ptr fun ti.ti_new_functions ti.ti_fun_heap
+			with
+				lookup_ptr fun [] ti_fun_heap = abort "drat"
+				lookup_ptr fun [fun_def_ptr:new_functions] ti_fun_heap
+					# (FI_Function {gf_fun_index}, ti_fun_heap)
+							= readPtr fun_def_ptr ti_fun_heap
+					| gf_fun_index == fun
+						= (fun_def_ptr, ti_fun_heap)
+						= lookup_ptr fun new_functions ti_fun_heap
+		# (FI_Function gf, ti_fun_heap)
+											= readPtr fun_def_ptr ti_fun_heap
+		# ti_fun_heap						= writePtr fun_def_ptr (FI_Function {gf & gf_fun_def = fun_def}) ti_fun_heap
+		  ti								= { ti & ti_fun_heap = ti_fun_heap }
+		= ti
+	
+	partition_group group_nr group_members ti
+		# fun_defs = ti.ti_fun_defs
+		# fun_heap = ti.ti_fun_heap
+		# max_fun_nr = ti.ti_next_fun_nr
+		# new_functions = ti.ti_new_functions
+		# main_dcl_module_n = main_dcl_module_n
+		# next_group = group_nr
+		# predef_symbols = ti.ti_predef_symbols
+		# var_heap = ti.ti_var_heap
+		# expression_heap = ti.ti_symbol_heap
+		# error_admin = {ea_file = ti.ti_error_file, ea_loc = [], ea_ok = True }
+		# (_,groups,fun_defs,fun_heap,predef_symbols,var_heap,expression_heap,error_admin)
+			= partitionateFunctions`` max_fun_nr next_group new_functions fun_defs group_members main_dcl_module_n def_min def_max fun_heap predef_symbols var_heap expression_heap error_admin
+		# ti = 
+			{ ti
+			& ti_fun_defs		= fun_defs
+			, ti_fun_heap		= fun_heap
+			, ti_predef_symbols	= predef_symbols
+			, ti_var_heap		= var_heap
+			, ti_symbol_heap	= expression_heap
+			, ti_error_file		= error_admin.ea_file
+			}
+		= (groups,ti)
+		
+	transform_function common_defs imported_funs fun ti
+		# (fun_def, ro_fun, ti)	= get_fun_def_and_symb_ident fun ti
+		# ti = ti <-!- ("transform_function",fun,ro_fun,fun_def)
+		# (Yes {st_args})					= fun_def.fun_type
 		  {fun_body = TransformedBody tb} = fun_def
-		  ti_var_heap = fold2St (\{fv_info_ptr} a_type ti_var_heap
-									-> setExtendedVarInfo fv_info_ptr (EVI_VarType a_type) ti_var_heap)
-								tb.tb_args st_args ti_var_heap
-		  ro_fun = fun_def_to_symb_ident fun fun_def
+		  ti_var_heap						= fold2St store_arg_type_info tb.tb_args st_args ti.ti_var_heap
 		  ro =	{ ro_imported_funs				= imported_funs
 				, ro_common_defs 				= common_defs
 				, ro_root_case_mode				= get_root_case_mode tb
 				, ro_fun_root					= ro_fun
 				, ro_fun_case					= ro_fun
+				, ro_fun_orig					= ro_fun
 				, ro_fun_args					= tb.tb_args
 				, ro_main_dcl_module_n			= main_dcl_module_n
 				, ro_transform_fusion			= compile_with_fusion
 				, ro_stdStrictLists_module_n	= stdStrictLists_module_n
 				}
-		  (fun_rhs, ti) = transform tb.tb_rhs ro { ti & ti_fun_defs = ti_fun_defs, ti_var_heap = ti_var_heap }
-		= { ti & ti_fun_defs = {ti.ti_fun_defs & [fun] = { fun_def & fun_body = TransformedBody { tb & tb_rhs = fun_rhs }}}}
+		  ti								= { ti & ti_var_heap = ti_var_heap } <-!- ("transform_function",fun,ro.ro_root_case_mode)
+		  (fun_rhs, ti)						= transform tb.tb_rhs ro ti
+		  fun_def							= { fun_def & fun_body = TransformedBody { tb & tb_rhs = fun_rhs }}
+		# ti			= set_fun_def fun fun_def ti
+		= ti
 	  where
-		fun_def_to_symb_ident fun_index {fun_symb}
+		store_arg_type_info {fv_info_ptr} a_type ti_var_heap
+			= setExtendedVarInfo fv_info_ptr (EVI_VarType a_type) ti_var_heap
+		
+		fun_def_to_symb_ident fun_index fsize {fun_symb}
+			| fun_index < fsize
 			= { symb_name=fun_symb, symb_kind=SK_Function {glob_object=fun_index, glob_module=main_dcl_module_n } }
 
 		get_root_case_mode {tb_rhs=Case _}	= RootCase
 		get_root_case_mode _ 				= NotRootCase
 
+		get_fun_def_and_symb_ident fun ti=:{ti_fun_defs}
+			| fun < size ti_fun_defs
+				# (fun_def, ti)						= ti!ti_fun_defs.[fun]
+				# si = { symb_name=fun_def.fun_symb, symb_kind=SK_Function {glob_object=fun, glob_module=main_dcl_module_n } }
+				= (fun_def,si,ti)
+			# (fun_def_ptr,ti_fun_heap)			= lookup_ptr fun ti.ti_new_functions ti.ti_fun_heap
+				with
+					lookup_ptr fun [] ti_fun_heap = abort "drat"
+					lookup_ptr fun [fun_def_ptr:new_functions] ti_fun_heap
+						# (FI_Function {gf_fun_index}, ti_fun_heap)
+								= readPtr fun_def_ptr ti_fun_heap
+						| gf_fun_index == fun
+							= (fun_def_ptr, ti_fun_heap)
+							= lookup_ptr fun new_functions ti_fun_heap
+			# (FI_Function {gf_fun_def}, ti_fun_heap)
+											= readPtr fun_def_ptr ti_fun_heap
+			# si = { symb_name=gf_fun_def.fun_symb, symb_kind=SK_GeneratedFunction fun_def_ptr fun }
+			  ti								= { ti & ti_fun_heap = ti_fun_heap }
+			= (gf_fun_def,si,ti)
+
 	reannotate_producers group_nr group_members ti
 		// determine if safe group
 		# (safe,ti) = safe_producers group_nr group_members group_members ti
@@ -2716,24 +2898,6 @@ where
 			// if safe mark all members as safe
 			= foldSt mark_producer_safe group_members ti
 		= ti
-	
-	get_fun_def fun ti
-		| fun < size ti.ti_fun_defs
-			# (fun_def, ti)						= ti!ti_fun_defs.[fun]
-			= (fun_def,ti)
-		# (fun_def_ptr,ti_fun_heap)			= lookup_ptr fun ti.ti_new_functions ti.ti_fun_heap
-			with
-				lookup_ptr fun [] ti_fun_heap = abort "drat"
-				lookup_ptr fun [fun_def_ptr:new_functions] ti_fun_heap
-					# (FI_Function {gf_fun_index}, ti_fun_heap)
-							= readPtr fun_def_ptr ti_fun_heap
-					| gf_fun_index == fun
-						= (fun_def_ptr, ti_fun_heap)
-						= lookup_ptr fun new_functions ti_fun_heap
-		# (FI_Function {gf_fun_def}, ti_fun_heap)
-											= readPtr fun_def_ptr ti_fun_heap
-		  ti								= { ti & ti_fun_heap = ti_fun_heap }
-		= (gf_fun_def,ti)
 
 	safe_producers group_nr group_members [] ti
 		= (True,ti)
@@ -2741,7 +2905,8 @@ where
 		// look for occurrence of group_members in safe argument position of fun RHS
 		// i.e. linearity ok && ...
 		#! (fun_def, ti)	= get_fun_def fun ti
-		   {fun_body		= TransformedBody tb} = fun_def
+		   {fun_body = TransformedBody tb}
+		   					= fun_def
 		   fun_body			= tb.tb_rhs
 
 		#! prs	=
@@ -2759,18 +2924,31 @@ where
 						= safe_producers group_nr group_members funs ti
 		= (safe,ti)
 	
-	mark_producer_safe fun ti
+	mark_producer_safe fun ti=:{ti_fun_defs}
 		// update cc_prod for fun
-		#!	ti_cons_args = {ti.ti_cons_args & [fun].cc_producer = pIsSafe}
-			ti = {ti & ti_cons_args = ti_cons_args}
+		| fun < size ti_fun_defs
+			= {ti & ti_cons_args.[fun].cc_producer = pIsSafe}
+		# (fun_def_ptr,ti_fun_heap)			= lookup_ptr fun ti.ti_new_functions ti.ti_fun_heap
+			with
+				lookup_ptr fun [] ti_fun_heap = abort "drat"
+				lookup_ptr fun [fun_def_ptr:new_functions] ti_fun_heap
+					# (FI_Function {gf_fun_index}, ti_fun_heap)
+							= readPtr fun_def_ptr ti_fun_heap
+					| gf_fun_index == fun
+						= (fun_def_ptr, ti_fun_heap)
+						= lookup_ptr fun new_functions ti_fun_heap
+		# (FI_Function gf, ti_fun_heap)
+											= readPtr fun_def_ptr ti_fun_heap
+		# ti_fun_heap						= writePtr fun_def_ptr (FI_Function {gf & gf_cons_args.cc_producer = pIsSafe}) ti_fun_heap
+		  ti								= { ti & ti_fun_heap = ti_fun_heap }
 		= ti
 // ... DvA		
 
 	add_new_function_to_group ::  !{# CommonDefs} !FunctionHeap  !FunctionInfoPtr
-				!(!*{! Group}, ![FunDef], !*ImportedTypes, !ImportedConstructors, !*TypeHeaps, !*VarHeap)
-					-> (!*{! Group}, ![FunDef], !*ImportedTypes, !ImportedConstructors, !*TypeHeaps, !*VarHeap)
-	add_new_function_to_group common_defs fun_heap fun_ptr (groups, fun_defs, imported_types, collected_imports, type_heaps, var_heap)
-		# (FI_Function {gf_fun_def,gf_fun_index}) = sreadPtr fun_ptr fun_heap
+				!(!*{!Group}, ![FunDef], ![ConsClasses], !*ImportedTypes, !ImportedConstructors, !*TypeHeaps, !*VarHeap)
+					-> (!*{!Group}, ![FunDef], ![ConsClasses], !*ImportedTypes, !ImportedConstructors, !*TypeHeaps, !*VarHeap)
+	add_new_function_to_group common_defs fun_heap fun_ptr (groups, fun_defs, cons_classes, imported_types, collected_imports, type_heaps, var_heap)
+		# (FI_Function {gf_fun_def,gf_fun_index,gf_cons_args}) = sreadPtr fun_ptr fun_heap
 		  {fun_type = Yes ft=:{st_args,st_result}, fun_info = {fi_group_index,fi_properties}} = gf_fun_def
 		  ets =
 		  	{ ets_type_defs							= imported_types
@@ -2782,11 +2960,17 @@ where
 		  	}
 		  (_,(st_result,st_args), {ets_type_defs, ets_collected_conses, ets_type_heaps, ets_var_heap})
 		  		= expandSynTypes (if (fi_properties bitand FI_HasTypeSpec == 0) (RemoveAnnotationsMask bitor ExpandAbstractSynTypesMask) ExpandAbstractSynTypesMask) common_defs (st_result,st_args) ets
-				  		
 		# ft = { ft &  st_result = st_result, st_args = st_args }
+		| fi_group_index >= size groups
+			= abort ("add_new_function_to_group "+++ toString fi_group_index+++ "," +++ toString (size groups) +++ "," +++ toString gf_fun_index)
+				  		
 		# (group, groups) = groups![fi_group_index]
-		= ({ groups & [fi_group_index] = { group & group_members = [gf_fun_index : group.group_members]} },
-				[ { gf_fun_def & fun_type = Yes ft} : fun_defs],
+		| not (isMember gf_fun_index group.group_members)
+			= abort ("add_new_function_to_group INSANE!\n" +++ toString gf_fun_index +++ "," +++ toString fi_group_index)
+		# groups = {groups & [fi_group_index] = group}
+
+		= (groups,
+				[ { gf_fun_def & fun_type = Yes ft} : fun_defs], [gf_cons_args:cons_classes],
 					ets_type_defs, ets_collected_conses, ets_type_heaps, ets_var_heap)
 	
 	convert_function_type common_defs fun_index (fun_defs, imported_types, collected_imports, fun_indices_with_abs_syn_types, type_heaps, var_heap)
@@ -3258,7 +3442,10 @@ instance producerRequirements Expression where
 		= (True,prs)
 	producerRequirements (App {app_symb={symb_kind=(SK_Constructor _)},app_args}) prs
 		= producerRequirements app_args prs
-	producerRequirements (App {app_symb,app_args}) prs
+	producerRequirements app=:(App {app_symb,app_args}) prs
+		# (rec,prs)			= is_recursive_app app prs
+		| not rec
+			= producerRequirements app_args prs
 		// look up consumer class for app_symb args
 		#! (maybe_ca,prs)	= retrieve_consumer_args app_symb prs
 		// need to check for recursive call in safe arg...
@@ -3287,21 +3474,19 @@ instance producerRequirements Expression where
 		is_recursive_app (App {app_symb}) prs
 			// check if app_symb member of prs_group
 			# {symb_kind}	= app_symb
-			| is_SK_Function_or_SK_LocalMacroFunction symb_kind
 			#! main_dcl_module_n	= prs.prs_main_dcl_module_n
 			# { glob_module, glob_object }
 				= case symb_kind of
 					SK_Function global_index -> global_index
 					SK_LocalMacroFunction index -> { glob_module = main_dcl_module_n, glob_object = index }
+					SK_GeneratedFunction info_ptr index -> { glob_module = main_dcl_module_n, glob_object = index }
+					_ -> {glob_module = -1, glob_object = -1}
 			| glob_module <> main_dcl_module_n
 				= (False,prs)
-//			#! rec = isMember glob_object prs.prs_group
 			#! (fun_def,fun_defs,fun_heap)	= get_fun_def symb_kind prs.prs_main_dcl_module_n prs.prs_fun_defs prs.prs_fun_heap
 			   prs = {prs & prs_fun_defs = fun_defs, prs_fun_heap = fun_heap}
-			   rec` = fun_def.fun_info.fi_group_index == prs.prs_group_index
-//			| rec <> rec`
-//				= (rec`,prs			---> ("is_recursive_app mismatch!"))
-			= (rec`,prs)
+			   rec = fun_def.fun_info.fi_group_index == prs.prs_group_index
+			= (rec,prs)
 		is_recursive_app _ prs
 			= (False,prs)
 
@@ -3375,6 +3560,8 @@ instance producerRequirements Expression where
 		= (False,prs)
 	producerRequirements (NoBind var) prs
 		= (True,prs)
+	producerRequirements (FailExpr _) prs
+		= (True,prs)
 	producerRequirements expr prs
 		= abort ("producerRequirements " ---> expr)
 
@@ -3470,17 +3657,17 @@ retrieve_consumer_args si=:{symb_kind} prs=:{prs_cons_args, prs_main_dcl_module_
 	  prs = {prs & prs_cons_args = prs_cons_args}
 	= case symb_kind of
 		SK_Function {glob_module, glob_object}
-			| glob_module == prs_main_dcl_module_n && glob_object < prs_size//size prs_cons_args
+			| glob_module == prs_main_dcl_module_n && glob_object < prs_size
 				# (cons_args,prs) = prs!prs_cons_args.[glob_object]
 				-> (Yes cons_args,prs)
 			-> (No,prs) -!-> ("r_c_a",si)
 		SK_LocalMacroFunction glob_object
-			| glob_object < prs_size//size prs_cons_args
+			| glob_object < prs_size
 				# (cons_args,prs) = prs!prs_cons_args.[glob_object]
 				-> (Yes cons_args,prs)
 			-> (No,prs) -!-> ("r_c_a",si)
 		SK_GeneratedFunction fun_ptr fun_index
-			| fun_index < prs_size//size prs_cons_args
+			| fun_index < prs_size
 				# (cons_args,prs) = prs!prs_cons_args.[fun_index]
 				-> (Yes cons_args,prs)
 			# (FI_Function {gf_cons_args}, fun_heap)	= readPtr fun_ptr prs.prs_fun_heap