convertDynamics.icl

implementation module convertDynamics

import syntax, transform, utilities, convertcases

::	*ConversionInfo =
	{	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
	
	//	data needed to generate coercions
	,	ci_placeholders_and_tc_args		:: [(!BoundVar,Ptr VarInfo)]
	}

::	ConversionInput =
	{	cinp_glob_type_inst	:: !{! GlobalTCType} 
	,	cinp_group_index	:: !Int
	,	cinp_st_args		:: ![FreeVar]
	}

:: OpenedDynamic =
	{	opened_dynamic_expr :: Expression
	, 	opened_dynamic_type :: Expression
	}

:: DefaultExpression :== Optional (BoundVar, [IndirectionVar])   //DefaultRecord

::	BoundVariables :== [TypedVariable]

:: IndirectionVar    :== BoundVar

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 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_new_variables = [], ci_fun_heap = newHeap, ci_next_fun_nr = nr_of_funs, ci_placeholders_and_tc_args = [] })
	  (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 [] 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
		| group_nr == size groups
			= (groups, fun_defs_and_ci)
			# (group, groups) = groups![group_nr]
			= convert_groups (inc group_nr) groups global_type_instances (foldSt (convert_function group_nr global_type_instances) group.group_members fun_defs_and_ci)

	convert_function group_nr global_type_instances fun (fun_defs, ci)
		# (fun_def, fun_defs) = fun_defs![fun]
		  {fun_body, fun_type, fun_info} = fun_def
		| isEmpty fun_info.fi_dynamics
			= (fun_defs, ci)
			# (fun_body, ci) = convert_dynamics_in_body {cinp_st_args = [], 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, fun_info = { fun_info & fi_local_vars = ci.ci_new_variables ++ fun_info.fi_local_vars }}},
				{ ci & ci_new_variables = [] })
// MV ..
	convert_dynamics_in_body global_type_instances (TransformedBody {tb_args,tb_rhs}) (Yes {st_context, st_args}) ci
		# vars_with_types = bindVarsToTypes2 st_context tb_args st_args [] common_defs
// .. MV
		  (tb_rhs, ci) = convertDynamics {global_type_instances & cinp_st_args = tb_args} 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'"

// MV ..
bindVarsToTypes2 st_context vars types typed_vars common_defs
	:== bindVarsToTypes vars (addTypesOfDictionaries common_defs st_context types) typed_vars
// .. MV
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)

instance convertDynamics [a]  |  convertDynamics a
where
	convertDynamics :: !ConversionInput !BoundVariables !DefaultExpression ![a] !*ConversionInfo -> (![a], !*ConversionInfo)  |  convertDynamics a
	convertDynamics cinp bound_vars default_expr xs ci = mapSt (convertDynamics cinp bound_vars default_expr) xs ci

instance convertDynamics (Optional a)  |  convertDynamics a
where
	convertDynamics :: !ConversionInput !BoundVariables !DefaultExpression !(Optional a) !*ConversionInfo -> (!Optional a, !*ConversionInfo)  |  convertDynamics a
	convertDynamics cinp bound_vars default_expr (Yes x)	ci
		# (x, ci) = convertDynamics cinp bound_vars default_expr x ci
		= (Yes x, ci)
	convertDynamics _ _ _ No ci
		= (No, ci)

instance convertDynamics (Bind a b)  |  convertDynamics a
where
	convertDynamics :: !ConversionInput !BoundVariables !DefaultExpression !(Bind a b) !*ConversionInfo -> (!Bind a b, !*ConversionInfo)  |  convertDynamics a
	convertDynamics cinp bound_vars default_expr binding=:{bind_src} ci
		# (bind_src, ci) = convertDynamics cinp bound_vars default_expr bind_src ci
		= ({binding &  bind_src = bind_src}, ci)

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 (bindVarsToTypes ap_vars arg_types_of_conses bound_vars) default_expr ap_expr ci
	= ({algebraic_pattern &  ap_expr = ap_expr}, ci)

instance convertDynamics BasicPattern
where
	convertDynamics :: !ConversionInput !BoundVariables !DefaultExpression !BasicPattern !*ConversionInfo -> (!BasicPattern, !*ConversionInfo)
	convertDynamics cinp bound_vars default_expr basic_pattern=:{bp_expr} ci
		# (bp_expr, ci) = convertDynamics cinp bound_vars default_expr bp_expr ci
		= ({basic_pattern &  bp_expr = bp_expr}, ci)


instance convertDynamics Expression
where
	convertDynamics :: !ConversionInput !BoundVariables !DefaultExpression !Expression !*ConversionInfo -> (!Expression, !*ConversionInfo)
	convertDynamics cinp bound_vars default_expr (Var var) ci
		= (Var var, ci)
	convertDynamics cinp bound_vars default_expr (App appje=:{app_args}) ci
		# (app_args,ci) = convertDynamics cinp bound_vars default_expr app_args ci
		= (App {appje &  app_args = app_args}, ci)
	convertDynamics cinp bound_vars default_expr (expr @ exprs) ci
		# (expr,  ci) = convertDynamics cinp bound_vars default_expr expr  ci
		  (exprs, ci) = convertDynamics cinp bound_vars default_expr exprs ci
		= (expr @ exprs, ci)
	convertDynamics cinp bound_vars default_expr (Let letje=:{let_strict_binds, let_lazy_binds, let_expr,let_info_ptr}) ci
		# (let_types, ci) = determine_let_types let_info_ptr ci
		  bound_vars = bindVarsToTypes [ bind.bind_dst \\ bind <- let_strict_binds ++ let_lazy_binds ] let_types bound_vars
		  (let_strict_binds, ci)	= convertDynamics cinp bound_vars default_expr let_strict_binds ci
		  (let_lazy_binds, ci)		= convertDynamics cinp bound_vars default_expr let_lazy_binds ci
		  (let_expr,  ci) 			= convertDynamics cinp bound_vars default_expr let_expr  ci
		= (Let { letje &  let_strict_binds = let_strict_binds, let_lazy_binds = let_lazy_binds, let_expr = let_expr}, ci)
	where
		determine_let_types let_info_ptr ci=:{ci_expr_heap}
			# (EI_LetType let_types, ci_expr_heap) = readPtr let_info_ptr ci_expr_heap
			= (let_types, { ci & ci_expr_heap = ci_expr_heap })

	convertDynamics cinp bound_vars default_expr (Case keesje=:{case_expr, case_guards, case_default, case_info_ptr}) ci
		# (case_expr,    ci) = convertDynamics cinp bound_vars default_expr case_expr ci
		  (case_default, ci) = convertDynamics cinp bound_vars default_expr case_default ci
		  (this_case_default, nested_case_default, ci) = determine_defaults case_default default_expr ci
		  (EI_CaseType {ct_cons_types, ct_result_type}, ci_expr_heap) = readPtr case_info_ptr ci.ci_expr_heap
		  ci = { ci & ci_expr_heap = ci_expr_heap }
		= case case_guards of
			(AlgebraicPatterns type algebraic_patterns)
				#  (algebraic_patterns, ci) = mapSt (convertDynamicsOfAlgebraicPattern cinp bound_vars nested_case_default)
													(zip2 algebraic_patterns ct_cons_types) ci
				-> (Case {keesje &  case_expr = case_expr, case_guards = AlgebraicPatterns type algebraic_patterns, case_default = this_case_default}, ci)
			(BasicPatterns type basic_patterns)
				#  (basic_patterns, ci) = convertDynamics  cinp bound_vars nested_case_default basic_patterns ci
				-> (Case {keesje &  case_expr = case_expr, case_guards = BasicPatterns type basic_patterns, case_default = this_case_default}, ci)
			(DynamicPatterns dynamic_patterns)
				#  keesje = {keesje &  case_expr = case_expr, case_default = this_case_default}
				-> convertDynamicPatterns cinp bound_vars keesje ci
			NoPattern
				-> (Case {keesje &  case_expr = case_expr, case_guards = NoPattern, case_default = this_case_default}, ci)
			_
				-> abort "unexpected value in convertDynamics: 'convertDynamics.CasePatterns'"
	convertDynamics cinp bound_vars default_expr (Selection opt_symb expression selections) ci
		# (expression,ci) = convertDynamics cinp bound_vars default_expr expression ci
		= (Selection opt_symb expression selections, ci)
	convertDynamics cinp bound_vars default_expr (Update expression1 selections expression2) ci
		# (expression1,ci) = convertDynamics cinp bound_vars default_expr expression1 ci
		# (expression2,ci) = convertDynamics cinp bound_vars default_expr expression2 ci
		= (Update expression1 selections expression2, ci)
	convertDynamics cinp bound_vars default_expr (RecordUpdate cons_symbol expression expressions) ci
		# (expression,ci) = convertDynamics cinp bound_vars default_expr expression ci
		# (expressions,ci) = convertDynamics cinp bound_vars default_expr expressions ci
		= (RecordUpdate cons_symbol expression expressions, ci)
	convertDynamics cinp bound_vars default_expr (TupleSelect definedSymbol int expression) ci
		# (expression,ci) = convertDynamics cinp bound_vars default_expr expression ci
		= (TupleSelect definedSymbol int expression, ci)
	convertDynamics _ _ _ (BasicExpr basicValue basicType) ci
		= (BasicExpr basicValue basicType, ci)
	convertDynamics _ _ _ (AnyCodeExpr codeBinding1 codeBinding2 strings) ci
		= (AnyCodeExpr codeBinding1 codeBinding2 strings, ci)
	convertDynamics _ _ _ (ABCCodeExpr strings bool) ci
		= (ABCCodeExpr strings bool, ci)
	convertDynamics cinp bound_vars default_expr (MatchExpr opt_symb symb expression) ci
		# (expression,ci) = convertDynamics cinp bound_vars default_expr expression ci
		= (MatchExpr opt_symb symb expression, ci)
	convertDynamics cinp bound_vars default_expr  (DynamicExpr {dyn_expr, dyn_info_ptr, dyn_uni_vars, dyn_type_code}) ci
		# (twoTuple_symb, ci) 	= getSymbol (GetTupleConsIndex 2) SK_Constructor 2 ci
		  (let_binds,     ci) 	= createVariables dyn_uni_vars [] ci
		  (dyn_expr,      ci) 	= convertDynamics cinp bound_vars default_expr dyn_expr ci
		  (dyn_type_code,_,_,ci) = convertTypecode cinp dyn_type_code False [] [] ci
//		  (_,dyn_type_code, ci) = convertTypecode cinp dyn_type_code ci
		= case let_binds of
			[]	-> (App {	app_symb		= twoTuple_symb,
							app_args 		= [dyn_expr, dyn_type_code],
							app_info_ptr	= nilPtr }, ci)
			_ 	#  (let_info_ptr,  ci) = let_ptr ci
				-> ( Let {	let_strict_binds	= [],
							let_lazy_binds		= let_binds,
							let_expr			= App {	app_symb		= twoTuple_symb,
														app_args 		= [dyn_expr, dyn_type_code],
														app_info_ptr	= nilPtr },
							let_info_ptr		= let_info_ptr}, ci)
	convertDynamics cinp bound_vars default_expr (TypeCodeExpression type_code) ci
		= abort "convertDynamics cinp bound_vars default_expr (TypeCodeExpression" //convertTypecode cinp type_code ci
	convertDynamics cinp bound_vars default_expr EE ci
		= (EE, ci)
	convertDynamics cinp bound_vars default_expr expression ci
		= abort "unexpected value in convertDynamics: 'convertDynamics.Expression'"



//convertTypecode ::  !ConversionInput TypeCodeExpression !*ConversionInfo  -> (Expression,!*ConversionInfo)
/*
	replace all references in a type code expression which refer to an argument i.e. the argument contains a
	type to their placeholders. Return is a list of (placeholder,argument) list. Each tuple is used later as
	arguments to the coerce relation. This should be optional
	

*/
// ci_placeholders_and_tc_args
convertTypecode cinp TCE_Empty replace_tc_args binds placeholders_and_tc_args ci 
	= (EE,binds,placeholders_and_tc_args,ci)

convertTypecode cinp=:{cinp_st_args} (TCE_Var var_info_ptr) replace_tc_args binds placeholders_and_tc_args ci=:{ci_placeholders_and_tc_args}
	| not replace_tc_args
		= (Var {var_name = a_ij_var_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr},binds,placeholders_and_tc_args, ci)

	// check if tc_arg has already been replaced by a placeholder
	#! ci_placeholder_and_tc_arg
		= filter (\(_,tc_args_ptr) -> tc_args_ptr == var_info_ptr) ci_placeholders_and_tc_args
	| not (isEmpty ci_placeholder_and_tc_arg)
		= (Var {var_name = v_tc_placeholder_ident, var_info_ptr = (fst (hd ci_placeholder_and_tc_arg)).var_info_ptr, var_expr_ptr = nilPtr},binds,placeholders_and_tc_args, ci)

	
	#! cinp_st_args
		= filter (\{fv_info_ptr} -> fv_info_ptr == var_info_ptr) cinp_st_args
	| isEmpty cinp_st_args
		// type pattern variable is *not* an argument i.e. nothing to replace
		= (Var {var_name = a_ij_var_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr},binds,placeholders_and_tc_args, ci)
		
		// type pattern variable is an argument i.e. contains a type code expression
		#! (placeholder_var, ci) 
			= newVariable v_tc_placeholder VI_Empty ci
		#! placeholder_fv
			= varToFreeVar placeholder_var 1 
		#! (place_holder_and_tc_arg,ci)
			= create_variable v_tc_placeholder_ident placeholder_var.var_info_ptr ci
			
		#! ci
			= { ci & 
				ci_placeholders_and_tc_args = [(placeholder_var /*.var_info_ptr*/,var_info_ptr):ci_placeholders_and_tc_args]
			,	ci_new_variables			= [placeholder_fv:ci.ci_new_variables]	}
			
		= (Var placeholder_var,[place_holder_and_tc_arg:binds],[(placeholder_var.var_info_ptr,var_info_ptr):placeholders_and_tc_args], ci)

// 1st component of tuple is true iff:
// 1. The type is a TCE_Var or TCE_TypeTerm
// 2. It is also a argument of the function
// Thus a tc argument variable.
// This forms a special case: instead of an unify, a coerce can be generated
convertTypecode cinp (TCE_TypeTerm var_info_ptr) replace_tc_args binds placeholders_and_tc_args ci
	/*
	** TCE_Var and TCE_TypeTerm are not equivalent. A TCE_TypeTerm is used for an argument which contains
	** a type representation. A TCE_Var is an existential quantified type variable. In previous phases no
	** clear distinction is made. It should be possible to generate the proper type code expression for
	** these two but it would involve changing a lot of small things. 
	*/
	= convertTypecode cinp (TCE_Var var_info_ptr) replace_tc_args binds placeholders_and_tc_args ci

convertTypecode cinp (TCE_Constructor index typecode_exprs) replace_tc_args binds placeholders_and_tc_args ci
	# (typecons_symb,  ci) 									= getSymbol PD_TypeConsSymbol SK_Constructor 2 ci
	  constructor											= get_constructor cinp.cinp_glob_type_inst index
	  (typecode_exprs,binds,placeholders_and_tc_args,ci)	= convertTypecodes cinp typecode_exprs replace_tc_args binds placeholders_and_tc_args ci
	= (App {app_symb		= typecons_symb,
			app_args 		= [constructor , typecode_exprs],
			app_info_ptr	= nilPtr},binds,placeholders_and_tc_args,ci)

convertTypecode cinp (TCE_Selector selections var_info_ptr) replace_tc_args binds placeholders_and_tc_args ci
	#! (var,binds,placeholders_and_tc_args,ci)		
		= convertTypecode cinp (TCE_Var var_info_ptr) replace_tc_args binds placeholders_and_tc_args ci
	= (Selection No var selections,binds,placeholders_and_tc_args,ci)

//convertTypecodes :: !ConversionInput [TypeCodeExpression] !*ConversionInfo  -> (Expression,!*ConversionInfo)
convertTypecodes _ [] replace_tc_args binds placeholders_and_tc_args ci
	# (nil_symb, ci) = getSymbol PD_NilSymbol SK_Constructor 0 ci
	= (App {	app_symb		= nil_symb,
				app_args 		= [],
				app_info_ptr	= nilPtr},binds,placeholders_and_tc_args, ci)

convertTypecodes cinp [typecode_expr : typecode_exprs] replace_tc_args binds placeholders_and_tc_args ci
	# (cons_symb, ci) = getSymbol PD_ConsSymbol SK_Constructor 2 ci
	# (expr,binds,placeholders_and_tc_args, ci) = convertTypecode  cinp typecode_expr  replace_tc_args binds placeholders_and_tc_args ci
	# (exprs,binds,placeholders_and_tc_args,ci) = convertTypecodes cinp typecode_exprs replace_tc_args binds placeholders_and_tc_args ci
	= (App {	app_symb		= cons_symb,
				app_args 		= [expr , exprs],
				app_info_ptr	= nilPtr}, binds,placeholders_and_tc_args, ci)

determine_defaults :: (Optional Expression) DefaultExpression !*ConversionInfo -> (Optional Expression, DefaultExpression, !*ConversionInfo)
/***
determine_defaults :: case_default default_expr varheap -> (this_case_default, nested_case_default, var_heap)
	this_case_default =	IF this case has no default, but there is a surrounding default
						THEN that is now the default and its reference count must be increased.
						ELSE it keeps this default
	nested_case_default  = 	IF this case has no default
		 					THEN the default_expr remains default in the nested cases.
							ELSE nested cases get this default. This is semantically already the case, so nothing has to be changed.

***/



// the case itself has no default but it has a surrounding default
determine_defaults No default_expr=:(Yes (var=:{var_info_ptr}, indirection_var_list)) ci=:{ci_var_heap}
	#! var_info = sreadPtr var_info_ptr ci_var_heap
	# (expression, ci) = toExpression default_expr {ci & ci_var_heap = ci_var_heap}
	= case var_info of
		VI_Default ref_count
			-> (expression, default_expr, {ci & ci_var_heap = ci.ci_var_heap <:= (var_info_ptr, VI_Default (inc ref_count))} )
		_
			-> (expression, default_expr, ci )
determine_defaults case_default _ ci
	= (case_default, No, 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 (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 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
	  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 ]})

/**************************************************************************************************/

convertDynamicPatterns :: !ConversionInput !BoundVariables !Case *ConversionInfo -> (Expression, *ConversionInfo)
convertDynamicPatterns cinp bound_vars {case_guards = DynamicPatterns [], case_default} ci
	= case case_default of
		(Yes expr)	-> (expr, ci)
		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_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) = 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_binds = [], let_lazy_binds = [ dt_bind : binds ], let_expr = expr, let_info_ptr = let_info_ptr}, 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 not 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  ***/

		  (a_ij_binds, ci)		= createVariables dp_type_patterns_vars [] ci
//	 	  (unify,type_code, ci)	= convertTypecode cinp dp_type_code ci
	 	  (type_code,a_ij_binds ,_, ci)	= convertTypecode cinp dp_type_code True /* should be changed to True for type dependent functions */  a_ij_binds [] ci
	 	  
	 	# (ci_placeholders_and_tc_args,ci)
	 		= ci!ci_placeholders_and_tc_args;
	 		
	 	// // foldSt :: !(.a -> .(.st -> .st)) ![.a] !.st -> .st

	 	# bound_vars
	 		= foldl (\bound_vars (place_holder,_) -> addToBoundVars place_holder empty_attributed_type bound_vars) bound_vars ci_placeholders_and_tc_args
	 	  
	 	  // walks through the patterns within one alternative
	 	  (dp_rhs, ci)			= convertDynamics cinp bound_vars this_default dp_rhs ci
	 	  
	 	  
		  /***  recursively convert the other patterns in the other alternatives ***/

	 	  (binds, ci)		= convert_other_patterns cinp bound_vars this_default pattern_number opened_dynamic result_type last_default patterns ci
	 	  
	 	  	 	 // coercions ..
		# (bound_vars,dp_rhs,ci)
			= case (isEmpty ci_placeholders_and_tc_args) of 
				True
					-> (bound_vars,dp_rhs,ci)
				False
					#! (bound_vars,new_dp_rhs,ci)
						= gen_type_coercions result_type bound_vars this_default pattern_number 0 dp_rhs ci
					-> (bound_vars,new_dp_rhs,ci)
		  // .. coercions
	 	  

		  /***  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
		  
		  // was coercions
		  
		  (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
		  a_ij_binds			= add_x_i_bind opened_dynamic.opened_dynamic_expr dp_var a_ij_binds

		  let_expr = Let {	let_strict_binds = [],
		  					let_lazy_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,
// MW was:												case_guards		= BasicPatterns BT_Bool [{bp_value = BVB True, bp_expr = dp_rhs}],
												case_guards		= BasicPatterns BT_Bool [{bp_value = BVB True, bp_expr = dp_rhs, bp_position = NoPos }],
												case_default	= default_expr,
												case_ident		= No,
												case_info_ptr	= case_info_ptr,
												case_default_pos= NoPos }, // MW4++
		  					let_info_ptr = let_info_ptr	}
		  					
		= (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})
*/

		add_x_i_bind bind_src bind_dst=:{fv_count} binds
			| fv_count > 0
				= [ { bind_src = bind_src, bind_dst = bind_dst } : binds ]
				= binds

	// other alternatives
	convert_other_patterns :: ConversionInput BoundVariables DefaultExpression Int OpenedDynamic AType !(Optional Expression) ![DynamicPattern] !*ConversionInfo
			-> (Env Expression FreeVar, *ConversionInfo)
	convert_other_patterns _ _ _ _ _ _  No  []  ci
		// no default and no alternatives left
		= ([], ci)
	convert_other_patterns cinp bound_vars this_default _ _ result_type (Yes last_default_expr) [] ci
		// default without alternatives left
		# 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)
	   
	   
	  /*
	 		# (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)
	    
	  
	 */
	
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})

gen_type_coercions result_type bound_vars _ pattern_n coercion_n dp_rhs ci=:{ci_placeholders_and_tc_args=[]}
	// there no more type coercions to carry out
	= (bound_vars,dp_rhs,ci)
gen_type_coercions result_type bound_vars this_default pattern_n coercion_n dp_rhs ci=:{ci_placeholders_and_tc_args=[({var_info_ptr=a_ij},a_ij_tc):rest]}
	# let_binds
		= []

	// extra
	# a_ij_var = {var_name = a_ij_var_name, var_info_ptr = a_ij, var_expr_ptr = nilPtr}	
	# a_ij_tc_var = {var_name = a_aij_tc_var_name, var_info_ptr = a_ij_tc, var_expr_ptr = nilPtr}


	// indirections
	# (ind_i,   ci) = newVariable ("ind_!"+++toString pattern_n +++ "_" +++ toString coercion_n) (VI_Indirection 1) ci
	  (c_inc_i, ci) = newVariable ("c_!"+++toString pattern_n +++ "_" +++ toString (inc coercion_n)) (VI_Default 0) ci
	  new_default = newDefault c_inc_i ind_i

	#		

 	  (coerce_symb, ci)		= getSymbol PD_coerce SK_Function 2 ci
	  (twotuple, ci) 		= getTupleSymbol 2 ci
	  (let_info_ptr, ci) 	= let_ptr ci
	  (case_info_ptr, ci)	= case_ptr ci


	  (coerce_result_var, ci)	= newVariable "result" VI_Empty ci
	  coerce_result_fv 			= varToFreeVar coerce_result_var 1
	  (coerce_bool_var, ci)		= newVariable "coerce_bool" VI_Empty ci
	  coerce_bool_fv 			= varToFreeVar coerce_bool_var 1
	  
	# (let_binds, ci) 		= bind_indirection_var ind_i coerce_result_var twotuple ci

	  


/*
newDefault :: BoundVar IndirectionVar -> DefaultExpression
newDefault variable indirection_var = Yes (variable, [indirection_var])

getVariable :: DefaultExpression -> BoundVar
getVariable (Yes (variable, _)) = variable
getVariable No = abort "unexpected value in convertDynamics: 'getVariable'"

getIndirectionVar (Yes (_, [ind_var:_])) = ind_var
getIndirectionVar No = abort "unexpected value in convertDynamics: 'getIndirectionVar'"

toExpression :: DefaultExpression !*ConversionInfo -> (Optional Expression, !*ConversionInfo)
t
*/
	  
	  ind_i_fv = varToFreeVar ind_i 1
	  c_inc_i_fv = varToFreeVar c_inc_i 1
	  ci = { ci & ci_new_variables = [ c_inc_i_fv,ind_i_fv : ci.ci_new_variables ] }
	  

	# bound_vars
		= (addToBoundVars ind_i empty_attributed_type (addToBoundVars c_inc_i result_type bound_vars))

    #  (default_expr, ci) 	
      	= MYtoExpression (newDefault (getVariable this_default) ind_i) ci // this_default ci
	  
	// extra
	# (bound_vars,new_dp_rhs,ci)
		= gen_type_coercions result_type bound_vars new_default pattern_n (inc coercion_n) dp_rhs { ci & ci_placeholders_and_tc_args = rest }

	# let_expr
		= Let {
				let_strict_binds	= []
			,	let_lazy_binds		= [{ bind_src = App { app_symb = coerce_symb,  app_args = [Var a_ij_var, Var a_ij_tc_var],  app_info_ptr = nilPtr },
  								   bind_dst = coerce_result_fv }
  								   ,
  								 { bind_src = TupleSelect twotuple 0 (Var coerce_result_var),
  								   bind_dst = coerce_bool_fv } : let_binds
  								],
  					let_expr =
  					 Case {	case_expr 		= Var coerce_bool_var,
// MW was:												case_guards		= BasicPatterns BT_Bool [{bp_value = BVB True, bp_expr = dp_rhs}],
										case_guards		= BasicPatterns BT_Bool [{bp_value = BVB True, bp_expr = EE /*new_dp_rhs*/, bp_position = NoPos }],
										case_default	= default_expr,
										case_ident		= No,
										case_info_ptr	= case_info_ptr,
										case_default_pos= NoPos } // MW4++
			,	let_info_ptr = let_info_ptr	
  		}
	
	// dp_rhs
	= (bound_vars,let_expr,{ ci & ci_new_variables = [coerce_result_fv, coerce_bool_fv : ci.ci_new_variables]}) //let_expr,ci)
	
	// { ci & ci_new_variables = [unify_result_fv, unify_bool_fv : ci.ci_new_variables]})



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
		# 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, 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 = [ 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}) 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 = 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
			  ci = { ci & ci_var_heap = ci_var_heap }
			= case info of
				VI_Default ref_count	-> (ref_count, ci)
//				_						-> (0, ci) ---> ("get_reference_count", var_name)  /* A predicted variable always has a ref_count */ 
		
		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, 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,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)


/**************************************************************************************************/

createVariables :: [VarInfoPtr] !(Env Expression FreeVar) !*ConversionInfo -> (!Env Expression FreeVar, !*ConversionInfo)
createVariables var_info_ptrs binds ci
	= mapAppendSt (create_variable a_ij_var_name) var_info_ptrs binds ci

create_variable :: !Ident VarInfoPtr !*ConversionInfo -> (Bind Expression FreeVar, !*ConversionInfo)
create_variable var_name var_info_ptr ci
	# (placeholder_symb, ci) = getSymbol PD_variablePlaceholder SK_Constructor 3 ci
	  cyclic_var = {var_name = 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_new_variables = [ cyclic_fv : ci.ci_new_variables ]})

/**************************************************************************************************/

newVariable :: String !VarInfo !*ConversionInfo -> *(!BoundVar,!*ConversionInfo)
newVariable var_name var_info ci=:{ci_var_heap}
	# (var_info_ptr, ci_var_heap) = newPtr var_info ci_var_heap
	= ( { var_name = {id_name = var_name, id_info = nilPtr},  var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr},
	    { ci & ci_var_heap = ci_var_heap })	


newDefault :: BoundVar IndirectionVar -> DefaultExpression
newDefault variable indirection_var = Yes (variable, [indirection_var])

getVariable :: DefaultExpression -> BoundVar
getVariable (Yes (variable, _)) = variable
getVariable No = abort "unexpected value in convertDynamics: 'getVariable'"

getIndirectionVar (Yes (_, [ind_var:_])) = ind_var
getIndirectionVar No = abort "unexpected value in convertDynamics: 'getIndirectionVar'"

MYtoExpression :: DefaultExpression !*ConversionInfo -> (Optional Expression, !*ConversionInfo)
MYtoExpression No ci = (No, ci)
MYtoExpression (Yes (variable, indirection_var_list)) ci
	| length indirection_var_list <> 1
		= abort "toExpression: meerdere indirectie variables"
	# (expression, ci) = toExpression2 variable indirection_var_list ci
	= (Yes expression, ci)
where
	toExpression2 variable [] ci = (Var variable, ci)
	toExpression2 variable [indirection_var] ci
		# (undo_symb, ci) = getSymbol PD_undo_indirections SK_Function 2 ci
		= (App {	app_symb = undo_symb,
					app_args = [Var variable, Var indirection_var],
					app_info_ptr = nilPtr },  ci)
		
	
/*
	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 = 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 & ci_var_heap = ci_var_heap }*/ ci)
*/

toExpression :: DefaultExpression !*ConversionInfo -> (Optional Expression, !*ConversionInfo)
toExpression No ci = (No, ci)
toExpression (Yes (variable, indirection_var_list)) ci
	| length indirection_var_list <> 1
		= abort "toExpression: meerdere indirectie variables"
	# (expression, ci) = toExpression2 variable indirection_var_list ci
	= (Yes expression, ci)
where
	toExpression2 variable [] ci = (Var variable, ci)
	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 & 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
	= {fv_def_level = NotALevel, fv_name = var_name, fv_info_ptr = var_info_ptr, fv_count = count}

freeVarToVar ::  FreeVar -> BoundVar
freeVarToVar {fv_name, fv_info_ptr}
	= { var_name = fv_name,  var_info_ptr = fv_info_ptr, var_expr_ptr = nilPtr}


addToBoundVars :: BoundVar AType BoundVariables -> BoundVariables
addToBoundVars var type bound_vars
	= [ { tv_free_var = varToFreeVar var 0, tv_type = type } : bound_vars ]


get_constructor :: !{!GlobalTCType} Index -> Expression
get_constructor glob_type_inst index
	= BasicExpr (BVS ("\"" +++ toString  glob_type_inst.[index] +++ "\"")) (BT_String TE)


instance toString GlobalTCType
where
	toString (GTT_Basic basic_type)				= toString basic_type
	toString GTT_Function						= " -> "
	toString (GTT_Constructor type_symb_indent)	= type_symb_indent.type_name.id_name

instance toString BasicType
where
	toString BT_Int 		= "Int"
	toString BT_Char		= "Char"
	toString BT_Real		= "Real"
	toString BT_Bool		= "Bool"
	toString BT_Dynamic		= "Dynamic"
	toString BT_File		= "File"
	toString BT_World		= "World"
	toString (BT_String _)	= "String"


getResultType :: ExprInfoPtr !*ConversionInfo -> (!AType, !*ConversionInfo)
getResultType case_info_ptr ci=:{ci_expr_heap}
	# (EI_CaseType {ct_result_type}, ci_expr_heap) = readPtr case_info_ptr ci_expr_heap
	= (ct_result_type, {ci & ci_expr_heap = ci_expr_heap})

getSymbol :: Index ((Global Index) -> SymbKind) Int !*ConversionInfo -> (SymbIdent, !*ConversionInfo)
getSymbol index symb_kind arity ci=:{ci_predef_symb}
	# ({pds_module, pds_def, pds_ident}, ci_predef_symb) = ci_predef_symb![index]
	  ci = {ci & ci_predef_symb = ci_predef_symb}
	  symbol = { symb_name = pds_ident, symb_kind = symb_kind { glob_module = pds_module, glob_object = pds_def}, symb_arity = arity }
	= (symbol, ci)

getTupleSymbol arity ci=:{ci_predef_symb}
	# ({pds_def, pds_ident}, ci_predef_symb) = ci_predef_symb![GetTupleConsIndex arity]
    = ( {ds_ident = pds_ident, ds_arity = arity, ds_index = pds_def}, {ci & ci_predef_symb = ci_predef_symb })

getGlobalIndex :: Index !*ConversionInfo -> (Global Index, !*ConversionInfo)
getGlobalIndex index ci=:{ci_predef_symb}
	# ({pds_module, pds_def}, ci_predef_symb) = ci_predef_symb![index]
	= ( { glob_module = pds_module, glob_object = pds_def} , {ci & ci_predef_symb = ci_predef_symb} )

getConstructor :: Index Int !*ConversionInfo -> (Global DefinedSymbol, !*ConversionInfo)
getConstructor index arity ci=:{ci_predef_symb}
	# ({pds_module, pds_def, pds_ident}, ci_predef_symb) = ci_predef_symb![index]
	  defined_symbol = { ds_ident = pds_ident, ds_arity = arity, ds_index = pds_def}
	= (	{glob_object = defined_symbol, glob_module = pds_module} , {ci & ci_predef_symb = ci_predef_symb} )


a_ij_var_name :== { id_name = "a_ij", id_info = nilPtr }
v_tc_name	  :== { id_name = "convertDynamicsvTC", id_info = nilPtr }
v_tc_placeholder_ident	:== { id_name = v_tc_placeholder, id_info = nilPtr }
v_tc_placeholder		:== "tc_placeholder"

a_aij_tc_var_name 	:== { id_name = "a_ij_tc", id_info = nilPtr }

case_ptr :: !*ConversionInfo -> (ExprInfoPtr, !*ConversionInfo)
case_ptr ci=:{ci_expr_heap}
	# (expr_info_ptr, ci_expr_heap) = newPtr (EI_CaseType {	ct_pattern_type = empty_attributed_type,
															ct_result_type = empty_attributed_type,
															ct_cons_types = repeat (repeat empty_attributed_type)}) ci_expr_heap
	= (expr_info_ptr, {ci &  ci_expr_heap = ci_expr_heap})

let_ptr :: !*ConversionInfo -> (ExprInfoPtr, !*ConversionInfo)
let_ptr ci=:{ci_expr_heap}
	# (expr_info_ptr, ci_expr_heap) = newPtr (EI_LetType (repeat empty_attributed_type)) ci_expr_heap
	= (expr_info_ptr, {ci &  ci_expr_heap = ci_expr_heap})


empty_attributed_type :: AType
empty_attributed_type = { at_attribute = TA_Multi, at_annotation = AN_None, at_type = TE }


isNo :: (Optional a) -> Bool
isNo (Yes _) = False
isNo No = True

zipAppend2 :: [.a] [.b] u:[w:(.a,.b)] -> v:[x:(.a,.b)], [w <= x, u <= v]
zipAppend2   []       ys     zs = zs
zipAppend2   xs       []     zs = zs
zipAppend2 [x : xs] [y : ys] zs = [ (x,y)  :  zipAppend2 xs ys zs ]


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