ghci: Ensure that system libffi include path is searched
[ghc.git] / compiler / codeGen / StgCmmClosure.hs
index f5a722e..fff2078 100644 (file)
 
 module StgCmmClosure (
         DynTag,  tagForCon, isSmallFamily,
-        ConTagZ, dataConTagZ,
 
         idPrimRep, isVoidRep, isGcPtrRep, addIdReps, addArgReps,
         argPrimRep,
 
+        NonVoid(..), fromNonVoid, nonVoidIds, nonVoidStgArgs,
+        assertNonVoidIds, assertNonVoidStgArgs,
+
         -- * LambdaFormInfo
         LambdaFormInfo,         -- Abstract
         StandardFormInfo,        -- ...ditto...
         mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo,
         mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape,
+        mkLFStringLit,
         lfDynTag,
-        maybeIsLFCon, isLFThunk, isLFReEntrant, lfUpdatable,
+        isLFThunk, isLFReEntrant, lfUpdatable,
 
         -- * Used by other modules
         CgLoc(..), SelfLoopInfo, CallMethod(..),
@@ -61,30 +64,35 @@ module StgCmmClosure (
 
 #include "../includes/MachDeps.h"
 
-#define FAST_STRING_NOT_NEEDED
 #include "HsVersions.h"
 
+import GhcPrelude
+
 import StgSyn
 import SMRep
 import Cmm
 import PprCmmExpr()
 
+import CostCentre
 import BlockId
 import CLabel
 import Id
 import IdInfo
 import DataCon
-import FastString
 import Name
 import Type
-import TypeRep
+import TyCoRep
 import TcType
 import TyCon
+import RepType
 import BasicTypes
 import Outputable
 import DynFlags
 import Util
 
+import Data.Coerce (coerce)
+import qualified Data.ByteString.Char8 as BS8
+
 -----------------------------------------------------------------------------
 --                Data types and synonyms
 -----------------------------------------------------------------------------
@@ -104,16 +112,52 @@ data CgLoc
         -- and branch to the block id
 
 instance Outputable CgLoc where
-  ppr (CmmLoc e)    = ptext (sLit "cmm") <+> ppr e
-  ppr (LneLoc b rs) = ptext (sLit "lne") <+> ppr b <+> ppr rs
+  ppr (CmmLoc e)    = text "cmm" <+> ppr e
+  ppr (LneLoc b rs) = text "lne" <+> ppr b <+> ppr rs
 
 type SelfLoopInfo = (Id, BlockId, [LocalReg])
 
 -- used by ticky profiling
 isKnownFun :: LambdaFormInfo -> Bool
-isKnownFun (LFReEntrant _ _ _ _) = True
-isKnownFun LFLetNoEscape         = True
-isKnownFun _ = False
+isKnownFun LFReEntrant{} = True
+isKnownFun LFLetNoEscape = True
+isKnownFun _             = False
+
+
+-------------------------------------
+--        Non-void types
+-------------------------------------
+-- We frequently need the invariant that an Id or a an argument
+-- is of a non-void type. This type is a witness to the invariant.
+
+newtype NonVoid a = NonVoid a
+  deriving (Eq, Show)
+
+fromNonVoid :: NonVoid a -> a
+fromNonVoid (NonVoid a) = a
+
+instance (Outputable a) => Outputable (NonVoid a) where
+  ppr (NonVoid a) = ppr a
+
+nonVoidIds :: [Id] -> [NonVoid Id]
+nonVoidIds ids = [NonVoid id | id <- ids, not (isVoidTy (idType id))]
+
+-- | Used in places where some invariant ensures that all these Ids are
+-- non-void; e.g. constructor field binders in case expressions.
+-- See Note [Post-unarisation invariants] in UnariseStg.
+assertNonVoidIds :: [Id] -> [NonVoid Id]
+assertNonVoidIds ids = ASSERT(not (any (isVoidTy . idType) ids))
+                       coerce ids
+
+nonVoidStgArgs :: [StgArg] -> [NonVoid StgArg]
+nonVoidStgArgs args = [NonVoid arg | arg <- args, not (isVoidTy (stgArgType arg))]
+
+-- | Used in places where some invariant ensures that all these arguments are
+-- non-void; e.g. constructor arguments.
+-- See Note [Post-unarisation invariants] in UnariseStg.
+assertNonVoidStgArgs :: [StgArg] -> [NonVoid StgArg]
+assertNonVoidStgArgs args = ASSERT(not (any (isVoidTy . stgArgType) args))
+                            coerce args
 
 
 -----------------------------------------------------------------------------
@@ -123,18 +167,20 @@ isKnownFun _ = False
 -- Why are these here?
 
 idPrimRep :: Id -> PrimRep
-idPrimRep id = typePrimRep (idType id)
-    -- NB: typePrimRep fails on unboxed tuples,
+idPrimRep id = typePrimRep1 (idType id)
+    -- NB: typePrimRep1 fails on unboxed tuples,
     --     but by StgCmm no Ids have unboxed tuple type
 
-addIdReps :: [Id] -> [(PrimRep, Id)]
-addIdReps ids = [(idPrimRep id, id) | id <- ids]
+addIdReps :: [NonVoid Id] -> [NonVoid (PrimRep, Id)]
+addIdReps = map (\id -> let id' = fromNonVoid id
+                         in NonVoid (idPrimRep id', id'))
 
-addArgReps :: [StgArg] -> [(PrimRep, StgArg)]
-addArgReps args = [(argPrimRep arg, arg) | arg <- args]
+addArgReps :: [NonVoid StgArg] -> [NonVoid (PrimRep, StgArg)]
+addArgReps = map (\arg -> let arg' = fromNonVoid arg
+                           in NonVoid (argPrimRep arg', arg'))
 
 argPrimRep :: StgArg -> PrimRep
-argPrimRep arg = typePrimRep (stgArgType arg)
+argPrimRep arg = typePrimRep1 (stgArgType arg)
 
 
 -----------------------------------------------------------------------------
@@ -149,6 +195,7 @@ argPrimRep arg = typePrimRep (stgArgType arg)
 data LambdaFormInfo
   = LFReEntrant         -- Reentrant closure (a function)
         TopLevelFlag    -- True if top level
+        OneShotInfo
         !RepArity       -- Arity. Invariant: always > 0
         !Bool           -- True <=> no fvs
         ArgDescr        -- Argument descriptor (should really be in ClosureInfo)
@@ -169,12 +216,12 @@ data LambdaFormInfo
                         -- Imported things which we *do* know something about use
                         -- one of the other LF constructors (eg LFReEntrant for
                         -- known functions)
-        !Bool                -- True <=> *might* be a function type
+        !Bool           -- True <=> *might* be a function type
                         --      The False case is good when we want to enter it,
                         --        because then we know the entry code will do
                         --        For a function, the entry code is the fast entry point
 
-  | LFUnLifted          -- A value of unboxed type;
+  | LFUnlifted          -- A value of unboxed type;
                         -- always a value, needs evaluation
 
   | LFLetNoEscape       -- See LetNoEscape module for precise description
@@ -212,9 +259,9 @@ data StandardFormInfo
 
 mkLFArgument :: Id -> LambdaFormInfo
 mkLFArgument id
-  | isUnLiftedType ty             = LFUnLifted
+  | isUnliftedType ty      = LFUnlifted
   | might_be_a_function ty = LFUnknown True
-  | otherwise                    = LFUnknown False
+  | otherwise              = LFUnknown False
   where
     ty = idType id
 
@@ -229,13 +276,16 @@ mkLFReEntrant :: TopLevelFlag    -- True of top level
               -> ArgDescr        -- Argument descriptor
               -> LambdaFormInfo
 
+mkLFReEntrant _ _ [] _
+  = pprPanic "mkLFReEntrant" empty
 mkLFReEntrant top fvs args arg_descr
-  = LFReEntrant top (length args) (null fvs) arg_descr
+  = LFReEntrant top os_info (length args) (null fvs) arg_descr
+  where os_info = idOneShotInfo (head args)
 
 -------------
 mkLFThunk :: Type -> TopLevelFlag -> [Id] -> UpdateFlag -> LambdaFormInfo
 mkLFThunk thunk_ty top fvs upd_flag
-  = ASSERT( not (isUpdatable upd_flag) || not (isUnLiftedType thunk_ty) )
+  = ASSERT( not (isUpdatable upd_flag) || not (isUnliftedType thunk_ty) )
     LFThunk top (null fvs)
             (isUpdatable upd_flag)
             NonStandardThunk
@@ -246,8 +296,8 @@ might_be_a_function :: Type -> Bool
 -- Return False only if we are *sure* it's a data type
 -- Look through newtypes etc as much as poss
 might_be_a_function ty
-  | UnaryRep rep <- repType ty
-  , Just tc <- tyConAppTyCon_maybe rep
+  | [LiftedRep] <- typePrimRep ty
+  , Just tc <- tyConAppTyCon_maybe (unwrapType ty)
   , isDataTyCon tc
   = False
   | otherwise
@@ -279,19 +329,21 @@ mkLFImported id
                 -- the id really does point directly to the constructor
 
   | arity > 0
-  = LFReEntrant TopLevel arity True (panic "arg_descr")
+  = LFReEntrant TopLevel noOneShotInfo arity True (panic "arg_descr")
 
   | otherwise
   = mkLFArgument id -- Not sure of exact arity
   where
-    arity = idRepArity id
+    arity = idFunRepArity id
+
+-------------
+mkLFStringLit :: LambdaFormInfo
+mkLFStringLit = LFUnlifted
 
 -----------------------------------------------------
 --                Dynamic pointer tagging
 -----------------------------------------------------
 
-type ConTagZ = Int      -- A *zero-indexed* contructor tag
-
 type DynTag = Int       -- The tag on a *pointer*
                         -- (from the dynamic-tagging paper)
 
@@ -311,17 +363,12 @@ type DynTag = Int       -- The tag on a *pointer*
 isSmallFamily :: DynFlags -> Int -> Bool
 isSmallFamily dflags fam_size = fam_size <= mAX_PTR_TAG dflags
 
--- We keep the *zero-indexed* tag in the srt_len field of the info
--- table of a data constructor.
-dataConTagZ :: DataCon -> ConTagZ
-dataConTagZ con = dataConTag con - fIRST_TAG
-
 tagForCon :: DynFlags -> DataCon -> DynTag
 tagForCon dflags con
-  | isSmallFamily dflags fam_size = con_tag + 1
+  | isSmallFamily dflags fam_size = con_tag
   | otherwise                     = 1
   where
-    con_tag  = dataConTagZ con
+    con_tag  = dataConTag con -- NB: 1-indexed
     fam_size = tyConFamilySize (dataConTyCon con)
 
 tagForArity :: DynFlags -> RepArity -> DynTag
@@ -332,20 +379,15 @@ tagForArity dflags arity
 lfDynTag :: DynFlags -> LambdaFormInfo -> DynTag
 -- Return the tag in the low order bits of a variable bound
 -- to this LambdaForm
-lfDynTag dflags (LFCon con)               = tagForCon dflags con
-lfDynTag dflags (LFReEntrant _ arity _ _) = tagForArity dflags arity
-lfDynTag _      _other                    = 0
+lfDynTag dflags (LFCon con)                 = tagForCon dflags con
+lfDynTag dflags (LFReEntrant _ arity _ _) = tagForArity dflags arity
+lfDynTag _      _other                      = 0
 
 
 -----------------------------------------------------------------------------
 --                Observing LambdaFormInfo
 -----------------------------------------------------------------------------
 
--------------
-maybeIsLFCon :: LambdaFormInfo -> Maybe DataCon
-maybeIsLFCon (LFCon con) = Just con
-maybeIsLFCon _ = Nothing
-
 ------------
 isLFThunk :: LambdaFormInfo -> Bool
 isLFThunk (LFThunk {})  = True
@@ -360,11 +402,11 @@ isLFReEntrant _                = False
 -----------------------------------------------------------------------------
 
 lfClosureType :: LambdaFormInfo -> ClosureTypeInfo
-lfClosureType (LFReEntrant _ arity _ argd) = Fun arity argd
-lfClosureType (LFCon con)                  = Constr (dataConTagZ con)
-                                                    (dataConIdentity con)
-lfClosureType (LFThunk _ _ _ is_sel _)     = thunkClosureType is_sel
-lfClosureType _                            = panic "lfClosureType"
+lfClosureType (LFReEntrant _ arity _ argd) = Fun arity argd
+lfClosureType (LFCon con)                    = Constr (dataConTagZ con)
+                                                      (dataConIdentity con)
+lfClosureType (LFThunk _ _ _ is_sel _)       = thunkClosureType is_sel
+lfClosureType _                              = panic "lfClosureType"
 
 thunkClosureType :: StandardFormInfo -> ClosureTypeInfo
 thunkClosureType (SelectorThunk off) = ThunkSelector off
@@ -384,7 +426,7 @@ nodeMustPointToIt :: DynFlags -> LambdaFormInfo -> Bool
 -- this closure has R1 (the "Node" register) pointing to the
 -- closure itself --- the "self" argument
 
-nodeMustPointToIt _ (LFReEntrant top _ no_fvs _)
+nodeMustPointToIt _ (LFReEntrant top _ no_fvs _)
   =  not no_fvs          -- Certainly if it has fvs we need to point to it
   || isNotTopLevel top   -- See Note [GC recovery]
         -- For lex_profiling we also access the cost centre for a
@@ -422,7 +464,7 @@ nodeMustPointToIt _ (LFCon _) = True
         -- 27/11/92.
 
 nodeMustPointToIt _ (LFUnknown _)   = True
-nodeMustPointToIt _ LFUnLifted      = False
+nodeMustPointToIt _ LFUnlifted      = False
 nodeMustPointToIt _ LFLetNoEscape   = False
 
 {- Note [GC recovery]
@@ -439,7 +481,7 @@ floated them out.  Well, a clever optimiser might leave one there to
 avoid a space leak, deliberately recomputing a thunk.  Also (and this
 really does happen occasionally) let-floating may make a function f smaller
 so it can be inlined, so now (f True) may generate a local no-fv closure.
-This actually happened during bootsrapping GHC itself, with f=mkRdrFunBind
+This actually happened during bootstrapping GHC itself, with f=mkRdrFunBind
 in TcGenDeriv.) -}
 
 -----------------------------------------------------------------------------
@@ -497,6 +539,7 @@ getCallMethod :: DynFlags
                                 -- itself
               -> LambdaFormInfo -- Its info
               -> RepArity       -- Number of available arguments
+              -> RepArity       -- Number of them being void arguments
               -> CgLoc          -- Passed in from cgIdApp so that we can
                                 -- handle let-no-escape bindings and self-recursive
                                 -- tail calls using the same data constructor,
@@ -505,30 +548,38 @@ getCallMethod :: DynFlags
               -> Maybe SelfLoopInfo -- can we perform a self-recursive tail call?
               -> CallMethod
 
-getCallMethod dflags _ id _ n_args _cg_loc (Just (self_loop_id, block_id, args))
-  | gopt Opt_Loopification dflags, id == self_loop_id, n_args == length args
+getCallMethod dflags _ id _ n_args v_args _cg_loc
+              (Just (self_loop_id, block_id, args))
+  | gopt Opt_Loopification dflags
+  , id == self_loop_id
+  , args `lengthIs` (n_args - v_args)
   -- If these patterns match then we know that:
   --   * loopification optimisation is turned on
   --   * function is performing a self-recursive call in a tail position
-  --   * number of parameters of the function matches functions arity.
-  -- See Note [Self-recursive tail calls] in StgCmmExpr for more details
+  --   * number of non-void parameters of the function matches functions arity.
+  -- See Note [Self-recursive tail calls] and Note [Void arguments in
+  -- self-recursive tail calls] in StgCmmExpr for more details
   = JumpToIt block_id args
 
-getCallMethod dflags name id (LFReEntrant _ arity _ _) n_args _cg_loc
+getCallMethod dflags name id (LFReEntrant _ _ arity _ _) n_args _v_args _cg_loc
               _self_loop_info
-  | n_args == 0    = ASSERT( arity /= 0 )
-                     ReturnIt        -- No args at all
+  | n_args == 0 -- No args at all
+  && not (gopt Opt_SccProfilingOn dflags)
+     -- See Note [Evaluating functions with profiling] in rts/Apply.cmm
+  = ASSERT( arity /= 0 ) ReturnIt
   | n_args < arity = SlowCall        -- Not enough args
   | otherwise      = DirectEntry (enterIdLabel dflags name (idCafInfo id)) arity
 
-getCallMethod _ _name _ LFUnLifted n_args _cg_loc _self_loop_info
+getCallMethod _ _name _ LFUnlifted n_args _v_args _cg_loc _self_loop_info
   = ASSERT( n_args == 0 ) ReturnIt
 
-getCallMethod _ _name _ (LFCon _) n_args _cg_loc _self_loop_info
+getCallMethod _ _name _ (LFCon _) n_args _v_args _cg_loc _self_loop_info
   = ASSERT( n_args == 0 ) ReturnIt
+    -- n_args=0 because it'd be ill-typed to apply a saturated
+    --          constructor application to anything
 
 getCallMethod dflags name id (LFThunk _ _ updatable std_form_info is_fun)
-              n_args _cg_loc _self_loop_info
+              n_args _v_args _cg_loc _self_loop_info
   | is_fun      -- it *might* be a function, so we must "call" it (which is always safe)
   = SlowCall    -- We cannot just enter it [in eval/apply, the entry code
                 -- is the fast-entry code]
@@ -559,104 +610,18 @@ getCallMethod dflags name id (LFThunk _ _ updatable std_form_info is_fun)
     DirectEntry (thunkEntryLabel dflags name (idCafInfo id) std_form_info
                 updatable) 0
 
-getCallMethod _ _name _ (LFUnknown True) _n_arg _cg_locs _self_loop_info
+getCallMethod _ _name _ (LFUnknown True) _n_arg _v_args _cg_locs _self_loop_info
   = SlowCall -- might be a function
 
-getCallMethod _ name _ (LFUnknown False) n_args _cg_loc _self_loop_info
+getCallMethod _ name _ (LFUnknown False) n_args _v_args _cg_loc _self_loop_info
   = ASSERT2( n_args == 0, ppr name <+> ppr n_args )
     EnterIt -- Not a function
 
-getCallMethod _ _name _ LFLetNoEscape _n_args (LneLoc blk_id lne_regs)
+getCallMethod _ _name _ LFLetNoEscape _n_args _v_args (LneLoc blk_id lne_regs)
               _self_loop_info
   = JumpToIt blk_id lne_regs
 
-getCallMethod _ _ _ _ _ _ _ = panic "Unknown call method"
-
------------------------------------------------------------------------------
---                staticClosureRequired
------------------------------------------------------------------------------
-
-{-  staticClosureRequired is never called (hence commented out)
-
-    SimonMar writes (Sept 07) It's an optimisation we used to apply at
-    one time, I believe, but it got lost probably in the rewrite of
-    the RTS/code generator.  I left that code there to remind me to
-    look into whether it was worth doing sometime
-
-{- Avoiding generating entries and info tables
-   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-At present, for every function we generate all of the following,
-just in case.  But they aren't always all needed, as noted below:
-
-[NB1: all of this applies only to *functions*.  Thunks always
-have closure, info table, and entry code.]
-
-[NB2: All are needed if the function is *exported*, just to play safe.]
-
-* Fast-entry code  ALWAYS NEEDED
-
-* Slow-entry code
-        Needed iff (a) we have any un-saturated calls to the function
-        OR         (b) the function is passed as an arg
-        OR         (c) we're in the parallel world and the function has free vars
-                       [Reason: in parallel world, we always enter functions
-                       with free vars via the closure.]
-
-* The function closure
-        Needed iff (a) we have any un-saturated calls to the function
-        OR         (b) the function is passed as an arg
-        OR         (c) if the function has free vars (ie not top level)
-
-  Why case (a) here?  Because if the arg-satis check fails,
-  UpdatePAP stuffs a pointer to the function closure in the PAP.
-  [Could be changed; UpdatePAP could stuff in a code ptr instead,
-   but doesn't seem worth it.]
-
-  [NB: these conditions imply that we might need the closure
-  without the slow-entry code.  Here's how.
-
-        f x y = let g w = ...x..y..w...
-                in
-                ...(g t)...
-
-  Here we need a closure for g which contains x and y,
-  but since the calls are all saturated we just jump to the
-  fast entry point for g, with R1 pointing to the closure for g.]
-
-
-* Standard info table
-        Needed iff (a) we have any un-saturated calls to the function
-        OR         (b) the function is passed as an arg
-        OR         (c) the function has free vars (ie not top level)
-
-        NB.  In the sequential world, (c) is only required so that the function closure has
-        an info table to point to, to keep the storage manager happy.
-        If (c) alone is true we could fake up an info table by choosing
-        one of a standard family of info tables, whose entry code just
-        bombs out.
-
-        [NB In the parallel world (c) is needed regardless because
-        we enter functions with free vars via the closure.]
-
-        If (c) is retained, then we'll sometimes generate an info table
-        (for storage mgr purposes) without slow-entry code.  Then we need
-        to use an error label in the info table to substitute for the absent
-        slow entry code.
--}
-
-staticClosureRequired
-        :: Name
-        -> StgBinderInfo
-        -> LambdaFormInfo
-        -> Bool
-staticClosureRequired binder bndr_info
-                      (LFReEntrant top_level _ _ _)        -- It's a function
-  = ASSERT( isTopLevel top_level )
-        -- Assumption: it's a top-level, no-free-var binding
-        not (satCallsOnly bndr_info)
-
-staticClosureRequired binder other_binder_info other_lf_info = True
--}
+getCallMethod _ _ _ _ _ _ _ _ = panic "Unknown call method"
 
 -----------------------------------------------------------------------------
 --              Data types for closure information
@@ -696,12 +661,15 @@ data ClosureInfo
     }
 
 -- | Convert from 'ClosureInfo' to 'CmmInfoTable'.
-mkCmmInfo :: ClosureInfo -> CmmInfoTable
-mkCmmInfo ClosureInfo {..}
+mkCmmInfo :: ClosureInfo -> Id -> CostCentreStack -> CmmInfoTable
+mkCmmInfo ClosureInfo {..} id ccs
   = CmmInfoTable { cit_lbl  = closureInfoLabel
                  , cit_rep  = closureSMRep
                  , cit_prof = closureProf
-                 , cit_srt  = NoC_SRT }
+                 , cit_srt  = Nothing
+                 , cit_clo  = if isStaticRep closureSMRep
+                                then Just (id,ccs)
+                                else Nothing }
 
 --------------------------------------
 --        Building ClosureInfos
@@ -756,7 +724,7 @@ blackHoleOnEntry cl_info
 
   | otherwise
   = case closureLFInfo cl_info of
-      LFReEntrant _ _ _ _       -> False
+      LFReEntrant {}            -> False
       LFLetNoEscape             -> False
       LFThunk _ _no_fvs upd _ _ -> upd   -- See Note [Black-holing non-updatable thunks]
       _other -> panic "blackHoleOnEntry"
@@ -764,7 +732,7 @@ blackHoleOnEntry cl_info
 {- Note [Black-holing non-updatable thunks]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We must not black-hole non-updatable (single-entry) thunks otherwise
-we run into issues like Trac #10414. Specifically:
+we run into issues like #10414. Specifically:
 
   * There is no reason to black-hole a non-updatable thunk: it should
     not be competed for by multiple threads
@@ -775,9 +743,9 @@ we run into issues like Trac #10414. Specifically:
 
   * It is dangerous to black-hole a non-updatable thunk because
      - is not updated (of course)
-     - hence, if it is black-holed and another thread tries to evalute
+     - hence, if it is black-holed and another thread tries to evaluate
        it, that thread will block forever
-    This actually happened in Trac #10414.  So we do not black-hole
+    This actually happened in #10414.  So we do not black-hole
     non-updatable thunks.
 
   * How could two threads evaluate the same non-updatable (single-entry)
@@ -787,7 +755,7 @@ we run into issues like Trac #10414. Specifically:
     thunk, because lazy black-holing only affects thunks with an
     update frame on the stack.
 
-Here is and example due to Reid Barton (Trac #10414):
+Here is and example due to Reid Barton (#10414):
     x = \u []  concat [[1], []]
 with the following definitions,
 
@@ -840,18 +808,19 @@ lfUpdatable _ = False
 
 closureSingleEntry :: ClosureInfo -> Bool
 closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd
+closureSingleEntry (ClosureInfo { closureLFInfo = LFReEntrant _ OneShotLam _ _ _}) = True
 closureSingleEntry _ = False
 
 closureReEntrant :: ClosureInfo -> Bool
-closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True
+closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant {} }) = True
 closureReEntrant _ = False
 
 closureFunInfo :: ClosureInfo -> Maybe (RepArity, ArgDescr)
 closureFunInfo (ClosureInfo { closureLFInfo = lf_info }) = lfFunInfo lf_info
 
 lfFunInfo :: LambdaFormInfo ->  Maybe (RepArity, ArgDescr)
-lfFunInfo (LFReEntrant _ arity _ arg_desc)  = Just (arity, arg_desc)
-lfFunInfo _                                 = Nothing
+lfFunInfo (LFReEntrant _ arity _ arg_desc)  = Just (arity, arg_desc)
+lfFunInfo _                                   = Nothing
 
 funTag :: DynFlags -> ClosureInfo -> DynTag
 funTag dflags (ClosureInfo { closureLFInfo = lf_info })
@@ -860,9 +829,9 @@ funTag dflags (ClosureInfo { closureLFInfo = lf_info })
 isToplevClosure :: ClosureInfo -> Bool
 isToplevClosure (ClosureInfo { closureLFInfo = lf_info })
   = case lf_info of
-      LFReEntrant TopLevel _ _ _ -> True
-      LFThunk TopLevel _ _ _ _   -> True
-      _other                         -> False
+      LFReEntrant TopLevel _ _ _ -> True
+      LFThunk TopLevel _ _ _ _     -> True
+      _other                       -> False
 
 --------------------------------------
 --   Label generation
@@ -948,25 +917,26 @@ enterIdLabel dflags id c
 mkProfilingInfo :: DynFlags -> Id -> String -> ProfilingInfo
 mkProfilingInfo dflags id val_descr
   | not (gopt Opt_SccProfilingOn dflags) = NoProfilingInfo
-  | otherwise = ProfilingInfo ty_descr_w8 val_descr_w8
+  | otherwise = ProfilingInfo ty_descr_w8 (BS8.pack val_descr)
   where
-    ty_descr_w8  = stringToWord8s (getTyDescription (idType id))
-    val_descr_w8 = stringToWord8s val_descr
+    ty_descr_w8  = BS8.pack (getTyDescription (idType id))
 
 getTyDescription :: Type -> String
 getTyDescription ty
   = case (tcSplitSigmaTy ty) of { (_, _, tau_ty) ->
     case tau_ty of
-      TyVarTy _                            -> "*"
-      AppTy fun _                   -> getTyDescription fun
-      FunTy _ res                   -> '-' : '>' : fun_result res
-      TyConApp tycon _              -> getOccString tycon
-      ForAllTy _ ty          -> getTyDescription ty
+      TyVarTy _              -> "*"
+      AppTy fun _            -> getTyDescription fun
+      TyConApp tycon _       -> getOccString tycon
+      FunTy {}              -> '-' : fun_result tau_ty
+      ForAllTy _  ty         -> getTyDescription ty
       LitTy n                -> getTyLitDescription n
+      CastTy ty _            -> getTyDescription ty
+      CoercionTy co          -> pprPanic "getTyDescription" (ppr co)
     }
   where
-    fun_result (FunTy _ res) = '>' : fun_result res
-    fun_result other             = getTyDescription other
+    fun_result (FunTy { ft_res = res }) = '>' : fun_result res
+    fun_result other                    = getTyDescription other
 
 getTyLitDescription :: TyLit -> String
 getTyLitDescription l =
@@ -983,22 +953,21 @@ mkDataConInfoTable dflags data_con is_static ptr_wds nonptr_wds
  = CmmInfoTable { cit_lbl  = info_lbl
                 , cit_rep  = sm_rep
                 , cit_prof = prof
-                , cit_srt  = NoC_SRT }
+                , cit_srt  = Nothing
+                , cit_clo  = Nothing }
  where
    name = dataConName data_con
-
-   info_lbl | is_static = mkStaticInfoTableLabel name NoCafRefs
-            | otherwise = mkConInfoTableLabel    name NoCafRefs
-
+   info_lbl = mkConInfoTableLabel name NoCafRefs
    sm_rep = mkHeapRep dflags is_static ptr_wds nonptr_wds cl_type
-
    cl_type = Constr (dataConTagZ data_con) (dataConIdentity data_con)
+                  -- We keep the *zero-indexed* tag in the srt_len field
+                  -- of the info table of a data constructor.
 
    prof | not (gopt Opt_SccProfilingOn dflags) = NoProfilingInfo
         | otherwise                            = ProfilingInfo ty_descr val_descr
 
-   ty_descr  = stringToWord8s $ occNameString $ getOccName $ dataConTyCon data_con
-   val_descr = stringToWord8s $ occNameString $ getOccName data_con
+   ty_descr  = BS8.pack $ occNameString $ getOccName $ dataConTyCon data_con
+   val_descr = BS8.pack $ occNameString $ getOccName data_con
 
 -- We need a black-hole closure info to pass to @allocDynClosure@ when we
 -- want to allocate the black hole on entry to a CAF.
@@ -1008,28 +977,24 @@ cafBlackHoleInfoTable
   = CmmInfoTable { cit_lbl  = mkCAFBlackHoleInfoTableLabel
                  , cit_rep  = blackHoleRep
                  , cit_prof = NoProfilingInfo
-                 , cit_srt  = NoC_SRT }
+                 , cit_srt  = Nothing
+                 , cit_clo  = Nothing }
 
 indStaticInfoTable :: CmmInfoTable
 indStaticInfoTable
   = CmmInfoTable { cit_lbl  = mkIndStaticInfoLabel
                  , cit_rep  = indStaticRep
                  , cit_prof = NoProfilingInfo
-                 , cit_srt  = NoC_SRT }
+                 , cit_srt  = Nothing
+                 , cit_clo  = Nothing }
 
 staticClosureNeedsLink :: Bool -> CmmInfoTable -> Bool
 -- A static closure needs a link field to aid the GC when traversing
 -- the static closure graph.  But it only needs such a field if either
---         a) it has an SRT
+--        a) it has an SRT
 --        b) it's a constructor with one or more pointer fields
 -- In case (b), the constructor's fields themselves play the role
 -- of the SRT.
---
--- At this point, the cit_srt field has not been calculated (that
--- happens right at the end of the Cmm pipeline), but we do have the
--- VarSet of CAFs that CoreToStg attached, and if that is empty there
--- will definitely not be an SRT.
---
 staticClosureNeedsLink has_srt CmmInfoTable{ cit_rep = smrep }
   | isConRep smrep         = not (isStaticNoCafCon smrep)
-  | otherwise              = has_srt -- needsSRT (cit_srt info_tbl)
+  | otherwise              = has_srt