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, 23 months 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