[project @ 1996-01-11 14:06:51 by partain]

32 files changed, 458 insertions, 770 deletions

diff --git a/ghc/compiler/codeGen/CgBindery.hi b/ghc/compiler/codeGen/CgBindery.hi
index 7d11d51c7b..4d4fa91ca1 100644
--- a/ghc/compiler/codeGen/CgBindery.hi
+++ b/ghc/compiler/codeGen/CgBindery.hi
@@ -4,85 +4,60 @@ import AbsCSyn(AbstractC, CAddrMode, CExprMacro, CStmtMacro, MagicId, RegRelativ
 import BasicLit(BasicLit)
 import CLabelInfo(CLabel)
 import CgMonad(CgInfoDownwards, CgState, StubFlag)
-import ClosureInfo(ClosureInfo, LambdaFormInfo, StandardFormInfo)
+import ClosureInfo(ClosureInfo, LambdaFormInfo)
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
-import Id(Id, IdDetails)
+import Id(Id)
 import IdEnv(IdEnv(..))
-import IdInfo(IdInfo)
 import Maybes(Labda)
 import PreludePS(_PackedString)
 import PreludeRatio(Ratio(..))
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import StgSyn(StgAtom)
-import UniType(UniType)
 import UniqFM(UniqFM)
 import UniqSet(UniqSet(..))
 import Unique(Unique)
-data AbstractC 	{-# GHC_PRAGMA AbsCNop | AbsCStmts AbstractC AbstractC | CAssign CAddrMode CAddrMode | CJump CAddrMode | CFallThrough CAddrMode | CReturn CAddrMode ReturnInfo | CSwitch CAddrMode [(BasicLit, AbstractC)] AbstractC | CCodeBlock CLabel AbstractC | CInitHdr ClosureInfo RegRelative CAddrMode Bool | COpStmt [CAddrMode] PrimOp [CAddrMode] Int [MagicId] | CSimultaneous AbstractC | CMacroStmt CStmtMacro [CAddrMode] | CCallProfCtrMacro _PackedString [CAddrMode] | CCallProfCCMacro _PackedString [CAddrMode] | CStaticClosure CLabel ClosureInfo CAddrMode [CAddrMode] | CClosureInfoAndCode ClosureInfo AbstractC (Labda AbstractC) CAddrMode [Char] | CRetVector CLabel [Labda CAddrMode] AbstractC | CRetUnVector CLabel CAddrMode | CFlatRetVector CLabel [CAddrMode] | CCostCentreDecl Bool CostCentre | CClosureUpdInfo AbstractC | CSplitMarker #-}
-data CAddrMode 	{-# GHC_PRAGMA CVal RegRelative PrimKind | CAddr RegRelative | CReg MagicId | CTableEntry CAddrMode CAddrMode PrimKind | CTemp Unique PrimKind | CLbl CLabel PrimKind | CUnVecLbl CLabel CLabel | CCharLike CAddrMode | CIntLike CAddrMode | CString _PackedString | CLit BasicLit | CLitLit _PackedString PrimKind | COffset HeapOffset | CCode AbstractC | CLabelledCode CLabel AbstractC | CJoinPoint Int Int | CMacroExpr PrimKind CExprMacro [CAddrMode] | CCostCentre CostCentre Bool #-}
-data MagicId 	{-# GHC_PRAGMA BaseReg | StkOReg | VanillaReg PrimKind Int# | FloatReg Int# | DoubleReg Int# | TagReg | RetReg | SpA | SuA | SpB | SuB | Hp | HpLim | LivenessReg | ActivityReg | StdUpdRetVecReg | StkStubReg | CurCostCentre | VoidReg #-}
-data BasicLit 	{-# GHC_PRAGMA MachChar Char | MachStr _PackedString | MachAddr Integer | MachInt Integer Bool | MachFloat (Ratio Integer) | MachDouble (Ratio Integer) | MachLitLit _PackedString PrimKind | NoRepStr _PackedString | NoRepInteger Integer | NoRepRational (Ratio Integer) #-}
+data AbstractC 
+data CAddrMode 
+data MagicId 
+data BasicLit 
 data CLabel 
 type CgBindings = UniqFM CgIdInfo
 data CgIdInfo   = MkCgIdInfo Id VolatileLoc StableLoc LambdaFormInfo
-data CgState 	{-# GHC_PRAGMA MkCgState AbstractC (UniqFM CgIdInfo) ((Int, [(Int, StubFlag)], Int, Int), (Int, [Int], Int, Int), (HeapOffset, HeapOffset)) #-}
-data LambdaFormInfo 	{-# GHC_PRAGMA LFReEntrant Bool Int Bool | LFCon Id Bool | LFTuple Id Bool | LFThunk Bool Bool Bool StandardFormInfo | LFArgument | LFImported | LFLetNoEscape Int (UniqFM Id) | LFBlackHole | LFIndirection #-}
+data CgState 
+data LambdaFormInfo 
 data HeapOffset 
-data Id 	{-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data Id 
 type IdEnv a = UniqFM a
-data Labda a 	{-# GHC_PRAGMA Hamna | Ni a #-}
-data StableLoc 	{-# GHC_PRAGMA NoStableLoc | VirAStkLoc Int | VirBStkLoc Int | LitLoc BasicLit | StableAmodeLoc CAddrMode #-}
-data StgAtom a 	{-# GHC_PRAGMA StgVarAtom a | StgLitAtom BasicLit #-}
-data UniqFM a 	{-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
+data Labda a 
+data StableLoc 
+data StgAtom a 
+data UniqFM a 
 type UniqSet a = UniqFM a
-data Unique 	{-# GHC_PRAGMA MkUnique Int# #-}
-data VolatileLoc 	{-# GHC_PRAGMA NoVolatileLoc | TempVarLoc Unique | RegLoc MagicId | VirHpLoc HeapOffset | VirNodeLoc HeapOffset #-}
+data Unique 
+data VolatileLoc 
 bindArgsToRegs :: [Id] -> [MagicId] -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 2 _U_ 1122 _N_ _S_ "SL" _N_ _N_ #-}
 bindNewPrimToAmode :: Id -> CAddrMode -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 2 _U_ 2122 _N_ _S_ "LS" _N_ _N_ #-}
 bindNewToAStack :: (Id, Int) -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 3 _U_ 101 _N_ _S_ "U(LL)AU(LLL)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 bindNewToBStack :: (Id, Int) -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 3 _U_ 101 _N_ _S_ "U(LL)AU(LLL)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 bindNewToNode :: Id -> HeapOffset -> LambdaFormInfo -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 5 _U_ 22201 _N_ _S_ "LLLAU(LLL)" {_A_ 4 _U_ 2221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 bindNewToReg :: Id -> MagicId -> LambdaFormInfo -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 5 _U_ 22201 _N_ _S_ "LLLAU(LLL)" {_A_ 4 _U_ 2221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 bindNewToTemp :: Id -> CgInfoDownwards -> CgState -> (CAddrMode, CgState)
-	{-# GHC_PRAGMA _A_ 1 _U_ 201 _N_ _N_ _N_ _N_ #-}
 getAtomAmode :: StgAtom Id -> CgInfoDownwards -> CgState -> (CAddrMode, CgState)
-	{-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "S" _N_ _N_ #-}
 getAtomAmodes :: [StgAtom Id] -> CgInfoDownwards -> CgState -> ([CAddrMode], CgState)
-	{-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "S" _N_ _N_ #-}
 getCAddrMode :: Id -> CgInfoDownwards -> CgState -> (CAddrMode, CgState)
-	{-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "U(LLLS)" {_A_ 4 _U_ 222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getCAddrModeAndInfo :: Id -> CgInfoDownwards -> CgState -> ((CAddrMode, LambdaFormInfo), CgState)
-	{-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "U(LLLS)" {_A_ 4 _U_ 222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getCAddrModeIfVolatile :: Id -> CgInfoDownwards -> CgState -> (Labda CAddrMode, CgState)
-	{-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "U(LLLS)" {_A_ 4 _U_ 222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getVolatileRegs :: UniqFM Id -> CgInfoDownwards -> CgState -> ([MagicId], CgState)
-	{-# GHC_PRAGMA _A_ 1 _U_ 222 _N_ _N_ _N_ _N_ #-}
 heapIdInfo :: Id -> HeapOffset -> LambdaFormInfo -> CgIdInfo
-	{-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _N_ _N_ _N_ #-}
 idInfoToAmode :: PrimKind -> CgIdInfo -> CgInfoDownwards -> CgState -> (CAddrMode, CgState)
-	{-# GHC_PRAGMA _A_ 2 _U_ 2122 _N_ _S_ "LU(ASLA)" {_A_ 5 _U_ 21122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 letNoEscapeIdInfo :: Id -> Int -> Int -> LambdaFormInfo -> CgIdInfo
-	{-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 maybeAStkLoc :: StableLoc -> Labda Int
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 8 \ (u0 :: StableLoc) -> case u0 of { _ALG_ _ORIG_ CgBindery VirAStkLoc (u1 :: Int) -> _!_ _ORIG_ Maybes Ni [Int] [u1]; (u2 :: StableLoc) -> _!_ _ORIG_ Maybes Hamna [Int] [] } _N_ #-}
 maybeBStkLoc :: StableLoc -> Labda Int
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 8 \ (u0 :: StableLoc) -> case u0 of { _ALG_ _ORIG_ CgBindery VirBStkLoc (u1 :: Int) -> _!_ _ORIG_ Maybes Ni [Int] [u1]; (u2 :: StableLoc) -> _!_ _ORIG_ Maybes Hamna [Int] [] } _N_ #-}
 newTempAmodeAndIdInfo :: Id -> LambdaFormInfo -> (CAddrMode, CgIdInfo)
-	{-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 nukeVolatileBinds :: UniqFM CgIdInfo -> UniqFM CgIdInfo
-	{-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 rebindToAStack :: Id -> Int -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 4 _U_ 2201 _N_ _S_ "LLAU(LLL)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 rebindToBStack :: Id -> Int -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 4 _U_ 2201 _N_ _S_ "LLAU(LLL)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 stableAmodeIdInfo :: Id -> CAddrMode -> LambdaFormInfo -> CgIdInfo
-	{-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _N_ _N_ _N_ #-}
 
diff --git a/ghc/compiler/codeGen/CgCase.hi b/ghc/compiler/codeGen/CgCase.hi
index 9a2ce69973..e0c05ba1f1 100644
--- a/ghc/compiler/codeGen/CgCase.hi
+++ b/ghc/compiler/codeGen/CgCase.hi
@@ -6,20 +6,17 @@ import CgBindery(CgIdInfo)
 import CgMonad(CgInfoDownwards, CgState, EndOfBlockInfo, StubFlag)
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import Maybes(Labda)
 import PrimOps(PrimOp)
 import StgSyn(StgAtom, StgBinding, StgCaseAlternatives, StgCaseDefault, StgExpr)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(Unique)
-data CgState 	{-# GHC_PRAGMA MkCgState AbstractC (UniqFM CgIdInfo) ((Int, [(Int, StubFlag)], Int, Int), (Int, [Int], Int, Int), (HeapOffset, HeapOffset)) #-}
-data Id 	{-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data StgCaseAlternatives a b 	{-# GHC_PRAGMA StgAlgAlts UniType [(Id, [a], [Bool], StgExpr a b)] (StgCaseDefault a b) | StgPrimAlts UniType [(BasicLit, StgExpr a b)] (StgCaseDefault a b) #-}
-data StgExpr a b 	{-# GHC_PRAGMA StgApp (StgAtom b) [StgAtom b] (UniqFM b) | StgConApp Id [StgAtom b] (UniqFM b) | StgPrimApp PrimOp [StgAtom b] (UniqFM b) | StgCase (StgExpr a b) (UniqFM b) (UniqFM b) Unique (StgCaseAlternatives a b) | StgLet (StgBinding a b) (StgExpr a b) | StgLetNoEscape (UniqFM b) (UniqFM b) (StgBinding a b) (StgExpr a b) | StgSCC UniType CostCentre (StgExpr a b) #-}
+data CgState 
+data Id 
+data StgCaseAlternatives a b 
+data StgExpr a b 
 cgCase :: StgExpr Id Id -> UniqFM Id -> UniqFM Id -> Unique -> StgCaseAlternatives Id Id -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 5 _U_ 2222222 _N_ _S_ "SLLLL" _N_ _N_ #-}
 saveVolatileVarsAndRegs :: UniqFM Id -> CgInfoDownwards -> CgState -> ((AbstractC, EndOfBlockInfo, Labda Int), CgState)
-	{-# GHC_PRAGMA _A_ 1 _U_ 222 _N_ _N_ _N_ _N_ #-}
 
diff --git a/ghc/compiler/codeGen/CgCase.lhs b/ghc/compiler/codeGen/CgCase.lhs
index 1cd7696a11..17be925b3b 100644
--- a/ghc/compiler/codeGen/CgCase.lhs
+++ b/ghc/compiler/codeGen/CgCase.lhs
@@ -190,30 +190,27 @@ cgCase (StgPrimApp op args _) live_in_whole_case live_in_alts uniq alts
 	-- Perform the operation
     getVolatileRegs live_in_alts		        `thenFC` \ vol_regs ->
 
-    profCtrC SLIT("SET_ACTIVITY") [CLitLit SLIT("ACT_PRIM") IntKind]  `thenC`
-
     absC (COpStmt result_amodes op
 		 arg_amodes -- note: no liveness arg
 		 liveness_mask vol_regs) 		`thenC`
 
-    profCtrC SLIT("SET_ACTIVITY") [CLitLit SLIT("ACT_PRIM_STOP") IntKind]  `thenC`
-
 	-- Scrutinise the result
     cgInlineAlts NoGC uniq alts
 
   | otherwise	-- *Can* trigger GC
-  = getPrimOpArgAmodes op args		`thenFC` \ arg_amodes ->
+  = getPrimOpArgAmodes op args	`thenFC` \ arg_amodes ->
+--NO:  getIntSwitchChkrC	`thenFC` \ isw_chkr   ->
 
    	-- Get amodes for the arguments and results, and assign to regs
 	-- (Can-trigger-gc primops guarantee to have their (nonRobust)
 	--  args in regs)
     let
-	op_result_regs = assignPrimOpResultRegs op
+	op_result_regs = assignPrimOpResultRegs {-NO:isw_chkr-} op
 
     	op_result_amodes = map CReg op_result_regs
 
 	(op_arg_amodes, liveness_mask, arg_assts) 
-	  = makePrimOpArgsRobust op arg_amodes
+	  = makePrimOpArgsRobust {-NO:isw_chkr-} op arg_amodes
 
 	liveness_arg  = mkIntCLit liveness_mask
     in
@@ -245,17 +242,13 @@ cgCase (StgPrimApp op args _) live_in_whole_case live_in_alts uniq alts
 	
 	-- do_op_and_continue will be passed an amode for the continuation
 	do_op_and_continue sequel
-          = profCtrC SLIT("SET_ACTIVITY") [CLitLit SLIT("ACT_PRIM") IntKind]  `thenC`
-
-	    absC (COpStmt op_result_amodes
+          = absC (COpStmt op_result_amodes
 			  op
 			  (pin_liveness op liveness_arg op_arg_amodes)
 			  liveness_mask
 			  [{-no vol_regs-}])
     	    	    	    	    	`thenC`
 
-	    profCtrC SLIT("SET_ACTIVITY") [CLitLit SLIT("ACT_PRIM_STOP") IntKind]  `thenC`
-
             sequelToAmode sequel        `thenFC` \ dest_amode ->
             absC (CReturn dest_amode DirectReturn)
 
@@ -438,6 +431,7 @@ cgEvalAlts :: Maybe VirtualSpBOffset	-- Offset of cost-centre to be restored, if
 cgEvalAlts cc_slot uniq (StgAlgAlts ty alts deflt)
   = 	-- Generate the instruction to restore cost centre, if any
     restoreCurrentCostCentre cc_slot 	`thenFC` \ cc_restore ->
+    getIntSwitchChkrC			`thenFC` \ isw_chkr ->
 
 	-- Generate sequel info for use downstream
 	-- At the moment, we only do it if the type is vector-returnable.
@@ -460,7 +454,7 @@ cgEvalAlts cc_slot uniq (StgAlgAlts ty alts deflt)
     	  = if not use_labelled_alts then
 		Nothing -- no semi-tagging info
 	    else
-		cgSemiTaggedAlts uniq alts deflt -- Just <something>
+		cgSemiTaggedAlts isw_chkr uniq alts deflt -- Just <something>
     in
     cgAlgAlts GCMayHappen uniq cc_restore use_labelled_alts ty alts deflt
 					`thenFC` \ (tagged_alt_absCs, deflt_absC) ->
@@ -587,14 +581,17 @@ It's all pretty turgid anyway.
 \begin{code}
 cgAlgAlts gc_flag uniq restore_cc semi_tagging
 	ty alts deflt@(StgBindDefault binder True{-used-} _)
-  = forkAlts (map (cgAlgAlt gc_flag uniq restore_cc semi_tagging) alts)
+  = getIntSwitchChkrC	`thenFC` \ isw_chkr ->
+    let
+	extra_branches :: [FCode (ConTag, AbstractC)]
+	extra_branches = catMaybes (map (mk_extra_branch isw_chkr) default_cons)
+
+	must_label_default = semi_tagging || not (null extra_branches)
+    in
+    forkAlts (map (cgAlgAlt gc_flag uniq restore_cc semi_tagging) alts)
 	     extra_branches
 	     (cgAlgDefault  gc_flag uniq restore_cc must_label_default deflt)
   where
-    extra_branches :: [FCode (ConTag, AbstractC)]
-    extra_branches = catMaybes (map mk_extra_branch default_cons)
-
-    must_label_default = semi_tagging || not (null extra_branches)
 
     default_join_lbl = mkDefaultLabel uniq
     jump_instruction = CJump (CLbl default_join_lbl CodePtrKind)
@@ -620,11 +617,11 @@ cgAlgAlts gc_flag uniq restore_cc semi_tagging
     -- nothing to do. Otherwise, we have a special case for a nullary constructor,
     -- but in the general case we do an allocation and heap-check.
 
-    mk_extra_branch :: DataCon -> (Maybe (FCode (ConTag, AbstractC)))
+    mk_extra_branch :: IntSwitchChecker -> DataCon -> (Maybe (FCode (ConTag, AbstractC)))
 
-    mk_extra_branch con
+    mk_extra_branch isw_chkr con
       = ASSERT(isDataCon con)
-	case dataReturnConvAlg con of
+	case dataReturnConvAlg isw_chkr con of
 	  ReturnInHeap	  -> Nothing
 	  ReturnInRegs rs -> Just (getAbsC (alloc_code rs) `thenFC` \ abs_c ->
 				   returnFC (tag, abs_c)
@@ -728,9 +725,10 @@ cgAlgAlt gc_flag uniq restore_cc must_label_branch (con, args, use_mask, rhs)
 cgAlgAltRhs :: GCFlag -> Id -> [Id] -> [Bool] -> PlainStgExpr -> Code
 
 cgAlgAltRhs gc_flag con args use_mask rhs
-  = let
+  = getIntSwitchChkrC	`thenFC` \ isw_chkr ->
+    let
       (live_regs, node_reqd)
-	= case (dataReturnConvAlg con) of
+	= case (dataReturnConvAlg isw_chkr con) of
 	    ReturnInHeap      -> ([],						  True)
 	    ReturnInRegs regs -> ([reg | (reg,True) <- regs `zipEqual` use_mask], False)
 				-- Pick the live registers using the use_mask
@@ -758,13 +756,14 @@ Turgid-but-non-monadic code to conjure up the required info from
 algebraic case alternatives for semi-tagging.
 
 \begin{code}
-cgSemiTaggedAlts :: Unique
+cgSemiTaggedAlts :: IntSwitchChecker
+		 -> Unique
 		 -> [(Id, [Id], [Bool], PlainStgExpr)]
 		 -> StgCaseDefault Id Id
 		 -> SemiTaggingStuff
 
-cgSemiTaggedAlts uniq alts deflt
-  = Just (map st_alt alts, st_deflt deflt)
+cgSemiTaggedAlts isw_chkr uniq alts deflt
+  = Just (map (st_alt isw_chkr) alts, st_deflt deflt)
   where
     st_deflt StgNoDefault = Nothing
 
@@ -774,13 +773,14 @@ cgSemiTaggedAlts uniq alts deflt
 	       mkDefaultLabel uniq)
 	     )
 
-    st_alt (con, args, use_mask, _)
-      = case (dataReturnConvAlg con) of
+    st_alt isw_chkr (con, args, use_mask, _)
+      = case (dataReturnConvAlg isw_chkr con) of
 
 	  ReturnInHeap ->
 	    -- Ha!  Nothing to do; Node already points to the thing
 	    (con_tag,
-	     (CCallProfCtrMacro SLIT("RET_SEMI_IN_HEAP") [], -- ToDo: monadise?
+	     (CCallProfCtrMacro SLIT("RET_SEMI_IN_HEAP") -- ToDo: monadise?
+			[mkIntCLit (length args)], -- how big the thing in the heap is
 	     join_label)
 	    )
 
@@ -799,7 +799,9 @@ cgSemiTaggedAlts uniq alts deflt
 	    in
 	    (con_tag,
 	     (mkAbstractCs [
-		CCallProfCtrMacro SLIT("RET_SEMI_IN_REGS") [], -- ToDo: macroise?
+		CCallProfCtrMacro SLIT("RET_SEMI_IN_REGS")  -- ToDo: macroise?
+			[mkIntCLit (length regs_w_offsets),
+			 mkIntCLit (length used_regs_w_offsets)],
 		CSimultaneous (mkAbstractCs (map move_to_reg used_regs_w_offsets))],
 	      join_label))
       where
@@ -809,7 +811,6 @@ cgSemiTaggedAlts uniq alts deflt
     move_to_reg :: (MagicId, VirtualHeapOffset {-from Node-}) -> AbstractC
     move_to_reg (reg, offset)
       = CAssign (CReg reg) (CVal (NodeRel offset) (kindFromMagicId reg))
-
 \end{code}
 
 %************************************************************************
diff --git a/ghc/compiler/codeGen/CgClosure.hi b/ghc/compiler/codeGen/CgClosure.hi
index fcdb52d910..36957ad7bd 100644
--- a/ghc/compiler/codeGen/CgClosure.hi
+++ b/ghc/compiler/codeGen/CgClosure.hi
@@ -1,14 +1,13 @@
 {-# GHC_PRAGMA INTERFACE VERSION 5 #-}
 interface CgClosure where
 import AbsCSyn(AbstractC)
-import CgBindery(CgIdInfo, StableLoc, VolatileLoc)
+import CgBindery(CgIdInfo)
 import CgMonad(CgInfoDownwards, CgState, CompilationInfo, EndOfBlockInfo, StubFlag)
 import ClosureInfo(LambdaFormInfo)
 import CmdLineOpts(GlobalSwitch)
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import Maybes(Labda)
 import PreludePS(_PackedString)
 import PrimOps(PrimOp)
@@ -16,17 +15,15 @@ import StgSyn(StgAtom, StgBinderInfo, StgBinding, StgCaseAlternatives, StgExpr,
 import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(Unique)
-data CgIdInfo 	{-# GHC_PRAGMA MkCgIdInfo Id VolatileLoc StableLoc LambdaFormInfo #-}
-data CgInfoDownwards 	{-# GHC_PRAGMA MkCgInfoDown CompilationInfo (UniqFM CgIdInfo) EndOfBlockInfo #-}
-data CgState 	{-# GHC_PRAGMA MkCgState AbstractC (UniqFM CgIdInfo) ((Int, [(Int, StubFlag)], Int, Int), (Int, [Int], Int, Int), (HeapOffset, HeapOffset)) #-}
-data CompilationInfo 	{-# GHC_PRAGMA MkCompInfo (GlobalSwitch -> Bool) _PackedString #-}
+data CgIdInfo 
+data CgInfoDownwards 
+data CgState 
+data CompilationInfo 
 data HeapOffset 
-data Id 	{-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data Labda a 	{-# GHC_PRAGMA Hamna | Ni a #-}
-data StgExpr a b 	{-# GHC_PRAGMA StgApp (StgAtom b) [StgAtom b] (UniqFM b) | StgConApp Id [StgAtom b] (UniqFM b) | StgPrimApp PrimOp [StgAtom b] (UniqFM b) | StgCase (StgExpr a b) (UniqFM b) (UniqFM b) Unique (StgCaseAlternatives a b) | StgLet (StgBinding a b) (StgExpr a b) | StgLetNoEscape (UniqFM b) (UniqFM b) (StgBinding a b) (StgExpr a b) | StgSCC UniType CostCentre (StgExpr a b) #-}
-data UpdateFlag 	{-# GHC_PRAGMA ReEntrant | Updatable | SingleEntry #-}
+data Id 
+data Labda a 
+data StgExpr a b 
+data UpdateFlag 
 cgRhsClosure :: Id -> CostCentre -> StgBinderInfo -> [Id] -> [Id] -> StgExpr Id Id -> LambdaFormInfo -> CgInfoDownwards -> CgState -> ((Id, CgIdInfo), CgState)
-	{-# GHC_PRAGMA _A_ 7 _U_ 222222222 _N_ _S_ "LLLLLLS" _N_ _N_ #-}
 cgTopRhsClosure :: Id -> CostCentre -> StgBinderInfo -> [Id] -> StgExpr Id Id -> LambdaFormInfo -> CgInfoDownwards -> CgState -> ((Id, CgIdInfo), CgState)
-	{-# GHC_PRAGMA _A_ 6 _U_ 22222222 _N_ _N_ _N_ _N_ #-}
 
diff --git a/ghc/compiler/codeGen/CgClosure.lhs b/ghc/compiler/codeGen/CgClosure.lhs
index 93aabe1b6f..677cf2f421 100644
--- a/ghc/compiler/codeGen/CgClosure.lhs
+++ b/ghc/compiler/codeGen/CgClosure.lhs
@@ -434,17 +434,13 @@ closureCodeBody binder_info closure_info cc [] body
 	pprPanic "closureCodeBody:thunk:prim type!" (ppr PprDebug tycon)
     else
 #endif
-    getAbsC body_code 		`thenFC` \ body_absC ->
-#ifndef DPH
-    moduleName			`thenFC` \ mod_name ->
-    absC (CClosureInfoAndCode closure_info body_absC Nothing stdUpd (cl_descr mod_name))
-#else
-    -- Applying a similar scheme to Simon's placing info tables before code...
-    -- ToDo:DPH: update
-    absC (CNativeInfoTableAndCode closure_info
-	    closure_description
-	    (CCodeBlock entry_label body_absC))
-#endif {- Data Parallel Haskell -}
+    getAbsC body_code 	`thenFC` \ body_absC ->
+    moduleName		`thenFC` \ mod_name ->
+    getIntSwitchChkrC	`thenFC` \ isw_chkr ->
+
+    absC (CClosureInfoAndCode closure_info body_absC Nothing
+			      stdUpd (cl_descr mod_name)
+			      (dataConLiveness isw_chkr closure_info))
   where
     cl_descr mod_name = closureDescription mod_name (closureId closure_info) [] body
 
@@ -580,48 +576,24 @@ closureCodeBody binder_info closure_info cc all_args body
 		-- Do the business
 	    funWrapper closure_info arg_regs (cgExpr body)
     in
-#ifndef DPH
  	-- Make a labelled code-block for the slow and fast entry code
     forkAbsC (if slow_code_needed then slow_entry_code else absC AbsCNop)  		
-						        `thenFC` \ slow_abs_c ->
-    forkAbsC fast_entry_code		    		`thenFC` \ fast_abs_c ->
-    moduleName						`thenFC` \ mod_name ->
+				`thenFC` \ slow_abs_c ->
+    forkAbsC fast_entry_code	`thenFC` \ fast_abs_c ->
+    moduleName			`thenFC` \ mod_name ->
+    getIntSwitchChkrC		`thenFC` \ isw_chkr ->
+    
 	-- Now either construct the info table, or put the fast code in alone
 	-- (We never have slow code without an info table)
     absC (
-      if info_table_needed 
-      then
-        CClosureInfoAndCode closure_info slow_abs_c 
-                            (Just fast_abs_c) stdUpd (cl_descr mod_name)
+      if info_table_needed then
+        CClosureInfoAndCode closure_info slow_abs_c (Just fast_abs_c)
+			stdUpd (cl_descr mod_name)
+			(dataConLiveness isw_chkr closure_info)
       else 
 	CCodeBlock fast_label fast_abs_c
     )
-
-  where
-#else
-    -- The info table goes before the slow entry point.
-    forkAbsC slow_entry_code		    		`thenFC` \ slow_abs_c ->
-    forkAbsC fast_entry_code		    		`thenFC` \ fast_abs_c ->
-    moduleName						`thenFC` \ mod_name ->
-    absC (CNativeInfoTableAndCode 
-		closure_info 
-		(closureDescription mod_name id all_args body)
-                (CCodeBlock slow_label 
-		   (AbsCStmts slow_abs_c
-		      (CCodeBlock fast_label 
-				  fast_abs_c))))
   where
-    slow_label = if slow_code_needed then
-			mkStdEntryLabel id
-		 else
-			mkErrorStdEntryLabel
-			-- We may need a pointer to stuff in the info table,
-			-- but if the slow entry code isn't needed, this code
-			-- will never be entered, so we can use a standard 
-			-- panic routine.
-
-#endif {- Data Parallel Haskell -}
-
     lf_info = closureLFInfo closure_info
 
     cl_descr mod_name = closureDescription mod_name id all_args body
@@ -904,8 +876,9 @@ setupUpdate :: ClosureInfo -> Code -> Code	-- Only called for thunks
 
 setupUpdate closure_info code
  = if (closureUpdReqd closure_info) then
-	link_caf_if_needed		`thenFC` \ update_closure ->
-	pushUpdateFrame update_closure vector code
+	link_caf_if_needed	`thenFC` \ update_closure ->
+	getIntSwitchChkrC	`thenFC` \ isw_chkr ->
+    	pushUpdateFrame update_closure (vector isw_chkr) code
    else
 	-- Non-updatable thunks still need a resume-cost-centre "update"
 	-- frame to be pushed if we are doing evaluation profiling.
@@ -942,17 +915,20 @@ setupUpdate closure_info code
 
    closure_label = mkClosureLabel (closureId closure_info)
 
-   vector = case (closureType closure_info) of
+   vector isw_chkr
+     = case (closureType closure_info) of
     	Nothing -> CReg StdUpdRetVecReg
     	Just (spec_tycon, _, spec_datacons) ->
-	    case ctrlReturnConvAlg spec_tycon of
+	    case (ctrlReturnConvAlg spec_tycon) of
     	      UnvectoredReturn 1 -> 
        	    	let
 		    spec_data_con = head spec_datacons
                     only_tag = getDataConTag spec_data_con
-    	    	    direct = case dataReturnConvAlg spec_data_con of
+
+    	    	    direct = case (dataReturnConvAlg isw_chkr spec_data_con) of
     	    	        ReturnInRegs _ -> mkConUpdCodePtrVecLabel spec_tycon only_tag
     	    	    	ReturnInHeap   -> mkStdUpdCodePtrVecLabel spec_tycon only_tag
+
     	    	    vectored = mkStdUpdVecTblLabel spec_tycon
     	    	in
     	    	    CUnVecLbl direct vectored
diff --git a/ghc/compiler/codeGen/CgCompInfo.hi b/ghc/compiler/codeGen/CgCompInfo.hi
index abf7a52c89..9a75ed2346 100644
--- a/ghc/compiler/codeGen/CgCompInfo.hi
+++ b/ghc/compiler/codeGen/CgCompInfo.hi
@@ -2,93 +2,49 @@
 interface CgCompInfo where
 import AbsCSyn(RegRelative)
 import HeapOffs(HeapOffset)
-data RegRelative 	{-# GHC_PRAGMA HpRel HeapOffset HeapOffset | SpARel Int Int | SpBRel Int Int | NodeRel HeapOffset #-}
+data RegRelative 
 cON_UF_SIZE :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [2#] _N_ #-}
 iND_TAG :: Integer
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 lIVENESS_R1 :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [1#] _N_ #-}
 lIVENESS_R2 :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [2#] _N_ #-}
 lIVENESS_R3 :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [4#] _N_ #-}
 lIVENESS_R4 :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [8#] _N_ #-}
 lIVENESS_R5 :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [16#] _N_ #-}
 lIVENESS_R6 :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [32#] _N_ #-}
 lIVENESS_R7 :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [64#] _N_ #-}
 lIVENESS_R8 :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [128#] _N_ #-}
 mAX_Double_REG :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [2#] _N_ #-}
 mAX_FAMILY_SIZE_FOR_VEC_RETURNS :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [8#] _N_ #-}
 mAX_Float_REG :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [4#] _N_ #-}
 mAX_INTLIKE :: Integer
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _#_ int2Integer# [] [16#] _N_ #-}
 mAX_SPEC_ALL_NONPTRS :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [5#] _N_ #-}
 mAX_SPEC_ALL_PTRS :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [12#] _N_ #-}
 mAX_SPEC_MIXED_FIELDS :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [3#] _N_ #-}
 mAX_SPEC_SELECTEE_SIZE :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [12#] _N_ #-}
 mAX_Vanilla_REG :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [8#] _N_ #-}
 mIN_BIG_TUPLE_SIZE :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [16#] _N_ #-}
 mIN_INTLIKE :: Integer
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 mIN_MP_INT_SIZE :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [16#] _N_ #-}
 mIN_SIZE_NonUpdHeapObject :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [1#] _N_ #-}
 mIN_SIZE_NonUpdStaticHeapObject :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [0#] _N_ #-}
 mIN_UPD_SIZE :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [2#] _N_ #-}
 mP_STRUCT_SIZE :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [3#] _N_ #-}
 oTHER_TAG :: Integer
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-}
 sCC_CON_UF_SIZE :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [3#] _N_ #-}
 sCC_STD_UF_SIZE :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [5#] _N_ #-}
 sTD_UF_SIZE :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [4#] _N_ #-}
 spARelToInt :: RegRelative -> Int
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 spBRelToInt :: RegRelative -> Int
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 uF_COST_CENTRE :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [4#] _N_ #-}
 uF_RET :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [0#] _N_ #-}
 uF_SUA :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [2#] _N_ #-}
 uF_SUB :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [1#] _N_ #-}
 uF_UPDATEE :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [3#] _N_ #-}
 uNFOLDING_CHEAP_OP_COST :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [1#] _N_ #-}
 uNFOLDING_CON_DISCOUNT_WEIGHT :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [1#] _N_ #-}
 uNFOLDING_CREATION_THRESHOLD :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [30#] _N_ #-}
 uNFOLDING_DEAR_OP_COST :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [4#] _N_ #-}
 uNFOLDING_NOREP_LIT_COST :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [4#] _N_ #-}
 uNFOLDING_OVERRIDE_THRESHOLD :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [8#] _N_ #-}
 uNFOLDING_USE_THRESHOLD :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [3#] _N_ #-}
 
diff --git a/ghc/compiler/codeGen/CgCompInfo.lhs b/ghc/compiler/codeGen/CgCompInfo.lhs
index 1ea5e045da..56ab5989f6 100644
--- a/ghc/compiler/codeGen/CgCompInfo.lhs
+++ b/ghc/compiler/codeGen/CgCompInfo.lhs
@@ -125,7 +125,7 @@ Constants for semi-tagging; the tags associated with the data
 constructors will start at 0 and go up.
 \begin{code}
 oTHER_TAG = (INFO_OTHER_TAG :: Integer)	-- (-1) unevaluated, probably
-iND_TAG	  = (INFO_IND_TAG   :: Integer) -- (-1) NOT USED, REALLY
+iND_TAG	  = (INFO_IND_TAG   :: Integer) -- (-2) NOT USED, REALLY
 \end{code}
 
 Stuff for liveness masks:
diff --git a/ghc/compiler/codeGen/CgCon.hi b/ghc/compiler/codeGen/CgCon.hi
index f90731dd3c..57c0983534 100644
--- a/ghc/compiler/codeGen/CgCon.hi
+++ b/ghc/compiler/codeGen/CgCon.hi
@@ -7,29 +7,22 @@ import CgBindery(CgIdInfo)
 import CgMonad(CgInfoDownwards, CgState, StubFlag)
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import PreludePS(_PackedString)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import StgSyn(StgAtom)
-import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(Unique)
-data CAddrMode 	{-# GHC_PRAGMA CVal RegRelative PrimKind | CAddr RegRelative | CReg MagicId | CTableEntry CAddrMode CAddrMode PrimKind | CTemp Unique PrimKind | CLbl CLabel PrimKind | CUnVecLbl CLabel CLabel | CCharLike CAddrMode | CIntLike CAddrMode | CString _PackedString | CLit BasicLit | CLitLit _PackedString PrimKind | COffset HeapOffset | CCode AbstractC | CLabelledCode CLabel AbstractC | CJoinPoint Int Int | CMacroExpr PrimKind CExprMacro [CAddrMode] | CCostCentre CostCentre Bool #-}
-data MagicId 	{-# GHC_PRAGMA BaseReg | StkOReg | VanillaReg PrimKind Int# | FloatReg Int# | DoubleReg Int# | TagReg | RetReg | SpA | SuA | SpB | SuB | Hp | HpLim | LivenessReg | ActivityReg | StdUpdRetVecReg | StkStubReg | CurCostCentre | VoidReg #-}
-data CgState 	{-# GHC_PRAGMA MkCgState AbstractC (UniqFM CgIdInfo) ((Int, [(Int, StubFlag)], Int, Int), (Int, [Int], Int, Int), (HeapOffset, HeapOffset)) #-}
-data Id 	{-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data PrimKind 	{-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-}
-data PrimOp
-	{-# GHC_PRAGMA CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp | OrdOp | ChrOp | IntAddOp | IntSubOp | IntMulOp | IntQuotOp | IntDivOp | IntRemOp | IntNegOp | IntAbsOp | AndOp | OrOp | NotOp | SllOp | SraOp | SrlOp | ISllOp | ISraOp | ISrlOp | Int2WordOp | Word2IntOp | Int2AddrOp | Addr2IntOp | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp | Float2IntOp | Int2FloatOp | FloatExpOp | FloatLogOp | FloatSqrtOp | FloatSinOp | FloatCosOp | FloatTanOp | FloatAsinOp | FloatAcosOp | FloatAtanOp | FloatSinhOp | FloatCoshOp | FloatTanhOp | FloatPowerOp | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp | Double2IntOp | Int2DoubleOp | Double2FloatOp | Float2DoubleOp | DoubleExpOp | DoubleLogOp | DoubleSqrtOp | DoubleSinOp | DoubleCosOp | DoubleTanOp | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp | DoublePowerOp | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp | IntegerCmpOp | Integer2IntOp | Int2IntegerOp | Word2IntegerOp | Addr2IntegerOp | FloatEncodeOp | FloatDecodeOp | DoubleEncodeOp | DoubleDecodeOp | NewArrayOp | NewByteArrayOp PrimKind | SameMutableArrayOp | SameMutableByteArrayOp | ReadArrayOp | WriteArrayOp | IndexArrayOp | ReadByteArrayOp PrimKind | WriteByteArrayOp PrimKind | IndexByteArrayOp PrimKind | IndexOffAddrOp PrimKind | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp | NewSynchVarOp | TakeMVarOp | PutMVarOp | ReadIVarOp | WriteIVarOp | MakeStablePtrOp | DeRefStablePtrOp | CCallOp _PackedString Bool Bool [UniType] UniType | ErrorIOPrimOp | ReallyUnsafePtrEqualityOp | SeqOp | ParOp | ForkOp | DelayOp | WaitOp #-}
-data StgAtom a 	{-# GHC_PRAGMA StgVarAtom a | StgLitAtom BasicLit #-}
+data CAddrMode 
+data MagicId 
+data CgState 
+data Id 
+data PrimKind 
+data PrimOp 
+data StgAtom a 
 bindConArgs :: Id -> [Id] -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 2 _U_ 1222 _N_ _S_ "U(LLLS)L" {_A_ 5 _U_ 2222222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 buildDynCon :: Id -> CostCentre -> Id -> [CAddrMode] -> Bool -> CgInfoDownwards -> CgState -> (CgIdInfo, CgState)
-	{-# GHC_PRAGMA _A_ 5 _U_ 2222122 _N_ _S_ "LLLLE" _N_ _N_ #-}
 cgReturnDataCon :: Id -> [CAddrMode] -> Bool -> UniqFM Id -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 6 _U_ 222222 _N_ _S_ "LLLLU(LLU(LLS))L" _N_ _N_ #-}
 cgTopRhsCon :: Id -> Id -> [StgAtom Id] -> Bool -> CgInfoDownwards -> CgState -> ((Id, CgIdInfo), CgState)
-	{-# GHC_PRAGMA _A_ 4 _U_ 222022 _N_ _S_ "LLSA" {_A_ 3 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
diff --git a/ghc/compiler/codeGen/CgCon.lhs b/ghc/compiler/codeGen/CgCon.lhs
index 05ef0e81ec..938582741d 100644
--- a/ghc/compiler/codeGen/CgCon.lhs
+++ b/ghc/compiler/codeGen/CgCon.lhs
@@ -417,7 +417,9 @@ found a $con$.
 bindConArgs :: DataCon -> [Id] -> Code
 bindConArgs con args
   = ASSERT(isDataCon con)
-    case (dataReturnConvAlg con) of
+    getIntSwitchChkrC	`thenFC` \ isw_chkr ->
+
+    case (dataReturnConvAlg isw_chkr con) of
       ReturnInRegs rs  -> bindArgsToRegs args rs
       ReturnInHeap     ->
 	  let
@@ -443,7 +445,8 @@ cgReturnDataCon :: DataCon -> [CAddrMode] -> Bool -> PlainStgLiveVars -> Code
 
 cgReturnDataCon con amodes all_zero_size_args live_vars
   = ASSERT(isDataCon con)
-    getEndOfBlockInfo		`thenFC` \ (EndOfBlockInfo args_spa args_spb sequel) ->
+    getIntSwitchChkrC	`thenFC` \ isw_chkr ->
+    getEndOfBlockInfo	`thenFC` \ (EndOfBlockInfo args_spa args_spb sequel) ->
 
     case sequel of
 
@@ -480,7 +483,7 @@ cgReturnDataCon con amodes all_zero_size_args live_vars
 		-- Ignore the sequel: we've already looked at it above
 
       other_sequel ->	-- The usual case
-	    case dataReturnConvAlg con of
+	    case (dataReturnConvAlg isw_chkr con) of
 
 	      ReturnInHeap	    ->
 			-- BUILD THE OBJECT IN THE HEAP
@@ -497,16 +500,16 @@ cgReturnDataCon con amodes all_zero_size_args live_vars
 		  in
 
 			-- RETURN
-		  profCtrC SLIT("RET_NEW_IN_HEAP") []		`thenC`
+		  profCtrC SLIT("RET_NEW_IN_HEAP") [mkIntCLit (length amodes)] `thenC`
 
 		  performReturn reg_assts (mkStaticAlgReturnCode con (Just info_lbl)) live_vars
 
 	      ReturnInRegs regs  ->
-	    	  let reg_assts = mkAbstractCs (zipWith move_to_reg amodes regs)
+	    	  let
+		      reg_assts = mkAbstractCs (zipWith move_to_reg amodes regs)
 		      info_lbl  = mkPhantomInfoTableLabel con
 	          in
---OLD:WDP:94/06	  evalCostCentreC "SET_RetCC" [CReg CurCostCentre] `thenC`
-		  profCtrC SLIT("RET_NEW_IN_REGS") []		   `thenC`
+		  profCtrC SLIT("RET_NEW_IN_REGS") [mkIntCLit (length amodes)] `thenC`
 
 	    	  performReturn reg_assts (mkStaticAlgReturnCode con (Just info_lbl)) live_vars
   where
diff --git a/ghc/compiler/codeGen/CgConTbls.hi b/ghc/compiler/codeGen/CgConTbls.hi
index 9779b1dc91..e05e367092 100644
--- a/ghc/compiler/codeGen/CgConTbls.hi
+++ b/ghc/compiler/codeGen/CgConTbls.hi
@@ -15,10 +15,9 @@ import TCE(TCE(..))
 import TyCon(TyCon)
 import UniType(UniType)
 import UniqFM(UniqFM)
-data AbstractC 	{-# GHC_PRAGMA AbsCNop | AbsCStmts AbstractC AbstractC | CAssign CAddrMode CAddrMode | CJump CAddrMode | CFallThrough CAddrMode | CReturn CAddrMode ReturnInfo | CSwitch CAddrMode [(BasicLit, AbstractC)] AbstractC | CCodeBlock CLabel AbstractC | CInitHdr ClosureInfo RegRelative CAddrMode Bool | COpStmt [CAddrMode] PrimOp [CAddrMode] Int [MagicId] | CSimultaneous AbstractC | CMacroStmt CStmtMacro [CAddrMode] | CCallProfCtrMacro _PackedString [CAddrMode] | CCallProfCCMacro _PackedString [CAddrMode] | CStaticClosure CLabel ClosureInfo CAddrMode [CAddrMode] | CClosureInfoAndCode ClosureInfo AbstractC (Labda AbstractC) CAddrMode [Char] | CRetVector CLabel [Labda CAddrMode] AbstractC | CRetUnVector CLabel CAddrMode | CFlatRetVector CLabel [CAddrMode] | CCostCentreDecl Bool CostCentre | CClosureUpdInfo AbstractC | CSplitMarker #-}
-data CompilationInfo 	{-# GHC_PRAGMA MkCompInfo (GlobalSwitch -> Bool) _PackedString #-}
+data AbstractC 
+data CompilationInfo 
 type TCE = UniqFM TyCon
-data UniqFM a 	{-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
+data UniqFM a 
 genStaticConBits :: CompilationInfo -> [TyCon] -> FiniteMap TyCon [[Labda UniType]] -> AbstractC
-	{-# GHC_PRAGMA _A_ 3 _U_ 211 _N_ _N_ _N_ _N_ #-}
 
diff --git a/ghc/compiler/codeGen/CgConTbls.lhs b/ghc/compiler/codeGen/CgConTbls.lhs
index b37689f197..22bfa737a9 100644
--- a/ghc/compiler/codeGen/CgConTbls.lhs
+++ b/ghc/compiler/codeGen/CgConTbls.lhs
@@ -36,7 +36,7 @@ import CgRetConv	( dataReturnConvAlg, ctrlReturnConvAlg,
 import CgTailCall	( performReturn, mkStaticAlgReturnCode )
 import CgUsages		( getHpRelOffset )
 import CLabelInfo	( mkConEntryLabel, mkStaticConEntryLabel, 
-    	    	    	  mkInfoTableLabel,
+    	    	    	  --UNUSED: mkInfoTableLabel,
 			  mkClosureLabel, --UNUSED: mkConUpdCodePtrUnvecLabel,
 			  mkConUpdCodePtrVecLabel, mkStdUpdCodePtrVecLabel, 
     	    	    	  mkStdUpdVecTblLabel, CLabel
@@ -44,7 +44,7 @@ import CLabelInfo	( mkConEntryLabel, mkStaticConEntryLabel,
 import ClosureInfo	( layOutStaticClosure, layOutDynCon,
 			  closureSizeWithoutFixedHdr, closurePtrsSize,
 			  fitsMinUpdSize, mkConLFInfo, layOutPhantomClosure,
-			  infoTableLabelFromCI
+			  infoTableLabelFromCI, dataConLiveness
 			)
 import CmdLineOpts	( GlobalSwitch(..) )
 import FiniteMap
@@ -177,14 +177,16 @@ genStaticConBits comp_info gen_tycons tycon_specs
 					(map (mk_upd_label spec_tycon) spec_data_cons)
     ------------------
     mk_upd_label tycon con
-      = case dataReturnConvAlg con of
-	  ReturnInRegs _ -> CLbl (mkConUpdCodePtrVecLabel tycon tag) CodePtrKind
-	  ReturnInHeap   -> CLbl (mkStdUpdCodePtrVecLabel tycon tag) CodePtrKind
+      = CLbl
+        (case (dataReturnConvAlg isw_chkr con) of
+	  ReturnInRegs _ -> mkConUpdCodePtrVecLabel tycon tag
+	  ReturnInHeap   -> mkStdUpdCodePtrVecLabel tycon tag)
+	CodePtrKind
       where
 	tag = getDataConTag con
 
     ------------------
-    (MkCompInfo sw_chkr _) = comp_info
+    (MkCompInfo sw_chkr isw_chkr _) = comp_info
 \end{code}
 
 %************************************************************************
@@ -199,22 +201,16 @@ static closure, for a constructor.
 \begin{code}
 genConInfo :: CompilationInfo -> TyCon -> Id -> AbstractC
 
-genConInfo comp_info tycon data_con
+genConInfo comp_info@(MkCompInfo _ isw_chkr _) tycon data_con
   = mkAbstractCs [
-#ifndef DPH
 		  CSplitMarker,
 		  inregs_upd_maybe,
 		  closure_code,
     	    	  static_code,
-#else
-		  info_table,
-		  CSplitMarker,
-		  static_info_table,
-#endif {- Data Parallel Haskell -}
 		  closure_maybe]
 	-- Order of things is to reduce forward references
   where
-    (closure_info, body_code) = mkConCodeAndInfo data_con
+    (closure_info, body_code) = mkConCodeAndInfo isw_chkr data_con
 
     -- To allow the debuggers, interpreters, etc to cope with static
     -- data structures (ie those built at compile time), we take care that
@@ -228,9 +224,12 @@ genConInfo comp_info tycon data_con
     entry_addr = CLbl entry_label CodePtrKind
     con_descr  = _UNPK_ (getOccurrenceName data_con)
 
-#ifndef DPH
-    closure_code        = CClosureInfoAndCode closure_info body Nothing stdUpd con_descr
-    static_code         = CClosureInfoAndCode static_ci body Nothing stdUpd con_descr
+    closure_code        = CClosureInfoAndCode closure_info body Nothing
+					      stdUpd con_descr
+					      (dataConLiveness isw_chkr closure_info)
+    static_code         = CClosureInfoAndCode static_ci body Nothing
+					      stdUpd con_descr
+					      (dataConLiveness isw_chkr static_ci)
 
     inregs_upd_maybe    = genPhantomUpdInfo comp_info tycon data_con
 
@@ -238,13 +237,6 @@ genConInfo comp_info tycon data_con
 
     tag	    	    	= getDataConTag data_con
 
-#else
-    info_table  	
-      = CNativeInfoTableAndCode closure_info con_descr entry_code
-    static_info_table	
-      = CNativeInfoTableAndCode static_ci con_descr (CJump entry_addr)
-#endif {- Data Parallel Haskell -}
-
     cost_centre = mkCCostCentre dontCareCostCentre -- not worried about static data costs
 
     -- For zero-arity data constructors, or, more accurately,
@@ -269,11 +261,12 @@ genConInfo comp_info tycon data_con
 \end{code}
 
 \begin{code}
-mkConCodeAndInfo :: Id 			-- Data constructor
+mkConCodeAndInfo :: IntSwitchChecker
+		 -> Id 			-- Data constructor
 		 -> (ClosureInfo, Code)	-- The info table
 
-mkConCodeAndInfo con
-  = case (dataReturnConvAlg con) of
+mkConCodeAndInfo isw_chkr con
+  = case (dataReturnConvAlg isw_chkr con) of
 
     ReturnInRegs regs ->
 	let
@@ -281,10 +274,7 @@ mkConCodeAndInfo con
 	      = layOutDynCon con kindFromMagicId regs
 
 	    body_code
-	      = -- OLD: We don't set CC when entering data any more (WDP 94/06)
-		-- lexCostCentreC "ENTER_CC_DCL" [CReg node]		`thenC`
-		-- evalCostCentreC "SET_RetCC_CL" [CReg node]		`thenC`
-		profCtrC SLIT("RET_OLD_IN_REGS") []			`thenC`
+	      = profCtrC SLIT("RET_OLD_IN_REGS") [mkIntCLit (length regs_w_offsets)] `thenC`
 
 		performReturn (mkAbstractCs (map move_to_reg regs_w_offsets))
 			      (mkStaticAlgReturnCode con Nothing {- Info-ptr already loaded-})
@@ -296,13 +286,13 @@ mkConCodeAndInfo con
 	let
 	    (_, _, arg_tys, _) = getDataConSig con
 
-	    (closure_info, _)
+	    (closure_info, arg_things)
 		= layOutDynCon con kindFromType arg_tys
 
 	    body_code
 		= -- OLD: We don't set CC when entering data any more (WDP 94/06)
 		  -- lexCostCentreC "ENTER_CC_DCL" [CReg node]		`thenC`
-		  profCtrC SLIT("RET_OLD_IN_HEAP") []			`thenC`
+		  profCtrC SLIT("RET_OLD_IN_HEAP") [mkIntCLit (length arg_things)] `thenC`
 
 		  performReturn AbsCNop	-- Ptr to thing already in Node
 			        (mkStaticAlgReturnCode con Nothing {- Info-ptr already loaded-})
@@ -327,15 +317,20 @@ Generate the "phantom" info table and update code, iff the constructor returns i
 \begin{code}
 
 genPhantomUpdInfo :: CompilationInfo -> TyCon -> Id{-data con-} -> AbstractC
-genPhantomUpdInfo comp_info tycon data_con 
-  = case dataReturnConvAlg data_con of
 
-      ReturnInHeap -> AbsCNop	-- No need for a phantom update
+genPhantomUpdInfo comp_info@(MkCompInfo _ isw_chkr _) tycon data_con 
+  = case (dataReturnConvAlg isw_chkr data_con) of
+
+      ReturnInHeap -> --OLD: pprTrace "NoPhantom: " (ppr PprDebug data_con) $
+		      AbsCNop	-- No need for a phantom update
 
       ReturnInRegs regs -> 
+	--OLD: pprTrace "YesPhantom! " (ppr PprDebug data_con) $
+	let 
+            phantom_itbl = CClosureInfoAndCode phantom_ci AbsCNop Nothing
+				upd_code con_descr
+				(dataConLiveness isw_chkr phantom_ci)
 
-        let 
-            phantom_itbl = CClosureInfoAndCode phantom_ci AbsCNop Nothing upd_code con_descr
             phantom_ci = layOutPhantomClosure data_con (mkConLFInfo data_con)
       
             con_descr = _UNPK_ (getOccurrenceName data_con)
@@ -371,7 +366,9 @@ genPhantomUpdInfo comp_info tycon data_con
 
 
     	    -- Code for building a new constructor in place over the updatee
-       	    overwrite_code = profCtrC SLIT("UPD_CON_IN_PLACE") []     	`thenC`
+       	    overwrite_code
+	      = profCtrC SLIT("UPD_CON_IN_PLACE")
+			 [mkIntCLit (length regs_w_offsets)]	`thenC`
 	    	absC (mkAbstractCs 
             	  [
     	            CAssign (CReg node) updatee,
@@ -396,8 +393,9 @@ genPhantomUpdInfo comp_info tycon data_con
     	    	    	    	else UPD_INPLACE_PTRS
 
     	    -- Code for allocating a new constructor in the heap
-    	    alloc_code = 
-    	    	let amodes_w_offsets = [ (CReg r, o) | (r,o) <- regs_w_offsets ]
+    	    alloc_code
+	      = let
+		    amodes_w_offsets = [ (CReg r, o) | (r,o) <- regs_w_offsets ]
 	    	in
 		    -- Allocate and build closure specifying upd_new_w_regs
 	    	    allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
@@ -406,13 +404,13 @@ genPhantomUpdInfo comp_info tycon data_con
 	    	    let
 			amode = CAddr hp_rel
     	    	    in
-	    	    	profCtrC SLIT("UPD_CON_IN_NEW") [] `thenC`
-	    	    	absC (mkAbstractCs 
-            	    	  [
-            	    	    CMacroStmt UPD_IND [updatee, amode],
-            	    	    CAssign (CReg node) amode,
-            	    	    CAssign (CReg infoptr) (CLbl info_label DataPtrKind)
-                          ])
+		    profCtrC SLIT("UPD_CON_IN_NEW")
+			     [mkIntCLit (length amodes_w_offsets)] `thenC`
+		    absC (mkAbstractCs 
+		      [ CMacroStmt UPD_IND [updatee, amode],
+			CAssign (CReg node) amode,
+			CAssign (CReg infoptr) (CLbl info_label DataPtrKind)
+		      ])
 
             (closure_info, regs_w_offsets) = layOutDynCon data_con kindFromMagicId regs
             info_label = infoTableLabelFromCI closure_info
diff --git a/ghc/compiler/codeGen/CgExpr.hi b/ghc/compiler/codeGen/CgExpr.hi
index 6d21c17ed7..1167fd33fa 100644
--- a/ghc/compiler/codeGen/CgExpr.hi
+++ b/ghc/compiler/codeGen/CgExpr.hi
@@ -5,20 +5,16 @@ import CgBindery(CgIdInfo)
 import CgMonad(CgInfoDownwards, CgState, StubFlag)
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import PrimOps(PrimOp)
 import StgSyn(StgAtom, StgBinding, StgCaseAlternatives, StgExpr)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(Unique)
-data CgState 	{-# GHC_PRAGMA MkCgState AbstractC (UniqFM CgIdInfo) ((Int, [(Int, StubFlag)], Int, Int), (Int, [Int], Int, Int), (HeapOffset, HeapOffset)) #-}
-data Id 	{-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data StgExpr a b 	{-# GHC_PRAGMA StgApp (StgAtom b) [StgAtom b] (UniqFM b) | StgConApp Id [StgAtom b] (UniqFM b) | StgPrimApp PrimOp [StgAtom b] (UniqFM b) | StgCase (StgExpr a b) (UniqFM b) (UniqFM b) Unique (StgCaseAlternatives a b) | StgLet (StgBinding a b) (StgExpr a b) | StgLetNoEscape (UniqFM b) (UniqFM b) (StgBinding a b) (StgExpr a b) | StgSCC UniType CostCentre (StgExpr a b) #-}
+data CgState 
+data Id 
+data StgExpr a b 
 cgExpr :: StgExpr Id Id -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 1 _U_ 222 _N_ _S_ "S" _N_ _N_ #-}
 cgSccExpr :: StgExpr Id Id -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 1 _U_ 222 _N_ _S_ "S" _N_ _N_ #-}
 getPrimOpArgAmodes :: PrimOp -> [StgAtom Id] -> CgInfoDownwards -> CgState -> ([CAddrMode], CgState)
-	{-# GHC_PRAGMA _A_ 2 _U_ 1222 _N_ _S_ "SL" _N_ _N_ #-}
 
diff --git a/ghc/compiler/codeGen/CgExpr.lhs b/ghc/compiler/codeGen/CgExpr.lhs
index 5974df641d..a8dbbfe5aa 100644
--- a/ghc/compiler/codeGen/CgExpr.lhs
+++ b/ghc/compiler/codeGen/CgExpr.lhs
@@ -98,10 +98,10 @@ Here is where we insert real live machine instructions.
 
 \begin{code}
 cgExpr x@(StgPrimApp op args live_vars)
-  = -- trace ("cgExpr:PrimApp:"++(ppShow 80 (ppr PprDebug x))) (
-    getPrimOpArgAmodes op args			`thenFC` \ arg_amodes ->
+  = getIntSwitchChkrC		`thenFC` \ isw_chkr ->
+    getPrimOpArgAmodes op args	`thenFC` \ arg_amodes ->
     let
-	result_regs   = assignPrimOpResultRegs op
+	result_regs   = assignPrimOpResultRegs {-NO:isw_chkr-} op
 	result_amodes = map CReg result_regs
 	may_gc  = primOpCanTriggerGC op
 	dyn_tag = head result_amodes
@@ -113,19 +113,16 @@ cgExpr x@(StgPrimApp op args live_vars)
 	-- (Can-trigger-gc primops guarantee to have their args in regs)
 	let
 	    (arg_robust_amodes, liveness_mask, arg_assts) 
-	      = makePrimOpArgsRobust op arg_amodes
+	      = makePrimOpArgsRobust {-NO:isw_chkr-} op arg_amodes
 
 	    liveness_arg = mkIntCLit liveness_mask
 	in
  	returnFC (
 	    arg_assts,
-	    mkAbstractCs [
-	      spat_prim_macro,
-	      COpStmt result_amodes op
-		      (pin_liveness op liveness_arg arg_robust_amodes)
-		      liveness_mask
-		      [{-no vol_regs-}],
-	      spat_prim_stop_macro ]
+	    COpStmt result_amodes op
+		    (pin_liveness op liveness_arg arg_robust_amodes)
+		    liveness_mask
+		    [{-no vol_regs-}]
 	)
      else
 	-- Use args from their current amodes.
@@ -133,13 +130,8 @@ cgExpr x@(StgPrimApp op args live_vars)
 	  liveness_mask = panic "cgExpr: liveness of non-GC-ing primop touched\n"
 	in
  	returnFC (
---	  DO NOT want CCallProfMacros in CSimultaneous stuff.  Yurgh.  (WDP 95/01)
---		Arises in compiling PreludeGlaST (and elsewhere??)
---	  mkAbstractCs [
---	    spat_prim_macro,
 	    COpStmt result_amodes op arg_amodes liveness_mask [{-no vol_regs-}],
---	    spat_prim_stop_macro ],
-	  AbsCNop
+	    AbsCNop
 	)
     )				`thenFC` \ (do_before_stack_cleanup,
 					     do_just_before_jump) ->
@@ -157,7 +149,7 @@ cgExpr x@(StgPrimApp op args live_vars)
 
 	ReturnsAlg tycon ->
 --OLD:	    evalCostCentreC "SET_RetCC" [CReg CurCostCentre]	`thenC`	
-	    profCtrC SLIT("RET_NEW_IN_REGS") []			`thenC`
+	    profCtrC SLIT("RET_NEW_IN_REGS") [num_of_fields]	`thenC`
 
 	    performReturn do_before_stack_cleanup
 			  (\ sequel -> robustifySequel may_gc sequel
@@ -189,12 +181,20 @@ cgExpr x@(StgPrimApp op args live_vars)
     	    	    	        dyn_tag DataPtrKind
 
 		data_con = head (getTyConDataCons tycon)
-		dir_lbl  = case dataReturnConvAlg data_con of
-    	    		    	ReturnInRegs _ -> CLbl (mkPhantomInfoTableLabel data_con) 
-						       DataPtrKind
-    	    	    		ReturnInHeap   -> panic "CgExpr: can't return prim in heap"
-					  -- Never used, and no point in generating
-					  -- the code for it!
+
+		(dir_lbl, num_of_fields)
+		  = case (dataReturnConvAlg fake_isw_chkr data_con) of
+		      ReturnInRegs rs
+			-> (CLbl (mkPhantomInfoTableLabel data_con) DataPtrKind,
+--OLD:			    pprTrace "CgExpr:prim datacon:" (ppr PprDebug data_con) $
+			    mkIntCLit (length rs)) -- for ticky-ticky only
+
+    	    	      ReturnInHeap
+			-> pprPanic "CgExpr: can't return prim in heap:" (ppr PprDebug data_con)
+			  -- Never used, and no point in generating
+			  -- the code for it!
+
+		fake_isw_chkr x = Nothing
   where
     -- for all PrimOps except ccalls, we pin the liveness info
     -- on as the first "argument"
@@ -212,10 +212,6 @@ cgExpr x@(StgPrimApp op args live_vars)
 	sequelToAmode sequel			`thenFC` \ amode ->
 	returnFC (CAssign (CReg RetReg) amode, InRetReg)
     robustifySequel _ sequel = returnFC (AbsCNop, sequel)
-    
-    spat_prim_macro	 = CCallProfCtrMacro SLIT("SET_ACTIVITY") [CLitLit SLIT("ACT_PRIM") IntKind]
-    spat_prim_stop_macro = CCallProfCtrMacro SLIT("SET_ACTIVITY") [CLitLit SLIT("ACT_PRIM_STOP") IntKind]
-
 \end{code}
 
 %********************************************************
diff --git a/ghc/compiler/codeGen/CgHeapery.hi b/ghc/compiler/codeGen/CgHeapery.hi
index 43aa7cb90b..5098bba2d8 100644
--- a/ghc/compiler/codeGen/CgHeapery.hi
+++ b/ghc/compiler/codeGen/CgHeapery.hi
@@ -5,29 +5,23 @@ import BasicLit(BasicLit)
 import CLabelInfo(CLabel)
 import CgBindery(CgIdInfo)
 import CgMonad(CgInfoDownwards, CgState, StubFlag)
-import ClosureInfo(ClosureInfo, LambdaFormInfo)
+import ClosureInfo(ClosureInfo)
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import Maybes(Labda)
 import PreludePS(_PackedString)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
-import SMRep(SMRep)
-import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(Unique)
-data AbstractC 	{-# GHC_PRAGMA AbsCNop | AbsCStmts AbstractC AbstractC | CAssign CAddrMode CAddrMode | CJump CAddrMode | CFallThrough CAddrMode | CReturn CAddrMode ReturnInfo | CSwitch CAddrMode [(BasicLit, AbstractC)] AbstractC | CCodeBlock CLabel AbstractC | CInitHdr ClosureInfo RegRelative CAddrMode Bool | COpStmt [CAddrMode] PrimOp [CAddrMode] Int [MagicId] | CSimultaneous AbstractC | CMacroStmt CStmtMacro [CAddrMode] | CCallProfCtrMacro _PackedString [CAddrMode] | CCallProfCCMacro _PackedString [CAddrMode] | CStaticClosure CLabel ClosureInfo CAddrMode [CAddrMode] | CClosureInfoAndCode ClosureInfo AbstractC (Labda AbstractC) CAddrMode [Char] | CRetVector CLabel [Labda CAddrMode] AbstractC | CRetUnVector CLabel CAddrMode | CFlatRetVector CLabel [CAddrMode] | CCostCentreDecl Bool CostCentre | CClosureUpdInfo AbstractC | CSplitMarker #-}
-data CAddrMode 	{-# GHC_PRAGMA CVal RegRelative PrimKind | CAddr RegRelative | CReg MagicId | CTableEntry CAddrMode CAddrMode PrimKind | CTemp Unique PrimKind | CLbl CLabel PrimKind | CUnVecLbl CLabel CLabel | CCharLike CAddrMode | CIntLike CAddrMode | CString _PackedString | CLit BasicLit | CLitLit _PackedString PrimKind | COffset HeapOffset | CCode AbstractC | CLabelledCode CLabel AbstractC | CJoinPoint Int Int | CMacroExpr PrimKind CExprMacro [CAddrMode] | CCostCentre CostCentre Bool #-}
-data CgState 	{-# GHC_PRAGMA MkCgState AbstractC (UniqFM CgIdInfo) ((Int, [(Int, StubFlag)], Int, Int), (Int, [Int], Int, Int), (HeapOffset, HeapOffset)) #-}
-data ClosureInfo 	{-# GHC_PRAGMA MkClosureInfo Id LambdaFormInfo SMRep #-}
+data AbstractC 
+data CAddrMode 
+data CgState 
+data ClosureInfo 
 data HeapOffset 
-data Id 	{-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data Id 
 allocDynClosure :: ClosureInfo -> CAddrMode -> CAddrMode -> [(CAddrMode, HeapOffset)] -> CgInfoDownwards -> CgState -> (HeapOffset, CgState)
-	{-# GHC_PRAGMA _A_ 4 _U_ 222111 _N_ _N_ _N_ _N_ #-}
 allocHeap :: HeapOffset -> CgInfoDownwards -> CgState -> (CAddrMode, CgState)
-	{-# GHC_PRAGMA _A_ 3 _U_ 211 _N_ _S_ "LLU(LLU(LLU(LL)))" {_A_ 5 _U_ 21222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 heapCheck :: [MagicId] -> Bool -> (CgInfoDownwards -> CgState -> CgState) -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 5 _U_ 22221 _N_ _S_ "LLLLU(LLU(LLL))" _N_ _N_ #-}
 
diff --git a/ghc/compiler/codeGen/CgLetNoEscape.hi b/ghc/compiler/codeGen/CgLetNoEscape.hi
index 8f5b0c4b23..0da1a6fb75 100644
--- a/ghc/compiler/codeGen/CgLetNoEscape.hi
+++ b/ghc/compiler/codeGen/CgLetNoEscape.hi
@@ -8,5 +8,4 @@ import Maybes(Labda)
 import StgSyn(StgBinderInfo, StgExpr)
 import UniqFM(UniqFM)
 cgLetNoEscapeClosure :: Id -> CostCentre -> StgBinderInfo -> UniqFM Id -> EndOfBlockInfo -> Labda Int -> [Id] -> StgExpr Id Id -> CgInfoDownwards -> CgState -> ((Id, CgIdInfo), CgState)
-	{-# GHC_PRAGMA _A_ 8 _U_ 2002202212 _N_ _S_ "LAALLALL" {_A_ 5 _U_ 2222212 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
diff --git a/ghc/compiler/codeGen/CgLetNoEscape.lhs b/ghc/compiler/codeGen/CgLetNoEscape.lhs
index abc1e115c9..be887aec5f 100644
--- a/ghc/compiler/codeGen/CgLetNoEscape.lhs
+++ b/ghc/compiler/codeGen/CgLetNoEscape.lhs
@@ -22,7 +22,7 @@ import CgHeapery	( heapCheck )
 import CgRetConv	( assignRegs )
 import CgStackery	( mkVirtStkOffsets )
 import CgUsages		( setRealAndVirtualSps, getVirtSps )
-import CLabelInfo	( mkFastEntryLabel )
+import CLabelInfo	( mkStdEntryLabel )
 import ClosureInfo	( mkLFLetNoEscape )
 import Id		( getIdKind )
 import Util
@@ -151,7 +151,7 @@ cgLetNoEscapeClosure binder cc bi full_live_in_rhss rhs_eob_info maybe_cc_slot a
 	(forkAbsC (cgLetNoEscapeBody args body)) 
 	    	    	    	     	`thenFC` \ (vA, vB, code) ->
     let
-	label = mkFastEntryLabel binder arity
+	label = mkStdEntryLabel binder -- arity
     in
     absC (CCodeBlock label code) `thenC` 
     returnFC (binder, letNoEscapeIdInfo binder vA vB lf_info)
@@ -163,10 +163,11 @@ cgLetNoEscapeBody :: [Id]		-- Args
 		  -> Code
 
 cgLetNoEscapeBody all_args rhs
-  = getVirtSps				`thenFC` \ (vA, vB) ->
+  = getVirtSps		`thenFC` \ (vA, vB) ->
+    getIntSwitchChkrC	`thenFC` \ isw_chkr ->
     let
 	arg_kinds	= map getIdKind all_args
-	(arg_regs, _)	= assignRegs [{-nothing live-}] arg_kinds
+	(arg_regs, _)	= assignRegs isw_chkr [{-nothing live-}] arg_kinds
     	stk_args	= drop (length arg_regs) all_args
 
     	-- stk_args is the args which are passed on the stack at the fast-entry point
diff --git a/ghc/compiler/codeGen/CgMonad.hi b/ghc/compiler/codeGen/CgMonad.hi
index 73a974ecbf..e6fd6fde77 100644
--- a/ghc/compiler/codeGen/CgMonad.hi
+++ b/ghc/compiler/codeGen/CgMonad.hi
@@ -4,206 +4,105 @@ import AbsCSyn(AbstractC, CAddrMode, CExprMacro, CStmtMacro, MagicId, RegRelativ
 import BasicLit(BasicLit)
 import CLabelInfo(CLabel)
 import CgBindery(CgBindings(..), CgIdInfo, StableLoc, VolatileLoc, heapIdInfo, stableAmodeIdInfo)
-import ClosureInfo(ClosureInfo, LambdaFormInfo, StandardFormInfo)
+import ClosureInfo(ClosureInfo, LambdaFormInfo)
 import CmdLineOpts(GlobalSwitch)
-import CostCentre(CcKind, CostCentre, IsCafCC, IsDupdCC)
+import CostCentre(CostCentre, IsCafCC)
 import HeapOffs(HeapOffset, VirtualHeapOffset(..), VirtualSpAOffset(..), VirtualSpBOffset(..))
-import Id(DataCon(..), Id, IdDetails)
+import Id(DataCon(..), Id)
 import IdEnv(IdEnv(..))
-import IdInfo(IdInfo)
 import Maybes(Labda)
 import Outputable(NamedThing, Outputable)
 import PreludePS(_PackedString)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import StgSyn(PlainStgLiveVars(..))
-import UniType(UniType)
 import UniqFM(UniqFM)
 import UniqSet(UniqSet(..))
 import Unique(Unique)
 infixr 9 `thenC`
 infixr 9 `thenFC`
 type AStackUsage = (Int, [(Int, StubFlag)], Int, Int)
-data AbstractC 	{-# GHC_PRAGMA AbsCNop | AbsCStmts AbstractC AbstractC | CAssign CAddrMode CAddrMode | CJump CAddrMode | CFallThrough CAddrMode | CReturn CAddrMode ReturnInfo | CSwitch CAddrMode [(BasicLit, AbstractC)] AbstractC | CCodeBlock CLabel AbstractC | CInitHdr ClosureInfo RegRelative CAddrMode Bool | COpStmt [CAddrMode] PrimOp [CAddrMode] Int [MagicId] | CSimultaneous AbstractC | CMacroStmt CStmtMacro [CAddrMode] | CCallProfCtrMacro _PackedString [CAddrMode] | CCallProfCCMacro _PackedString [CAddrMode] | CStaticClosure CLabel ClosureInfo CAddrMode [CAddrMode] | CClosureInfoAndCode ClosureInfo AbstractC (Labda AbstractC) CAddrMode [Char] | CRetVector CLabel [Labda CAddrMode] AbstractC | CRetUnVector CLabel CAddrMode | CFlatRetVector CLabel [CAddrMode] | CCostCentreDecl Bool CostCentre | CClosureUpdInfo AbstractC | CSplitMarker #-}
+data AbstractC 
 type BStackUsage = (Int, [Int], Int, Int)
-data CAddrMode 	{-# GHC_PRAGMA CVal RegRelative PrimKind | CAddr RegRelative | CReg MagicId | CTableEntry CAddrMode CAddrMode PrimKind | CTemp Unique PrimKind | CLbl CLabel PrimKind | CUnVecLbl CLabel CLabel | CCharLike CAddrMode | CIntLike CAddrMode | CString _PackedString | CLit BasicLit | CLitLit _PackedString PrimKind | COffset HeapOffset | CCode AbstractC | CLabelledCode CLabel AbstractC | CJoinPoint Int Int | CMacroExpr PrimKind CExprMacro [CAddrMode] | CCostCentre CostCentre Bool #-}
+data CAddrMode 
 data CLabel 
 type CgBindings = UniqFM CgIdInfo
-data CgIdInfo 	{-# GHC_PRAGMA MkCgIdInfo Id VolatileLoc StableLoc LambdaFormInfo #-}
+data CgIdInfo 
 data CgInfoDownwards   = MkCgInfoDown CompilationInfo (UniqFM CgIdInfo) EndOfBlockInfo
 data CgState   = MkCgState AbstractC (UniqFM CgIdInfo) ((Int, [(Int, StubFlag)], Int, Int), (Int, [Int], Int, Int), (HeapOffset, HeapOffset))
 type Code = CgInfoDownwards -> CgState -> CgState
-data CompilationInfo   = MkCompInfo (GlobalSwitch -> Bool) _PackedString
-data CostCentre 	{-# GHC_PRAGMA NoCostCentre | NormalCC CcKind _PackedString _PackedString IsDupdCC IsCafCC | CurrentCC | SubsumedCosts | AllCafsCC _PackedString _PackedString | AllDictsCC _PackedString _PackedString IsDupdCC | OverheadCC | PreludeCafsCC | PreludeDictsCC IsDupdCC | DontCareCC #-}
+data CompilationInfo   = MkCompInfo (GlobalSwitch -> Bool) ((Int -> GlobalSwitch) -> Labda Int) _PackedString
+data CostCentre 
 data EndOfBlockInfo   = EndOfBlockInfo Int Int Sequel
 type FCode a = CgInfoDownwards -> CgState -> (a, CgState)
-data GlobalSwitch
-	{-# GHC_PRAGMA ProduceC [Char] | ProduceS [Char] | ProduceHi [Char] | AsmTarget [Char] | ForConcurrent | Haskell_1_3 | GlasgowExts | CompilingPrelude | HideBuiltinNames | HideMostBuiltinNames | EnsureSplittableC [Char] | Verbose | PprStyle_User | PprStyle_Debug | PprStyle_All | DoCoreLinting | EmitArityChecks | OmitInterfacePragmas | OmitDerivedRead | OmitReexportedInstances | UnfoldingUseThreshold Int | UnfoldingCreationThreshold Int | UnfoldingOverrideThreshold Int | ReportWhyUnfoldingsDisallowed | UseGetMentionedVars | ShowPragmaNameErrs | NameShadowingNotOK | SigsRequired | SccProfilingOn | AutoSccsOnExportedToplevs | AutoSccsOnAllToplevs | AutoSccsOnIndividualCafs | SccGroup [Char] | DoTickyProfiling | DoSemiTagging | FoldrBuildOn | FoldrBuildTrace | SpecialiseImports | ShowImportSpecs | OmitUnspecialisedCode | SpecialiseOverloaded | SpecialiseUnboxed | SpecialiseAll | SpecialiseTrace | OmitBlackHoling | StgDoLetNoEscapes | IgnoreStrictnessPragmas | IrrefutableTuples | IrrefutableEverything | AllStrict | AllDemanded | D_dump_rif2hs | D_dump_rn4 | D_dump_tc | D_dump_deriv | D_dump_ds | D_dump_occur_anal | D_dump_simpl | D_dump_spec | D_dump_stranal | D_dump_deforest | D_dump_stg | D_dump_absC | D_dump_flatC | D_dump_realC | D_dump_asm | D_dump_core_passes | D_dump_core_passes_info | D_verbose_core2core | D_verbose_stg2stg | D_simplifier_stats #-}
+data GlobalSwitch 
 data HeapOffset 
 type HeapUsage = (HeapOffset, HeapOffset)
-data LambdaFormInfo 	{-# GHC_PRAGMA LFReEntrant Bool Int Bool | LFCon Id Bool | LFTuple Id Bool | LFThunk Bool Bool Bool StandardFormInfo | LFArgument | LFImported | LFLetNoEscape Int (UniqFM Id) | LFBlackHole | LFIndirection #-}
-data IsCafCC 	{-# GHC_PRAGMA IsCafCC | IsNotCafCC #-}
+type IntSwitchChecker = (Int -> GlobalSwitch) -> Labda Int
+data LambdaFormInfo 
+data IsCafCC 
 type SemiTaggingStuff = Labda ([(Int, (AbstractC, CLabel))], Labda (Labda Id, (AbstractC, CLabel)))
 data Sequel   = InRetReg | OnStack Int | UpdateCode CAddrMode | CaseAlts CAddrMode (Labda ([(Int, (AbstractC, CLabel))], Labda (Labda Id, (AbstractC, CLabel))))
-data StubFlag 	{-# GHC_PRAGMA Stubbed | NotStubbed #-}
+data StubFlag 
 type VirtualHeapOffset = HeapOffset
 type VirtualSpAOffset = Int
 type VirtualSpBOffset = Int
 type DataCon = Id
-data Id 	{-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
+data Id 
 type IdEnv a = UniqFM a
-data Labda a 	{-# GHC_PRAGMA Hamna | Ni a #-}
+data Labda a 
 type PlainStgLiveVars = UniqFM Id
-data UniqFM a 	{-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
+data UniqFM a 
 type UniqSet a = UniqFM a
-data Unique 	{-# GHC_PRAGMA MkUnique Int# #-}
+data Unique 
 absC :: AbstractC -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 3 _U_ 201 _N_ _S_ "LAU(LLL)" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 addBindC :: Id -> CgIdInfo -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 4 _U_ 1201 _N_ _S_ "LLAU(LLL)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 addBindsC :: [(Id, CgIdInfo)] -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 3 _U_ 101 _N_ _S_ "LAU(LLL)" {_A_ 4 _U_ 1222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 addFreeBSlots :: [Int] -> [Int] -> [Int]
-	{-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 costCentresC :: _PackedString -> [CAddrMode] -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 4 _U_ 2211 _N_ _S_ "LLU(U(SA)AA)U(LLL)" {_A_ 4 _U_ 2211 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 costCentresFlag :: CgInfoDownwards -> CgState -> (Bool, CgState)
-	{-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(U(LA)AA)L" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 fixC :: (a -> CgInfoDownwards -> CgState -> (a, CgState)) -> CgInfoDownwards -> CgState -> (a, CgState)
-	{-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "SLL" _N_ _N_ #-}
 forkAbsC :: (CgInfoDownwards -> CgState -> CgState) -> CgInfoDownwards -> CgState -> (AbstractC, CgState)
-	{-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "LLU(LLL)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 forkAlts :: [CgInfoDownwards -> CgState -> (a, CgState)] -> [CgInfoDownwards -> CgState -> (a, CgState)] -> (CgInfoDownwards -> CgState -> (b, CgState)) -> CgInfoDownwards -> CgState -> (([a], b), CgState)
-	{-# GHC_PRAGMA _A_ 5 _U_ 11122 _N_ _N_ _N_ _N_ #-}
 forkClosureBody :: (CgInfoDownwards -> CgState -> CgState) -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(LLA)U(LLL)" {_A_ 4 _U_ 1221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 forkEval :: EndOfBlockInfo -> (CgInfoDownwards -> CgState -> CgState) -> (CgInfoDownwards -> CgState -> (Sequel, CgState)) -> CgInfoDownwards -> CgState -> (EndOfBlockInfo, CgState)
-	{-# GHC_PRAGMA _A_ 3 _U_ 21112 _N_ _N_ _N_ _N_ #-}
 forkEvalHelp :: EndOfBlockInfo -> (CgInfoDownwards -> CgState -> CgState) -> (CgInfoDownwards -> CgState -> (a, CgState)) -> CgInfoDownwards -> CgState -> ((Int, Int, a), CgState)
-	{-# GHC_PRAGMA _A_ 5 _U_ 21112 _N_ _S_ "LLLU(LLA)L" _N_ _N_ #-}
 forkStatics :: (CgInfoDownwards -> CgState -> (a, CgState)) -> CgInfoDownwards -> CgState -> (a, CgState)
-	{-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(LAA)U(LLL)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getAbsC :: (CgInfoDownwards -> CgState -> CgState) -> CgInfoDownwards -> CgState -> (AbstractC, CgState)
-	{-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "LLU(LLL)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getEndOfBlockInfo :: CgInfoDownwards -> CgState -> (EndOfBlockInfo, CgState)
-	{-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(AAL)L" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: EndOfBlockInfo) (u1 :: CgState) -> _!_ _TUP_2 [EndOfBlockInfo, CgState] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CX 4 \ (u0 :: CgInfoDownwards) (u1 :: CgState) -> case u0 of { _ALG_ _ORIG_ CgMonad MkCgInfoDown (u2 :: CompilationInfo) (u3 :: UniqFM CgIdInfo) (u4 :: EndOfBlockInfo) -> _!_ _TUP_2 [EndOfBlockInfo, CgState] [u4, u1]; _NO_DEFLT_ } _N_ #-}
+getIntSwitchChkrC :: CgInfoDownwards -> CgState -> ((Int -> GlobalSwitch) -> Labda Int, CgState)
 getUnstubbedAStackSlots :: Int -> CgInfoDownwards -> CgState -> ([Int], CgState)
-	{-# GHC_PRAGMA _A_ 3 _U_ 201 _N_ _S_ "LAU(LLU(U(LLLL)LL))" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 heapIdInfo :: Id -> HeapOffset -> LambdaFormInfo -> CgIdInfo
-	{-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _N_ _N_ _N_ #-}
 initC :: CompilationInfo -> (CgInfoDownwards -> CgState -> CgState) -> AbstractC
-	{-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LS" _N_ _N_ #-}
 isStringSwitchSetC :: ([Char] -> GlobalSwitch) -> CgInfoDownwards -> CgState -> (Bool, CgState)
-	{-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "LU(U(LA)AA)L" {_A_ 3 _U_ 112 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 isStubbed :: StubFlag -> Bool
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "E" _F_ _IF_ARGS_ 0 1 C 4 \ (u0 :: StubFlag) -> case u0 of { _ALG_ _ORIG_ CgMonad Stubbed  -> _!_ True [] []; _ORIG_ CgMonad NotStubbed  -> _!_ False [] []; _NO_DEFLT_ } _N_ #-}
 isSwitchSetC :: GlobalSwitch -> CgInfoDownwards -> CgState -> (Bool, CgState)
-	{-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "LU(U(LA)AA)L" {_A_ 3 _U_ 212 _N_ _N_ _F_ _IF_ARGS_ 0 3 XXX 6 \ (u0 :: GlobalSwitch) (u1 :: GlobalSwitch -> Bool) (u2 :: CgState) -> let {(u3 :: Bool) = _APP_  u1 [ u0 ]} in _!_ _TUP_2 [Bool, CgState] [u3, u2] _N_} _F_ _ALWAYS_ \ (u0 :: GlobalSwitch) (u1 :: CgInfoDownwards) (u2 :: CgState) -> case u1 of { _ALG_ _ORIG_ CgMonad MkCgInfoDown (u3 :: CompilationInfo) (u4 :: UniqFM CgIdInfo) (u5 :: EndOfBlockInfo) -> case u3 of { _ALG_ _ORIG_ CgMonad MkCompInfo (u6 :: GlobalSwitch -> Bool) (u7 :: _PackedString) -> let {(u8 :: Bool) = _APP_  u6 [ u0 ]} in _!_ _TUP_2 [Bool, CgState] [u8, u2]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 listCs :: [CgInfoDownwards -> CgState -> CgState] -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 3 _U_ 122 _N_ _S_ "SLL" _N_ _N_ #-}
 listFCs :: [CgInfoDownwards -> CgState -> (a, CgState)] -> CgInfoDownwards -> CgState -> ([a], CgState)
-	{-# GHC_PRAGMA _A_ 3 _U_ 122 _N_ _S_ "SLL" _N_ _N_ #-}
 lookupBindC :: Id -> CgInfoDownwards -> CgState -> (CgIdInfo, CgState)
-	{-# GHC_PRAGMA _A_ 3 _U_ 211 _N_ _S_ "LU(ALA)U(LLL)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mapCs :: (a -> CgInfoDownwards -> CgState -> CgState) -> [a] -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 4 _U_ 2122 _N_ _S_ "LSLL" _N_ _N_ #-}
 mapFCs :: (a -> CgInfoDownwards -> CgState -> (b, CgState)) -> [a] -> CgInfoDownwards -> CgState -> ([b], CgState)
-	{-# GHC_PRAGMA _A_ 4 _U_ 2122 _N_ _S_ "LSLL" _N_ _N_ #-}
 modifyBindC :: Id -> (CgIdInfo -> CgIdInfo) -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 4 _U_ 1201 _N_ _S_ "LLAU(LLL)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 moduleName :: CgInfoDownwards -> CgState -> (_PackedString, CgState)
-	{-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(U(AL)AA)L" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: _PackedString) (u1 :: CgState) -> _!_ _TUP_2 [_PackedString, CgState] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CX 5 \ (u0 :: CgInfoDownwards) (u1 :: CgState) -> case u0 of { _ALG_ _ORIG_ CgMonad MkCgInfoDown (u2 :: CompilationInfo) (u3 :: UniqFM CgIdInfo) (u4 :: EndOfBlockInfo) -> case u2 of { _ALG_ _ORIG_ CgMonad MkCompInfo (u5 :: GlobalSwitch -> Bool) (u6 :: _PackedString) -> _!_ _TUP_2 [_PackedString, CgState] [u6, u1]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 noBlackHolingFlag :: CgInfoDownwards -> CgState -> (Bool, CgState)
-	{-# GHC_PRAGMA _A_ 2 _U_ 12 _N_ _S_ "U(U(LA)AA)L" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 nopC :: CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 2 _U_ 01 _N_ _S_ "AU(LLL)" {_A_ 3 _U_ 222 _N_ _N_ _F_ _IF_ARGS_ 0 3 XXX 4 \ (u0 :: AbstractC) (u1 :: UniqFM CgIdInfo) (u2 :: ((Int, [(Int, StubFlag)], Int, Int), (Int, [Int], Int, Int), (HeapOffset, HeapOffset))) -> _!_ _ORIG_ CgMonad MkCgState [] [u0, u1, u2] _N_} _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: CgInfoDownwards) (u1 :: CgState) -> u1 _N_ #-}
 nukeDeadBindings :: UniqFM Id -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 3 _U_ 201 _N_ _S_ "LAU(LLU(U(LLLL)U(LLLL)L))" {_A_ 4 _U_ 2221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 profCtrC :: _PackedString -> [CAddrMode] -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 4 _U_ 2211 _N_ _S_ "LLU(U(SA)AA)U(LLL)" {_A_ 4 _U_ 2211 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 returnFC :: a -> CgInfoDownwards -> CgState -> (a, CgState)
-	{-# GHC_PRAGMA _A_ 3 _U_ 202 _N_ _N_ _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: CgInfoDownwards) (u3 :: CgState) -> _!_ _TUP_2 [u0, CgState] [u1, u3] _N_ #-}
 sequelToAmode :: Sequel -> CgInfoDownwards -> CgState -> (CAddrMode, CgState)
-	{-# GHC_PRAGMA _A_ 3 _U_ 102 _N_ _S_ "SAL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 setEndOfBlockInfo :: EndOfBlockInfo -> (CgInfoDownwards -> CgState -> CgState) -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 4 _U_ 2112 _N_ _S_ "LSU(LLA)L" {_A_ 5 _U_ 21222 _N_ _N_ _F_ _IF_ARGS_ 0 5 XXXXX 8 \ (u0 :: EndOfBlockInfo) (u1 :: CgInfoDownwards -> CgState -> CgState) (u2 :: CompilationInfo) (u3 :: UniqFM CgIdInfo) (u4 :: CgState) -> let {(u5 :: CgInfoDownwards) = _!_ _ORIG_ CgMonad MkCgInfoDown [] [u2, u3, u0]} in _APP_  u1 [ u5, u4 ] _N_} _F_ _ALWAYS_ \ (u0 :: EndOfBlockInfo) (u1 :: CgInfoDownwards -> CgState -> CgState) (u2 :: CgInfoDownwards) (u3 :: CgState) -> case u2 of { _ALG_ _ORIG_ CgMonad MkCgInfoDown (u4 :: CompilationInfo) (u5 :: UniqFM CgIdInfo) (u6 :: EndOfBlockInfo) -> let {(u7 :: CgInfoDownwards) = _!_ _ORIG_ CgMonad MkCgInfoDown [] [u4, u5, u0]} in _APP_  u1 [ u7, u3 ]; _NO_DEFLT_ } _N_ #-}
 stableAmodeIdInfo :: Id -> CAddrMode -> LambdaFormInfo -> CgIdInfo
-	{-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _N_ _N_ _N_ #-}
 thenC :: (CgInfoDownwards -> CgState -> CgState) -> (CgInfoDownwards -> CgState -> a) -> CgInfoDownwards -> CgState -> a
-	{-# GHC_PRAGMA _A_ 4 _U_ 1122 _N_ _S_ "LSLL" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: CgInfoDownwards -> CgState -> CgState) (u2 :: CgInfoDownwards -> CgState -> u0) (u3 :: CgInfoDownwards) (u4 :: CgState) -> let {(u5 :: CgState) = _APP_  u1 [ u3, u4 ]} in _APP_  u2 [ u3, u5 ] _N_ #-}
 thenFC :: (CgInfoDownwards -> CgState -> (a, CgState)) -> (a -> CgInfoDownwards -> CgState -> b) -> CgInfoDownwards -> CgState -> b
-	{-# GHC_PRAGMA _A_ 4 _U_ 1122 _N_ _S_ "LSLL" _F_ _ALWAYS_ _/\_ u0 u1 -> \ (u2 :: CgInfoDownwards -> CgState -> (u0, CgState)) (u3 :: u0 -> CgInfoDownwards -> CgState -> u1) (u4 :: CgInfoDownwards) (u5 :: CgState) -> let {(u6 :: (u0, CgState)) = _APP_  u2 [ u4, u5 ]} in let {(u9 :: u0) = case u6 of { _ALG_ _TUP_2 (u7 :: u0) (u8 :: CgState) -> u7; _NO_DEFLT_ }} in let {(uc :: CgState) = case u6 of { _ALG_ _TUP_2 (ua :: u0) (ub :: CgState) -> ub; _NO_DEFLT_ }} in _APP_  u3 [ u9, u4, uc ] _N_ #-}
 instance Eq CLabel
-	{-# GHC_PRAGMA _M_ CLabelInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(CLabel -> CLabel -> Bool), (CLabel -> CLabel -> Bool)] [_CONSTM_ Eq (==) (CLabel), _CONSTM_ Eq (/=) (CLabel)] _N_
-	 (==) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-	 (/=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-}
 instance Eq GlobalSwitch
-	{-# GHC_PRAGMA _M_ CmdLineOpts {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> Bool)] [_CONSTM_ Eq (==) (GlobalSwitch), _CONSTM_ Eq (/=) (GlobalSwitch)] _N_
-	 (==) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-	 (/=) = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Eq Id
-	{-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Id -> Id -> Bool), (Id -> Id -> Bool)] [_CONSTM_ Eq (==) (Id), _CONSTM_ Eq (/=) (Id)] _N_
-	 (==) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _APP_  _WRKR_ _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_} _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Id) (u1 :: Id) -> case _APP_  _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ True [] []; (u2 :: Int#) -> _!_ False [] [] } _N_,
-	 (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _APP_  _WRKR_ _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_} _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Id) (u1 :: Id) -> case _APP_  _ORIG_ Id cmpId [ u0, u1 ] of { _PRIM_ 0# -> _!_ False [] []; (u2 :: Int#) -> _!_ True [] [] } _N_ #-}
 instance Eq Unique
-	{-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(Unique -> Unique -> Bool), (Unique -> Unique -> Bool)] [_CONSTM_ Eq (==) (Unique), _CONSTM_ Eq (/=) (Unique)] _N_
-	 (==) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ eqInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ eqInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-	 (/=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ eqInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ eqInt# [] [u2, u3] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 instance Ord CLabel
-	{-# GHC_PRAGMA _M_ CLabelInfo {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq CLabel}}, (CLabel -> CLabel -> Bool), (CLabel -> CLabel -> Bool), (CLabel -> CLabel -> Bool), (CLabel -> CLabel -> Bool), (CLabel -> CLabel -> CLabel), (CLabel -> CLabel -> CLabel), (CLabel -> CLabel -> _CMP_TAG)] [_DFUN_ Eq (CLabel), _CONSTM_ Ord (<) (CLabel), _CONSTM_ Ord (<=) (CLabel), _CONSTM_ Ord (>=) (CLabel), _CONSTM_ Ord (>) (CLabel), _CONSTM_ Ord max (CLabel), _CONSTM_ Ord min (CLabel), _CONSTM_ Ord _tagCmp (CLabel)] _N_
-	 (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-	 (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-	 (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-	 (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-	 max = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-	 min = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-	 _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-}
 instance Ord GlobalSwitch
-	{-# GHC_PRAGMA _M_ CmdLineOpts {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq GlobalSwitch}}, (GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> Bool), (GlobalSwitch -> GlobalSwitch -> GlobalSwitch), (GlobalSwitch -> GlobalSwitch -> GlobalSwitch), (GlobalSwitch -> GlobalSwitch -> _CMP_TAG)] [_DFUN_ Eq (GlobalSwitch), _CONSTM_ Ord (<) (GlobalSwitch), _CONSTM_ Ord (<=) (GlobalSwitch), _CONSTM_ Ord (>=) (GlobalSwitch), _CONSTM_ Ord (>) (GlobalSwitch), _CONSTM_ Ord max (GlobalSwitch), _CONSTM_ Ord min (GlobalSwitch), _CONSTM_ Ord _tagCmp (GlobalSwitch)] _N_
-	 (<) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-	 (<=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-	 (>=) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-	 (>) = _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_,
-	 max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-	 min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-	 _tagCmp = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Ord Id
-	{-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Id}}, (Id -> Id -> Bool), (Id -> Id -> Bool), (Id -> Id -> Bool), (Id -> Id -> Bool), (Id -> Id -> Id), (Id -> Id -> Id), (Id -> Id -> _CMP_TAG)] [_DFUN_ Eq (Id), _CONSTM_ Ord (<) (Id), _CONSTM_ Ord (<=) (Id), _CONSTM_ Ord (>=) (Id), _CONSTM_ Ord (>) (Id), _CONSTM_ Ord max (Id), _CONSTM_ Ord min (Id), _CONSTM_ Ord _tagCmp (Id)] _N_
-	 (<) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-	 (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-	 (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-	 (>) = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_,
-	 max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-	 min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-	 _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)AAA)U(U(P)AAA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Ord Unique
-	{-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq Unique}}, (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Bool), (Unique -> Unique -> Unique), (Unique -> Unique -> Unique), (Unique -> Unique -> _CMP_TAG)] [_DFUN_ Eq (Unique), _CONSTM_ Ord (<) (Unique), _CONSTM_ Ord (<=) (Unique), _CONSTM_ Ord (>=) (Unique), _CONSTM_ Ord (>) (Unique), _CONSTM_ Ord max (Unique), _CONSTM_ Ord min (Unique), _CONSTM_ Ord _tagCmp (Unique)] _N_
-	 (<) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ ltInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ ltInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-	 (<=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Int#) (u1 :: Int#) -> _#_ leInt# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> _#_ leInt# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-	 (>=) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ ltInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ ltInt# [] [u2, u3] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-	 (>) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 5 \ (u0 :: Int#) (u1 :: Int#) -> case _#_ leInt# [] [u0, u1] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ } _N_} _F_ _IF_ARGS_ 0 2 CC 7 \ (u0 :: Unique) (u1 :: Unique) -> case u0 of { _ALG_ _ORIG_ Unique MkUnique (u2 :: Int#) -> case u1 of { _ALG_ _ORIG_ Unique MkUnique (u3 :: Int#) -> case _#_ leInt# [] [u2, u3] of { _ALG_ True  -> _!_ False [] []; False  -> _!_ True [] []; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_,
-	 max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-	 min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-	 _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance NamedThing Id
-	{-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 11 _!_ _TUP_10 [(Id -> ExportFlag), (Id -> Bool), (Id -> (_PackedString, _PackedString)), (Id -> _PackedString), (Id -> [_PackedString]), (Id -> SrcLoc), (Id -> Unique), (Id -> Bool), (Id -> UniType), (Id -> Bool)] [_CONSTM_ NamedThing getExportFlag (Id), _CONSTM_ NamedThing isLocallyDefined (Id), _CONSTM_ NamedThing getOrigName (Id), _CONSTM_ NamedThing getOccurrenceName (Id), _CONSTM_ NamedThing getInformingModules (Id), _CONSTM_ NamedThing getSrcLoc (Id), _CONSTM_ NamedThing getTheUnique (Id), _CONSTM_ NamedThing hasType (Id), _CONSTM_ NamedThing getType (Id), _CONSTM_ NamedThing fromPreludeCore (Id)] _N_
-	 getExportFlag = _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_,
-	 isLocallyDefined = _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_,
-	 getOrigName = _A_ 1 _U_ 1 _N_ _S_ "U(LAAS)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
-	 getOccurrenceName = _A_ 1 _U_ 1 _N_ _S_ "U(LAAS)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
-	 getInformingModules = _A_ 1 _U_ 0 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Id) -> _APP_  _TYAPP_  _ORIG_ Util panic { [_PackedString] } [ _NOREP_S_ "getInformingModule:Id" ] _N_,
-	 getSrcLoc = _A_ 1 _U_ 1 _N_ _S_ "U(AALS)" {_A_ 2 _U_ 11 _N_ _N_ _N_ _N_} _N_ _N_,
-	 getTheUnique = _A_ 1 _U_ 1 _N_ _S_ "U(U(P)AAA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ _ORIG_ Unique MkUnique [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> u1; _NO_DEFLT_ } _N_,
-	 hasType = _A_ 1 _U_ 0 _N_ _S_ "A" {_A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ True [] [] _N_} _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: Id) -> _!_ True [] [] _N_,
-	 getType = _A_ 1 _U_ 1 _N_ _S_ "U(ASAA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: UniType) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: Id) -> case u0 of { _ALG_ _ORIG_ Id Id (u1 :: Unique) (u2 :: UniType) (u3 :: IdInfo) (u4 :: IdDetails) -> u2; _NO_DEFLT_ } _N_,
-	 fromPreludeCore = _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Outputable Id
-	{-# GHC_PRAGMA _M_ Id {-dfun-} _A_ 2 _N_ _N_ _N_ _N_ _N_
-	 ppr = _A_ 2 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 instance Text Unique
-	{-# GHC_PRAGMA _M_ Unique {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Unique, [Char])]), (Int -> Unique -> [Char] -> [Char]), ([Char] -> [([Unique], [Char])]), ([Unique] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Unique), _CONSTM_ Text showsPrec (Unique), _CONSTM_ Text readList (Unique), _CONSTM_ Text showList (Unique)] _N_
-	 readsPrec = _A_ 2 _U_ 02 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  _ORIG_ Util panic { ([Char] -> [(Unique, [Char])]) } [ _NOREP_S_ "no readsPrec for Unique", u1 ] _N_,
-	 showsPrec = _A_ 3 _U_ 010 _N_ _S_ "AU(P)A" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 3 XXX 5 \ (u0 :: Int) (u1 :: Unique) (u2 :: [Char]) -> let {(u3 :: _PackedString) = _APP_  _ORIG_ Unique showUnique [ u1 ]} in _APP_  _ORIG_ PreludePS _unpackPS [ u3 ] _N_,
-	 readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
-	 showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
diff --git a/ghc/compiler/codeGen/CgMonad.lhs b/ghc/compiler/codeGen/CgMonad.lhs
index ce063c8aeb..209078743d 100644
--- a/ghc/compiler/codeGen/CgMonad.lhs
+++ b/ghc/compiler/codeGen/CgMonad.lhs
@@ -36,7 +36,7 @@ module CgMonad (
 --	addFreeASlots,	-- no need to export it
 	addFreeBSlots,	-- ToDo: Belong elsewhere
 
-	isSwitchSetC, isStringSwitchSetC,
+	isSwitchSetC, isStringSwitchSetC, getIntSwitchChkrC,
 
 	noBlackHolingFlag,
 	profCtrC, --UNUSED: concurrentC,
@@ -50,7 +50,7 @@ module CgMonad (
 	CgBindings(..),
 	CgInfoDownwards(..), CgState(..),	-- non-abstract
 	CgIdInfo, -- abstract
-	CompilationInfo(..),
+	CompilationInfo(..), IntSwitchChecker(..),
 	GlobalSwitch, -- abstract
 
 	stableAmodeIdInfo, heapIdInfo,
@@ -111,8 +111,11 @@ data CompilationInfo
   = MkCompInfo
 	(GlobalSwitch -> Bool)
 			-- use it to look up whatever we like in command-line flags
+	IntSwitchChecker-- similar; for flags that have an Int assoc.
+			-- with them, notably number of regs available.
 	FAST_STRING	-- the module name
-		
+
+type IntSwitchChecker = (Int -> GlobalSwitch) -> Maybe Int
 
 data CgState
   = MkCgState
@@ -599,17 +602,22 @@ nothing.
 \begin{code}
 isSwitchSetC :: GlobalSwitch -> FCode Bool
 
-isSwitchSetC switch (MkCgInfoDown (MkCompInfo sw_chkr _) _ _) state
+isSwitchSetC switch (MkCgInfoDown (MkCompInfo sw_chkr _ _) _ _) state
   = (sw_chkr switch, state)
 
 isStringSwitchSetC :: (String -> GlobalSwitch) -> FCode Bool
 
-isStringSwitchSetC switch (MkCgInfoDown (MkCompInfo sw_chkr _) _ _) state
+isStringSwitchSetC switch (MkCgInfoDown (MkCompInfo sw_chkr _ _) _ _) state
   = (sw_chkr (switch (panic "isStringSwitchSetC")), state)
 
+getIntSwitchChkrC :: FCode IntSwitchChecker
+
+getIntSwitchChkrC (MkCgInfoDown (MkCompInfo _ isw_chkr _) _ _) state
+  = (isw_chkr, state)
+
 costCentresC :: FAST_STRING -> [CAddrMode] -> Code
 
-costCentresC macro args (MkCgInfoDown (MkCompInfo sw_chkr _) _ _)
+costCentresC macro args (MkCgInfoDown (MkCompInfo sw_chkr _ _) _ _)
 			state@(MkCgState absC binds usage)
   = if sw_chkr SccProfilingOn
     then MkCgState (mkAbsCStmts absC (CCallProfCCMacro macro args)) binds usage
@@ -617,7 +625,7 @@ costCentresC macro args (MkCgInfoDown (MkCompInfo sw_chkr _) _ _)
 
 profCtrC :: FAST_STRING -> [CAddrMode] -> Code
 
-profCtrC macro args (MkCgInfoDown (MkCompInfo sw_chkr _) _ _)
+profCtrC macro args (MkCgInfoDown (MkCompInfo sw_chkr _ _) _ _)
 			state@(MkCgState absC binds usage)
   = if not (sw_chkr DoTickyProfiling)
     then state
@@ -635,7 +643,7 @@ profCtrC macro args (MkCgInfoDown (MkCompInfo sw_chkr _) _ _)
 {- UNUSED, as it happens:
 concurrentC :: AbstractC -> Code
 
-concurrentC more_absC (MkCgInfoDown (MkCompInfo sw_chkr _) _ _)
+concurrentC more_absC (MkCgInfoDown (MkCompInfo sw_chkr _ _) _ _)
 			state@(MkCgState absC binds usage)
   = if not (sw_chkr ForConcurrent)
     then state
@@ -661,17 +669,17 @@ getAbsC code info_down (MkCgState absC binds usage)
 \begin{code}
 noBlackHolingFlag, costCentresFlag :: FCode Bool
 
-noBlackHolingFlag (MkCgInfoDown (MkCompInfo sw_chkr _) _ _) state
+noBlackHolingFlag (MkCgInfoDown (MkCompInfo sw_chkr _ _) _ _) state
   = (sw_chkr OmitBlackHoling, state)
 
-costCentresFlag	  (MkCgInfoDown (MkCompInfo sw_chkr _) _ _) state
+costCentresFlag	  (MkCgInfoDown (MkCompInfo sw_chkr _ _) _ _) state
   = (sw_chkr SccProfilingOn, state)
 \end{code}
 
 \begin{code}
 
 moduleName :: FCode FAST_STRING
-moduleName (MkCgInfoDown (MkCompInfo _ mod_name) _ _) state
+moduleName (MkCgInfoDown (MkCompInfo _ _ mod_name) _ _) state
   = (mod_name, state)
 
 \end{code}
diff --git a/ghc/compiler/codeGen/CgRetConv.hi b/ghc/compiler/codeGen/CgRetConv.hi
index f722d3089d..dd4b59ded3 100644
--- a/ghc/compiler/codeGen/CgRetConv.hi
+++ b/ghc/compiler/codeGen/CgRetConv.hi
@@ -2,38 +2,25 @@
 interface CgRetConv where
 import AbsCSyn(AbstractC, CAddrMode, MagicId)
 import CLabelInfo(CLabel)
-import Class(Class)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import CmdLineOpts(GlobalSwitch)
+import Id(Id)
 import Maybes(Labda)
-import NameTypes(FullName)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import TyCon(TyCon)
-import TyVar(TyVarTemplate)
-import UniType(UniType)
-import Unique(Unique)
-data MagicId 	{-# GHC_PRAGMA BaseReg | StkOReg | VanillaReg PrimKind Int# | FloatReg Int# | DoubleReg Int# | TagReg | RetReg | SpA | SuA | SpB | SuB | Hp | HpLim | LivenessReg | ActivityReg | StdUpdRetVecReg | StkStubReg | CurCostCentre | VoidReg #-}
+data MagicId 
 data CLabel 
 data CtrlReturnConvention   = VectoredReturn Int | UnvectoredReturn Int
 data DataReturnConvention   = ReturnInHeap | ReturnInRegs [MagicId]
-data Id 	{-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data PrimKind 	{-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-}
-data TyCon 	{-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-}
+data Id 
+data PrimKind 
+data TyCon 
 assignPrimOpResultRegs :: PrimOp -> [MagicId]
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
-assignRegs :: [MagicId] -> [PrimKind] -> ([MagicId], [PrimKind])
-	{-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _N_ _N_ #-}
+assignRegs :: ((Int -> GlobalSwitch) -> Labda Int) -> [MagicId] -> [PrimKind] -> ([MagicId], [PrimKind])
 ctrlReturnConvAlg :: TyCon -> CtrlReturnConvention
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
-dataReturnConvAlg :: Id -> DataReturnConvention
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAAS)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+dataReturnConvAlg :: ((Int -> GlobalSwitch) -> Labda Int) -> Id -> DataReturnConvention
 dataReturnConvPrim :: PrimKind -> MagicId
-	{-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "E" _N_ _N_ #-}
 makePrimOpArgsRobust :: PrimOp -> [CAddrMode] -> ([CAddrMode], Int, AbstractC)
-	{-# GHC_PRAGMA _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mkLiveRegsBitMask :: [MagicId] -> Int
-	{-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 noLiveRegsMask :: Int
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 2 _!_ I# [] [0#] _N_ #-}
 
diff --git a/ghc/compiler/codeGen/CgRetConv.lhs b/ghc/compiler/codeGen/CgRetConv.lhs
index 9b6a130124..679b7c07df 100644
--- a/ghc/compiler/codeGen/CgRetConv.lhs
+++ b/ghc/compiler/codeGen/CgRetConv.lhs
@@ -30,7 +30,7 @@ module CgRetConv (
 import AbsCSyn
 
 import AbsPrel		( PrimOp(..), PrimOpResultInfo(..), primOpCanTriggerGC,
-			  getPrimOpResultInfo, PrimKind
+			  getPrimOpResultInfo, integerDataCon, PrimKind
 			  IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
 			  IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
 			)
@@ -41,7 +41,8 @@ import AbsUniType	( getTyConFamilySize, kindFromType, getTyConDataCons,
 			  IF_ATTACK_PRAGMAS(COMMA cmpUniType)
 			)
 import CgCompInfo	-- various things
-
+import CgMonad		( IntSwitchChecker(..) )
+import CmdLineOpts	( GlobalSwitch(..) )
 import Id		( Id, getDataConSig, fIRST_TAG, isDataCon,
 			  DataCon(..), ConTag(..)
 			)
@@ -88,6 +89,7 @@ The register assignment given by a @ReturnInRegs@ obeys three rules:
 
 \begin{code}
 ctrlReturnConvAlg :: TyCon -> CtrlReturnConvention
+
 ctrlReturnConvAlg tycon
   = case (getTyConFamilySize tycon) of
       Nothing -> -- pprPanic "ctrlReturnConvAlg:" (ppr PprDebug tycon)
@@ -111,17 +113,28 @@ types.	If @assign_reg@ runs out of a particular kind of register,
 then it gives up, returning @ReturnInHeap@.
 
 \begin{code}
-dataReturnConvAlg :: DataCon -> DataReturnConvention
+dataReturnConvAlg :: IntSwitchChecker -> DataCon -> DataReturnConvention
 
-dataReturnConvAlg data_con
+dataReturnConvAlg isw_chkr data_con
   = ASSERT(isDataCon data_con)
     case leftover_kinds of
 	[]    ->	ReturnInRegs reg_assignment
 	other ->	ReturnInHeap	-- Didn't fit in registers
   where
     (_, _, arg_tys, _) = getDataConSig data_con
-    (reg_assignment, leftover_kinds) = assignRegs [node,infoptr] 
-    	    	    	    	    	    	  (map kindFromType arg_tys)
+
+    (reg_assignment, leftover_kinds)
+      = assignRegs isw_chkr_to_use
+		   [node, infoptr] -- taken...
+		   (map kindFromType arg_tys)
+ 
+    isw_chkr_to_use = isw_chkr
+{-OLD:
+      = if is_prim_result_ty {-and therefore *ignore* any return-in-regs threshold-}
+	then \ x -> Nothing
+	else isw_chkr
+-}
+    is_prim_result_ty = data_con == integerDataCon -- ***HACK***! (WDP 95/11)
 \end{code}
 
 \begin{code}
@@ -213,7 +226,7 @@ dataReturnConvPrim kind         = DataReg kind 2 -- Don't Hog a Modifier reg.
 
 \begin{code}
 assignPrimOpResultRegs
-    :: PrimOp	-- The constructors in canonical order
+    :: PrimOp		-- The constructors in canonical order
     -> [MagicId]	-- The return regs all concatenated to together,
 			-- (*including* one for the tag if necy)
 
@@ -222,18 +235,23 @@ assignPrimOpResultRegs op
 
 	ReturnsPrim kind -> [dataReturnConvPrim kind]
 
-	ReturnsAlg tycon -> let cons	    = getTyConDataCons tycon
-				result_regs = concat (map get_return_regs cons)
-			    in
-				-- Since R1 is dead, it can hold the tag if necessary
-			    case cons of
-				[_]   -> result_regs
-				other -> (VanillaReg IntKind ILIT(1)) : result_regs
+	ReturnsAlg tycon
+	  -> let
+		cons	    = getTyConDataCons tycon
+		result_regs = concat (map get_return_regs cons)
+	     in
+	     -- As R1 is dead, it can hold the tag if necessary
+	     case cons of
+		[_]   -> result_regs
+		other -> (VanillaReg IntKind ILIT(1)) : result_regs
+  where
+    get_return_regs con
+      = case (dataReturnConvAlg fake_isw_chkr con) of
+	  ReturnInRegs regs -> regs
+	  ReturnInHeap	    -> panic "getPrimOpAlgResultRegs"
 
- where
-   get_return_regs con = case (dataReturnConvAlg con) of
-			      ReturnInHeap	-> panic "getPrimOpAlgResultRegs"
-			      ReturnInRegs regs -> regs
+    fake_isw_chkr :: IntSwitchChecker
+    fake_isw_chkr x = Nothing
 \end{code}
 
 @assignPrimOpArgsRobust@ is used only for primitive ops which may
@@ -263,24 +281,28 @@ makePrimOpArgsRobust op arg_amodes
 	non_robust_amodes = filter (not . amodeCanSurviveGC) arg_amodes
     	arg_kinds = map getAmodeKind non_robust_amodes
 
-	(arg_regs, extra_args) = assignRegs [{-nothing live-}] arg_kinds
+	(arg_regs, extra_args)
+	  = assignRegs fake_isw_chkr [{-nothing live-}] arg_kinds
 
 		-- Check that all the args fit before returning arg_regs
 	final_arg_regs = case extra_args of
 			   []    -> arg_regs
 			   other -> error ("Cannot allocate enough registers for primop (try rearranging code or reducing number of arguments?) " ++ ppShow 80 (ppr PprDebug op))
 
-	arg_assts = mkAbstractCs (zipWith assign_to_reg arg_regs non_robust_amodes)
+	arg_assts = mkAbstractCs (zipWith assign_to_reg final_arg_regs non_robust_amodes)
 	assign_to_reg reg_id amode = CAssign (CReg reg_id) amode
 
     	safe_arg regs arg 
 		| amodeCanSurviveGC arg = (regs, arg) 
     		| otherwise    		= (tail regs, CReg (head regs))
-    	safe_amodes = snd (mapAccumL safe_arg arg_regs arg_amodes)
+    	safe_amodes = snd (mapAccumL safe_arg final_arg_regs arg_amodes)
 
-	liveness_mask = mkLiveRegsBitMask arg_regs
+	liveness_mask = mkLiveRegsBitMask final_arg_regs
     in
     (safe_amodes, liveness_mask, arg_assts)
+  where
+    fake_isw_chkr :: IntSwitchChecker
+    fake_isw_chkr x = Nothing
 \end{code}
 
 %************************************************************************
@@ -297,15 +319,15 @@ any further registers (even though we might have run out of only one kind of
 register); we just return immediately with the left-overs specified.
 
 \begin{code}
-assignRegs  :: [MagicId]	-- Unavailable registers
+assignRegs  :: IntSwitchChecker
+	    -> [MagicId]	-- Unavailable registers
 	    -> [PrimKind]	-- Arg or result kinds to assign
 	    -> ([MagicId],	-- Register assignment in same order
 				-- for *initial segment of* input list
 		[PrimKind])-- leftover kinds
 
-#ifndef DPH
-assignRegs regs_in_use kinds
- = assign_reg kinds [] (mkRegTbl regs_in_use)
+assignRegs isw_chkr regs_in_use kinds
+ = assign_reg kinds [] (mkRegTbl isw_chkr regs_in_use)
  where
 
     assign_reg	:: [PrimKind]  -- arg kinds being scrutinized
@@ -333,53 +355,6 @@ assignRegs regs_in_use kinds
     --  or, I suppose,
     --  (c) we came across a Kind we couldn't handle (this one shouldn't happen)
     assign_reg leftover_ks acc _ = (reverse acc, leftover_ks)
-#else
-assignRegs node_using_Ret1 kinds
- = if node_using_Ret1
-   then assign_reg kinds [] (tail vanillaRegNos) (tail datRegNos)
-   else assign_reg kinds [] vanillaRegNos        (tail datRegNos)
- where
-    assign_reg:: [PrimKind]  -- arg kinds being scrutinized
-	      -> [MagicId]	  -- accum. regs assigned so far (reversed)
-	      -> [Int]	   -- Vanilla Regs (ptr, int, char, float or double)
-	      -> [Int]	   -- Data Regs    (     int, char, float or double)
-	      -> ([MagicId], [PrimKind])
-
-    assign_reg (k:ks) acc (IBOX(p):ptr_regs) dat_regs
-      | isFollowableKind k	 
-      = assign_reg ks (VanillaReg k p:acc) ptr_regs dat_regs
-
-    assign_reg (CharKind:ks) acc ptr_regs (d:dat_regs)
-      = assign_reg ks (DataReg CharKind d:acc) ptr_regs dat_regs
-
-    assign_reg (IntKind:ks) acc ptr_regs (d:dat_regs)
-      = assign_reg ks (DataReg IntKind d:acc) ptr_regs dat_regs
-
-    assign_reg (WordKind:ks) acc ptr_regs (d:dat_regs)
-      = assign_reg ks (DataReg WordKind d:acc) ptr_regs dat_regs
-
-    assign_reg (AddrKind:ks) acc ptr_regs (d:dat_regs)
-      = assign_reg ks (DataReg AddrKind d:acc) ptr_regs dat_regs
-
-    assign_reg (FloatKind:ks) acc ptr_regs (d:dat_regs)
-      = assign_reg ks (DataReg FloatKind d:acc) ptr_regs dat_regs
-
-    -- Notice how doubles take up two data registers....
-    assign_reg (DoubleKind:ks)   acc ptr_regs (IBOX(d1):d2:dat_regs)
-      = assign_reg ks (DoubleReg d1:acc) ptr_regs dat_regs
-
-    assign_reg (VoidKind:ks) acc ptr_regs dat_regs
-      = assign_reg ks (VoidReg:acc) ptr_regs dat_regs
-
-    -- The catch-all.  It can happen because either
-    --	(a) we've assigned all the regs so leftover_ks is []
-    --  (b) we couldn't find a spare register in the appropriate supply
-    --  or, I suppose,
-    --  (c) we came across a Kind we couldn't handle (this one shouldn't happen)
-    --  ToDo Maybe when dataReg becomes empty, we can start using the
-    --       vanilla registers ????
-    assign_reg leftover_ks acc _ _ = (reverse acc, leftover_ks)
-#endif {- Data Parallel Haskell -}
 \end{code}
 
 Register supplies.  Vanilla registers can contain pointers, Ints, Chars.
@@ -389,35 +364,28 @@ vanillaRegNos :: [Int]
 vanillaRegNos	= [1 .. mAX_Vanilla_REG]
 \end{code}
 
-Only a subset of the registers on the DAP can be used to hold pointers (and most
-of these are taken up with things like the heap pointer and stack pointers). 
-However the resulting registers can hold integers, floats or chars. We therefore
-allocate pointer like things into the @vanillaRegNos@ (and Ints Chars or Floats
-if the remaining registers are empty). See NOTE.regsiterMap for an outline of
-the global and local register allocation scheme.
-
-\begin{code}
-#ifdef DPH
-datRegNos ::[Int]		
-datRegNos = [1..mAX_Data_REG]		-- For Ints, Floats, Doubles or Chars
-#endif {- Data Parallel Haskell -}
-\end{code}
-
 Floats and doubles have separate register supplies.
 
 \begin{code}
-#ifndef DPH
 floatRegNos, doubleRegNos :: [Int]
 floatRegNos	= [1 .. mAX_Float_REG]
 doubleRegNos	= [1 .. mAX_Double_REG]
 
-mkRegTbl :: [MagicId] -> ([Int], [Int], [Int])
-mkRegTbl regs_in_use = (ok_vanilla, ok_float, ok_double)
+mkRegTbl :: IntSwitchChecker -> [MagicId] -> ([Int], [Int], [Int])
+
+mkRegTbl isw_chkr regs_in_use
+  = (ok_vanilla, ok_float, ok_double)
   where
-    ok_vanilla = catMaybes (map (select (VanillaReg VoidKind)) vanillaRegNos)
+    ok_vanilla = catMaybes (map (select (VanillaReg VoidKind)) (taker vanillaRegNos))
     ok_float   = catMaybes (map (select FloatReg)	       floatRegNos)
     ok_double  = catMaybes (map (select DoubleReg)	       doubleRegNos)
 
+    taker :: [Int] -> [Int]
+    taker rs
+      = case (isw_chkr ReturnInRegsThreshold) of
+	  Nothing -> rs -- no flag set; use all of them
+	  Just  n -> take n rs
+
     select :: (FAST_INT -> MagicId) -> Int{-cand-} -> Maybe Int
 	-- one we've unboxed the Int, we make a MagicId
 	-- and see if it is already in use; if not, return its number.
@@ -431,6 +399,4 @@ mkRegTbl regs_in_use = (ok_vanilla, ok_float, ok_double)
 	else Nothing
       where
 	not_elem = isn'tIn "mkRegTbl"
-
-#endif {- Data Parallel Haskell -}
 \end{code}
diff --git a/ghc/compiler/codeGen/CgStackery.hi b/ghc/compiler/codeGen/CgStackery.hi
index 25448fd3ad..e9f79db665 100644
--- a/ghc/compiler/codeGen/CgStackery.hi
+++ b/ghc/compiler/codeGen/CgStackery.hi
@@ -14,22 +14,15 @@ import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import UniqFM(UniqFM)
 import Unique(Unique)
-data AbstractC 	{-# GHC_PRAGMA AbsCNop | AbsCStmts AbstractC AbstractC | CAssign CAddrMode CAddrMode | CJump CAddrMode | CFallThrough CAddrMode | CReturn CAddrMode ReturnInfo | CSwitch CAddrMode [(BasicLit, AbstractC)] AbstractC | CCodeBlock CLabel AbstractC | CInitHdr ClosureInfo RegRelative CAddrMode Bool | COpStmt [CAddrMode] PrimOp [CAddrMode] Int [MagicId] | CSimultaneous AbstractC | CMacroStmt CStmtMacro [CAddrMode] | CCallProfCtrMacro _PackedString [CAddrMode] | CCallProfCCMacro _PackedString [CAddrMode] | CStaticClosure CLabel ClosureInfo CAddrMode [CAddrMode] | CClosureInfoAndCode ClosureInfo AbstractC (Labda AbstractC) CAddrMode [Char] | CRetVector CLabel [Labda CAddrMode] AbstractC | CRetUnVector CLabel CAddrMode | CFlatRetVector CLabel [CAddrMode] | CCostCentreDecl Bool CostCentre | CClosureUpdInfo AbstractC | CSplitMarker #-}
-data CAddrMode 	{-# GHC_PRAGMA CVal RegRelative PrimKind | CAddr RegRelative | CReg MagicId | CTableEntry CAddrMode CAddrMode PrimKind | CTemp Unique PrimKind | CLbl CLabel PrimKind | CUnVecLbl CLabel CLabel | CCharLike CAddrMode | CIntLike CAddrMode | CString _PackedString | CLit BasicLit | CLitLit _PackedString PrimKind | COffset HeapOffset | CCode AbstractC | CLabelledCode CLabel AbstractC | CJoinPoint Int Int | CMacroExpr PrimKind CExprMacro [CAddrMode] | CCostCentre CostCentre Bool #-}
-data CgState 	{-# GHC_PRAGMA MkCgState AbstractC (UniqFM CgIdInfo) ((Int, [(Int, StubFlag)], Int, Int), (Int, [Int], Int, Int), (HeapOffset, HeapOffset)) #-}
-data PrimKind 	{-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-}
+data AbstractC 
+data CAddrMode 
+data CgState 
+data PrimKind 
 adjustRealSps :: Int -> Int -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 4 _U_ 2201 _N_ _S_ "LLAU(LLU(U(LLLL)U(LLLL)L))" {_A_ 5 _U_ 22221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 allocAStack :: CgInfoDownwards -> CgState -> (Int, CgState)
-	{-# GHC_PRAGMA _A_ 2 _U_ 01 _N_ _S_ "AU(LLU(U(LLLL)LL))" {_A_ 5 _U_ 22122 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 allocBStack :: Int -> CgInfoDownwards -> CgState -> (Int, CgState)
-	{-# GHC_PRAGMA _A_ 3 _U_ 201 _N_ _S_ "LAU(LLU(LU(LLLL)L))" {_A_ 4 _U_ 2221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 allocUpdateFrame :: Int -> CAddrMode -> ((Int, Int, Int) -> CgInfoDownwards -> CgState -> CgState) -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 5 _U_ 12111 _N_ _S_ "LLSU(LLU(LLS))U(LLU(LU(LLLL)L))" _N_ _N_ #-}
 getFinalStackHW :: (Int -> Int -> CgInfoDownwards -> CgState -> CgState) -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "SLU(LLL)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mkStkAmodes :: Int -> Int -> [CAddrMode] -> CgInfoDownwards -> CgState -> ((Int, Int, AbstractC), CgState)
-	{-# GHC_PRAGMA _A_ 5 _U_ 22201 _N_ _S_ "LLLAU(LLL)" {_A_ 4 _U_ 2221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mkVirtStkOffsets :: Int -> Int -> (a -> PrimKind) -> [a] -> (Int, Int, [(a, Int)], [(a, Int)])
-	{-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 
diff --git a/ghc/compiler/codeGen/CgStackery.lhs b/ghc/compiler/codeGen/CgStackery.lhs
index 3ec30f02ea..cb1a4ece2a 100644
--- a/ghc/compiler/codeGen/CgStackery.lhs
+++ b/ghc/compiler/codeGen/CgStackery.lhs
@@ -158,7 +158,7 @@ allocBStack size info_down (MkCgState absC binds
     find_block :: [VirtualSpBOffset] -> Maybe VirtualSpBOffset
     find_block [] = Nothing
     find_block (slot:slots)
-      | take size (slot:slots) == take size (repeat slot)
+      | take size (slot:slots) == [slot..slot+size-1]
       = Just slot
       | otherwise
       = find_block slots
diff --git a/ghc/compiler/codeGen/CgTailCall.hi b/ghc/compiler/codeGen/CgTailCall.hi
index fe77b1f72b..9cd0eecabc 100644
--- a/ghc/compiler/codeGen/CgTailCall.hi
+++ b/ghc/compiler/codeGen/CgTailCall.hi
@@ -5,40 +5,29 @@ import BasicLit(BasicLit)
 import CLabelInfo(CLabel)
 import CgBindery(CgIdInfo)
 import CgMonad(CgInfoDownwards, CgState, CompilationInfo, EndOfBlockInfo, Sequel, StubFlag)
-import Class(Class)
 import ClosureInfo(LambdaFormInfo)
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import Maybes(Labda)
-import NameTypes(FullName)
 import PreludePS(_PackedString)
 import PrimKind(PrimKind)
 import StgSyn(StgAtom)
 import TyCon(TyCon)
-import TyVar(TyVarTemplate)
-import UniType(UniType)
 import UniqFM(UniqFM)
 import Unique(Unique)
-data CAddrMode 	{-# GHC_PRAGMA CVal RegRelative PrimKind | CAddr RegRelative | CReg MagicId | CTableEntry CAddrMode CAddrMode PrimKind | CTemp Unique PrimKind | CLbl CLabel PrimKind | CUnVecLbl CLabel CLabel | CCharLike CAddrMode | CIntLike CAddrMode | CString _PackedString | CLit BasicLit | CLitLit _PackedString PrimKind | COffset HeapOffset | CCode AbstractC | CLabelledCode CLabel AbstractC | CJoinPoint Int Int | CMacroExpr PrimKind CExprMacro [CAddrMode] | CCostCentre CostCentre Bool #-}
-data CgInfoDownwards 	{-# GHC_PRAGMA MkCgInfoDown CompilationInfo (UniqFM CgIdInfo) EndOfBlockInfo #-}
-data CgState 	{-# GHC_PRAGMA MkCgState AbstractC (UniqFM CgIdInfo) ((Int, [(Int, StubFlag)], Int, Int), (Int, [Int], Int, Int), (HeapOffset, HeapOffset)) #-}
+data CAddrMode 
+data CgInfoDownwards 
+data CgState 
 data HeapOffset 
-data Id 	{-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data Labda a 	{-# GHC_PRAGMA Hamna | Ni a #-}
-data StgAtom a 	{-# GHC_PRAGMA StgVarAtom a | StgLitAtom BasicLit #-}
-data TyCon 	{-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-}
+data Id 
+data Labda a 
+data StgAtom a 
+data TyCon 
 cgTailCall :: StgAtom Id -> [StgAtom Id] -> UniqFM Id -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 3 _U_ 12222 _N_ _S_ "SSL" _N_ _N_ #-}
 mkDynamicAlgReturnCode :: TyCon -> CAddrMode -> Sequel -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 3 _U_ 12222 _N_ _S_ "SLS" _N_ _N_ #-}
 mkPrimReturnCode :: Sequel -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _S_ "SLL" _N_ _N_ #-}
 mkStaticAlgReturnCode :: Id -> Labda CLabel -> Sequel -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 3 _U_ 21222 _N_ _S_ "LLS" _N_ _N_ #-}
 performReturn :: AbstractC -> (Sequel -> CgInfoDownwards -> CgState -> CgState) -> UniqFM Id -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 5 _U_ 21221 _N_ _S_ "LSLU(LLU(LLL))L" _N_ _N_ #-}
 tailCallBusiness :: Id -> CAddrMode -> LambdaFormInfo -> [CAddrMode] -> UniqFM Id -> AbstractC -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 6 _U_ 22222222 _N_ _S_ "LSLLLL" _N_ _N_ #-}
 
diff --git a/ghc/compiler/codeGen/CgTailCall.lhs b/ghc/compiler/codeGen/CgTailCall.lhs
index a292b04525..c2ece1ee2c 100644
--- a/ghc/compiler/codeGen/CgTailCall.lhs
+++ b/ghc/compiler/codeGen/CgTailCall.lhs
@@ -169,8 +169,8 @@ mkStaticAlgReturnCode :: Id		-- The constructor
 mkStaticAlgReturnCode con maybe_info_lbl sequel
   =	-- Generate profiling code if necessary
     (case return_convention of
-	VectoredReturn _ -> profCtrC SLIT("VEC_RETURN") []
-	other		 -> nopC
+	VectoredReturn sz -> profCtrC SLIT("VEC_RETURN") [mkIntCLit sz]
+	other		  -> nopC
     )					`thenC`
 
 	-- Set tag if necessary
@@ -194,7 +194,8 @@ mkStaticAlgReturnCode con maybe_info_lbl sequel
 
 				-- Set the info pointer, and jump
 			set_info_ptr		`thenC`
-			absC (CJump (CLbl update_label CodePtrKind))
+			getIntSwitchChkrC	`thenFC` \ isw_chkr ->
+    			absC (CJump (CLbl (update_label isw_chkr) CodePtrKind))
 
 	CaseAlts _ (Just (alts, _)) ->	-- Ho! We know the constructor so
 					-- we can go right to the alternative
@@ -224,9 +225,10 @@ mkStaticAlgReturnCode con maybe_info_lbl sequel
     zero_indexed_tag  = tag - fIRST_TAG	      -- Adjust tag to be zero-indexed
 					      -- cf AbsCFuns.mkAlgAltsCSwitch
 
-    update_label      = case dataReturnConvAlg con of
-			    ReturnInHeap   -> mkStdUpdCodePtrVecLabel tycon tag
-			    ReturnInRegs _ -> mkConUpdCodePtrVecLabel tycon tag
+    update_label isw_chkr
+      = case (dataReturnConvAlg isw_chkr con) of
+	  ReturnInHeap   -> mkStdUpdCodePtrVecLabel tycon tag
+	  ReturnInRegs _ -> mkConUpdCodePtrVecLabel tycon tag
 
     return_info = case return_convention of
 			UnvectoredReturn _ -> DirectReturn
@@ -241,9 +243,9 @@ mkDynamicAlgReturnCode :: TyCon -> CAddrMode -> Sequel -> Code
 
 mkDynamicAlgReturnCode tycon dyn_tag sequel
   = case ctrlReturnConvAlg tycon of
-	VectoredReturn _ ->	
+	VectoredReturn sz ->
 
-		profCtrC SLIT("VEC_RETURN") []	`thenC`
+		profCtrC SLIT("VEC_RETURN") [mkIntCLit sz] `thenC`
 		sequelToAmode sequel		`thenFC` \ ret_addr ->	
 		absC (CReturn ret_addr (DynamicVectoredReturn dyn_tag))
 
@@ -321,9 +323,7 @@ tailCallBusiness :: Id -> CAddrMode	-- Function and its amode
 		 -> Code
 
 tailCallBusiness fun fun_amode lf_info arg_amodes live_vars pending_assts
-  = profCtrC SLIT("SET_ACTIVITY") [CLitLit SLIT("ACT_TAILCALL") IntKind]  `thenC`
-
-    isSwitchSetC EmitArityChecks		`thenFC` \ do_arity_chks ->
+  = isSwitchSetC EmitArityChecks		`thenFC` \ do_arity_chks ->
 
     nodeMustPointToIt lf_info			`thenFC` \ node_points ->
     getEntryConvention fun lf_info
@@ -446,8 +446,6 @@ tailCallBusiness fun fun_amode lf_info arg_amodes live_vars pending_assts
 		-- Here, lit.3 is built as a re-entrant thing, which you must enter.
 		-- (OK, the simplifier should have eliminated this, but it's
 		--  easy to deal with the case anyway.)
-
-
 		let
 		    join_details_to_code (load_regs_and_profiling_code, join_lbl)
 			= load_regs_and_profiling_code		`mkAbsCStmts`
@@ -458,14 +456,13 @@ tailCallBusiness fun fun_amode lf_info arg_amodes live_vars pending_assts
 				       | (tag, join_details) <- st_alts
 				       ]
 
-			-- This alternative is for the unevaluated case; oTHER_TAG is -1
-		    un_evald_alt = (mkMachInt oTHER_TAG, enter_jump)
-
-		    enter_jump = CJump (CMacroExpr CodePtrKind ENTRY_CODE [CReg infoptr])
+		    enter_jump
 		      -- Enter Node (we know infoptr will have the info ptr in it)!
-
+		      = mkAbstractCs [
+			CCallProfCtrMacro SLIT("RET_SEMI_FAILED")
+					[CMacroExpr IntKind INFO_TAG [CReg infoptr]],
+			CJump (CMacroExpr CodePtrKind ENTRY_CODE [CReg infoptr]) ]
 		in
-
 			-- Final switch
 		absC (mkAbstractCs [
 			    CAssign (CReg infoptr)
diff --git a/ghc/compiler/codeGen/CgUpdate.hi b/ghc/compiler/codeGen/CgUpdate.hi
index 0ff61fa02a..6762d3ef89 100644
--- a/ghc/compiler/codeGen/CgUpdate.hi
+++ b/ghc/compiler/codeGen/CgUpdate.hi
@@ -3,5 +3,4 @@ interface CgUpdate where
 import AbsCSyn(CAddrMode)
 import CgMonad(CgInfoDownwards, CgState)
 pushUpdateFrame :: CAddrMode -> CAddrMode -> (CgInfoDownwards -> CgState -> CgState) -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 5 _U_ 22222 _N_ _S_ "LLSU(U(LL)LU(LLS))U(LLU(LU(LLLL)L))" _N_ _N_ #-}
 
diff --git a/ghc/compiler/codeGen/CgUsages.hi b/ghc/compiler/codeGen/CgUsages.hi
index 0a1ecaf7ca..b41e473609 100644
--- a/ghc/compiler/codeGen/CgUsages.hi
+++ b/ghc/compiler/codeGen/CgUsages.hi
@@ -12,28 +12,18 @@ import Maybes(Labda)
 import PreludePS(_PackedString)
 import PrimOps(PrimOp)
 import UniqFM(UniqFM)
-data AbstractC 	{-# GHC_PRAGMA AbsCNop | AbsCStmts AbstractC AbstractC | CAssign CAddrMode CAddrMode | CJump CAddrMode | CFallThrough CAddrMode | CReturn CAddrMode ReturnInfo | CSwitch CAddrMode [(BasicLit, AbstractC)] AbstractC | CCodeBlock CLabel AbstractC | CInitHdr ClosureInfo RegRelative CAddrMode Bool | COpStmt [CAddrMode] PrimOp [CAddrMode] Int [MagicId] | CSimultaneous AbstractC | CMacroStmt CStmtMacro [CAddrMode] | CCallProfCtrMacro _PackedString [CAddrMode] | CCallProfCCMacro _PackedString [CAddrMode] | CStaticClosure CLabel ClosureInfo CAddrMode [CAddrMode] | CClosureInfoAndCode ClosureInfo AbstractC (Labda AbstractC) CAddrMode [Char] | CRetVector CLabel [Labda CAddrMode] AbstractC | CRetUnVector CLabel CAddrMode | CFlatRetVector CLabel [CAddrMode] | CCostCentreDecl Bool CostCentre | CClosureUpdInfo AbstractC | CSplitMarker #-}
-data RegRelative 	{-# GHC_PRAGMA HpRel HeapOffset HeapOffset | SpARel Int Int | SpBRel Int Int | NodeRel HeapOffset #-}
-data CgState 	{-# GHC_PRAGMA MkCgState AbstractC (UniqFM CgIdInfo) ((Int, [(Int, StubFlag)], Int, Int), (Int, [Int], Int, Int), (HeapOffset, HeapOffset)) #-}
+data AbstractC 
+data RegRelative 
+data CgState 
 data HeapOffset 
 freeBStkSlot :: Int -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 3 _U_ 201 _N_ _S_ "LAU(LLU(LU(LLLL)L))" {_A_ 4 _U_ 2221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getHpRelOffset :: HeapOffset -> CgInfoDownwards -> CgState -> (RegRelative, CgState)
-	{-# GHC_PRAGMA _A_ 3 _U_ 201 _N_ _S_ "LAU(LLU(LLU(LL)))" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getSpARelOffset :: Int -> CgInfoDownwards -> CgState -> (RegRelative, CgState)
-	{-# GHC_PRAGMA _A_ 3 _U_ 201 _N_ _S_ "LAU(LLU(U(LLLL)LL))" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getSpBRelOffset :: Int -> CgInfoDownwards -> CgState -> (RegRelative, CgState)
-	{-# GHC_PRAGMA _A_ 3 _U_ 201 _N_ _S_ "LAU(LLU(LU(LLLL)L))" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 getVirtAndRealHp :: CgInfoDownwards -> CgState -> ((HeapOffset, HeapOffset), CgState)
-	{-# GHC_PRAGMA _A_ 2 _U_ 01 _N_ _S_ "AU(LLU(LLU(LL)))" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 2 XC 6 \ (u0 :: CgInfoDownwards) (u1 :: CgState) -> case u1 of { _ALG_ _ORIG_ CgMonad MkCgState (u2 :: AbstractC) (u3 :: UniqFM CgIdInfo) (u4 :: ((Int, [(Int, StubFlag)], Int, Int), (Int, [Int], Int, Int), (HeapOffset, HeapOffset))) -> case u4 of { _ALG_ _TUP_3 (u5 :: (Int, [(Int, StubFlag)], Int, Int)) (u6 :: (Int, [Int], Int, Int)) (u7 :: (HeapOffset, HeapOffset)) -> case u7 of { _ALG_ _TUP_2 (u8 :: HeapOffset) (u9 :: HeapOffset) -> _!_ _TUP_2 [(HeapOffset, HeapOffset), CgState] [u7, u1]; _NO_DEFLT_ }; _NO_DEFLT_ }; _NO_DEFLT_ } _N_ #-}
 getVirtSps :: CgInfoDownwards -> CgState -> ((Int, Int), CgState)
-	{-# GHC_PRAGMA _A_ 2 _U_ 01 _N_ _S_ "AU(LLU(U(LLLL)U(LLLL)L))" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 initHeapUsage :: (HeapOffset -> CgInfoDownwards -> CgState -> CgState) -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLU(LLU(LLL))" {_A_ 5 _U_ 22221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 setRealAndVirtualSps :: Int -> Int -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 4 _U_ 2201 _N_ _S_ "LLAU(LLU(U(ALAA)U(ALAA)L))" {_A_ 5 _U_ 22221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 setRealHp :: HeapOffset -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 3 _U_ 201 _N_ _S_ "LAU(LLU(LLU(LA)))" {_A_ 4 _U_ 2221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 setVirtHp :: HeapOffset -> CgInfoDownwards -> CgState -> CgState
-	{-# GHC_PRAGMA _A_ 3 _U_ 201 _N_ _S_ "LAU(LLU(LLU(AL)))" {_A_ 4 _U_ 2221 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 
diff --git a/ghc/compiler/codeGen/ClosureInfo.hi b/ghc/compiler/codeGen/ClosureInfo.hi
index 8914c9fe26..95addbc841 100644
--- a/ghc/compiler/codeGen/ClosureInfo.hi
+++ b/ghc/compiler/codeGen/ClosureInfo.hi
@@ -2,168 +2,105 @@
 interface ClosureInfo where
 import AbsCSyn(AbstractC, CAddrMode, CExprMacro, CStmtMacro, MagicId, RegRelative, ReturnInfo)
 import BasicLit(BasicLit)
-import CLabelInfo(CLabel, mkClosureLabel)
-import CgBindery(CgIdInfo, StableLoc, VolatileLoc)
+import CLabelInfo(CLabel)
+import CgBindery(CgIdInfo)
 import CgMonad(CgInfoDownwards, CgState, CompilationInfo, EndOfBlockInfo, FCode(..), StubFlag)
-import Class(Class)
 import CmdLineOpts(GlobalSwitch)
 import CostCentre(CostCentre)
 import HeapOffs(HeapOffset)
-import Id(DataCon(..), Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(DataCon(..), Id)
 import Maybes(Labda)
-import NameTypes(FullName)
 import PreludePS(_PackedString)
 import PrimKind(PrimKind)
 import PrimOps(PrimOp)
 import SMRep(SMRep, SMSpecRepKind, SMUpdateKind, getSMInfoStr, getSMInitHdrStr, getSMUpdInplaceHdrStr, ltSMRepHdr)
 import StgSyn(PlainStgAtom(..), PlainStgExpr(..), PlainStgLiveVars(..), StgAtom, StgBinderInfo, StgBinding, StgCaseAlternatives, StgExpr, UpdateFlag(..))
 import TyCon(TyCon)
-import TyVar(TyVarTemplate)
-import UniTyFuns(getUniDataSpecTyCon_maybe)
 import UniType(UniType)
 import UniqFM(UniqFM)
 import UniqSet(UniqSet(..))
 import Unique(Unique)
-data AbstractC 	{-# GHC_PRAGMA AbsCNop | AbsCStmts AbstractC AbstractC | CAssign CAddrMode CAddrMode | CJump CAddrMode | CFallThrough CAddrMode | CReturn CAddrMode ReturnInfo | CSwitch CAddrMode [(BasicLit, AbstractC)] AbstractC | CCodeBlock CLabel AbstractC | CInitHdr ClosureInfo RegRelative CAddrMode Bool | COpStmt [CAddrMode] PrimOp [CAddrMode] Int [MagicId] | CSimultaneous AbstractC | CMacroStmt CStmtMacro [CAddrMode] | CCallProfCtrMacro _PackedString [CAddrMode] | CCallProfCCMacro _PackedString [CAddrMode] | CStaticClosure CLabel ClosureInfo CAddrMode [CAddrMode] | CClosureInfoAndCode ClosureInfo AbstractC (Labda AbstractC) CAddrMode [Char] | CRetVector CLabel [Labda CAddrMode] AbstractC | CRetUnVector CLabel CAddrMode | CFlatRetVector CLabel [CAddrMode] | CCostCentreDecl Bool CostCentre | CClosureUpdInfo AbstractC | CSplitMarker #-}
-data CAddrMode 	{-# GHC_PRAGMA CVal RegRelative PrimKind | CAddr RegRelative | CReg MagicId | CTableEntry CAddrMode CAddrMode PrimKind | CTemp Unique PrimKind | CLbl CLabel PrimKind | CUnVecLbl CLabel CLabel | CCharLike CAddrMode | CIntLike CAddrMode | CString _PackedString | CLit BasicLit | CLitLit _PackedString PrimKind | COffset HeapOffset | CCode AbstractC | CLabelledCode CLabel AbstractC | CJoinPoint Int Int | CMacroExpr PrimKind CExprMacro [CAddrMode] | CCostCentre CostCentre Bool #-}
-data MagicId 	{-# GHC_PRAGMA BaseReg | StkOReg | VanillaReg PrimKind Int# | FloatReg Int# | DoubleReg Int# | TagReg | RetReg | SpA | SuA | SpB | SuB | Hp | HpLim | LivenessReg | ActivityReg | StdUpdRetVecReg | StkStubReg | CurCostCentre | VoidReg #-}
+data AbstractC 
+data CAddrMode 
+data MagicId 
 data CLabel 
-data CgIdInfo 	{-# GHC_PRAGMA MkCgIdInfo Id VolatileLoc StableLoc LambdaFormInfo #-}
-data CgInfoDownwards 	{-# GHC_PRAGMA MkCgInfoDown CompilationInfo (UniqFM CgIdInfo) EndOfBlockInfo #-}
-data CgState 	{-# GHC_PRAGMA MkCgState AbstractC (UniqFM CgIdInfo) ((Int, [(Int, StubFlag)], Int, Int), (Int, [Int], Int, Int), (HeapOffset, HeapOffset)) #-}
-data ClosureInfo 	{-# GHC_PRAGMA MkClosureInfo Id LambdaFormInfo SMRep #-}
-data CompilationInfo 	{-# GHC_PRAGMA MkCompInfo (GlobalSwitch -> Bool) _PackedString #-}
+data CgIdInfo 
+data CgInfoDownwards 
+data CgState 
+data ClosureInfo 
+data CompilationInfo 
 data EntryConvention   = ViaNode | StdEntry CLabel (Labda CLabel) | DirectEntry CLabel Int [MagicId]
 type FCode a = CgInfoDownwards -> CgState -> (a, CgState)
 data HeapOffset 
 type DataCon = Id
-data Id 	{-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data Labda a 	{-# GHC_PRAGMA Hamna | Ni a #-}
-data LambdaFormInfo 	{-# GHC_PRAGMA LFReEntrant Bool Int Bool | LFCon Id Bool | LFTuple Id Bool | LFThunk Bool Bool Bool StandardFormInfo | LFArgument | LFImported | LFLetNoEscape Int (UniqFM Id) | LFBlackHole | LFIndirection #-}
-data PrimKind 	{-# GHC_PRAGMA PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind #-}
-data SMRep 	{-# GHC_PRAGMA StaticRep Int Int | SpecialisedRep SMSpecRepKind Int Int SMUpdateKind | GenericRep Int Int SMUpdateKind | BigTupleRep Int | DataRep Int | DynamicRep | BlackHoleRep | PhantomRep | MuTupleRep Int #-}
+data Id 
+data Labda a 
+data LambdaFormInfo 
+data PrimKind 
+data SMRep 
 type PlainStgAtom = StgAtom Id
 type PlainStgExpr = StgExpr Id Id
 type PlainStgLiveVars = UniqFM Id
-data StandardFormInfo 	{-# GHC_PRAGMA NonStandardThunk | SelectorThunk Id Id Int | VapThunk Id [StgAtom Id] Bool #-}
-data StgAtom a 	{-# GHC_PRAGMA StgVarAtom a | StgLitAtom BasicLit #-}
-data StgBinderInfo 	{-# GHC_PRAGMA NoStgBinderInfo | StgBinderInfo Bool Bool Bool Bool Bool #-}
-data StgExpr a b 	{-# GHC_PRAGMA StgApp (StgAtom b) [StgAtom b] (UniqFM b) | StgConApp Id [StgAtom b] (UniqFM b) | StgPrimApp PrimOp [StgAtom b] (UniqFM b) | StgCase (StgExpr a b) (UniqFM b) (UniqFM b) Unique (StgCaseAlternatives a b) | StgLet (StgBinding a b) (StgExpr a b) | StgLetNoEscape (UniqFM b) (UniqFM b) (StgBinding a b) (StgExpr a b) | StgSCC UniType CostCentre (StgExpr a b) #-}
+data StandardFormInfo 
+data StgAtom a 
+data StgBinderInfo 
+data StgExpr a b 
 data UpdateFlag   = ReEntrant | Updatable | SingleEntry
-data TyCon 	{-# GHC_PRAGMA SynonymTyCon Unique FullName Int [TyVarTemplate] UniType Bool | DataTyCon Unique FullName Int [TyVarTemplate] [Id] [Class] Bool | TupleTyCon Int | PrimTyCon Unique FullName Int ([PrimKind] -> PrimKind) | SpecTyCon TyCon [Labda UniType] #-}
-data UniqFM a 	{-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
+data TyCon 
+data UniqFM a 
 type UniqSet a = UniqFM a
 allocProfilingMsg :: ClosureInfo -> _PackedString
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ASA)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 blackHoleClosureInfo :: ClosureInfo -> ClosureInfo
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LAA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 blackHoleOnEntry :: Bool -> ClosureInfo -> Bool
-	{-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "LU(ALS)" {_A_ 3 _U_ 111 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 closureGoodStuffSize :: ClosureInfo -> Int
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 closureHdrSize :: ClosureInfo -> HeapOffset
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAS)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ HeapOffs totHdrSize _N_} _F_ _IF_ARGS_ 0 1 C 3 \ (u0 :: ClosureInfo) -> case u0 of { _ALG_ _ORIG_ ClosureInfo MkClosureInfo (u1 :: Id) (u2 :: LambdaFormInfo) (u3 :: SMRep) -> _APP_  _ORIG_ HeapOffs totHdrSize [ u3 ]; _NO_DEFLT_ } _N_ #-}
 closureId :: ClosureInfo -> Id
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(U(LLLL)AA)" {_A_ 4 _U_ 2222 _N_ _N_ _F_ _IF_ARGS_ 0 4 XXXX 5 \ (u0 :: Unique) (u1 :: UniType) (u2 :: IdInfo) (u3 :: IdDetails) -> _!_ _ORIG_ Id Id [] [u0, u1, u2, u3] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: ClosureInfo) -> case u0 of { _ALG_ _ORIG_ ClosureInfo MkClosureInfo (u1 :: Id) (u2 :: LambdaFormInfo) (u3 :: SMRep) -> u1; _NO_DEFLT_ } _N_ #-}
 closureKind :: ClosureInfo -> [Char]
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ASA)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 closureLFInfo :: ClosureInfo -> LambdaFormInfo
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ASA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: LambdaFormInfo) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: ClosureInfo) -> case u0 of { _ALG_ _ORIG_ ClosureInfo MkClosureInfo (u1 :: Id) (u2 :: LambdaFormInfo) (u3 :: SMRep) -> u2; _NO_DEFLT_ } _N_ #-}
 closureLabelFromCI :: ClosureInfo -> CLabel
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LAA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ CLabelInfo mkClosureLabel _N_} _F_ _IF_ARGS_ 0 1 C 3 \ (u0 :: ClosureInfo) -> case u0 of { _ALG_ _ORIG_ ClosureInfo MkClosureInfo (u1 :: Id) (u2 :: LambdaFormInfo) (u3 :: SMRep) -> _APP_  _ORIG_ CLabelInfo mkClosureLabel [ u1 ]; _NO_DEFLT_ } _N_ #-}
 closureNonHdrSize :: ClosureInfo -> Int
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ALS)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 closurePtrsSize :: ClosureInfo -> Int
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAS)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 closureReturnsUnboxedType :: ClosureInfo -> Bool
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LSA)" {_A_ 2 _U_ 11 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 closureSMRep :: ClosureInfo -> SMRep
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 1 \ (u0 :: SMRep) -> u0 _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: ClosureInfo) -> case u0 of { _ALG_ _ORIG_ ClosureInfo MkClosureInfo (u1 :: Id) (u2 :: LambdaFormInfo) (u3 :: SMRep) -> u3; _NO_DEFLT_ } _N_ #-}
 closureSemiTag :: ClosureInfo -> Int
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ASA)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 closureSingleEntry :: ClosureInfo -> Bool
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ASA)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 closureSize :: ClosureInfo -> HeapOffset
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ALS)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 closureSizeWithoutFixedHdr :: ClosureInfo -> HeapOffset
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ALS)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 closureType :: ClosureInfo -> Labda (TyCon, [UniType], [Id])
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LSA)" {_A_ 2 _U_ 11 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 closureTypeDescr :: ClosureInfo -> [Char]
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(U(ALAS)AA)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 closureUpdReqd :: ClosureInfo -> Bool
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ASA)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 12 \ (u0 :: LambdaFormInfo) -> case u0 of { _ALG_ _ORIG_ ClosureInfo LFThunk (u1 :: Bool) (u2 :: Bool) (u3 :: Bool) (u4 :: StandardFormInfo) -> u3; _ORIG_ ClosureInfo LFBlackHole  -> _!_ True [] []; (u5 :: LambdaFormInfo) -> _!_ False [] [] } _N_} _N_ _N_ #-}
-dataConLiveness :: ClosureInfo -> Int
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LAS)" {_A_ 2 _U_ 11 _N_ _N_ _N_ _N_} _N_ _N_ #-}
+dataConLiveness :: ((Int -> GlobalSwitch) -> Labda Int) -> ClosureInfo -> Int
 entryLabelFromCI :: ClosureInfo -> CLabel
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LSL)" {_A_ 3 _U_ 211 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 fastLabelFromCI :: ClosureInfo -> CLabel
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LAA)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 fitsMinUpdSize :: ClosureInfo -> Bool
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ALS)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 funInfoTableRequired :: Id -> StgBinderInfo -> LambdaFormInfo -> Bool
-	{-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LSL" _N_ _N_ #-}
 getEntryConvention :: Id -> LambdaFormInfo -> [PrimKind] -> CgInfoDownwards -> CgState -> (EntryConvention, CgState)
-	{-# GHC_PRAGMA _A_ 3 _U_ 22222 _N_ _N_ _N_ _N_ #-}
-mkClosureLabel :: Id -> CLabel
-	{-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-}
 getSMInfoStr :: SMRep -> [Char]
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getSMInitHdrStr :: SMRep -> [Char]
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getSMUpdInplaceHdrStr :: SMRep -> [Char]
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getStandardFormThunkInfo :: LambdaFormInfo -> Labda [StgAtom Id]
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
-getUniDataSpecTyCon_maybe :: UniType -> Labda (TyCon, [UniType], [Id])
-	{-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-}
 infoTableLabelFromCI :: ClosureInfo -> CLabel
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LSL)" {_A_ 3 _U_ 212 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 isConstantRep :: SMRep -> Bool
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 isPhantomRep :: SMRep -> Bool
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 11 \ (u0 :: SMRep) -> case u0 of { _ALG_ _ORIG_ SMRep PhantomRep  -> _!_ True [] []; (u1 :: SMRep) -> _!_ False [] [] } _N_ #-}
 isSpecRep :: SMRep -> Bool
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 11 \ (u0 :: SMRep) -> case u0 of { _ALG_ _ORIG_ SMRep SpecialisedRep (u1 :: SMSpecRepKind) (u2 :: Int) (u3 :: Int) (u4 :: SMUpdateKind) -> _!_ True [] []; (u5 :: SMRep) -> _!_ False [] [] } _N_ #-}
 isStaticClosure :: ClosureInfo -> Bool
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAS)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 1 C 11 \ (u0 :: SMRep) -> case u0 of { _ALG_ _ORIG_ SMRep StaticRep (u1 :: Int) (u2 :: Int) -> _!_ True [] []; (u3 :: SMRep) -> _!_ False [] [] } _N_} _N_ _N_ #-}
 layOutDynClosure :: Id -> (a -> PrimKind) -> [a] -> LambdaFormInfo -> (ClosureInfo, [(a, HeapOffset)])
-	{-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 layOutDynCon :: Id -> (a -> PrimKind) -> [a] -> (ClosureInfo, [(a, HeapOffset)])
-	{-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _N_ _N_ _N_ #-}
 layOutPhantomClosure :: Id -> LambdaFormInfo -> ClosureInfo
-	{-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 layOutStaticClosure :: Id -> (a -> PrimKind) -> [a] -> LambdaFormInfo -> (ClosureInfo, [(a, HeapOffset)])
-	{-# GHC_PRAGMA _A_ 4 _U_ 2222 _N_ _N_ _N_ _N_ #-}
 layOutStaticNoFVClosure :: Id -> LambdaFormInfo -> ClosureInfo
-	{-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 ltSMRepHdr :: SMRep -> SMRep -> Bool
-	{-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-}
 maybeSelectorInfo :: ClosureInfo -> Labda (Id, Int)
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ASA)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mkClosureLFInfo :: Bool -> [Id] -> UpdateFlag -> [Id] -> StgExpr Id Id -> LambdaFormInfo
-	{-# GHC_PRAGMA _A_ 5 _U_ 22222 _N_ _S_ "LLLSL" _N_ _N_ #-}
 mkConLFInfo :: Id -> LambdaFormInfo
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(LLLS)" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mkLFArgument :: LambdaFormInfo
-	{-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _!_ _ORIG_ ClosureInfo LFArgument [] [] _N_ #-}
 mkLFImported :: Id -> LambdaFormInfo
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(SAAAAAAAAA)A)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 mkLFLetNoEscape :: Int -> UniqFM Id -> LambdaFormInfo
-	{-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: Int) (u1 :: UniqFM Id) -> _!_ _ORIG_ ClosureInfo LFLetNoEscape [] [u0, u1] _N_ #-}
 mkVirtHeapOffsets :: SMRep -> (a -> PrimKind) -> [a] -> (Int, Int, [(a, HeapOffset)])
-	{-# GHC_PRAGMA _A_ 3 _U_ 222 _N_ _N_ _N_ _N_ #-}
 noUpdVapRequired :: StgBinderInfo -> Bool
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 4 \ (u0 :: StgBinderInfo) -> case u0 of { _ALG_ _ORIG_ StgSyn NoStgBinderInfo  -> _!_ False [] []; _ORIG_ StgSyn StgBinderInfo (u1 :: Bool) (u2 :: Bool) (u3 :: Bool) (u4 :: Bool) (u5 :: Bool) -> u4; _NO_DEFLT_ } _N_ #-}
 nodeMustPointToIt :: LambdaFormInfo -> CgInfoDownwards -> CgState -> (Bool, CgState)
-	{-# GHC_PRAGMA _A_ 3 _U_ 122 _N_ _S_ "SLL" _N_ _N_ #-}
 slopSize :: ClosureInfo -> Int
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(ALS)" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 slowFunEntryCodeRequired :: Id -> StgBinderInfo -> Bool
-	{-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "LS" _N_ _N_ #-}
 staticClosureRequired :: Id -> StgBinderInfo -> LambdaFormInfo -> Bool
-	{-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LSL" _N_ _N_ #-}
 stdVapRequired :: StgBinderInfo -> Bool
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 0 1 C 4 \ (u0 :: StgBinderInfo) -> case u0 of { _ALG_ _ORIG_ StgSyn NoStgBinderInfo  -> _!_ False [] []; _ORIG_ StgSyn StgBinderInfo (u1 :: Bool) (u2 :: Bool) (u3 :: Bool) (u4 :: Bool) (u5 :: Bool) -> u3; _NO_DEFLT_ } _N_ #-}
 
diff --git a/ghc/compiler/codeGen/ClosureInfo.lhs b/ghc/compiler/codeGen/ClosureInfo.lhs
index d705356369..055abe8e42 100644
--- a/ghc/compiler/codeGen/ClosureInfo.lhs
+++ b/ghc/compiler/codeGen/ClosureInfo.lhs
@@ -297,7 +297,7 @@ data LambdaFormInfo
 
   -- This last one is really only for completeness;
   -- it isn't actually used for anything interesting
-  | LFIndirection
+  {- | LFIndirection -}
 
 data StandardFormInfo	-- Tells whether this thunk has one of a small number
 			-- of standard forms
@@ -858,8 +858,9 @@ getEntryConvention :: Id			-- Function being applied
 		   -> FCode EntryConvention
 
 getEntryConvention id lf_info arg_kinds
- =  nodeMustPointToIt lf_info		`thenFC` \ node_points ->
-    isSwitchSetC ForConcurrent		`thenFC` \ is_concurrent -> 
+ =  nodeMustPointToIt lf_info	`thenFC` \ node_points ->
+    isSwitchSetC ForConcurrent	`thenFC` \ is_concurrent -> 
+    getIntSwitchChkrC		`thenFC` \ isw_chkr ->
     returnFC (
 
     if (node_points && is_concurrent) then ViaNode else
@@ -872,7 +873,7 @@ getEntryConvention id lf_info arg_kinds
 	    else 
 		DirectEntry (mkFastEntryLabel id arity) arity arg_regs
 	  where
-	    (arg_regs, _) = assignRegs live_regs (take arity arg_kinds)
+	    (arg_regs, _) = assignRegs isw_chkr live_regs (take arity arg_kinds)
     	    live_regs = if node_points then [node] else []
 
         LFCon con zero_arity  
@@ -900,9 +901,9 @@ getEntryConvention id lf_info arg_kinds
 
 	LFLetNoEscape arity _
 	  -> ASSERT(arity == length arg_kinds)
-	     DirectEntry (mkFastEntryLabel id arity) arity arg_regs
+	     DirectEntry (mkStdEntryLabel id) arity arg_regs
 	 where
-	    (arg_regs, _) = assignRegs live_regs arg_kinds
+	    (arg_regs, _) = assignRegs isw_chkr live_regs arg_kinds
     	    live_regs     = if node_points then [node] else []
     )
 
@@ -1171,7 +1172,7 @@ closureSemiTag (MkClosureInfo _ lf_info _)
   = case lf_info of
       LFCon data_con _ -> getDataConTag data_con - fIRST_TAG
       LFTuple _ _      -> 0
-      LFIndirection    -> fromInteger iND_TAG
+      --UNUSED: LFIndirection  -> fromInteger iND_TAG
       _	    	       -> fromInteger oTHER_TAG
 \end{code}
 
@@ -1204,9 +1205,9 @@ infoTableLabelFromCI (MkClosureInfo id lf_info rep)
 					-- Ditto for selectors
 -}
 
-	other -> if isStaticRep rep
+	other -> {-NO: if isStaticRep rep
 		 then mkStaticInfoTableLabel id
-		 else mkInfoTableLabel       id
+		 else -} mkInfoTableLabel id
 
 mkConInfoPtr :: Id -> SMRep -> CLabel
 mkConInfoPtr id rep = 
@@ -1261,7 +1262,7 @@ allocProfilingMsg (MkClosureInfo _ lf_info _)
       LFTuple _ _		-> SLIT("ALLOC_CON")
       LFThunk _ _ _ _ 		-> SLIT("ALLOC_THK")
       LFBlackHole		-> SLIT("ALLOC_BH")
-      LFIndirection		-> panic "ALLOC_IND"
+      --UNUSED: LFIndirection	-> panic "ALLOC_IND"
       LFImported		-> panic "ALLOC_IMP"
 \end{code}
 
@@ -1279,12 +1280,12 @@ information is never used, we don't care.
 
 \begin{code}
 
-dataConLiveness (MkClosureInfo con _ PhantomRep)
-  = case dataReturnConvAlg con of
+dataConLiveness isw_chkr (MkClosureInfo con _ PhantomRep)
+  = case (dataReturnConvAlg isw_chkr con) of
       ReturnInRegs regs -> mkLiveRegsBitMask regs
       ReturnInHeap -> panic "dataConLiveness:PhantomRep in heap???"
 
-dataConLiveness _ = mkLiveRegsBitMask [node]
+dataConLiveness _ _ = mkLiveRegsBitMask [node]
 \end{code}
 
 %************************************************************************
@@ -1315,7 +1316,7 @@ closureKind (MkClosureInfo _ lf _)
       LFTuple _ _		-> "CON_K"
       LFThunk _ _ _ _ 		-> "THK_K"
       LFBlackHole		-> "THK_K" -- consider BHs as thunks for the moment... (ToDo?)
-      LFIndirection		-> panic "IND_KIND"
+      --UNUSED: LFIndirection	-> panic "IND_KIND"
       LFImported		-> panic "IMP_KIND"
 
 closureTypeDescr :: ClosureInfo -> String
diff --git a/ghc/compiler/codeGen/CodeGen.hi b/ghc/compiler/codeGen/CodeGen.hi
index 28362e74a3..0b93b98a24 100644
--- a/ghc/compiler/codeGen/CodeGen.hi
+++ b/ghc/compiler/codeGen/CodeGen.hi
@@ -7,8 +7,7 @@ import ClosureInfo(ClosureInfo)
 import CmdLineOpts(GlobalSwitch, SwitchResult)
 import CostCentre(CostCentre)
 import FiniteMap(FiniteMap)
-import Id(Id, IdDetails)
-import IdInfo(IdInfo)
+import Id(Id)
 import Maybes(Labda)
 import PreludePS(_PackedString)
 import PrimOps(PrimOp)
@@ -16,12 +15,10 @@ import StgSyn(StgBinding, StgRhs)
 import TyCon(TyCon)
 import UniType(UniType)
 import UniqFM(UniqFM)
-import Unique(Unique)
-data AbstractC 	{-# GHC_PRAGMA AbsCNop | AbsCStmts AbstractC AbstractC | CAssign CAddrMode CAddrMode | CJump CAddrMode | CFallThrough CAddrMode | CReturn CAddrMode ReturnInfo | CSwitch CAddrMode [(BasicLit, AbstractC)] AbstractC | CCodeBlock CLabel AbstractC | CInitHdr ClosureInfo RegRelative CAddrMode Bool | COpStmt [CAddrMode] PrimOp [CAddrMode] Int [MagicId] | CSimultaneous AbstractC | CMacroStmt CStmtMacro [CAddrMode] | CCallProfCtrMacro _PackedString [CAddrMode] | CCallProfCCMacro _PackedString [CAddrMode] | CStaticClosure CLabel ClosureInfo CAddrMode [CAddrMode] | CClosureInfoAndCode ClosureInfo AbstractC (Labda AbstractC) CAddrMode [Char] | CRetVector CLabel [Labda CAddrMode] AbstractC | CRetUnVector CLabel CAddrMode | CFlatRetVector CLabel [CAddrMode] | CCostCentreDecl Bool CostCentre | CClosureUpdInfo AbstractC | CSplitMarker #-}
-data FiniteMap a b 	{-# GHC_PRAGMA EmptyFM | Branch a b Int# (FiniteMap a b) (FiniteMap a b) #-}
-data Id 	{-# GHC_PRAGMA Id Unique UniType IdInfo IdDetails #-}
-data StgBinding a b 	{-# GHC_PRAGMA StgNonRec a (StgRhs a b) | StgRec [(a, StgRhs a b)] #-}
-data UniqFM a 	{-# GHC_PRAGMA EmptyUFM | LeafUFM Int# a | NodeUFM Int# Int# (UniqFM a) (UniqFM a) #-}
+data AbstractC 
+data FiniteMap a b 
+data Id 
+data StgBinding a b 
+data UniqFM a 
 codeGen :: _PackedString -> ([CostCentre], [CostCentre]) -> [_PackedString] -> (GlobalSwitch -> SwitchResult) -> [TyCon] -> FiniteMap TyCon [[Labda UniType]] -> [StgBinding Id Id] -> AbstractC
-	{-# GHC_PRAGMA _A_ 7 _U_ 2112112 _N_ _S_ "LU(LL)LSLLL" _N_ _N_ #-}
 
diff --git a/ghc/compiler/codeGen/CodeGen.lhs b/ghc/compiler/codeGen/CodeGen.lhs
index a1aa854e7e..795f2ec8b3 100644
--- a/ghc/compiler/codeGen/CodeGen.lhs
+++ b/ghc/compiler/codeGen/CodeGen.lhs
@@ -34,9 +34,10 @@ import CgClosure	( cgTopRhsClosure )
 import CgCon		( cgTopRhsCon )
 import CgConTbls	( genStaticConBits, TCE(..), UniqFM )
 import ClosureInfo	( LambdaFormInfo, mkClosureLFInfo )
-import CmdLineOpts	( GlobalSwitch(..), switchIsOn, stringSwitchSet, SwitchResult )
+import CmdLineOpts
 import FiniteMap	( FiniteMap )
 import Maybes		( Maybe(..) )
+import Pretty		-- debugging only
 import PrimKind		( getKindSize )
 import Util
 \end{code}
@@ -56,15 +57,36 @@ codeGen :: FAST_STRING		-- module name
 
 codeGen mod_name (local_CCs, extern_CCs) import_names sw_lookup_fn gen_tycons tycon_specs stg_pgm
   = let
-	switch_is_on	  = switchIsOn sw_lookup_fn
+	switch_is_on	  = switchIsOn   sw_lookup_fn
+	int_switch_set	  = intSwitchSet sw_lookup_fn
 	doing_profiling   = switch_is_on SccProfilingOn
 	compiling_prelude = switch_is_on CompilingPrelude
 	splitting         = switch_is_on (EnsureSplittableC (panic "codeGen:esc"))
+
+	cinfo = MkCompInfo switch_is_on int_switch_set mod_name
     in
+
+{- OLD:
+    pprTrace "codeGen:" (ppCat [
+    (case (switch_is_on StgDoLetNoEscapes) of
+	False -> ppStr "False?"
+	True  -> ppStr "True?"
+    ),
+    (case (int_switch_set ReturnInRegsThreshold) of
+	Nothing -> ppStr "Nothing!"
+	Just  n -> ppCat [ppStr "Just", ppInt n]
+    ),
+    (case (int_switch_set UnfoldingUseThreshold) of
+	Nothing -> ppStr "Nothing!"
+	Just  n -> ppCat [ppStr "Just", ppInt n]
+    ),
+    (case (int_switch_set UnfoldingCreationThreshold) of
+	Nothing -> ppStr "Nothing!"
+	Just  n -> ppCat [ppStr "Just", ppInt n]
+    )
+    ]) $
+-}
     if not doing_profiling then
-	let
-	    cinfo = MkCompInfo switch_is_on mod_name
-	in
 	mkAbstractCs [
 	    genStaticConBits cinfo gen_tycons tycon_specs,
 	    initC cinfo (cgTopBindings splitting stg_pgm) ]
@@ -80,9 +102,7 @@ codeGen mod_name (local_CCs, extern_CCs) import_names sw_lookup_fn gen_tycons ty
 	 -- into the code-generator, as are the imported-modules' names.)
 	 --
 	 -- Note: we don't register/etc if compiling Prelude bits.
-	let
-	    cinfo = MkCompInfo switch_is_on mod_name
-	in
+
 	mkAbstractCs [
 		if compiling_prelude
 		then AbsCNop
diff --git a/ghc/compiler/codeGen/SMRep.hi b/ghc/compiler/codeGen/SMRep.hi
index bad95d40e3..e8d86a346a 100644
--- a/ghc/compiler/codeGen/SMRep.hi
+++ b/ghc/compiler/codeGen/SMRep.hi
@@ -5,33 +5,11 @@ data SMRep   = StaticRep Int Int | SpecialisedRep SMSpecRepKind Int Int SMUpdate
 data SMSpecRepKind   = SpecRep | ConstantRep | CharLikeRep | IntLikeRep
 data SMUpdateKind   = SMNormalForm | SMSingleEntry | SMUpdatable
 getSMInfoStr :: SMRep -> [Char]
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getSMInitHdrStr :: SMRep -> [Char]
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 getSMUpdInplaceHdrStr :: SMRep -> [Char]
-	{-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-}
 ltSMRepHdr :: SMRep -> SMRep -> Bool
-	{-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "SS" _N_ _N_ #-}
 instance Eq SMRep
-	{-# GHC_PRAGMA _M_ SMRep {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(SMRep -> SMRep -> Bool), (SMRep -> SMRep -> Bool)] [_CONSTM_ Eq (==) (SMRep), _CONSTM_ Eq (/=) (SMRep)] _N_
-	 (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-	 (/=) = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Ord SMRep
-	{-# GHC_PRAGMA _M_ SMRep {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 9 _!_ _TUP_8 [{{Eq SMRep}}, (SMRep -> SMRep -> Bool), (SMRep -> SMRep -> Bool), (SMRep -> SMRep -> Bool), (SMRep -> SMRep -> Bool), (SMRep -> SMRep -> SMRep), (SMRep -> SMRep -> SMRep), (SMRep -> SMRep -> _CMP_TAG)] [_DFUN_ Eq (SMRep), _CONSTM_ Ord (<) (SMRep), _CONSTM_ Ord (<=) (SMRep), _CONSTM_ Ord (>=) (SMRep), _CONSTM_ Ord (>) (SMRep), _CONSTM_ Ord max (SMRep), _CONSTM_ Ord min (SMRep), _CONSTM_ Ord _tagCmp (SMRep)] _N_
-	 (<) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-	 (<=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_,
-	 (>=) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: SMRep) (u1 :: SMRep) -> _APP_  _CONSTM_ Ord (<=) (SMRep) [ u1, u0 ] _N_,
-	 (>) = _A_ 2 _U_ 22 _N_ _S_ "SS" _F_ _IF_ARGS_ 0 2 XX 3 \ (u0 :: SMRep) (u1 :: SMRep) -> _APP_  _CONSTM_ Ord (<) (SMRep) [ u1, u0 ] _N_,
-	 max = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-	 min = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_,
-	 _tagCmp = _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-}
 instance Outputable SMRep
-	{-# GHC_PRAGMA _M_ SMRep {-dfun-} _A_ 2 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _CONSTM_ Outputable ppr (SMRep) _N_
-	 ppr = _A_ 2 _U_ 0220 _N_ _S_ "AL" {_A_ 1 _U_ 220 _N_ _N_ _N_ _N_} _N_ _N_ #-}
 instance Text SMRep
-	{-# GHC_PRAGMA _M_ SMRep {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(SMRep, [Char])]), (Int -> SMRep -> [Char] -> [Char]), ([Char] -> [([SMRep], [Char])]), ([SMRep] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (SMRep), _CONSTM_ Text showsPrec (SMRep), _CONSTM_ Text readList (SMRep), _CONSTM_ Text showList (SMRep)] _N_
-	 readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_  _TYAPP_  patError# { (Int -> [Char] -> [(SMRep, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_,
-	 showsPrec = _A_ 3 _U_ 012 _N_ _S_ "ASL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_,
-	 readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_,
-	 showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-}
 
diff --git a/ghc/compiler/codeGen/SMRep.lhs b/ghc/compiler/codeGen/SMRep.lhs
index fb5b113c2c..c7656af03e 100644
--- a/ghc/compiler/codeGen/SMRep.lhs
+++ b/ghc/compiler/codeGen/SMRep.lhs
@@ -83,6 +83,52 @@ data SMRep
 			-- Used for mutable tuples
 	Int		-- # ptr words
 
+{- Mattson review:
+
+To: simonpj@dcs.gla.ac.uk, partain@dcs.gla.ac.uk
+Cc: kh@dcs.gla.ac.uk, trinder@dcs.gla.ac.uk, areid@dcs.gla.ac.uk
+Subject: Correct me if I'm wrong...
+Date: Fri, 17 Feb 1995 18:09:00 +0000
+From: Jim Mattson <mattson@dcs.gla.ac.uk>
+
+BigTupleRep == TUPLE
+
+    Never generated by the compiler, and only used in the RTS when
+    mutuples don't require special attention at GC time (e.g. 2s)
+    When it is used, it is a primitive object (never entered).
+    May be mutable...probably should never be used in the parallel 
+    system, since we need to distinguish mutables from immutables when
+    deciding whether to copy or move closures across processors.
+
+DataRep == DATA (aka MutableByteArray & ByteArray)
+    Never generated by the compiler, and only used in the RTS for
+    ArrayOfData.  Always a primitive object (never entered).  May
+    be mutable...though we don't distinguish between mutable and
+    immutable data arrays in the sequential world, it would probably
+    be useful in the parallel world to know when it is safe to just
+    copy one of these.  I believe the hooks are in place for changing
+    the InfoPtr on a MutableByteArray when it's frozen to a ByteArray
+    if we want to do so.
+
+DynamicRep == DYN
+    Never generated by the compiler, and only used in the RTS for
+    PAPs and the Stable Pointer table.  PAPs are non-primitive,
+    non-updatable, normal-form objects, but the SPT is a primitive,
+    mutable object.  At the moment, there is no SPT in the parallel
+    world.  Presumably, it would be possible to have an SPT on each
+    processor, and we could identify a stable pointer as a (processor,
+    SPT-entry) pair, but would it be worth it?
+
+MuTupleRep == MUTUPLE
+    Never generated by the compiler, and only used in the RTS when
+    mutuples *do* require special attention at GC time.
+    When it is used, it is a primitive object (never entered).
+    Always mutable...there is an IMMUTUPLE in the RTS, but no
+    corresponding type in the compiler.
+
+--jim
+-}
+
 instance Eq SMRep where
     (SpecialisedRep k1 a1 b1 _) == (SpecialisedRep k2 a2 b2 _) = (tagOf_SMSpecRepKind k1) _EQ_ (tagOf_SMSpecRepKind k2)
 							       && a1 == a2 && b1 == b2
@@ -137,8 +183,8 @@ tagOf_SMRep PhantomRep	     	     = ILIT(8)
 tagOf_SMRep (MuTupleRep _)	     = ILIT(9)
 
 instance Text SMRep where
-    showsPrec d rep rest
-      = (case rep of
+    showsPrec d rep
+      = showString (case rep of
 	   StaticRep _ _   	                 -> "STATIC"
 	   SpecialisedRep kind _ _ SMNormalForm  -> "SPEC_N"
 	   SpecialisedRep kind _ _ SMSingleEntry -> "SPEC_S"
@@ -146,12 +192,12 @@ instance Text SMRep where
 	   GenericRep _ _ SMNormalForm	         -> "GEN_N"
 	   GenericRep _ _ SMSingleEntry	         -> "GEN_S"
 	   GenericRep _ _ SMUpdatable	         -> "GEN_U"
-	   BigTupleRep _	         -> "TUPLE"
-	   DataRep	 _	         -> "DATA"
-	   DynamicRep		         -> "DYN"
-	   BlackHoleRep	   	         -> "BH"
-	   PhantomRep	   	         -> "INREGS"
-	   MuTupleRep _	            	 -> "MUTUPLE") ++ rest
+	   BigTupleRep _	         	 -> "TUPLE"
+	   DataRep	 _	         	 -> "DATA"
+	   DynamicRep		         	 -> "DYN"
+	   BlackHoleRep	   	         	 -> "BH"
+	   PhantomRep	   	         	 -> "INREGS"
+	   MuTupleRep _	            	 	 -> "MUTUPLE")
 
 instance Outputable SMRep where
     ppr sty rep = ppStr (show rep)