Tabs -> Spaces + formatting fixes

2 files changed, 559 insertions, 596 deletions

diff --git a/compiler/codeGen/CgBindery.lhs b/compiler/codeGen/CgBindery.lhs
index 65f8a52981..198e192f5c 100644
--- a/compiler/codeGen/CgBindery.lhs
+++ b/compiler/codeGen/CgBindery.lhs
@@ -5,37 +5,31 @@
 \section[CgBindery]{Utility functions related to doing @CgBindings@}
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
 
 module CgBindery (
-	CgBindings, CgIdInfo,
-	StableLoc, VolatileLoc,
+        CgBindings, CgIdInfo,
+        StableLoc, VolatileLoc,
 
-	cgIdInfoId, cgIdInfoArgRep, cgIdInfoLF,
+        cgIdInfoId, cgIdInfoArgRep, cgIdInfoLF,
 
-	stableIdInfo, heapIdInfo,
+        stableIdInfo, heapIdInfo,
         taggedStableIdInfo, taggedHeapIdInfo,
-	letNoEscapeIdInfo, idInfoToAmode,
+        letNoEscapeIdInfo, idInfoToAmode,
 
-	addBindC, addBindsC,
+        addBindC, addBindsC,
 
-	nukeVolatileBinds,
-	nukeDeadBindings,
-	getLiveStackSlots,
+        nukeVolatileBinds,
+        nukeDeadBindings,
+        getLiveStackSlots,
         getLiveStackBindings,
 
-	bindArgsToStack,  rebindToStack,
-	bindNewToNode, bindNewToUntagNode, bindNewToReg, bindArgsToRegs,
-	bindNewToTemp,
-	getArgAmode, getArgAmodes, 
-	getCgIdInfo, 
-	getCAddrModeIfVolatile, getVolatileRegs,
-	maybeLetNoEscape, 
+        bindArgsToStack,  rebindToStack,
+        bindNewToNode, bindNewToUntagNode, bindNewToReg, bindArgsToRegs,
+        bindNewToTemp,
+        getArgAmode, getArgAmodes, 
+        getCgIdInfo, 
+        getCAddrModeIfVolatile, getVolatileRegs,
+        maybeLetNoEscape, 
     ) where
 
 import CgMonad
@@ -47,7 +41,7 @@ import ClosureInfo
 import Constants
 
 import OldCmm
-import PprCmm		( {- instance Outputable -} )
+import PprCmm           ( {- instance Outputable -} )
 import SMRep
 import Id
 import DataCon
@@ -64,40 +58,39 @@ import FastString
 
 \end{code}
 
-
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[Bindery-datatypes]{Data types}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 @(CgBinding a b)@ is a type of finite maps from a to b.
 
 The assumption used to be that @lookupCgBind@ must get exactly one
-match.  This is {\em completely wrong} in the case of compiling
-letrecs (where knot-tying is used).  An initial binding is fed in (and
+match. This is {\em completely wrong} in the case of compiling
+letrecs (where knot-tying is used). An initial binding is fed in (and
 never evaluated); eventually, a correct binding is put into the
-environment.  So there can be two bindings for a given name.
+environment. So there can be two bindings for a given name.
 
 \begin{code}
 type CgBindings = IdEnv CgIdInfo
 
 data CgIdInfo
-  = CgIdInfo	
-	{ cg_id :: Id	-- Id that this is the info for
-			-- Can differ from the Id at occurrence sites by 
-			-- virtue of being externalised, for splittable C
-	, cg_rep :: CgRep
-	, cg_vol :: VolatileLoc
-	, cg_stb :: StableLoc
-	, cg_lf  :: LambdaFormInfo 
+  = CgIdInfo    
+        { cg_id :: Id   -- Id that this is the info for
+                        -- Can differ from the Id at occurrence sites by 
+                        -- virtue of being externalised, for splittable C
+        , cg_rep :: CgRep
+        , cg_vol :: VolatileLoc
+        , cg_stb :: StableLoc
+        , cg_lf  :: LambdaFormInfo 
         , cg_tag :: {-# UNPACK #-} !Int  -- tag to be added in idInfoToAmode
          }
 
 mkCgIdInfo :: Id -> VolatileLoc -> StableLoc -> LambdaFormInfo -> CgIdInfo
 mkCgIdInfo id vol stb lf
   = CgIdInfo { cg_id = id, cg_vol = vol, cg_stb = stb, 
-	       cg_lf = lf, cg_rep = idCgRep id, cg_tag = tag }
+               cg_lf = lf, cg_rep = idCgRep id, cg_tag = tag }
   where
     tag
       | Just con <- isDataConWorkId_maybe id,
@@ -114,16 +107,16 @@ mkCgIdInfo id vol stb lf
 
 voidIdInfo :: Id -> CgIdInfo
 voidIdInfo id = CgIdInfo { cg_id = id, cg_vol = NoVolatileLoc
-			 , cg_stb = VoidLoc, cg_lf = mkLFArgument id
-			 , cg_rep = VoidArg, cg_tag = 0 }
-	-- Used just for VoidRep things
+                         , cg_stb = VoidLoc, cg_lf = mkLFArgument id
+                         , cg_rep = VoidArg, cg_tag = 0 }
+        -- Used just for VoidRep things
 
-data VolatileLoc	-- These locations die across a call
+data VolatileLoc        -- These locations die across a call
   = NoVolatileLoc
-  | RegLoc	CmmReg		   -- In one of the registers (global or local)
-  | VirHpLoc	VirtualHpOffset  -- Hp+offset (address of closure)
-  | VirNodeLoc	ByteOff            -- Cts of offset indirect from Node
-				   -- ie *(Node+offset).
+  | RegLoc      CmmReg             -- In one of the registers (global or local)
+  | VirHpLoc    VirtualHpOffset  -- Hp+offset (address of closure)
+  | VirNodeLoc  ByteOff            -- Cts of offset indirect from Node
+                                   -- ie *(Node+offset).
                                    -- NB. Byte offset, because we subtract R1's
                                    -- tag from the offset.
 
@@ -131,7 +124,7 @@ mkTaggedCgIdInfo :: Id -> VolatileLoc -> StableLoc -> LambdaFormInfo -> DataCon
                  -> CgIdInfo
 mkTaggedCgIdInfo id vol stb lf con
   = CgIdInfo { cg_id = id, cg_vol = vol, cg_stb = stb, 
-	       cg_lf = lf, cg_rep = idCgRep id, cg_tag = tagForCon con }
+               cg_lf = lf, cg_rep = idCgRep id, cg_tag = tagForCon con }
 \end{code}
 
 @StableLoc@ encodes where an Id can be found, used by
@@ -141,20 +134,18 @@ the @CgBindings@ environment in @CgBindery@.
 data StableLoc
   = NoStableLoc
 
-  | VirStkLoc	VirtualSpOffset		-- The thing is held in this
-					-- stack slot
+  | VirStkLoc   VirtualSpOffset         -- The thing is held in this
+                                        -- stack slot
 
-  | VirStkLNE	VirtualSpOffset		-- A let-no-escape thing; the
-					-- value is this stack pointer
-					-- (as opposed to the contents of the slot)
+  | VirStkLNE   VirtualSpOffset         -- A let-no-escape thing; the
+                                        -- value is this stack pointer
+                                        -- (as opposed to the contents of the slot)
 
-  | StableLoc	CmmExpr
-  | VoidLoc	-- Used only for VoidRep variables.  They never need to
-		-- be saved, so it makes sense to treat treat them as
-		-- having a stable location
-\end{code}
+  | StableLoc   CmmExpr
+  | VoidLoc     -- Used only for VoidRep variables.  They never need to
+                -- be saved, so it makes sense to treat treat them as
+                -- having a stable location
 
-\begin{code}
 instance PlatformOutputable CgIdInfo where
   pprPlatform platform (CgIdInfo id _ vol stb _ _)
     -- TODO, pretty pring the tag info
@@ -175,9 +166,9 @@ instance PlatformOutputable StableLoc where
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[Bindery-idInfo]{Manipulating IdInfo}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -191,7 +182,7 @@ letNoEscapeIdInfo :: Id -> VirtualSpOffset -> LambdaFormInfo -> CgIdInfo
 letNoEscapeIdInfo id sp lf_info = mkCgIdInfo id NoVolatileLoc (VirStkLNE sp) lf_info
 
 stackIdInfo :: Id -> VirtualSpOffset -> LambdaFormInfo -> CgIdInfo
-stackIdInfo id sp	lf_info = mkCgIdInfo id NoVolatileLoc (VirStkLoc sp) lf_info
+stackIdInfo id sp       lf_info = mkCgIdInfo id NoVolatileLoc (VirStkLoc sp) lf_info
 
 nodeIdInfo :: Id -> Int -> LambdaFormInfo -> CgIdInfo
 nodeIdInfo id offset    lf_info = mkCgIdInfo id (VirNodeLoc (wORD_SIZE*offset)) NoStableLoc lf_info
@@ -216,7 +207,7 @@ untagNodeIdInfo id offset    lf_info tag
 idInfoToAmode :: CgIdInfo -> FCode CmmExpr
 idInfoToAmode info
   = case cg_vol info of {
-      RegLoc reg 	-> returnFC (CmmReg reg) ;
+      RegLoc reg        -> returnFC (CmmReg reg) ;
       VirNodeLoc nd_off -> returnFC (CmmLoad (cmmOffsetB (CmmReg nodeReg) nd_off)
                                              mach_rep) ;
       VirHpLoc hp_off   -> do { off <- getHpRelOffset hp_off
@@ -226,14 +217,14 @@ idInfoToAmode info
     case cg_stb info of
       StableLoc amode  -> returnFC $! maybeTag amode
       VirStkLoc sp_off -> do { sp_rel <- getSpRelOffset sp_off
-			     ; return (CmmLoad sp_rel mach_rep) }
+                             ; return (CmmLoad sp_rel mach_rep) }
 
       VirStkLNE sp_off -> getSpRelOffset sp_off
 
       VoidLoc -> return $ pprPanic "idInfoToAmode: void" (ppr (cg_id info))
-		-- We return a 'bottom' amode, rather than panicing now
-		-- In this way getArgAmode returns a pair of (VoidArg, bottom)
-		-- and that's exactly what we want
+                -- We return a 'bottom' amode, rather than panicing now
+                -- In this way getArgAmode returns a pair of (VoidArg, bottom)
+                -- and that's exactly what we want
 
       NoStableLoc -> pprPanic "idInfoToAmode: no loc" (ppr (cg_id info))
     }
@@ -256,16 +247,16 @@ cgIdInfoArgRep = cg_rep
 
 maybeLetNoEscape :: CgIdInfo -> Maybe VirtualSpOffset
 maybeLetNoEscape (CgIdInfo { cg_stb = VirStkLNE sp_off }) = Just sp_off
-maybeLetNoEscape _       				  = Nothing
+maybeLetNoEscape _                                        = Nothing
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[CgMonad-bindery]{Monad things for fiddling with @CgBindings@}
-%*									*
+%*                                                                      *
 %************************************************************************
 
-.There are three basic routines, for adding (@addBindC@), modifying
+There are three basic routines, for adding (@addBindC@), modifying
 (@modifyBindC@) and looking up (@getCgIdInfo@) bindings.
 
 A @Id@ is bound to a @(VolatileLoc, StableLoc)@ triple.
@@ -274,72 +265,72 @@ The name should not already be bound. (nice ASSERT, eh?)
 \begin{code}
 addBindC :: Id -> CgIdInfo -> Code
 addBindC name stuff_to_bind = do
-	binds <- getBinds
-	setBinds $ extendVarEnv binds name stuff_to_bind
+        binds <- getBinds
+        setBinds $ extendVarEnv binds name stuff_to_bind
 
 addBindsC :: [(Id, CgIdInfo)] -> Code
 addBindsC new_bindings = do
-	binds <- getBinds
-	let new_binds = foldl (\ binds (name,info) -> extendVarEnv binds name info)
-			      binds
-			      new_bindings
-	setBinds new_binds
+        binds <- getBinds
+        let new_binds = foldl (\ binds (name,info) -> extendVarEnv binds name info)
+                              binds
+                              new_bindings
+        setBinds new_binds
 
 modifyBindC :: Id -> (CgIdInfo -> CgIdInfo) -> Code
 modifyBindC name mangle_fn = do
-	binds <- getBinds
-	setBinds $ modifyVarEnv mangle_fn binds name
+        binds <- getBinds
+        setBinds $ modifyVarEnv mangle_fn binds name
 
 getCgIdInfo :: Id -> FCode CgIdInfo
 getCgIdInfo id
-  = do	{ 	-- Try local bindings first
-	; local_binds  <- getBinds
-	; case lookupVarEnv local_binds id of {
-	    Just info -> return info ;
-	    Nothing   -> do
-
-	{ 	-- Try top-level bindings
-	  static_binds <- getStaticBinds
-	; case lookupVarEnv static_binds id of {
-	    Just info -> return info ;
-	    Nothing   ->
-
-		-- Should be imported; make up a CgIdInfo for it
-	let 
-	    name = idName id
-	in
-	if isExternalName name then do
-	    let ext_lbl = CmmLit (CmmLabel (mkClosureLabel name $ idCafInfo id))
-	    return (stableIdInfo id ext_lbl (mkLFImported id))
-	else
-	if isVoidArg (idCgRep id) then
-		-- Void things are never in the environment
-	    return (voidIdInfo id)
-	else
-	-- Bug	
-	cgLookupPanic id
-	}}}}
+  = do  {       -- Try local bindings first
+        ; local_binds  <- getBinds
+        ; case lookupVarEnv local_binds id of {
+            Just info -> return info ;
+            Nothing   -> do
+
+        {       -- Try top-level bindings
+          static_binds <- getStaticBinds
+        ; case lookupVarEnv static_binds id of {
+            Just info -> return info ;
+            Nothing   ->
+
+                -- Should be imported; make up a CgIdInfo for it
+        let 
+            name = idName id
+        in
+        if isExternalName name then do
+            let ext_lbl = CmmLit (CmmLabel (mkClosureLabel name $ idCafInfo id))
+            return (stableIdInfo id ext_lbl (mkLFImported id))
+        else
+        if isVoidArg (idCgRep id) then
+                -- Void things are never in the environment
+            return (voidIdInfo id)
+        else
+        -- Bug  
+        cgLookupPanic id
+        }}}}
     
-			
+                        
 cgLookupPanic :: Id -> FCode a
 cgLookupPanic id
-  = do	static_binds <- getStaticBinds
-	local_binds <- getBinds
+  = do  static_binds <- getStaticBinds
+        local_binds <- getBinds
 --      srt <- getSRTLabel
         pprPanic "cgLookupPanic (probably invalid Core; try -dcore-lint)"
-		(vcat [ppr id,
-		ptext (sLit "static binds for:"),
-		vcat [ ppr (cg_id info) | info <- varEnvElts static_binds ],
-		ptext (sLit "local binds for:"),
+                (vcat [ppr id,
+                ptext (sLit "static binds for:"),
+                vcat [ ppr (cg_id info) | info <- varEnvElts static_binds ],
+                ptext (sLit "local binds for:"),
                 vcat [ ppr (cg_id info) | info <- varEnvElts local_binds ]
 --              ptext (sLit "SRT label") <+> pprCLabel srt
-	      ])
+              ])
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[Bindery-nuke-volatile]{Nuking volatile bindings}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 We sometimes want to nuke all the volatile bindings; we must be sure
@@ -357,71 +348,68 @@ nukeVolatileBinds binds
 
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[lookup-interface]{Interface functions to looking up bindings}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
 getCAddrModeIfVolatile :: Id -> FCode (Maybe CmmExpr)
 getCAddrModeIfVolatile id
-  = do	{ info <- getCgIdInfo id
-	; case cg_stb info of
-		NoStableLoc -> do -- Aha!  So it is volatile!
-			amode <- idInfoToAmode info
-			return $ Just amode
-		_ -> return Nothing }
+  = do  { info <- getCgIdInfo id
+        ; case cg_stb info of
+                NoStableLoc -> do -- Aha!  So it is volatile!
+                        amode <- idInfoToAmode info
+                        return $ Just amode
+                _ -> return Nothing }
 \end{code}
 
 @getVolatileRegs@ gets a set of live variables, and returns a list of
-all registers on which these variables depend.  These are the regs
-which must be saved and restored across any C calls.  If a variable is
+all registers on which these variables depend. These are the regs
+which must be saved and restored across any C calls. If a variable is
 both in a volatile location (depending on a register) {\em and} a
 stable one (notably, on the stack), we modify the current bindings to
 forget the volatile one.
 
 \begin{code}
 getVolatileRegs :: StgLiveVars -> FCode [GlobalReg]
-
 getVolatileRegs vars = do
-  do 	{ stuff <- mapFCs snaffle_it (varSetElems vars)
-	; returnFC $ catMaybes stuff }
+  do    { stuff <- mapFCs snaffle_it (varSetElems vars)
+        ; returnFC $ catMaybes stuff }
   where
     snaffle_it var = do
-	{ info <- getCgIdInfo var 
-	; let
-		-- commoned-up code...
-	     consider_reg reg
-		=	-- We assume that all regs can die across C calls
-			-- We leave it to the save-macros to decide which
-			-- regs *really* need to be saved.
-		  case cg_stb info of
-			NoStableLoc     -> returnFC (Just reg) -- got one!
-			_ -> do
-				{ -- has both volatile & stable locations;
-				  -- force it to rely on the stable location
-				  modifyBindC var nuke_vol_bind 
-				; return Nothing }
-
-	; case cg_vol info of
-	    RegLoc (CmmGlobal reg) -> consider_reg reg
-	    VirNodeLoc _ 	   -> consider_reg node
-	    _         	 	   -> returnFC Nothing	-- Local registers
-	}
+        { info <- getCgIdInfo var 
+        ; let
+                -- commoned-up code...
+             consider_reg reg
+                =       -- We assume that all regs can die across C calls
+                        -- We leave it to the save-macros to decide which
+                        -- regs *really* need to be saved.
+                  case cg_stb info of
+                        NoStableLoc     -> returnFC (Just reg) -- got one!
+                        _ -> do
+                                { -- has both volatile & stable locations;
+                                  -- force it to rely on the stable location
+                                  modifyBindC var nuke_vol_bind 
+                                ; return Nothing }
+
+        ; case cg_vol info of
+            RegLoc (CmmGlobal reg) -> consider_reg reg
+            VirNodeLoc _           -> consider_reg node
+            _                      -> returnFC Nothing  -- Local registers
+        }
 
     nuke_vol_bind info = info { cg_vol = NoVolatileLoc }
-\end{code}
 
-\begin{code}
 getArgAmode :: StgArg -> FCode (CgRep, CmmExpr)
 getArgAmode (StgVarArg var) 
-  = do	{ info <- getCgIdInfo var
-	; amode <- idInfoToAmode info
-	; return (cgIdInfoArgRep info, amode ) }
+  = do  { info <- getCgIdInfo var
+        ; amode <- idInfoToAmode info
+        ; return (cgIdInfoArgRep info, amode ) }
 
 getArgAmode (StgLitArg lit) 
-  = do	{ cmm_lit <- cgLit lit
-	; return (typeCgRep (literalType lit), CmmLit cmm_lit) }
+  = do  { cmm_lit <- cgLit lit
+        ; return (typeCgRep (literalType lit), CmmLit cmm_lit) }
 
 getArgAmode (StgTypeArg _) = panic "getArgAmode: type arg"
 
@@ -429,15 +417,15 @@ getArgAmodes :: [StgArg] -> FCode [(CgRep, CmmExpr)]
 getArgAmodes [] = returnFC []
 getArgAmodes (atom:atoms)
   | isStgTypeArg atom = getArgAmodes atoms
-  | otherwise 	      = do { amode  <- getArgAmode  atom 
-	 		   ; amodes <- getArgAmodes atoms
-	 		   ; return ( amode : amodes ) }
+  | otherwise         = do { amode  <- getArgAmode  atom 
+                           ; amodes <- getArgAmodes atoms
+                           ; return ( amode : amodes ) }
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[binding-and-rebinding-interface]{Interface functions for binding and re-binding names}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -466,22 +454,20 @@ bindNewToUntagNode id offset lf_info tag
 -- temporary.
 bindNewToTemp :: Id -> FCode LocalReg
 bindNewToTemp id
-  = do	addBindC id (regIdInfo id (CmmLocal temp_reg) lf_info)
-	return temp_reg
+  = do  addBindC id (regIdInfo id (CmmLocal temp_reg) lf_info)
+        return temp_reg
   where
     uniq     = getUnique id
     temp_reg = LocalReg uniq (argMachRep (idCgRep id))
-    lf_info  = mkLFArgument id	-- Always used of things we
-				-- know nothing about
+    lf_info  = mkLFArgument id  -- Always used of things we
+                                -- know nothing about
 
 bindNewToReg :: Id -> CmmReg -> LambdaFormInfo -> Code
 bindNewToReg name reg lf_info
   = addBindC name info
   where
     info = mkCgIdInfo name (RegLoc reg) NoStableLoc lf_info
-\end{code}
 
-\begin{code}
 rebindToStack :: Id -> VirtualSpOffset -> Code
 rebindToStack name offset
   = modifyBindC name replace_stable_fn
@@ -490,19 +476,19 @@ rebindToStack name offset
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[CgMonad-deadslots]{Finding dead stack slots}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 nukeDeadBindings does the following:
 
-      -	Removes all bindings from the environment other than those
-	for variables in the argument to nukeDeadBindings.
-      -	Collects any stack slots so freed, and returns them to the  stack free
-	list.
-      -	Moves the virtual stack pointer to point to the topmost used
-	stack locations.
+      - Removes all bindings from the environment other than those
+        for variables in the argument to nukeDeadBindings.
+      - Collects any stack slots so freed, and returns them to the  stack free
+        list.
+      - Moves the virtual stack pointer to point to the topmost used
+        stack locations.
 
 You can have multi-word slots on the stack (where a Double# used to
 be, for instance); if dead, such a slot will be reported as *several*
@@ -512,60 +498,56 @@ Probably *naughty* to look inside monad...
 
 \begin{code}
 nukeDeadBindings :: StgLiveVars  -- All the *live* variables
-		 -> Code
+                 -> Code
 nukeDeadBindings live_vars = do
-	binds <- getBinds
-	let (dead_stk_slots, bs') =
-		dead_slots live_vars 
-			[] []
-			[ (cg_id b, b) | b <- varEnvElts binds ]
-	setBinds $ mkVarEnv bs'
-	freeStackSlots dead_stk_slots
+        binds <- getBinds
+        let (dead_stk_slots, bs') =
+                dead_slots live_vars 
+                        [] []
+                        [ (cg_id b, b) | b <- varEnvElts binds ]
+        setBinds $ mkVarEnv bs'
+        freeStackSlots dead_stk_slots
 \end{code}
 
 Several boring auxiliary functions to do the dirty work.
 
 \begin{code}
 dead_slots :: StgLiveVars
-	   -> [(Id,CgIdInfo)]
-	   -> [VirtualSpOffset]
-	   -> [(Id,CgIdInfo)]
-	   -> ([VirtualSpOffset], [(Id,CgIdInfo)])
+           -> [(Id,CgIdInfo)]
+           -> [VirtualSpOffset]
+           -> [(Id,CgIdInfo)]
+           -> ([VirtualSpOffset], [(Id,CgIdInfo)])
 
 -- dead_slots carries accumulating parameters for
---	filtered bindings, dead slots
+--      filtered bindings, dead slots
 dead_slots _ fbs ds []
   = (ds, reverse fbs) -- Finished; rm the dups, if any
 
 dead_slots live_vars fbs ds ((v,i):bs)
   | v `elementOfUniqSet` live_vars
     = dead_slots live_vars ((v,i):fbs) ds bs
-	  -- Live, so don't record it in dead slots
-	  -- Instead keep it in the filtered bindings
+          -- Live, so don't record it in dead slots
+          -- Instead keep it in the filtered bindings
 
   | otherwise
     = case cg_stb i of
-	VirStkLoc offset
-	 | size > 0
-	 -> dead_slots live_vars fbs ([offset-size+1 .. offset] ++ ds) bs
+        VirStkLoc offset
+         | size > 0
+         -> dead_slots live_vars fbs ([offset-size+1 .. offset] ++ ds) bs
 
-	_ -> dead_slots live_vars fbs ds bs
+        _ -> dead_slots live_vars fbs ds bs
   where
     size :: WordOff
     size = cgRepSizeW (cg_rep i)
-\end{code}
 
-\begin{code}
 getLiveStackSlots :: FCode [VirtualSpOffset]
 -- Return the offsets of slots in stack containig live pointers
 getLiveStackSlots 
-  = do 	{ binds <- getBinds
-	; return [off | CgIdInfo { cg_stb = VirStkLoc off, 
-				   cg_rep = rep } <- varEnvElts binds, 
-		        isFollowableArg rep] }
-\end{code}
+  = do  { binds <- getBinds
+        ; return [off | CgIdInfo { cg_stb = VirStkLoc off, 
+                                   cg_rep = rep } <- varEnvElts binds, 
+                        isFollowableArg rep] }
 
-\begin{code}
 getLiveStackBindings :: FCode [(VirtualSpOffset, CgIdInfo)]
 getLiveStackBindings
   = do { binds <- getBinds
@@ -575,3 +557,4 @@ getLiveStackBindings
                             cg_rep = rep} <- [bind],
                  isFollowableArg rep] }
 \end{code}
+
diff --git a/compiler/codeGen/CgMonad.lhs b/compiler/codeGen/CgMonad.lhs
index 6636e24ec1..490f9520f1 100644
--- a/compiler/codeGen/CgMonad.lhs
+++ b/compiler/codeGen/CgMonad.lhs
@@ -4,20 +4,19 @@
 %
 \section[CgMonad]{The code generation monad}
 
-See the beginning of the top-level @CodeGen@ module, to see how this
-monadic stuff fits into the Big Picture.
+See the beginning of the top-level @CodeGen@ module, to see how this monadic
+stuff fits into the Big Picture.
 
 \begin{code}
 
 {-# LANGUAGE BangPatterns #-}
 module CgMonad (
-        Code,
-        FCode,
+        Code, FCode,
 
         initC, thenC, thenFC, listCs, listFCs, mapCs, mapFCs,
-        returnFC, fixC, fixC_, checkedAbsC, 
+        returnFC, fixC, fixC_, checkedAbsC,
         stmtC, stmtsC, labelC, emitStmts, nopC, whenC, newLabelC,
-        newUnique, newUniqSupply, 
+        newUnique, newUniqSupply,
 
         CgStmts, emitCgStmts, forkCgStmts, cgStmtsToBlocks,
         getCgStmts', getCgStmts,
@@ -35,7 +34,7 @@ module CgMonad (
         setEndOfBlockInfo, getEndOfBlockInfo,
 
         setSRT, getSRT,
-        setSRTLabel, getSRTLabel, 
+        setSRTLabel, getSRTLabel,
         setTickyCtrLabel, getTickyCtrLabel,
 
         StackUsage(..), HeapUsage(..),
@@ -48,10 +47,11 @@ module CgMonad (
 
         Sequel(..),
 
-        -- ideally we wouldn't export these, but some other modules access internal state
-        getState, setState, getInfoDown, getDynFlags, getThisPackage, 
+        -- ideally we wouldn't export these, but some other modules access
+        -- internal state
+        getState, setState, getInfoDown, getDynFlags, getThisPackage,
 
-        -- more localised access to monad state 
+        -- more localised access to monad state
         getStkUsage, setStkUsage,
         getBinds, setBinds, getStaticBinds,
 
@@ -92,82 +92,86 @@ infixr 9 `thenFC`
 %*                                                                      *
 %************************************************************************
 
-This monadery has some information that it only passes {\em
-downwards}, as well as some ``state'' which is modified as we go
-along.
+This monadery has some information that it only passes {\em downwards}, as well
+as some ``state'' which is modified as we go along.
 
 \begin{code}
-data CgInfoDownwards    -- information only passed *downwards* by the monad
+
+-- | State only passed *downwards* by the monad
+data CgInfoDownwards
   = MkCgInfoDown {
-        cgd_dflags  :: DynFlags,
-        cgd_mod     :: Module,          -- Module being compiled
-        cgd_statics :: CgBindings,      -- [Id -> info] : static environment
-        cgd_srt_lbl :: CLabel,          -- label of the current SRT
-        cgd_srt     :: SRT,             -- the current SRT
-        cgd_ticky   :: CLabel,          -- current destination for ticky counts
-        cgd_eob     :: EndOfBlockInfo   -- Info for stuff to do at end of basic block:
+        cgd_dflags  :: DynFlags,      -- current flag settings
+        cgd_mod     :: Module,        -- Module being compiled
+        cgd_statics :: CgBindings,    -- [Id -> info] : static environment
+        cgd_srt_lbl :: CLabel,        -- label of the current SRT
+        cgd_srt     :: SRT,           -- the current SRT
+        cgd_ticky   :: CLabel,        -- current destination for ticky counts
+        cgd_eob     :: EndOfBlockInfo -- Info for stuff to do at end of basic block:
   }
 
+-- | Setup initial @CgInfoDownwards@ for the code gen
 initCgInfoDown :: DynFlags -> Module -> CgInfoDownwards
 initCgInfoDown dflags mod
-  = MkCgInfoDown {      cgd_dflags  = dflags,
-                        cgd_mod     = mod,
-                        cgd_statics = emptyVarEnv,
-                        cgd_srt_lbl = error "initC: srt_lbl",
-                        cgd_srt     = error "initC: srt",
-                        cgd_ticky   = mkTopTickyCtrLabel,
-                        cgd_eob     = initEobInfo }
+  = MkCgInfoDown { cgd_dflags  = dflags,
+                   cgd_mod     = mod,
+                   cgd_statics = emptyVarEnv,
+                   cgd_srt_lbl = error "initC: srt_lbl",
+                   cgd_srt     = error "initC: srt",
+                   cgd_ticky   = mkTopTickyCtrLabel,
+                   cgd_eob     = initEobInfo
+  }
 
+-- | State passed around and modified during code generation
 data CgState
   = MkCgState {
-     cgs_stmts :: OrdList CgStmt, -- Current proc
-     cgs_tops  :: OrdList CmmDecl,
-        -- Other procedures and data blocks in this compilation unit
-        -- Both the latter two are ordered only so that we can 
-        -- reduce forward references, when it's easy to do so
-     
-     cgs_binds :: CgBindings,     -- [Id -> info] : *local* bindings environment
-                                  -- Bindings for top-level things are given in
-                                  -- the info-down part
-     
+     cgs_stmts   :: OrdList CgStmt,
+         -- Current proc
+     cgs_tops    :: OrdList CmmDecl,
+         -- Other procedures and data blocks in this compilation unit
+         -- Both the latter two are ordered only so that we can
+         -- reduce forward references, when it's easy to do so
+
+     cgs_binds   :: CgBindings,
+         -- [Id -> info] : *local* bindings environment Bindings for
+         -- top-level things are given in the info-down part
+
      cgs_stk_usg :: StackUsage,
      cgs_hp_usg  :: HeapUsage,
-     
-     cgs_uniqs :: UniqSupply }
+     cgs_uniqs   :: UniqSupply
+  }
 
+-- | Setup initial @CgState@ for the code gen
 initCgState :: UniqSupply -> CgState
 initCgState uniqs
-  = MkCgState { cgs_stmts = nilOL, cgs_tops = nilOL,
-                cgs_binds = emptyVarEnv, 
-                cgs_stk_usg = initStkUsage, 
-                cgs_hp_usg = initHpUsage,
-                cgs_uniqs = uniqs }
-\end{code}
-
-@EndOfBlockInfo@ tells what to do at the end of this block of code or,
-if the expression is a @case@, what to do at the end of each
-alternative.
+  = MkCgState { cgs_stmts   = nilOL,
+                cgs_tops    = nilOL,
+                cgs_binds   = emptyVarEnv,
+                cgs_stk_usg = initStkUsage,
+                cgs_hp_usg  = initHpUsage,
+                cgs_uniqs   = uniqs
+  }
 
-\begin{code}
+-- | @EndOfBlockInfo@ tells what to do at the end of this block of code or, if
+-- the expression is a @case@, what to do at the end of each alternative.
 data EndOfBlockInfo
   = EndOfBlockInfo
-        VirtualSpOffset   -- Args Sp: trim the stack to this point at a
-                          -- return; push arguments starting just
-                          -- above this point on a tail call.
-                          
-                          -- This is therefore the stk ptr as seen
-                          -- by a case alternative.
+        VirtualSpOffset -- Args Sp: trim the stack to this point at a
+                        -- return; push arguments starting just
+                        -- above this point on a tail call.
+                        --
+                        -- This is therefore the stk ptr as seen
+                        -- by a case alternative.
         Sequel
 
+-- | Standard @EndOfBlockInfo@ where the continuation is on the stack
 initEobInfo :: EndOfBlockInfo
 initEobInfo = EndOfBlockInfo 0 OnStack
-\end{code}
 
-Any addressing modes inside @Sequel@ must be ``robust,'' in the sense
-that it must survive stack pointer adjustments at the end of the
-block.
-
-\begin{code}
+-- | @Sequel@ is a representation of the next continuation to jump to
+-- after the current function.
+--
+-- Any addressing modes inside @Sequel@ must be ``robust,'' in the sense
+-- that it must survive stack pointer adjustments at the end of the block.
 data Sequel
   = OnStack          -- Continuation is on the stack
 
@@ -178,9 +182,9 @@ data Sequel
           Id          -- The case binder, only used to see if it's dead
 
 type SemiTaggingStuff
-  = Maybe                   -- Maybe we don't have any semi-tagging stuff...
-     ([(ConTagZ, CmmLit)],  -- Alternatives
-      CmmLit)               -- Default (will be a can't happen RTS label if can't happen)
+  = Maybe                  -- Maybe we don't have any semi-tagging stuff...
+     ([(ConTagZ, CmmLit)], -- Alternatives
+      CmmLit)              -- Default (will be a can't happen RTS label if can't happen)
 
 -- The case branch is executed only from a successful semitagging
 -- venture, when a case has looked at a variable, found that it's
@@ -195,9 +199,9 @@ type SemiTaggingStuff
 %************************************************************************
 
 The CgStmts type is what the code generator outputs: it is a tree of
-statements, including in-line labels.  The job of flattenCgStmts is to
-turn this into a list of basic blocks, each of which ends in a jump
-statement (either a local branch or a non-local jump).
+statements, including in-line labels. The job of flattenCgStmts is to turn
+this into a list of basic blocks, each of which ends in a jump statement
+(either a local branch or a non-local jump).
 
 \begin{code}
 type CgStmts = OrdList CgStmt
@@ -208,7 +212,7 @@ data CgStmt
   | CgFork  BlockId CgStmts
 
 flattenCgStmts :: BlockId -> CgStmts -> [CmmBasicBlock]
-flattenCgStmts id stmts = 
+flattenCgStmts id stmts =
         case flatten (fromOL stmts) of
           ([],blocks)    -> blocks
           (block,blocks) -> BasicBlock id block : blocks
@@ -231,15 +235,15 @@ flattenCgStmts id stmts =
         [CgLabel id]           -> ( [stmt], [BasicBlock id [CmmBranch id]])
         (CgLabel id : stmts)   -> ( [stmt], BasicBlock id block : blocks )
             where (block,blocks) = flatten stmts
-        (CgFork fork_id stmts : ss) -> 
+        (CgFork fork_id stmts : ss) ->
            flatten (CgFork fork_id stmts : CgStmt stmt : ss)
         (CgStmt {} : _) -> panic "CgStmt not seen as ordinary"
 
-  flatten (s:ss) = 
+  flatten (s:ss) =
         case s of
           CgStmt stmt -> (stmt:block,blocks)
           CgLabel id  -> ([CmmBranch id],BasicBlock id block:blocks)
-          CgFork fork_id stmts -> 
+          CgFork fork_id stmts ->
                 (block, BasicBlock fork_id fork_block : fork_blocks ++ blocks)
                 where (fork_block, fork_blocks) = flatten (fromOL stmts)
     where (block,blocks) = flatten ss
@@ -263,10 +267,15 @@ isOrdinaryStmt _          = False
 %************************************************************************
 
 \begin{code}
-type VirtualHpOffset = WordOff  -- Both are in
-type VirtualSpOffset = WordOff  -- units of words
+type VirtualHpOffset = WordOff -- Both are in
+type VirtualSpOffset = WordOff -- units of words
 
-data StackUsage 
+-- | Stack usage information during code generation.
+--
+-- INVARIANT: The environment contains no Stable references to
+--            stack slots below (lower offset) frameSp
+--            It can contain volatile references to this area though.
+data StackUsage
   = StackUsage {
         virtSp :: VirtualSpOffset,
                 -- Virtual offset of topmost allocated slot
@@ -277,83 +286,83 @@ data StackUsage
                 -- all the stack from frameSp downwards
                 -- INVARIANT: less than or equal to virtSp
 
-         freeStk :: [VirtualSpOffset], 
+         freeStk :: [VirtualSpOffset],
                 -- List of free slots, in *increasing* order
                 -- INVARIANT: all <= virtSp
-                -- All slots <= virtSp are taken except these ones
+                --            All slots <= virtSp are taken except these ones
 
-         realSp :: VirtualSpOffset,     
+         realSp :: VirtualSpOffset,
                 -- Virtual offset of real stack pointer register
 
          hwSp :: VirtualSpOffset
-  }                -- Highest value ever taken by virtSp
-
--- INVARIANT: The environment contains no Stable references to
---            stack slots below (lower offset) frameSp
---            It can contain volatile references to this area though.
-
-data HeapUsage =
-  HeapUsage {
-        virtHp :: VirtualHpOffset,      -- Virtual offset of highest-allocated word
-        realHp :: VirtualHpOffset       -- realHp: Virtual offset of real heap ptr
+  }             -- Highest value ever taken by virtSp
+
+-- | Heap usage information during code generation.
+--
+-- virtHp keeps track of the next location to allocate an object at. realHp
+-- keeps track of what the Hp STG register actually points to. The reason these
+-- aren't always the same is that we want to be able to move the realHp in one
+-- go when allocating numerous objects to save having to bump it each time.
+-- virtHp we do bump each time but it doesn't create corresponding inefficient
+-- machine code.
+data HeapUsage
+  = HeapUsage {
+        virtHp :: VirtualHpOffset, -- Virtual offset of highest allocated word
+        realHp :: VirtualHpOffset  -- Virtual offset of real heap ptr
   }
-\end{code}
 
-virtHp keeps track of the next location to allocate an object at. realHp keeps
-track of what the Hp STG register actually points to. The reason these aren't
-always the same is that we want to be able to move the realHp in one go when
-allocating numerous objects to save having to bump it each time. virtHp we do
-bump each time but it doesn't create corresponding inefficient machine code.
-
-\begin{code}
+-- | Return the heap usage high water mark
 heapHWM :: HeapUsage -> VirtualHpOffset
 heapHWM = virtHp
-\end{code}
 
-Initialisation.
 
-\begin{code}
+-- | Initial stack usage
 initStkUsage :: StackUsage
-initStkUsage = StackUsage {
-                        virtSp = 0,
-                        frameSp = 0,
-                        freeStk = [],
-                        realSp = 0,
-                        hwSp = 0
-               }
-                
-initHpUsage :: HeapUsage 
-initHpUsage = HeapUsage {
-                virtHp = 0,
-                realHp = 0
-              }
+initStkUsage
+  = StackUsage {
+        virtSp  = 0,
+        frameSp = 0,
+        freeStk = [],
+        realSp  = 0,
+        hwSp    = 0
+  }
+
+-- | Initial heap usage
+initHpUsage :: HeapUsage
+initHpUsage
+  = HeapUsage {
+        virtHp = 0,
+        realHp = 0
+  }
 
 -- | @stateIncUsafe@ sets the stack and heap high water marks of $arg1$ to
 -- be the max of the high water marks of $arg1$ and $arg2$.
 stateIncUsage :: CgState -> CgState -> CgState
 stateIncUsage s1 s2@(MkCgState { cgs_stk_usg = stk_usg, cgs_hp_usg = hp_usg })
-     = s1 { cgs_hp_usg  = cgs_hp_usg  s1 `maxHpHw`  virtHp hp_usg,
-            cgs_stk_usg = cgs_stk_usg s1 `maxStkHw` hwSp   stk_usg }
-       `addCodeBlocksFrom` s2
-                
+  = s1 { cgs_hp_usg  = cgs_hp_usg  s1 `maxHpHw`  virtHp hp_usg,
+         cgs_stk_usg = cgs_stk_usg s1 `maxStkHw` hwSp   stk_usg }
+    `addCodeBlocksFrom` s2
+
+-- | Similar to @stateIncUsafe@ but we don't max the heap high-watermark
+-- because @stateIncUsageEval@ is used only in forkEval, which in turn is only
+-- used for blocks of code which do their own heap-check.
 stateIncUsageEval :: CgState -> CgState -> CgState
 stateIncUsageEval s1 s2
-     = s1 { cgs_stk_usg = cgs_stk_usg s1 `maxStkHw` hwSp (cgs_stk_usg s2) }
-       `addCodeBlocksFrom` s2
-        -- We don't max the heap high-watermark because stateIncUsageEval is
-        -- used only in forkEval, which in turn is only used for blocks of code
-        -- which do their own heap-check.
+  = s1 { cgs_stk_usg = cgs_stk_usg s1 `maxStkHw` hwSp (cgs_stk_usg s2) }
+    `addCodeBlocksFrom` s2
 
+-- | Add code blocks from the latter to the former
+-- (The cgs_stmts will often be empty, but not always; see @codeOnly@)
 addCodeBlocksFrom :: CgState -> CgState -> CgState
--- Add code blocks from the latter to the former
--- (The cgs_stmts will often be empty, but not always; see codeOnly)
 s1 `addCodeBlocksFrom` s2
   = s1 { cgs_stmts = cgs_stmts s1 `appOL` cgs_stmts s2,
          cgs_tops  = cgs_tops  s1 `appOL` cgs_tops  s2 }
 
+-- | Set @HeapUsage@ virtHp to max of current or $arg2$.
 maxHpHw :: HeapUsage -> VirtualHpOffset -> HeapUsage
 hp_usg `maxHpHw` hw = hp_usg { virtHp = virtHp hp_usg `max` hw }
 
+-- | Set @StackUsage@ hwSp to max of current or $arg2$.
 maxStkHw :: StackUsage -> VirtualSpOffset -> StackUsage
 stk_usg `maxStkHw` hw = stk_usg { hwSp = hwSp stk_usg `max` hw }
 \end{code}
@@ -369,52 +378,39 @@ newtype FCode a = FCode (CgInfoDownwards -> CgState -> (a, CgState))
 type Code       = FCode ()
 
 instance Monad FCode where
-        (>>=) = thenFC
+        (>>=)  = thenFC
         return = returnFC
 
 {-# INLINE thenC #-}
 {-# INLINE thenFC #-}
 {-# INLINE returnFC #-}
-\end{code}
-The Abstract~C is not in the environment so as to improve strictness.
 
-\begin{code}
 initC :: DynFlags -> Module -> FCode a -> IO a
-
-initC dflags mod (FCode code)
-  = do  { uniqs <- mkSplitUniqSupply 'c'
-        ; case code (initCgInfoDown dflags mod) (initCgState uniqs) of
-              (res, _) -> return res
-        }
+initC dflags mod (FCode code) = do
+    uniqs <- mkSplitUniqSupply 'c'
+    case code (initCgInfoDown dflags mod) (initCgState uniqs) of
+        (res, _) -> return res
 
 returnFC :: a -> FCode a
-returnFC val = FCode (\_ state -> (val, state))
-\end{code}
+returnFC val = FCode $ \_ state -> (val, state)
 
-\begin{code}
 thenC :: Code -> FCode a -> FCode a
-thenC (FCode m) (FCode k) = 
-        FCode (\info_down state -> let (_,new_state) = m info_down state in 
-                k info_down new_state)
+thenC (FCode m) (FCode k) = FCode $ \info_down state ->
+    let (_,new_state) = m info_down state
+    in k info_down new_state
 
 listCs :: [Code] -> Code
-listCs [] = return ()
-listCs (fc:fcs) = do
-        fc
-        listCs fcs
-        
+listCs []       = return ()
+listCs (fc:fcs) = fc >> listCs fcs
+
 mapCs :: (a -> Code) -> [a] -> Code
 mapCs = mapM_
 
 thenFC  :: FCode a -> (a -> FCode c) -> FCode c
-thenFC (FCode m) k = FCode (
-        \info_down state ->
-                let 
-                        (m_result, new_state) = m info_down state
-                        (FCode kcode) = k m_result
-                in 
-                        kcode info_down new_state
-        )
+thenFC (FCode m) k = FCode $ \info_down state ->
+    let (m_result, new_state) = m info_down state
+        (FCode kcode)         = k m_result
+    in kcode info_down new_state
 
 listFCs :: [FCode a] -> FCode [a]
 listFCs = sequence
@@ -424,11 +420,10 @@ mapFCs = mapM
 
 -- | Knot-tying combinator for @FCode@
 fixC :: (a -> FCode a) -> FCode a
-fixC fcode = FCode $
-        \info_down state -> 
-                let FCode fc     = fcode v
-                    result@(v,_) = fc info_down state
-                in result
+fixC fcode = FCode $ \info_down state ->
+    let FCode fc     = fcode v
+        result@(v,_) = fc info_down state
+    in result
 
 -- | Knot-tying combinator that throws result away
 fixC_ :: (a -> FCode a) -> FCode ()
@@ -443,64 +438,65 @@ fixC_ fcode = fixC fcode >> return ()
 
 \begin{code}
 getState :: FCode CgState
-getState = FCode $ \_ state -> (state,state)
+getState = FCode $ \_ state -> (state, state)
 
 setState :: CgState -> FCode ()
-setState state = FCode $ \_ _ -> ((),state)
+setState state = FCode $ \_ _ -> ((), state)
 
 getStkUsage :: FCode StackUsage
 getStkUsage = do
-        state <- getState
-        return $ cgs_stk_usg state
+    state <- getState
+    return $ cgs_stk_usg state
 
 setStkUsage :: StackUsage -> Code
 setStkUsage new_stk_usg = do
-        state <- getState
-        setState $ state {cgs_stk_usg = new_stk_usg}
+    state <- getState
+    setState $ state {cgs_stk_usg = new_stk_usg}
 
 getHpUsage :: FCode HeapUsage
 getHpUsage = do
-        state <- getState
-        return $ cgs_hp_usg state
-        
+    state <- getState
+    return $ cgs_hp_usg state
+
 setHpUsage :: HeapUsage -> Code
 setHpUsage new_hp_usg = do
-        state <- getState
-        setState $ state {cgs_hp_usg = new_hp_usg}
+    state <- getState
+    setState $ state {cgs_hp_usg = new_hp_usg}
 
 getBinds :: FCode CgBindings
 getBinds = do
-        state <- getState
-        return $ cgs_binds state
-        
+    state <- getState
+    return $ cgs_binds state
+
 setBinds :: CgBindings -> FCode ()
 setBinds new_binds = do
-        state <- getState
-        setState $ state {cgs_binds = new_binds}
+    state <- getState
+    setState $ state {cgs_binds = new_binds}
 
 getStaticBinds :: FCode CgBindings
 getStaticBinds = do
-        info  <- getInfoDown
-        return (cgd_statics info)
+    info  <- getInfoDown
+    return (cgd_statics info)
 
 withState :: FCode a -> CgState -> FCode (a,CgState)
-withState (FCode fcode) newstate = FCode $ \info_down state -> 
-        let (retval, state2) = fcode info_down newstate in ((retval,state2), state)
+withState (FCode fcode) newstate = FCode $ \info_down state ->
+    let (retval, state2) = fcode info_down newstate
+    in ((retval, state2), state)
 
 newUniqSupply :: FCode UniqSupply
 newUniqSupply = do
-        state <- getState
-        let (us1, us2) = splitUniqSupply (cgs_uniqs state)
-        setState $ state { cgs_uniqs = us1 }
-        return us2
+    state <- getState
+    let (us1, us2) = splitUniqSupply (cgs_uniqs state)
+    setState $ state { cgs_uniqs = us1 }
+    return us2
 
 newUnique :: FCode Unique
 newUnique = do
-        us <- newUniqSupply
-        return (uniqFromSupply us)
+    us <- newUniqSupply
+    return (uniqFromSupply us)
 
 getInfoDown :: FCode CgInfoDownwards
-getInfoDown = FCode $ \info_down state -> (info_down,state)
+getInfoDown = FCode $ \info_down state -> (info_down, state)
 
 instance HasDynFlags FCode where
     getDynFlags = liftM cgd_dflags getInfoDown
@@ -509,175 +505,158 @@ getThisPackage :: FCode PackageId
 getThisPackage = liftM thisPackage getDynFlags
 
 withInfoDown :: FCode a -> CgInfoDownwards -> FCode a
-withInfoDown (FCode fcode) info_down = FCode $ \_ state -> fcode info_down state 
+withInfoDown (FCode fcode) info_down = FCode $ \_ state -> fcode info_down state
 
 doFCode :: FCode a -> CgInfoDownwards -> CgState -> (a,CgState)
 doFCode (FCode fcode) info_down state = fcode info_down state
 \end{code}
 
-
 %************************************************************************
 %*                                                                      *
                 Forking
 %*                                                                      *
 %************************************************************************
 
-@forkClosureBody@ takes a code, $c$, and compiles it in a completely
-fresh environment, except that:
-        - compilation info and statics are passed in unchanged.
-The current environment is passed on completely unaltered, except that
-abstract C from the fork is incorporated.
-
-@forkProc@ takes a code and compiles it in the current environment,
-returning the basic blocks thus constructed.  The current environment
-is passed on completely unchanged.  It is pretty similar to
-@getBlocks@, except that the latter does affect the environment.
-
-@forkStatics@ $fc$ compiles $fc$ in an environment whose statics come
-from the current bindings, but which is otherwise freshly initialised.
-The Abstract~C returned is attached to the current state, but the
-bindings and usage information is otherwise unchanged.
-
 \begin{code}
+
+-- | Takes code and compiles it in a completely fresh environment, except that
+-- compilation info and statics are passed in unchanged. The current
+-- environment is passed on completely unaltered, except that the Cmm code
+-- from the fork is incorporated.
 forkClosureBody :: Code -> Code
-forkClosureBody body_code
-  = do  { info <- getInfoDown
-        ; us   <- newUniqSupply
-        ; state <- getState
-        ; let   body_info_down = info { cgd_eob = initEobInfo }
-                ((),fork_state) = doFCode body_code body_info_down 
-                                          (initCgState us)
-        ; ASSERT( isNilOL (cgs_stmts fork_state) )
-          setState $ state `addCodeBlocksFrom` fork_state }
-        
+forkClosureBody body_code = do
+    info  <- getInfoDown
+    us    <- newUniqSupply
+    state <- getState
+    let body_info_down   = info { cgd_eob = initEobInfo }
+        ((), fork_state) = doFCode body_code body_info_down (initCgState us)
+
+    ASSERT( isNilOL (cgs_stmts fork_state) )
+      setState $ state `addCodeBlocksFrom` fork_state
+
+-- | @forkStatics@ $fc$ compiles $fc$ in an environment whose statics come
+-- from the current bindings, but which is otherwise freshly initialised.
+-- The Cmm returned is attached to the current state, but the bindings and
+-- usage information is otherwise unchanged.
 forkStatics :: FCode a -> FCode a
-forkStatics body_code
-  = do  { info  <- getInfoDown
-        ; us    <- newUniqSupply
-        ; state <- getState
-        ; let   rhs_info_down = info { cgd_statics = cgs_binds state,
-                                       cgd_eob     = initEobInfo }
-                (result, fork_state_out) = doFCode body_code rhs_info_down 
-                                                   (initCgState us)
-        ; ASSERT( isNilOL (cgs_stmts fork_state_out) )
-          setState (state `addCodeBlocksFrom` fork_state_out)
-        ; return result }
-
+forkStatics body_code = do
+    info  <- getInfoDown
+    us    <- newUniqSupply
+    state <- getState
+    let rhs_info_down = info { cgd_statics = cgs_binds state,
+                               cgd_eob     = initEobInfo }
+        (result, fork_state_out) = doFCode body_code rhs_info_down (initCgState us)
+
+    ASSERT( isNilOL (cgs_stmts fork_state_out) )
+      setState (state `addCodeBlocksFrom` fork_state_out)
+    return result
+
+-- | @forkProc@ takes a code and compiles it in the current environment,
+-- returning the basic blocks thus constructed. The current environment is
+-- passed on completely unchanged. It is pretty similar to @getBlocks@, except
+-- that the latter does affect the environment.
 forkProc :: Code -> FCode CgStmts
-forkProc body_code
-  = do  { info_down <- getInfoDown
-        ; us    <- newUniqSupply
-        ; state <- getState
-        ; let   fork_state_in = (initCgState us) 
-                                        { cgs_binds   = cgs_binds state,
-                                          cgs_stk_usg = cgs_stk_usg state,
-                                          cgs_hp_usg  = cgs_hp_usg state }
-                        -- ToDo: is the hp usage necesary?
-                (code_blks, fork_state_out) = doFCode (getCgStmts body_code) 
-                                                      info_down fork_state_in
-        ; setState $ state `stateIncUsageEval` fork_state_out
-        ; return code_blks }
+forkProc body_code = do
+    info  <- getInfoDown
+    us    <- newUniqSupply
+    state <- getState
+    let fork_state_in = (initCgState us)
+                            { cgs_binds   = cgs_binds state,
+                              cgs_stk_usg = cgs_stk_usg state,
+                              cgs_hp_usg  = cgs_hp_usg state }
+        (code_blks, fork_state_out) = doFCode (getCgStmts body_code)
+                                              info fork_state_in
+    setState $ state `stateIncUsageEval` fork_state_out
+    return code_blks
 
 -- Emit any code from the inner thing into the outer thing
 -- Do not affect anything else in the outer state
 -- Used in almost-circular code to prevent false loop dependencies
 codeOnly :: Code -> Code
-codeOnly body_code
-  = do  { info_down <- getInfoDown
-        ; us   <- newUniqSupply
-        ; state <- getState
-        ; let   fork_state_in = (initCgState us) { cgs_binds   = cgs_binds state,
-                                                   cgs_stk_usg = cgs_stk_usg state,
-                                                   cgs_hp_usg  = cgs_hp_usg state }
-                ((), fork_state_out) = doFCode body_code info_down fork_state_in
-        ; setState $ state `addCodeBlocksFrom` fork_state_out }
-\end{code}
-
-@forkAlts@ $bs~d$ takes fcodes $bs$ for the branches of a @case@, and
-an fcode for the default case $d$, and compiles each in the current
-environment.  The current environment is passed on unmodified, except
-that
-        - the worst stack high-water mark is incorporated
-        - the virtual Hp is moved on to the worst virtual Hp for the branches
-
-\begin{code}
+codeOnly body_code = do
+    info  <- getInfoDown
+    us    <- newUniqSupply
+    state <- getState
+    let fork_state_in = (initCgState us) { cgs_binds   = cgs_binds state,
+                                           cgs_stk_usg = cgs_stk_usg state,
+                                           cgs_hp_usg  = cgs_hp_usg state }
+        ((), fork_state_out) = doFCode body_code info fork_state_in
+    setState $ state `addCodeBlocksFrom` fork_state_out
+
+-- | @forkAlts@ $bs~d$ takes fcodes $bs$ for the branches of a @case@, and an
+-- an fcode for the default case $d$, and compiles each in the current
+-- environment. The current environment is passed on unmodified, except that:
+--     * the worst stack high-water mark is incorporated
+--     * the virtual Hp is moved on to the worst virtual Hp for the branches
 forkAlts :: [FCode a] -> FCode [a]
-
-forkAlts branch_fcodes
-  = do  { info_down <- getInfoDown
-        ; us <- newUniqSupply
-        ; state <- getState
-        ; let compile us branch 
-                = (us2, doFCode branch info_down branch_state)
-                where
-                  (us1,us2) = splitUniqSupply us
-                  branch_state = (initCgState us1) {
-                                        cgs_binds   = cgs_binds state,
-                                        cgs_stk_usg = cgs_stk_usg state,
-                                        cgs_hp_usg  = cgs_hp_usg state }
-
-              (_us, results) = mapAccumL compile us branch_fcodes
-              (branch_results, branch_out_states) = unzip results
-        ; setState $ foldl stateIncUsage state branch_out_states
-                -- NB foldl.  state is the *left* argument to stateIncUsage
-        ; return branch_results }
-\end{code}
-
-@forkEval@ takes two blocks of code.
-
-   -  The first meddles with the environment to set it up as expected by
-      the alternatives of a @case@ which does an eval (or gc-possible primop).
-   -  The second block is the code for the alternatives.
-      (plus info for semi-tagging purposes)
-
-@forkEval@ picks up the virtual stack pointer and returns a suitable
-@EndOfBlockInfo@ for the caller to use, together with whatever value
-is returned by the second block.
-
-It uses @initEnvForAlternatives@ to initialise the environment, and
-@stateIncUsageAlt@ to incorporate usage; the latter ignores the heap
-usage.
-
-\begin{code}
-forkEval :: EndOfBlockInfo              -- For the body
-         -> Code                        -- Code to set environment
-         -> FCode Sequel                -- Semi-tagging info to store
-         -> FCode EndOfBlockInfo        -- The new end of block info
-
-forkEval body_eob_info env_code body_code
-  = do  { (v, sequel) <- forkEvalHelp body_eob_info env_code body_code
-        ; returnFC (EndOfBlockInfo v sequel) }
-
+forkAlts branch_fcodes = do 
+    info  <- getInfoDown
+    us    <- newUniqSupply
+    state <- getState
+    let compile us branch = (us2, doFCode branch info branch_state)
+            where
+                (us1,us2)    = splitUniqSupply us
+                branch_state = (initCgState us1) {
+                                   cgs_binds   = cgs_binds state,
+                                   cgs_stk_usg = cgs_stk_usg state,
+                                   cgs_hp_usg  = cgs_hp_usg state }
+        (_us, results) = mapAccumL compile us branch_fcodes
+        (branch_results, branch_out_states) = unzip results
+    -- NB foldl. state is the *left* argument to stateIncUsage
+    setState $ foldl stateIncUsage state branch_out_states
+    return branch_results
+
+-- | @forkEval@ takes two blocks of code.
+-- 
+--   *  The first meddles with the environment to set it up as expected by
+--      the alternatives of a @case@ which does an eval (or gc-possible primop).
+--   *  The second block is the code for the alternatives.
+--      (plus info for semi-tagging purposes)
+--
+-- @forkEval@ picks up the virtual stack pointer and returns a suitable
+-- @EndOfBlockInfo@ for the caller to use, together with whatever value
+-- is returned by the second block.
+-- 
+-- It uses @initEnvForAlternatives@ to initialise the environment, and
+-- @stateIncUsageAlt@ to incorporate usage; the latter ignores the heap usage.
+forkEval :: EndOfBlockInfo       -- For the body
+         -> Code                 -- Code to set environment
+         -> FCode Sequel         -- Semi-tagging info to store
+         -> FCode EndOfBlockInfo -- The new end of block info
+forkEval body_eob_info env_code body_code = do
+    (v, sequel) <- forkEvalHelp body_eob_info env_code body_code
+    returnFC (EndOfBlockInfo v sequel)
+
+-- A disturbingly complicated function
 forkEvalHelp :: EndOfBlockInfo  -- For the body
              -> Code            -- Code to set environment
              -> FCode a         -- The code to do after the eval
              -> FCode (VirtualSpOffset, -- Sp
                        a)               -- Result of the FCode
-        -- A disturbingly complicated function
-forkEvalHelp body_eob_info env_code body_code
-  = do  { info_down <- getInfoDown
-        ; us   <- newUniqSupply
-        ; state <- getState
-        ; let { info_down_for_body = info_down {cgd_eob = body_eob_info}
-              ; (_, env_state) = doFCode env_code info_down_for_body 
-                                         (state {cgs_uniqs = us})
-              ; state_for_body = (initCgState (cgs_uniqs env_state)) 
-                                        { cgs_binds   = binds_for_body,
-                                          cgs_stk_usg = stk_usg_for_body }
-              ; binds_for_body   = nukeVolatileBinds (cgs_binds env_state)
-              ; stk_usg_from_env = cgs_stk_usg env_state
-              ; virtSp_from_env  = virtSp stk_usg_from_env
-              ; stk_usg_for_body = stk_usg_from_env {realSp = virtSp_from_env,
-                                                     hwSp   = virtSp_from_env}
-              ; (value_returned, state_at_end_return)
-                        = doFCode body_code info_down_for_body state_for_body           
-          } 
-        ; ASSERT( isNilOL (cgs_stmts state_at_end_return) )
-                 -- The code coming back should consist only of nested declarations,
-                 -- notably of the return vector!
-          setState $ state `stateIncUsageEval` state_at_end_return
-        ; return (virtSp_from_env, value_returned) }
-
+forkEvalHelp body_eob_info env_code body_code = do
+    info  <- getInfoDown
+    us    <- newUniqSupply
+    state <- getState
+
+    let info_body      = info { cgd_eob = body_eob_info }
+        (_, env_state) = doFCode env_code info_body
+                                 (state {cgs_uniqs = us})
+        state_for_body = (initCgState (cgs_uniqs env_state))
+                            { cgs_binds   = binds_for_body,
+                              cgs_stk_usg = stk_usg_for_body }
+        binds_for_body   = nukeVolatileBinds (cgs_binds env_state)
+        stk_usg_from_env = cgs_stk_usg env_state
+        virtSp_from_env  = virtSp stk_usg_from_env
+        stk_usg_for_body = stk_usg_from_env { realSp = virtSp_from_env,
+                                              hwSp   = virtSp_from_env }
+        (value_returned, state_at_end_return)
+            = doFCode body_code info_body state_for_body
+
+    -- The code coming back should consist only of nested declarations,
+    -- notably of the return vector!
+    ASSERT( isNilOL (cgs_stmts state_at_end_return) )
+      setState $ state `stateIncUsageEval` state_at_end_return
+    return (virtSp_from_env, value_returned)
 
 -- ----------------------------------------------------------------------------
 -- Combinators for emitting code
@@ -698,20 +677,20 @@ labelC :: BlockId -> Code
 labelC id = emitCgStmt (CgLabel id)
 
 newLabelC :: FCode BlockId
-newLabelC = do { u <- newUnique
-               ; return $ mkBlockId u }
+newLabelC = do
+    u <- newUnique
+    return $ mkBlockId u
 
 -- Emit code, eliminating no-ops
 checkedAbsC :: CmmStmt -> Code
-checkedAbsC stmt = emitStmts (if isNopStmt stmt then nilOL
-                              else unitOL stmt)
+checkedAbsC stmt = emitStmts $ if isNopStmt stmt then nilOL else unitOL stmt
 
 stmtsC :: [CmmStmt] -> Code
-stmtsC stmts = emitStmts (toOL stmts)
+stmtsC stmts = emitStmts $ toOL stmts
 
 -- Emit code; no no-op checking
 emitStmts :: CmmStmts -> Code
-emitStmts stmts = emitCgStmts (fmap CgStmt stmts)
+emitStmts stmts = emitCgStmts $ fmap CgStmt stmts
 
 -- forkLabelledCode is for emitting a chunk of code with a label, outside
 -- of the current instruction stream.
@@ -719,40 +698,38 @@ forkLabelledCode :: Code -> FCode BlockId
 forkLabelledCode code = getCgStmts code >>= forkCgStmts
 
 emitCgStmt :: CgStmt -> Code
-emitCgStmt stmt
-  = do  { state <- getState
-        ; setState $ state { cgs_stmts = cgs_stmts state `snocOL` stmt }
-        }
+emitCgStmt stmt = do
+    state <- getState
+    setState $ state { cgs_stmts = cgs_stmts state `snocOL` stmt }
 
 emitDecl :: CmmDecl -> Code
-emitDecl decl
-  = do  { state <- getState
-        ; setState $ state { cgs_tops = cgs_tops state `snocOL` decl } }
+emitDecl decl = do
+    state <- getState
+    setState $ state { cgs_tops = cgs_tops state `snocOL` decl }
 
 emitProc :: CmmInfo -> CLabel -> [CmmFormal] -> [CmmBasicBlock] -> Code
-emitProc info lbl [] blocks
-  = do  { let proc_block = CmmProc info lbl (ListGraph blocks)
-        ; state <- getState
-        ; setState $ state { cgs_tops = cgs_tops state `snocOL` proc_block } }
+emitProc info lbl [] blocks = do
+    let proc_block = CmmProc info lbl (ListGraph blocks)
+    state <- getState
+    setState $ state { cgs_tops = cgs_tops state `snocOL` proc_block }
 emitProc _ _ (_:_) _ = panic "emitProc called with nonempty args"
 
 -- Emit a procedure whose body is the specified code; no info table
 emitSimpleProc :: CLabel -> Code -> Code
-emitSimpleProc lbl code
-  = do  { stmts <- getCgStmts code
-        ; blks <- cgStmtsToBlocks stmts
-        ; emitProc (CmmInfo Nothing Nothing CmmNonInfoTable) lbl [] blks }
+emitSimpleProc lbl code = do
+    stmts <- getCgStmts code
+    blks <- cgStmtsToBlocks stmts
+    emitProc (CmmInfo Nothing Nothing CmmNonInfoTable) lbl [] blks
 
 -- Get all the CmmTops (there should be no stmts)
 -- Return a single Cmm which may be split from other Cmms by
 -- object splitting (at a later stage)
 getCmm :: Code -> FCode CmmGroup
-getCmm code 
-  = do  { state1 <- getState
-        ; ((), state2) <- withState code (state1 { cgs_tops  = nilOL })
-        ; setState $ state2 { cgs_tops = cgs_tops state1 } 
-        ; return (fromOL (cgs_tops state2))
-        }
+getCmm code = do
+    state1 <- getState
+    ((), state2) <- withState code (state1 { cgs_tops  = nilOL })
+    setState $ state2 { cgs_tops = cgs_tops state1 }
+    return (fromOL (cgs_tops state2))
 
 -- ----------------------------------------------------------------------------
 -- CgStmts
@@ -760,38 +737,37 @@ getCmm code
 -- These functions deal in terms of CgStmts, which is an abstract type
 -- representing the code in the current proc.
 
-
 -- emit CgStmts into the current instruction stream
 emitCgStmts :: CgStmts -> Code
-emitCgStmts stmts
-  = do  { state <- getState
-        ; setState $ state { cgs_stmts = cgs_stmts state `appOL` stmts } }
+emitCgStmts stmts = do
+    state <- getState
+    setState $ state { cgs_stmts = cgs_stmts state `appOL` stmts }
 
 -- emit CgStmts outside the current instruction stream, and return a label
 forkCgStmts :: CgStmts -> FCode BlockId
-forkCgStmts stmts
-  = do  { id <- newLabelC
-        ; emitCgStmt (CgFork id stmts)
-        ; return id
-        }
+forkCgStmts stmts = do
+    id <- newLabelC
+    emitCgStmt (CgFork id stmts)
+    return id
 
 -- turn CgStmts into [CmmBasicBlock], for making a new proc.
 cgStmtsToBlocks :: CgStmts -> FCode [CmmBasicBlock]
-cgStmtsToBlocks stmts
-  = do  { id <- newLabelC
-        ; return (flattenCgStmts id stmts)
-        }       
+cgStmtsToBlocks stmts = do
+    id <- newLabelC
+    return (flattenCgStmts id stmts)
 
 -- collect the code emitted by an FCode computation
 getCgStmts' :: FCode a -> FCode (a, CgStmts)
-getCgStmts' fcode
-  = do  { state1 <- getState
-        ; (a, state2) <- withState fcode (state1 { cgs_stmts = nilOL })
-        ; setState $ state2 { cgs_stmts = cgs_stmts state1  }
-        ; return (a, cgs_stmts state2) }
+getCgStmts' fcode = do
+    state1 <- getState
+    (a, state2) <- withState fcode (state1 { cgs_stmts = nilOL })
+    setState $ state2 { cgs_stmts = cgs_stmts state1  }
+    return (a, cgs_stmts state2)
 
 getCgStmts :: FCode a -> FCode CgStmts
-getCgStmts fcode = do { (_,stmts) <- getCgStmts' fcode; return stmts }
+getCgStmts fcode = do
+    (_,stmts) <- getCgStmts' fcode
+    return stmts
 
 -- Simple ways to construct CgStmts:
 noCgStmts :: CgStmts
@@ -807,56 +783,60 @@ consCgStmt stmt stmts = CgStmt stmt `consOL` stmts
 -- Get the current module name
 
 getModuleName :: FCode Module
-getModuleName = do { info <- getInfoDown; return (cgd_mod info) }
+getModuleName = do
+    info <- getInfoDown
+    return (cgd_mod info)
 
 -- ----------------------------------------------------------------------------
 -- Get/set the end-of-block info
 
 setEndOfBlockInfo :: EndOfBlockInfo -> Code -> Code
 setEndOfBlockInfo eob_info code = do
-        info  <- getInfoDown
-        withInfoDown code (info {cgd_eob = eob_info})
+    info  <- getInfoDown
+    withInfoDown code (info {cgd_eob = eob_info})
 
 getEndOfBlockInfo :: FCode EndOfBlockInfo
 getEndOfBlockInfo = do
-        info <- getInfoDown
-        return (cgd_eob info)
+    info <- getInfoDown
+    return (cgd_eob info)
 
 -- ----------------------------------------------------------------------------
 -- Get/set the current SRT label
 
 -- There is just one SRT for each top level binding; all the nested
--- bindings use sub-sections of this SRT.  The label is passed down to
+-- bindings use sub-sections of this SRT. The label is passed down to
 -- the nested bindings via the monad.
 
 getSRTLabel :: FCode CLabel     -- Used only by cgPanic
-getSRTLabel = do info  <- getInfoDown
-                 return (cgd_srt_lbl info)
+getSRTLabel = do
+    info  <- getInfoDown
+    return (cgd_srt_lbl info)
 
 setSRTLabel :: CLabel -> FCode a -> FCode a
-setSRTLabel srt_lbl code
-  = do  info <- getInfoDown
-        withInfoDown code (info { cgd_srt_lbl = srt_lbl})
+setSRTLabel srt_lbl code = do
+    info <- getInfoDown
+    withInfoDown code (info { cgd_srt_lbl = srt_lbl})
 
 getSRT :: FCode SRT
-getSRT = do info <- getInfoDown
-            return (cgd_srt info)
+getSRT = do
+    info <- getInfoDown
+    return (cgd_srt info)
 
 setSRT :: SRT -> FCode a -> FCode a
-setSRT srt code
-  = do info <- getInfoDown
-       withInfoDown code (info { cgd_srt = srt})
+setSRT srt code = do
+    info <- getInfoDown
+    withInfoDown code (info { cgd_srt = srt})
 
 -- ----------------------------------------------------------------------------
 -- Get/set the current ticky counter label
 
 getTickyCtrLabel :: FCode CLabel
 getTickyCtrLabel = do
-        info <- getInfoDown
-        return (cgd_ticky info)
+    info <- getInfoDown
+    return (cgd_ticky info)
 
 setTickyCtrLabel :: CLabel -> Code -> Code
 setTickyCtrLabel ticky code = do
-        info <- getInfoDown
-        withInfoDown code (info {cgd_ticky = ticky})
+    info <- getInfoDown
+    withInfoDown code (info {cgd_ticky = ticky})
 \end{code}