[commit: ghc] master: Rename topNormaliseType to topNormaliseType_maybe and add new, simpler topNormaliseType (97dfa2f)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/97dfa2fe36933339ceb58bff9a231a78aa1fe2c3/ghc

>---------------------------------------------------------------

commit 97dfa2fe36933339ceb58bff9a231a78aa1fe2c3
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Wed Oct 23 12:09:33 2013 +0100

    Rename topNormaliseType to topNormaliseType_maybe
    and add new, simpler topNormaliseType
    
    This is just a minor refactoring


>---------------------------------------------------------------

97dfa2fe36933339ceb58bff9a231a78aa1fe2c3
 compiler/basicTypes/MkId.lhs    |    6 ++----
 compiler/simplCore/Simplify.lhs |    4 ++--
 compiler/types/FamInstEnv.lhs   |   16 +++++++++++-----
 3 files changed, 15 insertions(+), 11 deletions(-)

diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index 05a49ea..df2af85 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -605,7 +605,7 @@ dataConArgRep dflags fam_envs arg_ty
   | not (gopt Opt_OmitInterfacePragmas dflags) -- Don't unpack if -fomit-iface-pragmas
           -- Don't unpack if we aren't optimising; rather arbitrarily, 
           -- we use -fomit-iface-pragmas as the indication
-  , let mb_co   = topNormaliseType fam_envs arg_ty
+  , let mb_co   = topNormaliseType_maybe fam_envs arg_ty
                      -- Unwrap type families and newtypes
         arg_ty' = case mb_co of { Just (_,ty) -> ty; Nothing -> arg_ty }
   , isUnpackableType fam_envs arg_ty'
@@ -712,9 +712,7 @@ isUnpackableType fam_envs ty
   where
     ok_arg tcs (ty, bang) = not (attempt_unpack bang) || ok_ty tcs norm_ty
         where
-          norm_ty = case topNormaliseType fam_envs ty of
-                      Just (_, ty) -> ty
-                      Nothing      -> ty
+          norm_ty = topNormaliseType fam_envs ty
     ok_ty tcs ty
       | Just (tc, _) <- splitTyConApp_maybe ty
       , let tc_name = getName tc
diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index d75694a..9b8684e 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -22,7 +22,7 @@ import IdInfo
 import Name             ( mkSystemVarName, isExternalName )
 import Coercion hiding  ( substCo, substTy, substCoVar, extendTvSubst )
 import OptCoercion      ( optCoercion )
-import FamInstEnv       ( topNormaliseType )
+import FamInstEnv       ( topNormaliseType_maybe )
 import DataCon          ( DataCon, dataConWorkId, dataConRepStrictness
                         , isMarkedStrict ) --, dataConTyCon, dataConTag, fIRST_TAG )
 --import TyCon            ( isEnumerationTyCon ) -- temporalily commented out. See #8326
@@ -2060,7 +2060,7 @@ improveSeq :: (FamInstEnv, FamInstEnv) -> SimplEnv
 -- Note [Improving seq]
 improveSeq fam_envs env scrut case_bndr case_bndr1 [(DEFAULT,_,_)]
   | not (isDeadBinder case_bndr) -- Not a pure seq!  See Note [Improving seq]
-  , Just (co, ty2) <- topNormaliseType fam_envs (idType case_bndr1)
+  , Just (co, ty2) <- topNormaliseType_maybe fam_envs (idType case_bndr1)
   = do { case_bndr2 <- newId (fsLit "nt") ty2
         ; let rhs  = DoneEx (Var case_bndr2 `Cast` mkSymCo co)
               env2 = extendIdSubst env case_bndr rhs
diff --git a/compiler/types/FamInstEnv.lhs b/compiler/types/FamInstEnv.lhs
index b6fdb35..7662dac 100644
--- a/compiler/types/FamInstEnv.lhs
+++ b/compiler/types/FamInstEnv.lhs
@@ -28,7 +28,8 @@ module FamInstEnv (
         isDominatedBy,
         
         -- Normalisation
-        chooseBranch, topNormaliseType, normaliseType, normaliseTcApp,
+        chooseBranch, topNormaliseType, topNormaliseType_maybe,
+        normaliseType, normaliseTcApp,
 
         -- Flattening
         flattenTys
@@ -835,9 +836,14 @@ findBranch [] _ _ = Nothing
 %************************************************************************
 
 \begin{code}
-topNormaliseType :: FamInstEnvs
-                 -> Type
-                 -> Maybe (Coercion, Type)
+topNormaliseType :: FamInstEnvs -> Type -> Type
+topNormaliseType env ty = case topNormaliseType_maybe env ty of
+                            Just (_co, ty') -> ty'
+                            Nothing         -> ty
+
+topNormaliseType_maybe :: FamInstEnvs
+                       -> Type
+                       -> Maybe (Coercion, Type)
 
 -- Get rid of *outermost* (or toplevel) 
 --      * type functions 
@@ -851,7 +857,7 @@ topNormaliseType :: FamInstEnvs
 -- Its a bit like Type.repType, but handles type families too
 -- The coercion returned is always an R coercion
 
-topNormaliseType env ty
+topNormaliseType_maybe env ty
   = go initRecTc ty
   where
     go :: RecTcChecker -> Type -> Maybe (Coercion, Type)