[Git][ghc/ghc][wip/tyconapp-opts] Notes from call
Ben Gamari
gitlab at gitlab.haskell.org
Thu Mar 26 04:27:35 UTC 2020
Ben Gamari pushed to branch wip/tyconapp-opts at Glasgow Haskell Compiler / GHC
Commits:
f25cda0c by Ben Gamari at 2020-03-26T00:27:25-04:00
Notes from call
- - - - -
15 changed files:
- compiler/GHC/Core/Type.hs
- compiler/GHC/Core/Unify.hs
- compiler/prelude/TysPrim.hs
- compiler/prelude/TysWiredIn.hs
- compiler/typecheck/TcCanonical.hs
- compiler/typecheck/TcType.hs
- testsuite/tests/deSugar/should_compile/T2431.stderr
- testsuite/tests/deriving/should_compile/T14578.stderr
- testsuite/tests/plugins/plugins09.stdout
- testsuite/tests/plugins/plugins10.stdout
- testsuite/tests/plugins/plugins11.stdout
- testsuite/tests/plugins/static-plugins.stdout
- testsuite/tests/simplCore/should_compile/T13143.stderr
- testsuite/tests/simplCore/should_compile/T7360.stderr
- testsuite/tests/typecheck/should_compile/T13032.stderr
Changes:
=====================================
compiler/GHC/Core/Type.hs
=====================================
@@ -1231,6 +1231,7 @@ 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
@@ -1239,6 +1240,10 @@ mkTyConApp tycon tys
| tycon == liftedTypeKindTyCon
= ASSERT2( null tys, ppr tycon $$ ppr tys )
liftedTypeKindTyConApp
+ -- Note [mkTyConApp and Type]
+ | tycon == tYPETyCon
+ , [rep] <- tys
+ = tYPE rep
| otherwise
= TyConApp tycon tys
@@ -2266,6 +2271,7 @@ 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 =
@@ -2301,6 +2307,10 @@ nonDetCmpTypeX env orig_t1 orig_t2 =
-- Returns both the resulting ordering relation between the two types
-- and whether either contains a cast.
go :: RnEnv2 -> Type -> Type -> TypeOrdering
+ -- See Note [Comparing nullary type synonyms].
+ go _ (TyConApp tc1 []) (TyConApp tc2 [])
+ | tc1 == tc2
+ = TEQ
go env t1 t2
| Just t1' <- coreView t1 = go env t1' t2
| Just t2' <- coreView t2 = go env t1 t2'
=====================================
compiler/GHC/Core/Unify.hs
=====================================
@@ -957,6 +957,11 @@ unify_ty :: UMEnv
-- Respects newtypes, PredTypes
unify_ty env ty1 ty2 kco
+ -- See Note [Comparing nullary type synonyms].
+ | TyConApp tc1 [] <- ty1
+ , TyConApp tc2 [] <- ty2
+ , tc1 == tc2 = return ()
+
-- TODO: More commentary needed here
| Just ty1' <- tcView ty1 = unify_ty env ty1' ty2 kco
| Just ty2' <- tcView ty2 = unify_ty env ty1 ty2' kco
=====================================
compiler/prelude/TysPrim.hs
=====================================
@@ -527,6 +527,9 @@ 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]
{-
=====================================
compiler/prelude/TysWiredIn.hs
=====================================
@@ -145,6 +145,7 @@ import Id
import Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE )
import Module ( Module )
import GHC.Core.Type
+import qualified GHC.Core.TyCo.Rep as TyCoRep (Type(TyConApp))
import GHC.Types.RepType
import GHC.Core.DataCon
import {-# SOURCE #-} GHC.Core.ConLike
@@ -642,7 +643,7 @@ constraintKindTyCon :: TyCon
constraintKindTyCon = pcTyCon constraintKindTyConName Nothing [] []
liftedTypeKind, typeToTypeKind, constraintKind :: Kind
-liftedTypeKind = tYPE liftedRepTy
+liftedTypeKind = TyCoRep.TyConApp liftedTypeKindTyCon []
typeToTypeKind = liftedTypeKind `mkVisFunTy` liftedTypeKind
constraintKind = mkTyConApp constraintKindTyCon []
@@ -1178,8 +1179,8 @@ runtimeRepTy = mkTyConTy runtimeRepTyCon
-- type Type = tYPE 'LiftedRep
liftedTypeKindTyCon :: TyCon
liftedTypeKindTyCon = buildSynTyCon liftedTypeKindTyConName
- [] liftedTypeKind []
- (tYPE liftedRepTy)
+ [] liftedTypeKind [] rhs
+ where rhs = TyCoRep.TyConApp tYPETyCon [liftedRepTy]
runtimeRepTyCon :: TyCon
runtimeRepTyCon = pcTyCon runtimeRepTyConName Nothing []
=====================================
compiler/typecheck/TcCanonical.hs
=====================================
@@ -969,8 +969,14 @@ can_eq_nc'
-> Type -> Type -- RHS, after and before type-synonym expansion, resp
-> TcS (StopOrContinue Ct)
+-- See Note [Comparing nullary type synonyms].
+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,6 +1533,11 @@ 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].
+ go _ (TyConApp tc1 []) (TyConApp tc2 [])
+ | tc1 == tc2
+ = True
+
go env t1 t2 | not keep_syns, Just t1' <- tcView t1 = go env t1' t2
go env t1 t2 | not keep_syns, Just t2' <- tcView t2 = go env t1 t2'
@@ -1565,6 +1570,7 @@ 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
=====================================
testsuite/tests/deSugar/should_compile/T2431.stderr
=====================================
@@ -1,9 +1,9 @@
==================== Tidy Core ====================
Result size of Tidy Core
- = {terms: 63, types: 43, coercions: 1, joins: 0/0}
+ = {terms: 63, types: 39, coercions: 1, joins: 0/0}
--- RHS size: {terms: 2, types: 4, coercions: 1, joins: 0/0}
+-- RHS size: {terms: 2, types: 3, coercions: 1, joins: 0/0}
T2431.$WRefl [InlPrag=INLINE[0]] :: forall a. a :~: a
[GblId[DataConWrapper],
Caf=NoCafRefs,
@@ -15,7 +15,7 @@ T2431.$WRefl [InlPrag=INLINE[0]] :: forall a. a :~: a
T2431.$WRefl
= \ (@a) -> T2431.Refl @a @a @~(<a>_N :: a GHC.Prim.~# a)
--- RHS size: {terms: 4, types: 8, coercions: 0, joins: 0/0}
+-- RHS size: {terms: 4, types: 7, coercions: 0, joins: 0/0}
absurd :: forall a. (Int :~: Bool) -> a
[GblId, Arity=1, Str=<L,U>b, Cpr=b, Unf=OtherCon []]
absurd = \ (@a) (x :: Int :~: Bool) -> case x of { }
@@ -110,3 +110,6 @@ T2431.$tc'Refl
$tc'Refl2
1#
$krep3
+
+
+
=====================================
testsuite/tests/deriving/should_compile/T14578.stderr
=====================================
@@ -9,7 +9,7 @@ Derived class instances:
GHC.Base.sconcat ::
GHC.Base.NonEmpty (T14578.Wat f g a) -> T14578.Wat f g a
GHC.Base.stimes ::
- forall (b :: TYPE GHC.Types.LiftedRep).
+ forall (b :: GHC.Types.Type).
GHC.Real.Integral b => b -> T14578.Wat f g a -> T14578.Wat f g a
(GHC.Base.<>)
= GHC.Prim.coerce
@@ -37,12 +37,10 @@ Derived class instances:
instance GHC.Base.Functor f =>
GHC.Base.Functor (T14578.App f) where
GHC.Base.fmap ::
- forall (a :: TYPE GHC.Types.LiftedRep)
- (b :: TYPE GHC.Types.LiftedRep).
+ forall (a :: GHC.Types.Type) (b :: GHC.Types.Type).
(a -> b) -> T14578.App f a -> T14578.App f b
(GHC.Base.<$) ::
- forall (a :: TYPE GHC.Types.LiftedRep)
- (b :: TYPE GHC.Types.LiftedRep).
+ forall (a :: GHC.Types.Type) (b :: GHC.Types.Type).
a -> T14578.App f b -> T14578.App f a
GHC.Base.fmap
= GHC.Prim.coerce
@@ -55,24 +53,20 @@ Derived class instances:
instance GHC.Base.Applicative f =>
GHC.Base.Applicative (T14578.App f) where
- GHC.Base.pure ::
- forall (a :: TYPE GHC.Types.LiftedRep). a -> T14578.App f a
+ GHC.Base.pure :: forall (a :: GHC.Types.Type). a -> T14578.App f a
(GHC.Base.<*>) ::
- forall (a :: TYPE GHC.Types.LiftedRep)
- (b :: TYPE GHC.Types.LiftedRep).
+ forall (a :: GHC.Types.Type) (b :: GHC.Types.Type).
T14578.App f (a -> b) -> T14578.App f a -> T14578.App f b
GHC.Base.liftA2 ::
- forall (a :: TYPE GHC.Types.LiftedRep)
- (b :: TYPE GHC.Types.LiftedRep)
- (c :: TYPE GHC.Types.LiftedRep).
+ forall (a :: GHC.Types.Type)
+ (b :: GHC.Types.Type)
+ (c :: GHC.Types.Type).
(a -> b -> c) -> T14578.App f a -> T14578.App f b -> T14578.App f c
(GHC.Base.*>) ::
- forall (a :: TYPE GHC.Types.LiftedRep)
- (b :: TYPE GHC.Types.LiftedRep).
+ forall (a :: GHC.Types.Type) (b :: GHC.Types.Type).
T14578.App f a -> T14578.App f b -> T14578.App f b
(GHC.Base.<*) ::
- forall (a :: TYPE GHC.Types.LiftedRep)
- (b :: TYPE GHC.Types.LiftedRep).
+ forall (a :: GHC.Types.Type) (b :: GHC.Types.Type).
T14578.App f a -> T14578.App f b -> T14578.App f a
GHC.Base.pure
= GHC.Prim.coerce
=====================================
testsuite/tests/plugins/plugins09.stdout
=====================================
@@ -3,7 +3,6 @@ interfacePlugin: Prelude
interfacePlugin: GHC.Float
interfacePlugin: GHC.Base
typeCheckPlugin (rn)
-interfacePlugin: GHC.Types
typeCheckPlugin (tc)
interfacePlugin: GHC.Integer.Type
interfacePlugin: GHC.Natural
=====================================
testsuite/tests/plugins/plugins10.stdout
=====================================
@@ -6,7 +6,6 @@ interfacePlugin: GHC.Float
interfacePlugin: GHC.Base
interfacePlugin: Language.Haskell.TH.Syntax
typeCheckPlugin (rn)
-interfacePlugin: GHC.Types
typeCheckPlugin (tc)
interfacePlugin: GHC.Integer.Type
interfacePlugin: GHC.Natural
=====================================
testsuite/tests/plugins/plugins11.stdout
=====================================
@@ -3,7 +3,6 @@ interfacePlugin: Prelude
interfacePlugin: GHC.Float
interfacePlugin: GHC.Base
typeCheckPlugin (rn)
-interfacePlugin: GHC.Types
typeCheckPlugin (tc)
interfacePlugin: GHC.Integer.Type
interfacePlugin: GHC.Natural
=====================================
testsuite/tests/plugins/static-plugins.stdout
=====================================
@@ -5,11 +5,11 @@ interfacePlugin: GHC.Float
interfacePlugin: GHC.Base
interfacePlugin: System.IO
typeCheckPlugin (rn)
-interfacePlugin: GHC.Prim
-interfacePlugin: GHC.Show
interfacePlugin: GHC.Types
+interfacePlugin: GHC.Show
interfacePlugin: GHC.TopHandler
typeCheckPlugin (tc)
+interfacePlugin: GHC.Prim
interfacePlugin: GHC.CString
interfacePlugin: GHC.Integer.Type
interfacePlugin: GHC.Natural
=====================================
testsuite/tests/simplCore/should_compile/T13143.stderr
=====================================
@@ -1,17 +1,17 @@
==================== Tidy Core ====================
Result size of Tidy Core
- = {terms: 71, types: 44, coercions: 0, joins: 0/0}
+ = {terms: 71, types: 40, coercions: 0, joins: 0/0}
Rec {
--- RHS size: {terms: 4, types: 4, coercions: 0, joins: 0/0}
+-- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0}
T13143.$wf [InlPrag=NOINLINE, Occ=LoopBreaker]
:: forall {a}. GHC.Prim.Void# -> a
[GblId, Arity=1, Str=<B,A>b, Cpr=b, Unf=OtherCon []]
T13143.$wf = \ (@a) _ [Occ=Dead] -> T13143.$wf @a GHC.Prim.void#
end Rec }
--- RHS size: {terms: 4, types: 4, coercions: 0, joins: 0/0}
+-- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0}
f [InlPrag=NOUSERINLINE[0]] :: forall a. Int -> a
[GblId,
Arity=1,
=====================================
testsuite/tests/simplCore/should_compile/T7360.stderr
=====================================
@@ -1,7 +1,7 @@
==================== Tidy Core ====================
Result size of Tidy Core
- = {terms: 114, types: 53, coercions: 0, joins: 0/0}
+ = {terms: 114, types: 51, coercions: 0, joins: 0/0}
-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0}
T7360.$WFoo3 [InlPrag=INLINE[0]] :: Int -> Foo
@@ -39,7 +39,7 @@ T7360.fun4 :: Int
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
T7360.fun4 = GHC.Types.I# 0#
--- RHS size: {terms: 16, types: 13, coercions: 0, joins: 0/0}
+-- RHS size: {terms: 16, types: 12, coercions: 0, joins: 0/0}
fun2 :: forall {a}. [a] -> ((), Int)
[GblId,
Arity=1,
=====================================
testsuite/tests/typecheck/should_compile/T13032.stderr
=====================================
@@ -1,9 +1,9 @@
==================== Desugar (after optimization) ====================
Result size of Desugar (after optimization)
- = {terms: 13, types: 24, coercions: 0, joins: 0/0}
+ = {terms: 13, types: 18, coercions: 0, joins: 0/0}
--- RHS size: {terms: 6, types: 11, coercions: 0, joins: 0/0}
+-- RHS size: {terms: 6, types: 8, coercions: 0, joins: 0/0}
f :: forall a b. (a ~ b) => a -> b -> Bool
[LclIdX,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f25cda0c941a6643c635eaa21803d7c2e50892c2
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f25cda0c941a6643c635eaa21803d7c2e50892c2
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/20200326/9a02f8f8/attachment-0001.html>
More information about the ghc-commits
mailing list