path: root/backend/backendconvert.icl

implementation module backendconvert

import code from library "backend_library"

import StdEnv

import frontend
import backend
import backendsupport, backendpreprocess
import RWSDebug

:: BEMonad a :== St !*BackEnd !a


:: Backender :== *BackEnd -> *BackEnd

/* +++
:: *BackEndState = {bes_backEnd :: BackEnd, bes_varHeap :: *VarHeap}

appBackEnd f beState
	#	(result, bes_backEnd)
		=	f beState.bes_backEnd
	=	(result, {beState & bes_backEnd = bes_backEnd})
accVarHeap f beState
	#	(result, varHeap)
		=	f beState.bes_varHeap
	=	(result, {beState & bes_varHeap = varHeap})
*/
appBackEnd f beState :== f beState
accVarHeap f beState :== f beState

beFunction0 f
	:== appBackEnd f
beFunction1 f m1
	:== m1 ==> \a1
	->	appBackEnd (f a1)
beFunction2 f m1 m2
	:== m1 ==> \a1
	->	m2 ==> \a2
	->	appBackEnd (f a1 a2)
beFunction3 f m1 m2 m3
	:== m1 ==> \a1
	->	m2 ==> \a2
	->	m3 ==> \a3
	->	appBackEnd (f a1 a2 a3)
beFunction4 f m1 m2 m3 m4
	:== m1 ==> \a1
	->	m2 ==> \a2
	->	m3 ==> \a3
	->	m4 ==> \a4
	->	appBackEnd (f a1 a2 a3 a4)
beFunction5 f m1 m2 m3 m4 m5
	:== m1 ==> \a1
	->	m2 ==> \a2
	->	m3 ==> \a3
	->	m4 ==> \a4
	->	m5 ==> \a5
	->	appBackEnd (f a1 a2 a3 a4 a5)
beFunction6 f m1 m2 m3 m4 m5 m6
	:== m1 ==> \a1
	->	m2 ==> \a2
	->	m3 ==> \a3
	->	m4 ==> \a4
	->	m5 ==> \a5
	->	m6 ==> \a6
	->	appBackEnd (f a1 a2 a3 a4 a5 a6)
beFunction7 f m1 m2 m3 m4 m5 m6 m7
	:== m1 ==> \a1
	->	m2 ==> \a2
	->	m3 ==> \a3
	->	m4 ==> \a4
	->	m5 ==> \a5
	->	m6 ==> \a6
	->	m7 ==> \a7
	->	appBackEnd (f a1 a2 a3 a4 a5 a6 a7)

changeArrayFunctionIndex selectIndex
	:== selectIndex

beBoolSymbol value
	:==	beFunction0 (BEBoolSymbol value)
beLiteralSymbol type value
	:==	beFunction0 (BELiteralSymbol type value)
beFunctionSymbol functionIndex moduleIndex
	:==	beFunction0 (BEFunctionSymbol functionIndex moduleIndex)
beSpecialArrayFunctionSymbol arrayFunKind functionIndex moduleIndex
	:==	beFunction0 (BESpecialArrayFunctionSymbol arrayFunKind (changeArrayFunctionIndex functionIndex) moduleIndex)
beDictionarySelectFunSymbol
	:==	beFunction0 BEDictionarySelectFunSymbol
beDictionaryUpdateFunSymbol
	:==	beFunction0 BEDictionaryUpdateFunSymbol
beConstructorSymbol moduleIndex constructorIndex
	:==	beFunction0 (BEConstructorSymbol constructorIndex moduleIndex)
beFieldSymbol fieldIndex moduleIndex
	:==	beFunction0 (BEFieldSymbol fieldIndex moduleIndex)
beTypeSymbol typeIndex moduleIndex
	:==	beFunction0 (BETypeSymbol typeIndex moduleIndex)
beBasicSymbol typeSymbolIndex
	:==	beFunction0 (BEBasicSymbol typeSymbolIndex)
beDontCareDefinitionSymbol
	:==	beFunction0 BEDontCareDefinitionSymbol
beNoArgs
	:==	beFunction0 BENoArgs
beArgs
	:==	beFunction2 BEArgs
beNoTypeArgs
	:==	beFunction0 BENoTypeArgs
beTypeArgs
	:==	beFunction2 BETypeArgs
beNormalNode
	:==	beFunction2 BENormalNode
beIfNode
	:==	beFunction3 BEIfNode
beGuardNode
	:==	beFunction7 BEGuardNode
beSelectorNode selectorKind
	:==	beFunction2 (BESelectorNode selectorKind)
beUpdateNode
	:==	beFunction1 BEUpdateNode
beNormalTypeNode
	:==	beFunction2 BENormalTypeNode
beVarTypeNode name
	:==	beFunction0 (BEVarTypeNode name)
beRuleAlt lineNumber
	:==	beFunction5 (BERuleAlt lineNumber)
beNoRuleAlts
	:==	beFunction0 BENoRuleAlts
beRuleAlts
	:==	beFunction2 BERuleAlts
beTypeAlt
	:==	beFunction2 BETypeAlt
beRule index isCaf
	:==	beFunction2 (BERule index isCaf)
beNoRules
	:==	beFunction0 BENoRules
beRules
	:==	beFunction2 BERules
beNodeDef sequenceNumber
	:==	beFunction1 (BENodeDef sequenceNumber)
beNoNodeDefs
	:==	beFunction0 BENoNodeDefs
beNodeDefs
	:==	beFunction2 BENodeDefs
beStrictNodeId
	:==	beFunction1 BEStrictNodeId
beNoStrictNodeIds
	:==	beFunction0 BENoStrictNodeIds
beStrictNodeIds
	:==	beFunction2 BEStrictNodeIds
beNodeIdNode
	:==	beFunction2 BENodeIdNode
beNodeId sequenceNumber
	:==	beFunction0 (BENodeId sequenceNumber)
beWildCardNodeId
	:==	beFunction0 BEWildCardNodeId
beConstructor
	:==	beFunction1 BEConstructor
beNoConstructors
	:==	beFunction0 BENoConstructors
beConstructors
	:==	beFunction2 BEConstructors
beNoFields
	:==	beFunction0 BENoFields
beFields
	:==	beFunction2 BEFields
beField fieldIndex moduleIndex 
	:==	beFunction1 (BEField fieldIndex moduleIndex)
beAnnotateTypeNode annotation
	:==	beFunction1 (BEAnnotateTypeNode annotation)
beAttributeTypeNode attribution
	:==	beFunction1 (BEAttributeTypeNode attribution)
beDeclareRuleType functionIndex moduleIndex name
	:==	beFunction0 (BEDeclareRuleType functionIndex moduleIndex name)
beDefineRuleType functionIndex moduleIndex
	:==	beFunction1 (BEDefineRuleType functionIndex moduleIndex)
beCodeAlt lineNumber
	:==	beFunction3 (BECodeAlt lineNumber)
beString string
	:==	beFunction0 (BEString string)
beStrings
	:==	beFunction2 BEStrings
beNoStrings
	:==	beFunction0 BENoStrings
beCodeParameter location
	:==	beFunction1 (BECodeParameter location)
beCodeParameters
	:==	beFunction2 BECodeParameters
beNoCodeParameters
	:==	beFunction0 BENoCodeParameters
beAbcCodeBlock inline
	:==	beFunction1 (BEAbcCodeBlock inline)
beAnyCodeBlock
	:==	beFunction3 BEAnyCodeBlock
beDeclareNodeId number lhsOrRhs name
	:==	beFunction0 (BEDeclareNodeId number lhsOrRhs name)
beAdjustArrayFunction backendId functionIndex moduleIndex
	:==	beFunction0 (BEAdjustArrayFunction backendId functionIndex moduleIndex)
beFlatType
	:==	beFunction2 BEFlatType
beNoTypeVars
	:==	beFunction0 BENoTypeVars
beTypeVars
	:==	beFunction2 BETypeVars
beTypeVar name
	:==	beFunction0 (BETypeVar name)
beExportType typeIndex
	:==	beFunction0 (BEExportType typeIndex)
beExportConstructor constructorIndex
	:==	beFunction0 (BEExportConstructor constructorIndex)
beExportField fieldIndex
	:==	beFunction0 (BEExportField fieldIndex)
beExportFunction dclIndexFunctionIndex iclFunctionIndex
	:==	beFunction0 (BEExportFunction dclIndexFunctionIndex iclFunctionIndex)
beTupleSelectNode arity index
	:==	beFunction1 (BETupleSelectNode arity index)
beMatchNode arity
	:==	beFunction2 (BEMatchNode arity)
beDefineImportedObjsAndLibs
	:== beFunction2 BEDefineImportedObjsAndLibs

notYetImplementedExpr :: Expression
notYetImplementedExpr
	=	(BasicExpr (BVS "\"error in compiler (something was not implemented by lazy Ronny)\"") BT_Int)

backEndConvertModules :: PredefinedSymbols FrontEndSyntaxTree VarHeap *BackEnd -> *BackEnd
backEndConvertModules predefs {fe_icl = fe_icl =: {icl_name, icl_functions, icl_common, icl_imported_objects}, fe_components, fe_dcls, fe_arrayInstances, fe_dclIclConversions, fe_iclDclConversions} varHeap backEnd
	// sanity check ...
//	| cIclModIndex <> kIclModuleIndex || cPredefinedModuleIndex <> kPredefinedModuleIndex
//		=	undef <<- "backendconvert, backEndConvertModules: module index mismatch"
	// ... sanity check
/*
	#  backEnd
		=	ruleDoesNotMatch 1 backEnd
			with
				ruleDoesNotMatch 0 backend
					=	backend
	#  backEnd
		=	abort "front end abort" backEnd
*/
	#! backEnd
		=	BEDeclareModules (size fe_dcls) backEnd
	#! backEnd
		=	predefineSymbols fe_dcls.[cPredefinedModuleIndex] predefs backEnd
	#! backEnd
		=	declareCurrentDclModule fe_icl fe_dcls.[cIclModIndex] backEnd
	#! backEnd
		=	declareOtherDclModules fe_dcls backEnd
	#! backEnd
		=	defineCurrentDclModule varHeap fe_icl fe_dcls.[cIclModIndex] backEnd
	#! backEnd
		=	defineOtherDclModules fe_dcls varHeap backEnd
	#! backEnd
		=	declareDclModule cIclModIndex fe_dcls.[cIclModIndex] backEnd
	#! backEnd
		=	defineDclModule varHeap cIclModIndex fe_dcls.[cIclModIndex] backEnd
	#! backEnd
		=	BEDeclareIclModule icl_name.id_name (size icl_functions) (size icl_common.com_type_defs) (size icl_common.com_cons_defs) (size icl_common.com_selector_defs) backEnd
	#! backEnd
		=	declareFunctionSymbols icl_functions (getConversions fe_iclDclConversions) functionIndices backEnd
		with
			getConversions :: (Optional {#Int}) -> {#Int}
			getConversions No
				=	{}
			getConversions (Yes conversions)
				=	conversions
	#! backEnd
		=	declare cIclModIndex varHeap icl_common backEnd
	#! backEnd
		=	declareArrayInstances fe_arrayInstances icl_functions backEnd
	#! (rules, backEnd)
		=	convertRules [(index, icl_functions.[index]) \\ (_, index) <- functionIndices] varHeap backEnd
	#! backEnd
		=	BEDefineRules rules backEnd
	#! backEnd
		=	beDefineImportedObjsAndLibs
				(convertStrings [imported.io_name \\ imported <- icl_imported_objects | not imported.io_is_library])
				(convertStrings [imported.io_name \\ imported <- icl_imported_objects | imported.io_is_library])
				backEnd
	#! backEnd
		=	adjustArrayFunctions predefs fe_arrayInstances icl_functions fe_dcls varHeap backEnd
	#! backEnd
		=	markExports fe_dcls.[cIclModIndex] icl_common.com_class_defs icl_common.com_type_defs fe_dclIclConversions backEnd
	=	backEnd
	where
		componentCount
			=	length functionIndices
		functionIndices
			=	flatten [[(componentIndex, member) \\ member <- group.group_members] \\ group <-: fe_components & componentIndex <- [0..]]

declareOtherDclModules :: {#DclModule} -> Backender
declareOtherDclModules dcls
	=	foldStateWithIndexA declareOtherDclModule dcls

defineOtherDclModules :: {#DclModule} VarHeap -> Backender
defineOtherDclModules dcls varHeap
	=	foldStateWithIndexA (defineOtherDclModule varHeap) dcls

declareCurrentDclModule :: IclModule DclModule -> Backender
declareCurrentDclModule {icl_common} {dcl_name, dcl_functions, dcl_is_system, dcl_common}
	=	BEDeclareDclModule cIclModIndex dcl_name.id_name dcl_is_system (size dcl_functions) (size icl_common.com_type_defs) (size dcl_common.com_cons_defs) (size dcl_common.com_selector_defs)
	
declareOtherDclModule :: ModuleIndex DclModule -> Backender
declareOtherDclModule moduleIndex dclModule
	| moduleIndex == cIclModIndex || moduleIndex == cPredefinedModuleIndex
		=	identity
	// otherwise
		=	declareDclModule moduleIndex dclModule

declareDclModule :: ModuleIndex DclModule -> Backender
declareDclModule moduleIndex {dcl_name, dcl_common, dcl_functions, dcl_is_system}
	=	BEDeclareDclModule moduleIndex dcl_name.id_name dcl_is_system (size dcl_functions) (size dcl_common.com_type_defs) (size dcl_common.com_cons_defs) (size dcl_common.com_selector_defs)

defineCurrentDclModule :: VarHeap IclModule DclModule -> Backender
defineCurrentDclModule varHeap {icl_common} {dcl_name, dcl_common, dcl_functions, dcl_is_system, dcl_conversions}
	=	declareCurrentDclModuleTypes dcl_common.com_type_defs typeConversions varHeap
	o`	defineCurrentDclModuleTypes dcl_common.com_cons_defs dcl_common.com_selector_defs dcl_common.com_type_defs typeConversions varHeap
	where
		typeConversions
			=	currentModuleTypeConversions icl_common.com_class_defs dcl_common.com_class_defs dcl_conversions

defineOtherDclModule :: VarHeap ModuleIndex DclModule -> Backender
defineOtherDclModule varHeap moduleIndex dclModule
	| moduleIndex == cIclModIndex || moduleIndex == cPredefinedModuleIndex
		=	identity
	// otherwise
		=	defineDclModule varHeap moduleIndex dclModule

defineDclModule :: VarHeap ModuleIndex DclModule -> Backender
defineDclModule varHeap moduleIndex {dcl_name, dcl_common, dcl_functions, dcl_is_system}
	=	declare moduleIndex varHeap dcl_common
	o`	declareFunTypes moduleIndex dcl_functions varHeap

class declareVars a :: a !VarHeap -> Backender

instance declareVars [a] | declareVars a where
	declareVars :: [a] VarHeap -> Backender | declareVars a
	declareVars list varHeap
		=	foldState (flip declareVars varHeap) list

instance declareVars (Ptr VarInfo) where
	declareVars varInfoPtr varHeap
		=	declareVariable BELhsNodeId varInfoPtr "_var???" varHeap	// +++ name

instance declareVars FreeVar where
	declareVars :: FreeVar VarHeap -> Backender
	declareVars freeVar varHeap
		=	declareVariable BELhsNodeId freeVar.fv_info_ptr freeVar.fv_name.id_name varHeap

instance declareVars (Bind a FreeVar) where
	declareVars :: (Bind a FreeVar) VarHeap -> Backender
	declareVars {bind_dst=freeVar} varHeap
		=	declareVariable BERhsNodeId freeVar.fv_info_ptr freeVar.fv_name.id_name varHeap

declareVariable :: Int (Ptr VarInfo) {#Char} VarHeap -> Backender
declareVariable lhsOrRhs varInfoPtr name varHeap
	=	beDeclareNodeId (getVariableSequenceNumber varInfoPtr varHeap) lhsOrRhs name

instance declareVars (Optional a) | declareVars a where
	declareVars :: (Optional a) VarHeap -> Backender | declareVars a
	declareVars (Yes x) varHeap
		=	declareVars x varHeap
	declareVars No _
		=	identity

instance declareVars FunctionPattern where
	declareVars :: FunctionPattern !VarHeap -> Backender
	declareVars (FP_Algebraic _ freeVars optionalVar) varHeap
		=	declareVars freeVars varHeap
		o`	declareVars optionalVar varHeap
	declareVars (FP_Variable freeVar) varHeap
		=	declareVars freeVar varHeap
	declareVars (FP_Basic _ optionalVar) varHeap
		=	declareVars optionalVar varHeap
	declareVars FP_Empty varHeap
		=	identity

instance declareVars Expression where
	declareVars :: Expression !VarHeap -> Backender
	declareVars (Let {let_strict_binds, let_lazy_binds, let_expr}) varHeap
		=	declareVars let_strict_binds varHeap
		o`	declareVars let_lazy_binds varHeap
		o`	declareVars let_expr varHeap
	declareVars (Conditional {if_then, if_else}) varHeap
		=	declareVars if_then varHeap
		o`	declareVars if_else varHeap
	declareVars (AnyCodeExpr _ outParams _) varHeap
		=	declareVars outParams varHeap
	declareVars _ _
		=	identity

instance declareVars TransformedBody where
	declareVars :: TransformedBody !VarHeap -> Backender
	declareVars {tb_args, tb_rhs} varHeap
		=	declareVars tb_args varHeap
		o`	declareVars tb_rhs varHeap

instance declareVars BackendBody where
	declareVars :: BackendBody !VarHeap -> Backender
	declareVars {bb_args, bb_rhs} varHeap
		=	declareVars bb_args varHeap
		o`	declareVars bb_rhs varHeap

:: ModuleIndex :== Index

class declare a :: ModuleIndex !VarHeap a  -> Backender
class declareWithIndex a :: Index ModuleIndex !VarHeap a -> Backender

instance declare {#a} | declareWithIndex a & ArrayElem a where
	declare :: ModuleIndex  VarHeap {#a} -> Backender | declareWithIndex a & ArrayElem a 
	declare moduleIndex varHeap array
		=	foldStateWithIndexA (\i -> declareWithIndex i moduleIndex varHeap) array

declareFunctionSymbols :: {#FunDef} {#Int} [(Int, Int)] *BackEnd -> *BackEnd
declareFunctionSymbols functions iclDclConversions functionIndices backEnd
	=	foldr (declare iclDclConversions) backEnd [(functionIndex, componentIndex, functions.[functionIndex]) \\ (componentIndex, functionIndex) <- functionIndices]
	where
		declare :: {#Int} (Int, Int, FunDef) *BackEnd -> *BackEnd
		declare iclDclConversions (functionIndex, componentIndex, function) backEnd
			=	BEDeclareFunction (function.fun_symb.id_name +++ ";" +++ toString iclDclConversions.[functionIndex]) function.fun_arity functionIndex componentIndex backEnd

// move to backendsupport
foldStateWithIndexRangeA function frm to array
	:== foldStateWithIndexRangeA frm
	where
		foldStateWithIndexRangeA index
			| index == to
				=	identity
			// otherwise
				=	function index array.[index]
				o`	foldStateWithIndexRangeA (index+1)

declareArrayInstances :: IndexRange {#FunDef} -> Backender
declareArrayInstances {ir_from, ir_to} functions
	=	foldStateWithIndexRangeA declareArrayInstance ir_from ir_to functions
	where
		declareArrayInstance :: Index FunDef -> Backender
		declareArrayInstance index {fun_symb={id_name}, fun_type=Yes type}
			=	beDeclareRuleType index cIclModIndex (id_name +++ ";" +++ toString index)
			o`	beDefineRuleType index cIclModIndex (convertTypeAlt index cIclModIndex type)

instance declare CommonDefs where
	declare :: ModuleIndex VarHeap CommonDefs -> Backender
	declare moduleIndex varHeap {com_cons_defs, com_type_defs, com_selector_defs, com_class_defs}
		=	declare moduleIndex varHeap com_type_defs
		o`	defineTypes moduleIndex com_cons_defs com_selector_defs com_type_defs varHeap

instance declareWithIndex TypeDef a where
	declareWithIndex :: Index ModuleIndex VarHeap (TypeDef a) -> Backender
	declareWithIndex typeIndex moduleIndex _ {td_name}
		=	BEDeclareType typeIndex moduleIndex td_name.id_name

declareFunTypes :: ModuleIndex {#FunType} VarHeap -> Backender
declareFunTypes moduleIndex funTypes varHeap
		=	foldStateWithIndexA (declareFunType moduleIndex varHeap) funTypes

declareFunType :: ModuleIndex VarHeap Index FunType -> Backender
declareFunType moduleIndex varHeap functionIndex {ft_symb, ft_type_ptr}
	=	case (sreadPtr ft_type_ptr varHeap) of
			VI_ExpandedType expandedType
				->	beDeclareRuleType functionIndex moduleIndex (ft_symb.id_name +++ ";" +++ toString functionIndex)
				o`	beDefineRuleType functionIndex moduleIndex (convertTypeAlt functionIndex moduleIndex expandedType)
			_
				->	identity

currentModuleTypeConversions :: {#ClassDef} {#ClassDef} (Optional ConversionTable) -> {#Int}
currentModuleTypeConversions iclClasses dclClasses (Yes conversionTable)
	// revert ...
	// | True
	//	=	{i \\ i <- [0 .. nDclTypes + nDclClasses - 1]}
	// ... revert
	// sanity check ...
	| sort [dclClass.class_dictionary.ds_index \\ dclClass <-: dclClasses]
				<> [size typeConversions .. size typeConversions + size dclClasses - 1]
		=	abort "backendconvert, currentModuleTypeConversions wrong index range for dcl dictionary types"
	// ... sanity check
	| nDclClasses == 0
		=	typeConversions
	// otherwise
		=	{createArray (nDclTypes + nDclClasses) NoIndex
				& [i] = typeConversion
					\\ typeConversion <-: typeConversions & i <- [0..]}
			:-  foldStateWithIndexA (updateDictionaryTypeIndex classConversions) classConversions
	where
		typeConversions
			=	conversionTable.[cTypeDefs]
		nDclTypes
			=	size typeConversions
		classConversions
			=	conversionTable.[cClassDefs]
		nDclClasses
			=	size classConversions

		updateDictionaryTypeIndex :: {#Int} Int Int *{#Int} -> *{#Int}
		updateDictionaryTypeIndex classConversions dclClassIndex iclClassIndex allTypeConversions
			// sanity check ...
			# (oldIndex, allTypeConversions)
				=	uselect allTypeConversions dclTypeIndex
			| oldIndex <> NoIndex
				=	abort "backendconvert, updateDictionaryTypeIndex wrong index overwritten"
			// ... sanity chechk
			=	{allTypeConversions & [dclTypeIndex] = iclTypeIndex}
			where
				dclTypeIndex
					=	dclClasses.[dclClassIndex].class_dictionary.ds_index
				iclClassIndex
					=	classConversions.[dclClassIndex]
				iclTypeIndex
					=	iclClasses.[iclClassIndex].class_dictionary.ds_index
currentModuleTypeConversions _ _ No
	=	{}

declareCurrentDclModuleTypes :: {#CheckedTypeDef} {#Int} VarHeap -> Backender
declareCurrentDclModuleTypes dclTypes typeConversions varHeap
	=	foldStateWithIndexA (declareConvertedType dclTypes varHeap) typeConversions
	where
		declareConvertedType :: {#CheckedTypeDef} VarHeap Index Index -> Backender
		declareConvertedType dclTypes varHeap dclIndex iclIndex
			=	declareWithIndex iclIndex cIclModIndex varHeap dclTypes.[dclIndex]

defineCurrentDclModuleTypes :: {#ConsDef} {#SelectorDef} {#CheckedTypeDef} {#Int} VarHeap -> Backender
defineCurrentDclModuleTypes dclConstructors dclSelectors dclTypes typeConversions varHeap
	=	foldStateWithIndexA (defineConvertedType dclTypes varHeap) typeConversions
	where
		defineConvertedType :: {#CheckedTypeDef} VarHeap Index Index -> Backender
		defineConvertedType dclTypes varHeap dclIndex iclIndex
			=	defineType cIclModIndex dclConstructors dclSelectors varHeap iclIndex dclTypes.[dclIndex]

defineTypes :: ModuleIndex {#ConsDef} {#SelectorDef} {#CheckedTypeDef} VarHeap -> Backender
defineTypes moduleIndex constructors selectors types varHeap
	=	foldStateWithIndexA (defineType moduleIndex constructors selectors varHeap) types

convertTypeLhs :: ModuleIndex Index  [ATypeVar] -> BEMonad BEFlatTypeP
convertTypeLhs moduleIndex typeIndex args
	=	beFlatType (beTypeSymbol typeIndex moduleIndex) (convertTypeVars args)

convertTypeVars :: [ATypeVar] -> BEMonad BETypeVarListP
convertTypeVars typeVars
	=	foldr (beTypeVars o convertTypeVar) beNoTypeVars typeVars

convertTypeVar :: ATypeVar -> BEMonad BETypeVarP
convertTypeVar typeVar
	=	beTypeVar typeVar.atv_variable.tv_name.id_name

defineType :: ModuleIndex {#ConsDef} {#SelectorDef} VarHeap Index CheckedTypeDef *BackEnd -> *BackEnd
defineType moduleIndex constructors _ varHeap typeIndex {td_args, td_rhs=AlgType constructorSymbols} be
	# (flatType, be)
		=	convertTypeLhs moduleIndex typeIndex td_args be
	# (constructors, be)
		=	convertConstructors moduleIndex constructors constructorSymbols varHeap be
	# (_, be)
		=	BEAlgebraicType flatType constructors be
	=	be 
defineType moduleIndex constructors selectors varHeap typeIndex {td_args, td_rhs=RecordType {rt_constructor, rt_fields}} be
	# (flatType, be)
		=	convertTypeLhs moduleIndex typeIndex td_args be
	# (fields, be)
		=	convertSelectors moduleIndex selectors rt_fields varHeap be
	# (constructorTypeNode, be)
		=	beNormalTypeNode
				(beConstructorSymbol moduleIndex constructorIndex)
				(convertSymbolTypeArgs constructorType)
				be
	# (_, be)
		=	BERecordType moduleIndex flatType constructorTypeNode fields be
	=	be
	where
		constructorIndex
			=	rt_constructor.ds_index
		constructorDef
			=	constructors.[constructorIndex]
		constructorType
			=	case (sreadPtr constructorDef.cons_type_ptr varHeap) of
					VI_ExpandedType expandedType
						->	expandedType
					_
						->	constructorDef.cons_type

defineType _ _ _ _ _ _ be
	=	be

convertConstructors :: ModuleIndex {#ConsDef} [DefinedSymbol] VarHeap -> BEMonad BEConstructorListP
convertConstructors moduleIndex constructors symbols varHeap
	=	foldr (beConstructors o convertConstructor moduleIndex constructors varHeap) beNoConstructors symbols

convertConstructor :: ModuleIndex {#ConsDef} VarHeap DefinedSymbol -> BEMonad BEConstructorListP
convertConstructor moduleIndex constructorDefs varHeap {ds_index}
	=	BEDeclareConstructor ds_index moduleIndex constructorDef.cons_symb.id_name // +++ remove declare
	o`	beConstructor
			(beNormalTypeNode
				(beConstructorSymbol moduleIndex ds_index)
				(convertSymbolTypeArgs constructorType)) 
	where
		constructorDef
			=	constructorDefs.[ds_index]
		constructorType
			=	case (sreadPtr constructorDef.cons_type_ptr varHeap) of
					VI_ExpandedType expandedType
						->	expandedType
					_
						->	constructorDef.cons_type

convertSelectors :: ModuleIndex {#SelectorDef} {#FieldSymbol} VarHeap -> BEMonad BEFieldListP
convertSelectors moduleIndex selectors symbols varHeap
	=	foldrA (beFields o convertSelector moduleIndex selectors varHeap) beNoFields symbols

convertSelector :: ModuleIndex {#SelectorDef} VarHeap FieldSymbol -> BEMonad BEFieldListP
convertSelector moduleIndex selectorDefs varHeap {fs_index}
	=	BEDeclareField fs_index moduleIndex selectorDef.sd_symb.id_name
	o`	beField fs_index moduleIndex (convertAnnotTypeNode (selectorType.st_result))
	where
		selectorDef
			=	selectorDefs.[fs_index]
		selectorType
			=	case (sreadPtr selectorDef.sd_type_ptr varHeap) of
					VI_ExpandedType expandedType
						->	expandedType
					_
						->	selectorDef.sd_type

predefineSymbols :: DclModule PredefinedSymbols -> Backender
predefineSymbols {dcl_common} predefs
	=	BEDeclarePredefinedModule (size dcl_common.com_type_defs) (size dcl_common.com_cons_defs)
	o`	foldState predefineType types
	o`	foldState predefineConstructor constructors
	where
		predefineType (index, arity, symbolKind)
			// sanity check ...
			| predefs.[index].pds_def == NoIndex
				=	abort "backendconvert, predefineSymbols predef is not a type"
			// ... sanity check
			=	BEPredefineTypeSymbol arity predefs.[index].pds_def cPredefinedModuleIndex symbolKind

		predefineConstructor (index, arity, symbolKind)
			// sanity check ...
			| predefs.[index].pds_def == NoIndex
				=	abort "backendconvert, predefineSymbols predef is not a constructor"
			// ... sanity check
			=	BEPredefineConstructorSymbol arity predefs.[index].pds_def cPredefinedModuleIndex symbolKind

		types :: [(Int, Int, BESymbKind)]
		types
			=	[	(PD_ListType, 1, BEListType)
				,	(PD_LazyArrayType, 1, BEArrayType)
				,	(PD_StrictArrayType, 1, BEStrictArrayType)
				,	(PD_UnboxedArrayType, 1, BEUnboxedArrayType)
				:	[(index, index-PD_Arity2TupleType+2, BETupleType) \\ index <- [PD_Arity2TupleType..PD_Arity32TupleType]]
				]

		constructors :: [(Int, Int, BESymbKind)]
		constructors
			=	[	(PD_NilSymbol, 0, BENilSymb)
				,	(PD_ConsSymbol, 2, BEConsSymb)
				:	[(index, index-PD_Arity2TupleSymbol+2, BETupleSymb) \\ index <- [PD_Arity2TupleSymbol..PD_Arity32TupleSymbol]]
				]

:: AdjustStdArrayInfo =
	{	asai_moduleIndex	:: !Int
	,	asai_mapping 		:: !{#BEArrayFunKind}
	,	asai_funs			:: !{#FunType}
	,	asai_varHeap	 	:: !VarHeap
	}

adjustArrayFunctions :: PredefinedSymbols IndexRange {#FunDef} {#DclModule} VarHeap -> Backender
adjustArrayFunctions predefs arrayInstancesRange functions dcls varHeap
	=	adjustStdArray arrayInfo predefs stdArray.dcl_common.com_instance_defs
	o`	adjustIclArrayInstances arrayInstancesRange arrayMemberMapping functions
	where
		arrayModuleIndex
			=	predefs.[PD_StdArray].pds_def
		arrayClassIndex
			=	predefs.[PD_ArrayClass].pds_def
		arrayClass
			=	stdArray.dcl_common.com_class_defs.[arrayClassIndex]
		stdArray
			=	dcls.[arrayModuleIndex]
		arrayMemberMapping
			=	getArrayMemberMapping predefs arrayClass.class_members
		arrayInfo
			=	{	asai_moduleIndex	= arrayModuleIndex
				,	asai_mapping 		= arrayMemberMapping
				,	asai_funs			= stdArray.dcl_functions
				,	asai_varHeap		= varHeap
				}

		getArrayMemberMapping :: PredefinedSymbols {#DefinedSymbol} -> {#BEArrayFunKind}
		getArrayMemberMapping predefs members
			// sanity check ...
			| size members <> length (memberIndexMapping predefs)
				=	abort "backendconvert, arrayMemberMapping: incorrect number of members"
			// ... sanity check
			=	{	createArray (size members) BENoArrayFun
				&	[i] = backEndFunKind member.ds_index (memberIndexMapping predefs) \\ member <-: members & i <- [0..]
				}				
			where
				memberIndexMapping :: PredefinedSymbols -> [(!Index, !BEArrayFunKind)]
				memberIndexMapping predefs
					=	[(predefs.[predefIndex].pds_def, backEndArrayFunKind) \\ (predefIndex, backEndArrayFunKind) <- predefMapping]
					where
						predefMapping 
							=	[	(PD_CreateArrayFun,		BECreateArrayFun)
								,	(PD_ArraySelectFun,		BEArraySelectFun)
								,	(PD_UnqArraySelectFun,	BEUnqArraySelectFun)
								,	(PD_ArrayUpdateFun,		BEArrayUpdateFun)
								,	(PD_ArrayReplaceFun,	BEArrayReplaceFun)
								,	(PD_ArraySizeFun,		BEArraySizeFun)
								,	(PD_UnqArraySizeFun,	BEUnqArraySizeFun)
								,	(PD__CreateArrayFun,	BE_CreateArrayFun)
								]

				backEndFunKind :: Index [(!Index, !BEArrayFunKind)] -> BEArrayFunKind
				backEndFunKind memberIndex predefMapping
					=	hd [back \\ (predefMemberIndex, back) <- predefMapping | predefMemberIndex == memberIndex]

		adjustStdArray :: AdjustStdArrayInfo PredefinedSymbols {#ClassInstance} -> Backender
		adjustStdArray arrayInfo predefs instances
			| arrayModuleIndex == NoIndex
				=	identity
			// otherwise
				=	foldStateA (adjustStdArrayInstance arrayClassIndex arrayInfo) instances
			where
				adjustStdArrayInstance :: Index AdjustStdArrayInfo ClassInstance -> Backender
				adjustStdArrayInstance arrayClassIndex arrayInfo=:{asai_moduleIndex} instance`=:{ins_class}
					| ins_class.glob_object.ds_index == arrayClassIndex && ins_class.glob_module == asai_moduleIndex
						=	adjustArrayClassInstance arrayInfo instance`
					// otherwise
						=	identity
					where
						adjustArrayClassInstance :: AdjustStdArrayInfo ClassInstance -> Backender
						adjustArrayClassInstance arrayInfo {ins_members}
							=	foldStateWithIndexA (adjustMember arrayInfo) ins_members
						where
							adjustMember :: AdjustStdArrayInfo Int DefinedSymbol -> Backender
							adjustMember {asai_moduleIndex, asai_mapping, asai_funs, asai_varHeap} offset {ds_index}
								=	case (sreadPtr asai_funs.[ds_index].ft_type_ptr asai_varHeap) of
										VI_ExpandedType _
											->	beAdjustArrayFunction asai_mapping.[offset] ds_index asai_moduleIndex
										_
											->	identity

		adjustIclArrayInstances :: IndexRange {#BEArrayFunKind} {#FunDef} -> Backender
		adjustIclArrayInstances  {ir_from, ir_to} mapping instances
			=	foldStateWithIndexRangeA (adjustIclArrayInstance mapping) ir_from ir_to instances
			where
				adjustIclArrayInstance :: {#BEArrayFunKind} Index FunDef -> Backender
				// for array functions fun_index is not the index in the FunDef array,
				// but its member index in the Array class
				adjustIclArrayInstance mapping index {fun_index}
					=	beAdjustArrayFunction mapping.[fun_index] index cIclModIndex

convertRules :: [(Int, FunDef)] VarHeap -> BEMonad BEImpRuleP
convertRules rules varHeap
	=	foldr (beRules o flip convertRule varHeap) beNoRules rules

convertRule :: (Int,FunDef) VarHeap -> BEMonad BEImpRuleP
convertRule (index, {fun_type=Yes type, fun_body=body, fun_pos, fun_kind}) varHeap
	=	beRule index (cafness fun_kind) (convertTypeAlt index cIclModIndex type) (convertFunctionBody index (positionToLineNumber fun_pos) body varHeap)
	where
		cafness :: FunKind -> Int
		cafness (FK_Function _)
			=	BEIsNotACaf
		cafness FK_Macro
			=	BEIsNotACaf
		cafness FK_Caf
			=	BEIsACaf
		cafness funKind
			=	BEIsNotACaf <<- ("backendconvert, cafness: unknown fun kind", funKind)

		positionToLineNumber :: Position -> Int
		positionToLineNumber (FunPos  _ lineNumber _)
			=	lineNumber
		positionToLineNumber (LinePos _ lineNumber)
			=	lineNumber
		positionToLineNumber _
			=	-1

convertFunctionBody :: Int Int FunctionBody VarHeap -> BEMonad BERuleAltP
convertFunctionBody functionIndex lineNumber (BackendBody bodies) varHeap
	=	convertBackendBodies functionIndex lineNumber bodies varHeap

convertTypeAlt :: Int ModuleIndex SymbolType -> BEMonad BETypeAltP
convertTypeAlt functionIndex moduleIndex symbol=:{st_result}
	=	beTypeAlt (beNormalTypeNode (beFunctionSymbol functionIndex moduleIndex) (convertSymbolTypeArgs symbol)) (convertAnnotTypeNode st_result)

convertSymbolTypeArgs :: SymbolType -> BEMonad BETypeArgP
convertSymbolTypeArgs {st_args}
	=	convertTypeArgs st_args

convertBasicTypeKind :: BasicType -> BESymbKind
convertBasicTypeKind BT_Int
	=	BEIntType
convertBasicTypeKind BT_Char
	=	BECharType
convertBasicTypeKind BT_Real
	=	BERealType
convertBasicTypeKind BT_Bool
	=	BEBoolType
convertBasicTypeKind BT_File
	=	BEFileType
convertBasicTypeKind BT_World
	=	BEWorldType
convertBasicTypeKind BT_Dynamic
	=	BEDynamicType
convertBasicTypeKind (BT_String _)
	=	undef <<- "convertBasicTypeKind (BT_String _) shouldn't occur"

convertAnnotation :: Annotation -> BEAnnotation
convertAnnotation AN_None
	=	BENoAnnot
convertAnnotation AN_Strict
	=	BEStrictAnnot

convertAttribution :: TypeAttribute -> BEAttribution
convertAttribution TA_Unique
	=	BEUniqueAttr
convertAttribution _ // +++ uni vars, etc.
	=	BENoUniAttr

convertAnnotTypeNode :: AType -> BEMonad BETypeNodeP
convertAnnotTypeNode {at_type, at_annotation, at_attribute}
	=	convertTypeNode at_type
	:-	beAnnotateTypeNode (convertAnnotation at_annotation)
	:-	beAttributeTypeNode (convertAttribution (at_attribute))

convertTypeNode :: Type -> BEMonad BETypeNodeP
convertTypeNode (TB (BT_String type))
	=	convertTypeNode type
convertTypeNode (TB basicType)
	=	beNormalTypeNode (beBasicSymbol (convertBasicTypeKind basicType)) beNoTypeArgs
convertTypeNode (TA typeSymbolIdent typeArgs)
	=	beNormalTypeNode (convertTypeSymbolIdent typeSymbolIdent) (convertTypeArgs typeArgs)
convertTypeNode (TV {tv_name})
	=	beVarTypeNode tv_name.id_name
convertTypeNode (TempQV n)
	=	beVarTypeNode ("_tqv" +++ toString n)
convertTypeNode (TempV n)
	=	beVarTypeNode ("_tv" +++ toString n)
convertTypeNode (a --> b)
	=	beNormalTypeNode (beBasicSymbol BEFunType) (convertTypeArgs [a, b])
convertTypeNode (a :@: b)
	=	beNormalTypeNode (beBasicSymbol BEApplySymb) (convertTypeArgs [{at_attribute=TA_Multi, at_annotation=AN_None, at_type = consVariableToType a} : b])
convertTypeNode TE
	=	beNormalTypeNode beDontCareDefinitionSymbol beNoTypeArgs
convertTypeNode typeNode
	=	undef <<- ("backendconvert, convertTypeNode: unknown type node", typeNode)

consVariableToType :: ConsVariable -> Type
consVariableToType (CV typeVar)
	=	TV typeVar
consVariableToType (TempCV varId)
	=	TempV varId
consVariableToType (TempQCV varId)
	=	TempQV varId

convertTypeArgs :: [AType] -> BEMonad BETypeArgP
convertTypeArgs args
	=	foldr (beTypeArgs o convertAnnotTypeNode) beNoTypeArgs args

convertBackendBodies :: Int Int [BackendBody] VarHeap -> BEMonad BERuleAltP
convertBackendBodies functionIndex lineNumber bodies varHeap
	=	foldr (beRuleAlts o (flip (convertBackendBody functionIndex lineNumber)) varHeap) beNoRuleAlts bodies

convertBackendBody :: Int Int BackendBody VarHeap -> BEMonad BERuleAltP
convertBackendBody functionIndex lineNumber body=:{bb_args, bb_rhs=ABCCodeExpr instructions inline} varHeap
	=	beNoNodeDefs ==> \noNodeDefs
	->	declareVars body varHeap
	o`	beCodeAlt
			lineNumber
			(convertLhsNodeDefs bb_args noNodeDefs varHeap)
			(convertBackendLhs functionIndex bb_args varHeap)
			(beAbcCodeBlock inline (convertStrings instructions))
convertBackendBody functionIndex lineNumber body=:{bb_args, bb_rhs=AnyCodeExpr inParams outParams instructions} varHeap
	=	beNoNodeDefs ==> \noNodeDefs
	->	declareVars body varHeap
	o`	beCodeAlt
			lineNumber
			(convertLhsNodeDefs bb_args noNodeDefs varHeap)
			(convertBackendLhs functionIndex bb_args varHeap)
			(beAnyCodeBlock (convertCodeParameters inParams varHeap) (convertCodeParameters outParams varHeap) (convertStrings instructions))
convertBackendBody functionIndex lineNumber body=:{bb_args, bb_rhs} varHeap
	=	beNoNodeDefs ==> \noNodeDefs
	->	declareVars body varHeap
	o`	beRuleAlt
			lineNumber
			(convertLhsNodeDefs bb_args noNodeDefs varHeap)
			(convertBackendLhs functionIndex bb_args varHeap)
			(convertRhsNodeDefs bb_rhs varHeap)
			(convertRhsStrictNodeIds bb_rhs varHeap)
			(convertRootExpr bb_rhs varHeap)

convertStrings :: [{#Char}] -> BEMonad BEStringListP
convertStrings strings
	=	foldr (beStrings o beString) beNoStrings strings

convertCodeParameters :: (CodeBinding a) VarHeap -> BEMonad BECodeParameterP | varInfoPtr a
convertCodeParameters codeParameters varHeap
	=	foldr (beCodeParameters o flip convertCodeParameter varHeap) beNoCodeParameters codeParameters

class varInfoPtr a :: a -> VarInfoPtr

instance varInfoPtr BoundVar where
	varInfoPtr boundVar
		=	boundVar.var_info_ptr

instance varInfoPtr FreeVar where
	varInfoPtr freeVar
		=	freeVar.fv_info_ptr

convertCodeParameter :: (Bind String a) VarHeap -> BEMonad BECodeParameterP | varInfoPtr a
convertCodeParameter {bind_src, bind_dst} varHeap
		=	beCodeParameter bind_src (convertVar (varInfoPtr bind_dst) varHeap)

convertTransformedLhs :: Int [FreeVar] VarHeap -> BEMonad BENodeP
convertTransformedLhs functionIndex freeVars varHeap
	=	beNormalNode (beFunctionSymbol functionIndex cIclModIndex) (convertLhsArgs freeVars varHeap)

convertBackendLhs :: Int [FunctionPattern] VarHeap -> BEMonad BENodeP
convertBackendLhs functionIndex patterns varHeap
	=	beNormalNode (beFunctionSymbol functionIndex cIclModIndex) (convertPatterns patterns varHeap)

convertPatterns :: [FunctionPattern] VarHeap -> BEMonad BEArgP
convertPatterns patterns varHeap
	=	foldr (beArgs o flip convertPattern varHeap) beNoArgs patterns

convertPattern :: FunctionPattern VarHeap -> BEMonad BENodeP
convertPattern (FP_Variable freeVar) varHeap
	=	convertFreeVarPattern freeVar varHeap
convertPattern (FP_Basic _ (Yes freeVar)) varHeap
	=	convertFreeVarPattern freeVar varHeap
convertPattern (FP_Basic value No) _
	=	beNormalNode (convertLiteralSymbol value) beNoArgs
convertPattern (FP_Algebraic _ freeVars (Yes freeVar)) varHeap
	=	convertFreeVarPattern freeVar varHeap
convertPattern (FP_Algebraic {glob_module, glob_object={ds_index}} subpatterns No) varHeap
	=	beNormalNode (beConstructorSymbol glob_module ds_index) (convertPatterns subpatterns varHeap)
convertPattern (FP_Dynamic _ _ _ (Yes freeVar)) varHeap
	=	convertFreeVarPattern freeVar varHeap
convertPattern FP_Empty varHeap
	=	beNodeIdNode beWildCardNodeId beNoArgs

convertFreeVarPattern :: FreeVar  VarHeap -> BEMonad BENodeP
convertFreeVarPattern freeVar varHeap
	=	beNodeIdNode (convertVar freeVar.fv_info_ptr varHeap) beNoArgs

convertLhsArgs :: [FreeVar] VarHeap -> BEMonad BEArgP
convertLhsArgs freeVars varHeap
	=	foldr (beArgs o (flip convertFreeVarPattern) varHeap) beNoArgs freeVars

convertVarPtr :: VarInfoPtr  VarHeap -> BEMonad BENodeP
convertVarPtr var varHeap
	=	beNodeIdNode (convertVar var varHeap) beNoArgs

convertVars :: [VarInfoPtr] VarHeap -> BEMonad BEArgP
convertVars vars varHeap
	=	foldr (beArgs o flip convertVarPtr varHeap) beNoArgs vars

convertRootExpr :: Expression VarHeap -> BEMonad BENodeP
convertRootExpr (Let {let_expr}) varHeap
	=	convertRootExpr let_expr varHeap
convertRootExpr (Conditional {if_cond=cond, if_then=then, if_else=Yes else}) varHeap
	=	convertConditional cond then else varHeap
	where
		convertConditional :: Expression Expression Expression VarHeap -> BEMonad BENodeP
		convertConditional cond then else varHeap
			=	beGuardNode
					(convertExpr cond varHeap)
					(convertRhsNodeDefs then varHeap)
					(convertRhsStrictNodeIds then varHeap)
					(convertRootExpr then varHeap)
					(convertRhsNodeDefs else varHeap)
					(convertRhsStrictNodeIds else varHeap)
					(convertRootExpr else varHeap)
convertRootExpr (Conditional {if_cond=cond, if_then=then, if_else=No}) varHeap
		=	beGuardNode
				(convertExpr cond varHeap)
				(convertRhsNodeDefs then varHeap)
				(convertRhsStrictNodeIds then varHeap)
				(convertRootExpr then varHeap)
				beNoNodeDefs
				beNoStrictNodeIds
				(beNormalNode (beBasicSymbol BEFailSymb) beNoArgs)
convertRootExpr expr varHeap
	=	convertExpr expr varHeap

// RWS +++ rewrite
convertLhsNodeDefs :: [FunctionPattern] BENodeDefP VarHeap -> BEMonad BENodeDefP
convertLhsNodeDefs [FP_Basic value (Yes freeVar) : patterns] nodeDefs varHeap
	=	convertLhsNodeDefs patterns nodeDefs varHeap ==> \nodeDefs
	->	defineLhsNodeDef freeVar (FP_Basic value No) nodeDefs varHeap
convertLhsNodeDefs [FP_Algebraic symbol subpatterns (Yes freeVar) : patterns] nodeDefs varHeap
	=	convertLhsNodeDefs subpatterns nodeDefs varHeap ==> \nodeDefs
	->	convertLhsNodeDefs patterns nodeDefs varHeap ==> \nodeDefs
	->	defineLhsNodeDef freeVar (FP_Algebraic symbol subpatterns No) nodeDefs varHeap
convertLhsNodeDefs [FP_Algebraic symbol subpatterns No : patterns] nodeDefs varHeap
	=	convertLhsNodeDefs subpatterns nodeDefs varHeap ==> \nodeDefs
	->	convertLhsNodeDefs patterns nodeDefs varHeap
convertLhsNodeDefs [FP_Dynamic varPtrs var typeCode (Yes freeVar) : patterns] nodeDefs varHeap
	=	convertLhsNodeDefs patterns nodeDefs varHeap ==> \nodeDefs
	->	defineLhsNodeDef freeVar (FP_Dynamic varPtrs var typeCode No) nodeDefs varHeap
convertLhsNodeDefs [_ : patterns] nodeDefs varHeap
	=	convertLhsNodeDefs patterns nodeDefs varHeap
convertLhsNodeDefs [] nodeDefs varHeap
	=	return nodeDefs

defineLhsNodeDef :: FreeVar FunctionPattern BENodeDefP VarHeap -> BEMonad BENodeDefP
defineLhsNodeDef freeVar pattern nodeDefs varHeap
	=	beNodeDefs
			(beNodeDef (getVariableSequenceNumber freeVar.fv_info_ptr varHeap) (convertPattern pattern varHeap))
			(return nodeDefs)

collectNodeDefs :: Expression -> [Bind Expression FreeVar]
collectNodeDefs (Let {let_strict_binds, let_lazy_binds})
	=	let_strict_binds ++ let_lazy_binds
collectNodeDefs _
	=	[]

convertRhsNodeDefs :: Expression VarHeap -> BEMonad BENodeDefP
convertRhsNodeDefs expr varHeap
	=	convertNodeDefs (collectNodeDefs expr) varHeap

convertNodeDef :: !(Bind Expression FreeVar) VarHeap -> BEMonad BENodeDefP
convertNodeDef {bind_src=expr, bind_dst=freeVar} varHeap
	=	beNodeDef (getVariableSequenceNumber freeVar.fv_info_ptr varHeap) (convertExpr expr varHeap)

convertNodeDefs :: [Bind Expression FreeVar] VarHeap -> BEMonad BENodeDefP
convertNodeDefs binds varHeap
	=	foldr (beNodeDefs o flip convertNodeDef varHeap) beNoNodeDefs binds

collectStrictNodeIds :: Expression -> [FreeVar]
collectStrictNodeIds (Let {let_strict_binds, let_expr})
	=	[bind_dst \\ {bind_dst} <- let_strict_binds]
collectStrictNodeIds _
	=	[]

convertStrictNodeId :: FreeVar VarHeap -> BEMonad BEStrictNodeIdP
convertStrictNodeId freeVar varHeap
	=	beStrictNodeId (convertVar freeVar.fv_info_ptr varHeap)

convertStrictNodeIds :: [FreeVar] VarHeap -> BEMonad BEStrictNodeIdP
convertStrictNodeIds freeVars varHeap
	=	foldr (beStrictNodeIds o flip convertStrictNodeId varHeap) beNoStrictNodeIds freeVars

convertRhsStrictNodeIds :: Expression VarHeap -> BEMonad BEStrictNodeIdP
convertRhsStrictNodeIds expression varHeap
	=	convertStrictNodeIds (collectStrictNodeIds expression) varHeap

convertLiteralSymbol :: BasicValue -> BEMonad BESymbolP
convertLiteralSymbol (BVI string)
	=	beLiteralSymbol BEIntDenot string
convertLiteralSymbol (BVB bool)
	=	beBoolSymbol bool
convertLiteralSymbol (BVC string)
	=	beLiteralSymbol BECharDenot string
convertLiteralSymbol (BVR string)
	=	beLiteralSymbol BERealDenot string
convertLiteralSymbol (BVS string)
	=	beLiteralSymbol BEStringDenot string

convertArgs :: [Expression] VarHeap -> BEMonad BEArgP
convertArgs exprs varHeap
	=	foldr (beArgs o flip convertExpr varHeap) beNoArgs exprs

convertSymbol :: !SymbIdent -> BEMonad BESymbolP
convertSymbol {symb_kind=SK_Function {glob_module, glob_object}}
	=	beFunctionSymbol glob_object glob_module
convertSymbol {symb_kind=SK_GeneratedFunction _ index}
	=	beFunctionSymbol index cIclModIndex
convertSymbol {symb_kind=SK_Constructor {glob_module, glob_object}}
	=	beConstructorSymbol glob_module glob_object
convertSymbol symbol
	=	undef <<- ("backendconvert, convertSymbol: unknown symbol", symbol)

convertTypeSymbolIdent :: TypeSymbIdent -> BEMonad BESymbolP
convertTypeSymbolIdent {type_index={glob_module, glob_object}}
	=	beTypeSymbol glob_object glob_module

convertExpr :: Expression VarHeap -> BEMonad BENodeP
convertExpr  (BasicExpr value _) varHeap
	=	beNormalNode (convertLiteralSymbol value) beNoArgs
convertExpr  (App {app_symb, app_args}) varHeap
	=	beNormalNode (convertSymbol app_symb) (convertArgs app_args varHeap)
convertExpr (Var var) varHeap
	=	beNodeIdNode (convertVar var.var_info_ptr varHeap) beNoArgs
convertExpr (f @ [a]) varHeap
	=	beNormalNode (beBasicSymbol BEApplySymb) (convertArgs [f, a] varHeap)
convertExpr (f @ [a:as]) varHeap
	=	convertExpr (f @ [a] @ as) varHeap
convertExpr (Selection isUnique expression selections) varHeap
	=	convertSelections (convertExpr expression varHeap) varHeap (addKinds isUnique selections)
	where
		addKinds No selections
			=	[(BESelector, selection) \\ selection <- selections]
		addKinds _ [selection]
			=	[(BESelector_U, selection)]
		addKinds _ [selection : selections]
			=	[(BESelector_F, selection) : addMoreKinds selections]
			where
				addMoreKinds []
					=	[]
				addMoreKinds [selection]
					=	[(BESelector_L, selection)]
				addMoreKinds [selection : selections]
					=	[(BESelector_N, selection) : addMoreKinds selections]
		addKinds _ []
			=	[]
convertExpr (RecordUpdate _ expr updates) varHeap
	=	foldl (convertUpdate varHeap) (convertExpr expr varHeap) updates
	where
		convertUpdate varHeap  expr {bind_src=EE}
			=	expr
		convertUpdate varHeap expr {bind_src, bind_dst=bind_dst=:{glob_module, glob_object={fs_index}}}
			=	beUpdateNode
					(beArgs
						expr
						(beArgs
							(beSelectorNode BESelector (beFieldSymbol fs_index glob_module)
							(beArgs (convertExpr bind_src varHeap)
							beNoArgs))
						beNoArgs))
convertExpr (Update expr1 [singleSelection] expr2) varHeap
	=	case singleSelection of
			RecordSelection _ _
				->	beUpdateNode (convertArgs [expr1, Selection No expr2 [singleSelection]] varHeap)
			ArraySelection {glob_object={ds_index}, glob_module} _ index
				->	beNormalNode
						(beSpecialArrayFunctionSymbol BEArrayUpdateFun ds_index glob_module)
						(convertArgs [expr1, index, expr2] varHeap)
			DictionarySelection dictionaryVar dictionarySelections _ index
				->	convertExpr (Selection No (Var dictionaryVar) dictionarySelections @ [expr1, index, expr2]) varHeap
convertExpr (Update expr1 selections expr2) varHeap
	=	case lastSelection of
			RecordSelection _ _
				->	beUpdateNode (beArgs selection (convertArgs [Selection No expr2 [lastSelection]] varHeap))
			ArraySelection {glob_object={ds_index}, glob_module} _ index
				->	beNormalNode (beSpecialArrayFunctionSymbol BE_ArrayUpdateFun ds_index glob_module) (beArgs selection (convertArgs [index, expr2] varHeap))
			DictionarySelection dictionaryVar dictionarySelections _ index
				->	beNormalNode beDictionaryUpdateFunSymbol
							(beArgs dictionary (beArgs selection (convertArgs [index, expr2] varHeap)))
					with
						dictionary
							=	convertExpr (Selection No (Var dictionaryVar) dictionarySelections) varHeap
	where
		lastSelection
			=	last selections
		selection
			=	convertSelections (convertExpr expr1 varHeap) varHeap (addKinds (init selections))
		addKinds [selection : selections]
			=	[(BESelector_F, selection) : addMoreKinds selections]
			where
				addMoreKinds selections
					=	[(BESelector_U, selection) \\ selection <- selections]
		addKinds []
			=	[]
convertExpr (TupleSelect {ds_arity} n expr) varHeap
	=	beTupleSelectNode ds_arity n (convertExpr expr varHeap)
convertExpr (MatchExpr optionalTuple {glob_module, glob_object={ds_index}} expr) varHeap
	=	beMatchNode (arity optionalTuple) (beConstructorSymbol glob_module ds_index) (convertExpr expr varHeap)
	where
		arity :: (Optional (Global DefinedSymbol)) -> Int
		arity No
			=	1
		arity (Yes {glob_object={ds_arity}})
			=	ds_arity
convertExpr (Conditional {if_cond=cond, if_then, if_else=Yes else}) varHeap
	=	beIfNode (convertExpr cond varHeap) (convertExpr if_then varHeap) (convertExpr else varHeap)
convertExpr  expr _
	=	undef <<- ("backendconvert, convertExpr: unknown expression", expr)


convertSelections :: (BEMonad BENodeP) VarHeap [(BESelectorKind, Selection)] -> (BEMonad BENodeP)
convertSelections expression varHeap selections
	=	foldl (convertSelection varHeap) expression selections

convertSelection :: VarHeap (BEMonad BENodeP) (BESelectorKind, Selection) -> (BEMonad BENodeP)
convertSelection varHeap expression (kind, RecordSelection {glob_object={ds_index}, glob_module} _)
	=	beSelectorNode kind (beFieldSymbol ds_index glob_module) (beArgs expression beNoArgs)
convertSelection varHeap expression (kind, ArraySelection {glob_object={ds_index}, glob_module} _ index)
	=	beNormalNode (beSpecialArrayFunctionSymbol (selectionKindToArrayFunKind kind) ds_index glob_module) (beArgs expression (convertArgs [index] varHeap))
convertSelection varHeap expression (kind, DictionarySelection dictionaryVar dictionarySelections _ index)
	=	case kind of
			BESelector
				->	beNormalNode (beBasicSymbol BEApplySymb)
							(beArgs
								(beNormalNode (beBasicSymbol BEApplySymb)
								(beArgs dictionary
									(beArgs expression beNoArgs)))
							(convertArgs [index] varHeap))
			_
				->	beNormalNode beDictionarySelectFunSymbol
							(beArgs dictionary (beArgs expression (convertArgs [index] varHeap)))
		where
			dictionary
				=	convertExpr (Selection No (Var dictionaryVar) dictionarySelections) varHeap

selectionKindToArrayFunKind BESelector
	=	BEArraySelectFun
selectionKindToArrayFunKind BESelector_U
	=	BE_UnqArraySelectFun
selectionKindToArrayFunKind BESelector_F
	=	BE_UnqArraySelectFun
selectionKindToArrayFunKind BESelector_L
	=	BE_UnqArraySelectLastFun
selectionKindToArrayFunKind BESelector_N
	=	BE_UnqArraySelectLastFun

convertVar :: VarInfoPtr VarHeap -> BEMonad BENodeIdP
convertVar varInfo varHeap
	=	beNodeId (getVariableSequenceNumber varInfo varHeap)

getVariableSequenceNumber :: VarInfoPtr VarHeap -> Int
getVariableSequenceNumber varInfoPtr varHeap
	# (VI_SequenceNumber sequenceNumber)
		=	sreadPtr varInfoPtr varHeap
	=	sequenceNumber

markExports :: DclModule {#ClassDef} {#CheckedTypeDef} (Optional {#Int}) -> Backender
markExports {dcl_conversions = Yes conversionTable} iclClasses iclTypes (Yes functionConversions)
	=	foldStateA beExportType conversionTable.[cTypeDefs]
	o	foldStateA beExportConstructor conversionTable.[cConstructorDefs]
	o	foldStateA beExportField conversionTable.[cSelectorDefs]
	o	foldStateA (exportDictionary iclClasses iclTypes) conversionTable.[cClassDefs]
	o	foldStateWithIndexA beExportFunction functionConversions
	where
		exportDictionary :: {#ClassDef} {#CheckedTypeDef} Index -> Backender
		exportDictionary iclClasses iclTypes classIndex
			=	beExportType typeIndex
			o	foldStateA exportDictionaryField rt_fields
			where
				typeIndex
					=	iclClasses.[classIndex].class_dictionary.ds_index
				{td_rhs = RecordType {rt_fields}}
					=	iclTypes.[typeIndex]

				exportDictionaryField :: FieldSymbol -> Backender
				exportDictionaryField {fs_index}
					=	beExportField fs_index
markExports _ _ _ _
	=	identity