[Git][ghc/ghc][wip/T18282] Perf wibbles

[Simon Peyton Jones]

Simon Peyton Jones pushed to branch wip/T18282 at Glasgow Haskell Compiler / GHC


Commits:
aa45ef1f by Simon Peyton Jones at 2020-06-03T19:43:52+01:00
Perf wibbles

Document before committing

- - - - -


2 changed files:

- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/Unify.hs


Changes:

=====================================
compiler/GHC/Core/Coercion.hs
=====================================
@@ -2833,7 +2833,7 @@ simplifyArgsWorker orig_ki_binders orig_inner_ki orig_fvs
        -> [Role]      -- Roles at which to flatten these ...
        -> [(Type, Coercion)]  -- flattened arguments, with their flattening coercions
        -> ([Type], [Coercion], CoercionN)
-    go acc_xis acc_cos lc binders inner_ki _ []
+    go acc_xis acc_cos !lc binders inner_ki _ []
       = (reverse acc_xis, reverse acc_cos, kind_co)
       where
         final_kind = mkPiTys binders inner_ki


=====================================
compiler/GHC/Core/Unify.hs
=====================================
@@ -1,6 +1,6 @@
 -- (c) The University of Glasgow 2006
 
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ScopedTypeVariables, PatternSynonyms, BangPatterns #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveFunctor #-}
 
@@ -44,6 +44,7 @@ import GHC.Data.Pair
 import GHC.Utils.Outputable
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Set
+import GHC.Exts( oneShot )
 
 import Control.Monad
 import Control.Applicative hiding ( empty )
@@ -1235,8 +1236,14 @@ data UMState = UMState
                    { um_tv_env   :: TvSubstEnv
                    , um_cv_env   :: CvSubstEnv }
 
-newtype UM a = UM { unUM :: UMState -> UnifyResultM (UMState, a) }
-    deriving (Functor)
+newtype UM a
+  = UMNoEta { unUM :: UMState -> UnifyResultM (UMState, a) }
+  deriving (Functor)
+
+pattern UM :: (UMState -> UnifyResultM (UMState, a)) -> UM a
+pattern UM m <- UMNoEta m
+  where
+    UM m = UMNoEta (oneShot m)
 
 instance Applicative UM where
       pure a = UM (\s -> pure (s, a))



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aa45ef1f9b534b44982999c4a71842cca33b31f4

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aa45ef1f9b534b44982999c4a71842cca33b31f4
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200603/c8624849/attachment-0001.html>