Ticket #8041: 0001-Avoid-needlessly-splitting-a-UniqSupply-when-extract.patch

File 0001-Avoid-needlessly-splitting-a-UniqSupply-when-extract.patch, 5.0 KB (added by parcs, 2 years ago)
  • compiler/basicTypes/UniqSupply.lhs

    From f58bbfc9fd8e79ccf867eaff262389c17d0b7e6d Mon Sep 17 00:00:00 2001
    From: Patrick Palka <[email protected]>
    Date: Wed, 26 Jun 2013 10:21:06 -0400
    Subject: [PATCH] Avoid needlessly splitting a UniqSupply when extracting a
     Unique (#8041)
    
    In many places, 'splitUniqSupply' + 'uniqFromSupply' is used to split a
    UniqSupply into a Unique and a new UniqSupply. In such places we should
    instead use the more efficient and more appropriate
    'takeUniqFromSupply' (or equivalent).
    
    Not only is the former method slower, it also generates and throws away
    an extra Unique.
    ---
     compiler/basicTypes/UniqSupply.lhs | 8 ++++++--
     compiler/codeGen/StgCmmExpr.hs     | 4 ++--
     compiler/codeGen/StgCmmMonad.hs    | 6 ++++--
     compiler/simplCore/CoreMonad.lhs   | 6 ++++++
     compiler/simplCore/SimplMonad.lhs  | 4 ++--
     compiler/specialise/Specialise.lhs | 6 ++++++
     6 files changed, 26 insertions(+), 8 deletions(-)
    
    diff --git a/compiler/basicTypes/UniqSupply.lhs b/compiler/basicTypes/UniqSupply.lhs
    index fb07e73..0c6007a 100644
    a b class Monad m => MonadUnique m where 
    176176    -- | Get an infinite list of new unique identifiers
    177177    getUniquesM :: m [Unique]
    178178
     179    -- This default definition of getUniqueM, while correct, is not as
     180    -- efficient as it could be since it needlessly generates and throws away
     181    -- an extra Unique. For your instances consider providing an explicit
     182    -- definition for 'getUniqueM' which uses 'takeUniqFromSupply' directly.
    179183    getUniqueM  = liftM uniqFromSupply  getUniqueSupplyM
    180184    getUniquesM = liftM uniqsFromSupply getUniqueSupplyM
    181185
    instance MonadUnique UniqSM where 
    185189    getUniquesM = getUniquesUs
    186190
    187191getUniqueUs :: UniqSM Unique
    188 getUniqueUs = USM (\us -> case splitUniqSupply us of
    189                           (us1,us2) -> (# uniqFromSupply us1, us2 #))
     192getUniqueUs = USM (\us -> case takeUniqFromSupply us of
     193                          (u,us') -> (# u, us' #))
    190194
    191195getUniquesUs :: UniqSM [Unique]
    192196getUniquesUs = USM (\us -> case splitUniqSupply us of
  • compiler/codeGen/StgCmmExpr.hs

    diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs
    index d7edf8e..438058f 100644
    a b cgExpr (StgLit lit) = do cmm_lit <- cgLit lit 
    7070
    7171cgExpr (StgLet binds expr)             = do { cgBind binds;     cgExpr expr }
    7272cgExpr (StgLetNoEscape _ _ binds expr) =
    73   do { us <- newUniqSupply
    74      ; let join_id = mkBlockId (uniqFromSupply us)
     73  do { u <- newUnique
     74     ; let join_id = mkBlockId u
    7575     ; cgLneBinds join_id binds
    7676     ; r <- cgExpr expr
    7777     ; emitLabel join_id
  • compiler/codeGen/StgCmmMonad.hs

    diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs
    index 3f361e3..251b679 100644
    a b newUniqSupply = do 
    446446
    447447newUnique :: FCode Unique
    448448newUnique = do
    449         us <- newUniqSupply
    450         return (uniqFromSupply us)
     449        state <- getState
     450        let (u,us') = takeUniqFromSupply (cgs_uniqs state)
     451        setState $ state { cgs_uniqs = us' }
     452        return u
    451453
    452454------------------
    453455getInfoDown :: FCode CgInfoDownwards
  • compiler/simplCore/CoreMonad.lhs

    diff --git a/compiler/simplCore/CoreMonad.lhs b/compiler/simplCore/CoreMonad.lhs
    index 2aa42cc..04cdc36 100644
    a b instance MonadUnique CoreM where 
    783783        modifyS (\s -> s { cs_uniq_supply = us2 })
    784784        return us1
    785785
     786    getUniqueM = do
     787        us <- getS cs_uniq_supply
     788        let (u,us') = takeUniqFromSupply us
     789        modifyS (\s -> s { cs_uniq_supply = us' })
     790        return u
     791
    786792runCoreM :: HscEnv
    787793         -> RuleBase
    788794         -> UniqSupply
  • compiler/simplCore/SimplMonad.lhs

    diff --git a/compiler/simplCore/SimplMonad.lhs b/compiler/simplCore/SimplMonad.lhs
    index a5eb116..4c3c72d 100644
    a b instance MonadUnique SimplM where 
    145145                                (us1, us2) -> return (us1, us2, sc))
    146146
    147147    getUniqueM
    148        = SM (\_st_env us sc -> case splitUniqSupply us of
    149                                 (us1, us2) -> return (uniqFromSupply us1, us2, sc))
     148       = SM (\_st_env us sc -> case takeUniqFromSupply us of
     149                                (u, us') -> return (u, us', sc))
    150150
    151151    getUniquesM
    152152        = SM (\_st_env us sc -> case splitUniqSupply us of
  • compiler/specialise/Specialise.lhs

    diff --git a/compiler/specialise/Specialise.lhs b/compiler/specialise/Specialise.lhs
    index a161444..bf73bec 100644
    a b instance MonadUnique SpecM where 
    18821882                     put $ st { spec_uniq_supply = us2 }
    18831883                     return us1
    18841884
     1885    getUniqueM
     1886        = SpecM $ do st <- get
     1887                     let (u,us') = takeUniqFromSupply $ spec_uniq_supply st
     1888                     put $ st { spec_uniq_supply = us' }
     1889                     return u
     1890
    18851891instance HasDynFlags SpecM where
    18861892    getDynFlags = SpecM $ liftM spec_dflags get
    18871893