implementation module transform

import syntax, check, StdCompare, utilities, mergecases; //, RWSDebug

::	LiftState =
	{	ls_var_heap		:: !.VarHeap
	,	ls_x 			:: !.LiftStateX
	,	ls_expr_heap	:: !.ExpressionHeap
	}
	
::	LiftStateX = {
		x_fun_defs :: !.{#FunDef},
		x_macro_defs :: !.{#.{#FunDef}},
		x_main_dcl_module_n :: !Int
	}

class lift a :: !a !*LiftState -> (!a, !*LiftState)

instance lift [a] | lift a
where
	lift l ls = mapSt lift l ls

instance lift (a,b) | lift a & lift b
where
	lift t ls = app2St (lift,lift) t ls

instance lift (Optional a) | lift a
where
	lift (Yes x) ls
		# (x, ls) = lift x ls
		= (Yes x, ls)
	lift no ls
		= (no, ls)
	
instance lift CheckedAlternative
where
	lift ca=:{ca_rhs} ls
		# (ca_rhs, ls) = lift ca_rhs ls
		= ({ ca & ca_rhs = ca_rhs }, ls)
	
instance lift Expression
where
	lift (FreeVar {fv_ident,fv_info_ptr}) ls=:{ls_var_heap}
		# (var_info, ls_var_heap) = readPtr fv_info_ptr ls_var_heap
		  ls = { ls & ls_var_heap = ls_var_heap }
		= case var_info of
			 VI_LiftedVariable var_info_ptr
			 	# (var_expr_ptr, ls_expr_heap) = newPtr EI_Empty ls.ls_expr_heap
			 	-> (Var { var_ident = fv_ident, var_info_ptr = var_info_ptr, var_expr_ptr = var_expr_ptr }, { ls & ls_expr_heap = ls_expr_heap})
			 _
			 	# (var_expr_ptr, ls_expr_heap) = newPtr EI_Empty ls.ls_expr_heap
			 	-> (Var { var_ident = fv_ident, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr }, { ls & ls_expr_heap = ls_expr_heap})
	lift (App app) ls
		# (app, ls) = lift app ls
		= (App app, ls)
	lift (expr @ exprs) ls
		# ((expr,exprs), ls) = lift (expr,exprs) ls
		= (expr @ exprs, ls)
	lift (Let lad=:{let_strict_binds, let_lazy_binds, let_expr}) ls
		# (let_strict_binds, ls) = lift let_strict_binds ls
		  (let_lazy_binds, ls) = lift let_lazy_binds ls
		  (let_expr, ls) = lift let_expr ls
		= (Let {lad & let_strict_binds = let_strict_binds, let_lazy_binds = let_lazy_binds, let_expr = let_expr}, ls)
	lift (Case case_expr) ls
		# (case_expr, ls) = lift case_expr ls
		= (Case case_expr, ls)
	lift (Selection is_unique expr selectors) ls
		# (selectors, ls) = lift selectors ls
		  (expr, ls) = lift expr ls
		= (Selection is_unique expr selectors, ls)
	lift (Update expr1 selectors expr2) ls
		# (selectors, ls) = lift selectors ls
		  (expr1, ls) = lift expr1 ls
		  (expr2, ls) = lift expr2 ls
		= (Update expr1 selectors expr2, ls)
	lift (RecordUpdate cons_symbol expression expressions) ls
		# (expression, ls) = lift expression ls
		  (expressions, ls) = lift expressions ls
		= (RecordUpdate cons_symbol expression expressions, ls)
	lift (TupleSelect symbol argn_nr expr) ls
		# (expr, ls) = lift expr ls
		= (TupleSelect symbol argn_nr expr, ls)
	lift (MatchExpr cons_ident expr) ls
		# (expr, ls) = lift expr ls
		= (MatchExpr cons_ident expr, ls)
	lift (DynamicExpr expr) ls
		# (expr, ls) = lift expr ls
		= (DynamicExpr expr, ls)
	lift expr ls
		= (expr, ls)

instance lift Selection
where
	lift (ArraySelection array_select expr_ptr index_expr) ls
		# (index_expr, ls) = lift index_expr ls
		= (ArraySelection array_select expr_ptr index_expr, ls)
	lift record_selection ls
		= (record_selection, ls)

instance lift App
where
	lift app=:{app_symb = app_symbol=:{symb_kind = SK_Function {glob_object,glob_module}}, app_args} ls
		| glob_module == ls.ls_x.LiftStateX.x_main_dcl_module_n
			# (fun_def,ls) = ls!ls_x.x_fun_defs.[glob_object]
			= lift_function_app app fun_def.fun_info.fi_free_vars ls
			# (app_args, ls) = lift app_args ls
			= ({ app & app_args = app_args }, ls)
	lift app=:{app_symb = {symb_kind = SK_LocalMacroFunction glob_object},app_args} ls
		# (fun_def,ls) = ls!ls_x.x_fun_defs.[glob_object]
		= lift_function_app app fun_def.fun_info.fi_free_vars ls
	lift app=:{app_symb = {symb_kind = SK_LocalDclMacroFunction {glob_object,glob_module}}} ls
		# (fun_def,ls) = ls!ls_x.x_macro_defs.[glob_module,glob_object]
		= lift_function_app app fun_def.fun_info.fi_free_vars ls
	lift app=:{app_args} ls
		# (app_args, ls) = lift app_args ls
		= ({ app & app_args = app_args }, ls)

lift_function_app app=:{app_symb=app_symbol,app_args} [] ls
	# (app_args, ls) = lift app_args ls
	= ({ app & app_args = app_args }, ls)
lift_function_app app=:{app_args} fi_free_vars ls
	# (app_args, ls) = lift app_args ls
	# (app_args, ls_var_heap, ls_expr_heap) = add_free_variables_in_app fi_free_vars app_args ls.ls_var_heap ls.ls_expr_heap
	# app = { app & app_args = app_args }
	= (app,	{ ls & ls_var_heap = ls_var_heap, ls_expr_heap = ls_expr_heap })
where
	add_free_variables_in_app :: ![FreeVar] ![Expression] !*VarHeap !*ExpressionHeap -> (![Expression],!*VarHeap,!*ExpressionHeap)
	add_free_variables_in_app [] app_args var_heap expr_heap
		= (app_args, var_heap, expr_heap)
	add_free_variables_in_app [{fv_ident, fv_info_ptr} : free_vars] app_args var_heap expr_heap
		# (var_info,var_heap) = readPtr fv_info_ptr var_heap
		= case var_info of
			VI_LiftedVariable var_info_ptr
			 	# (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
				-> add_free_variables_in_app free_vars [Var { var_ident = fv_ident, var_info_ptr = var_info_ptr, var_expr_ptr = var_expr_ptr } : app_args]
						var_heap expr_heap
			_
			 	# (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
				-> add_free_variables_in_app free_vars [Var { var_ident = fv_ident, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr } : app_args]
						var_heap expr_heap

instance lift LetBind
where
	lift bind=:{lb_src} ls
		# (lb_src, ls) = lift lb_src ls
		= ({ bind & lb_src = lb_src }, ls)

instance lift (Bind a b) | lift a
where
	lift bind=:{bind_src} ls
		# (bind_src, ls) = lift bind_src ls
		= ({ bind & bind_src = bind_src }, ls)

instance lift Case
where
	lift kees=:{ case_expr,case_guards,case_default } ls
		# ((case_expr,(case_guards,case_default)), ls) = lift (case_expr,(case_guards,case_default)) ls
		= ({ kees & case_expr = case_expr,case_guards = case_guards, case_default = case_default }, ls)

instance lift CasePatterns
where
	lift (AlgebraicPatterns type patterns) ls
		# (patterns, ls) = lift patterns ls
		= (AlgebraicPatterns type patterns, ls)
	lift (BasicPatterns type patterns) ls
		# (patterns, ls) = lift patterns ls
		= (BasicPatterns type patterns, ls)
	lift (OverloadedListPatterns type decons_expr patterns) ls
		# (patterns, ls) = lift patterns ls
		# (decons_expr, ls) = lift decons_expr ls
		= (OverloadedListPatterns type decons_expr patterns, ls)
	lift (DynamicPatterns patterns) ls
		# (patterns, ls) = lift patterns ls
		= (DynamicPatterns patterns, ls)

instance lift AlgebraicPattern
where
	lift pattern=:{ap_expr} ls
		# (ap_expr, ls) = lift ap_expr ls
		= ({ pattern & ap_expr = ap_expr }, ls)

instance lift BasicPattern
where
	lift pattern=:{bp_expr} ls
		# (bp_expr, ls) = lift bp_expr ls
		= ({ pattern & bp_expr = bp_expr }, ls)

instance lift DynamicPattern
where
	lift pattern=:{dp_rhs} ls
		# (dp_rhs, ls) = lift dp_rhs ls
		= ({ pattern & dp_rhs = dp_rhs }, ls)

instance lift DynamicExpr
where
	lift dyn=:{dyn_expr} ls
		# (dyn_expr, ls) = lift dyn_expr ls
		= ({ dyn & dyn_expr = dyn_expr}, ls)

liftFunctions :: [FunctionOrMacroIndex] Int Int *{#FunDef} *{#*{#FunDef}} *(Heap VarInfo) *(Heap ExprInfo) -> .LiftState;
liftFunctions group group_index main_dcl_module_n fun_defs macro_defs var_heap expr_heap
	# (contains_free_vars, lifted_function_called, fun_defs,macro_defs)
			= foldSt (add_free_vars_of_non_recursive_calls_to_function group_index) group (False, False, fun_defs,macro_defs)
	| contains_free_vars
		# (fun_defs,macro_defs) = iterateSt (add_free_vars_of_recursive_calls_to_functions group_index group) (fun_defs,macro_defs)
		= lift_functions group {ls_x={x_fun_defs=fun_defs,x_macro_defs=macro_defs,x_main_dcl_module_n=main_dcl_module_n},ls_var_heap=var_heap,ls_expr_heap=expr_heap}
	| lifted_function_called
		= lift_functions group {ls_x={x_fun_defs=fun_defs,x_macro_defs=macro_defs,x_main_dcl_module_n=main_dcl_module_n},ls_var_heap=var_heap,ls_expr_heap=expr_heap}
		= {ls_x={x_fun_defs=fun_defs,x_macro_defs=macro_defs,x_main_dcl_module_n=main_dcl_module_n},ls_var_heap=var_heap, ls_expr_heap=expr_heap}
where
	add_free_vars_of_non_recursive_calls_to_function group_index (FunctionOrIclMacroIndex fun) (contains_free_vars, lifted_function_called, fun_defs,macro_defs)
		# (fun_def=:{fun_info}, fun_defs) = fun_defs![fun]
		  { fi_free_vars,fi_def_level,fi_calls } = fun_info
		  (lifted_function_called, fi_free_vars, fun_defs,macro_defs)
				= add_free_vars_of_non_recursive_calls fi_def_level group_index fi_calls lifted_function_called fi_free_vars fun_defs macro_defs
		= (contains_free_vars || not (isEmpty fi_free_vars), lifted_function_called, 
			{ fun_defs & [fun] = { fun_def & fun_info = { fun_info & fi_free_vars = fi_free_vars }}},macro_defs)
	add_free_vars_of_non_recursive_calls_to_function group_index (DclMacroIndex macro_module_index macro_index) (contains_free_vars, lifted_function_called, fun_defs,macro_defs)
		# (fun_def=:{fun_info}, macro_defs) = macro_defs![macro_module_index,macro_index]
		  { fi_free_vars,fi_def_level,fi_calls } = fun_info
		  (lifted_function_called, fi_free_vars, fun_defs,macro_defs)
		  		= add_free_vars_of_non_recursive_calls fi_def_level group_index fi_calls lifted_function_called fi_free_vars fun_defs macro_defs
		= (contains_free_vars || not (isEmpty fi_free_vars), lifted_function_called, 
			fun_defs,{ macro_defs & [macro_module_index,macro_index] = { fun_def & fun_info = { fun_info & fi_free_vars = fi_free_vars }}})

	add_free_vars_of_non_recursive_calls fi_def_level group_index fi_calls lifted_function_called fi_free_vars fun_defs macro_defs
		= foldSt (add_free_vars_of_non_recursive_call fi_def_level group_index) fi_calls (lifted_function_called, fi_free_vars, fun_defs,macro_defs)
	where
		add_free_vars_of_non_recursive_call fun_def_level group_index (FunCall fc_index _) (lifted_function_called, free_vars, fun_defs,macro_defs)
			# ({fun_info = {fi_free_vars,fi_group_index}}, fun_defs) = fun_defs![fc_index]
			| (if (fi_group_index>=NoIndex) (fi_group_index==group_index) (-2-fi_group_index==group_index)) || (isEmpty fi_free_vars)
				= (lifted_function_called, free_vars, fun_defs,macro_defs)
				# (free_vars_added, free_vars) = add_free_variables fun_def_level fi_free_vars (False, free_vars)
				= (True, free_vars, fun_defs,macro_defs)
		add_free_vars_of_non_recursive_call fun_def_level group_index (MacroCall macro_module_index fc_index _) (lifted_function_called, free_vars, fun_defs,macro_defs)
			# ({fun_info = {fi_free_vars,fi_group_index}}, macro_defs) = macro_defs![macro_module_index,fc_index]
			| (if (fi_group_index>=NoIndex) (fi_group_index==group_index) (-2-fi_group_index==group_index)) || (isEmpty fi_free_vars)
				= (lifted_function_called, free_vars, fun_defs,macro_defs)
				# (free_vars_added, free_vars) = add_free_variables fun_def_level fi_free_vars (False, free_vars)
				= (True, free_vars, fun_defs,macro_defs)
		add_free_vars_of_non_recursive_call fun_def_level group_index (DclFunCall _ _) (lifted_function_called, free_vars, fun_defs,macro_defs)
			= (lifted_function_called, free_vars, fun_defs,macro_defs)

	add_free_vars_of_recursive_calls_to_functions group_index group (fun_defs,macro_defs)
		= foldSt (add_free_vars_of_recursive_calls_to_function group_index) group (False, (fun_defs,macro_defs))

	add_free_vars_of_recursive_calls_to_function group_index (FunctionOrIclMacroIndex fun) (free_vars_added, (fun_defs,macro_defs))
		# (fun_def=:{fun_info}, fun_defs) = fun_defs![fun]
		  { fi_free_vars,fi_def_level,fi_calls } = fun_info
		  (free_vars_added, fi_free_vars, fun_defs,macro_defs)
				= foldSt (add_free_vars_of_recursive_call fi_def_level group_index) fi_calls (free_vars_added, fi_free_vars, fun_defs,macro_defs)
		  fun_defs = { fun_defs & [fun] = { fun_def & fun_info = { fun_info & fi_free_vars = fi_free_vars }}}
		= (free_vars_added, (fun_defs,macro_defs))
	add_free_vars_of_recursive_calls_to_function group_index (DclMacroIndex module_index fun) (free_vars_added, (fun_defs,macro_defs))
		# (fun_def=:{fun_info}, macro_defs) = macro_defs![module_index,fun]
		  { fi_free_vars,fi_def_level,fi_calls } = fun_info
		  (free_vars_added, fi_free_vars, fun_defs,macro_defs)
				= foldSt (add_free_vars_of_recursive_call fi_def_level group_index) fi_calls (free_vars_added, fi_free_vars, fun_defs,macro_defs)
		  macro_defs = { macro_defs & [module_index,fun] = { fun_def & fun_info = { fun_info & fi_free_vars = fi_free_vars }}}
		= (free_vars_added, (fun_defs,macro_defs))

	add_free_vars_of_recursive_call fun_def_level group_index (FunCall fc_index _) (free_vars_added, free_vars, fun_defs,macro_defs)
		# ({fun_info = {fi_free_vars,fi_group_index}}, fun_defs) = fun_defs![fc_index]
		| if (fi_group_index>=NoIndex) (fi_group_index==group_index) (-2-fi_group_index==group_index)
			# (free_vars_added, free_vars) = add_free_variables fun_def_level fi_free_vars (free_vars_added, free_vars)
			= (free_vars_added, free_vars, fun_defs,macro_defs)
			= (free_vars_added, free_vars, fun_defs,macro_defs)
	add_free_vars_of_recursive_call fun_def_level group_index (MacroCall module_index fc_index _) (free_vars_added, free_vars, fun_defs,macro_defs)
		# ({fun_info = {fi_free_vars,fi_group_index}}, macro_defs) = macro_defs![module_index,fc_index]
		| if (fi_group_index>=NoIndex) (fi_group_index==group_index) (-2-fi_group_index==group_index)
			# (free_vars_added, free_vars) = add_free_variables fun_def_level fi_free_vars (free_vars_added, free_vars)
			= (free_vars_added, free_vars, fun_defs,macro_defs)
			= (free_vars_added, free_vars, fun_defs,macro_defs)
	add_free_vars_of_recursive_call fun_def_level group_index (DclFunCall _ _) (free_vars_added, free_vars, fun_defs,macro_defs)
		= (free_vars_added, free_vars, fun_defs,macro_defs)

	add_free_variables fun_level new_vars (free_vars_added, free_vars)
		= add_free_global_variables (skip_local_variables fun_level new_vars) (free_vars_added, free_vars)
	where
		skip_local_variables level vars=:[{fv_def_level}:rest_vars]
			| fv_def_level > level
				= skip_local_variables level rest_vars
				= vars
		skip_local_variables _ []
			= []

		add_free_global_variables []  (free_vars_added, free_vars)
			= (free_vars_added, free_vars)
		add_free_global_variables free_vars (free_vars_added, [])
			= (True, free_vars)
		add_free_global_variables [var:vars] (free_vars_added, free_vars)
			# (free_var_added, free_vars) = newFreeVariable var free_vars
			= add_free_global_variables vars (free_var_added || free_vars_added, free_vars)

	lift_functions group lift_state
		= foldSt lift_function group lift_state
	where
		lift_function (FunctionOrIclMacroIndex fun) {ls_x=ls_x=:{x_fun_defs=fun_defs=:{[fun] = fun_def}}, ls_var_heap=var_heap, ls_expr_heap=expr_heap}
			# {fi_free_vars} = fun_def.fun_info
			  fun_lifted = length fi_free_vars
			  (PartitioningFunction {cb_args,cb_rhs} fun_number) = fun_def.fun_body
			  (cb_args, var_heap) = add_lifted_args fi_free_vars cb_args var_heap
			  (cb_rhs, {ls_x,ls_var_heap,ls_expr_heap}) = lift cb_rhs { ls_x={ls_x & x_fun_defs = fun_defs}, ls_var_heap = var_heap, ls_expr_heap = expr_heap }
			  ls_var_heap = remove_lifted_args fi_free_vars ls_var_heap
			  fun_defs = ls_x.x_fun_defs
			  fun_defs = { fun_defs & [fun] = { fun_def & fun_lifted = fun_lifted, fun_body = PartitioningFunction {cb_args = cb_args, cb_rhs = cb_rhs} fun_number}}
			= {ls_x={ls_x & x_fun_defs=fun_defs}, ls_var_heap=ls_var_heap, ls_expr_heap= ls_expr_heap}
//				 ---> ("lift_function", fun_def.fun_ident, fi_free_vars, cb_args, cb_rhs)
		lift_function (DclMacroIndex module_index fun) {ls_x=ls_x=:{x_macro_defs=macro_defs=:{[module_index,fun] = fun_def}}, ls_var_heap=var_heap, ls_expr_heap=expr_heap}
			# {fi_free_vars} = fun_def.fun_info
			  fun_lifted = length fi_free_vars
			  (PartitioningFunction {cb_args,cb_rhs} fun_number) = fun_def.fun_body
			  (cb_args, var_heap) = add_lifted_args fi_free_vars cb_args var_heap
			  (cb_rhs, {ls_x,ls_var_heap,ls_expr_heap}) = lift cb_rhs { ls_x={ls_x & x_macro_defs = macro_defs}, ls_var_heap = var_heap, ls_expr_heap = expr_heap }
			  ls_var_heap = remove_lifted_args fi_free_vars ls_var_heap
			  macro_defs = ls_x.x_macro_defs
			  macro_defs = { macro_defs & [module_index].[fun] = { fun_def & fun_lifted = fun_lifted, fun_body = PartitioningFunction {cb_args = cb_args, cb_rhs = cb_rhs} fun_number}}
			= {ls_x={ls_x & x_macro_defs=macro_defs}, ls_var_heap=ls_var_heap, ls_expr_heap= ls_expr_heap}

		remove_lifted_args vars var_heap
			= foldl (\var_heap {fv_ident,fv_info_ptr} -> writePtr fv_info_ptr VI_Empty var_heap) var_heap vars
	
		add_lifted_args [lifted_arg=:{fv_ident,fv_info_ptr} : lifted_args] args var_heap
			# (new_info_ptr, var_heap) = newPtr VI_Empty var_heap
			  args = [{ lifted_arg & fv_info_ptr = new_info_ptr } : args ]
			= add_lifted_args lifted_args args (writePtr fv_info_ptr (VI_LiftedVariable new_info_ptr) var_heap)
		add_lifted_args [] args var_heap
			= (args, var_heap)

unfoldVariable :: !BoundVar UnfoldInfo !*UnfoldState -> (!Expression, !*UnfoldState)
unfoldVariable var=:{var_ident,var_info_ptr} ui us
	# (var_info, us) = readVarInfo var_info_ptr us
	= case var_info of 
		VI_Expression expr
			-> (expr, us)
		VI_Variable var_ident var_info_ptr
		 	# (var_expr_ptr, us_symbol_heap) = newPtr EI_Empty us.us_symbol_heap
			-> (Var {var_ident = var_ident, var_info_ptr = var_info_ptr, var_expr_ptr = var_expr_ptr}, { us & us_symbol_heap = us_symbol_heap})
		VI_Body fun_ident _ vars
			-> (App {	app_symb = fun_ident,
						app_args = [ Var { var_ident=fv_ident, var_info_ptr=fv_info_ptr, var_expr_ptr=nilPtr }
									\\ {fv_ident,fv_info_ptr}<-vars],
						app_info_ptr = nilPtr }, us)
		VI_Dictionary app_symb app_args class_type
			# (new_class_type, us_opt_type_heaps) = substitute_class_types class_type us.us_opt_type_heaps
			  (new_info_ptr, us_symbol_heap) = newPtr (EI_DictionaryType new_class_type) us.us_symbol_heap
			  app = App { app_symb = app_symb, app_args = app_args, app_info_ptr = new_info_ptr }
			  us = { us & us_opt_type_heaps = us_opt_type_heaps, us_symbol_heap = us_symbol_heap }
			-> unfold app ui us
		_
			-> (Var var, us)
  where
	substitute_class_types class_types No
		= (class_types, No)
	substitute_class_types class_types (Yes type_heaps)
		# (new_class_types, type_heaps) = substitute class_types type_heaps
		= (new_class_types, Yes type_heaps)

readVarInfo var_info_ptr us
	# (var_info, us_var_heap) = readPtr var_info_ptr us.us_var_heap
	  us = { us & us_var_heap = us_var_heap }
	= case var_info of
		VI_Extended _ original	-> (original, us)
		_						-> (var_info, us)

writeVarInfo :: VarInfoPtr VarInfo *VarHeap -> *VarHeap
writeVarInfo var_info_ptr new_var_info var_heap
	# (old_var_info, var_heap) = readPtr var_info_ptr var_heap
	= case old_var_info of
		VI_Extended extensions _	-> writePtr var_info_ptr (VI_Extended extensions new_var_info) var_heap
		_							-> writePtr var_info_ptr new_var_info var_heap

::	CopiedLocalFunction = {
		old_function_n :: !FunctionOrMacroIndex,
		new_function_n :: !Int
	}

::	CopiedLocalFunctions = {
		copied_local_functions :: [CopiedLocalFunction],
		used_copied_local_functions :: [CopiedLocalFunction],
		new_copied_local_functions :: [CopiedLocalFunction],
		next_local_function_n :: !Int
	}

::	UnfoldState =
	{	us_var_heap				:: !.VarHeap
	,	us_symbol_heap			:: !.ExpressionHeap
	,	us_opt_type_heaps		:: !.Optional .TypeHeaps,
		us_cleanup_info			:: ![ExprInfoPtr],
		us_local_macro_functions :: !Optional CopiedLocalFunctions
	}

::	UnfoldInfo =
	{	ui_handle_aci_free_vars	:: !AciFreeVarHandleMode
	}

:: AciFreeVarHandleMode = LeaveThem | RemoveThem | SubstituteThem

class unfold a :: !a !UnfoldInfo !*UnfoldState -> (!a, !*UnfoldState)

instance unfold Expression
where
	unfold (Var var) ui us
		= unfoldVariable var ui us
	unfold (App app) ui us
		# (app, us) = unfold app ui us
		= (App app, us)
	unfold (expr @ exprs) ui us
		# ((expr,exprs), us) = unfold (expr,exprs) ui us
		= (expr @ exprs, us)
	unfold (Let lad) ui us
		# (lad, us) = unfold lad ui us
		= (Let lad, us)
	unfold (Case case_expr) ui us
		# (case_expr, us) = unfold case_expr ui us
		= (Case case_expr, us)
	unfold (Selection is_unique expr selectors) ui us
		# ((expr, selectors), us) = unfold (expr, selectors) ui us
		= (Selection is_unique expr selectors, us)
	unfold (Update expr1 selectors expr2) ui us
		# (((expr1, expr2), selectors), us) = unfold ((expr1, expr2), selectors) ui us
		= (Update expr1 selectors expr2, us)
	unfold (RecordUpdate cons_symbol expression expressions) ui us
		# ((expression, expressions), us) = unfold (expression, expressions) ui us
		= (RecordUpdate cons_symbol expression expressions, us)
	unfold (TupleSelect symbol argn_nr expr) ui us
		# (expr, us) = unfold expr ui us
		= (TupleSelect symbol argn_nr expr, us)
	unfold (MatchExpr cons_ident expr) ui us
		# (expr, us) = unfold expr ui us
		= (MatchExpr cons_ident expr, us)
	unfold (DynamicExpr expr) ui us
		# (expr, us) = unfold expr ui us
		= (DynamicExpr expr, us)
	unfold expr ui us
		= (expr, us)

instance unfold DynamicExpr
where
	unfold expr=:{dyn_expr, dyn_info_ptr} ui us=:{us_symbol_heap}
		# (dyn_info, us_symbol_heap) = readPtr dyn_info_ptr us_symbol_heap
		# (new_dyn_info_ptr, us_symbol_heap) = newPtr dyn_info us_symbol_heap
		# (dyn_expr, us) = unfold dyn_expr ui {us & us_symbol_heap=us_symbol_heap}
		= ({ expr & dyn_expr = dyn_expr, dyn_info_ptr = new_dyn_info_ptr }, us)

instance unfold Selection
where
	unfold (ArraySelection array_select expr_ptr index_expr) ui us=:{us_symbol_heap}
		# (new_ptr, us_symbol_heap) = newPtr EI_Empty us_symbol_heap
		  (index_expr, us) = unfold index_expr ui { us & us_symbol_heap = us_symbol_heap}
		= (ArraySelection array_select new_ptr index_expr, us)
	unfold (DictionarySelection var selectors expr_ptr index_expr) ui us=:{us_symbol_heap}
		# (new_ptr, us_symbol_heap) = newPtr EI_Empty us_symbol_heap
		  (index_expr, us) = unfold index_expr ui { us & us_symbol_heap = us_symbol_heap}
		  (var_expr, us) = unfoldVariable var ui us
		= case var_expr of 
			App {app_symb={symb_kind= SK_Constructor _ }, app_args}
				# [RecordSelection _ field_index:_] = selectors
				  (App { app_symb = {symb_ident, symb_kind = SK_Function array_select}}) =  app_args !! field_index
				-> (ArraySelection { array_select & glob_object = { ds_ident = symb_ident, ds_arity = 2, ds_index = array_select.glob_object}}
							new_ptr index_expr, us)
			Var var
				-> (DictionarySelection var selectors new_ptr index_expr, us)
	unfold record_selection ui us
		= (record_selection, us)

instance unfold FreeVar
where
	unfold fv=:{fv_info_ptr,fv_ident} ui us=:{us_var_heap}
		# (new_info_ptr, us_var_heap) = newPtr VI_Empty us_var_heap
		= ({ fv & fv_info_ptr = new_info_ptr }, { us & us_var_heap = writePtr fv_info_ptr (VI_Variable fv_ident new_info_ptr) us_var_heap })
instance unfold App
where
	unfold app=:{app_symb={symb_kind}, app_args, app_info_ptr} ui us
		= case symb_kind of
			SK_Function {glob_module,glob_object}
				-> unfold_function_app app ui us
			SK_IclMacro macro_index
				-> unfold_function_app app ui us
			SK_DclMacro {glob_module,glob_object}
				-> unfold_function_app app ui us
			SK_OverloadedFunction {glob_module,glob_object}
				-> unfold_function_app app ui us
			SK_Generic {glob_module,glob_object} kind
				-> unfold_function_app app ui us
			SK_LocalMacroFunction local_macro_function_n
				-> unfold_local_macro_function (FunctionOrIclMacroIndex local_macro_function_n)
			SK_LocalDclMacroFunction {glob_module,glob_object}
				-> unfold_local_macro_function (DclMacroIndex glob_module glob_object)
			SK_Constructor _
				| not (isNilPtr app_info_ptr)
					# (app_info, us_symbol_heap) = readPtr app_info_ptr us.us_symbol_heap
					  (new_app_info, us_opt_type_heaps) = substitute_EI_DictionaryType app_info us.us_opt_type_heaps
					  (new_info_ptr, us_symbol_heap) = newPtr new_app_info us_symbol_heap
					  us={ us & us_symbol_heap = us_symbol_heap, us_opt_type_heaps = us_opt_type_heaps }
					  (app_args, us) = unfold app_args ui us
					-> ({ app & app_args = app_args, app_info_ptr = new_info_ptr}, us) 
					# (app_args, us) = unfold app_args ui us
					-> ({ app & app_args = app_args}, us)
			_
				# (app_args, us) = unfold app_args ui us
				-> ({ app & app_args = app_args, app_info_ptr = nilPtr}, us) 
	where
		unfold_function_app app=:{app_args, app_info_ptr} ui us
			# (new_info_ptr, us_symbol_heap) = newPtr EI_Empty us.us_symbol_heap
			# us={ us & us_symbol_heap = us_symbol_heap }
			# (app_args, us) = unfold app_args ui us
			= ({ app & app_args = app_args, app_info_ptr = new_info_ptr}, us) 

		unfold_local_macro_function local_macro_function_n
			# (us_local_macro_functions,us) = us!us_local_macro_functions
			= case us_local_macro_functions of
				No
					-> unfold_function_app app ui us
				uslocal_macro_functions=:(Yes local_macro_functions)
					# (new_local_macro_function_n,us_local_macro_functions) = determine_new_local_macro_function_n local_macro_function_n local_macro_functions
						with
							determine_new_local_macro_function_n local_macro_function_n local_macro_functions=:{copied_local_functions,used_copied_local_functions,new_copied_local_functions,next_local_function_n}
								# new_local_macro_function_n = search_new_local_macro_function_n used_copied_local_functions
								| new_local_macro_function_n>=0
									= (new_local_macro_function_n,us_local_macro_functions)
								# (new_local_macro_function_n,used_copied_local_functions) = search_new_local_macro_function_n_and_add_to_used_functions copied_local_functions used_copied_local_functions
								| new_local_macro_function_n>=0
									= (new_local_macro_function_n,Yes {local_macro_functions & used_copied_local_functions=used_copied_local_functions})
								# (new_local_macro_function_n,used_copied_local_functions) = search_new_local_macro_function_n_and_add_to_used_functions new_copied_local_functions used_copied_local_functions
								| new_local_macro_function_n>=0
									= (new_local_macro_function_n,Yes {local_macro_functions & used_copied_local_functions=used_copied_local_functions})
									# new_local_function = {old_function_n=local_macro_function_n,new_function_n=next_local_function_n}
									# new_copied_local_functions=new_copied_local_functions++[new_local_function]
									# us_local_macro_functions=Yes {copied_local_functions=copied_local_functions,
																	new_copied_local_functions=new_copied_local_functions,
																	used_copied_local_functions=[new_local_function:used_copied_local_functions],
																	next_local_function_n=next_local_function_n+1}
									= (next_local_function_n,us_local_macro_functions)
								where
									search_new_local_macro_function_n [{old_function_n,new_function_n}:local_functions]
										| local_macro_function_n==old_function_n
											= new_function_n
										 	= search_new_local_macro_function_n local_functions
									search_new_local_macro_function_n []
										= -1

									search_new_local_macro_function_n_and_add_to_used_functions [copied_local_function=:{old_function_n,new_function_n}:local_functions] used_copied_local_functions
										| local_macro_function_n==old_function_n
											= (new_function_n,[copied_local_function:used_copied_local_functions])
										 	= search_new_local_macro_function_n_and_add_to_used_functions local_functions used_copied_local_functions
									search_new_local_macro_function_n_and_add_to_used_functions [] used_copied_local_functions
										= (-1,used_copied_local_functions)
					# us={us & us_local_macro_functions=us_local_macro_functions}
					# app={app & app_symb.symb_kind=SK_LocalMacroFunction new_local_macro_function_n}
					-> unfold_function_app app ui us

		substitute_EI_DictionaryType (EI_DictionaryType class_type) (Yes type_heaps)
			# (new_class_type, type_heaps) = substitute class_type type_heaps
			= (EI_DictionaryType new_class_type, Yes type_heaps)
		substitute_EI_DictionaryType x opt_type_heaps
			= (x, opt_type_heaps)

instance unfold LetBind
where
	unfold bind=:{lb_src} ui us
		# (lb_src, us) = unfold lb_src ui us
		= ({ bind & lb_src = lb_src }, us)

instance unfold (Bind a b) | unfold a
where
	unfold bind=:{bind_src} ui us
		# (bind_src, us) = unfold bind_src ui us
		= ({ bind & bind_src = bind_src }, us)

instance unfold Case
where
	unfold kees=:{ case_expr,case_guards,case_default,case_info_ptr} ui us=:{us_cleanup_info}
		# (old_case_info, us_symbol_heap) = readPtr case_info_ptr us.us_symbol_heap
		  (new_case_info, us_opt_type_heaps) = substitute_let_or_case_type old_case_info us.us_opt_type_heaps
		  (new_info_ptr, us_symbol_heap) = newPtr new_case_info us_symbol_heap
		  us_cleanup_info = case old_case_info of
								EI_Extended _ _	-> [new_info_ptr:us_cleanup_info]
								_				-> us_cleanup_info
		  us = { us & us_symbol_heap = us_symbol_heap, us_opt_type_heaps = us_opt_type_heaps, us_cleanup_info=us_cleanup_info }
		  ((case_guards,case_default), us) = unfold (case_guards,case_default) ui us
		  (case_expr, us) = update_active_case_info_and_unfold case_expr new_info_ptr us
		= ({ kees & case_expr = case_expr,case_guards = case_guards, case_default = case_default, case_info_ptr =  new_info_ptr}, us)
	where
		update_active_case_info_and_unfold case_expr=:(Var {var_info_ptr}) case_info_ptr us
			# (case_info, us_symbol_heap) = readPtr case_info_ptr us.us_symbol_heap
			  us = { us & us_symbol_heap = us_symbol_heap }
			= case case_info of
				EI_Extended (EEI_ActiveCase aci=:{aci_free_vars}) ei
					# (new_aci_free_vars, us) = case ui.ui_handle_aci_free_vars of
													LeaveThem		-> (aci_free_vars, us)
													RemoveThem		-> (No, us)
													SubstituteThem	-> case aci_free_vars of
																		No		-> (No, us)
																		Yes fvs	# (fvs_subst, us) = mapSt unfoldBoundVar fvs us
																				-> (Yes fvs_subst, us)
					  (var_info, us) = readVarInfo var_info_ptr us
					-> case var_info of
						VI_Body fun_ident {tb_args, tb_rhs} new_aci_params
							# tb_args_ptrs = [ fv_info_ptr \\ {fv_info_ptr}<-tb_args ] 
							  (original_bindings, us_var_heap) = mapSt readPtr tb_args_ptrs us.us_var_heap
							  us_var_heap = fold2St bind tb_args_ptrs new_aci_params us_var_heap
							  (tb_rhs, us) = unfold tb_rhs ui { us & us_var_heap = us_var_heap }
							  us_var_heap = fold2St writePtr tb_args_ptrs original_bindings us.us_var_heap
							  new_aci = { aci & aci_params = new_aci_params, aci_opt_unfolder = Yes fun_ident, aci_free_vars = new_aci_free_vars }
							  new_eei = (EI_Extended (EEI_ActiveCase new_aci) ei)
							  us_symbol_heap = writePtr case_info_ptr new_eei us.us_symbol_heap
							-> (tb_rhs, { us & us_var_heap = us_var_heap, us_symbol_heap = us_symbol_heap })
						_	# new_eei = EI_Extended (EEI_ActiveCase { aci & aci_free_vars = new_aci_free_vars }) ei
							  us_symbol_heap = writePtr case_info_ptr new_eei us.us_symbol_heap
							-> unfold case_expr ui { us & us_symbol_heap = us_symbol_heap }
				_	-> unfold case_expr ui us	
		  where 
			// XXX consider to store BoundVars in VI_Body
			bind fv_info_ptr {fv_ident=name, fv_info_ptr=info_ptr} var_heap
				= writeVarInfo fv_info_ptr (VI_Expression (Var {var_ident=name, var_info_ptr=info_ptr, var_expr_ptr = nilPtr})) var_heap
/*
			bind ({fv_info_ptr}, var_bound_var) var_heap
				= writeVarInfo fv_info_ptr (VI_Expression var_bound_var) var_heap
*/

/*		update_active_case_info_and_unfold case_expr=:(Var {var_info_ptr}) case_info_ptr us
			#! var_info = sreadPtr var_info_ptr us.us_var_heap
			= case var_info of
				VI_Body fun_ident fun_body new_aci_var_info_ptr
					# (fun_body, us) = unfold fun_body us
					  (EI_Extended (EEI_ActiveCase aci) ei, us_symbol_heap) = readPtr case_info_ptr us.us_symbol_heap
					  new_aci = { aci & aci_var_info_ptr = new_aci_var_info_ptr, aci_opt_unfolder = Yes fun_ident }
					  us_symbol_heap = writePtr case_info_ptr (EI_Extended (EEI_ActiveCase new_aci) ei) us_symbol_heap
					-> (fun_body, { us & us_symbol_heap = us_symbol_heap })
				_	-> unfold case_expr us
*/
		update_active_case_info_and_unfold case_expr _ us
			= unfold case_expr ui us

		unfoldBoundVar {var_info_ptr} us
			# (VI_Expression (Var act_var), us_var_heap) = readPtr var_info_ptr us.us_var_heap
			= (act_var, { us & us_var_heap = us_var_heap })

instance unfold Let
where
	unfold lad=:{let_strict_binds, let_lazy_binds, let_expr, let_info_ptr} ui us
		# (let_strict_binds, us) = copy_bound_vars let_strict_binds us
		# (let_lazy_binds, us) = copy_bound_vars let_lazy_binds us
		# (let_strict_binds, us) = unfold let_strict_binds ui us
		# (let_lazy_binds, us) = unfold let_lazy_binds ui us
		# (let_expr, us) = unfold let_expr ui us
		  (old_let_info, us_symbol_heap) = readPtr let_info_ptr us.us_symbol_heap
		  (new_let_info, us_opt_type_heaps) = substitute_let_or_case_type old_let_info us.us_opt_type_heaps
		  (new_info_ptr, us_symbol_heap) = newPtr new_let_info us_symbol_heap
		= ({lad & let_strict_binds = let_strict_binds, let_lazy_binds = let_lazy_binds, let_expr = let_expr, let_info_ptr = new_info_ptr},
			{ us & us_symbol_heap = us_symbol_heap, us_opt_type_heaps = us_opt_type_heaps })
		where
			copy_bound_vars [bind=:{lb_dst} : binds] us
				# (lb_dst, us) = unfold lb_dst ui us
				  (binds, us) = copy_bound_vars binds us
				= ([ {bind & lb_dst = lb_dst} : binds ], us)
			copy_bound_vars [] us
				= ([], us)

substitute_let_or_case_type	expr_info No
	= (expr_info, No)
substitute_let_or_case_type	(EI_Extended extensions expr_info) yes_type_heaps
	# (new_expr_info, yes_type_heaps) = substitute_let_or_case_type expr_info yes_type_heaps
	= (EI_Extended extensions new_expr_info, yes_type_heaps)
substitute_let_or_case_type	(EI_CaseType case_type) (Yes type_heaps)
	# (new_case_type, type_heaps) = substitute case_type type_heaps
	= (EI_CaseType new_case_type, Yes type_heaps)
substitute_let_or_case_type	(EI_LetType let_type) (Yes type_heaps)
	# (new_let_type, type_heaps) = substitute let_type type_heaps
	= (EI_LetType new_let_type, Yes type_heaps)

instance unfold CasePatterns
where
	unfold (AlgebraicPatterns type patterns) ui us
		# (patterns, us) = unfold patterns ui us
		= (AlgebraicPatterns type patterns, us)
	unfold (BasicPatterns type patterns) ui us
		# (patterns, us) = unfold patterns ui us
		= (BasicPatterns type patterns, us)
	unfold (OverloadedListPatterns type decons_expr patterns) ui us
		# (patterns, us) = unfold patterns ui us
		# (decons_expr, us) = unfold decons_expr ui us
		= (OverloadedListPatterns type decons_expr patterns, us)
	unfold (DynamicPatterns patterns) ui us
		# (patterns, us) = unfold patterns ui us
		= (DynamicPatterns patterns, us)

instance unfold AlgebraicPattern
where
	unfold guard=:{ap_vars,ap_expr} ui us
		# (ap_vars, us) = unfold ap_vars ui us
		  (ap_expr, us) = unfold ap_expr ui us
		= ({ guard & ap_vars = ap_vars, ap_expr = ap_expr }, us)

instance unfold BasicPattern
where
	unfold guard=:{bp_expr} ui us
		# (bp_expr, us) = unfold bp_expr ui us
		= ({ guard & bp_expr = bp_expr }, us)

instance unfold DynamicPattern
where
	unfold guard=:{dp_var,dp_rhs} ui us
		# (dp_var, us) = unfold dp_var ui us
		  (dp_rhs, us) = unfold dp_rhs ui us
		= ({ guard & dp_var = dp_var, dp_rhs = dp_rhs }, us)

instance unfold [a] | unfold a
where
	unfold l ui us
		= map_st l us
		where
			map_st [x : xs] s
			 	# (x, s) = unfold x ui s
				  (xs, s) = map_st xs s
				#! s = s
				= ([x : xs], s)
			map_st [] s
			 	= ([], s)

instance unfold (a,b) | unfold a & unfold b
where
	unfold (a,b) ui us
		# (a,us) = unfold a ui us
		# (b,us) = unfold b ui us
		= ((a,b),us)

instance unfold (Optional a) | unfold a
where
	unfold (Yes x) ui us
		# (x, us) = unfold x ui us
		= (Yes x, us)
	unfold no ui us
		= (no, us)

updateFunctionCalls :: ![FunCall] ![FunCall] !*{# FunDef} !*SymbolTable
	-> (![FunCall], !*{# FunDef}, !*SymbolTable)
updateFunctionCalls calls collected_calls fun_defs symbol_table
	= foldSt add_function_call calls (collected_calls, fun_defs, symbol_table)
where
	add_function_call fc=:(FunCall fc_index _) (collected_calls, fun_defs, symbol_table)
//		# fc_index = trace_n ("add_function_call: "+++toString fc_index+++" ") fc_index
		# ({fun_ident}, fun_defs) = fun_defs![fc_index]
		  (collected_calls, symbol_table) = examineFunctionCall fun_ident fc (collected_calls, symbol_table) 
		= (collected_calls, fun_defs, symbol_table)

examineFunctionCall {id_info} fc=:(FunCall fc_index _) (calls, symbol_table)
	# (entry, symbol_table) = readPtr id_info symbol_table
	= case entry.ste_kind of
		STE_Called indexes
			| is_member fc_index indexes
				-> (calls, symbol_table)
				-> ([ fc : calls ], symbol_table <:= (id_info, { entry & ste_kind = STE_Called [ FunctionOrIclMacroIndex fc_index : indexes ]}))
		_
			-> ( [ fc : calls ], symbol_table <:=
					(id_info, { ste_kind = STE_Called [FunctionOrIclMacroIndex fc_index], ste_index = NoIndex, ste_def_level = NotALevel, ste_previous = entry }))
	where
		is_member fc_index [FunctionOrIclMacroIndex index:indexes]
			| fc_index==index
				= True
				= is_member fc_index indexes
		is_member fc_index [_:indexes]
			= is_member fc_index indexes
		is_member _ []
			= False
examineFunctionCall {id_info} fc=:(MacroCall macro_module_index fc_index _) (calls, symbol_table)
	# (entry, symbol_table) = readPtr id_info symbol_table
	= case entry.ste_kind of
		STE_Called indexes
			| is_member macro_module_index fc_index indexes
				-> (calls, symbol_table)
				-> ([ fc : calls ], symbol_table <:= (id_info, { entry & ste_kind = STE_Called [ DclMacroIndex macro_module_index fc_index : indexes ]}))
		_
			-> ( [ fc : calls ], symbol_table <:=
					(id_info, { ste_kind = STE_Called [DclMacroIndex macro_module_index fc_index], ste_index = NoIndex, ste_def_level = NotALevel, ste_previous = entry }))
	where
		is_member macro_module_index fc_index [DclMacroIndex module_index index:indexes]
			| fc_index==index && module_index==macro_module_index
				= True
				= is_member macro_module_index fc_index indexes
		is_member macro_module_index fc_index [_:indexes]
			= is_member macro_module_index fc_index indexes
		is_member _ _ []
			= False
			
::	ExpandState =
	{	es_symbol_table	:: !.SymbolTable
	,	es_var_heap		:: !.VarHeap
	,	es_symbol_heap 	:: !.ExpressionHeap
	,	es_error 		:: !.ErrorAdmin,
		es_fun_defs :: !.{#FunDef},
		es_macro_defs :: !.{#.{#FunDef}},
		es_new_fun_def_numbers :: ![Int]
	}

copy_macro_and_local_functions :: FunDef (Optional CopiedLocalFunctions) *ExpandState -> (!FunDef,![(CopiedLocalFunction,FunDef)],!Optional CopiedLocalFunctions,!*ExpandState);
copy_macro_and_local_functions macro=:{fun_kind} local_macro_functions es
	# (macro,local_macro_functions,es) = copy_macro_or_local_macro_function macro local_macro_functions es
	# (new_functions,local_macro_functions,es) = copy_local_functions_of_macro local_macro_functions [] es
	= (macro,new_functions,local_macro_functions,es)

copy_local_functions_of_macro :: (Optional CopiedLocalFunctions) [CopiedLocalFunction] *ExpandState -> (![(CopiedLocalFunction,FunDef)],!Optional CopiedLocalFunctions,!*ExpandState);
copy_local_functions_of_macro local_macro_functions local_functions_to_be_copied es
	# (local_functions_to_be_copied,local_macro_functions) = add_new_local_functions_to_be_copied local_functions_to_be_copied local_macro_functions
		with
			add_new_local_functions_to_be_copied local_functions_to_be_copied local_macro_functions=:(Yes copied_local_macro_functions=:{new_copied_local_functions=[]})
				= (local_functions_to_be_copied,Yes {copied_local_macro_functions & used_copied_local_functions=[]})
			add_new_local_functions_to_be_copied local_functions_to_be_copied (Yes {copied_local_functions,new_copied_local_functions,next_local_function_n})
				# local_macro_functions=Yes {copied_local_functions=copied_local_functions++new_copied_local_functions,
											new_copied_local_functions=[],used_copied_local_functions=[],next_local_function_n=next_local_function_n}
				= (local_functions_to_be_copied++new_copied_local_functions,local_macro_functions)
	= case local_functions_to_be_copied of
		[]
			-> ([],local_macro_functions,es)
		[(old_and_new_function_n=:{old_function_n,new_function_n}):local_functions_to_be_copied]
			# (function,es)
				= case old_function_n of
					FunctionOrIclMacroIndex old_function_index
						# (function,es)=es!es_fun_defs.[old_function_index]			
						#! function_group_index=function.fun_info.fi_group_index
						# es = {es & es_fun_defs.[old_function_index].fun_info.fi_group_index= if (function_group_index>NoIndex) (-2-function_group_index) function_group_index}
						# function = {function & fun_info.fi_group_index=if (function_group_index<NoIndex) (-2-function_group_index) function_group_index}
						-> (function,es)
					DclMacroIndex old_function_module_index old_function_index
						# (function,es)=es!es_macro_defs.[old_function_module_index,old_function_index]			
						#! function_group_index=function.fun_info.fi_group_index
						# es = {es & es_macro_defs.[old_function_module_index].[old_function_index].fun_info.fi_group_index= if (function_group_index>NoIndex) (-2-function_group_index) function_group_index}
						# function = {function & fun_info.fi_group_index=if (function_group_index<NoIndex) (-2-function_group_index) function_group_index}
						-> (function,es)
			# (function,local_macro_functions,es) = copy_macro_or_local_macro_function function local_macro_functions es
			# (new_functions,local_macro_functions,es) = copy_local_functions_of_macro local_macro_functions local_functions_to_be_copied es
			-> ([(old_and_new_function_n,function):new_functions],local_macro_functions,es)

update_calls calls No
	= calls
update_calls calls (Yes {used_copied_local_functions=[]})
	= calls
update_calls calls (Yes {used_copied_local_functions})
	# calls = remove_old_calls calls
	= add_new_calls used_copied_local_functions calls
where
	remove_old_calls [call=:(FunCall fc_index _):calls]
		| contains_old_function_n used_copied_local_functions
//			# calls = trace ("remove_old_calls1: "+++toString fc_index) calls
			= remove_old_calls calls
//			# calls = trace ("remove_old_calls2: "+++toString fc_index) calls
			= [call:remove_old_calls calls]
	where
		contains_old_function_n [{old_function_n=FunctionOrIclMacroIndex old_function_index }:local_functions]
			= fc_index==old_function_index || contains_old_function_n local_functions
		contains_old_function_n [_:local_functions]
			= contains_old_function_n local_functions
		contains_old_function_n []
			= False
	remove_old_calls [call=:(MacroCall macro_module_index fc_index _):calls]
		| contains_old_function_n used_copied_local_functions
			= remove_old_calls calls
			= [call:remove_old_calls calls]
	where
		contains_old_function_n [{old_function_n=DclMacroIndex old_macro_module_index old_function_index }:local_functions]
			= fc_index==old_function_index && macro_module_index==old_macro_module_index || contains_old_function_n local_functions
		contains_old_function_n [_:local_functions]
			= contains_old_function_n local_functions
		contains_old_function_n []
			= False
	remove_old_calls [call=:(DclFunCall _ _):calls]
			= [call:remove_old_calls calls]
	remove_old_calls []
		= []
	
	add_new_calls [{new_function_n}:local_functions] calls
//		# local_functions = trace ("add_new_calls: "+++toString new_function_n) local_functions
		= add_new_calls local_functions [FunCall new_function_n NotALevel:calls]
	add_new_calls [] calls
		= calls

copy_macro_or_local_macro_function :: !FunDef !(Optional CopiedLocalFunctions) !*ExpandState -> (!FunDef,!Optional CopiedLocalFunctions,!.ExpandState);
copy_macro_or_local_macro_function macro=:{fun_body = TransformedBody {tb_args,tb_rhs},fun_kind,fun_info={fi_local_vars,fi_calls}} local_macro_functions es=:{es_var_heap,es_symbol_heap}
	# (tb_args,es_var_heap) = create_new_arguments tb_args es_var_heap
		with
			create_new_arguments [var=:{fv_ident,fv_info_ptr} : vars] var_heap
				# (new_vars,var_heap) = create_new_arguments vars var_heap
				# (new_info, var_heap) = newPtr VI_Empty var_heap
				# new_var = { fv_ident = fv_ident, fv_def_level = NotALevel, fv_info_ptr = new_info, fv_count = 0 }
				= ([new_var : new_vars], writePtr fv_info_ptr (VI_Variable fv_ident new_info) var_heap)
			create_new_arguments [] var_heap
				= ([],var_heap)
	# us = { us_symbol_heap = es_symbol_heap, us_var_heap = es_var_heap, us_opt_type_heaps = No,us_cleanup_info = [],
			 us_local_macro_functions = local_macro_functions }
	# (result_expr,{us_local_macro_functions,us_symbol_heap,us_var_heap}) = unfold tb_rhs {ui_handle_aci_free_vars = RemoveThem} us
	# (fi_local_vars,us_var_heap) = update_local_vars fi_local_vars us_var_heap
		with
			update_local_vars :: ![FreeVar] !*(Heap VarInfo) -> (![FreeVar],!*Heap VarInfo);
			update_local_vars [fv=:{fv_info_ptr}:fvs] var_heap
				# (fvs,var_heap)=update_local_vars fvs var_heap
				# (fv_info,var_heap) = readPtr fv_info_ptr var_heap
				# fv = {fv & fv_info_ptr=case fv_info of 
											(VI_Variable _ info_ptr) -> info_ptr
						}
				= ([fv:fvs],var_heap)
			update_local_vars [] var_heap
				= ([],var_heap)
	# fi_calls = update_calls fi_calls us_local_macro_functions
	= ({macro & fun_body = TransformedBody {tb_args=tb_args,tb_rhs=result_expr},fun_info.fi_local_vars=fi_local_vars,fun_info.fi_calls=fi_calls},us_local_macro_functions,
		{es & es_var_heap=us_var_heap, es_symbol_heap=us_symbol_heap})

unfoldMacro :: !FunDef ![Expression] !*ExpandInfo -> (!Expression, !*ExpandInfo)
unfoldMacro {fun_body =fun_body=: TransformedBody {tb_args,tb_rhs}, fun_info = {fi_calls},fun_kind,fun_ident} args (calls, es=:{es_var_heap,es_symbol_heap,es_fun_defs})
	# (let_binds, var_heap) = bind_expressions tb_args args [] es_var_heap
	#! size_fun_defs = size es_fun_defs
	# copied_local_functions = Yes { copied_local_functions=[],used_copied_local_functions=[],new_copied_local_functions=[],next_local_function_n=size_fun_defs}
	# us = { us_symbol_heap = es_symbol_heap, us_var_heap = var_heap, us_opt_type_heaps = No,us_cleanup_info = [], us_local_macro_functions = copied_local_functions }
	# (result_expr,{us_local_macro_functions,us_symbol_heap,us_var_heap}) = unfold tb_rhs {ui_handle_aci_free_vars = RemoveThem} us
	# es = {es & es_var_heap = us_var_heap, es_symbol_heap = us_symbol_heap}	
	# fi_calls = update_calls fi_calls us_local_macro_functions
	# (new_functions,us_local_macro_functions,es) = copy_local_functions_of_macro us_local_macro_functions [] es
	# {es_symbol_heap,es_symbol_table,es_fun_defs,es_new_fun_def_numbers} = es
	# (es_fun_defs,es_new_fun_def_numbers) = case new_functions of
		[]
			-> (es_fun_defs,es_new_fun_def_numbers)
		_
			# last_function_index = case us_local_macro_functions of (Yes {next_local_function_n}) -> next_local_function_n-1
			# new_fun_defs = new_fun_defs
				with
					new_fun_defs :: *{!FunDef}
					new_fun_defs => {fun_def \\ (_,fun_def)<-new_functions}
//			-> ({if (i<size_fun_defs) es_fun_defs.[i] new_fun_defs.[i-size_fun_defs] \\ i<-[0..last_function_index]} // inefficient
//				,[size_fun_defs:es_new_fun_def_numbers])
//			#! new_fun_defs = arrayConcat es_fun_defs new_fun_defs	// leads to backend crash!
			# new_fun_defs = arrayConcat es_fun_defs new_fun_defs
			-> (new_fun_defs, [size_fun_defs:es_new_fun_def_numbers])
	# (calls, fun_defs, es_symbol_table) = updateFunctionCalls fi_calls calls es_fun_defs es_symbol_table
	| isEmpty let_binds
		= (result_expr, (calls, { es & es_symbol_table = es_symbol_table, es_fun_defs=fun_defs,es_new_fun_def_numbers=es_new_fun_def_numbers }))
		# (new_info_ptr, es_symbol_heap) = newPtr EI_Empty es_symbol_heap
		# result_expr=Let { let_strict_binds = [], let_lazy_binds = let_binds, let_expr = result_expr, let_info_ptr = new_info_ptr, let_expr_position = NoPos }
		= (result_expr, (calls, { es & es_symbol_table = es_symbol_table, es_symbol_heap=es_symbol_heap, es_fun_defs=fun_defs,es_new_fun_def_numbers=es_new_fun_def_numbers }))
where
	bind_expressions [var : vars] [expr : exprs] binds var_heap
		# (binds, var_heap) = bind_expressions vars exprs binds var_heap
		= bind_expression var expr binds var_heap
	bind_expressions _ _ binds var_heap
		= (binds, var_heap)

	bind_expression :: FreeVar Expression [LetBind] *(Heap VarInfo) -> (![LetBind],!*Heap VarInfo);
	bind_expression {fv_count} expr binds var_heap
		| fv_count == 0
			= (binds, var_heap)
	bind_expression {fv_info_ptr} (Var {var_ident,var_info_ptr}) binds var_heap
		= (binds, writePtr fv_info_ptr (VI_Variable var_ident var_info_ptr) var_heap)
	bind_expression {fv_ident,fv_info_ptr,fv_count} expr binds var_heap
		| fv_count == 1
			= (binds, writePtr fv_info_ptr (VI_Expression expr) var_heap)
		# (new_info, var_heap) = newPtr VI_Empty var_heap
		  new_var = { fv_ident = fv_ident, fv_def_level = NotALevel, fv_info_ptr = new_info, fv_count = 0 }
		= ([{ lb_src = expr, lb_dst = new_var, lb_position = NoPos} : binds], writePtr fv_info_ptr (VI_Variable fv_ident new_info) var_heap)

::	Group =
	{	group_members	:: ![Int]
	}

::	PartitioningInfo = 
	{	pi_symbol_table	:: !.SymbolTable
	,	pi_var_heap		:: !.VarHeap
	,	pi_symbol_heap	:: !.ExpressionHeap
	,	pi_error		:: !.ErrorAdmin
	,	pi_fun_defs		:: !.{#FunDef}
	,	pi_macro_defs	:: !.{#.{#FunDef}}
	,	pi_next_num		:: !Int
	,	pi_next_group	:: !Int
	,	pi_groups		:: ![[FunctionOrMacroIndex]]
	,	pi_deps			:: ![FunctionOrMacroIndex]
	,	pi_unexpanded_dcl_macros :: ![(Int,Int,FunDef)]
	}

NotChecked :== -1	

:: PredefSymbolsForTransform = { predef_alias_dummy :: !PredefinedSymbol, predef_and :: !PredefinedSymbol, predef_or :: !PredefinedSymbol };

reset_body_of_rhs_macros pi_deps fun_defs macro_defs
	= foldSt reset_body_of_rhs_macro pi_deps (fun_defs,macro_defs)
	where
		reset_body_of_rhs_macro (FunctionOrIclMacroIndex macro_index) (fun_defs,macro_defs)
			# (macro_def,fun_defs) = fun_defs![macro_index]
			= case macro_def.fun_body of
				RhsMacroBody body
					-> ({ fun_defs & [macro_index] = { macro_def & fun_body = CheckedBody body }},macro_defs)
				_
					-> (fun_defs,macro_defs)
		reset_body_of_rhs_macro (DclMacroIndex module_index macro_index) (fun_defs,macro_defs)
			# (macro_def,macro_defs) = macro_defs![module_index,macro_index]
			= case macro_def.fun_body of
				RhsMacroBody body
					-> (fun_defs,{ macro_defs & [module_index,macro_index] = { macro_def & fun_body = CheckedBody body }})
				_
					-> (fun_defs,macro_defs)

expand_simple_macro mod_index macro=:{fun_body = CheckedBody body, fun_info, fun_ident, fun_pos,fun_kind}
		predef_symbols_for_transform pi=:{pi_symbol_table,pi_symbol_heap,pi_var_heap,pi_fun_defs,pi_macro_defs,pi_error}
  	# identPos = newPosition fun_ident fun_pos
	# es = { es_symbol_table = pi_symbol_table, es_var_heap = pi_var_heap,
			 es_symbol_heap = pi_symbol_heap, es_error = setErrorAdmin identPos pi_error,
			 es_fun_defs=pi_fun_defs, es_macro_defs=pi_macro_defs, es_new_fun_def_numbers=[]
		   }			
	# (tb_args, tb_rhs, local_vars, fi_calls, fi_dynamics,{es_symbol_table, es_var_heap, es_symbol_heap, es_error,es_fun_defs,es_macro_defs})
			= expandMacrosInBody [] body fun_info.fi_dynamics predef_symbols_for_transform es
	# macro = { macro & fun_body = TransformedBody { tb_args = tb_args, tb_rhs = tb_rhs},
	  			fun_info = { fun_info & fi_calls = fi_calls, fi_local_vars = local_vars, fi_dynamics=fi_dynamics }}
	= ( macro, { pi & pi_symbol_table = es_symbol_table, pi_symbol_heap = es_symbol_heap, pi_var_heap = es_var_heap, pi_fun_defs = es_fun_defs,pi_macro_defs=es_macro_defs,pi_error = es_error })

expand_dcl_macro_if_simple mod_index macro_index macro=:{fun_body = CheckedBody body, fun_info}
		predef_symbols_for_transform pi=:{pi_symbol_table,pi_symbol_heap,pi_var_heap,pi_fun_defs,pi_macro_defs,pi_error}
	| macros_are_simple fun_info.fi_calls mod_index pi_fun_defs pi_macro_defs && has_no_curried_macro body.cb_rhs pi_fun_defs pi_macro_defs
		# (macro,pi) = expand_simple_macro mod_index macro predef_symbols_for_transform pi
		= { pi & pi_macro_defs.[mod_index,macro_index] = macro }
		= { pi & pi_deps = [DclMacroIndex mod_index macro_index:pi.pi_deps], pi_macro_defs.[mod_index,macro_index] = { macro & fun_body = RhsMacroBody body }} 

expand_icl_macro_if_simple mod_index macro_index macro=:{fun_body = CheckedBody body, fun_info}
		predef_symbols_for_transform pi=:{pi_symbol_table,pi_symbol_heap,pi_var_heap,pi_fun_defs,pi_macro_defs,pi_error}
	| macros_are_simple fun_info.fi_calls mod_index pi_fun_defs pi_macro_defs && has_no_curried_macro body.cb_rhs pi_fun_defs pi_macro_defs
		# (macro,pi) = expand_simple_macro mod_index macro predef_symbols_for_transform pi
		= { pi & pi_fun_defs.[macro_index] = macro }
		= { pi & pi_deps = [FunctionOrIclMacroIndex macro_index:pi.pi_deps], pi_fun_defs.[macro_index] = { macro & fun_body = RhsMacroBody body }}

macros_are_simple :: [FunCall] Int {#FunDef} {#{#FunDef}} -> Bool;
macros_are_simple [] mod_index fun_defs macro_defs
	= True
macros_are_simple [FunCall fc_index _ : calls ] mod_index fun_defs macro_defs
	# {fun_kind,fun_body, fun_ident} = fun_defs.[fc_index]
	= is_a_pattern_macro fun_kind fun_body && macros_are_simple calls mod_index fun_defs macro_defs
macros_are_simple [MacroCall module_index fc_index _ : calls ] mod_index fun_defs macro_defs
	# {fun_kind,fun_body, fun_ident} = macro_defs.[module_index,fc_index]
	= is_a_pattern_macro fun_kind fun_body && macros_are_simple calls mod_index fun_defs macro_defs
macros_are_simple [DclFunCall dcl_fun_index _ : calls ] mod_index fun_defs macro_defs
	= dcl_fun_index<>mod_index && macros_are_simple calls mod_index fun_defs macro_defs

is_a_pattern_macro FK_Macro (TransformedBody {tb_args})
	= True
is_a_pattern_macro _ _
	= False

visit_macro mod_index max_fun_nr predef_symbols_for_transform (FunCall fc_index _) pi
	= partitionate_icl_macro mod_index max_fun_nr predef_symbols_for_transform fc_index pi
visit_macro mod_index max_fun_nr predef_symbols_for_transform (MacroCall macro_module_index fc_index _) pi
	= partitionate_dcl_macro macro_module_index max_fun_nr predef_symbols_for_transform fc_index pi
visit_macro mod_index max_fun_nr predef_symbols_for_transform (DclFunCall _ _) pi
	= pi

partitionate_dcl_macro mod_index max_fun_nr predef_symbols_for_transform macro_index pi
	# (macro_def, pi) = pi!pi_macro_defs.[mod_index,macro_index]
	| case macro_def.fun_kind of FK_Macro->True ; _ -> False
	 	= case macro_def.fun_body of
	 		CheckedBody body
	 			# pi={ pi & pi_macro_defs.[mod_index,macro_index] = { macro_def & fun_body = PartitioningMacro }}
		  		# macros_pi = foldSt (visit_macro mod_index max_fun_nr predef_symbols_for_transform) macro_def.fun_info.fi_calls pi
				-> expand_dcl_macro_if_simple mod_index macro_index macro_def predef_symbols_for_transform macros_pi
	 		PartitioningMacro
	  			# identPos = newPosition macro_def.fun_ident macro_def.fun_pos
	 			-> { pi &  pi_error = checkError macro_def.fun_ident "recursive macro definition" (setErrorAdmin identPos pi.pi_error)  }
	 		_
	 			-> pi
		= pi

partitionate_icl_macro mod_index max_fun_nr predef_symbols_for_transform macro_index pi
	# (macro_def, pi) = pi!pi_fun_defs.[macro_index]
	| case macro_def.fun_kind of FK_Macro->True; _ -> False
	 	= case macro_def.fun_body of
	 		CheckedBody body
	 			# pi={ pi & pi_fun_defs.[macro_index] = { macro_def & fun_body = PartitioningMacro }}
		  		# macros_pi = foldSt (visit_macro mod_index max_fun_nr predef_symbols_for_transform) macro_def.fun_info.fi_calls pi
				-> expand_icl_macro_if_simple mod_index macro_index macro_def predef_symbols_for_transform macros_pi
	 		PartitioningMacro
	  			# identPos = newPosition macro_def.fun_ident macro_def.fun_pos
	 			-> { pi &  pi_error = checkError macro_def.fun_ident "recursive macro definition" (setErrorAdmin identPos pi.pi_error)  }
	 		_
	 			-> pi
		= pi

partitionateDclMacros :: !IndexRange !Index !PredefSymbolsForTransform !*{#FunDef} !*{#*{#FunDef}} !*VarHeap !*ExpressionHeap !*SymbolTable !*ErrorAdmin
																   -> (!*{#FunDef},!*{#*{#FunDef}},!*VarHeap,!*ExpressionHeap,!*SymbolTable,!*ErrorAdmin )
partitionateDclMacros {ir_from,ir_to} mod_index predef_symbols_for_transform fun_defs macro_defs var_heap symbol_heap symbol_table error
	#! max_fun_nr = cMAXINT
	# partitioning_info = { pi_var_heap = var_heap, pi_symbol_heap = symbol_heap,
							pi_symbol_table = symbol_table, pi_fun_defs=fun_defs, pi_macro_defs=macro_defs,
							pi_error = error, pi_deps = [], pi_next_num = 0, pi_next_group = 0, pi_groups = [],
							pi_unexpanded_dcl_macros=[] }
	  {pi_symbol_table, pi_var_heap, pi_symbol_heap, pi_fun_defs, pi_macro_defs, pi_error, pi_next_group, pi_groups, pi_deps}
	  		= iFoldSt (partitionate_dcl_macro mod_index max_fun_nr predef_symbols_for_transform) ir_from ir_to partitioning_info
	  (fun_defs,macro_defs) = reset_body_of_rhs_macros pi_deps pi_fun_defs pi_macro_defs
	= (fun_defs,macro_defs, pi_var_heap, pi_symbol_heap, pi_symbol_table, pi_error)

partitionateIclMacros :: !IndexRange !Index !PredefSymbolsForTransform !*{#FunDef} !*{#*{#FunDef}} !*VarHeap !*ExpressionHeap !*SymbolTable !*ErrorAdmin
																   -> (!*{#FunDef},!*{#*{#FunDef}},!*VarHeap,!*ExpressionHeap,!*SymbolTable,!*ErrorAdmin )
partitionateIclMacros {ir_from,ir_to} mod_index predef_symbols_for_transform fun_defs macro_defs var_heap symbol_heap symbol_table error
	#! max_fun_nr = cMAXINT
	# partitioning_info = { pi_var_heap = var_heap, pi_symbol_heap = symbol_heap,
							pi_symbol_table = symbol_table, pi_fun_defs=fun_defs, pi_macro_defs=macro_defs,
							pi_error = error, pi_deps = [], pi_next_num = 0, pi_next_group = 0, pi_groups = [],
							pi_unexpanded_dcl_macros=[] }
	  {pi_symbol_table, pi_var_heap, pi_symbol_heap, pi_fun_defs, pi_macro_defs, pi_error, pi_next_group, pi_groups, pi_deps}
	  		= iFoldSt (partitionate_icl_macro mod_index max_fun_nr predef_symbols_for_transform) ir_from ir_to partitioning_info
	  (fun_defs,macro_defs) = reset_body_of_rhs_macros pi_deps pi_fun_defs pi_macro_defs
	= (fun_defs,macro_defs, pi_var_heap, pi_symbol_heap, pi_symbol_table, pi_error)

add_new_macros_to_groups :: ![Int] !Int Int  *{#FunDef}  [FunctionOrMacroIndex]  [[FunctionOrMacroIndex]]
								   -> (!Int,!*{#FunDef},![FunctionOrMacroIndex],![[FunctionOrMacroIndex]]);
add_new_macros_to_groups [new_macro_fun_def_index] n_fun_defs_after_expanding_macros pi_next_group es_fun_defs functions_in_group pi_groups
	= add_new_macro_and_local_functions_to_groups new_macro_fun_def_index n_fun_defs_after_expanding_macros pi_next_group es_fun_defs functions_in_group pi_groups
add_new_macros_to_groups [new_macro_fun_def_index:macro_fun_def_numbers=:[next_macro_fun_def_index:_]] n_fun_defs_after_expanding_macros pi_next_group es_fun_defs functions_in_group pi_groups
	# (pi_next_group,es_fun_defs,functions_in_group,pi_groups)
		= add_new_macro_and_local_functions_to_groups new_macro_fun_def_index next_macro_fun_def_index pi_next_group es_fun_defs functions_in_group pi_groups
	= add_new_macros_to_groups macro_fun_def_numbers n_fun_defs_after_expanding_macros pi_next_group es_fun_defs functions_in_group pi_groups
add_new_macros_to_groups [] n_fun_defs_after_expanding_macros pi_next_group es_fun_defs functions_in_group pi_groups
	= (pi_next_group,es_fun_defs,functions_in_group,pi_groups)

add_new_macro_and_local_functions_to_groups :: !Int !Int Int  *{#FunDef}  [FunctionOrMacroIndex]  [[FunctionOrMacroIndex]]
													-> (!Int,!*{#FunDef},![FunctionOrMacroIndex],![[FunctionOrMacroIndex]]);
add_new_macro_and_local_functions_to_groups new_macro_fun_def_index n_fun_defs_after_expanding_macros pi_next_group es_fun_defs functions_in_group pi_groups
	# (pi_next_group,es_fun_defs,functions_in_group,macros)
		= add_macros_to_current_group new_macro_fun_def_index n_fun_defs_after_expanding_macros pi_next_group es_fun_defs functions_in_group []
	# (macros_with_group_numbers,es_fun_defs) = add_group_numbers macros es_fun_defs
		with
			add_group_numbers [fun_def_index:l] es_fun_defs
				# (group_number,es_fun_defs) = es_fun_defs![fun_def_index].fun_info.fi_group_index
//				# group_number=trace ("add_group_numbers: "+++toString fun_def_index+++" "+++toString group_number+++"\n") group_number;
				# (l,es_fun_defs) = add_group_numbers l es_fun_defs
				= ([(fun_def_index,group_number):l],es_fun_defs)
			add_group_numbers [] es_fun_defs
				= ([],es_fun_defs)
	# sorted_macros_with_group_numbers = sortBy (\(_,group_number1) (_,group_number2) -> group_number1<group_number2) macros_with_group_numbers
	# (pi_next_group,pi_groups) = partition_macros_in_groups sorted_macros_with_group_numbers [] (-1) pi_next_group pi_groups
		with
			partition_macros_in_groups [(fun_def_index,fun_def_group_number):l] [] group_number pi_next_group pi_groups
				= partition_macros_in_groups l [FunctionOrIclMacroIndex fun_def_index] fun_def_group_number pi_next_group pi_groups
			partition_macros_in_groups [(fun_def_index,fun_def_group_number):l] group group_number pi_next_group pi_groups
				| fun_def_group_number==group_number
					= partition_macros_in_groups l [FunctionOrIclMacroIndex fun_def_index:group] group_number pi_next_group pi_groups
					# pi_groups=[group:pi_groups]
					# pi_next_group=pi_next_group+1
					= partition_macros_in_groups l [FunctionOrIclMacroIndex fun_def_index] fun_def_group_number pi_next_group pi_groups			
			partition_macros_in_groups [] [] group_number pi_next_group pi_groups
				= (pi_next_group,pi_groups)
			partition_macros_in_groups [] last_group group_number pi_next_group pi_groups
				= (pi_next_group+1,[last_group:pi_groups])
	= (pi_next_group,es_fun_defs,functions_in_group,pi_groups)

add_macros_to_current_group :: !Int !Int Int *{#FunDef} [FunctionOrMacroIndex] [Int] -> (!Int,!*{#FunDef},![FunctionOrMacroIndex],![Int]);
add_macros_to_current_group new_macro_fun_def_index n_fun_defs_after_expanding_macros pi_next_group es_fun_defs functions_in_group macros
	| new_macro_fun_def_index>=n_fun_defs_after_expanding_macros
		= (pi_next_group,es_fun_defs,functions_in_group,macros)
	| es_fun_defs.[new_macro_fun_def_index].fun_info.fi_group_index<=NoIndex
		= abort ("add_macros_to_current_group: "+++toString new_macro_fun_def_index)
//				+++" "+++toString es_fun_defs.[new_macro_fun_def_index].fun_info.fi_group_index)

	| es_fun_defs.[new_macro_fun_def_index].fun_info.fi_group_index==pi_next_group
//		# new_macro_fun_def_index=trace ("add_macros_to_current_group1: "+++toString new_macro_fun_def_index+++"\n") new_macro_fun_def_index;
		# functions_in_group=[FunctionOrIclMacroIndex new_macro_fun_def_index:functions_in_group]
		= add_macros_to_current_group (new_macro_fun_def_index+1) n_fun_defs_after_expanding_macros pi_next_group es_fun_defs functions_in_group macros

//		# new_macro_fun_def_index=trace ("add_macros_to_current_group2: "+++toString new_macro_fun_def_index+++"\n") new_macro_fun_def_index;
//		# pi_groups=[[new_macro_fun_def_index]:pi_groups]
//		# pi_next_group=pi_next_group+1
		= add_macros_to_current_group (new_macro_fun_def_index+1) n_fun_defs_after_expanding_macros pi_next_group es_fun_defs functions_in_group [new_macro_fun_def_index:macros]

has_no_curried_macro cb_rhs fun_defs macro_defs
	= has_no_curried_macro_CheckedAlternative cb_rhs
where
	has_no_curried_macro_CheckedAlternative [{ca_rhs}:cas]
		= has_no_curried_macro_Expression ca_rhs && has_no_curried_macro_CheckedAlternative cas
	has_no_curried_macro_CheckedAlternative []
		= True

	has_no_curried_macro_Expression (App {app_symb={symb_kind = SK_DclMacro {glob_object,glob_module}}, app_args})
		| macro_defs.[glob_module,glob_object].fun_arity<>length app_args
			= False;
			= has_no_curried_macro_Expressions app_args
	has_no_curried_macro_Expression (App {app_symb={symb_kind = SK_IclMacro glob_object}, app_args})
		| fun_defs.[glob_object].fun_arity<>length app_args
			= False;
			= has_no_curried_macro_Expressions app_args
	has_no_curried_macro_Expression (App {app_args})
		= has_no_curried_macro_Expressions app_args
	has_no_curried_macro_Expression (expr @ exprs)
		= has_no_curried_macro_Expression expr && has_no_curried_macro_Expressions exprs
	has_no_curried_macro_Expression (Let {let_strict_binds, let_lazy_binds, let_expr})
		= has_no_curried_macro_LetBinds let_strict_binds && has_no_curried_macro_LetBinds let_lazy_binds && has_no_curried_macro_Expression let_expr
		where
				has_no_curried_macro_LetBinds [{lb_src}:xs]
					= has_no_curried_macro_Expression lb_src && has_no_curried_macro_LetBinds xs
				has_no_curried_macro_LetBinds []
					= True
	has_no_curried_macro_Expression (Case {case_expr,case_guards,case_default})
		=	has_no_curried_macro_Expression case_expr && has_no_curried_macro_CasePatterns case_guards && has_no_curried_macro_OptionalExpression case_default
		where
			has_no_curried_macro_CasePatterns (AlgebraicPatterns type patterns)
				= has_no_curried_macro_AlgebraicPatterns patterns
			where
				has_no_curried_macro_AlgebraicPatterns [{ap_expr}:patterns]
					= has_no_curried_macro_Expression ap_expr && has_no_curried_macro_AlgebraicPatterns patterns
				has_no_curried_macro_AlgebraicPatterns []
					= True
			has_no_curried_macro_CasePatterns (BasicPatterns type patterns)
				= has_no_curried_macro_BasicPatterns patterns
			where
				has_no_curried_macro_BasicPatterns [{bp_expr}:patterns]
					= has_no_curried_macro_Expression bp_expr && has_no_curried_macro_BasicPatterns patterns
				has_no_curried_macro_BasicPatterns []
					= True
			has_no_curried_macro_CasePatterns (DynamicPatterns patterns)
				= has_no_curried_macro_DynamicPatterns patterns
			where
				has_no_curried_macro_DynamicPatterns [{dp_rhs}:patterns]
					= has_no_curried_macro_Expression dp_rhs && has_no_curried_macro_DynamicPatterns patterns
				has_no_curried_macro_DynamicPatterns []
					= True

			has_no_curried_macro_OptionalExpression (Yes expr)
				= has_no_curried_macro_Expression expr
			has_no_curried_macro_OptionalExpression No
				= True
	has_no_curried_macro_Expression (Selection is_unique expr selectors)
		= has_no_curried_macro_Expression expr && has_no_curried_macro_Selections selectors
	has_no_curried_macro_Expression (Update expr1 selectors expr2)
		= has_no_curried_macro_Expression expr1 && has_no_curried_macro_Expression expr2 && has_no_curried_macro_Selections selectors
	has_no_curried_macro_Expression (RecordUpdate cons_symbol expression expressions)
		= has_no_curried_macro_Expression expression && has_no_curried_macro_Binds expressions
		where
			has_no_curried_macro_Binds [{bind_src}:binds]
				= has_no_curried_macro_Expression bind_src && has_no_curried_macro_Binds binds
			has_no_curried_macro_Binds []
				= True
	has_no_curried_macro_Expression (TupleSelect symbol argn_nr expr)
		= has_no_curried_macro_Expression expr
	has_no_curried_macro_Expression (MatchExpr cons_ident expr)
		= has_no_curried_macro_Expression expr
	has_no_curried_macro_Expression expr
		= True

	has_no_curried_macro_Expressions [x:xs]
		= has_no_curried_macro_Expression x && has_no_curried_macro_Expressions xs
	has_no_curried_macro_Expressions []
		= True

	has_no_curried_macro_Selections [ArraySelection array_select expr_ptr index_expr:selections]
		= has_no_curried_macro_Expression index_expr && has_no_curried_macro_Selections selections
	has_no_curried_macro_Selections [record_selection:selections]
		= has_no_curried_macro_Selections selections
	has_no_curried_macro_Selections []
		= True

partitionateAndLiftFunctions :: ![IndexRange] !Index !PredefSymbolsForTransform !*{#FunDef} !*{#*{#FunDef}} !*VarHeap !*ExpressionHeap !*SymbolTable !*ErrorAdmin
																-> (!*{!Group}, !*{#FunDef},!*{#*{#FunDef}},!*VarHeap,!*ExpressionHeap,!*SymbolTable,!*ErrorAdmin )
partitionateAndLiftFunctions ranges main_dcl_module_n predef_symbols_for_transform fun_defs macro_defs var_heap symbol_heap symbol_table error
	#! max_fun_nr = cMAXINT
	# partitioning_info = {	pi_var_heap = var_heap, pi_symbol_heap = symbol_heap, pi_symbol_table = symbol_table, pi_fun_defs=fun_defs, pi_macro_defs=macro_defs,
							pi_error = error, pi_deps = [], pi_next_num = 0, pi_next_group = 0, pi_groups = [],
							pi_unexpanded_dcl_macros=[] }
	  {pi_groups, pi_symbol_table, pi_var_heap, pi_symbol_heap, pi_fun_defs, pi_macro_defs, pi_error,pi_unexpanded_dcl_macros}
	  		= foldSt (partitionate_functions main_dcl_module_n max_fun_nr) ranges partitioning_info
	# (reversed_pi_groups,fun_defs) = remove_macros_from_groups_and_reverse pi_groups pi_fun_defs []
	# groups = { {group_members = group} \\ group <- reversed_pi_groups }
	# pi_macro_defs = restore_unexpanded_dcl_macros pi_unexpanded_dcl_macros pi_macro_defs
		with
			restore_unexpanded_dcl_macros [(macro_module_index,macro_index,macro_def):unexpanded_dcl_macros] macro_defs
				# macro_defs = {macro_defs & [macro_module_index,macro_index] = macro_def}
				= restore_unexpanded_dcl_macros unexpanded_dcl_macros macro_defs
			restore_unexpanded_dcl_macros [] macro_defs
				= macro_defs
	= (groups, fun_defs, pi_macro_defs, pi_var_heap, pi_symbol_heap, pi_symbol_table, pi_error)
where
	remove_macros_from_groups_and_reverse [group:groups] fun_defs result_groups
		# (group,fun_defs) = remove_macros_from_group group fun_defs
		= case group of
			[]	-> remove_macros_from_groups_and_reverse groups fun_defs result_groups
			_	-> remove_macros_from_groups_and_reverse groups fun_defs [group:result_groups]
	where
		remove_macros_from_group [FunctionOrIclMacroIndex fun:funs] fun_defs
			# (funs,fun_defs)=remove_macros_from_group funs fun_defs
			| fun_defs.[fun].fun_info.fi_group_index<NoIndex
				= (funs,fun_defs)
				= ([fun:funs],fun_defs)
		remove_macros_from_group [DclMacroIndex macro_module_index macro_index:funs] fun_defs		
			= remove_macros_from_group funs fun_defs
		remove_macros_from_group [] fun_defs
			= ([],fun_defs);
	remove_macros_from_groups_and_reverse [] fun_defs result_groups
		= (result_groups,fun_defs);

	partitionate_functions mod_index max_fun_nr {ir_from,ir_to} pi
		= iFoldSt (partitionate_global_function mod_index max_fun_nr) ir_from ir_to pi
		
	partitionate_global_function mod_index max_fun_nr fun_index pi
		# (_,pi) = partitionate_function mod_index max_fun_nr fun_index pi
		= pi

	partitionate_function mod_index max_fun_nr fun_index pi
		# (fun_def, pi) = pi!pi_fun_defs.[fun_index]
		= case fun_def.fun_body of
			CheckedBody body
				# fun_number = pi.pi_next_num
				# (min_dep, pi) = foldSt (visit_function mod_index max_fun_nr) fun_def.fun_info.fi_calls
						(max_fun_nr,
							{ pi & pi_fun_defs={ pi.pi_fun_defs & [fun_index] = { fun_def & fun_body = PartitioningFunction body fun_number }},
								   pi_next_num = inc fun_number, pi_deps = [FunctionOrIclMacroIndex fun_index : pi.pi_deps] })
				-> try_to_close_group max_fun_nr (-1) fun_index fun_number min_dep pi
			PartitioningFunction _ fun_number
				-> (fun_number, pi)
			TransformedBody _
				| fun_def.fun_info.fi_group_index == NoIndex
					# pi =  add_called_macros fun_def.fun_info.fi_calls pi
					-> (max_fun_nr,
//					-> (max_fun_nr, ({ fun_defs & [fun_index] = {fun_def & fun_info.fi_group_index = -2-pi.pi_next_group }},
							{pi & pi_fun_defs.[fun_index] = {fun_def & fun_info.fi_group_index = pi.pi_next_group },
								  pi_next_group = inc pi.pi_next_group, pi_groups = [ [FunctionOrIclMacroIndex fun_index] : pi.pi_groups]}
//							{pi & pi_next_group = pi.pi_next_group}
							)
					-> (max_fun_nr, pi)
			GeneratedBody
				/*	
				// allocate a group that contains this and only this function		
				| fun_def.fun_info.fi_group_index == NoIndex
					# pi = { pi & pi_fun_defs.[fun_index] = { fun_def & fun_info.fi_group_index = pi.pi_next_group },
								  pi_groups = [[FunctionOrIclMacroIndex fun_index] : pi.pi_groups] , pi_next_group = inc pi.pi_next_group }
					-> (max_fun_nr, pi)
					-> abort ("generated function already has a group index: " +++ toString fun_def.fun_ident +++ " " +++ toString fun_index +++ "\n")
				*/
				// do not allocate a group, it will be allocated during generic phase
				-> (max_fun_nr, pi)					
	partitionate_macro mod_index max_fun_nr macro_module_index macro_index pi
		# (fun_def, pi) = pi!pi_macro_defs.[macro_module_index,macro_index]
		= case fun_def.fun_body of
			CheckedBody body
				# fun_number = pi.pi_next_num			
				# pi={pi & pi_unexpanded_dcl_macros=[(macro_module_index,macro_index,fun_def):pi.pi_unexpanded_dcl_macros]}
				# (min_dep, pi) = foldSt (visit_function mod_index max_fun_nr) fun_def.fun_info.fi_calls
						(max_fun_nr,
							{ pi & pi_macro_defs.[macro_module_index,macro_index] = { fun_def & fun_body = PartitioningFunction body fun_number },
								   pi_next_num = inc fun_number, pi_deps = [DclMacroIndex macro_module_index macro_index : pi.pi_deps] })
				-> try_to_close_group max_fun_nr macro_module_index macro_index fun_number min_dep pi
			PartitioningFunction _ fun_number
				-> (fun_number, pi)
			TransformedBody _
				| fun_def.fun_info.fi_group_index == NoIndex
					# pi =  add_called_macros fun_def.fun_info.fi_calls pi
					-> (max_fun_nr,
							{pi & pi_macro_defs.[macro_module_index,macro_index] = {fun_def & fun_info.fi_group_index = pi.pi_next_group },
								  pi_next_group = inc pi.pi_next_group, pi_groups = [ [DclMacroIndex macro_module_index macro_index] : pi.pi_groups]}
							)
					-> (max_fun_nr, pi)
						
	visit_function mod_index max_fun_nr (FunCall fc_index _) (min_dep, pi)
		# (next_min, pi) = partitionate_function mod_index max_fun_nr fc_index pi
		= (min next_min min_dep, pi)
	visit_function mod_index max_fun_nr (MacroCall macro_module_index fc_index _) (min_dep, pi)
		# (next_min, pi) = partitionate_macro mod_index max_fun_nr macro_module_index fc_index pi
		= (min next_min min_dep, pi)
	visit_function mod_index max_fun_nr (DclFunCall dcl_fun_module_index dcl_fun_index) (min_dep, pi)
		| mod_index==dcl_fun_module_index
			# (next_min, pi) = partitionate_function mod_index max_fun_nr dcl_fun_index pi
			= (min next_min min_dep, pi)
			= (min_dep, pi)

	try_to_close_group max_fun_nr macro_module_index fun_index fun_number min_dep 
					pi=:{pi_symbol_table, pi_var_heap, pi_symbol_heap, pi_fun_defs,pi_macro_defs,pi_deps, pi_groups, pi_next_group, pi_error,pi_unexpanded_dcl_macros}
		| fun_number <= min_dep
			# (pi_deps, functions_in_group, macros_in_group, fun_defs,pi_macro_defs)
					= close_group macro_module_index fun_index pi_deps [] [] max_fun_nr pi_next_group pi_fun_defs pi_macro_defs
			  {ls_x={x_fun_defs=fun_defs,x_macro_defs}, ls_var_heap=pi_var_heap, ls_expr_heap=pi_symbol_heap}
			  		= liftFunctions (functions_in_group ++ macros_in_group) pi_next_group main_dcl_module_n fun_defs pi_macro_defs pi_var_heap pi_symbol_heap		  
			# es = expand_macros_in_group macros_in_group
			  			{	es_symbol_table = pi_symbol_table, es_var_heap = pi_var_heap, es_symbol_heap = pi_symbol_heap,
			  				es_fun_defs=fun_defs, es_macro_defs=x_macro_defs, es_new_fun_def_numbers=[],
				  			es_error = pi_error }
			# {es_symbol_table, es_var_heap, es_symbol_heap, es_error,es_fun_defs,es_macro_defs,es_new_fun_def_numbers}
			  		= expand_macros_in_group functions_in_group es
			# (n_fun_defs_after_expanding_macros,es_fun_defs) = usize es_fun_defs
			# (pi_next_group,es_fun_defs,functions_in_group,pi_groups)
				= add_new_macros_to_groups (reverse es_new_fun_def_numbers) n_fun_defs_after_expanding_macros pi_next_group es_fun_defs functions_in_group pi_groups
			= (max_fun_nr, { pi & pi_deps = pi_deps, pi_var_heap = es_var_heap,
						pi_symbol_table = es_symbol_table, pi_fun_defs=es_fun_defs, pi_macro_defs=es_macro_defs,
						pi_error = es_error, pi_symbol_heap = es_symbol_heap, 
						pi_next_group = inc pi_next_group, 
						pi_groups = [ functions_in_group ++ macros_in_group : pi_groups ],pi_unexpanded_dcl_macros=pi_unexpanded_dcl_macros })
			= (min_dep, pi)
	where
		close_group macro_module_index fun_index [index=:FunctionOrIclMacroIndex d:ds] functions_in_group macros_in_group nr_of_fun_defs group_number fun_defs macro_defs
			# (fun_def, fun_defs) = fun_defs![d]
			| case fun_def.fun_kind of FK_Macro->True; _ -> False
				# fun_defs = { fun_defs & [d] = { fun_def & fun_info.fi_group_index = -2-group_number }}
//				# fun_defs = { fun_defs & [d] = { fun_def & fun_info.fi_group_index = group_number }}
				# macros_in_group = [index : macros_in_group]
				| d == fun_index && macro_module_index==(-1)
					= (ds, functions_in_group, macros_in_group, fun_defs,macro_defs)
					= close_group macro_module_index fun_index ds functions_in_group macros_in_group nr_of_fun_defs group_number fun_defs macro_defs
				# fun_defs = { fun_defs & [d] = { fun_def & fun_info.fi_group_index = group_number }}
				# functions_in_group = [index : functions_in_group]
				| d == fun_index && macro_module_index==(-1)
					= (ds, functions_in_group, macros_in_group, fun_defs,macro_defs)
					= close_group macro_module_index fun_index ds functions_in_group macros_in_group nr_of_fun_defs group_number fun_defs macro_defs
		close_group macro_module_index fun_index [index=:DclMacroIndex module_index d:ds] functions_in_group macros_in_group nr_of_fun_defs group_number fun_defs macro_defs
			# (fun_def, macro_defs) = macro_defs![module_index,d]
			| case fun_def.fun_kind of FK_Macro->True; _ -> False
				# macro_defs = { macro_defs & [module_index,d] = { fun_def & fun_info.fi_group_index = -2-group_number }}
				# macros_in_group = [index : macros_in_group]
				| d == fun_index && macro_module_index==module_index
					= (ds, functions_in_group, macros_in_group, fun_defs,macro_defs)
					= close_group macro_module_index fun_index ds functions_in_group macros_in_group nr_of_fun_defs group_number fun_defs macro_defs
				# macro_defs = { macro_defs & [module_index,d] = { fun_def & fun_info.fi_group_index = group_number }}
				# functions_in_group = [index : functions_in_group]
				| d == fun_index && macro_module_index==module_index
					= (ds, functions_in_group, macros_in_group, fun_defs,macro_defs)
					= close_group macro_module_index fun_index ds functions_in_group macros_in_group nr_of_fun_defs group_number fun_defs macro_defs

		expand_macros_in_group group es
			= foldSt expand_macros group es
		where
			expand_macros (FunctionOrIclMacroIndex fun_index) es
				# (fun_def,es) = es!es_fun_defs.[fun_index]
				  {fun_ident,fun_body = PartitioningFunction body _, fun_info, fun_pos,fun_kind} = fun_def
			  	  identPos = newPosition fun_ident fun_pos
				# es={ es & es_error = setErrorAdmin identPos es.es_error }
				# (tb_args, tb_rhs, fi_local_vars, fi_calls,fi_dynamics, es)
						= expandMacrosInBody fun_info.fi_calls body fun_info.fi_dynamics predef_symbols_for_transform es
				  fun_def = { fun_def & fun_body = TransformedBody { tb_args = tb_args, tb_rhs = tb_rhs},
				  			fun_info = { fun_info & fi_calls = fi_calls, fi_local_vars = fi_local_vars,fi_dynamics=fi_dynamics }}
				= {es & es_fun_defs.[fun_index] = fun_def }
			expand_macros (DclMacroIndex macro_module_index fun_index) es
				# (old_fun_def,es) = es!es_macro_defs.[macro_module_index,fun_index]
				  {fun_ident,fun_body = PartitioningFunction body _, fun_info, fun_pos,fun_kind} = old_fun_def
			  	  identPos = newPosition fun_ident fun_pos
				#  es={ es & es_error = setErrorAdmin identPos es.es_error }
				# (tb_args, tb_rhs, fi_local_vars, fi_calls,fi_dynamics, es)
						= expandMacrosInBody fun_info.fi_calls body fun_info.fi_dynamics predef_symbols_for_transform es
				  fun_def = { old_fun_def & fun_body = TransformedBody { tb_args = tb_args, tb_rhs = tb_rhs},
				  			fun_info = { fun_info & fi_calls = fi_calls, fi_local_vars = fi_local_vars,fi_dynamics=fi_dynamics }}
				= {es & es_macro_defs.[macro_module_index,fun_index] = fun_def }
	
	add_called_macros calls pi
		= foldSt add_called_macro calls pi
	where
		add_called_macro (FunCall fc_index _) pi
//			# fc_index = trace_n ("add_called_macro: "+++toString fc_index+++" ") fc_index
			# (macro_def, pi) = pi!pi_fun_defs.[fc_index]
			= case macro_def.fun_body of
				TransformedBody _
					| macro_def.fun_info.fi_group_index == NoIndex
						# pi = add_called_macros macro_def.fun_info.fi_calls pi
//						->	({ macro_defs & [fc_index] = {macro_def & fun_info.fi_group_index = pi.pi_next_group }},
//						# fc_index = trace ("add_called_macro2: "+++toString fc_index+++" ") fc_index
//						->	({ macro_defs & [fc_index] = {macro_def & fun_info.fi_group_index = -2-pi.pi_next_group }},
						->	{pi & pi_fun_defs.[fc_index] = {macro_def & fun_info.fi_group_index = pi.pi_next_group },
									pi_next_group = inc pi.pi_next_group, pi_groups = [ [FunctionOrIclMacroIndex fc_index] : pi.pi_groups]}
//								{pi & pi_next_group = pi.pi_next_group}
						-> pi

addFunctionCallsToSymbolTable calls fun_defs macro_defs symbol_table
	= foldSt add_function_call_to_symbol_table calls ([], fun_defs,macro_defs, symbol_table)
where
	add_function_call_to_symbol_table fc=:(FunCall fc_index _) (collected_calls, fun_defs,macro_defs, symbol_table)
		# ({fun_ident = { id_info }, fun_kind}, fun_defs) = fun_defs![fc_index]
		= case fun_kind of
			FK_Macro
				-> (collected_calls, fun_defs,macro_defs,symbol_table)
			_
				# (entry, symbol_table) = readPtr id_info symbol_table
				-> ([fc : collected_calls], fun_defs,macro_defs,
					symbol_table <:= (id_info, { ste_kind = STE_Called [FunctionOrIclMacroIndex fc_index], ste_index = NoIndex, ste_def_level = NotALevel, ste_previous = entry }))
	add_function_call_to_symbol_table (MacroCall _ _ _) (collected_calls, fun_defs,macro_defs, symbol_table)
		= (collected_calls, fun_defs,macro_defs,symbol_table)
	add_function_call_to_symbol_table (DclFunCall _ _) (collected_calls, fun_defs,macro_defs, symbol_table)
		= (collected_calls, fun_defs,macro_defs,symbol_table)

removeFunctionCallsFromSymbolTable calls fun_defs symbol_table
	= foldSt remove_function_call_from_symbol_table calls (fun_defs, symbol_table)
where
	remove_function_call_from_symbol_table (FunCall fc_index _) (fun_defs, symbol_table)
		# ({fun_ident = { id_info }}, fun_defs) = fun_defs![fc_index]
		  (entry, symbol_table) = readPtr id_info symbol_table
		= case entry.ste_kind of
			STE_Called indexes
				-> (fun_defs, symbol_table <:= (id_info, entry.ste_previous))
			_
				-> (fun_defs, symbol_table)


expandMacrosInBody :: [.FunCall] CheckedBody ![ExprInfoPtr] PredefSymbolsForTransform *ExpandState -> ([FreeVar],Expression,[FreeVar],[FunCall],![ExprInfoPtr],.ExpandState);
expandMacrosInBody fi_calls {cb_args,cb_rhs} fi_dynamics predef_symbols_for_transform es=:{es_symbol_table,es_symbol_heap,es_fun_defs,es_macro_defs}
	# (prev_calls, fun_defs, macro_defs,es_symbol_table)
			= addFunctionCallsToSymbolTable fi_calls es_fun_defs es_macro_defs es_symbol_table
	  ([rhs:rhss], (all_calls, es) )
	  		= mapSt expandCheckedAlternative cb_rhs (prev_calls, { es & es_fun_defs=fun_defs, es_macro_defs=macro_defs,es_symbol_table = es_symbol_table, es_symbol_heap=es_symbol_heap })
	  (fun_defs, symbol_table)
	  		= removeFunctionCallsFromSymbolTable all_calls es.es_fun_defs es.es_symbol_table
	  ((merged_rhs, _), es_var_heap, es_symbol_heap, es_error)
	  		= mergeCases rhs rhss es.es_var_heap es.es_symbol_heap es.es_error
	  (new_rhs, new_args, local_vars, fi_dynamics, {cos_error, cos_var_heap, cos_symbol_heap})
	  		= determineVariablesAndRefCounts cb_args merged_rhs
	  				{ cos_error = es_error, cos_var_heap = es_var_heap, cos_symbol_heap = es_symbol_heap,
	  					cos_predef_symbols_for_transform = predef_symbols_for_transform }
	= (new_args, new_rhs, local_vars, all_calls, fi_dynamics,
		{ es & es_error = cos_error, es_var_heap = cos_var_heap, es_symbol_heap = cos_symbol_heap, es_fun_defs=fun_defs, es_symbol_table = symbol_table })
//		---> ("expandMacrosInBody", (cb_args, ca_rhs, '\n'), ("merged_rhs", merged_rhs, '\n'), ("new_rhs", new_args, local_vars, (new_rhs, '\n')))


expandCheckedAlternative {ca_rhs, ca_position} ei
	# (ca_rhs, ei) = expand ca_rhs ei
	= ((ca_rhs, ca_position), ei)


::	ExpandInfo :== (![FunCall], !.ExpandState)

add_new_fun_defs new_functions new_function_index last_function_index es=:{es_fun_defs,es_new_fun_def_numbers}
	# new_fun_defs = new_fun_defs
		with
			new_fun_defs :: *{!FunDef}
			new_fun_defs => {fun_def \\ (_,fun_def)<-new_functions}
	# es_fun_defs = {if (i<new_function_index) es_fun_defs.[i] new_fun_defs.[i-new_function_index] \\ i<-[0..last_function_index]} // inefficient
	= {es & es_fun_defs=es_fun_defs,es_new_fun_def_numbers=[new_function_index:es_new_fun_def_numbers]}

class expand a :: !a !*ExpandInfo -> (!a, !*ExpandInfo)

instance expand Expression
where
	expand (App app=:{app_symb = symb=:{symb_kind = SK_DclMacro {glob_object,glob_module}}, app_args}) ei
		# (app_args, (calls, es)) = expand app_args ei
		# (macro, es) = es!es_macro_defs.[glob_module,glob_object]
		#! macro_group_index=macro.fun_info.fi_group_index
		# es = {es & es_macro_defs.[glob_module,glob_object].fun_info.fi_group_index= if (macro_group_index>NoIndex) (-2-macro_group_index) macro_group_index}
		| macro.fun_arity == length app_args
			= unfoldMacro macro app_args (calls, es)

			# macro = {macro & fun_info.fi_group_index=if (macro_group_index<NoIndex) (-2-macro_group_index) macro_group_index}
			#! new_function_index = size es.es_fun_defs
			# copied_local_functions = Yes { copied_local_functions=[],used_copied_local_functions=[],new_copied_local_functions=[],next_local_function_n=new_function_index+1}

			# (macro,new_functions,local_macro_functions,es) = copy_macro_and_local_functions macro copied_local_functions es			
//			# new_function_index=trace ("new_function_index: "+++toString new_function_index+++"\n") new_function_index;
			# last_function_index = case local_macro_functions of (Yes {next_local_function_n}) -> next_local_function_n-1
			# es = add_new_fun_defs [({old_function_n=DclMacroIndex glob_module glob_object,new_function_n=new_function_index},macro):new_functions] new_function_index last_function_index es
			# (calls, es_symbol_table) = examineFunctionCall macro.fun_ident (FunCall new_function_index NotALevel) (calls, es.es_symbol_table)
			# app = App { app & app_symb = { symb & symb_kind = SK_LocalMacroFunction new_function_index }, app_args = app_args }

/*			| macro.fun_info.fi_group_index>NoIndex
				# macro = {macro & fun_info.fi_group_index= -2-macro.fun_info.fi_group_index}
				# es= {es & es_fun_defs.[new_function_index]=macro}
				= (app, (calls, { es & es_symbol_table = es_symbol_table }))
*/
			= (app, (calls, { es & es_symbol_table = es_symbol_table }))

/*
			# (calls, es_symbol_table) = examineFunctionCall macro.fun_ident {fc_index = glob_object, fc_level = NotALevel} (calls, es.es_symbol_table)
			# app = App { app & app_symb = { symb & symb_kind = SK_Function {glob_object = glob_object, glob_module = glob_module} }, app_args = app_args }
			| macro.fun_info.fi_group_index<NoIndex
				# macro = {macro & fun_info.fi_group_index= -2-macro.fun_info.fi_group_index}
				# es= {es & es_fun_defs.[glob_object]=macro}
				= (app, (calls, { es & es_symbol_table = es_symbol_table }))
				= (app, (calls, { es & es_symbol_table = es_symbol_table }))
*/
	expand (App app=:{app_symb = symb=:{symb_kind = SK_IclMacro glob_object}, app_args}) ei
		# (app_args, (calls, es)) = expand app_args ei
		# (macro, es) = es!es_fun_defs.[glob_object]
		#! macro_group_index=macro.fun_info.fi_group_index
		# es = {es & es_fun_defs.[glob_object].fun_info.fi_group_index= if (macro_group_index>NoIndex) (-2-macro_group_index) macro_group_index}
		| macro.fun_arity == length app_args
			= unfoldMacro macro app_args (calls, es)

			# macro = {macro & fun_info.fi_group_index=if (macro_group_index<NoIndex) (-2-macro_group_index) macro_group_index}
			#! new_function_index = size es.es_fun_defs
			# copied_local_functions = Yes { copied_local_functions=[],used_copied_local_functions=[],new_copied_local_functions=[],next_local_function_n=new_function_index+1}

			# (macro,new_functions,local_macro_functions,es) = copy_macro_and_local_functions macro copied_local_functions es
//			# new_function_index=trace ("new_function_index: "+++toString new_function_index+++"\n") new_function_index;
			# last_function_index = case local_macro_functions of (Yes {next_local_function_n}) -> next_local_function_n-1
			# es = add_new_fun_defs [({old_function_n=FunctionOrIclMacroIndex glob_object,new_function_n=new_function_index},macro):new_functions] new_function_index last_function_index es
			# (calls, es_symbol_table) = examineFunctionCall macro.fun_ident (FunCall new_function_index NotALevel) (calls, es.es_symbol_table)
			# app = App { app & app_symb = { symb & symb_kind = SK_LocalMacroFunction new_function_index }, app_args = app_args }
			= (app, (calls, { es & es_symbol_table = es_symbol_table }))

	expand (App app=:{app_args}) ei
		# (app_args, ei) = expand app_args ei
		= (App { app & app_args = app_args }, ei)
	expand (expr @ exprs) ei
		# ((expr,exprs), ei) = expand (expr,exprs) ei
		= (expr @ exprs, ei)
	expand (Let lad=:{let_strict_binds, let_lazy_binds, let_expr}) ei
		# (let_strict_binds, ei) = expand let_strict_binds ei
		# (let_lazy_binds, ei) = expand let_lazy_binds ei
		# (let_expr, ei) = expand let_expr ei
		= (Let {lad & let_expr = let_expr, let_strict_binds = let_strict_binds, let_lazy_binds = let_lazy_binds}, ei)
	expand (Case case_expr) ei
		# (case_expr, ei) = expand case_expr ei
		= (Case case_expr, ei)
	expand (Selection is_unique expr selectors) ei
		# ((expr, selectors), ei) = expand (expr, selectors) ei
		= (Selection is_unique expr selectors, ei)
	expand (Update expr1 selectors expr2) ei
		# (((expr1, expr2), selectors), ei) = expand ((expr1, expr2), selectors) ei
		= (Update expr1 selectors expr2, ei)
	expand (RecordUpdate cons_symbol expression expressions) ei
		# ((expression, expressions), ei) = expand (expression, expressions) ei
		= (RecordUpdate cons_symbol expression expressions, ei)
	expand (TupleSelect symbol argn_nr expr) ei
		# (expr, ei) = expand expr ei
		= (TupleSelect symbol argn_nr expr, ei)
	expand (MatchExpr cons_ident expr) ei
		# (expr, ei) = expand expr ei
		= (MatchExpr cons_ident expr, ei)
	expand (DynamicExpr dyn) ei
		# (dyn, ei) = expand dyn ei
		= (DynamicExpr dyn, ei)
	expand expr ei
		= (expr, ei)

instance expand Selection
where
	expand (ArraySelection array_select expr_ptr index_expr) ei
		# (index_expr, ei) = expand index_expr ei
		= (ArraySelection array_select expr_ptr index_expr, ei)
	expand record_selection ei
		= (record_selection, ei)

instance expand LetBind
where
	expand bind=:{lb_src} ei
		# (lb_src, ei) = expand lb_src ei
		= ({ bind & lb_src = lb_src }, ei)

instance expand (Bind a b) | expand a
where
	expand bind=:{bind_src} ei
		# (bind_src, ei) = expand bind_src ei
		= ({ bind & bind_src = bind_src }, ei)

instance expand Case
where
 	expand kees (fundefs, es=:{es_var_heap, es_symbol_heap, es_error})
		# (kees=:{case_expr,case_guards,case_default}, es_var_heap, es_symbol_heap, es_error)
			= merge_if_explicit_case kees es_var_heap es_symbol_heap es_error
		# ei = (fundefs, {es & es_var_heap=es_var_heap, es_symbol_heap=es_symbol_heap, es_error=es_error})
		# ((case_expr,(case_guards,case_default)), ei) = expand (case_expr,(case_guards,case_default)) ei
		= ({ kees & case_expr = case_expr,case_guards = case_guards, case_default = case_default }, ei)
		where
			merge_if_explicit_case kees=:{ case_explicit } var_heap expr_heap error_admin
				| case_explicit
					# cases	= map (make_case kees.case_expr) (split_patterns kees.case_guards)
					  cases = init cases ++ [{last cases & case_default = kees.case_default}]
					  [firstCase : otherCases] = [(Case kees, NoPos) \\ kees <- cases]
					  ((Case {case_guards},_), var_heap, expr_heap, error_admin)
					  		=  mergeCases firstCase otherCases var_heap expr_heap error_admin
					  kees = {kees & case_guards = case_guards}
					=	(kees, var_heap, expr_heap, error_admin)
					with
						split_patterns :: CasePatterns -> [CasePatterns]
						split_patterns (AlgebraicPatterns index patterns)
							=	[AlgebraicPatterns index [pattern] \\ pattern <- patterns]
						split_patterns (BasicPatterns basicType patterns)
							=	[BasicPatterns basicType [pattern] \\ pattern <- patterns]
						split_patterns (OverloadedListPatterns  overloaded_list_type decons_expr patterns)
							=	[OverloadedListPatterns overloaded_list_type decons_expr [pattern] \\ pattern <- patterns]
						split_patterns (DynamicPatterns patterns)
							=	[DynamicPatterns [pattern] \\ pattern <- patterns]
						split_patterns NoPattern
							=	[NoPattern]

						make_case :: Expression CasePatterns -> Case
						make_case expr guard
							=
							{	case_expr		= expr
							,	case_guards		= guard
							,	case_default	= No
							,	case_ident		= No
							,	case_info_ptr	= nilPtr
							,	case_default_pos= NoPos
							,	case_explicit	= False
							}
				// otherwise // not case_explicit
					=	(kees, var_heap, expr_heap, error_admin)

instance expand CasePatterns
where
	expand (AlgebraicPatterns type patterns) ei
		# (patterns, ei) = expand patterns ei
		= (AlgebraicPatterns type patterns, ei) 
	expand (BasicPatterns type patterns) ei
		# (patterns, ei) = expand patterns ei
		= (BasicPatterns type patterns, ei) 
	expand (OverloadedListPatterns type decons_expr patterns) ei
		# (patterns, ei) = expand patterns ei
		= (OverloadedListPatterns type decons_expr patterns, ei) 
	expand (DynamicPatterns patterns) ei
		# (patterns, ei) = expand patterns ei
		= (DynamicPatterns patterns, ei) 

instance expand AlgebraicPattern
where
	expand alg_pattern=:{ap_expr} ei
		# (ap_expr, ei) = expand ap_expr ei
		= ({ alg_pattern & ap_expr = ap_expr }, ei)

instance expand BasicPattern
where
	expand bas_pattern=:{bp_expr} ei
		# (bp_expr, ei) = expand bp_expr ei
		= ({ bas_pattern & bp_expr = bp_expr }, ei)

instance expand DynamicPattern
where
	expand dyn_pattern=:{dp_rhs} ei
		# (dp_rhs, ei) = expand dp_rhs ei
		= ({ dyn_pattern & dp_rhs = dp_rhs }, ei)

instance expand DynamicExpr
where
	expand (dyn=:{dyn_expr}) ei
		# (dyn_expr, ei) = expand dyn_expr ei
		= ({dyn & dyn_expr = dyn_expr}, ei)

instance expand [a] | expand a
where
	expand [x:xs] ei
		# (x, ei) = expand x ei
		  (xs, ei) = expand xs ei
		= ([x:xs], ei)
	expand [] ei
		= ([], ei)

instance expand (a,b) | expand a & expand b
where
	expand (x,y) ei
		# (x, ei) = expand x ei
		  (y, ei) = expand y ei
		= ((x,y), ei)

instance expand (Optional a) | expand a
where
	expand (Yes x) ei
		# (x, ei) = expand x ei
		= (Yes x, ei)
	expand no ei
		= (no, ei)

::	CollectState =
	{	cos_var_heap	:: !.VarHeap
	,	cos_symbol_heap :: !.ExpressionHeap
	,	cos_error		:: !.ErrorAdmin
	,	cos_predef_symbols_for_transform :: !PredefSymbolsForTransform
	}

determineVariablesAndRefCounts :: ![FreeVar] !Expression !*CollectState -> (!Expression , ![FreeVar], ![FreeVar], ![DynamicPtr], !*CollectState)
determineVariablesAndRefCounts free_vars expr cos=:{cos_var_heap}
	# (expr, local_vars, dynamics, cos) = collectVariables expr [] [] { cos & cos_var_heap = clearCount free_vars cIsAGlobalVar cos_var_heap }
	  (free_vars, cos_var_heap) = retrieveRefCounts free_vars cos.cos_var_heap
	  (local_vars, cos_var_heap) = retrieveRefCounts local_vars cos_var_heap
	= (expr, free_vars, local_vars, dynamics, { cos & cos_var_heap = cos_var_heap })

retrieveRefCounts free_vars var_heap
	= mapSt retrieveRefCount free_vars var_heap

retrieveRefCount :: FreeVar *VarHeap -> (!FreeVar,!.VarHeap)
retrieveRefCount fv=:{fv_info_ptr} var_heap
	# (VI_Count count _, var_heap) = readPtr fv_info_ptr var_heap
	= ({ fv & fv_count = count }, var_heap)

/*
	'clearCount' initialises the 'fv_info_ptr' field of each 'FreeVar'
*/

class clearCount a :: !a !Bool !*VarHeap -> *VarHeap

instance clearCount [a] | clearCount a
where
	clearCount [x:xs] locality var_heap
		= clearCount x locality (clearCount xs locality var_heap)
	clearCount [] locality var_heap
		= var_heap

instance clearCount LetBind
where
	clearCount bind=:{lb_dst} locality var_heap
		= clearCount lb_dst locality var_heap

instance clearCount FreeVar
where
	clearCount{fv_info_ptr} locality var_heap
		= var_heap <:= (fv_info_ptr, VI_Count 0 locality)

/*
	In 'collectVariables' all local variables are collected. Moreover the reference counts
	of the local as well as of the global variables are determined. Aliases and unreachable 
	bindings introduced in a 'let' are removed.
	Dynamic administration is rebuilt.
*/	

class collectVariables a :: !a ![FreeVar] ![DynamicPtr] !*CollectState -> (!a, ![FreeVar],![DynamicPtr],!*CollectState)

cContainsACycle		:== True
cContainsNoCycle	:== False

instance collectVariables Expression
where
	collectVariables (Var var) free_vars dynamics cos
		# (var, free_vars, dynamics, cos) = collectVariables var free_vars dynamics cos
		= (Var var, free_vars, dynamics, cos)
	/* optimize && and || */
	collectVariables (App app=:{app_symb={symb_kind=SK_Function {glob_object,glob_module}},app_args}) free_vars dynamics cos=:{cos_predef_symbols_for_transform={predef_and,predef_or}}
		# ([e1,e2:_], free_vars, dynamics, cos) = collectVariables app_args free_vars dynamics cos
		| glob_object==predef_and.pds_def && glob_module==predef_and.pds_module && two_args app_args
			# (kase,cos) = if_expression e1 e2 (BasicExpr (BVB False)) cos
			= (kase, free_vars, dynamics, cos)
		| glob_object==predef_or.pds_def && glob_module==predef_or.pds_module && two_args app_args
			# (kase,cos) = if_expression e1 (BasicExpr (BVB True)) e2 cos
			= (kase, free_vars, dynamics, cos)
		where
			if_expression :: !Expression !Expression !Expression !*CollectState -> (!Expression,!.CollectState);
			if_expression e1 e2 e3 cos
//				# (new_info_ptr,symbol_heap) = newPtr EI_Empty cos.cos_symbol_heap
				# case_type =
					{	ct_pattern_type	= MakeAttributedType (TB BT_Bool)
					,	ct_result_type	= MakeAttributedType (TB BT_Bool)
					,	ct_cons_types 	= [[MakeAttributedType (TB BT_Bool)]]
					}
				# (new_info_ptr,symbol_heap) = newPtr (EI_CaseType case_type) cos.cos_symbol_heap
				# kase = Case {	case_expr=e1, case_guards=BasicPatterns BT_Bool [{bp_value=BVB True,bp_expr=e2,bp_position=NoPos}],
								case_default=Yes e3, case_ident=No, case_info_ptr=new_info_ptr, case_default_pos = NoPos,
								case_explicit = False }
				= (kase,{cos & cos_symbol_heap=symbol_heap});
			
			two_args [_,_]
				= True;
			two_args app_args
				= False;
	collectVariables (App app=:{app_args}) free_vars dynamics cos
		# (app_args, free_vars, dynamics, cos) = collectVariables app_args free_vars dynamics cos
		= (App { app & app_args = app_args}, free_vars, dynamics, cos)
	collectVariables (expr @ exprs) free_vars dynamics cos
		# ((expr, exprs), free_vars, dynamics, cos) = collectVariables (expr, exprs) free_vars dynamics cos
		= (expr @ exprs, free_vars, dynamics, cos)
	collectVariables (Let lad=:{let_strict_binds, let_lazy_binds, let_expr, let_info_ptr}) free_vars dynamics cos=:{cos_var_heap}
		# (let_info,cos_symbol_heap)	= readPtr let_info_ptr cos.cos_symbol_heap
		  let_types = case let_info of
		  				EI_LetType let_types	-> let_types
		  				_						-> repeat undef
		  cos = {cos & cos_symbol_heap = cos_symbol_heap}
		  cos_var_heap = cos.cos_var_heap

		# cos_var_heap = determine_aliases let_strict_binds cos_var_heap
		  cos_var_heap = determine_aliases let_lazy_binds cos_var_heap

		  (let_strict_binds, let_types)	= combine let_strict_binds let_types
			  	with
			  		combine [] let_types
			  			= ([],let_types)
			  		combine [lb:let_binds] [tp:let_types]
			  			# (let_binds,let_types)	= combine let_binds let_types
			  			= ([(tp, lb) : let_binds], let_types)
		  let_lazy_binds = zip2 let_types let_lazy_binds

		  (is_cyclic_s, let_strict_binds, cos) 
		  		= detect_cycles_and_handle_alias_binds True let_strict_binds
		  											{ cos & cos_var_heap = cos_var_heap }
		  (is_cyclic_l, let_lazy_binds, cos) 
		  		= detect_cycles_and_handle_alias_binds False let_lazy_binds cos
		| is_cyclic_s || is_cyclic_l
			# let_info = case let_info of
				EI_LetType _	-> EI_LetType (map fst (let_strict_binds ++ let_lazy_binds))
				_				-> let_info
			  let_strict_binds = map snd let_strict_binds
			  let_lazy_binds = map snd let_lazy_binds
			  cos_symbol_heap = writePtr let_info_ptr let_info cos.cos_symbol_heap
			  cos = {cos & cos_symbol_heap = cos_symbol_heap}
			= (Let {lad & let_strict_binds = let_strict_binds, let_lazy_binds = let_lazy_binds }, free_vars, dynamics,
					{ cos & cos_error = checkError "" "cyclic let definition" cos.cos_error})
//		| otherwise
			# (let_expr, free_vars, dynamics, cos) = collectVariables let_expr free_vars dynamics cos
			  all_binds = combine let_strict_binds let_lazy_binds
						  	with
						  		combine [] let_lazy_binds
						  			= [(False, tp, lb) \\ (tp,lb)<-let_lazy_binds]
						  		combine [(tp,lb):let_strict_binds] let_lazy_binds
						  			= [(True, tp, lb) : combine let_strict_binds let_lazy_binds]
			  (collected_binds, free_vars, dynamics, cos) = collect_variables_in_binds all_binds [] free_vars dynamics cos
			| isEmpty collected_binds
				= (let_expr, free_vars, dynamics, cos)
			 	# (let_strict_bind_types,let_lazy_bind_types,let_strict_binds,let_lazy_binds) = split_binds collected_binds
						  	with
				  				split_binds :: ![(Bool, AType, LetBind)] -> (!*[AType],!*[AType],!*[LetBind],!*[LetBind])
								split_binds []
									= ([],[],[],[])
								split_binds [(strict, t, b):xs]
									# (st,lt,sb,lb) = split_binds xs
									| strict
										= ([t:st],lt,[b:sb],lb)
										= (st,[t:lt],sb,[b:lb])
				# let_info = case let_info of
					EI_LetType _	-> EI_LetType (let_strict_bind_types ++ let_lazy_bind_types)
					_				-> let_info
				  cos_symbol_heap = writePtr let_info_ptr let_info cos.cos_symbol_heap
				  cos = {cos & cos_symbol_heap = cos_symbol_heap}
				= (Let {lad & let_expr = let_expr, let_strict_binds = let_strict_binds, let_lazy_binds = let_lazy_binds}, free_vars, dynamics, cos)
		where
		/*	Set the 'var_info_field' of each  bound variable to either 'VI_Alias var' (if
			this variable is an alias for 'var') or to 'VI_Count 0 cIsALocalVar' to initialise
		   	the reference count info.
		*/	   
		   
			determine_aliases [{lb_dst={fv_info_ptr}, lb_src = Var var} : binds] var_heap
				= determine_aliases binds (writePtr fv_info_ptr (VI_Alias var) var_heap)
			determine_aliases [bind : binds] var_heap
				= determine_aliases binds (clearCount bind cIsALocalVar var_heap)
			determine_aliases [] var_heap
				= var_heap

			
		/*	Remove all aliases from the list of lazy 'let'-binds. Add a _dummyForStrictAlias
			function call for the strict aliases. Be careful with cycles! */
		
			detect_cycles_and_handle_alias_binds :: !.Bool !u:[v:(.a,w:LetBind)] !*CollectState -> (!.Bool,!x:[y:(.a,z:LetBind)],!.CollectState), [u <= x,v <= y,w <= z]
			detect_cycles_and_handle_alias_binds is_strict [] cos
				= (cContainsNoCycle, [], cos)
//			detect_cycles_and_handle_alias_binds is_strict [bind=:{bind_dst={fv_info_ptr}} : binds] cos
			detect_cycles_and_handle_alias_binds is_strict [(type,bind=:{lb_dst={fv_info_ptr}}) : binds] cos
				# (var_info, cos_var_heap) = readPtr fv_info_ptr cos.cos_var_heap
				  cos = { cos & cos_var_heap = cos_var_heap }
				= case var_info of
					VI_Alias {var_info_ptr}
						| is_cyclic fv_info_ptr var_info_ptr cos.cos_var_heap
							-> (cContainsACycle, binds, cos)
						| is_strict
							# cos_var_heap = writePtr fv_info_ptr (VI_Count 0 cIsALocalVar) cos.cos_var_heap
							  (new_bind_src, cos) = add_dummy_id_for_strict_alias bind.lb_src 
							  								{ cos & cos_var_heap = cos_var_heap }
							  (is_cyclic, binds, cos) 
							  		= detect_cycles_and_handle_alias_binds is_strict binds cos
							-> (is_cyclic, [(type,{ bind & lb_src = new_bind_src }) : binds], cos)
						-> detect_cycles_and_handle_alias_binds is_strict binds cos
					_
						# (is_cyclic, binds, cos) = detect_cycles_and_handle_alias_binds is_strict binds cos
						-> (is_cyclic, [(type,bind) : binds], cos)
			where
				is_cyclic :: !.(Ptr VarInfo) !(Ptr VarInfo) !(Heap VarInfo) -> .Bool
				is_cyclic orig_info_ptr info_ptr var_heap
					| orig_info_ptr == info_ptr
						= True
						#! var_info = sreadPtr info_ptr var_heap
						= case var_info of
							VI_Alias {var_info_ptr}
								-> is_cyclic orig_info_ptr var_info_ptr var_heap
							_
								-> False
				
				add_dummy_id_for_strict_alias :: !.Expression !*CollectState -> (!.Expression,!.CollectState)
				add_dummy_id_for_strict_alias bind_src cos=:{cos_symbol_heap, cos_predef_symbols_for_transform}
					# (new_app_info_ptr, cos_symbol_heap) = newPtr EI_Empty cos_symbol_heap
					  {pds_module, pds_def} = cos_predef_symbols_for_transform.predef_alias_dummy
					  pds_ident = predefined_idents.[PD_DummyForStrictAliasFun]
			  		  app_symb = { symb_ident = pds_ident, symb_kind = SK_Function {glob_module = pds_module, glob_object = pds_def} }
					= (App { app_symb = app_symb, app_args = [bind_src], app_info_ptr = new_app_info_ptr },
						{ cos & cos_symbol_heap = cos_symbol_heap } )
								
		/*	Apply 'collectVariables' to the bound expressions (the 'bind_src' field of 'let'-bind) if
		    the corresponding bound variable (the 'bind_dst' field) has been used. This can be determined
		    by examining the reference count.
		*/

			collect_variables_in_binds :: ![(Bool,.b,.LetBind)] !u:[v:(Bool,.b,w:LetBind)] ![FreeVar] ![(Ptr ExprInfo)] !*CollectState -> (!x:[y:(Bool,.b,z:LetBind)],![FreeVar],![(Ptr ExprInfo)],!.CollectState), [u <= x,v <= y,w <= z]
			collect_variables_in_binds binds collected_binds free_vars dynamics cos
				# (continue, binds, collected_binds, free_vars, dynamics, cos) = examine_reachable_binds False binds collected_binds free_vars dynamics cos
				| continue
					= collect_variables_in_binds binds collected_binds free_vars dynamics cos
					# cos = {cos & cos_error=report_unused_strict_binds binds cos.cos_error}
					= (collected_binds, free_vars, dynamics, cos)
		
			examine_reachable_binds :: !Bool ![v:(.a,.b,w:LetBind)] !x:[y:(.a,.b,z:LetBind)] ![.FreeVar] ![.(Ptr ExprInfo)] !*CollectState -> *(!Bool,![v0:(.a,.b,w0:LetBind)],!x0:[y0:(.a,.b,z0:LetBind)],![FreeVar],![(Ptr ExprInfo)],!*CollectState), [v <= v0,w <= w0,x <= x0,y <= y0,z <= z0]
			examine_reachable_binds bind_found [bind=:(is_strict, type, letb=:{lb_dst=fv=:{fv_info_ptr},lb_src}) : binds] collected_binds free_vars dynamics cos
				# (bind_found, binds, collected_binds, free_vars, dynamics, cos) = examine_reachable_binds bind_found binds collected_binds free_vars dynamics cos
				# (VI_Count count is_global, cos_var_heap) = readPtr fv_info_ptr cos.cos_var_heap
				# cos = { cos & cos_var_heap = cos_var_heap }
				| count > 0
					# (lb_src, free_vars, dynamics, cos) = collectVariables lb_src free_vars dynamics cos
					= (True, binds, [ (is_strict, type, { letb & lb_dst = { fv & fv_count = count }, lb_src = lb_src }) : collected_binds ], free_vars, dynamics, cos)
					= (bind_found, [bind : binds], collected_binds, free_vars, dynamics, cos)
			examine_reachable_binds bind_found [] collected_binds free_vars dynamics cos
				= (bind_found, [], collected_binds, free_vars, dynamics, cos)

			report_unused_strict_binds [(is_strict,type,{lb_dst={fv_ident},lb_position}):binds] errors
				| not is_strict
					= report_unused_strict_binds binds errors
					= report_unused_strict_binds binds (checkWarningWithPosition fv_ident lb_position "not used, ! ignored" errors)
			report_unused_strict_binds [] errors
				= errors

	collectVariables (Case case_expr) free_vars dynamics cos
		# (case_expr, free_vars, dynamics, cos) = collectVariables case_expr free_vars dynamics cos
		= (Case case_expr, free_vars, dynamics, cos)
	collectVariables (Selection is_unique expr selectors) free_vars dynamics cos
		# ((expr, selectors), free_vars, dynamics, cos) = collectVariables (expr, selectors) free_vars dynamics cos
		= (Selection is_unique expr selectors, free_vars, dynamics, cos)
	collectVariables (Update expr1 selectors expr2) free_vars dynamics cos
		# (((expr1, expr2), selectors), free_vars, dynamics, cos) = collectVariables ((expr1, expr2), selectors) free_vars dynamics cos
		= (Update expr1 selectors expr2, free_vars, dynamics, cos)
	collectVariables (RecordUpdate cons_symbol expression expressions) free_vars dynamics cos
		# ((expression, expressions), free_vars, dynamics, cos) = collectVariables (expression, expressions) free_vars dynamics cos
		= (RecordUpdate cons_symbol expression expressions, free_vars, dynamics, cos)
	collectVariables (TupleSelect symbol argn_nr expr) free_vars dynamics cos
		# (expr, free_vars, dynamics, cos) = collectVariables expr free_vars dynamics cos
		= (TupleSelect symbol argn_nr expr, free_vars, dynamics, cos)
	collectVariables (MatchExpr cons_ident expr) free_vars dynamics cos
		# (expr, free_vars, dynamics, cos) = collectVariables expr free_vars dynamics cos
		= (MatchExpr cons_ident expr, free_vars, dynamics, cos)
	collectVariables (DynamicExpr dynamic_expr) free_vars dynamics cos
		# (dynamic_expr, free_vars, dynamics, cos) = collectVariables dynamic_expr free_vars dynamics cos
		= (DynamicExpr dynamic_expr, free_vars, dynamics, cos);
	collectVariables expr free_vars dynamics cos
		= (expr, free_vars, dynamics, cos)

instance collectVariables Selection
where
	collectVariables (ArraySelection array_select expr_ptr index_expr) free_vars dynamics cos
		# (index_expr, free_vars, dynamics, cos) = collectVariables index_expr free_vars dynamics cos
		= (ArraySelection array_select expr_ptr index_expr, free_vars, dynamics, cos)
	collectVariables (DictionarySelection dictionary_select selectors expr_ptr index_expr) free_vars dynamics cos
		# ((index_expr,selectors), free_vars, dynamics, cos) = collectVariables (index_expr,selectors) free_vars dynamics cos
		= (DictionarySelection dictionary_select selectors expr_ptr index_expr, free_vars, dynamics, cos)
	collectVariables record_selection free_vars dynamics cos
		= (record_selection, free_vars, dynamics, cos)

instance collectVariables [a] | collectVariables a
where
	collectVariables [x:xs] free_vars dynamics cos
		# (x, free_vars, dynamics, cos) = collectVariables x free_vars dynamics cos
		# (xs, free_vars, dynamics, cos) = collectVariables xs free_vars dynamics cos
		= ([x:xs], free_vars, dynamics, cos)
	collectVariables [] free_vars dynamics cos
		= ([], free_vars, dynamics, cos)

instance collectVariables (!a,!b) | collectVariables a & collectVariables b
where
	collectVariables (x,y) free_vars dynamics cos
		# (x, free_vars, dynamics, cos) = collectVariables x free_vars dynamics cos
		# (y, free_vars, dynamics, cos) = collectVariables y free_vars dynamics cos
		= ((x,y), free_vars, dynamics, cos)

instance collectVariables (Optional a) | collectVariables a
where
	collectVariables (Yes x) free_vars dynamics cos
		# (x, free_vars, dynamics, cos) = collectVariables x free_vars dynamics cos
		= (Yes x, free_vars, dynamics, cos)
	collectVariables no free_vars dynamics cos
		= (no, free_vars, dynamics, cos)

instance collectVariables (Bind a b) | collectVariables a where
	collectVariables bind=:{bind_src} free_vars dynamics cos
		# (bind_src, free_vars, dynamics, cos) = collectVariables bind_src free_vars dynamics cos
		= ({bind & bind_src = bind_src}, free_vars, dynamics, cos)

instance collectVariables Case
where
	collectVariables kees=:{ case_expr, case_guards, case_default } free_vars dynamics cos
		# (case_expr, free_vars, dynamics, cos) = collectVariables case_expr free_vars dynamics cos
		# (case_guards, free_vars, dynamics, cos) = collectVariables case_guards free_vars dynamics cos
		# (case_default, free_vars, dynamics, cos) = collectVariables case_default free_vars dynamics cos
		=  ({ kees & case_expr = case_expr, case_guards = case_guards, case_default = case_default }, free_vars, dynamics, cos)

instance collectVariables CasePatterns
where
	collectVariables (AlgebraicPatterns type patterns) free_vars dynamics cos
		# (patterns, free_vars, dynamics, cos) = collectVariables patterns free_vars dynamics cos
		= (AlgebraicPatterns type patterns, free_vars, dynamics, cos)
	collectVariables (BasicPatterns type patterns) free_vars dynamics cos
		# (patterns, free_vars, dynamics, cos) = collectVariables patterns free_vars dynamics cos
		= (BasicPatterns type patterns, free_vars, dynamics, cos)
	collectVariables (OverloadedListPatterns type decons_expr patterns) free_vars dynamics cos
		# (patterns, free_vars, dynamics, cos) = collectVariables patterns free_vars dynamics cos
		= (OverloadedListPatterns type decons_expr patterns, free_vars, dynamics, cos)
	collectVariables (DynamicPatterns patterns) free_vars dynamics cos
		# (patterns, free_vars, dynamics, cos) = collectVariables patterns free_vars dynamics cos
		= (DynamicPatterns patterns, free_vars, dynamics, cos)
	collectVariables NoPattern free_vars dynamics cos
		= (NoPattern, free_vars, dynamics, cos)

instance collectVariables AlgebraicPattern
where
	collectVariables pattern=:{ap_vars,ap_expr} free_vars dynamics cos
		# (ap_expr, free_vars, dynamics, cos) = collectVariables ap_expr free_vars dynamics { cos & cos_var_heap = clearCount ap_vars cIsALocalVar cos.cos_var_heap}
		  (ap_vars, cos_var_heap) = retrieveRefCounts ap_vars cos.cos_var_heap
		= ({ pattern & ap_expr = ap_expr, ap_vars = ap_vars }, free_vars, dynamics, { cos & cos_var_heap = cos_var_heap })
	
instance collectVariables BasicPattern
where
	collectVariables pattern=:{bp_expr} free_vars dynamics cos
		# (bp_expr, free_vars, dynamics, cos) = collectVariables bp_expr free_vars dynamics cos
		= ({ pattern & bp_expr = bp_expr }, free_vars, dynamics, cos)

instance collectVariables DynamicPattern
where
	collectVariables pattern=:{dp_var,dp_rhs,dp_type} free_vars dynamics cos=:{cos_var_heap,cos_symbol_heap}
		# cos_var_heap = clearCount dp_var cIsALocalVar cos_var_heap
		  (EI_DynamicTypeWithVars vars type _, cos_symbol_heap) = readPtr dp_type cos_symbol_heap
		  cos = { cos & cos_var_heap = cos_var_heap, cos_symbol_heap = cos_symbol_heap }
		  (dp_rhs, free_vars, local_dynamics, cos) = collectVariables dp_rhs free_vars [] cos
		  cos_symbol_heap = cos.cos_symbol_heap <:= (dp_type, EI_DynamicTypeWithVars vars type local_dynamics)
		  (dp_var, cos_var_heap) = retrieveRefCount dp_var cos.cos_var_heap
		  cos = { cos & cos_var_heap = cos_var_heap, cos_symbol_heap = cos_symbol_heap }
		= ({ pattern & dp_rhs = dp_rhs, dp_var = dp_var }, free_vars, [dp_type:dynamics], cos)

instance collectVariables DynamicExpr
where
	collectVariables dynamic_expr=:{dyn_expr, dyn_info_ptr} free_vars dynamics cos
		# (dyn_expr, free_vars, local_dynamics, cos=:{cos_symbol_heap}) = collectVariables dyn_expr free_vars [] cos
		  cos_symbol_heap = mark_used_dynamic dyn_info_ptr local_dynamics (readPtr dyn_info_ptr cos_symbol_heap)
		= ({dynamic_expr & dyn_expr = dyn_expr}, free_vars, [dyn_info_ptr:dynamics], { cos & cos_symbol_heap = cos_symbol_heap });
	where
		mark_used_dynamic dyn_info_ptr local_dynamics (EI_UnmarkedDynamic opt_type _, symbol_heap) 
			= symbol_heap <:= (dyn_info_ptr, EI_Dynamic opt_type local_dynamics)
		mark_used_dynamic dyn_info_ptr local_dynamics (EI_Dynamic opt_type _, symbol_heap) 
			= symbol_heap <:= (dyn_info_ptr, EI_Dynamic opt_type local_dynamics)

instance collectVariables BoundVar
where
	collectVariables var=:{var_ident,var_info_ptr,var_expr_ptr} free_vars dynamics cos=:{cos_var_heap}
		# (var_info, cos_var_heap) = readPtr var_info_ptr cos_var_heap
		  cos = { cos & cos_var_heap = cos_var_heap }
		= case var_info of
			VI_Alias alias
				#  (original, free_vars, dynamics, cos) = collectVariables alias free_vars dynamics cos
				-> ({ original & var_expr_ptr = var_expr_ptr }, free_vars, dynamics, cos)
			VI_Count count is_global
				| count > 0 || is_global
					-> (var, free_vars, dynamics, { cos & cos_var_heap = writePtr var_info_ptr (VI_Count (inc count) is_global) cos.cos_var_heap })
					-> (var, [{fv_ident = var_ident, fv_info_ptr = var_info_ptr, fv_def_level = NotALevel, fv_count = 0} : free_vars ], dynamics,
								{ cos & cos_var_heap = writePtr var_info_ptr (VI_Count 1 is_global) cos.cos_var_heap })
			_
				-> abort "collectVariables [BoundVar] (transform, 1227)"  //---> (var_info ,var_ident, ptrToInt var_info_ptr)

instance <<< (Ptr a)
where
	(<<<) file p = file <<< ptrToInt p

instance <<< VarInfo
  where
	(<<<) file (VI_Expression expr) = file <<< expr
	(<<<) file vi					= file <<< "VI??"