+import StgSyn ( StgArg )
+import Type ( isUnLiftedType )
+import Name ( Name )
+import TyCon ( TyCon )
+import PrimOp ( PrimOp )
+import Util ( zipWithEqual, splitAtList )
+import ListSetOps ( assocMaybe )
+import PrimRep ( isFollowableRep )
+import Outputable
+import Panic ( panic, assertPanic )
+
+import List ( partition )
+
+-----------------------------------------------------------------------------
+-- Tail Calls
+
+cgTailCall :: Id -> [StgArg] -> Code
+
+-- Here's the code we generate for a tail call. (NB there may be no
+-- arguments, in which case this boils down to just entering a variable.)
+--
+-- * Put args in the top locations of the stack.
+-- * Adjust the stack ptr
+-- * Make R1 point to the function closure if necessary.
+-- * Perform the call.
+--
+-- Things to be careful about:
+--
+-- * Don't overwrite stack locations before you have finished with
+-- them (remember you need the function and the as-yet-unmoved
+-- arguments).
+-- * Preferably, generate no code to replace x by x on the stack (a
+-- common situation in tail-recursion).
+-- * Adjust the stack high water mark appropriately.
+--
+-- Treat unboxed locals exactly like literals (above) except use the addr
+-- mode for the local instead of (CLit lit) in the assignment.
+
+-- Case for unboxed returns first:
+cgTailCall fun []
+ | isUnLiftedType (idType fun)
+ = getCAddrMode fun `thenFC` \ amode ->
+ performPrimReturn (ppr fun) amode
+
+-- The general case (@fun@ is boxed):
+cgTailCall fun args
+ = getCAddrModeAndInfo fun `thenFC` \ (fun', fun_amode, lf_info) ->
+ getArgAmodes args `thenFC` \ arg_amodes ->
+ performTailCall fun' fun_amode lf_info arg_amodes AbsCNop
+
+
+-- -----------------------------------------------------------------------------
+-- The guts of a tail-call
+
+performTailCall
+ :: Id -- function
+ -> CAddrMode -- function amode
+ -> LambdaFormInfo
+ -> [CAddrMode]
+ -> AbstractC -- Pending simultaneous assignments
+ -- *** GUARANTEED to contain only stack assignments.
+ -> Code
+
+performTailCall fun fun_amode lf_info arg_amodes pending_assts =
+ nodeMustPointToIt lf_info `thenFC` \ node_points ->
+ let
+ -- assign to node if necessary
+ node_asst
+ | node_points = CAssign (CReg node) fun_amode
+ | otherwise = AbsCNop
+ in
+
+ getEndOfBlockInfo `thenFC` \ eob@(EndOfBlockInfo args_sp sequel) ->