Get rid of tcm_smart from TyCoMapper
authorSimon Peyton Jones <simonpj@microsoft.com>
Fri, 15 Feb 2019 09:56:06 +0000 (09:56 +0000)
committerMarge Bot <ben+marge-bot@smart-cactus.org>
Mon, 18 Feb 2019 00:58:29 +0000 (19:58 -0500)
Following a succession of refactorings of the type checker,
culminating in the patch
       Make a smart mkAppTyM
we have got rid of mkNakedAppTy etc.  And that in turn
meant that the tcm_smart field of the generic TyCoMapper
(in Type.hs) was entirely unused.  It was always set to True.

So this patch just gets rid of it completely.  Less code,
less complexity, and more efficient because fewer higher-order
function calls.  Everyone wins.

No change in behaviour; this does not cure any bugs!

compiler/typecheck/TcHsSyn.hs
compiler/typecheck/TcHsType.hs
compiler/typecheck/TcMType.hs
compiler/types/Type.hs

index 3f7a325..8b815bb 100644 (file)
@@ -1848,12 +1848,11 @@ zonkCoHole env hole@(CoercionHole { ch_ref = ref, ch_co_var = cv })
 
 zonk_tycomapper :: TyCoMapper ZonkEnv TcM
 zonk_tycomapper = TyCoMapper
-  { tcm_smart = True   -- Establish type invariants
-  , tcm_tyvar = zonkTyVarOcc
-  , tcm_covar = zonkCoVarOcc
-  , tcm_hole  = zonkCoHole
+  { tcm_tyvar      = zonkTyVarOcc
+  , tcm_covar      = zonkCoVarOcc
+  , tcm_hole       = zonkCoHole
   , tcm_tycobinder = \env tv _vis -> zonkTyBndrX env tv
-  , tcm_tycon = zonkTcTyConToTyCon }
+  , tcm_tycon      = zonkTcTyConToTyCon }
 
 -- Zonk a TyCon by changing a TcTyCon to a regular TyCon
 zonkTcTyConToTyCon :: TcTyCon -> TcM TyCon
index cae0b5b..91b7aa2 100644 (file)
@@ -2809,8 +2809,7 @@ zonkPromoteType = mapType zonkPromoteMapper ()
 
 -- cf. TcMType.zonkTcTypeMapper
 zonkPromoteMapper :: TyCoMapper () TcM
-zonkPromoteMapper = TyCoMapper { tcm_smart    = True
-                               , tcm_tyvar    = const zonkPromoteTcTyVar
+zonkPromoteMapper = TyCoMapper { tcm_tyvar    = const zonkPromoteTcTyVar
                                , tcm_covar    = const covar
                                , tcm_hole     = const hole
                                , tcm_tycobinder = const tybinder
index c12c2f6..ded352c 100644 (file)
@@ -1939,12 +1939,11 @@ zonkCoVar = zonkId
 -- before all metavars are filled in.
 zonkTcTypeMapper :: TyCoMapper () TcM
 zonkTcTypeMapper = TyCoMapper
-  { tcm_smart = True
-  , tcm_tyvar = const zonkTcTyVar
+  { tcm_tyvar = const zonkTcTyVar
   , tcm_covar = const (\cv -> mkCoVarCo <$> zonkTyCoVarKind cv)
   , tcm_hole  = hole
   , tcm_tycobinder = \_env tv _vis -> ((), ) <$> zonkTyCoVarKind tv
-  , tcm_tycon = zonk_tc_tycon }
+  , tcm_tycon      = zonkTcTyCon }
   where
     hole :: () -> CoercionHole -> TcM Coercion
     hole _ hole@(CoercionHole { ch_ref = ref, ch_co_var = cv })
@@ -1955,11 +1954,14 @@ zonkTcTypeMapper = TyCoMapper
                Nothing -> do { cv' <- zonkCoVar cv
                              ; return $ HoleCo (hole { ch_co_var = cv' }) } }
 
-    zonk_tc_tycon tc  -- A non-poly TcTyCon may have unification
-                      -- variables that need zonking, but poly ones cannot
-      | tcTyConIsPoly tc = return tc
-      | otherwise        = do { tck' <- zonkTcType (tyConKind tc)
-                              ; return (setTcTyConKind tc tck') }
+zonkTcTyCon :: TcTyCon -> TcM TcTyCon
+-- Only called on TcTyCons
+-- A non-poly TcTyCon may have unification
+-- variables that need zonking, but poly ones cannot
+zonkTcTyCon tc
+ | tcTyConIsPoly tc = return tc
+ | otherwise        = do { tck' <- zonkTcType (tyConKind tc)
+                         ; return (setTcTyConKind tc tck') }
 
 -- For unbound, mutable tyvars, zonkType uses the function given to it
 -- For tyvars bound at a for-all, zonkType zonks them to an immutable
index 6590489..945d7e1 100644 (file)
@@ -527,9 +527,7 @@ this one change made a 20% allocation difference in perf/compiler/T5030.
 -- | This describes how a "map" operation over a type/coercion should behave
 data TyCoMapper env m
   = TyCoMapper
-      { tcm_smart :: Bool -- ^ Should the new type be created with smart
-                          -- constructors?
-      , tcm_tyvar :: env -> TyVar -> m Type
+      { tcm_tyvar :: env -> TyVar -> m Type
       , tcm_covar :: env -> CoVar -> m Coercion
       , tcm_hole  :: env -> CoercionHole -> m Coercion
           -- ^ What to do with coercion holes.
@@ -548,24 +546,25 @@ data TyCoMapper env m
 
 {-# INLINABLE mapType #-}  -- See Note [Specialising mappers]
 mapType :: Monad m => TyCoMapper env m -> env -> Type -> m Type
-mapType mapper@(TyCoMapper { tcm_smart = smart, tcm_tyvar = tyvar
-                           , tcm_tycobinder = tycobinder, tcm_tycon = tycon })
+mapType mapper@(TyCoMapper { tcm_tyvar = tyvar
+                           , tcm_tycobinder = tycobinder
+                           , tcm_tycon = tycon })
         env ty
   = go ty
   where
     go (TyVarTy tv) = tyvar env tv
-    go (AppTy t1 t2) = mkappty <$> go t1 <*> go t2
+    go (AppTy t1 t2) = mkAppTy <$> go t1 <*> go t2
     go ty@(TyConApp tc tys)
       | isTcTyCon tc
       = do { tc' <- tycon tc
-           ; mktyconapp tc' <$> mapM go tys }
+           ; mkTyConApp tc' <$> mapM go tys }
 
       -- Not a TcTyCon
       | null tys    -- Avoid allocation in this very
       = return ty   -- common case (E.g. Int, LiftedRep etc)
 
       | otherwise
-      = mktyconapp tc <$> mapM go tys 
+      = mkTyConApp tc <$> mapM go tys
 
     go (FunTy arg res)   = FunTy <$> go arg <*> go res
     go (ForAllTy (Bndr tv vis) inner)
@@ -573,18 +572,15 @@ mapType mapper@(TyCoMapper { tcm_smart = smart, tcm_tyvar = tyvar
            ; inner' <- mapType mapper env' inner
            ; return $ ForAllTy (Bndr tv' vis) inner' }
     go ty@(LitTy {})   = return ty
-    go (CastTy ty co)  = mkcastty <$> go ty <*> mapCoercion mapper env co
+    go (CastTy ty co)  = mkCastTy <$> go ty <*> mapCoercion mapper env co
     go (CoercionTy co) = CoercionTy <$> mapCoercion mapper env co
 
-    (mktyconapp, mkappty, mkcastty)
-      | smart     = (mkTyConApp, mkAppTy, mkCastTy)
-      | otherwise = (TyConApp,   AppTy,   CastTy)
-
 {-# INLINABLE mapCoercion #-}  -- See Note [Specialising mappers]
 mapCoercion :: Monad m
             => TyCoMapper env m -> env -> Coercion -> m Coercion
-mapCoercion mapper@(TyCoMapper { tcm_smart = smart, tcm_covar = covar
-                               , tcm_hole = cohole, tcm_tycobinder = tycobinder
+mapCoercion mapper@(TyCoMapper { tcm_covar = covar
+                               , tcm_hole = cohole
+                               , tcm_tycobinder = tycobinder
                                , tcm_tycon = tycon })
             env co
   = go co
@@ -593,53 +589,41 @@ mapCoercion mapper@(TyCoMapper { tcm_smart = smart, tcm_covar = covar
     go_mco (MCo co) = MCo <$> (go co)
 
     go (Refl ty) = Refl <$> mapType mapper env ty
-    go (GRefl r ty mco) = mkgreflco r <$> mapType mapper env ty <*> (go_mco mco)
+    go (GRefl r ty mco) = mkGReflCo r <$> mapType mapper env ty <*> (go_mco mco)
     go (TyConAppCo r tc args)
       = do { tc' <- if isTcTyCon tc
                     then tycon tc
                     else return tc
-           ; mktyconappco r tc' <$> mapM go args }
-    go (AppCo c1 c2) = mkappco <$> go c1 <*> go c2
+           ; mkTyConAppCo r tc' <$> mapM go args }
+    go (AppCo c1 c2) = mkAppCo <$> go c1 <*> go c2
     go (ForAllCo tv kind_co co)
       = do { kind_co' <- go kind_co
            ; (env', tv') <- tycobinder env tv Inferred
            ; co' <- mapCoercion mapper env' co
-           ; return $ mkforallco tv' kind_co' co' }
+           ; return $ mkForAllCo tv' kind_co' co' }
         -- See Note [Efficiency for mapCoercion ForAllCo case]
     go (FunCo r c1 c2) = mkFunCo r <$> go c1 <*> go c2
     go (CoVarCo cv) = covar env cv
     go (AxiomInstCo ax i args)
-      = mkaxiominstco ax i <$> mapM go args
+      = mkAxiomInstCo ax i <$> mapM go args
     go (HoleCo hole) = cohole env hole
     go (UnivCo p r t1 t2)
-      = mkunivco <$> go_prov p <*> pure r
+      = mkUnivCo <$> go_prov p <*> pure r
                  <*> mapType mapper env t1 <*> mapType mapper env t2
-    go (SymCo co) = mksymco <$> go co
-    go (TransCo c1 c2) = mktransco <$> go c1 <*> go c2
+    go (SymCo co) = mkSymCo <$> go co
+    go (TransCo c1 c2) = mkTransCo <$> go c1 <*> go c2
     go (AxiomRuleCo r cos) = AxiomRuleCo r <$> mapM go cos
-    go (NthCo r i co)      = mknthco r i <$> go co
-    go (LRCo lr co)        = mklrco lr <$> go co
-    go (InstCo co arg)     = mkinstco <$> go co <*> go arg
-    go (KindCo co)         = mkkindco <$> go co
-    go (SubCo co)          = mksubco <$> go co
+    go (NthCo r i co)      = mkNthCo r i <$> go co
+    go (LRCo lr co)        = mkLRCo lr <$> go co
+    go (InstCo co arg)     = mkInstCo <$> go co <*> go arg
+    go (KindCo co)         = mkKindCo <$> go co
+    go (SubCo co)          = mkSubCo <$> go co
 
     go_prov UnsafeCoerceProv    = return UnsafeCoerceProv
     go_prov (PhantomProv co)    = PhantomProv <$> go co
     go_prov (ProofIrrelProv co) = ProofIrrelProv <$> go co
     go_prov p@(PluginProv _)    = return p
 
-    ( mktyconappco, mkappco, mkaxiominstco, mkunivco
-      , mksymco, mktransco, mknthco, mklrco, mkinstco
-      , mkkindco, mksubco, mkforallco, mkgreflco)
-      | smart
-      = ( mkTyConAppCo, mkAppCo, mkAxiomInstCo, mkUnivCo
-        , mkSymCo, mkTransCo, mkNthCo, mkLRCo, mkInstCo
-        , mkKindCo, mkSubCo, mkForAllCo, mkGReflCo )
-      | otherwise
-      = ( TyConAppCo, AppCo, AxiomInstCo, UnivCo
-        , SymCo, TransCo, NthCo, LRCo, InstCo
-        , KindCo, SubCo, ForAllCo, GRefl )
-
 {-
 ************************************************************************
 *                                                                      *