summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2022-07-12 16:01:14 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-07-18 16:38:04 -0400
commit5f907371996735d13a4f9c87d235a18a68022e4e (patch)
tree192ecdd8be69c3185199226c911339e07bbe5e3b
parentd4d3fe6e02c0eb2117dbbc9df72ae394edf50f06 (diff)
downloadhaskell-5f907371996735d13a4f9c87d235a18a68022e4e.tar.gz
White space only in FamInstEnv
-rw-r--r--compiler/GHC/Core/FamInstEnv.hs64
1 files changed, 34 insertions, 30 deletions
diff --git a/compiler/GHC/Core/FamInstEnv.hs b/compiler/GHC/Core/FamInstEnv.hs
index bfbd2000cb..0e6670f7ec 100644
--- a/compiler/GHC/Core/FamInstEnv.hs
+++ b/compiler/GHC/Core/FamInstEnv.hs
@@ -1323,12 +1323,46 @@ topNormaliseType_maybe env ty
_ -> NS_Done
---------------
+-- | Try to simplify a type-family application, by *one* step
+-- If topReduceTyFamApp_maybe env r F tys = Just (HetReduction (Reduction co rhs) res_co)
+-- then co :: F tys ~R# rhs
+-- res_co :: typeKind(F tys) ~ typeKind(rhs)
+-- Type families and data families; always Representational role
+topReduceTyFamApp_maybe :: FamInstEnvs -> TyCon -> [Type]
+ -> Maybe HetReduction
+topReduceTyFamApp_maybe envs fam_tc arg_tys
+ | isFamilyTyCon fam_tc -- type families and data families
+ , Just redn <- reduceTyFamApp_maybe envs role fam_tc ntys
+ = Just $
+ mkHetReduction
+ (mkTyConAppCo role fam_tc args_cos `mkTransRedn` redn)
+ res_co
+ | otherwise
+ = Nothing
+ where
+ role = Representational
+ ArgsReductions (Reductions args_cos ntys) res_co
+ = initNormM envs role (tyCoVarsOfTypes arg_tys)
+ $ normalise_tc_args fam_tc arg_tys
+
+---------------
+normaliseType :: FamInstEnvs
+ -> Role -- desired role of coercion
+ -> Type -> Reduction
+normaliseType env role ty
+ = initNormM env role (tyCoVarsOfType ty) $ normalise_type ty
+
+---------------
normaliseTcApp :: FamInstEnvs -> Role -> TyCon -> [Type] -> Reduction
-- See comments on normaliseType for the arguments of this function
normaliseTcApp env role tc tys
= initNormM env role (tyCoVarsOfTypes tys) $
normalise_tc_app tc tys
+-------------------------------------------------------
+-- Functions that work in the NormM monad
+-------------------------------------------------------
+
-- See Note [Normalising types] about the LiftingContext
normalise_tc_app :: TyCon -> [Type] -> NormM Reduction
normalise_tc_app tc tys
@@ -1371,41 +1405,11 @@ normalise_tc_app tc tys
assemble_result r redn kind_co
= mkCoherenceRightMRedn r redn (mkSymMCo kind_co)
----------------
--- | Try to simplify a type-family application, by *one* step
--- If topReduceTyFamApp_maybe env r F tys = Just (HetReduction (Reduction co rhs) res_co)
--- then co :: F tys ~R# rhs
--- res_co :: typeKind(F tys) ~ typeKind(rhs)
--- Type families and data families; always Representational role
-topReduceTyFamApp_maybe :: FamInstEnvs -> TyCon -> [Type]
- -> Maybe HetReduction
-topReduceTyFamApp_maybe envs fam_tc arg_tys
- | isFamilyTyCon fam_tc -- type families and data families
- , Just redn <- reduceTyFamApp_maybe envs role fam_tc ntys
- = Just $
- mkHetReduction
- (mkTyConAppCo role fam_tc args_cos `mkTransRedn` redn)
- res_co
- | otherwise
- = Nothing
- where
- role = Representational
- ArgsReductions (Reductions args_cos ntys) res_co
- = initNormM envs role (tyCoVarsOfTypes arg_tys)
- $ normalise_tc_args fam_tc arg_tys
-
normalise_tc_args :: TyCon -> [Type] -> NormM ArgsReductions
normalise_tc_args tc tys
= do { role <- getRole
; normalise_args (tyConKind tc) (tyConRolesX role tc) tys }
----------------
-normaliseType :: FamInstEnvs
- -> Role -- desired role of coercion
- -> Type -> Reduction
-normaliseType env role ty
- = initNormM env role (tyCoVarsOfType ty) $ normalise_type ty
-
normalise_type :: Type -> NormM Reduction
-- Normalise the input type, by eliminating *all* type-function redexes
-- but *not* newtypes (which are visible to the programmer)