change: dynamics are now converted before 'fusion'

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

1 files changed, 139 insertions, 95 deletions

diff --git a/frontend/convertDynamics.icl b/frontend/convertDynamics.icl
index d046d72..32ef5ec 100644
--- a/frontend/convertDynamics.icl
+++ b/frontend/convertDynamics.icl
@@ -6,6 +6,7 @@ import syntax, transform, utilities, convertcases
 	{	ci_predef_symb		:: !*PredefinedSymbols
 	,	ci_var_heap			:: !*VarHeap
 	,	ci_expr_heap		:: !*ExpressionHeap
+	,	ci_new_variables 	:: ![FreeVar]
 	,	ci_new_functions 	:: ![FunctionInfoPtr]
 	,	ci_fun_heap			:: !*FunctionHeap
 	,	ci_next_fun_nr		:: !Index
@@ -22,25 +23,22 @@ import syntax, transform, utilities, convertcases
 	}
 
 :: DefaultExpression :== Optional (BoundVar, [IndirectionVar])   //DefaultRecord
-:: DefaultRecord =
-	{	c_i				:: BoundVar
-	,	indirections	:: [IndirectionVar]
-	}
-:: BoundVariables 	 :== [(FreeVar, AType)]
+
+::	BoundVariables :== [TypedVariable]
+
 :: IndirectionVar    :== BoundVar
 
-convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !*{! Group} !*{#FunDef} !*PredefinedSymbols
-		!*{#{# CheckedTypeDef}} !ImportedFunctions !*VarHeap !*TypeHeaps !*ExpressionHeap
+convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !*{! Group} !*{#FunDef} !*PredefinedSymbols !*VarHeap !*TypeHeaps !*ExpressionHeap
 			-> (!*{! Group}, !*{#FunDef}, !*PredefinedSymbols, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap)
-convertDynamicPatternsIntoUnifyAppls global_type_instances common_defs groups fun_defs predefined_symbols
-		imported_types imported_conses var_heap type_heaps expr_heap
+convertDynamicPatternsIntoUnifyAppls global_type_instances common_defs groups fun_defs predefined_symbols var_heap type_heaps expr_heap
 	#! nr_of_funs = size fun_defs
+	# imported_types = {com_type_defs \\ {com_type_defs} <-: common_defs }
 	# (groups, (fun_defs, {ci_predef_symb, ci_var_heap, ci_expr_heap, ci_fun_heap, ci_new_functions}))
 			= convert_groups 0 groups global_type_instances (fun_defs, {	
 							ci_predef_symb = predefined_symbols, ci_var_heap = var_heap, ci_expr_heap = expr_heap,
-							ci_new_functions = [], ci_fun_heap = newHeap, ci_next_fun_nr = nr_of_funs })
+							ci_new_functions = [], ci_new_variables = [], ci_fun_heap = newHeap, ci_next_fun_nr = nr_of_funs })
 	  (groups, new_fun_defs, imported_types, imported_conses, type_heaps, ci_var_heap)
-			= addNewFunctionsToGroups common_defs ci_fun_heap ci_new_functions groups imported_types imported_conses type_heaps ci_var_heap
+			= addNewFunctionsToGroups common_defs ci_fun_heap ci_new_functions groups imported_types [] type_heaps ci_var_heap
 	= (groups, { fundef \\ fundef <- [ fundef \\ fundef <-: fun_defs ] ++ new_fun_defs }, ci_predef_symb, imported_types, imported_conses, ci_var_heap, type_heaps, ci_expr_heap)
 where
 	convert_groups group_nr groups global_type_instances fun_defs_and_ci
@@ -51,18 +49,24 @@ where
 
 	convert_function group_nr global_type_instances fun (fun_defs, ci)
 		#! fun_def = fun_defs.[fun]
-		# {fun_body,fun_type} = fun_def
+		# {fun_body, fun_type, fun_info} = fun_def
 		  (fun_body, ci) = convert_dynamics_in_body {cinp_glob_type_inst = global_type_instances, cinp_group_index = group_nr} fun_body fun_type ci
-		= ({fun_defs & [fun] = { fun_def & fun_body = fun_body }}, ci)
+		= ({fun_defs & [fun] = { fun_def & fun_body = fun_body, fun_info = { fun_info & fi_local_vars = ci.ci_new_variables ++ fun_info.fi_local_vars }}},
+			{ ci & ci_new_variables = [] }) ---> ("convert_function", ci.ci_new_variables ++ fun_info.fi_local_vars)
 
 	convert_dynamics_in_body global_type_instances (TransformedBody {tb_args,tb_rhs}) (Yes {st_args}) ci
-		# vars_with_types = zip2 tb_args st_args
+		# vars_with_types = bindVarsToTypes tb_args st_args []
 		  (tb_rhs, ci) = convertDynamics global_type_instances vars_with_types No tb_rhs ci
 		= (TransformedBody {tb_args = tb_args,tb_rhs = tb_rhs}, ci)
 	convert_dynamics_in_body global_type_instances other fun_type ci
 		= abort "unexpected value in 'convert dynamics.convert_dynamics_in_body'"
 
 
+bindVarsToTypes vars types typed_vars
+	= fold2St bind_var_to_type vars types typed_vars
+where
+	bind_var_to_type var type typed_vars
+		= [{tv_free_var = var, tv_type = type } : typed_vars]
 
 class convertDynamics a :: !ConversionInput !BoundVariables !DefaultExpression !a !*ConversionInfo -> (!a, !*ConversionInfo)
 
@@ -89,7 +93,7 @@ where
 
 convertDynamicsOfAlgebraicPattern :: !ConversionInput !BoundVariables !DefaultExpression !(!AlgebraicPattern,[AType]) !*ConversionInfo -> (!AlgebraicPattern,!*ConversionInfo)
 convertDynamicsOfAlgebraicPattern cinp bound_vars default_expr (algebraic_pattern=:{ap_vars, ap_expr}, arg_types_of_conses) ci
-	# (ap_expr, ci) = convertDynamics cinp (zipAppend2 ap_vars arg_types_of_conses bound_vars) default_expr ap_expr ci
+	# (ap_expr, ci) = convertDynamics cinp (bindVarsToTypes ap_vars arg_types_of_conses bound_vars) default_expr ap_expr ci
 	= ({algebraic_pattern &  ap_expr = ap_expr}, ci)
 
 instance convertDynamics BasicPattern
@@ -114,7 +118,7 @@ where
 		= (expr @ exprs, ci)
 	convertDynamics cinp bound_vars default_expr (Let letje=:{let_binds, let_expr,let_info_ptr}) ci
 		# (let_types, ci) = determine_let_types let_info_ptr ci
-		  bound_vars = zipAppend2 [ bind.bind_dst \\ bind <- let_binds ] let_types bound_vars
+		  bound_vars = bindVarsToTypes [ bind.bind_dst \\ bind <- let_binds ] let_types bound_vars
 		  (let_binds, ci) = convertDynamics cinp bound_vars default_expr let_binds ci
 		  (let_expr,  ci) = convertDynamics cinp bound_vars default_expr let_expr  ci
 		= (Let { letje &  let_binds = let_binds, let_expr = let_expr}, ci)
@@ -245,19 +249,20 @@ determine_defaults case_default _ ci
 add_dynamic_bound_vars :: ![DynamicPattern] BoundVariables -> BoundVariables
 add_dynamic_bound_vars [] bound_vars = bound_vars
 add_dynamic_bound_vars [{dp_var, dp_type_patterns_vars} : patterns] bound_vars
-	= add_dynamic_bound_vars patterns [(dp_var, empty_attributed_type) : mapAppend bind_info_ptr dp_type_patterns_vars bound_vars]
+	= add_dynamic_bound_vars patterns (foldSt bind_info_ptr dp_type_patterns_vars [ {tv_free_var = dp_var, tv_type = empty_attributed_type } : bound_vars ])
 where
-	bind_info_ptr var_info_ptr
-		= ({fv_def_level = NotALevel, fv_name = a_ij_var_name, fv_info_ptr = var_info_ptr, fv_count = 0}, empty_attributed_type)
+	bind_info_ptr var_info_ptr bound_vars
+		= [{ tv_free_var = {fv_def_level = NotALevel, fv_name = a_ij_var_name, fv_info_ptr = var_info_ptr, fv_count = 0}, tv_type = empty_attributed_type } : bound_vars]
 
 
 open_dynamic :: Expression !*ConversionInfo -> (OpenedDynamic, Bind Expression FreeVar, !*ConversionInfo)
 open_dynamic dynamic_expr ci
 	# (twotuple, ci) = getTupleSymbol 2 ci
 	  (dynamicType_var, ci) = newVariable "dt" VI_Empty ci
-	= (	{ opened_dynamic_expr = TupleSelect twotuple 0 dynamic_expr,   opened_dynamic_type = Var dynamicType_var },
-	  	{ bind_src = TupleSelect twotuple 1 dynamic_expr,   bind_dst = varToFreeVar dynamicType_var 0 },
-	  	ci)
+	  dynamicType_fv = varToFreeVar dynamicType_var 1
+	= (	{ opened_dynamic_expr = TupleSelect twotuple 0 dynamic_expr, opened_dynamic_type = Var dynamicType_var },
+	  	{ bind_src = TupleSelect twotuple 1 dynamic_expr, bind_dst = dynamicType_fv },
+	  	{ ci & ci_new_variables = [ dynamicType_fv : ci.ci_new_variables ]})
 
 /**************************************************************************************************/
 
@@ -268,91 +273,113 @@ convertDynamicPatterns cinp bound_vars {case_guards = DynamicPatterns [], case_d
 		No			-> abort "unexpected value in convertDynamics: 'convertDynamicPatterns'"
 convertDynamicPatterns cinp bound_vars {case_expr, case_guards = DynamicPatterns patterns, case_default, case_info_ptr} ci
 	# (opened_dynamic, dt_bind, ci) = open_dynamic case_expr ci
-	  (ind_0, ci) = newVariable "ind_0" VI_Empty ci
+	  (ind_0, ci) = newVariable "ind_0" (VI_Indirection 0) ci
 	  (c_1,   ci) = newVariable "c_1" (VI_Default 0) ci
       new_default = newDefault c_1 ind_0
       (result_type, ci) = getResultType case_info_ptr ci
       bound_vars = addToBoundVars (freeVarToVar dt_bind.bind_dst) empty_attributed_type (addToBoundVars ind_0 empty_attributed_type
       							  (addToBoundVars c_1 result_type (add_dynamic_bound_vars patterns bound_vars)))
-	  (binds, expr, ci) = convertDynamicPattern cinp bound_vars new_default 1 opened_dynamic result_type case_default patterns ci
+	  (binds, expr, ci) = convert_dynamic_pattern cinp bound_vars new_default 1 opened_dynamic result_type case_default patterns ci
 	  (let_info_ptr, ci) = let_ptr ci
 	= (Let {let_strict = False, let_binds = [ dt_bind : binds ], let_expr = expr, let_info_ptr = let_info_ptr}, ci)
-
-convertDynamicPattern :: !ConversionInput !BoundVariables DefaultExpression Int OpenedDynamic AType (Optional Expression) ![DynamicPattern] *ConversionInfo -> (Env Expression FreeVar, Expression, *ConversionInfo)
-convertDynamicPattern cinp bound_vars this_default pattern_number opened_dynamic result_type last_default
-																		[{ dp_var, dp_type_patterns_vars, dp_type_code, dp_rhs } : patterns] ci
-	# /***  The last case may noy have a default  ***/
-	  ind_var = getIndirectionVar this_default
-      this_default = if (isEmpty patterns && (isNo last_default))  No  this_default
-
-	  /***  convert the elements of this pattern  ***/
-	  x_i_bind = { bind_src = opened_dynamic.opened_dynamic_expr,  bind_dst = dp_var }
-	  (a_ij_binds, ci) = createVariables dp_type_patterns_vars [] ci
- 	  (type_code, ci) = convertTypecode cinp dp_type_code ci
- 	  (dp_rhs,    ci) = convertDynamics cinp bound_vars this_default dp_rhs ci
-
-	  /***  recursively convert the other patterns  ***/
-	  (binds, ci) = convertOtherPatterns cinp bound_vars this_default pattern_number opened_dynamic result_type last_default patterns ci
-
-	  /***  generate the expression  ***/
- 	  (unify_symb, ci) = getSymbol PD_unify SK_Function 2 ci
-	  (twotuple,   ci) = getTupleSymbol 2 ci
-	  (let_info_ptr,  ci) = let_ptr ci
-	  (case_info_ptr, ci) = case_ptr ci
-	  (default_expr, ci) = toExpression this_default ci
-	  (unify_result, ci) = newVariable "result" VI_Empty ci
-	  (unify_bool,   ci) = newVariable "unify_bool" VI_Empty ci
-	  let_expr = Let {	let_strict = False,
-	  					let_binds = [{ bind_src = App { app_symb = unify_symb,  app_args = [opened_dynamic.opened_dynamic_type, type_code],  app_info_ptr = nilPtr },
-	  								   bind_dst = varToFreeVar unify_result 0 },
-	  								 { bind_src = TupleSelect twotuple 0 (Var unify_result),
-	  								   bind_dst = varToFreeVar unify_bool 0 },
-	  								 { bind_src = TupleSelect twotuple 1 (Var unify_result),
-	  								   bind_dst = varToFreeVar ind_var 0 }
-	  								],
-	  					let_expr = Case {	case_expr 		= Var unify_bool,
-											case_guards		= BasicPatterns BT_Bool [{bp_value = BVB True, bp_expr = dp_rhs}],
-											case_default	= default_expr,
-											case_ident		= No,
-											case_info_ptr	= case_info_ptr	},
-	  					let_info_ptr = let_info_ptr	}
-	= ([x_i_bind : a_ij_binds ++ binds],  let_expr,  ci)
-
-convertOtherPatterns :: ConversionInput BoundVariables DefaultExpression Int OpenedDynamic AType !(Optional Expression) ![DynamicPattern] !*ConversionInfo -> (Env Expression FreeVar, *ConversionInfo)
-convertOtherPatterns _ _ _ _ _ _  No  []  ci
-	= ([], ci)
-convertOtherPatterns cinp bound_vars this_default _ _ result_type (Yes last_default_expr) [] ci
-	# c_i = getVariable this_default
-	  (c_bind, ci) = generateBinding cinp bound_vars c_i last_default_expr result_type ci
-	= ([c_bind], ci)
-convertOtherPatterns cinp bound_vars this_default pattern_number opened_dynamic result_type last_default patterns ci
-	# (ind_i,   ci) = newVariable ("ind_"+++toString (pattern_number)) VI_Empty ci
-	  (c_inc_i, ci) = newVariable ("c_"+++toString (inc pattern_number)) (VI_Default 0) ci
-      new_default = newDefault c_inc_i ind_i
-      bound_vars = addToBoundVars ind_i empty_attributed_type (addToBoundVars c_inc_i result_type bound_vars)
- 	  (binds, expr, ci) = convertDynamicPattern cinp bound_vars new_default (inc pattern_number) opened_dynamic result_type last_default patterns ci
-	  c_i = getVariable this_default
-	  (c_bind, ci) = generateBinding cinp bound_vars c_i expr result_type ci
-   = ([c_bind : binds], ci)
+where
+	convert_dynamic_pattern :: !ConversionInput !BoundVariables DefaultExpression Int OpenedDynamic AType (Optional Expression) ![DynamicPattern] *ConversionInfo
+		-> (Env Expression FreeVar, Expression, *ConversionInfo)
+	convert_dynamic_pattern cinp bound_vars this_default pattern_number opened_dynamic result_type last_default
+																			[{ dp_var, dp_type_patterns_vars, dp_type_code, dp_rhs } : patterns] ci
+		# /***  The last case may noy have a default  ***/
+
+		  ind_var = getIndirectionVar this_default
+	
+	      this_default = if (isEmpty patterns && (isNo last_default)) No this_default
+	
+		  /***  convert the elements of this pattern  ***/
+
+		  x_i_bind = { bind_src = opened_dynamic.opened_dynamic_expr,  bind_dst = dp_var }
+		  (a_ij_binds, ci) = createVariables dp_type_patterns_vars [] ci
+	 	  (type_code, ci) = convertTypecode cinp dp_type_code ci
+	 	  (dp_rhs,    ci) = convertDynamics cinp bound_vars this_default dp_rhs ci
+	
+		  /***  recursively convert the other patterns  ***/
+
+		  (binds, ci) = convert_other_patterns cinp bound_vars this_default pattern_number opened_dynamic result_type last_default patterns ci
+
+	
+		  /***  generate the expression  ***/
+	 	  (unify_symb, ci) 		= getSymbol PD_unify SK_Function 2 ci
+		  (twotuple, ci) 		= getTupleSymbol 2 ci
+		  (let_info_ptr, ci) 	= let_ptr ci
+		  (case_info_ptr, ci)	= case_ptr ci
+		  (default_expr, ci) 	= toExpression this_default ci
+		  (unify_result_var, ci)	= newVariable "result" VI_Empty ci
+		  unify_result_fv 			= varToFreeVar unify_result_var 1
+		  (unify_bool_var,   ci)	= newVariable "unify_bool" VI_Empty ci
+		  unify_bool_fv 			= varToFreeVar unify_bool_var 1
+
+		  (let_binds, ci) = bind_indirection_var ind_var unify_result_var twotuple ci
+
+		  let_expr = Let {	let_strict = False,
+		  					let_binds = [{ bind_src = App { app_symb = unify_symb,  app_args = [opened_dynamic.opened_dynamic_type, type_code],  app_info_ptr = nilPtr },
+		  								   bind_dst = unify_result_fv },
+		  								 { bind_src = TupleSelect twotuple 0 (Var unify_result_var),
+		  								   bind_dst = unify_bool_fv } : let_binds
+		  								],
+		  					let_expr = Case {	case_expr 		= Var unify_bool_var,
+												case_guards		= BasicPatterns BT_Bool [{bp_value = BVB True, bp_expr = dp_rhs}],
+												case_default	= default_expr,
+												case_ident		= No,
+												case_info_ptr	= case_info_ptr	},
+		  					let_info_ptr = let_info_ptr	}
+		= ([x_i_bind : a_ij_binds ++ binds],  let_expr,  { ci & ci_new_variables = [unify_result_fv, unify_bool_fv : ci.ci_new_variables]})
+	where
+		bind_indirection_var var=:{var_info_ptr} unify_result_var twotuple ci=:{ci_var_heap,ci_new_variables}
+			# (VI_Indirection ref_count, ci_var_heap) = readPtr var_info_ptr ci_var_heap
+			| ref_count > 0
+				# ind_fv = varToFreeVar var ref_count
+		  		= ([{ bind_src = TupleSelect twotuple 1 (Var unify_result_var), bind_dst = ind_fv }],
+						{ ci & ci_var_heap = ci_var_heap, ci_new_variables = [ ind_fv : ci_new_variables ]})
+				= ([], {ci & ci_var_heap = ci_var_heap})
+
+	convert_other_patterns :: ConversionInput BoundVariables DefaultExpression Int OpenedDynamic AType !(Optional Expression) ![DynamicPattern] !*ConversionInfo
+			-> (Env Expression FreeVar, *ConversionInfo)
+	convert_other_patterns _ _ _ _ _ _  No  []  ci
+		= ([], ci)
+	convert_other_patterns cinp bound_vars this_default _ _ result_type (Yes last_default_expr) [] ci
+		# c_i = getVariable this_default
+		  (c_bind, ci) = generateBinding cinp bound_vars c_i last_default_expr result_type ci
+		= ([c_bind], ci)
+	convert_other_patterns cinp bound_vars this_default pattern_number opened_dynamic result_type last_default patterns ci
+		# (ind_i,   ci) = newVariable ("ind_"+++toString (pattern_number)) (VI_Indirection 0) ci
+		  (c_inc_i, ci) = newVariable ("c_"+++toString (inc pattern_number)) (VI_Default 0) ci
+	      new_default = newDefault c_inc_i ind_i
+	      bound_vars = addToBoundVars ind_i empty_attributed_type (addToBoundVars c_inc_i result_type bound_vars)
+	 	  (binds, expr, ci) = convert_dynamic_pattern cinp bound_vars new_default (inc pattern_number) opened_dynamic result_type last_default patterns ci
+		  c_i = getVariable this_default
+		  (c_bind, ci) = generateBinding cinp bound_vars c_i expr result_type ci
+	   = ([c_bind : binds], ci)
 
 generateBinding :: !ConversionInput BoundVariables BoundVar Expression AType !*ConversionInfo -> *(Bind Expression FreeVar, *ConversionInfo)
 generateBinding cinp bound_vars var bind_expr result_type ci
 	# (ref_count, ci) = get_reference_count var ci
 	| ref_count == 0
-		= ({ bind_src = bind_expr, bind_dst = varToFreeVar var 1}, ci)
+		# free_var = varToFreeVar var 1
+		= ({ bind_src = bind_expr, bind_dst = free_var }, { ci & ci_new_variables = [ free_var : ci.ci_new_variables ]})
 		# (saved_defaults, ci_var_heap) = foldSt save_default bound_vars ([], ci.ci_var_heap)
-		  (act_args, free_typed_vars, tb_rhs, ci_var_heap) = copyExpression bound_vars bind_expr ci_var_heap
+		  (act_args, free_typed_vars, local_free_vars, tb_rhs, ci_var_heap) = copyExpression bound_vars bind_expr ci_var_heap
+		  (ci_new_variables, ci_var_heap) = foldSt remove_local_var ci.ci_new_variables ([], ci_var_heap)
 		  ci_var_heap = foldSt restore_default saved_defaults ci_var_heap
-		  tb_args = [ arg \\ (arg, _) <- free_typed_vars ]
-		  arg_types = [ type \\ (_, type) <- free_typed_vars ]
+		  tb_args = [ ftv.tv_free_var \\ ftv <- free_typed_vars ]
+		  arg_types = [ ftv.tv_type \\ ftv <- free_typed_vars ]
 		  (fun_symb,  (ci_next_fun_nr, ci_new_functions, ci_fun_heap))
-				= newFunction No (TransformedBody {tb_args = tb_args, tb_rhs = tb_rhs}) arg_types result_type cinp.cinp_group_index
+				= newFunction No (TransformedBody {tb_args = tb_args, tb_rhs = tb_rhs}) local_free_vars arg_types result_type cinp.cinp_group_index
 						(ci.ci_next_fun_nr, ci.ci_new_functions, ci.ci_fun_heap)
+		  free_var = varToFreeVar var (inc ref_count)
 		= ({	bind_src = App {	app_symb 		= fun_symb,
 									app_args 		= act_args,
 									app_info_ptr	= nilPtr },
-				bind_dst = varToFreeVar var (inc ref_count) },
-		   { ci & ci_var_heap = ci_var_heap, ci_next_fun_nr = ci_next_fun_nr, ci_new_functions = ci_new_functions, ci_fun_heap = ci_fun_heap })
+				bind_dst = free_var },
+		   { ci & ci_var_heap = ci_var_heap, ci_next_fun_nr = ci_next_fun_nr, ci_new_functions = ci_new_functions, ci_fun_heap = ci_fun_heap,
+					 ci_new_variables = [ free_var : ci_new_variables ] })
 	where
 		get_reference_count {var_name,var_info_ptr} ci=:{ci_var_heap}
 			# (info, ci_var_heap) = readPtr var_info_ptr ci_var_heap
@@ -361,14 +388,25 @@ generateBinding cinp bound_vars var bind_expr result_type ci
 				VI_Default ref_count	-> (ref_count, ci)
 //				_						-> (0, ci) ---> ("get_reference_count", var_name)  /* A predicted variable always has a ref_count */ 
 		
-		save_default ({fv_info_ptr},_) (saved_defaults, ci_var_heap)
+		save_default {tv_free_var={fv_info_ptr}} (saved_defaults, ci_var_heap)
 			# (info, ci_var_heap) = readPtr fv_info_ptr ci_var_heap
 			= case info of
-				VI_Default ref_count	-> ([(fv_info_ptr, ref_count) : saved_defaults] , ci_var_heap)
+				VI_Default ref_count
+					-> ([(fv_info_ptr, info) : saved_defaults] , ci_var_heap)
+				VI_Indirection ref_count
+					-> ([(fv_info_ptr, info) : saved_defaults] , ci_var_heap)
 				_						-> (saved_defaults, ci_var_heap)
 				
-		restore_default (var_info_ptr,ref_count) ci_var_heap
-			= ci_var_heap <:= (var_info_ptr, VI_Default ref_count)
+		restore_default (var_info_ptr,info) ci_var_heap
+			= ci_var_heap <:= (var_info_ptr, info)
+
+		remove_local_var fv=:{fv_info_ptr} (local_vars, var_heap)
+			# (info, var_heap) = readPtr fv_info_ptr var_heap
+			= case info of
+				VI_LocalVar
+					-> (local_vars, var_heap)
+				_
+					-> ([fv : local_vars], var_heap)
 
 
 /**************************************************************************************************/
@@ -381,12 +419,13 @@ where
 	create_variable var_info_ptr ci
 		# (placeholder_symb, ci) = getSymbol PD_variablePlaceholder SK_Constructor 3 ci
 		  cyclic_var = {var_name = a_ij_var_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr}	
+		  cyclic_fv = varToFreeVar cyclic_var 1	
 		= ({ bind_src = App {	app_symb = placeholder_symb,
 								app_args = [Var cyclic_var, Var cyclic_var],
 								app_info_ptr = nilPtr },
 			 bind_dst = varToFreeVar cyclic_var 1
 		   },
-		   ci)
+		   { ci & ci_new_variables = [ cyclic_fv : ci.ci_new_variables ]})
 
 /**************************************************************************************************/
 
@@ -417,9 +456,14 @@ where
 	toExpression2 variable [indirection_var : indirection_vars] ci
 		# (expression, ci) = toExpression2 variable indirection_vars ci
 		  (undo_symb, ci) = getSymbol PD_undo_indirections SK_Function 2 ci
+		  ci_var_heap = adjust_ref_count indirection_var ci.ci_var_heap
 		= (App {	app_symb = undo_symb,
 					app_args = [expression, Var indirection_var],
-					app_info_ptr = nilPtr }, ci)
+					app_info_ptr = nilPtr }, { ci & ci_var_heap = ci_var_heap })
+
+	adjust_ref_count {var_info_ptr} var_heap
+		# (VI_Indirection ref_count, var_heap) = readPtr var_info_ptr var_heap
+		= var_heap <:= (var_info_ptr, VI_Indirection (inc ref_count))
 
 varToFreeVar :: BoundVar Int -> FreeVar
 varToFreeVar {var_name, var_info_ptr} count
@@ -432,7 +476,7 @@ freeVarToVar {fv_name, fv_info_ptr}
 
 addToBoundVars :: BoundVar AType BoundVariables -> BoundVariables
 addToBoundVars var type bound_vars
-	= [ (varToFreeVar var 0, type) : bound_vars ]
+	= [ { tv_free_var = varToFreeVar var 0, tv_type = type } : bound_vars ]
 
 
 get_constructor :: !{!GlobalTCType} Index -> Expression