diff options
| author | Ben Gamari <ben@smart-cactus.org> | 2017-02-02 01:29:26 -0500 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2017-02-18 00:09:27 -0500 |
| commit | 8fa4bf9ab3f4ea4b208f4a43cc90857987e6d497 (patch) | |
| tree | ad5f6ea9449e0ff9e92edb1f67c86cb38300cd71 /testsuite | |
| parent | b207b536ded40156f9adb168565ca78e1eef2c74 (diff) | |
| download | haskell-8fa4bf9ab3f4ea4b208f4a43cc90857987e6d497.tar.gz | |
Type-indexed Typeable
This at long last realizes the ideas for type-indexed Typeable discussed in A
Reflection on Types (#11011). The general sketch of the project is described on
the Wiki (Typeable/BenGamari). The general idea is that we are adding a type
index to `TypeRep`,
data TypeRep (a :: k)
This index allows the typechecker to reason about the type represented by the `TypeRep`.
This index representation mechanism is exposed as `Type.Reflection`, which also provides
a number of patterns for inspecting `TypeRep`s,
```lang=haskell
pattern TRFun :: forall k (fun :: k). ()
=> forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)
(arg :: TYPE r1) (res :: TYPE r2).
(k ~ Type, fun ~~ (arg -> res))
=> TypeRep arg
-> TypeRep res
-> TypeRep fun
pattern TRApp :: forall k2 (t :: k2). ()
=> forall k1 (a :: k1 -> k2) (b :: k1). (t ~ a b)
=> TypeRep a -> TypeRep b -> TypeRep t
-- | Pattern match on a type constructor.
pattern TRCon :: forall k (a :: k). TyCon -> TypeRep a
-- | Pattern match on a type constructor including its instantiated kind
-- variables.
pattern TRCon' :: forall k (a :: k). TyCon -> [SomeTypeRep] -> TypeRep a
```
In addition, we give the user access to the kind of a `TypeRep` (#10343),
typeRepKind :: TypeRep (a :: k) -> TypeRep k
Moreover, all of this plays nicely with 8.2's levity polymorphism, including the
newly levity polymorphic (->) type constructor.
Library changes
---------------
The primary change here is the introduction of a Type.Reflection module to base.
This module provides access to the new type-indexed TypeRep introduced in this
patch. We also continue to provide the unindexed Data.Typeable interface, which
is simply a type synonym for the existentially quantified SomeTypeRep,
data SomeTypeRep where SomeTypeRep :: TypeRep a -> SomeTypeRep
Naturally, this change also touched Data.Dynamic, which can now export the
Dynamic data constructor. Moreover, I removed a blanket reexport of
Data.Typeable from Data.Dynamic (which itself doesn't even import Data.Typeable
now).
We also add a kind heterogeneous type equality type, (:~~:), to
Data.Type.Equality.
Implementation
--------------
The implementation strategy is described in Note [Grand plan for Typeable] in
TcTypeable. None of it was difficult, but it did exercise a number of parts of
the new levity polymorphism story which had not yet been exercised, which took
some sorting out.
The rough idea is that we augment the TyCon produced for each type constructor
with information about the constructor's kind (which we call a KindRep). This
allows us to reconstruct the monomorphic result kind of an particular
instantiation of a type constructor given its kind arguments.
Unfortunately all of this takes a fair amount of work to generate and send
through the compilation pipeline. In particular, the KindReps can unfortunately
get quite large. Moreover, the simplifier will float out various pieces of them,
resulting in numerous top-level bindings. Consequently we mark the KindRep
bindings as noinline, ensuring that the float-outs don't make it into the
interface file. This is important since there is generally little benefit to
inlining KindReps and they would otherwise strongly affect compiler performance.
Performance
-----------
Initially I was hoping to also clear up the remaining holes in Typeable's
coverage by adding support for both unboxed tuples (#12409) and unboxed sums
(#13276). While the former was fairly straightforward, the latter ended up being
quite difficult: while the implementation can support them easily, enabling this
support causes thousands of Typeable bindings to be emitted to the GHC.Types as
each arity-N sum tycon brings with it N promoted datacons, each of which has a
KindRep whose size which itself scales with N. Doing this was simply too
expensive to be practical; consequently I've disabled support for the time
being.
Even after disabling sums this change regresses compiler performance far more
than I would like. In particular there are several testcases in the testsuite
which consist mostly of types which regress by over 30% in compiler allocations.
These include (considering the "bytes allocated" metric),
* T1969: +10%
* T10858: +23%
* T3294: +19%
* T5631: +41%
* T6048: +23%
* T9675: +20%
* T9872a: +5.2%
* T9872d: +12%
* T9233: +10%
* T10370: +34%
* T12425: +30%
* T12234: +16%
* 13035: +17%
* T4029: +6.1%
I've spent quite some time chasing down the source of this regression and while
I was able to make som improvements, I think this approach of generating
Typeable bindings at time of type definition is doomed to give us unnecessarily
large compile-time overhead.
In the future I think we should consider moving some of all of the Typeable
binding generation logic back to the solver (where it was prior to
91c6b1f54aea658b0056caec45655475897f1972). I've opened #13261 documenting this
proposal.
Diffstat (limited to 'testsuite')
37 files changed, 1176 insertions, 374 deletions
diff --git a/testsuite/tests/deSugar/should_compile/T2431.stderr b/testsuite/tests/deSugar/should_compile/T2431.stderr index 83826408cf..d601d5d48f 100644 --- a/testsuite/tests/deSugar/should_compile/T2431.stderr +++ b/testsuite/tests/deSugar/should_compile/T2431.stderr @@ -1,7 +1,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 44, types: 34, coercions: 1, joins: 0/0} + = {terms: 83, types: 49, coercions: 1, joins: 0/0} -- RHS size: {terms: 2, types: 4, coercions: 1, joins: 0/0} T2431.$WRefl [InlPrag=INLINE] :: forall a. a :~: a @@ -47,25 +47,30 @@ T2431.$trModule :: GHC.Types.Module [GblId, Caf=NoCafRefs] T2431.$trModule = GHC.Types.Module $trModule2 $trModule4 --- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -$tc'Refl1 :: GHC.Prim.Addr# +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +krep :: GHC.Types.KindRep [GblId, Caf=NoCafRefs] -$tc'Refl1 = "'Refl"# +krep = GHC.Types.KindRepTYPE GHC.Types.LiftedRep -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -$tc'Refl2 :: GHC.Types.TrName +krep1 :: GHC.Types.KindRep [GblId, Caf=NoCafRefs] -$tc'Refl2 = GHC.Types.TrNameS $tc'Refl1 +krep1 = GHC.Types.KindRepTYPE GHC.Types.LiftedRep --- RHS size: {terms: 5, types: 0, coercions: 0, joins: 0/0} -T2431.$tc'Refl :: GHC.Types.TyCon +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +krep2 :: GHC.Types.KindRep [GblId, Caf=NoCafRefs] -T2431.$tc'Refl = - GHC.Types.TyCon - 15026191172322750497## - 3898273167927206410## - T2431.$trModule - $tc'Refl2 +krep2 = GHC.Types.KindRepTYPE GHC.Types.LiftedRep + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +krep3 :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs] +krep3 = GHC.Types.KindRepFun krep1 krep2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +krep4 :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs] +krep4 = GHC.Types.KindRepFun krep krep3 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} $tc:~:1 :: GHC.Prim.Addr# @@ -77,15 +82,66 @@ $tc:~:2 :: GHC.Types.TrName [GblId, Caf=NoCafRefs] $tc:~:2 = GHC.Types.TrNameS $tc:~:1 --- RHS size: {terms: 5, types: 0, coercions: 0, joins: 0/0} +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T2431.$tc:~: :: GHC.Types.TyCon [GblId, Caf=NoCafRefs] T2431.$tc:~: = GHC.Types.TyCon - 9759653149176674453## - 12942818337407067047## + 4608886815921030019## + 6030312177285011233## T2431.$trModule $tc:~:2 + 0# + krep4 + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +krep5 :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs] +krep5 = GHC.Types.KindRepVar 0# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +krep6 :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs] +krep6 = GHC.Types.KindRepVar 0# + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +krep7 :: [GHC.Types.KindRep] +[GblId, Caf=NoCafRefs] +krep7 = + GHC.Types.: + @ GHC.Types.KindRep krep6 (GHC.Types.[] @ GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +krep8 :: [GHC.Types.KindRep] +[GblId, Caf=NoCafRefs] +krep8 = GHC.Types.: @ GHC.Types.KindRep krep5 krep7 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +krep9 :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs] +krep9 = GHC.Types.KindRepTyConApp T2431.$tc:~: krep8 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$tc'Refl1 :: GHC.Prim.Addr# +[GblId, Caf=NoCafRefs] +$tc'Refl1 = "'Refl"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$tc'Refl2 :: GHC.Types.TrName +[GblId, Caf=NoCafRefs] +$tc'Refl2 = GHC.Types.TrNameS $tc'Refl1 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T2431.$tc'Refl :: GHC.Types.TyCon +[GblId, Caf=NoCafRefs] +T2431.$tc'Refl = + GHC.Types.TyCon + 2478588351447975921## + 2684375695874497811## + T2431.$trModule + $tc'Refl2 + 1# + krep9 diff --git a/testsuite/tests/dependent/should_compile/RaeJobTalk.hs b/testsuite/tests/dependent/should_compile/RaeJobTalk.hs index e5c2002e0c..480db090c3 100644 --- a/testsuite/tests/dependent/should_compile/RaeJobTalk.hs +++ b/testsuite/tests/dependent/should_compile/RaeJobTalk.hs @@ -11,7 +11,7 @@ module RaeJobTalk where import Data.Type.Bool -import Data.Type.Equality +import Data.Type.Equality hiding ((:~~:)(..)) import GHC.TypeLits import Data.Proxy import GHC.Exts @@ -129,60 +129,60 @@ instance Read TyConX where readsPrec _ "List" = [(TyConX List, "")] readsPrec _ _ = [] --- This variant of TypeRepX allows you to specify an arbitrary +-- This variant of SomeTypeRep allows you to specify an arbitrary -- constraint on the inner TypeRep -data TypeRepX :: (forall k. k -> Constraint) -> Type where - TypeRepX :: forall k (c :: forall k'. k' -> Constraint) (a :: k). - c a => TypeRep a -> TypeRepX c +data SomeTypeRep :: (forall k. k -> Constraint) -> Type where + SomeTypeRep :: forall k (c :: forall k'. k' -> Constraint) (a :: k). + c a => TypeRep a -> SomeTypeRep c -- This constraint is always satisfied class ConstTrue (a :: k) -- needs the :: k to make it a specified tyvar instance ConstTrue a -instance Show (TypeRepX ConstTrue) where - show (TypeRepX tr) = show tr +instance Show (SomeTypeRep ConstTrue) where + show (SomeTypeRep tr) = show tr --- can't write Show (TypeRepX c) because c's kind mentions a forall, +-- can't write Show (SomeTypeRep c) because c's kind mentions a forall, -- and the impredicativity check gets nervous. See #11519 -instance Show (TypeRepX IsType) where - show (TypeRepX tr) = show tr +instance Show (SomeTypeRep IsType) where + show (SomeTypeRep tr) = show tr -- Just enough functionality to get through example. No parentheses -- or other niceties. -instance Read (TypeRepX ConstTrue) where +instance Read (SomeTypeRep ConstTrue) where readsPrec p s = do let tokens = words s tyreps <- mapM read_token tokens return (foldl1 mk_app tyreps, "") where - read_token :: String -> [TypeRepX ConstTrue] - read_token "String" = return (TypeRepX $ typeRep @String) + read_token :: String -> [SomeTypeRep ConstTrue] + read_token "String" = return (SomeTypeRep $ typeRep @String) read_token other = do (TyConX tc, _) <- readsPrec p other - return (TypeRepX (TyCon tc)) + return (SomeTypeRep (TyCon tc)) - mk_app :: TypeRepX ConstTrue -> TypeRepX ConstTrue -> TypeRepX ConstTrue - mk_app (TypeRepX f) (TypeRepX a) = case kindRep f of + mk_app :: SomeTypeRep ConstTrue -> SomeTypeRep ConstTrue -> SomeTypeRep ConstTrue + mk_app (SomeTypeRep f) (SomeTypeRep a) = case kindRep f of TyCon Arrow `TyApp` k1 `TyApp` _ - | Just HRefl <- k1 `eqT` kindRep a -> TypeRepX (TyApp f a) + | Just HRefl <- k1 `eqT` kindRep a -> SomeTypeRep (TyApp f a) _ -> error "ill-kinded type" --- instance Read (TypeRepX ((~~) Type)) RAE: need (~~) :: forall k1. k1 -> forall k2. k2 -> Constraint +-- instance Read (SomeTypeRep ((~~) Type)) RAE: need (~~) :: forall k1. k1 -> forall k2. k2 -> Constraint -- RAE: need kind signatures on classes --- TypeRepX ((~~) Type) +-- SomeTypeRep ((~~) Type) -- (~~) :: forall k1 k2. k1 -> k2 -> Constraint -- I need: (~~) :: forall k1. k1 -> forall k2. k2 -> Constraint class k ~~ Type => IsType (x :: k) instance k ~~ Type => IsType (x :: k) -instance Read (TypeRepX IsType) where - readsPrec p s = case readsPrec @(TypeRepX ConstTrue) p s of - [(TypeRepX tr, "")] +instance Read (SomeTypeRep IsType) where + readsPrec p s = case readsPrec @(SomeTypeRep ConstTrue) p s of + [(SomeTypeRep tr, "")] | Just HRefl <- eqT (kindRep tr) (typeRep @Type) - -> [(TypeRepX tr, "")] + -> [(SomeTypeRep tr, "")] _ -> error "wrong kind" ----------------------------- @@ -371,7 +371,7 @@ readRows sch lst = (row : tail) tail = readRows sch strTail -- Read in one line of a .schema file. Note that the type read must have kind * -readCol :: String -> (String, TypeRepX IsType) +readCol :: String -> (String, SomeTypeRep IsType) readCol str = case break isSpace str of (name, ' ' : ty) -> (name, read ty) _ -> schemaError $ "Bad parse of " ++ str @@ -386,11 +386,11 @@ withSchema filename thing_inside = do cols = map readCol schEntries go cols thing_inside where - go :: [(String, TypeRepX IsType)] + go :: [(String, SomeTypeRep IsType)] -> (forall (s :: TSchema). Schema s -> IO a) -> IO a go [] thing = thing Nil - go ((name, TypeRepX tr) : cols) thing + go ((name, SomeTypeRep tr) : cols) thing = go cols $ \schema -> case someSymbolVal name of SomeSymbol (_ :: Proxy name) -> diff --git a/testsuite/tests/dependent/should_compile/T11711.hs b/testsuite/tests/dependent/should_compile/T11711.hs index 633ae35e64..0cd4dceb42 100644 --- a/testsuite/tests/dependent/should_compile/T11711.hs +++ b/testsuite/tests/dependent/should_compile/T11711.hs @@ -26,8 +26,8 @@ data TypeRep (a :: k) where class Typeable (a :: k) where typeRep :: TypeRep a -data TypeRepX where - TypeRepX :: forall k (a :: k). TypeRep a -> TypeRepX +data SomeTypeRep where + SomeTypeRep :: forall k (a :: k). TypeRep a -> SomeTypeRep eqTypeRep :: TypeRep a -> TypeRep b -> Maybe (a :~~: b) eqTypeRep = undefined @@ -38,12 +38,12 @@ typeRepKind = undefined instance Typeable Type where typeRep = TrTyCon "Type" typeRep -funResultTy :: TypeRepX -> TypeRepX -> Maybe TypeRepX -funResultTy (TypeRepX f) (TypeRepX x) +funResultTy :: SomeTypeRep -> SomeTypeRep -> Maybe SomeTypeRep +funResultTy (SomeTypeRep f) (SomeTypeRep x) | Just HRefl <- (typeRep :: TypeRep Type) `eqTypeRep` typeRepKind f , TRFun arg res <- f , Just HRefl <- arg `eqTypeRep` x - = Just (TypeRepX res) + = Just (SomeTypeRep res) | otherwise = Nothing diff --git a/testsuite/tests/dependent/should_compile/dynamic-paper.hs b/testsuite/tests/dependent/should_compile/dynamic-paper.hs index 0d55bba93a..1aa4ee54d9 100644 --- a/testsuite/tests/dependent/should_compile/dynamic-paper.hs +++ b/testsuite/tests/dependent/should_compile/dynamic-paper.hs @@ -89,7 +89,7 @@ instance Typeable Int instance (Typeable a, Typeable b) => Typeable (a b) instance Typeable (,) -instance Eq TypeRepX +instance Eq SomeTypeRep data Dynamic where Dyn :: TypeRep a -> a -> Dynamic @@ -196,19 +196,19 @@ castR ta tb = withTypeable ta (withTypeable tb castDance) cmpT = undefined compareTypeRep = undefined -data TypeRepX where - TypeRepX :: TypeRep a -> TypeRepX +data SomeTypeRep where + SomeTypeRep :: TypeRep a -> SomeTypeRep -type TyMapLessTyped = Map TypeRepX Dynamic +type TyMapLessTyped = Map SomeTypeRep Dynamic insertLessTyped :: forall a. Typeable a => a -> TyMapLessTyped -> TyMapLessTyped -insertLessTyped x = Map.insert (TypeRepX (typeRep :: TypeRep a)) (toDynamic x) +insertLessTyped x = Map.insert (SomeTypeRep (typeRep :: TypeRep a)) (toDynamic x) lookupLessTyped :: forall a. Typeable a => TyMapLessTyped -> Maybe a -lookupLessTyped = fromDynamic <=< Map.lookup (TypeRepX (typeRep :: TypeRep a)) +lookupLessTyped = fromDynamic <=< Map.lookup (SomeTypeRep (typeRep :: TypeRep a)) -instance Ord TypeRepX where - compare (TypeRepX tr1) (TypeRepX tr2) = compareTypeRep tr1 tr2 +instance Ord SomeTypeRep where + compare (SomeTypeRep tr1) (SomeTypeRep tr2) = compareTypeRep tr1 tr2 compareTypeRep :: TypeRep a -> TypeRep b -> Ordering -- primitive diff --git a/testsuite/tests/deriving/perf/all.T b/testsuite/tests/deriving/perf/all.T index 4c4bb97101..8dee98961b 100644 --- a/testsuite/tests/deriving/perf/all.T +++ b/testsuite/tests/deriving/perf/all.T @@ -1,8 +1,9 @@ test('T10858', [compiler_stats_num_field('bytes allocated', - [ (wordsize(64), 247768192, 8) ]), - # Initial: 222312440 + [ (wordsize(64), 304094944, 8) ]), + # Initial: 476296112 # 2016-12-19 247768192 Join points (#19288) + # 2016-02-12 304094944 Type-indexed Typeable only_ways(['normal'])], compile, ['-O']) diff --git a/testsuite/tests/ghci.debugger/scripts/print019.stderr b/testsuite/tests/ghci.debugger/scripts/print019.stderr index cc62fa16e6..c266bc8d1a 100644 --- a/testsuite/tests/ghci.debugger/scripts/print019.stderr +++ b/testsuite/tests/ghci.debugger/scripts/print019.stderr @@ -5,10 +5,10 @@ Use :print or :force to determine these types Relevant bindings include it :: a1 (bound at <interactive>:10:1) These potential instances exist: - instance Show TypeRep -- Defined in ‘Data.Typeable.Internal’ instance Show Ordering -- Defined in ‘GHC.Show’ instance Show TyCon -- Defined in ‘GHC.Show’ - ...plus 30 others - ...plus 10 instances involving out-of-scope types + instance Show Integer -- Defined in ‘GHC.Show’ + ...plus 29 others + ...plus 12 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In a stmt of an interactive GHCi command: print it diff --git a/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr b/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr index fe7b8bf42c..c7db52a5df 100644 --- a/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr +++ b/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr @@ -13,32 +13,55 @@ ({ <no location info> } (HsApp ({ <no location info> } - (HsConLikeOut - ({abstract:ConLike}))) + (HsApp + ({ <no location info> } + (HsApp + ({ <no location info> } + (HsConLikeOut + ({abstract:ConLike}))) + ({ <no location info> } + (HsLit + (HsWordPrim + (NoSourceText) + (14073232900889011755)))))) + ({ <no location info> } + (HsLit + (HsWordPrim + (NoSourceText) + (2739668351064589274)))))) ({ <no location info> } - (HsLit - (HsWordPrim - (NoSourceText) - (8575021419490388262)))))) + (HsVar + ({ <no location info> }{Var: (main:DumpTypecheckedAst.$trModule{v} [lidx] :: ghc-prim:GHC.Types.Module{tc})}))))) ({ <no location info> } - (HsLit - (HsWordPrim - (NoSourceText) - (11015472196725198936)))))) + (HsPar + ({ <no location info> } + (HsApp + ({ <no location info> } + (HsConLikeOut + ({abstract:ConLike}))) + ({ <no location info> } + (HsLit + (HsStringPrim + (NoSourceText) "Peano"))))))))) ({ <no location info> } - (HsVar - ({ <no location info> }{Var: (main:DumpTypecheckedAst.$trModule{v} [lidx] :: ghc-prim:GHC.Types.Module{tc})}))))) + (HsLit + (HsIntPrim + (SourceText "0") + (0)))))) ({ <no location info> } - (HsPar - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsConLikeOut - ({abstract:ConLike}))) - ({ <no location info> } - (HsLit - (HsStringPrim - (NoSourceText) "Peano"))))))))) + (HsVar + ({ <no location info> }{Var: (krep{v} [lid] :: ghc-prim:GHC.Types.KindRep{tc})}))))) + (False))), + ({ <no location info> } + (VarBind {Var: (krep{v} [lid] :: ghc-prim:GHC.Types.KindRep{tc})} + ({ <no location info> } + (HsApp + ({ <no location info> } + (HsConLikeOut + ({abstract:ConLike}))) + ({ <no location info> } + (HsConLikeOut + ({abstract:ConLike}))))) (False))), ({ <no location info> } (VarBind {Var: (main:DumpTypecheckedAst.$tc'Zero{v} [lidx] :: ghc-prim:GHC.Types.TyCon{tc})} @@ -51,32 +74,65 @@ ({ <no location info> } (HsApp ({ <no location info> } - (HsConLikeOut - ({abstract:ConLike}))) + (HsApp + ({ <no location info> } + (HsApp + ({ <no location info> } + (HsConLikeOut + ({abstract:ConLike}))) + ({ <no location info> } + (HsLit + (HsWordPrim + (NoSourceText) + (13760111476013868540)))))) + ({ <no location info> } + (HsLit + (HsWordPrim + (NoSourceText) + (12314848029315386153)))))) ({ <no location info> } - (HsLit - (HsWordPrim - (NoSourceText) - (2837710233032485839)))))) + (HsVar + ({ <no location info> }{Var: (main:DumpTypecheckedAst.$trModule{v} [lidx] :: ghc-prim:GHC.Types.Module{tc})}))))) ({ <no location info> } - (HsLit - (HsWordPrim - (NoSourceText) - (4722402035995040741)))))) + (HsPar + ({ <no location info> } + (HsApp + ({ <no location info> } + (HsConLikeOut + ({abstract:ConLike}))) + ({ <no location info> } + (HsLit + (HsStringPrim + (NoSourceText) "'Zero"))))))))) ({ <no location info> } - (HsVar - ({ <no location info> }{Var: (main:DumpTypecheckedAst.$trModule{v} [lidx] :: ghc-prim:GHC.Types.Module{tc})}))))) + (HsLit + (HsIntPrim + (SourceText "0") + (0)))))) ({ <no location info> } - (HsPar + (HsVar + ({ <no location info> }{Var: (krep{v} [lid] :: ghc-prim:GHC.Types.KindRep{tc})}))))) + (False))), + ({ <no location info> } + (VarBind {Var: (krep{v} [lid] :: ghc-prim:GHC.Types.KindRep{tc})} + ({ <no location info> } + (HsApp + ({ <no location info> } + (HsApp ({ <no location info> } - (HsApp - ({ <no location info> } - (HsConLikeOut - ({abstract:ConLike}))) - ({ <no location info> } - (HsLit - (HsStringPrim - (NoSourceText) "'Zero"))))))))) + (HsConLikeOut + ({abstract:ConLike}))) + ({ <no location info> } + (HsVar + ({ <no location info> }{Var: (main:DumpTypecheckedAst.$tcPeano{v} [lidx] :: ghc-prim:GHC.Types.TyCon{tc})}))))) + ({ <no location info> } + (HsWrap + (WpTyApp + (TyConApp + ({abstract:TyCon}) + [])) + (HsConLikeOut + ({abstract:ConLike})))))) (False))), ({ <no location info> } (VarBind {Var: (main:DumpTypecheckedAst.$tc'Succ{v} [lidx] :: ghc-prim:GHC.Types.TyCon{tc})} @@ -89,32 +145,94 @@ ({ <no location info> } (HsApp ({ <no location info> } - (HsConLikeOut - ({abstract:ConLike}))) + (HsApp + ({ <no location info> } + (HsApp + ({ <no location info> } + (HsConLikeOut + ({abstract:ConLike}))) + ({ <no location info> } + (HsLit + (HsWordPrim + (NoSourceText) + (1143980031331647856)))))) + ({ <no location info> } + (HsLit + (HsWordPrim + (NoSourceText) + (14802086722010293686)))))) ({ <no location info> } - (HsLit - (HsWordPrim - (NoSourceText) - (16648669567626715052)))))) + (HsVar + ({ <no location info> }{Var: (main:DumpTypecheckedAst.$trModule{v} [lidx] :: ghc-prim:GHC.Types.Module{tc})}))))) ({ <no location info> } - (HsLit - (HsWordPrim - (NoSourceText) - (1296291977643060110)))))) + (HsPar + ({ <no location info> } + (HsApp + ({ <no location info> } + (HsConLikeOut + ({abstract:ConLike}))) + ({ <no location info> } + (HsLit + (HsStringPrim + (NoSourceText) "'Succ"))))))))) ({ <no location info> } - (HsVar - ({ <no location info> }{Var: (main:DumpTypecheckedAst.$trModule{v} [lidx] :: ghc-prim:GHC.Types.Module{tc})}))))) + (HsLit + (HsIntPrim + (SourceText "0") + (0)))))) + ({ <no location info> } + (HsVar + ({ <no location info> }{Var: (krep{v} [lid] :: ghc-prim:GHC.Types.KindRep{tc})}))))) + (False))), + ({ <no location info> } + (VarBind {Var: (krep{v} [lid] :: ghc-prim:GHC.Types.KindRep{tc})} + ({ <no location info> } + (HsApp + ({ <no location info> } + (HsApp + ({ <no location info> } + (HsConLikeOut + ({abstract:ConLike}))) + ({ <no location info> } + (HsPar + ({ <no location info> } + (HsApp + ({ <no location info> } + (HsApp + ({ <no location info> } + (HsConLikeOut + ({abstract:ConLike}))) + ({ <no location info> } + (HsVar + ({ <no location info> }{Var: (main:DumpTypecheckedAst.$tcPeano{v} [lidx] :: ghc-prim:GHC.Types.TyCon{tc})}))))) + ({ <no location info> } + (HsWrap + (WpTyApp + (TyConApp + ({abstract:TyCon}) + [])) + (HsConLikeOut + ({abstract:ConLike})))))))))) ({ <no location info> } (HsPar ({ <no location info> } (HsApp ({ <no location info> } - (HsConLikeOut - ({abstract:ConLike}))) + (HsApp + ({ <no location info> } + (HsConLikeOut + ({abstract:ConLike}))) + ({ <no location info> } + (HsVar + ({ <no location info> }{Var: (main:DumpTypecheckedAst.$tcPeano{v} [lidx] :: ghc-prim:GHC.Types.TyCon{tc})}))))) ({ <no location info> } - (HsLit - (HsStringPrim - (NoSourceText) "'Succ"))))))))) + (HsWrap + (WpTyApp + (TyConApp + ({abstract:TyCon}) + [])) + (HsConLikeOut + ({abstract:ConLike})))))))))) (False))), ({ <no location info> } (VarBind {Var: (main:DumpTypecheckedAst.$trModule{v} [lidx] :: ghc-prim:GHC.Types.Module{tc})} diff --git a/testsuite/tests/patsyn/should_compile/T12698.hs b/testsuite/tests/patsyn/should_compile/T12698.hs index 6ba45e4e85..27d54d8eba 100644 --- a/testsuite/tests/patsyn/should_compile/T12698.hs +++ b/testsuite/tests/patsyn/should_compile/T12698.hs @@ -6,7 +6,7 @@ module T12698 where import GHC.Types import Prelude hiding ( fromInteger ) -import Data.Type.Equality +import Data.Type.Equality hiding ((:~~:)(..)) import Data.Kind import qualified Prelude diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 5f898fbbee..24b03d0326 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -39,7 +39,7 @@ test('T1969', # 2013-11-13 17 (x86/Windows, 64bit machine) # 2015-07-11 21 (x86/Linux, 64bit machine) use +RTS -G1 # 2016-04-06 30 (x86/Linux, 64bit machine) - (wordsize(64), 68, 20)]), + (wordsize(64), 83, 20)]), # 28 (amd64/Linux) # 34 (amd64/Linux) # 2012-09-20 23 (amd64/Linux) @@ -53,6 +53,7 @@ test('T1969', # 2015-10-28 55, (amd64/Linux) emit Typeable at definition site # 2016-10-20 68, (amd64/Linux) allow top-level string literals # See the comment 16 on #8472. + # 2017-02-17 83 (amd64/Linux) Type-indexed Typeable compiler_stats_num_field('max_bytes_used', [(platform('i386-unknown-mingw32'), 5719436, 20), # 2010-05-17 5717704 (x86/Windows) @@ -96,27 +97,28 @@ test('T1969', # 2014-06-29 303300692 (x86/Linux) # 2015-07-11 288699104 (x86/Linux, 64-bit machine) use +RTS -G1 # 2016-04-06 344730660 (x86/Linux, 64-bit machine) - (wordsize(64), 756138176, 5)]), - # 17/11/2009 434845560 (amd64/Linux) - # 08/12/2009 459776680 (amd64/Linux) - # 17/05/2010 519377728 (amd64/Linux) - # 05/08/2011 561382568 (amd64/OS X) - # 16/07/2012 589168872 (amd64/Linux) - # 20/07/2012 595936240 (amd64/Linux) - # 23/08/2012 606230880 (amd64/Linux) - # 29/08/2012 633334184 (amd64/Linux) new codegen - # 18/09/2012 641959976 (amd64/Linux) - # 19/10/2012 661832592 (amd64/Linux) -fPIC turned on - # 23/10/2012 642594312 (amd64/Linux) -fPIC turned off again - # 12/11/2012 658786936 (amd64/Linux) UNKNOWN REASON - # 17/1/13: 667160192 (x86_64/Linux) new demand analyser - # 18/10/2013 698612512 (x86_64/Linux) fix for #8456 - # 10/02/2014 660922376 (x86_64/Linux) call arity analysis - # 17/07/2014 651626680 (x86_64/Linux) roundabout update - # 10/09/2014 630299456 (x86_64/Linux) post-AMP-cleanup - # 03/06/2015 581460896 (x86_64/Linux) use +RTS -G1 - # 28/10/2015 695430728 (x86_64/Linux) emit Typeable at definition site - # 28/10/2015 756138176 (x86_64/Linux) inst-decl defaults go via typechecker (#12220) + (wordsize(64), 831733376, 5)]), + # 2009-11-17 434845560 (amd64/Linux) + # 2009-12-08 459776680 (amd64/Linux) + # 2010-05-17 519377728 (amd64/Linux) + # 2011-08-05 561382568 (amd64/OS X) + # 2012-07-16 589168872 (amd64/Linux) + # 2012-07-20 595936240 (amd64/Linux) + # 2012-08-23 606230880 (amd64/Linux) + # 2012-08-29 633334184 (amd64/Linux) new codegen + # 2012-09-18 641959976 (amd64/Linux) + # 2012-10-19 661832592 (amd64/Linux) -fPIC turned on + # 2012-10-23 642594312 (amd64/Linux) -fPIC turned off again + # 2012-11-12 658786936 (amd64/Linux) UNKNOWN REASON + # 2013-91-17 667160192 (x86_64/Linux) new demand analyser + # 2013-10-18 698612512 (x86_64/Linux) fix for #8456 + # 2014-02-10 660922376 (x86_64/Linux) call arity analysis + # 2014-07-17 651626680 (x86_64/Linux) roundabout update + # 2014-09-10 630299456 (x86_64/Linux) post-AMP-cleanup + # 2015-06-03 581460896 (x86_64/Linux) use +RTS -G1 + # 2015-10-28 695430728 (x86_64/Linux) emit Typeable at definition site + # 2015-10-28 756138176 (x86_64/Linux) inst-decl defaults go via typechecker (#12220) + # 2017-02-17 831733376 (x86_64/Linux) Type-indexed Typeable only_ways(['normal']), extra_hc_opts('-dcore-lint -static'), @@ -155,7 +157,7 @@ test('T3294', # 2015-07-11 43196344 (x86/Linux, 64-bit machine) use +RTS -G1 # 2016-04-06 28686588 (x86/Linux, 64-bit machine) - (wordsize(64), 52992688, 20)]), + (wordsize(64), 63131248, 20)]), # prev: 25753192 (amd64/Linux) # 29/08/2012: 37724352 (amd64/Linux) # (increase due to new codegen, see #7198) @@ -173,6 +175,7 @@ test('T3294', # D757: emit Typeable instances at site of type definition # 2016-07-11: 54609256 (Windows) before fix for #12227 # 2016-07-11: 52992688 (Windows) after fix for #12227 + # 2017-02-17: 63131248 (amd64/Linux) Type indexed Typeable compiler_stats_num_field('bytes allocated', [(wordsize(32), 1377050640, 5), @@ -182,7 +185,7 @@ test('T3294', # 2013-11-13: 1478325844 (x86/Windows, 64bit machine) # 2014-01-12: 1565185140 (x86/Linux) # 2013-04-04: 1377050640 (x86/Windows, 64bit machine) - (wordsize(64), 2739731144, 5)]), + (wordsize(64), 2758641264, 5)]), # old: 1357587088 (amd64/Linux) # 29/08/2012: 2961778696 (amd64/Linux) # (^ increase due to new codegen, see #7198) @@ -195,6 +198,7 @@ test('T3294', # 2014-09-10: 2709595808 (amd64/Linux) post-AMP cleanup # 2016-07-11: 2664479936 (Windows) before fix for #12227 # 2016-07-11: 2739731144 (Windows) after fix for #12227 (ignoring) + # 2016-02-17: 2758641264 (amd64/Linux) (Type indexed Typeable) conf_3294, # Use `+RTS -G1` for more stable residency measurements. Note [residency]. @@ -419,7 +423,7 @@ test('T5631', # 2014-04-04: 346389856 (x86 Windows, 64 bit machine) # 2014-12-01: 390199244 (Windows laptop) # 2016-04-06: 570137436 (amd64/Linux) many reasons - (wordsize(64), 1077429456, 5)]), + (wordsize(64), 1517484488, 5)]), # expected value: 774595008 (amd64/Linux): # expected value: 735486328 (amd64/Linux) 2012/12/12: # expected value: 690742040 (amd64/Linux) Call Arity improvements @@ -431,7 +435,7 @@ test('T5631', # 2015-03-18: 1124068664 (Mac) optimize Unify & zonking # 2016-10-19: 1024926024 (amd64/Linux) Refactor traceRn interface (#12617) # 2016-11-10: 1077429456 (amd64/Linux) Stop -dno-debug-output suppressing -ddump-tc-trace - + # 2017-02-17: 1517484488 (amd64/Linux) Type-indexed Typeable only_ways(['normal']) ], compile, @@ -655,18 +659,19 @@ test('T6048', # 2014-12-01: 49987836 (x86 Windows) # 2016-04-06: 55701280 (x86/Linux, 64-bit machine) - (wordsize(64), 94327392, 10)]) - # 18/09/2012 97247032 amd64/Linux - # 16/01/2014 108578664 amd64/Linux (unknown, likely foldl-via-foldr) - # 18/01/2014 95960720 amd64/Linux Call Arity improvements - # 28/02/2014 105556793 amd64/Linux (unknown, tweak in base/4d9e7c9e3 resulted in change) - # 05/03/2014 110646312 amd64/Linux Call Arity became more elaborate - # 14/07/2014 125431448 amd64/Linux unknown reason. Even worse in GHC-7.8.3. *shurg* - # 29/08/2014 108354472 amd64/Linux w/w for INLINABLE things - # 14/09/2014 88186056 amd64/Linux BPP part1 change (more NoImplicitPreludes in base) - # 08/01/2014 95946688 amd64/Linux Mostly 4c834fd. Occasional spikes to 103822120! - # 11/03/2016 108225624 amd64/Linux unknown reason sadly; likely gradual creep. - # 25/11/2016 94327392 amd64/Linux Back down again hooray; still not sure why + (wordsize(64), 115714216, 10)]) + # 2012-09-18 97247032 amd64/Linux + # 2014-01-16 108578664 amd64/Linux (unknown, likely foldl-via-foldr) + # 2014-01-18 95960720 amd64/Linux Call Arity improvements + # 2014-02-28 105556793 amd64/Linux (unknown, tweak in base/4d9e7c9e3 resulted in change) + # 2014-03-05 110646312 amd64/Linux Call Arity became more elaborate + # 2014-07-14 125431448 amd64/Linux unknown reason. Even worse in GHC-7.8.3. *shurg* + # 2014-08-29 108354472 amd64/Linux w/w for INLINABLE things + # 2014-09-14 88186056 amd64/Linux BPP part1 change (more NoImplicitPreludes in base) + # 2014-01-08 95946688 amd64/Linux Mostly 4c834fd. Occasional spikes to 103822120! + # 2016-03-11 108225624 amd64/Linux unknown reason sadly; likely gradual creep. + # 2016-11-25 94327392 amd64/Linux Back down again hooray; still not sure why + # 2017-02-17 115715592 amd64/Linux Type-indexed Typeable ], compile,['']) @@ -721,9 +726,10 @@ test('T9675', # 2015-07-11 56 (x86/Linux, 64-bit machine) use +RTS -G1 ]), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 608284152, 10) + [(wordsize(64), 731171072, 10) # 2014-10-13 544489040 # 2015-10-28 608284152 emit Typeable at definition site + # 2017-02-17 731171072 Type-indexed Typeable ,(wordsize(32), 279480696, 10) # 2015-07-11 279480696 (x86/Linux, 64-bit machine) use +RTS -G1 ]), @@ -737,14 +743,14 @@ test('T9675', test('T9872a', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 3304620816, 5), + [(wordsize(64), 3298422648, 5), # 2014-12-10 5521332656 Initally created # 2014-12-16 5848657456 Flattener parameterized over roles # 2014-12-18 2680733672 Reduce type families even more eagerly # 2015-12-11 3581500440 TypeInType (see #11196) # 2016-04-07 3352882080 CSE improvements # 2016-10-19 3134866040 Refactor traceRn interface (#12617) - # 2017-02-01 3304620816 + # 2017-02-17 3298422648 Type-indexed Typeable (wordsize(32), 1740903516, 5) # was 1325592896 # 2016-04-06 1740903516 x86/Linux @@ -792,7 +798,7 @@ test('T9872c', test('T9872d', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 478169352, 5), + [(wordsize(64), 535565128, 5), # 2014-12-18 796071864 Initally created # 2014-12-18 739189056 Reduce type families even more eagerly # 2015-01-07 687562440 TrieMap leaf compression @@ -802,6 +808,7 @@ test('T9872d', # 2016-03-18 506691240 optimize Unify & zonking # 2016-12-05 478169352 using tyConIsTyFamFree, I think, but only # a 1% improvement 482 -> 478 + # 2017-02-17 535565128 Type-indexed Typeable (wordsize(32), 264566040, 5) # some date 328810212 # 2015-07-11 350369584 @@ -835,7 +842,7 @@ test('T9961', test('T9233', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 884436192, 5), + [(wordsize(64), 974530192, 5), # 2015-08-04 999826288 initial value # 2016-04-14 1066246248 Final demand analyzer run # 2016-06-18 984268712 shuffling around of Data.Functor.Identity @@ -845,6 +852,7 @@ test('T9233', # 2017-01-23 861862608 worker/wrapper evald-ness flags; another 5% improvement! # 2017-02-01 894486272 Join points # 2017-02-07 884436192 Another improvement to SetLevels + # 2017-02-17 974530192 Type-indexed Typeable (wordsize(32), 515672240, 5) # Put in your value here if you hit this # 2016-04-06 515672240 (x86/Linux) initial value @@ -857,7 +865,7 @@ test('T9233', test('T10370', [ only_ways(['optasm']), compiler_stats_num_field('max_bytes_used', # Note [residency] - [(wordsize(64), 38221184, 15), + [(wordsize(64), 51126304, 15), # 2015-10-22 19548720 # 2016-02-24 22823976 Changing Levity to RuntimeRep; not sure why this regresses though, even after some analysis # 2016-04-14 28256896 final demand analyzer run @@ -870,15 +878,17 @@ test('T10370', # were identical, so I think it's just GC noise. # 2016-10-20 38221184 Allow top-level string literals. # See the comment 16 on #8472. + # 2017-02-17 51126304 Type-indexed Typeawble (wordsize(32), 11371496, 15), # 2015-10-22 11371496 ]), compiler_stats_num_field('peak_megabytes_allocated', # Note [residency] - [(wordsize(64), 146, 15), + [(wordsize(64), 187, 15), # 2015-10-22 76 # 2016-04-14 101 final demand analyzer run # 2016-08-08 121 see above # 2017-01-18 146 Allow top-level string literals in Core + # 2017-02-17 187 Type-indexed Typeawble (wordsize(32), 39, 15), # 2015-10-22 39 ]), @@ -916,9 +926,10 @@ test('T12227', test('T12425', [ only_ways(['optasm']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 133380960, 5), + [(wordsize(64), 173257664, 5), # initial: 125831400 # 2017-01-18: 133380960 Allow top-level string literals in Core + # 2017-02-17: 173257664 Type-indexed Typeable ]), ], compile, @@ -929,11 +940,12 @@ test('T12234', compiler_stats_num_field('bytes allocated', [(platform('x86_64-unknown-mingw32'), 77949232, 5), # initial: 77949232 - (wordsize(64), 74374440, 5), + (wordsize(64), 86525344, 5), # initial: 72958288 # 2016-01-17: 76848856 (x86-64, Linux. drift?) # 2017-02-01: 80882208 (Use superclass instances when solving) # 2017-02-05: 74374440 (Probably OccAnal fixes) + # 2017-02-17: 86525344 (Type-indexed Typeable) ]), ], compile, @@ -942,10 +954,11 @@ test('T12234', test('T13035', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 88806416, 5), - # 2017-01-05 90595208 initial - # 2017-01-19 95269000 Allow top-level string literals in Core - # 2017-02-05 88806416 Probably OccAnal fixes + [(wordsize(64), 103890200, 5), + # 2017-01-05 90595208 initial + # 2017-01-19 95269000 Allow top-level string literals in Core + # 2017-02-05 88806416 Probably OccAnal fixes + # 2017-02-17 103890200 Type-indexed Typeable ]), ], compile, diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index 4c641d5828..a148b712d2 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -5,7 +5,7 @@ test('haddock.base', [unless(in_tree_compiler(), skip), req_haddock ,stats_num_field('bytes allocated', - [(wordsize(64), 38425793776, 5) + [(wordsize(64), 25592972912, 5) # 2012-08-14: 5920822352 (amd64/Linux) # 2012-09-20: 5829972376 (amd64/Linux) # 2012-10-08: 5902601224 (amd64/Linux) @@ -34,6 +34,7 @@ test('haddock.base', # 2017-02-11: 34819979936 (x86_64/Linux) - OccurAnal / One-Shot (#13227) # 2017-02-16: 32695562088 Better Lint for join points # 2017-02-17: 38425793776 (x86_64/Linux) - Generalize kind of (->) + # 2017-02-12: 25592972912 (x86_64/Linux) - Type-indexed Typeable ,(platform('i386-unknown-mingw32'), 4434804940, 5) # 2013-02-10: 3358693084 (x86/Windows) @@ -56,7 +57,7 @@ test('haddock.base', test('haddock.Cabal', [unless(in_tree_compiler(), skip), req_haddock ,stats_num_field('bytes allocated', - [(wordsize(64), 27784875792, 5) + [(wordsize(64), 18865432648, 5) # 2012-08-14: 3255435248 (amd64/Linux) # 2012-08-29: 3324606664 (amd64/Linux, new codegen) # 2012-10-08: 3373401360 (amd64/Linux) @@ -100,6 +101,7 @@ test('haddock.Cabal', # 2017-02-11: 25533642168 (amd64/Linux) - OccurAnal / One-Shot (#13227) # 2017-02-16: 23867276992 Better Lint for join points # 2017-02-17: 27784875792 (amd64/Linux) - Generalize kind of (->) + # 2017-02-12: 18865432648 (amd64/Linux) - Type-indexed Typeable ,(platform('i386-unknown-mingw32'), 3293415576, 5) # 2012-10-30: 1733638168 (x86/Windows) diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T index 4bd75f70de..27d8df87b8 100644 --- a/testsuite/tests/perf/should_run/all.T +++ b/testsuite/tests/perf/should_run/all.T @@ -73,7 +73,7 @@ test('lazy-bs-alloc', [stats_num_field('peak_megabytes_allocated', (2, 1)), # expected value: 2 (amd64/Linux) stats_num_field('bytes allocated', - [(wordsize(64), 444720, 5), + [(wordsize(64), 421792, 5), # 489776 (amd64/Linux) # 2013-02-07: 429744 (amd64/Linux) # 2013-12-12: 425400 (amd64/Linux) @@ -81,6 +81,7 @@ test('lazy-bs-alloc', # 2015-08-15: 431500 (Windows not good enough. avg of Windows&Linux) # 2015-12-15: 444720 (amd64/Linux, D1616) # 2015-12-17: 444720 (widen 3->5%, Windows is at 462688) + # 2017-01-30: 421792 (amd64/Linux, strangely Type-indexed Typeable) (wordsize(32), 429760, 2)]), # 2013-02-10: 421296 (x86/Windows) # 2013-02-10: 414180 (x86/OSX) diff --git a/testsuite/tests/perf/space_leaks/all.T b/testsuite/tests/perf/space_leaks/all.T index a58ae2c97b..76ad7a7606 100644 --- a/testsuite/tests/perf/space_leaks/all.T +++ b/testsuite/tests/perf/space_leaks/all.T @@ -58,13 +58,14 @@ test('T4018', test('T4029', [stats_num_field('peak_megabytes_allocated', - [(wordsize(64), 71, 10)]), + [(wordsize(64), 80, 10)]), # 2016-02-26: 66 (amd64/Linux) INITIAL # 2016-05-23: 82 (amd64/Linux) Use -G1 # 2016-07-13: 92 (amd64/Linux) Changes to tidyType # 2016-09-01: 71 (amd64/Linux) Restore w/w limit (#11565) + # 2017-02-12: 80 (amd64/Linux) Type-indexed Typeable stats_num_field('max_bytes_used', - [(wordsize(64), 22770352, 5)]), + [(wordsize(64), 24151096, 5)]), # 2016-02-26: 24071720 (amd64/Linux) INITIAL # 2016-04-21: 25542832 (amd64/Linux) # 2016-05-23: 25247216 (amd64/Linux) Use -G1 @@ -75,6 +76,7 @@ test('T4029', # 2016-11-14: 21387048 (amd64/Linux) Creep back upwards :( # 2017-01-18: 21670448 (amd64/Linux) Float string literals to toplevel # 2017-02-07: 22770352 (amd64/Linux) It is unclear + # 2017-02-12: 24151096 (amd64/Linux) Type-indexed Typeable extra_hc_opts('+RTS -G1 -RTS' ), ], ghci_script, diff --git a/testsuite/tests/polykinds/T8132.hs b/testsuite/tests/polykinds/T8132.hs index 337e2882f1..cdbfd7f0b9 100644 --- a/testsuite/tests/polykinds/T8132.hs +++ b/testsuite/tests/polykinds/T8132.hs @@ -1,6 +1,7 @@ {-# LANGUAGE MagicHash #-} -import Data.Typeable.Internal +import Data.Typeable data K = K -instance Typeable K where typeRep# _ = undefined +-- This used to have a RHS but now we hide typeRep# +instance Typeable K -- where typeRep# _ = undefined diff --git a/testsuite/tests/polykinds/T8132.stderr b/testsuite/tests/polykinds/T8132.stderr index c5f56f9fbe..a1aaa1319a 100644 --- a/testsuite/tests/polykinds/T8132.stderr +++ b/testsuite/tests/polykinds/T8132.stderr @@ -1,4 +1,4 @@ -T8132.hs:6:1: error: +T8132.hs:7:1: error: • Class ‘Typeable’ does not support user-specified instances • In the instance declaration for ‘Typeable K’ diff --git a/testsuite/tests/roles/should_compile/Roles1.stderr b/testsuite/tests/roles/should_compile/Roles1.stderr index bb67a8cf26..a81e7c0187 100644 --- a/testsuite/tests/roles/should_compile/Roles1.stderr +++ b/testsuite/tests/roles/should_compile/Roles1.stderr @@ -27,88 +27,188 @@ Dependent packages: [base-4.10.0.0, ghc-prim-0.5.0.0, ==================== Typechecker ==================== Roles1.$tcT7 = GHC.Types.TyCon - 12795488517584970699## - 6852268802866176810## + 178606230775360129## + 14564382578551945561## Roles1.$trModule (GHC.Types.TrNameS "T7"#) + 1 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepVar 0) + (GHC.Types.KindRepFun + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep)) Roles1.$tc'K7 = GHC.Types.TyCon - 12022030613939361326## - 11727141136040515167## + 15901479081375327280## + 4842873210599704617## Roles1.$trModule (GHC.Types.TrNameS "'K7"#) + 3 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepVar 2) + (GHC.Types.KindRepTyConApp + Roles1.$tcT7 + ((:) + (GHC.Types.KindRepVar 0) + ((:) (GHC.Types.KindRepVar 1) ((:) (GHC.Types.KindRepVar 2) [])))) Roles1.$tcT6 = GHC.Types.TyCon - 1052116432298682626## - 4782516991847719023## + 7244893995195634045## + 6882827069359931041## Roles1.$trModule (GHC.Types.TrNameS "T6"#) + 1 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepVar 0) + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) Roles1.$tc'K6 = GHC.Types.TyCon - 14383224451764499060## - 13586832700239872984## + 13928703131159360198## + 9274401506945696896## Roles1.$trModule (GHC.Types.TrNameS "'K6"#) + 2 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepTyConApp + Roles1.$tcT6 + ((:) (GHC.Types.KindRepVar 0) ((:) (GHC.Types.KindRepVar 1) [])) Roles1.$tcT5 = GHC.Types.TyCon - 10855726709479635304## - 5574528370049939204## + 12033401645911719002## + 6369139038321702301## Roles1.$trModule (GHC.Types.TrNameS "T5"#) + 0 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) Roles1.$tc'K5 = GHC.Types.TyCon - 17986294396600628264## - 15784122741796850983## + 5548842497263642061## + 18349261927117571882## Roles1.$trModule (GHC.Types.TrNameS "'K5"#) + 1 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepVar 0) + (GHC.Types.KindRepTyConApp + Roles1.$tcT5 ((:) (GHC.Types.KindRepVar 0) [])) Roles1.$tcT4 = GHC.Types.TyCon - 5809060867006837344## - 8795972313583150301## + 15834077582937152787## + 17059037094835388922## Roles1.$trModule (GHC.Types.TrNameS "T4"#) + 0 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepFun + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep)) + (GHC.Types.KindRepFun + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep)) Roles1.$tc'K4 = GHC.Types.TyCon - 6498964159768283182## - 956453098475971212## + 10188453925450404995## + 4762093850599364042## Roles1.$trModule (GHC.Types.TrNameS "'K4"#) + 2 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepApp + (GHC.Types.KindRepVar 0) (GHC.Types.KindRepVar 1)) + (GHC.Types.KindRepTyConApp + Roles1.$tcT4 + ((:) (GHC.Types.KindRepVar 0) ((:) (GHC.Types.KindRepVar 1) []))) Roles1.$tcT3 = GHC.Types.TyCon - 17827258502042208248## - 10404219359416482652## + 13341737262627465733## + 14527452670364737316## Roles1.$trModule (GHC.Types.TrNameS "T3"#) + 1 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepVar 0) + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) Roles1.$tc'K3 = GHC.Types.TyCon - 18386915834109553575## - 773967725306507064## + 14534968069054730342## + 6860808298964464185## Roles1.$trModule (GHC.Types.TrNameS "'K3"#) + 2 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepTyConApp + Roles1.$tcT3 + ((:) (GHC.Types.KindRepVar 0) ((:) (GHC.Types.KindRepVar 1) [])) Roles1.$tcT2 = GHC.Types.TyCon - 14324923875690440398## - 17626224477681351106## + 12900773996789723956## + 9313087549503346504## Roles1.$trModule (GHC.Types.TrNameS "T2"#) + 0 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) Roles1.$tc'K2 = GHC.Types.TyCon - 17795591238510508397## - 10155757471958311507## + 11054915488163123841## + 10799789256744079155## Roles1.$trModule (GHC.Types.TrNameS "'K2"#) + 1 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepVar 0) + (GHC.Types.KindRepTyConApp + Roles1.$tcT2 ((:) (GHC.Types.KindRepVar 0) [])) Roles1.$tcT1 = GHC.Types.TyCon - 12633763300352597178## - 11103726621424210926## + 13228660854624297872## + 14494320157476678712## Roles1.$trModule (GHC.Types.TrNameS "T1"#) + 0 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) Roles1.$tc'K1 = GHC.Types.TyCon - 1949157551035372857## - 3576433963139282451## + 1265606750138351672## + 7033043930969109074## Roles1.$trModule (GHC.Types.TrNameS "'K1"#) + 1 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepVar 0) + (GHC.Types.KindRepTyConApp + Roles1.$tcT1 ((:) (GHC.Types.KindRepVar 0) [])) Roles1.$trModule = GHC.Types.Module (GHC.Types.TrNameS "main"#) (GHC.Types.TrNameS "Roles1"#) diff --git a/testsuite/tests/roles/should_compile/Roles13.stderr b/testsuite/tests/roles/should_compile/Roles13.stderr index 7e510d442e..f336a69be1 100644 --- a/testsuite/tests/roles/should_compile/Roles13.stderr +++ b/testsuite/tests/roles/should_compile/Roles13.stderr @@ -1,7 +1,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 63, types: 26, coercions: 5, joins: 0/0} + = {terms: 114, types: 43, coercions: 5, joins: 0/0} -- RHS size: {terms: 2, types: 2, coercions: 0, joins: 0/0} convert1 :: Wrap Age -> Wrap Age @@ -41,25 +41,10 @@ Roles13.$trModule :: GHC.Types.Module [GblId, Caf=NoCafRefs] Roles13.$trModule = GHC.Types.Module $trModule2 $trModule4 --- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -$tc'MkAge1 :: GHC.Prim.Addr# -[GblId, Caf=NoCafRefs] -$tc'MkAge1 = "'MkAge"# - -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -$tc'MkAge2 :: GHC.Types.TrName +krep :: GHC.Types.KindRep [GblId, Caf=NoCafRefs] -$tc'MkAge2 = GHC.Types.TrNameS $tc'MkAge1 - --- RHS size: {terms: 5, types: 0, coercions: 0, joins: 0/0} -Roles13.$tc'MkAge :: GHC.Types.TyCon -[GblId, Caf=NoCafRefs] -Roles13.$tc'MkAge = - GHC.Types.TyCon - 1226019810264079099## - 12180888342844277416## - Roles13.$trModule - $tc'MkAge2 +krep = GHC.Types.KindRepTYPE GHC.Types.LiftedRep -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} $tcAge1 :: GHC.Prim.Addr# @@ -71,35 +56,73 @@ $tcAge2 :: GHC.Types.TrName [GblId, Caf=NoCafRefs] $tcAge2 = GHC.Types.TrNameS $tcAge1 --- RHS size: {terms: 5, types: 0, coercions: 0, joins: 0/0} +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Roles13.$tcAge :: GHC.Types.TyCon [GblId, Caf=NoCafRefs] Roles13.$tcAge = GHC.Types.TyCon - 18304088376370610314## - 1954648846714895105## + 3456257068627873222## + 14056710845110756026## Roles13.$trModule $tcAge2 + 0# + krep + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +krep1 :: GHC.Types.KindRep +[GblId] +krep1 = + GHC.Types.KindRepTyConApp + GHC.Types.$tcInt (GHC.Types.[] @ GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +krep2 :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs] +krep2 = + GHC.Types.KindRepTyConApp + Roles13.$tcAge (GHC.Types.[] @ GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +krep3 :: GHC.Types.KindRep +[GblId] +krep3 = GHC.Types.KindRepFun krep1 krep2 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -$tc'MkWrap1 :: GHC.Prim.Addr# +$tc'MkAge1 :: GHC.Prim.Addr# [GblId, Caf=NoCafRefs] -$tc'MkWrap1 = "'MkWrap"# +$tc'MkAge1 = "'MkAge"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -$tc'MkWrap2 :: GHC.Types.TrName +$tc'MkAge2 :: GHC.Types.TrName [GblId, Caf=NoCafRefs] -$tc'MkWrap2 = GHC.Types.TrNameS $tc'MkWrap1 +$tc'MkAge2 = GHC.Types.TrNameS $tc'MkAge1 --- RHS size: {terms: 5, types: 0, coercions: 0, joins: 0/0} -Roles13.$tc'MkWrap :: GHC.Types.TyCon -[GblId, Caf=NoCafRefs] -Roles13.$tc'MkWrap = +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +Roles13.$tc'MkAge :: GHC.Types.TyCon +[GblId] +Roles13.$tc'MkAge = GHC.Types.TyCon - 12402878715225676312## - 13345418993613492500## + 18264039750958872441## + 1870189534242358050## Roles13.$trModule - $tc'MkWrap2 + $tc'MkAge2 + 0# + krep3 + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +krep4 :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs] +krep4 = GHC.Types.KindRepTYPE GHC.Types.LiftedRep + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +krep5 :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs] +krep5 = GHC.Types.KindRepTYPE GHC.Types.LiftedRep + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +krep6 :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs] +krep6 = GHC.Types.KindRepFun krep4 krep5 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} $tcWrap1 :: GHC.Prim.Addr# @@ -111,15 +134,66 @@ $tcWrap2 :: GHC.Types.TrName [GblId, Caf=NoCafRefs] $tcWrap2 = GHC.Types.TrNameS $tcWrap1 --- RHS size: {terms: 5, types: 0, coercions: 0, joins: 0/0} +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Roles13.$tcWrap :: GHC.Types.TyCon [GblId, Caf=NoCafRefs] Roles13.$tcWrap = GHC.Types.TyCon - 5278920226786541118## - 14554440859491798587## + 13773534096961634492## + 15591525585626702988## Roles13.$trModule $tcWrap2 + 0# + krep6 + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +krep7 :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs] +krep7 = GHC.Types.KindRepVar 0# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +krep8 :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs] +krep8 = GHC.Types.KindRepVar 0# + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +krep9 :: [GHC.Types.KindRep] +[GblId, Caf=NoCafRefs] +krep9 = + GHC.Types.: + @ GHC.Types.KindRep krep8 (GHC.Types.[] @ GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +krep10 :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs] +krep10 = GHC.Types.KindRepTyConApp Roles13.$tcWrap krep9 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +krep11 :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs] +krep11 = GHC.Types.KindRepFun krep7 krep10 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$tc'MkWrap1 :: GHC.Prim.Addr# +[GblId, Caf=NoCafRefs] +$tc'MkWrap1 = "'MkWrap"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$tc'MkWrap2 :: GHC.Types.TrName +[GblId, Caf=NoCafRefs] +$tc'MkWrap2 = GHC.Types.TrNameS $tc'MkWrap1 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +Roles13.$tc'MkWrap :: GHC.Types.TyCon +[GblId, Caf=NoCafRefs] +Roles13.$tc'MkWrap = + GHC.Types.TyCon + 15580677875333883466## + 808508687714473149## + Roles13.$trModule + $tc'MkWrap2 + 1# + krep11 diff --git a/testsuite/tests/roles/should_compile/Roles14.stderr b/testsuite/tests/roles/should_compile/Roles14.stderr index 8604b00ad2..61d0a597d1 100644 --- a/testsuite/tests/roles/should_compile/Roles14.stderr +++ b/testsuite/tests/roles/should_compile/Roles14.stderr @@ -14,16 +14,30 @@ Dependent packages: [base-4.10.0.0, ghc-prim-0.5.0.0, ==================== Typechecker ==================== Roles12.$tcC2 = GHC.Types.TyCon - 4006088231579841122## - 4783761708993822739## + 7996680154108933333## + 9454227235464419996## Roles12.$trModule (GHC.Types.TrNameS "C2"#) + 0 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) + (GHC.Types.KindRepTyConApp GHC.Types.$tcConstraint []) Roles12.$tc'C:C2 = GHC.Types.TyCon - 5555822832309788726## - 2795860317217328413## + 7087988437584478859## + 11477953550142401435## Roles12.$trModule (GHC.Types.TrNameS "'C:C2"#) + 1 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepFun + (GHC.Types.KindRepVar 0) (GHC.Types.KindRepVar 0)) + (GHC.Types.KindRepTyConApp + Roles12.$tcC2 ((:) (GHC.Types.KindRepVar 0) [])) Roles12.$trModule = GHC.Types.Module (GHC.Types.TrNameS "main"#) (GHC.Types.TrNameS "Roles12"#) diff --git a/testsuite/tests/roles/should_compile/Roles2.stderr b/testsuite/tests/roles/should_compile/Roles2.stderr index cea02f5215..7a795a3fa6 100644 --- a/testsuite/tests/roles/should_compile/Roles2.stderr +++ b/testsuite/tests/roles/should_compile/Roles2.stderr @@ -13,28 +13,56 @@ Dependent packages: [base-4.10.0.0, ghc-prim-0.5.0.0, ==================== Typechecker ==================== Roles2.$tcT2 = GHC.Types.TyCon - 5934726586329293381## - 1923031187495159753## + 9065817229114433861## + 13399581642971864140## Roles2.$trModule (GHC.Types.TrNameS "T2"#) + 0 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) Roles2.$tc'K2 = GHC.Types.TyCon - 1362115092449420584## - 15899377929296700609## + 17395957229042313563## + 12263882107019815181## Roles2.$trModule (GHC.Types.TrNameS "'K2"#) + 1 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepTyConApp + GHC.Ptr.$tcFunPtr ((:) (GHC.Types.KindRepVar 0) [])) + (GHC.Types.KindRepTyConApp + Roles2.$tcT2 ((:) (GHC.Types.KindRepVar 0) [])) Roles2.$tcT1 = GHC.Types.TyCon - 13879106829711353992## - 15151456821588362072## + 10310640733256438505## + 9162099558816022096## Roles2.$trModule (GHC.Types.TrNameS "T1"#) + 0 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) Roles2.$tc'K1 = GHC.Types.TyCon - 14735176013935828521## - 17563925141462511949## + 16530009231990968394## + 11761390951471299534## Roles2.$trModule (GHC.Types.TrNameS "'K1"#) + 1 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepTyConApp + GHC.Types.$tcIO ((:) (GHC.Types.KindRepVar 0) [])) + (GHC.Types.KindRepTyConApp + Roles2.$tcT1 ((:) (GHC.Types.KindRepVar 0) [])) Roles2.$trModule = GHC.Types.Module (GHC.Types.TrNameS "main"#) (GHC.Types.TrNameS "Roles2"#) diff --git a/testsuite/tests/roles/should_compile/Roles3.stderr b/testsuite/tests/roles/should_compile/Roles3.stderr index 1541f892a9..5d3c38c355 100644 --- a/testsuite/tests/roles/should_compile/Roles3.stderr +++ b/testsuite/tests/roles/should_compile/Roles3.stderr @@ -35,52 +35,93 @@ Dependent packages: [base-4.10.0.0, ghc-prim-0.5.0.0, ==================== Typechecker ==================== Roles3.$tcC4 = GHC.Types.TyCon - 12861862461396457184## - 6389612623460961504## + 6800596812149592130## + 15513203864133461281## Roles3.$trModule (GHC.Types.TrNameS "C4"#) -Roles3.$tc'C:C4 - = GHC.Types.TyCon - 5012080351591218464## - 14312195554521420369## - Roles3.$trModule - (GHC.Types.TrNameS "'C:C4"#) + 0 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) + (GHC.Types.KindRepFun + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) + (GHC.Types.KindRepTyConApp GHC.Types.$tcConstraint [])) Roles3.$tcC3 = GHC.Types.TyCon - 5998139369941479154## - 6816352641934636458## + 5076086601454991970## + 10299714674904836194## Roles3.$trModule (GHC.Types.TrNameS "C3"#) -Roles3.$tc'C:C3 - = GHC.Types.TyCon - 5363370173992879615## - 3444510123613553605## - Roles3.$trModule - (GHC.Types.TrNameS "'C:C3"#) + 0 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) + (GHC.Types.KindRepFun + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) + (GHC.Types.KindRepTyConApp GHC.Types.$tcConstraint [])) Roles3.$tcC2 = GHC.Types.TyCon - 8833962732139387711## - 7891126688522429937## + 7902873224172523979## + 11840994447152209031## Roles3.$trModule (GHC.Types.TrNameS "C2"#) + 0 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) + (GHC.Types.KindRepFun + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) + (GHC.Types.KindRepTyConApp GHC.Types.$tcConstraint [])) Roles3.$tc'C:C2 = GHC.Types.TyCon - 17372867324718144313## - 13604113872247370917## + 11218882737915989529## + 9454910899374397367## Roles3.$trModule (GHC.Types.TrNameS "'C:C2"#) + 2 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepFun + (GHC.Types.KindRepTyConApp + Data.Type.Equality.$tc~ + ((:) + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) + ((:) (GHC.Types.KindRepVar 0) ((:) (GHC.Types.KindRepVar 1) [])))) + (GHC.Types.KindRepFun + (GHC.Types.KindRepVar 0) (GHC.Types.KindRepVar 1))) + (GHC.Types.KindRepTyConApp + Roles3.$tcC2 + ((:) (GHC.Types.KindRepVar 0) ((:) (GHC.Types.KindRepVar 1) []))) Roles3.$tcC1 = GHC.Types.TyCon - 16242970448469140073## - 10229725431456576413## + 11013585501375994163## + 16371608655219610659## Roles3.$trModule (GHC.Types.TrNameS "C1"#) + 0 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) + (GHC.Types.KindRepTyConApp GHC.Types.$tcConstraint []) Roles3.$tc'C:C1 = GHC.Types.TyCon - 2927144765823607117## - 15172069236577673237## + 4508088879886988796## + 13962145553903222779## Roles3.$trModule (GHC.Types.TrNameS "'C:C1"#) + 1 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepFun + (GHC.Types.KindRepVar 0) (GHC.Types.KindRepVar 0)) + (GHC.Types.KindRepTyConApp + Roles3.$tcC1 ((:) (GHC.Types.KindRepVar 0) [])) Roles3.$trModule = GHC.Types.Module (GHC.Types.TrNameS "main"#) (GHC.Types.TrNameS "Roles3"#) diff --git a/testsuite/tests/roles/should_compile/Roles4.stderr b/testsuite/tests/roles/should_compile/Roles4.stderr index 49e9ac9768..989d77a9d6 100644 --- a/testsuite/tests/roles/should_compile/Roles4.stderr +++ b/testsuite/tests/roles/should_compile/Roles4.stderr @@ -20,28 +20,58 @@ Dependent packages: [base-4.10.0.0, ghc-prim-0.5.0.0, ==================== Typechecker ==================== Roles4.$tcC3 = GHC.Types.TyCon - 16502190608089501863## - 13971441568961069854## + 7508642517340826358## + 16938219270597865136## Roles4.$trModule (GHC.Types.TrNameS "C3"#) + 0 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) + (GHC.Types.KindRepTyConApp GHC.Types.$tcConstraint []) Roles4.$tc'C:C3 = GHC.Types.TyCon - 16482122951248115051## - 8497036782794772516## + 3133378316178104365## + 15809386433947157376## Roles4.$trModule (GHC.Types.TrNameS "'C:C3"#) + 1 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepFun + (GHC.Types.KindRepVar 0) + (GHC.Types.KindRepTyConApp + GHC.Types.$tc[] ((:) (GHC.Types.KindRepVar 0) []))) + (GHC.Types.KindRepTyConApp + Roles4.$tcC3 ((:) (GHC.Types.KindRepVar 0) [])) Roles4.$tcC1 = GHC.Types.TyCon - 11951908835899020229## - 6518430686554778113## + 13392243382482428602## + 1780037961948725012## Roles4.$trModule (GHC.Types.TrNameS "C1"#) + 0 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) + (GHC.Types.KindRepTyConApp GHC.Types.$tcConstraint []) Roles4.$tc'C:C1 = GHC.Types.TyCon - 11393997571952951642## - 4382794907973051606## + 3870707671502302648## + 10631907186261837450## Roles4.$trModule (GHC.Types.TrNameS "'C:C1"#) + 1 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepFun + (GHC.Types.KindRepVar 0) (GHC.Types.KindRepVar 0)) + (GHC.Types.KindRepTyConApp + Roles4.$tcC1 ((:) (GHC.Types.KindRepVar 0) [])) Roles4.$trModule = GHC.Types.Module (GHC.Types.TrNameS "main"#) (GHC.Types.TrNameS "Roles4"#) diff --git a/testsuite/tests/roles/should_compile/T8958.stderr b/testsuite/tests/roles/should_compile/T8958.stderr index a527d1f02e..52bfa274c9 100644 --- a/testsuite/tests/roles/should_compile/T8958.stderr +++ b/testsuite/tests/roles/should_compile/T8958.stderr @@ -22,40 +22,96 @@ Dependent packages: [base-4.10.0.0, ghc-prim-0.5.0.0, ==================== Typechecker ==================== T8958.$tcMap = GHC.Types.TyCon - 11173210732975605893## - 6338753504925142034## + 16542473435673943392## + 5374201132143305512## T8958.$trModule (GHC.Types.TrNameS "Map"#) + 0 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) + (GHC.Types.KindRepFun + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep)) T8958.$tc'MkMap = GHC.Types.TyCon - 10702411725744601909## - 8660532495248702786## + 2942839876828444488## + 3989137838066763457## T8958.$trModule (GHC.Types.TrNameS "'MkMap"#) + 2 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepTyConApp + GHC.Types.$tc[] + ((:) @ GHC.Types.KindRep + (GHC.Types.KindRepTyConApp + GHC.Tuple.$tc(,) + ((:) @ GHC.Types.KindRep + (GHC.Types.KindRepVar 0) + ((:) @ GHC.Types.KindRep + (GHC.Types.KindRepVar 1) [] @ GHC.Types.KindRep))) + [] @ GHC.Types.KindRep)) + (GHC.Types.KindRepTyConApp + T8958.$tcMap + ((:) @ GHC.Types.KindRep + (GHC.Types.KindRepVar 0) + ((:) @ GHC.Types.KindRep + (GHC.Types.KindRepVar 1) [] @ GHC.Types.KindRep))) T8958.$tcRepresentational = GHC.Types.TyCon - 17939208465687456137## - 86959701938445380## + 12809567151893673426## + 12159693688248149156## T8958.$trModule (GHC.Types.TrNameS "Representational"#) + 0 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) + (GHC.Types.KindRepTyConApp + GHC.Types.$tcConstraint [] @ GHC.Types.KindRep) T8958.$tc'C:Representational = GHC.Types.TyCon - 6623579006299218188## - 18041743345929230411## + 2358772282532242424## + 5444038897914446879## T8958.$trModule (GHC.Types.TrNameS "'C:Representational"#) + 1 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepTyConApp + T8958.$tcRepresentational + ((:) @ GHC.Types.KindRep + (GHC.Types.KindRepVar 0) [] @ GHC.Types.KindRep) T8958.$tcNominal = GHC.Types.TyCon - 5048799062136959048## - 4899664595355811926## + 12224997609886144634## + 9866011944332051160## T8958.$trModule (GHC.Types.TrNameS "Nominal"#) + 0 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) + (GHC.Types.KindRepTyConApp + GHC.Types.$tcConstraint [] @ GHC.Types.KindRep) T8958.$tc'C:Nominal = GHC.Types.TyCon - 13167926310643805202## - 1726092271306256063## + 10562260635335201742## + 1215478186250709459## T8958.$trModule (GHC.Types.TrNameS "'C:Nominal"#) + 1 + krep +krep [InlPrag=[~]] + = GHC.Types.KindRepTyConApp + T8958.$tcNominal + ((:) @ GHC.Types.KindRep + (GHC.Types.KindRepVar 0) [] @ GHC.Types.KindRep) T8958.$trModule = GHC.Types.Module (GHC.Types.TrNameS "main"#) (GHC.Types.TrNameS "T8958"#) diff --git a/testsuite/tests/safeHaskell/unsafeLibs/GoodImport03.hs b/testsuite/tests/safeHaskell/unsafeLibs/GoodImport03.hs index 84e728ffb3..edd6d65fcb 100644 --- a/testsuite/tests/safeHaskell/unsafeLibs/GoodImport03.hs +++ b/testsuite/tests/safeHaskell/unsafeLibs/GoodImport03.hs @@ -56,7 +56,6 @@ import Data.String import Data.Traversable import Data.Tuple import Data.Typeable -import Data.Typeable.Internal import Data.Unique import Data.Version import Data.Word @@ -113,6 +112,8 @@ import Text.Read.Lex import Text.Show import Text.Show.Functions +import Type.Reflection + -- import Unsafe.Coerce f :: Int diff --git a/testsuite/tests/simplCore/should_compile/T7360.stderr b/testsuite/tests/simplCore/should_compile/T7360.stderr index e3fea9ba85..bf2c6df607 100644 --- a/testsuite/tests/simplCore/should_compile/T7360.stderr +++ b/testsuite/tests/simplCore/should_compile/T7360.stderr @@ -1,7 +1,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 94, types: 48, coercions: 0, joins: 0/0} + = {terms: 125, types: 58, coercions: 0, joins: 0/0} -- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} T7360.$WFoo3 [InlPrag=INLINE] :: Int -> Foo @@ -119,129 +119,174 @@ T7360.$trModule :: GHC.Types.Module T7360.$trModule = GHC.Types.Module T7360.$trModule3 T7360.$trModule1 +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T7360.$tcFoo1 [InlPrag=[~]] :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m5] +T7360.$tcFoo1 = GHC.Types.KindRepTYPE GHC.Types.LiftedRep + -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T7360.$tc'Foo9 :: GHC.Prim.Addr# +T7360.$tcFoo3 :: GHC.Prim.Addr# [GblId, Caf=NoCafRefs, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] -T7360.$tc'Foo9 = "'Foo3"# + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +T7360.$tcFoo3 = "Foo"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T7360.$tc'Foo8 :: GHC.Types.TrName +T7360.$tcFoo2 :: GHC.Types.TrName [GblId, Caf=NoCafRefs, Str=m1, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] -T7360.$tc'Foo8 = GHC.Types.TrNameS T7360.$tc'Foo9 +T7360.$tcFoo2 = GHC.Types.TrNameS T7360.$tcFoo3 --- RHS size: {terms: 5, types: 0, coercions: 0, joins: 0/0} -T7360.$tc'Foo3 :: GHC.Types.TyCon +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T7360.$tcFoo :: GHC.Types.TyCon [GblId, Caf=NoCafRefs, Str=m, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 50}] -T7360.$tc'Foo3 = + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] +T7360.$tcFoo = GHC.Types.TyCon - 10507205234936349519## - 8302184214013227554## + 1581370841583180512## + 13291578023368289311## T7360.$trModule - T7360.$tc'Foo8 + T7360.$tcFoo2 + 0# + T7360.$tcFoo1 + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +T7360.$tc'Foo4 [InlPrag=[~]] :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m1] +T7360.$tc'Foo4 = + GHC.Types.KindRepTyConApp + T7360.$tcFoo (GHC.Types.[] @ GHC.Types.KindRep) -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T7360.$tc'Foo7 :: GHC.Prim.Addr# +T7360.$tc'Foo6 :: GHC.Prim.Addr# [GblId, Caf=NoCafRefs, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] -T7360.$tc'Foo7 = "'Foo2"# +T7360.$tc'Foo6 = "'Foo1"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T7360.$tc'Foo6 :: GHC.Types.TrName +T7360.$tc'Foo5 :: GHC.Types.TrName [GblId, Caf=NoCafRefs, Str=m1, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] -T7360.$tc'Foo6 = GHC.Types.TrNameS T7360.$tc'Foo7 +T7360.$tc'Foo5 = GHC.Types.TrNameS T7360.$tc'Foo6 --- RHS size: {terms: 5, types: 0, coercions: 0, joins: 0/0} -T7360.$tc'Foo2 :: GHC.Types.TyCon +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T7360.$tc'Foo1 :: GHC.Types.TyCon [GblId, Caf=NoCafRefs, Str=m, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 50}] -T7360.$tc'Foo2 = + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] +T7360.$tc'Foo1 = GHC.Types.TyCon - 9825259700232563546## - 11056638024476048052## + 3986951253261644518## + 2515097940992351150## T7360.$trModule - T7360.$tc'Foo6 + T7360.$tc'Foo5 + 0# + T7360.$tc'Foo4 + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +T7360.$tc'Foo7 [InlPrag=[~]] :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m1] +T7360.$tc'Foo7 = + GHC.Types.KindRepTyConApp + T7360.$tcFoo (GHC.Types.[] @ GHC.Types.KindRep) -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T7360.$tc'Foo5 :: GHC.Prim.Addr# +T7360.$tc'Foo9 :: GHC.Prim.Addr# [GblId, Caf=NoCafRefs, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] -T7360.$tc'Foo5 = "'Foo1"# +T7360.$tc'Foo9 = "'Foo2"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T7360.$tc'Foo4 :: GHC.Types.TrName +T7360.$tc'Foo8 :: GHC.Types.TrName [GblId, Caf=NoCafRefs, Str=m1, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] -T7360.$tc'Foo4 = GHC.Types.TrNameS T7360.$tc'Foo5 +T7360.$tc'Foo8 = GHC.Types.TrNameS T7360.$tc'Foo9 --- RHS size: {terms: 5, types: 0, coercions: 0, joins: 0/0} -T7360.$tc'Foo1 :: GHC.Types.TyCon +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T7360.$tc'Foo2 :: GHC.Types.TyCon [GblId, Caf=NoCafRefs, Str=m, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 50}] -T7360.$tc'Foo1 = + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] +T7360.$tc'Foo2 = GHC.Types.TyCon - 2058692068419561651## - 9152017373001677943## + 17325079864060690428## + 2969742457748208427## T7360.$trModule - T7360.$tc'Foo4 + T7360.$tc'Foo8 + 0# + T7360.$tc'Foo7 + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +krep :: GHC.Types.KindRep +[GblId, Str=m1] +krep = + GHC.Types.KindRepTyConApp + GHC.Types.$tcInt (GHC.Types.[] @ GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +krep1 :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m1] +krep1 = + GHC.Types.KindRepTyConApp + T7360.$tcFoo (GHC.Types.[] @ GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T7360.$tc'Foo10 [InlPrag=[~]] :: GHC.Types.KindRep +[GblId, Str=m4] +T7360.$tc'Foo10 = GHC.Types.KindRepFun krep krep1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T7360.$tcFoo2 :: GHC.Prim.Addr# +T7360.$tc'Foo12 :: GHC.Prim.Addr# [GblId, Caf=NoCafRefs, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] -T7360.$tcFoo2 = "Foo"# + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +T7360.$tc'Foo12 = "'Foo3"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T7360.$tcFoo1 :: GHC.Types.TrName +T7360.$tc'Foo11 :: GHC.Types.TrName [GblId, Caf=NoCafRefs, Str=m1, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] -T7360.$tcFoo1 = GHC.Types.TrNameS T7360.$tcFoo2 +T7360.$tc'Foo11 = GHC.Types.TrNameS T7360.$tc'Foo12 --- RHS size: {terms: 5, types: 0, coercions: 0, joins: 0/0} -T7360.$tcFoo :: GHC.Types.TyCon +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T7360.$tc'Foo3 :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, Str=m, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 50}] -T7360.$tcFoo = + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] +T7360.$tc'Foo3 = GHC.Types.TyCon - 8358641983981300860## - 582034888424804490## + 3674231676522181654## + 2694749919371021431## T7360.$trModule - T7360.$tcFoo1 + T7360.$tc'Foo11 + 0# + T7360.$tc'Foo10 diff --git a/testsuite/tests/simplCore/should_compile/T8274.stdout b/testsuite/tests/simplCore/should_compile/T8274.stdout index df8253f510..90d5cebefb 100644 --- a/testsuite/tests/simplCore/should_compile/T8274.stdout +++ b/testsuite/tests/simplCore/should_compile/T8274.stdout @@ -4,15 +4,20 @@ T8274.$trModule4 :: Addr# T8274.$trModule4 = "main"# T8274.$trModule2 :: Addr# T8274.$trModule2 = "T8274"# -T8274.$tc'Positives2 :: Addr# -T8274.$tc'Positives2 = "'Positives"# -T8274.$tc'Positives = GHC.Types.TyCon 14732531009298850569## 4925356269917933860## T8274.$trModule T8274.$tc'Positives1 -T8274.$tcP2 :: Addr# -T8274.$tcP2 = "P"# -T8274.$tcP = GHC.Types.TyCon 11095028091707994303## 9476557054198009608## T8274.$trModule T8274.$tcP1 -T8274.$tc'Negatives2 :: Addr# -T8274.$tc'Negatives2 = "'Negatives"# -T8274.$tc'Negatives = GHC.Types.TyCon 15950179315687996644## 11481167534507418130## T8274.$trModule T8274.$tc'Negatives1 -T8274.$tcN2 :: Addr# -T8274.$tcN2 = "N"# -T8274.$tcN = GHC.Types.TyCon 7479687563082171902## 17616649989360543185## T8274.$trModule T8274.$tcN1 +T8274.$tcP3 :: Addr# +T8274.$tcP3 = "P"# +T8274.$tcP = GHC.Types.TyCon 7483823267324216774## 12197132127820124256## T8274.$trModule T8274.$tcP2 0# T8274.$tcP1 +krep = GHC.Types.KindRepTyConApp GHC.Types.$tcInt# (GHC.Types.[] @ GHC.Types.KindRep) +krep1 = GHC.Types.KindRepTyConApp GHC.Types.$tcFloat# (GHC.Types.[] @ GHC.Types.KindRep) +krep2 = GHC.Types.KindRepTyConApp GHC.Types.$tcDouble# (GHC.Types.[] @ GHC.Types.KindRep) +krep3 = GHC.Types.KindRepTyConApp GHC.Types.$tcChar# (GHC.Types.[] @ GHC.Types.KindRep) +krep4 = GHC.Types.KindRepTyConApp GHC.Types.$tcWord# (GHC.Types.[] @ GHC.Types.KindRep) +T8274.$tc'Positives3 :: Addr# +T8274.$tc'Positives3 = "'Positives"# + = GHC.Types.TyCon 14886798270706315033## 15735393004803600911## T8274.$trModule T8274.$tc'Positives2 0# T8274.$tc'Positives1 +T8274.$tcN3 :: Addr# +T8274.$tcN3 = "N"# +T8274.$tcN = GHC.Types.TyCon 17387464673997143412## 16681536026493340311## T8274.$trModule T8274.$tcN2 0# T8274.$tcN1 +T8274.$tc'Negatives3 :: Addr# +T8274.$tc'Negatives3 = "'Negatives"# + = GHC.Types.TyCon 14330047746189143983## 12207513731214201811## T8274.$trModule T8274.$tc'Negatives2 0# T8274.$tc'Negatives1 diff --git a/testsuite/tests/th/TH_Roles2.stderr b/testsuite/tests/th/TH_Roles2.stderr index 33fec8e9d5..7b872aae9a 100644 --- a/testsuite/tests/th/TH_Roles2.stderr +++ b/testsuite/tests/th/TH_Roles2.stderr @@ -4,17 +4,23 @@ TYPE CONSTRUCTORS data T (a :: k) COERCION AXIOMS Dependent modules: [] -Dependent packages: [array-0.5.1.1, base-4.9.0.0, deepseq-1.4.2.0, +Dependent packages: [array-0.5.1.2, base-4.10.0.0, deepseq-1.4.3.0, ghc-boot-th-8.1, ghc-prim-0.5.0.0, integer-gmp-1.0.0.1, - pretty-1.1.3.3, template-haskell-2.11.0.0] + pretty-1.1.3.3, template-haskell-2.12.0.0] ==================== Typechecker ==================== TH_Roles2.$tcT = GHC.Types.TyCon - 6325001754388382679## - 4656387726417942748## + 11651627537942629178## + 11503899791410937231## TH_Roles2.$trModule (GHC.Types.TrNameS "T"#) + 1 + krep_a7XD +krep_a7XD [InlPrag=[~]] + = GHC.Types.KindRepFun + (GHC.Types.KindRepVar 0) + (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) TH_Roles2.$trModule = GHC.Types.Module (GHC.Types.TrNameS "main"#) (GHC.Types.TrNameS "TH_Roles2"#) diff --git a/testsuite/tests/typecheck/should_compile/tc167.hs b/testsuite/tests/typecheck/should_compile/tc167.hs index b42ceacdc8..773075022c 100644 --- a/testsuite/tests/typecheck/should_compile/tc167.hs +++ b/testsuite/tests/typecheck/should_compile/tc167.hs @@ -1,13 +1,15 @@ {-# LANGUAGE MagicHash #-} --- Type checking with unboxed kinds fails when (->) is used in a prefix way +-- It used to be that (->) would have a very restrictive kind when used in +-- prefix position. This restriction was lifted after the levity polymorphism +-- work in 2016. module ShouldSucceed where import GHC.Base type T = (->) Int# --- Here's the comment from TypeRep: +-- Here's the old comment from TypeRep: -- -- funTyCon = mkFunTyCon funTyConName -- (mkArrowKinds [liftedTypeKind, liftedTypeKind] diff --git a/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr b/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr index e6e637cfeb..fd6be80c7e 100644 --- a/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr +++ b/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr @@ -1,13 +1,13 @@ TcStaticPointersFail02.hs:9:6: error: - • No instance for (Data.Typeable.Internal.Typeable b) + • No instance for (base-4.10.0.0:Data.Typeable.Internal.Typeable b) arising from a static form • In the expression: static (undefined :: (forall a. a -> a) -> b) In an equation for ‘f1’: f1 = static (undefined :: (forall a. a -> a) -> b) TcStaticPointersFail02.hs:12:6: error: - • No instance for (Data.Typeable.Internal.Typeable + • No instance for (base-4.10.0.0:Data.Typeable.Internal.Typeable (Monad m => a -> m a)) arising from a static form (maybe you haven't applied a function to enough arguments?) diff --git a/testsuite/tests/typecheck/should_run/TestTypeableBinary.hs b/testsuite/tests/typecheck/should_run/TestTypeableBinary.hs new file mode 100644 index 0000000000..e427c13725 --- /dev/null +++ b/testsuite/tests/typecheck/should_run/TestTypeableBinary.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} + +import qualified Data.ByteString as BS +import Type.Reflection +import Data.Binary +import GHCi.TH.Binary () + +import GHC.Exts +import Data.Kind +import Data.Proxy + +testRoundtrip :: Typeable a => TypeRep a -> IO () +testRoundtrip rep + | rep /= rep' = putStrLn $ "bad: " ++ show rep ++ " /= " ++ show rep' + | otherwise = putStrLn $ "good: " ++ show rep + where + rep' = decode (encode rep) + +main :: IO () +main = do + testRoundtrip (typeRep :: TypeRep Int) + testRoundtrip (typeRep :: TypeRep Int#) + testRoundtrip (typeRep :: TypeRep IO) + testRoundtrip (typeRep :: TypeRep Maybe) + testRoundtrip (typeRep :: TypeRep TYPE) + testRoundtrip (typeRep :: TypeRep RuntimeRep) + testRoundtrip (typeRep :: TypeRep 'IntRep) + testRoundtrip (typeRep :: TypeRep (->)) + testRoundtrip (typeRep :: TypeRep (Proxy Int)) + testRoundtrip (typeRep :: TypeRep (Proxy Int#)) + testRoundtrip (typeRep :: TypeRep Type) + testRoundtrip (typeRep :: TypeRep (Int -> Int)) + testRoundtrip (typeRep :: TypeRep 5) + testRoundtrip (typeRep :: TypeRep "hello world") + testRoundtrip (typeRep :: TypeRep ('Just 5)) diff --git a/testsuite/tests/typecheck/should_run/TestTypeableBinary.stdout b/testsuite/tests/typecheck/should_run/TestTypeableBinary.stdout new file mode 100644 index 0000000000..515738e98e --- /dev/null +++ b/testsuite/tests/typecheck/should_run/TestTypeableBinary.stdout @@ -0,0 +1,15 @@ +good: Int +good: Int# +good: IO +good: Maybe +good: TYPE +good: RuntimeRep +good: 'IntRep +good: (->) 'LiftedRep 'LiftedRep +good: Proxy * Int +good: Proxy (TYPE 'IntRep) Int# +good: * +good: Int -> Int +good: 5 +good: "hello world" +good: 'Just Nat 5 diff --git a/testsuite/tests/typecheck/should_run/TypeOf.stdout b/testsuite/tests/typecheck/should_run/TypeOf.stdout index 99f113cf00..3c125fecfd 100644 --- a/testsuite/tests/typecheck/should_run/TypeOf.stdout +++ b/testsuite/tests/typecheck/should_run/TypeOf.stdout @@ -5,7 +5,7 @@ Word Double IO () (Char,Int,[Char]) -TypeRep +SomeTypeRep Bool Ordering Int -> Int @@ -13,7 +13,7 @@ Proxy Constraint (Eq Int) Proxy Constraint (Int,Int) Proxy Symbol "hello world" Proxy Nat 1 -Proxy [Nat] (': Nat 1 (': Nat 2 (': Nat 3 '[]))) +Proxy [Nat] (': Nat 1 (': Nat 2 (': Nat 3 ('[] Nat)))) Proxy Ordering 'EQ Proxy (RuntimeRep -> Constraint) TYPE Proxy Constraint Constraint @@ -21,4 +21,4 @@ Proxy Constraint Constraint Proxy Constraint Constraint Proxy RuntimeRep 'LiftedRep Proxy (Nat,Symbol) ('(,) Nat Symbol 1 "hello") -Proxy (Constraint -> Constraint -> Constraint) ~~ +Proxy (Constraint -> Constraint -> Constraint) (~~ Constraint Constraint) diff --git a/testsuite/tests/typecheck/should_run/TypeRep.hs b/testsuite/tests/typecheck/should_run/TypeRep.hs index 5fbf909193..002e4fbac0 100644 --- a/testsuite/tests/typecheck/should_run/TypeRep.hs +++ b/testsuite/tests/typecheck/should_run/TypeRep.hs @@ -1,5 +1,9 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE TypeInType #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE AllowAmbiguousTypes #-} @@ -30,6 +34,12 @@ main = do print $ rep @Bool print $ rep @Ordering print $ rep @(Int -> Int) + print $ rep @((Eq Int, Eq String) :: Constraint) + + -- Unboxed things (#12049) + print $ rep @Int# + print $ rep @(##) + print $ rep @(# Int#, Int #) -- Various instantiations of a kind-polymorphic type print $ rep @(Proxy (Eq Int)) @@ -45,4 +55,4 @@ main = do print $ rep @(Proxy 'LiftedRep) -- Something lifted and primitive - print $ rep @RealWorld + print $ rep @RealWorld -- #12132 diff --git a/testsuite/tests/typecheck/should_run/TypeRep.stdout b/testsuite/tests/typecheck/should_run/TypeRep.stdout index 09b4cea574..8f5d3fb232 100644 --- a/testsuite/tests/typecheck/should_run/TypeRep.stdout +++ b/testsuite/tests/typecheck/should_run/TypeRep.stdout @@ -10,11 +10,15 @@ IO Bool Ordering Int -> Int +(%,%) (Eq Int) (Eq [Char]) +Int# +(##) +(#,#) 'IntRep 'LiftedRep Int# Int Proxy Constraint (Eq Int) Proxy Constraint (Int,Int) Proxy Symbol "hello world" Proxy Nat 1 -Proxy [Nat] (': Nat 1 (': Nat 2 (': Nat 3 '[]))) +Proxy [Nat] (': Nat 1 (': Nat 2 (': Nat 3 ('[] Nat)))) Proxy Ordering 'EQ Proxy (RuntimeRep -> Constraint) TYPE Proxy Constraint Constraint diff --git a/testsuite/tests/typecheck/should_run/Typeable1.hs b/testsuite/tests/typecheck/should_run/Typeable1.hs new file mode 100644 index 0000000000..02a7ebb98b --- /dev/null +++ b/testsuite/tests/typecheck/should_run/Typeable1.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE PolyKinds #-} + +import Type.Reflection +import Data.Kind + +data ComposeK (f :: k' -> Type) (g :: k -> k') a = ComposeK (f (g a)) + +main :: IO () +main = do + let x :: ComposeK Maybe Maybe Int + x = undefined + + App x y <- pure $ typeOf x + print (x, y) + + App x y <- pure x + print (x, y) + + App x y <- pure x + print (x, y) + + App x y <- pure x -- This makes GHC panic + print (x, y) diff --git a/testsuite/tests/typecheck/should_run/Typeable1.stderr b/testsuite/tests/typecheck/should_run/Typeable1.stderr new file mode 100644 index 0000000000..9a7d3b799c --- /dev/null +++ b/testsuite/tests/typecheck/should_run/Typeable1.stderr @@ -0,0 +1,25 @@ + +Typeable1.hs:22:5: error: + • Couldn't match kind ‘* -> (* -> *) -> (* -> *) -> * -> *’ + with ‘forall k. (* -> *) -> (k -> *) -> k -> *’ + Inaccessible code in + a pattern with pattern synonym: + App :: forall k2 (t :: k2). + () => + forall k1 (a :: k1 -> k2) (b :: k1). + t ~ a b => + TypeRep a -> TypeRep b -> TypeRep t, + in a pattern binding in + 'do' block + • In the pattern: App x y + In a stmt of a 'do' block: App x y <- pure x + In the expression: + do let x :: ComposeK Maybe Maybe Int + x = undefined + App x y <- pure $ typeOf x + print (x, y) + App x y <- pure x + .... + • Relevant bindings include + y :: TypeRep b2 (bound at Typeable1.hs:19:11) + x :: TypeRep a2 (bound at Typeable1.hs:19:9) diff --git a/testsuite/tests/typecheck/should_run/TypeableEq.hs b/testsuite/tests/typecheck/should_run/TypeableEq.hs new file mode 100644 index 0000000000..6fe6aa7c11 --- /dev/null +++ b/testsuite/tests/typecheck/should_run/TypeableEq.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE PolyKinds, TypeFamilies #-} + +-- | Test equality predicates of Type.Reflection. +module Main where + +import Type.Reflection +import Data.Kind +import Data.Maybe +import Data.Proxy +import Data.Functor.Const +import Data.Functor.Product + +--data Product (f :: k -> Type) (g :: k -> Type) (a :: k) +-- = Product (f x) (g x) + +test1 :: IO () +test1 = do + let x = typeRep :: TypeRep (Maybe String) + y = typeRep :: TypeRep (Maybe Int) + + checkEq False x y + App maybe1 _ <- pure x + App maybe2 _ <- pure y + checkEq True maybe1 maybe2 + + +test2 :: IO () +test2 = do + let x = typeRep :: TypeRep (Proxy String) + y = typeRep :: TypeRep (Proxy Int) + + checkEq False x y + App proxy1 _ <- pure x + App proxy2 _ <- pure y + checkEq True proxy1 proxy2 + + +test3 :: IO () +test3 = do + let x = typeRep :: TypeRep (Product (Const String) (Const Int) Int) + y = typeRep :: TypeRep (Product (Const String) (Const Char) Int) + checkEq False x y + App dx _ <- pure x -- "d" stands for decomposed + App dy _ <- pure y + checkEq False dx dy + App ddx _ <- pure dx + App ddy _ <- pure dy + checkEq True ddx ddy + + +test4 :: IO () +test4 = do + let x = typeRep :: TypeRep (Product (Const String) (Const Int) Int) + y = typeRep :: TypeRep (Product (Const String) (Const Int) Char) + + checkEq False x y + App dx _ <- pure x + App dy _ <- pure y + checkEq True dx dy + App ddx _ <- pure dx + App ddy _ <- pure dy + checkEq True ddx ddy + + +main :: IO () +main = sequence_ [test1, test2, test3, test4] + +type IsEqual = Bool + +check :: Bool -> String -> IO () +check success msg = putStrLn $ goodBad ++ " " ++ msg + where goodBad + | success = "good" + | otherwise = "bad " + +checkEq :: IsEqual -> TypeRep a -> TypeRep b -> IO () +checkEq expected a b = + check success (show a ++ " == " ++ show b ++ "?") + where success = isJust (a `eqTypeRep` b) == expected diff --git a/testsuite/tests/typecheck/should_run/TypeableEq.stdout b/testsuite/tests/typecheck/should_run/TypeableEq.stdout new file mode 100644 index 0000000000..bff6d9ee2c --- /dev/null +++ b/testsuite/tests/typecheck/should_run/TypeableEq.stdout @@ -0,0 +1,10 @@ +good Maybe [Char] == Maybe Int? +good Maybe == Maybe? +good Proxy * [Char] == Proxy * Int? +good Proxy * == Proxy *? +good Product * (Const * [Char]) (Const * Int) Int == Product * (Const * [Char]) (Const * Char) Int? +good Product * (Const * [Char]) (Const * Int) == Product * (Const * [Char]) (Const * Char)? +good Product * (Const * [Char]) == Product * (Const * [Char])? +good Product * (Const * [Char]) (Const * Int) Int == Product * (Const * [Char]) (Const * Int) Char? +good Product * (Const * [Char]) (Const * Int) == Product * (Const * [Char]) (Const * Int)? +good Product * (Const * [Char]) == Product * (Const * [Char])? diff --git a/testsuite/tests/typecheck/should_run/all.T b/testsuite/tests/typecheck/should_run/all.T index eab9f8a8a8..c44a23e1ff 100755 --- a/testsuite/tests/typecheck/should_run/all.T +++ b/testsuite/tests/typecheck/should_run/all.T @@ -117,3 +117,6 @@ test('KindInvariant', normal, ghci_script, ['KindInvariant.script']) test('StrictPats', normal, compile_and_run, ['']) test('T12809', normal, compile_and_run, ['']) test('EtaExpandLevPoly', normal, compile_and_run, ['']) +test('TestTypeableBinary', normal, compile_and_run, ['']) +test('Typeable1', normal, compile_fail, ['']) +test('TypeableEq', normal, compile_and_run, ['']) |