diff options
Diffstat (limited to 'testsuite/tests')
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, ['']) |