Commit 97dfa2fe authored by Simon Peyton Jones's avatar Simon Peyton Jones

Rename topNormaliseType to topNormaliseType_maybe

and add new, simpler topNormaliseType

This is just a minor refactoring
parent 3fb19a91
......@@ -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
......
......@@ -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
......
......@@ -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)
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment