[Git][ghc/ghc][wip/tyconapp-opts] Some cleanup
Ben Gamari
gitlab at gitlab.haskell.org
Thu Apr 9 04:15:29 UTC 2020
Ben Gamari pushed to branch wip/tyconapp-opts at Glasgow Haskell Compiler / GHC
Commits:
0038463c by Ben Gamari at 2020-04-09T00:15:14-04:00
Some cleanup
- - - - -
6 changed files:
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Core/Unify.hs
- compiler/prelude/TysPrim.hs
- compiler/typecheck/TcCanonical.hs
- compiler/typecheck/TcType.hs
Changes:
=====================================
compiler/GHC/Core/TyCon.hs
=====================================
@@ -2289,16 +2289,13 @@ expandSynTyCon_maybe
expandSynTyCon_maybe tc tys
| SynonymTyCon { tyConTyVars = tvs, synTcRhs = rhs, tyConArity = arity } <- tc
= case tys of
- [] -> Just ([], rhs, tys)
+ [] -> Just ([], rhs, []) -- Avoid a bit of work in the case of nullary synonyms
_ -> case tys `listLengthCmp` arity of
GT -> Just (tvs `zip` tys, rhs, drop arity tys)
EQ -> Just (tvs `zip` tys, rhs, [])
LT -> Nothing
| otherwise
= Nothing
-{-# INLINE expandSynTyCon_maybe #-}
--- Inline to avoid allocation of tuples due to lack of nested CPR on sums.
--- Particularly relevant to coreView and tcView, which are hammered.
----------------
=====================================
compiler/GHC/Core/Type.hs
=====================================
@@ -350,18 +350,16 @@ See also #11715, which tracks removing this inconsistency.
-}
-- | Gives the typechecker view of a type. This unwraps synonyms but
--- leaves 'Constraint' alone. c.f. coreView, which turns Constraint into
--- TYPE LiftedRep. Returns Nothing if no unwrapping happens.
+-- leaves 'Constraint' alone. c.f. 'coreView', which turns 'Constraint' into
+-- @TYPE LiftedRep at . Returns 'Nothing' if no unwrapping happens.
-- See also Note [coreView vs tcView]
{-# INLINE tcView #-}
tcView :: Type -> Maybe Type
tcView (TyConApp tc tys)
- | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys
- = Just $ case tenv of
- [] -> mkAppTys rhs tys'
- _ -> mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys'
+ | res@(Just _) <- expandSynTyConApp_maybe tc tys
+ = res
-- The free vars of 'rhs' should all be bound by 'tenv', so it's
- -- ok to use 'substTy' here.
+ -- ok to use 'substTy' here (which is what expandSynTyConApp_maybe does).
-- See also Note [The substitution invariant] in GHC.Core.TyCo.Subst.
-- Its important to use mkAppTys, rather than (foldl AppTy),
-- because the function part might well return a
@@ -370,19 +368,16 @@ tcView _ = Nothing
{-# INLINE coreView #-}
coreView :: Type -> Maybe Type
--- ^ This function Strips off the /top layer only/ of a type synonym
+-- ^ This function strips off the /top layer only/ of a type synonym
-- application (if any) its underlying representation type.
--- Returns Nothing if there is nothing to look through.
+-- Returns 'Nothing' if there is nothing to look through.
-- This function considers 'Constraint' to be a synonym of @TYPE LiftedRep at .
--
-- By being non-recursive and inlined, this case analysis gets efficiently
-- joined onto the case analysis that the caller is already doing
coreView ty@(TyConApp tc tys)
- | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys
- = Just $ case tenv of
- [] -> mkAppTys rhs tys'
- _ -> mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys'
- -- This equation is exactly like tcView
+ | res@(Just _) <- expandSynTyConApp_maybe tc tys
+ = res
-- At the Core level, Constraint = Type
-- See Note [coreView vs tcView]
@@ -393,6 +388,21 @@ coreView ty@(TyConApp tc tys)
coreView _ = Nothing
-----------------------------------------------
+expandSynTyConApp_maybe :: TyCon -> [Type] -> Maybe Type
+expandSynTyConApp_maybe tc tys
+ | Just (tvs, rhs) <- synTyConDefn_maybe tc
+ = case tys of
+ [] -> Just (mkAppTys rhs tys)
+ _ -> case tys `listLengthCmp` arity of
+ GT -> Just (mkAppTys rhs' (drop arity tys))
+ EQ -> Just rhs'
+ LT -> Nothing
+ where
+ arity = tyConArity tc
+ rhs' = substTy (mkTvSubstPrs (tvs `zip` tys)) rhs
+ | otherwise
+ = Nothing
+
expandTypeSynonyms :: Type -> Type
-- ^ Expand out all type synonyms. Actually, it'd suffice to expand out
-- just the ones that discard type variables (e.g. type Funny a = Int)
@@ -1223,8 +1233,10 @@ TyConApp constructors were all duplicates of `Type` applied to no arguments.
Therefore in `mkTyConApp` we have a special case for `Type` to ensure that
only one `TyConApp 'Type []` closure is allocated during the course of
-compilation. In order to avoid a potentially expensive series of checks in
-`mkTyConApp` only this egregious case is special cased at the moment.
+compilation.
+
+We also have a similar special-case for applications of TYPE; see
+Note [Prefer Type over TYPE 'LiftedPtrRep] for details.
---------------------------------------------------------------------
@@ -1236,7 +1248,6 @@ compilation. In order to avoid a potentially expensive series of checks in
-- its arguments. Applies its arguments to the constructor from left to right.
mkTyConApp :: TyCon -> [Type] -> Type
mkTyConApp tycon tys
--- TODO: TYPE 'LiftedRep
| isFunTyCon tycon
, [_rep1,_rep2,ty1,ty2] <- tys
-- The FunTyCon (->) is always a visible one
@@ -1245,7 +1256,7 @@ mkTyConApp tycon tys
| tycon == liftedTypeKindTyCon
= ASSERT2( null tys, ppr tycon $$ ppr tys )
liftedTypeKindTyConApp
- -- Note [mkTyConApp and Type]
+ -- Note [Prefer Type over TYPE 'LiftedPtrRep]
| tycon == tYPETyCon
, [rep] <- tys
= tYPE rep
@@ -2203,6 +2214,36 @@ But the left is an AppTy while the right is a TyConApp. The solution is
to use repSplitAppTy_maybe to break up the TyConApp into its pieces and
then continue. Easy to do, but also easy to forget to do.
+
+Note [Comparing nullary type synonyms]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider the task of testing equality between two 'Type's of the form
+
+ TyConApp tc []
+
+where @tc@ is a type synonym. A naive way to perform this comparison these
+would first expand the synonym and then compare the resulting expansions.
+
+However, this is obviously wasteful and the RHS of @tc@ may be large; it is
+much better to rather compare the TyCons directly. Consequently, before
+expanding type synonyms in type comparisons we first look for a nullary
+TyConApp and simply compare the TyCons if we find one. Of course, if we find
+that the TyCons are *not* equal then we still need to perform the expansion as
+their RHSs may still be equal.
+
+We perform this optimisation in a number of places:
+
+ * GHC.Core.Types.eqType
+ * GHC.Core.Types.nonDetCmpType
+ * GHC.Core.Unify.unify_ty
+ * TcCanonical.can_eq_nc'
+ * TcUnify.uType
+
+This optimisation is especially helpful for the ubiquitous GHC.Types.Type,
+since GHC prefers to use the type synonym over @TYPE 'LiftedPtr@ applications
+whenever possible. See [Prefer Type over TYPE 'LiftedPtrRep] in TysPrim for
+details.
+
-}
eqType :: Type -> Type -> Bool
@@ -2276,7 +2317,6 @@ data TypeOrdering = TLT -- ^ @t1 < t2@
| TGT -- ^ @t1 > t2@
deriving (Eq, Ord, Enum, Bounded)
--- TODO: nullary synonym optimization
nonDetCmpTypeX :: RnEnv2 -> Type -> Type -> Ordering -- Main workhorse
-- See Note [Non-trivial definitional equality] in GHC.Core.TyCo.Rep
nonDetCmpTypeX env orig_t1 orig_t2 =
=====================================
compiler/GHC/Core/Unify.hs
=====================================
@@ -957,7 +957,7 @@ unify_ty :: UMEnv
-- Respects newtypes, PredTypes
unify_ty env ty1 ty2 kco
- -- See Note [Comparing nullary type synonyms].
+ -- See Note [Comparing nullary type synonyms] in GHC.Core.Type.
| TyConApp tc1 [] <- ty1
, TyConApp tc2 [] <- ty2
, tc1 == tc2 = return ()
=====================================
compiler/prelude/TysPrim.hs
=====================================
@@ -527,11 +527,35 @@ mkPrimTcName built_in_syntax occ key tycon
-- | Given a RuntimeRep, applies TYPE to it.
-- see Note [TYPE and RuntimeRep]
tYPE :: Type -> Type
- -- static cases
tYPE (TyConApp tc [])
| tc `hasKey` liftedRepDataConKey = liftedTypeKind -- TYPE 'LiftedPtrRep
tYPE rr = TyConApp tYPETyCon [rr]
+-- Note [Prefer Type over TYPE 'LiftedPtrRep]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+--
+-- The Core of nearly any program will have numerous occurrences of
+-- @TYPE 'LiftedPtrRep@ floating about. Consequently, we try hard to ensure
+-- that operations on such types are efficient:
+--
+-- * Instead of representing the lifted kind as
+-- @TyConApp tYPETyCon [liftedRepDataCon]@ we rather prefer to
+-- use the 'GHC.Types.Type' type synonym (available in GHC as
+-- 'TysPrim.liftedTypeKind'). Note only is this a smaller AST but it also
+-- guarantees sharing on the heap.
+--
+-- * To avoid allocating 'TyConApp' constructors 'TysPrim.tYPE'
+-- catches the lifted case and uses `liftedTypeKind` instead of building an
+-- application.
+--
+-- * Similarly, 'Type.mkTyConApp' catches applications of TYPE and
+-- handles them using 'TysPrim.tYPE', ensuring that it benefits from the
+-- optimisation described above.
+--
+-- * Since 'liftedTypeKind' is a nullary type synonym application,
+-- it benefits from the optimisation described in Note [Comparing nullary
+-- type synonyms] in "GHC.Core.Type".
+
{-
************************************************************************
* *
=====================================
compiler/typecheck/TcCanonical.hs
=====================================
@@ -969,14 +969,13 @@ can_eq_nc'
-> Type -> Type -- RHS, after and before type-synonym expansion, resp
-> TcS (StopOrContinue Ct)
--- See Note [Comparing nullary type synonyms].
+-- See Note [Comparing nullary type synonyms] in GHC.Core.Type.
can_eq_nc' _flat _rdr_env _envs ev eq_rel ty1@(TyConApp tc1 []) _ps_ty1 (TyConApp tc2 []) _ps_ty2
| tc1 == tc2
= canEqReflexive ev eq_rel ty1
-- Expand synonyms first; see Note [Type synonyms and canonicalization]
can_eq_nc' flat rdr_env envs ev eq_rel ty1 ps_ty1 ty2 ps_ty2
--- TODO: Handle nullary synonyms
| Just ty1' <- tcView ty1 = can_eq_nc' flat rdr_env envs ev eq_rel ty1' ps_ty1 ty2 ps_ty2
| Just ty2' <- tcView ty2 = can_eq_nc' flat rdr_env envs ev eq_rel ty1 ps_ty1 ty2' ps_ty2
=====================================
compiler/typecheck/TcType.hs
=====================================
@@ -1533,7 +1533,7 @@ tc_eq_type keep_syns vis_only orig_ty1 orig_ty2
= go orig_env orig_ty1 orig_ty2
where
go :: RnEnv2 -> Type -> Type -> Bool
- -- See Note [Comparing nullary type synonyms].
+ -- See Note [Comparing nullary type synonyms] in GHC.Core.Type.
go _ (TyConApp tc1 []) (TyConApp tc2 [])
| tc1 == tc2
= True
@@ -1570,7 +1570,6 @@ tc_eq_type keep_syns vis_only orig_ty1 orig_ty2
= go env s1 s2 && go env t1 t2
go env (TyConApp tc1 ts1) (TyConApp tc2 ts2)
- -- TODO: nullary synonym optimisation
= tc1 == tc2 && gos env (tc_vis tc1) ts1 ts2
go env (CastTy t1 _) t2 = go env t1 t2
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0038463cb7070090b9e62f0c5278a8f8f47ac7df
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0038463cb7070090b9e62f0c5278a8f8f47ac7df
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200409/fac32f2d/attachment-0001.html>
More information about the ghc-commits
mailing list