Rename topNormaliseType to topNormaliseType_maybe
authorSimon Peyton Jones <simonpj@microsoft.com>
Wed, 23 Oct 2013 11:09:33 +0000 (12:09 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Wed, 23 Oct 2013 11:09:33 +0000 (12:09 +0100)
and add new, simpler topNormaliseType

This is just a minor refactoring

compiler/basicTypes/MkId.lhs
compiler/simplCore/Simplify.lhs
compiler/types/FamInstEnv.lhs

index 05a49ea..df2af85 100644 (file)
@@ -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
index d75694a..9b8684e 100644 (file)
@@ -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
index b6fdb35..7662dac 100644 (file)
@@ -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)