diff options
| -rw-r--r-- | compiler/prelude/PrelNames.hs | 23 | ||||
| -rw-r--r-- | compiler/typecheck/TcTypeable.hs | 156 | ||||
| -rw-r--r-- | testsuite/tests/deSugar/should_compile/T2431.stderr | 43 | ||||
| -rw-r--r-- | testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr | 13 | ||||
| -rw-r--r-- | testsuite/tests/roles/should_compile/Roles1.stderr | 15 | ||||
| -rw-r--r-- | testsuite/tests/roles/should_compile/Roles13.stderr | 56 | ||||
| -rw-r--r-- | testsuite/tests/roles/should_compile/Roles14.stderr | 4 | ||||
| -rw-r--r-- | testsuite/tests/roles/should_compile/Roles2.stderr | 6 | ||||
| -rw-r--r-- | testsuite/tests/roles/should_compile/Roles3.stderr | 14 | ||||
| -rw-r--r-- | testsuite/tests/roles/should_compile/Roles4.stderr | 6 | ||||
| -rw-r--r-- | testsuite/tests/roles/should_compile/T8958.stderr | 9 | ||||
| -rw-r--r-- | testsuite/tests/simplCore/should_compile/T7360.stderr | 19 | ||||
| -rw-r--r-- | testsuite/tests/simplCore/should_compile/T8274.stdout | 8 | ||||
| -rw-r--r-- | testsuite/tests/th/TH_Roles2.stderr | 8 |
14 files changed, 209 insertions, 171 deletions
diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 470b736286..2b1c6b0f9d 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -244,6 +244,11 @@ basicKnownKeyNames typeSymbolTypeRepName, typeNatTypeRepName, trGhcPrimModuleName, + -- KindReps for common cases + starKindRepName, + starArrStarKindRepName, + starArrStarArrStarKindRepName, + -- Dynamic toDynName, @@ -1267,6 +1272,12 @@ typeSymbolTypeRepName = varQual tYPEABLE_INTERNAL (fsLit "typeSymbolTypeRep") ty -- See Note [Grand plan for Typeable] in TcTypeable. trGhcPrimModuleName = varQual gHC_TYPES (fsLit "tr$ModuleGHCPrim") trGhcPrimModuleKey +-- Typeable KindReps for some common cases +starKindRepName, starArrStarKindRepName, starArrStarArrStarKindRepName :: Name +starKindRepName = varQual gHC_TYPES (fsLit "krep$*") starKindRepKey +starArrStarKindRepName = varQual gHC_TYPES (fsLit "krep$*Arr*") starArrStarKindRepKey +starArrStarArrStarKindRepName = varQual gHC_TYPES (fsLit "krep$*->*->*") starArrStarArrStarKindRepKey + -- Custom type errors errorMessageTypeErrorFamName , typeErrorTextDataConName @@ -2325,6 +2336,12 @@ trTYPE'PtrRepLiftedKey = mkPreludeMiscIdUnique 511 trRuntimeRepKey = mkPreludeMiscIdUnique 512 tr'PtrRepLiftedKey = mkPreludeMiscIdUnique 513 +-- KindReps for common cases +starKindRepKey, starArrStarKindRepKey, starArrStarArrStarKindRepKey :: Unique +starKindRepKey = mkPreludeMiscIdUnique 520 +starArrStarKindRepKey = mkPreludeMiscIdUnique 521 +starArrStarArrStarKindRepKey = mkPreludeMiscIdUnique 522 + -- Dynamic toDynIdKey :: Unique toDynIdKey = mkPreludeMiscIdUnique 550 @@ -2349,14 +2366,14 @@ emptyCallStackKey = mkPreludeMiscIdUnique 558 pushCallStackKey = mkPreludeMiscIdUnique 559 fromStaticPtrClassOpKey :: Unique -fromStaticPtrClassOpKey = mkPreludeMiscIdUnique 519 +fromStaticPtrClassOpKey = mkPreludeMiscIdUnique 560 makeStaticKey :: Unique -makeStaticKey = mkPreludeMiscIdUnique 520 +makeStaticKey = mkPreludeMiscIdUnique 561 -- Natural naturalFromIntegerIdKey :: Unique -naturalFromIntegerIdKey = mkPreludeMiscIdUnique 521 +naturalFromIntegerIdKey = mkPreludeMiscIdUnique 562 {- ************************************************************************ diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs index 16b982d46e..78feca1dbf 100644 --- a/compiler/typecheck/TcTypeable.hs +++ b/compiler/typecheck/TcTypeable.hs @@ -28,7 +28,7 @@ import Type import Kind ( isTYPEApp ) import TyCon import DataCon -import Name ( getOccName ) +import Name ( Name, getOccName ) import OccName import Module import HsSyn @@ -121,7 +121,11 @@ There are many wrinkles: there is generally little benefit to inlining KindReps and they would otherwise strongly affect compiler performance. -* Even KindReps aren't inlined this scheme still has more of an effect on +* In general there are lots of things of kind *, * -> *, and * -> * -> *. To + reduce the number of bindings we need to produce, we generate their KindReps + once in GHC.Types. These are referred to as "built-in" KindReps below. + +* Even though KindReps aren't inlined this scheme still has more of an effect on compilation time than I'd like. This is especially true in the case of families of type constructors (e.g. tuples and unboxed sums). The problem is particularly bad in the case of sums, since each arity-N tycon brings with it @@ -222,12 +226,14 @@ data TypeRepTodo , todo_tycons :: [TypeableTyCon] -- ^ The 'TyCon's in need of bindings and their zonked kinds } + | ExportedKindRepsTodo [(Kind, Id)] + -- ^ Build exported 'KindRep' bindings for the given set of kinds. todoForTyCons :: Module -> Id -> [TyCon] -> TcM TypeRepTodo todoForTyCons mod mod_id tycons = do - trTyConTyCon <- tcLookupTyCon trTyConTyConName + trTyConTy <- mkTyConTy <$> tcLookupTyCon trTyConTyConName let mkRepId :: TyConRepName -> Id - mkRepId rep_name = mkExportedVanillaId rep_name (mkTyConTy trTyConTyCon) + mkRepId rep_name = mkExportedVanillaId rep_name trTyConTy tycons <- sequence [ do kind <- zonkTcType $ tyConKind tc'' @@ -259,24 +265,38 @@ todoForTyCons mod mod_id tycons = do mod_fpr = fingerprintString $ moduleNameString $ moduleName mod pkg_fpr = fingerprintString $ unitIdString $ moduleUnitId mod +todoForExportedKindReps :: [(Kind, Name)] -> TcM TypeRepTodo +todoForExportedKindReps kinds = do + trKindRepTy <- mkTyConTy <$> tcLookupTyCon kindRepTyConName + let mkId (k, name) = (k, mkExportedVanillaId name trKindRepTy) + return $ ExportedKindRepsTodo $ map mkId kinds + -- | Generate TyCon bindings for a set of type constructors mkTypeRepTodoBinds :: [TypeRepTodo] -> TcM TcGblEnv mkTypeRepTodoBinds [] = getGblEnv mkTypeRepTodoBinds todos = do { stuff <- collect_stuff - -- First extend the type environment with all of the bindings which we - -- are going to produce since we may need to refer to them while - -- generating the kind representations of other types. - ; let tycon_rep_bndrs :: [Id] - tycon_rep_bndrs = [ tycon_rep_id - | todo <- todos - , TypeableTyCon {..} <- todo_tycons todo - ] - ; gbl_env <- tcExtendGlobalValEnv tycon_rep_bndrs getGblEnv + -- First extend the type environment with all of the bindings + -- which we are going to produce since we may need to refer to them + -- while generating the kind representations of other types. + ; let produced_bndrs :: [Id] + produced_bndrs = [ tycon_rep_id + | todo@(TypeRepTodo{}) <- todos + , TypeableTyCon {..} <- todo_tycons todo + ] ++ + [ rep_id + | ExportedKindRepsTodo kinds <- todos + , (_, rep_id) <- kinds + ] + ; gbl_env <- tcExtendGlobalValEnv produced_bndrs getGblEnv ; let mk_binds :: TypeRepTodo -> KindRepM [LHsBinds Id] - mk_binds todo = mapM (mkTyConRepBinds stuff todo) (todo_tycons todo) + mk_binds todo@(TypeRepTodo {}) = + mapM (mkTyConRepBinds stuff todo) (todo_tycons todo) + mk_binds (ExportedKindRepsTodo kinds) = + mkExportedKindReps stuff kinds >> return [] + ; (gbl_env, binds) <- setGblEnv gbl_env $ runKindRepM (mapM mk_binds todos) ; return $ gbl_env `addTypecheckedBinds` concat binds } @@ -289,7 +309,8 @@ mkPrimTypeableTodos :: TcM (TcGblEnv, [TypeRepTodo]) mkPrimTypeableTodos = do { mod <- getModule ; if mod == gHC_TYPES - then do { trModuleTyCon <- tcLookupTyCon trModuleTyConName + then do { -- Build Module binding for GHC.Prim + trModuleTyCon <- tcLookupTyCon trModuleTyConName ; let ghc_prim_module_id = mkExportedVanillaId trGhcPrimModuleName (mkTyConTy trModuleTyCon) @@ -297,18 +318,22 @@ mkPrimTypeableTodos ; ghc_prim_module_bind <- mkVarBind ghc_prim_module_id <$> mkModIdRHS gHC_PRIM + -- Extend our environment with above ; gbl_env <- tcExtendGlobalValEnv [ghc_prim_module_id] getGblEnv ; let gbl_env' = gbl_env `addTypecheckedBinds` [unitBag ghc_prim_module_bind] - ; todo <- todoForTyCons gHC_PRIM ghc_prim_module_id - ghcPrimTypeableTyCons - ; return (gbl_env', [todo]) + + -- Build TypeRepTodos for built-in KindReps + ; todo1 <- todoForExportedKindReps builtInKindReps + -- Build TypeRepTodos for types in GHC.Prim + ; todo2 <- todoForTyCons gHC_PRIM ghc_prim_module_id + ghcPrimTypeableTyCons + ; return ( gbl_env' , [todo1, todo2]) } else do gbl_env <- getGblEnv return (gbl_env, []) } - where -- | This is the list of primitive 'TyCon's for which we must generate bindings -- in "GHC.Types". This should include all types defined in "GHC.Prim". @@ -417,9 +442,11 @@ typeIsTypeable (LitTy _) = True typeIsTypeable (CastTy{}) = False typeIsTypeable (CoercionTy{}) = panic "typeIsTypeable(Coercion)" --- | Maps kinds to 'KindRep' bindings (or rather, a pair of the bound identifier --- and its RHS). -type KindRepEnv = TypeMap (Id, LHsExpr Id) +-- | Maps kinds to 'KindRep' bindings. This binding may either be defined in +-- some other module (in which case the @Maybe (LHsExpr Id@ will be 'Nothing') +-- or a binding which we generated in the current module (in which case it will +-- be 'Just' the RHS of the binding). +type KindRepEnv = TypeMap (Id, Maybe (LHsExpr Id)) -- | A monad within which we will generate 'KindRep's. Here we keep an -- environments containing 'KindRep's which we've already generated so we can @@ -430,23 +457,64 @@ newtype KindRepM a = KindRepM { unKindRepM :: StateT KindRepEnv TcRn a } liftTc :: TcRn a -> KindRepM a liftTc = KindRepM . lift +-- | We generate @KindRep@s for a few common kinds in @GHC.Types@ so that they +-- can be reused across modules. +builtInKindReps :: [(Kind, Name)] +builtInKindReps = + [ (star, starKindRepName) + , (mkFunTy star star, starArrStarKindRepName) + , (mkFunTys [star, star] star, starArrStarArrStarKindRepName) + ] + where + star = liftedTypeKind + +initialKindRepEnv :: TcRn KindRepEnv +initialKindRepEnv = foldlM add_kind_rep emptyTypeMap builtInKindReps + where + add_kind_rep acc (k,n) = do + id <- tcLookupId n + return $! extendTypeMap acc k (id, Nothing) + +-- | Performed while compiling "GHC.Types" to generate the built-in 'KindRep's. +mkExportedKindReps :: TypeableStuff + -> [(Kind, Id)] -- ^ the kinds to generate bindings for + -> KindRepM () +mkExportedKindReps stuff@(Stuff {..}) = mapM_ kindrep_binding + where + empty_scope = mkDeBruijnContext [] + + kindrep_binding :: (Kind, Id) -> KindRepM () + kindrep_binding (kind, rep_bndr) = do + -- We build the binding manually here instead of using mkKindRepRhs + -- since the latter would find the built-in 'KindRep's in the + -- 'KindRepEnv' (by virtue of being in 'initialKindRepEnv'). + rhs <- mkKindRepRhs stuff empty_scope kind + addKindRepBind empty_scope kind rep_bndr rhs + +addKindRepBind :: CmEnv -> Kind -> Id -> LHsExpr Id -> KindRepM () +addKindRepBind in_scope k bndr rhs = + KindRepM $ modify' $ + \env -> extendTypeMapWithScope env in_scope k (bndr, Just rhs) + -- | Run a 'KindRepM' and add the produced 'KindRep's to the typechecking -- environment. runKindRepM :: KindRepM a -> TcRn (TcGblEnv, a) runKindRepM (KindRepM action) = do - (res, reps_env) <- runStateT action emptyTypeMap - let reps = foldTypeMap (:) [] reps_env - tcg_env <- tcExtendGlobalValEnv (map fst reps) getGblEnv - let to_bind :: (Id, LHsExpr Id) -> LHsBind Id - to_bind = uncurry mkVarBind - tcg_env' = tcg_env `addTypecheckedBinds` map (unitBag . to_bind) reps + kindRepEnv <- initialKindRepEnv + (res, reps_env) <- runStateT action kindRepEnv + let rep_binds = foldTypeMap to_bind_pair [] reps_env + to_bind_pair (bndr, Just rhs) rest = (bndr, rhs) : rest + to_bind_pair (_, Nothing) rest = rest + tcg_env <- tcExtendGlobalValEnv (map fst rep_binds) getGblEnv + let binds = map (uncurry mkVarBind) rep_binds + tcg_env' = tcg_env `addTypecheckedBinds` [listToBag binds] return (tcg_env', res) -- | Produce or find a 'KindRep' for the given kind. getKindRep :: TypeableStuff -> CmEnv -- ^ in-scope kind variables -> Kind -- ^ the kind we want a 'KindRep' for -> KindRepM (LHsExpr Id) -getKindRep (Stuff {..}) in_scope = go +getKindRep stuff@(Stuff {..}) in_scope = go where go :: Kind -> KindRepM (LHsExpr Id) go = KindRepM . StateT . go' @@ -468,13 +536,19 @@ getKindRep (Stuff {..}) in_scope = go <$> newSysLocalId (fsLit "krep") (mkTyConTy kindRepTyCon) -- do we need to tie a knot here? - (rhs, env') <- runStateT (unKindRepM $ new_kind_rep k) env - let env'' = extendTypeMapWithScope env' in_scope k (rep_bndr, rhs) - return (nlHsVar rep_bndr, env'') - - - new_kind_rep :: Kind -- ^ the kind we want a 'KindRep' for - -> KindRepM (LHsExpr Id) + flip runStateT env $ unKindRepM $ do + rhs <- mkKindRepRhs stuff in_scope k + addKindRepBind in_scope k rep_bndr rhs + return $ nlHsVar rep_bndr + +-- | Construct the right-hand-side of the 'KindRep' for the given 'Kind' and +-- in-scope kind variable set. +mkKindRepRhs :: TypeableStuff + -> CmEnv -- ^ in-scope kind variables + -> Kind -- ^ the kind we want a 'KindRep' for + -> KindRepM (LHsExpr Id) -- ^ RHS expression +mkKindRepRhs stuff@(Stuff {..}) in_scope = new_kind_rep + where new_kind_rep k -- We handle TYPE separately to make it clear to consumers -- (e.g. serializers) that there is a loop here (as @@ -490,15 +564,15 @@ getKindRep (Stuff {..}) in_scope = go = pprPanic "mkTyConKindRepBinds.go(tyvar)" (ppr v) new_kind_rep (AppTy t1 t2) - = do rep1 <- go t1 - rep2 <- go t2 + = do rep1 <- getKindRep stuff in_scope t1 + rep2 <- getKindRep stuff in_scope t2 return $ nlHsDataCon kindRepAppDataCon `nlHsApp` rep1 `nlHsApp` rep2 new_kind_rep k@(TyConApp tc tys) | Just rep_name <- tyConRepName_maybe tc = do rep_id <- liftTc $ lookupId rep_name - tys' <- mapM go tys + tys' <- mapM (getKindRep stuff in_scope) tys return $ nlHsDataCon kindRepTyConAppDataCon `nlHsApp` nlHsVar rep_id `nlHsApp` mkList (mkTyConTy kindRepTyCon) tys' @@ -509,8 +583,8 @@ getKindRep (Stuff {..}) in_scope = go = pprPanic "mkTyConKindRepBinds(ForAllTy)" (ppr var $$ ppr ty) new_kind_rep (FunTy t1 t2) - = do rep1 <- go t1 - rep2 <- go t2 + = do rep1 <- getKindRep stuff in_scope t1 + rep2 <- getKindRep stuff in_scope t2 return $ nlHsDataCon kindRepFunDataCon `nlHsApp` rep1 `nlHsApp` rep2 diff --git a/testsuite/tests/deSugar/should_compile/T2431.stderr b/testsuite/tests/deSugar/should_compile/T2431.stderr index 16bda5890f..c1625cc8bb 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: 74, types: 46, coercions: 1, joins: 0/0} + = {terms: 63, types: 43, coercions: 1, joins: 0/0} -- RHS size: {terms: 2, types: 4, coercions: 1, joins: 0/0} T2431.$WRefl [InlPrag=INLINE] :: forall a. a :~: a @@ -50,22 +50,7 @@ T2431.$trModule = GHC.Types.Module $trModule2 $trModule4 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} krep :: GHC.Types.KindRep [GblId, Caf=NoCafRefs] -krep = GHC.Types.KindRepTYPE GHC.Types.LiftedRep - --- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -krep1 :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs] -krep1 = GHC.Types.KindRepFun krep krep - --- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -krep2 :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs] -krep2 = GHC.Types.KindRepFun krep krep1 - --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -krep3 :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs] -krep3 = GHC.Types.KindRepVar 0# +krep = GHC.Types.KindRepVar 0# -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} $tc:~:1 :: GHC.Prim.Addr# @@ -79,7 +64,7 @@ $tc:~:2 = GHC.Types.TrNameS $tc:~:1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T2431.$tc:~: :: GHC.Types.TyCon -[GblId, Caf=NoCafRefs] +[GblId] T2431.$tc:~: = GHC.Types.TyCon 4608886815921030019## @@ -87,24 +72,24 @@ T2431.$tc:~: T2431.$trModule $tc:~:2 0# - krep2 + GHC.Types.krep$*->*->* -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -krep4 :: [GHC.Types.KindRep] +krep1 :: [GHC.Types.KindRep] [GblId, Caf=NoCafRefs] -krep4 +krep1 = GHC.Types.: - @ GHC.Types.KindRep krep3 (GHC.Types.[] @ GHC.Types.KindRep) + @ GHC.Types.KindRep krep (GHC.Types.[] @ GHC.Types.KindRep) -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} -krep5 :: [GHC.Types.KindRep] +krep2 :: [GHC.Types.KindRep] [GblId, Caf=NoCafRefs] -krep5 = GHC.Types.: @ GHC.Types.KindRep krep3 krep4 +krep2 = GHC.Types.: @ GHC.Types.KindRep krep krep1 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -krep6 :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs] -krep6 = GHC.Types.KindRepTyConApp T2431.$tc:~: krep5 +krep3 :: GHC.Types.KindRep +[GblId] +krep3 = GHC.Types.KindRepTyConApp T2431.$tc:~: krep2 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} $tc'Refl1 :: GHC.Prim.Addr# @@ -118,7 +103,7 @@ $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] +[GblId] T2431.$tc'Refl = GHC.Types.TyCon 2478588351447975921## @@ -126,7 +111,7 @@ T2431.$tc'Refl T2431.$trModule $tc'Refl2 1# - krep6 + krep3 diff --git a/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr b/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr index bb98450397..74d2595abd 100644 --- a/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr +++ b/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr @@ -50,7 +50,7 @@ (0)))))) ({ <no location info> } (HsVar - ({ <no location info> }{Var: (krep{v} [lid] :: ghc-prim:GHC.Types.KindRep{tc})}))))) + ({ <no location info> }{Var: (ghc-prim:GHC.Types.krep$*{v} [gid] :: ghc-prim:GHC.Types.KindRep{tc})}))))) (False))), ({ <no location info> } (VarBind {Var: (main:DumpTypecheckedAst.$tc'Zero{v} [lidx] :: ghc-prim:GHC.Types.TyCon{tc})} @@ -173,17 +173,6 @@ ({ <no location info> } (HsApp ({ <no location info> } - (HsConLikeOut - ({abstract:ConLike}))) - ({ <no location info> } - (HsConLikeOut - ({abstract:ConLike}))))) - (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 diff --git a/testsuite/tests/roles/should_compile/Roles1.stderr b/testsuite/tests/roles/should_compile/Roles1.stderr index c9be2ea3cd..b43a008691 100644 --- a/testsuite/tests/roles/should_compile/Roles1.stderr +++ b/testsuite/tests/roles/should_compile/Roles1.stderr @@ -64,7 +64,7 @@ Roles1.$tcT5 Roles1.$trModule (GHC.Types.TrNameS "T5"#) 0 - krep + GHC.Types.krep$*Arr* Roles1.$tc'K5 = GHC.Types.TyCon 5548842497263642061## @@ -112,7 +112,7 @@ Roles1.$tcT2 Roles1.$trModule (GHC.Types.TrNameS "T2"#) 0 - krep + GHC.Types.krep$*Arr* Roles1.$tc'K2 = GHC.Types.TyCon 11054915488163123841## @@ -128,7 +128,7 @@ Roles1.$tcT1 Roles1.$trModule (GHC.Types.TrNameS "T1"#) 0 - krep + GHC.Types.krep$*Arr* Roles1.$tc'K1 = GHC.Types.TyCon 1265606750138351672## @@ -143,15 +143,15 @@ krep [InlPrag=[~]] = GHC.Types.KindRepVar 0 krep [InlPrag=[~]] = GHC.Types.KindRepVar 1 krep [InlPrag=[~]] = GHC.Types.KindRepVar 2 krep [InlPrag=[~]] = GHC.Types.KindRepApp krep krep +krep [InlPrag=[~]] = GHC.Types.KindRepFun krep GHC.Types.krep$*Arr* +krep [InlPrag=[~]] = GHC.Types.KindRepFun krep GHC.Types.krep$* krep [InlPrag=[~]] = GHC.Types.KindRepFun krep krep krep [InlPrag=[~]] = GHC.Types.KindRepFun krep krep krep [InlPrag=[~]] = GHC.Types.KindRepFun krep krep krep [InlPrag=[~]] = GHC.Types.KindRepFun krep krep krep [InlPrag=[~]] = GHC.Types.KindRepFun krep krep -krep [InlPrag=[~]] = GHC.Types.KindRepFun krep krep -krep [InlPrag=[~]] = GHC.Types.KindRepFun krep krep -krep [InlPrag=[~]] = GHC.Types.KindRepFun krep krep -krep [InlPrag=[~]] = GHC.Types.KindRepFun krep krep +krep [InlPrag=[~]] + = GHC.Types.KindRepFun GHC.Types.krep$*Arr* GHC.Types.krep$*Arr* krep [InlPrag=[~]] = GHC.Types.KindRepTyConApp Roles1.$tcT7 ((:) krep ((:) krep ((:) krep []))) @@ -161,7 +161,6 @@ krep [InlPrag=[~]] = GHC.Types.KindRepTyConApp Roles1.$tcT4 ((:) krep ((:) krep [])) krep [InlPrag=[~]] = GHC.Types.KindRepTyConApp Roles1.$tcT3 ((:) krep ((:) krep [])) -krep [InlPrag=[~]] = GHC.Types.KindRepTYPE GHC.Types.LiftedRep krep [InlPrag=[~]] = GHC.Types.KindRepTyConApp Roles1.$tcT5 ((:) krep []) krep [InlPrag=[~]] diff --git a/testsuite/tests/roles/should_compile/Roles13.stderr b/testsuite/tests/roles/should_compile/Roles13.stderr index cc8dfdfc29..c105a0f7b6 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: 105, types: 40, coercions: 5, joins: 0/0} + = {terms: 98, types: 38, coercions: 5, joins: 0/0} -- RHS size: {terms: 2, types: 2, coercions: 0, joins: 0/0} convert1 :: Wrap Age -> Wrap Age @@ -51,17 +51,7 @@ krep -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} krep1 :: GHC.Types.KindRep [GblId, Caf=NoCafRefs] -krep1 = GHC.Types.KindRepTYPE GHC.Types.LiftedRep - --- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -krep2 :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs] -krep2 = GHC.Types.KindRepFun krep1 krep1 - --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -krep3 :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs] -krep3 = GHC.Types.KindRepVar 0# +krep1 = GHC.Types.KindRepVar 0# -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} $tcAge1 :: GHC.Prim.Addr# @@ -75,7 +65,7 @@ $tcAge2 = GHC.Types.TrNameS $tcAge1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Roles13.$tcAge :: GHC.Types.TyCon -[GblId, Caf=NoCafRefs] +[GblId] Roles13.$tcAge = GHC.Types.TyCon 3456257068627873222## @@ -83,19 +73,19 @@ Roles13.$tcAge Roles13.$trModule $tcAge2 0# - krep1 + GHC.Types.krep$* -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} -krep4 :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs] -krep4 +krep2 :: GHC.Types.KindRep +[GblId] +krep2 = GHC.Types.KindRepTyConApp Roles13.$tcAge (GHC.Types.[] @ GHC.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -krep5 :: GHC.Types.KindRep +krep3 :: GHC.Types.KindRep [GblId] -krep5 = GHC.Types.KindRepFun krep krep4 +krep3 = GHC.Types.KindRepFun krep krep2 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} $tc'MkAge1 :: GHC.Prim.Addr# @@ -117,7 +107,7 @@ Roles13.$tc'MkAge Roles13.$trModule $tc'MkAge2 0# - krep5 + krep3 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} $tcWrap1 :: GHC.Prim.Addr# @@ -131,7 +121,7 @@ $tcWrap2 = GHC.Types.TrNameS $tcWrap1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Roles13.$tcWrap :: GHC.Types.TyCon -[GblId, Caf=NoCafRefs] +[GblId] Roles13.$tcWrap = GHC.Types.TyCon 13773534096961634492## @@ -139,24 +129,24 @@ Roles13.$tcWrap Roles13.$trModule $tcWrap2 0# - krep2 + GHC.Types.krep$*Arr* -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -krep6 :: [GHC.Types.KindRep] +krep4 :: [GHC.Types.KindRep] [GblId, Caf=NoCafRefs] -krep6 +krep4 = GHC.Types.: - @ GHC.Types.KindRep krep3 (GHC.Types.[] @ GHC.Types.KindRep) + @ GHC.Types.KindRep krep1 (GHC.Types.[] @ GHC.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -krep7 :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs] -krep7 = GHC.Types.KindRepTyConApp Roles13.$tcWrap krep6 +krep5 :: GHC.Types.KindRep +[GblId] +krep5 = GHC.Types.KindRepTyConApp Roles13.$tcWrap krep4 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -krep8 :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs] -krep8 = GHC.Types.KindRepFun krep3 krep7 +krep6 :: GHC.Types.KindRep +[GblId] +krep6 = GHC.Types.KindRepFun krep1 krep5 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} $tc'MkWrap1 :: GHC.Prim.Addr# @@ -170,7 +160,7 @@ $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] +[GblId] Roles13.$tc'MkWrap = GHC.Types.TyCon 15580677875333883466## @@ -178,7 +168,7 @@ Roles13.$tc'MkWrap Roles13.$trModule $tc'MkWrap2 1# - krep8 + krep6 diff --git a/testsuite/tests/roles/should_compile/Roles14.stderr b/testsuite/tests/roles/should_compile/Roles14.stderr index 44e0ecb28e..9db7ae53db 100644 --- a/testsuite/tests/roles/should_compile/Roles14.stderr +++ b/testsuite/tests/roles/should_compile/Roles14.stderr @@ -19,7 +19,7 @@ Roles12.$tcC2 Roles12.$trModule (GHC.Types.TrNameS "C2"#) 0 - krep + GHC.Types.krep$*Arr* Roles12.$tc'C:C2 = GHC.Types.TyCon 7087988437584478859## @@ -31,8 +31,6 @@ Roles12.$tc'C:C2 krep [InlPrag=[~]] = GHC.Types.KindRepVar 0 krep [InlPrag=[~]] = GHC.Types.KindRepFun krep krep krep [InlPrag=[~]] = GHC.Types.KindRepFun krep krep -krep [InlPrag=[~]] = GHC.Types.KindRepFun krep krep -krep [InlPrag=[~]] = GHC.Types.KindRepTYPE GHC.Types.LiftedRep krep [InlPrag=[~]] = GHC.Types.KindRepTyConApp Roles12.$tcC2 ((:) krep []) Roles12.$trModule diff --git a/testsuite/tests/roles/should_compile/Roles2.stderr b/testsuite/tests/roles/should_compile/Roles2.stderr index 737d215195..a206db699b 100644 --- a/testsuite/tests/roles/should_compile/Roles2.stderr +++ b/testsuite/tests/roles/should_compile/Roles2.stderr @@ -18,7 +18,7 @@ Roles2.$tcT2 Roles2.$trModule (GHC.Types.TrNameS "T2"#) 0 - krep + GHC.Types.krep$*Arr* Roles2.$tc'K2 = GHC.Types.TyCon 17395957229042313563## @@ -34,7 +34,7 @@ Roles2.$tcT1 Roles2.$trModule (GHC.Types.TrNameS "T1"#) 0 - krep + GHC.Types.krep$*Arr* Roles2.$tc'K1 = GHC.Types.TyCon 16530009231990968394## @@ -46,8 +46,6 @@ Roles2.$tc'K1 krep [InlPrag=[~]] = GHC.Types.KindRepVar 0 krep [InlPrag=[~]] = GHC.Types.KindRepFun krep krep krep [InlPrag=[~]] = GHC.Types.KindRepFun krep krep -krep [InlPrag=[~]] = GHC.Types.KindRepFun krep krep -krep [InlPrag=[~]] = GHC.Types.KindRepTYPE GHC.Types.LiftedRep krep [InlPrag=[~]] = GHC.Types.KindRepTyConApp GHC.Ptr.$tcFunPtr ((:) krep []) krep [InlPrag=[~]] diff --git a/testsuite/tests/roles/should_compile/Roles3.stderr b/testsuite/tests/roles/should_compile/Roles3.stderr index e4ec97ab4d..bec3c06ae0 100644 --- a/testsuite/tests/roles/should_compile/Roles3.stderr +++ b/testsuite/tests/roles/should_compile/Roles3.stderr @@ -40,7 +40,7 @@ Roles3.$tcC4 Roles3.$trModule (GHC.Types.TrNameS "C4"#) 0 - krep + GHC.Types.krep$*->*->* Roles3.$tcC3 = GHC.Types.TyCon 5076086601454991970## @@ -48,7 +48,7 @@ Roles3.$tcC3 Roles3.$trModule (GHC.Types.TrNameS "C3"#) 0 - krep + GHC.Types.krep$*->*->* Roles3.$tcC2 = GHC.Types.TyCon 7902873224172523979## @@ -56,7 +56,7 @@ Roles3.$tcC2 Roles3.$trModule (GHC.Types.TrNameS "C2"#) 0 - krep + GHC.Types.krep$*->*->* Roles3.$tc'C:C2 = GHC.Types.TyCon 11218882737915989529## @@ -72,7 +72,7 @@ Roles3.$tcC1 Roles3.$trModule (GHC.Types.TrNameS "C1"#) 0 - krep + GHC.Types.krep$*Arr* Roles3.$tc'C:C1 = GHC.Types.TyCon 4508088879886988796## @@ -88,14 +88,12 @@ krep [InlPrag=[~]] = GHC.Types.KindRepFun krep krep krep [InlPrag=[~]] = GHC.Types.KindRepFun krep krep krep [InlPrag=[~]] = GHC.Types.KindRepFun krep krep krep [InlPrag=[~]] = GHC.Types.KindRepFun krep krep -krep [InlPrag=[~]] = GHC.Types.KindRepFun krep krep -krep [InlPrag=[~]] = GHC.Types.KindRepFun krep krep krep [InlPrag=[~]] = GHC.Types.KindRepTyConApp - Data.Type.Equality.$tc~ ((:) krep ((:) krep ((:) krep []))) + Data.Type.Equality.$tc~ + ((:) GHC.Types.krep$* ((:) krep ((:) krep []))) krep [InlPrag=[~]] = GHC.Types.KindRepTyConApp Roles3.$tcC2 ((:) krep ((:) krep [])) -krep [InlPrag=[~]] = GHC.Types.KindRepTYPE GHC.Types.LiftedRep krep [InlPrag=[~]] = GHC.Types.KindRepTyConApp Roles3.$tcC1 ((:) krep []) Roles3.$trModule diff --git a/testsuite/tests/roles/should_compile/Roles4.stderr b/testsuite/tests/roles/should_compile/Roles4.stderr index de95825009..daf1442ef8 100644 --- a/testsuite/tests/roles/should_compile/Roles4.stderr +++ b/testsuite/tests/roles/should_compile/Roles4.stderr @@ -25,7 +25,7 @@ Roles4.$tcC3 Roles4.$trModule (GHC.Types.TrNameS "C3"#) 0 - krep + GHC.Types.krep$*Arr* Roles4.$tc'C:C3 = GHC.Types.TyCon 3133378316178104365## @@ -41,7 +41,7 @@ Roles4.$tcC1 Roles4.$trModule (GHC.Types.TrNameS "C1"#) 0 - krep + GHC.Types.krep$*Arr* Roles4.$tc'C:C1 = GHC.Types.TyCon 3870707671502302648## @@ -55,8 +55,6 @@ krep [InlPrag=[~]] = GHC.Types.KindRepFun krep krep krep [InlPrag=[~]] = GHC.Types.KindRepFun krep krep krep [InlPrag=[~]] = GHC.Types.KindRepFun krep krep krep [InlPrag=[~]] = GHC.Types.KindRepFun krep krep -krep [InlPrag=[~]] = GHC.Types.KindRepFun krep krep -krep [InlPrag=[~]] = GHC.Types.KindRepTYPE GHC.Types.LiftedRep krep [InlPrag=[~]] = GHC.Types.KindRepTyConApp GHC.Types.$tc[] ((:) krep []) krep [InlPrag=[~]] diff --git a/testsuite/tests/roles/should_compile/T8958.stderr b/testsuite/tests/roles/should_compile/T8958.stderr index a259f7067a..84b62bf074 100644 --- a/testsuite/tests/roles/should_compile/T8958.stderr +++ b/testsuite/tests/roles/should_compile/T8958.stderr @@ -27,7 +27,7 @@ T8958.$tcMap T8958.$trModule (GHC.Types.TrNameS "Map"#) 0 - krep + GHC.Types.krep$*->*->* T8958.$tc'MkMap = GHC.Types.TyCon 2942839876828444488## @@ -43,7 +43,7 @@ T8958.$tcRepresentational T8958.$trModule (GHC.Types.TrNameS "Representational"#) 0 - krep + GHC.Types.krep$*Arr* T8958.$tc'C:Representational = GHC.Types.TyCon 2358772282532242424## @@ -59,7 +59,7 @@ T8958.$tcNominal T8958.$trModule (GHC.Types.TrNameS "Nominal"#) 0 - krep + GHC.Types.krep$*Arr* T8958.$tc'C:Nominal = GHC.Types.TyCon 10562260635335201742## @@ -71,8 +71,6 @@ T8958.$tc'C:Nominal krep [InlPrag=[~]] = GHC.Types.KindRepVar 0 krep [InlPrag=[~]] = GHC.Types.KindRepVar 1 krep [InlPrag=[~]] = GHC.Types.KindRepFun krep krep -krep [InlPrag=[~]] = GHC.Types.KindRepFun krep krep -krep [InlPrag=[~]] = GHC.Types.KindRepFun krep krep krep [InlPrag=[~]] = GHC.Types.KindRepTyConApp GHC.Tuple.$tc(,) @@ -83,7 +81,6 @@ krep [InlPrag=[~]] T8958.$tcMap ((:) @ GHC.Types.KindRep krep ((:) @ GHC.Types.KindRep krep [] @ GHC.Types.KindRep)) -krep [InlPrag=[~]] = GHC.Types.KindRepTYPE GHC.Types.LiftedRep krep [InlPrag=[~]] = GHC.Types.KindRepTyConApp GHC.Types.$tc[] diff --git a/testsuite/tests/simplCore/should_compile/T7360.stderr b/testsuite/tests/simplCore/should_compile/T7360.stderr index 862cf34fa7..acb3a3de75 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: 117, types: 54, coercions: 0, joins: 0/0} + = {terms: 114, types: 53, coercions: 0, joins: 0/0} -- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} T7360.$WFoo3 [InlPrag=INLINE] :: Int -> Foo @@ -126,27 +126,22 @@ krep = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @ GHC.Types.KindRep) --- 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.$tcFoo3 :: GHC.Prim.Addr# +T7360.$tcFoo2 :: 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.$tcFoo3 = "Foo"# +T7360.$tcFoo2 = "Foo"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T7360.$tcFoo2 :: GHC.Types.TrName +T7360.$tcFoo1 :: 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.$tcFoo2 = GHC.Types.TrNameS T7360.$tcFoo3 +T7360.$tcFoo1 = GHC.Types.TrNameS T7360.$tcFoo2 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T7360.$tcFoo :: GHC.Types.TyCon @@ -160,9 +155,9 @@ T7360.$tcFoo 1581370841583180512## 13291578023368289311## T7360.$trModule - T7360.$tcFoo2 - 0# T7360.$tcFoo1 + 0# + GHC.Types.krep$* -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} T7360.$tc'Foo4 [InlPrag=[~]] :: GHC.Types.KindRep diff --git a/testsuite/tests/simplCore/should_compile/T8274.stdout b/testsuite/tests/simplCore/should_compile/T8274.stdout index 7773b13515..0b12ddf5a5 100644 --- a/testsuite/tests/simplCore/should_compile/T8274.stdout +++ b/testsuite/tests/simplCore/should_compile/T8274.stdout @@ -11,13 +11,13 @@ krep3 = GHC.Types.KindRepTyConApp GHC.Types.$tcFloat# (GHC.Types.[] @ GHC.Types. krep4 = GHC.Types.KindRepTyConApp GHC.Types.$tcInt# (GHC.Types.[] @ GHC.Types.KindRep) T8274.$tcP2 :: Addr# T8274.$tcP2 = "P"# -T8274.$tcP = GHC.Types.TyCon 7483823267324216774## 12197132127820124256## T8274.$trModule T8274.$tcP1 0# T8274.$tcN1 +T8274.$tcP = GHC.Types.TyCon 7483823267324216774## 12197132127820124256## T8274.$trModule T8274.$tcP1 0# GHC.Types.krep$* 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.$tcN2 :: Addr# +T8274.$tcN2 = "N"# +T8274.$tcN = GHC.Types.TyCon 17387464673997143412## 16681536026493340311## T8274.$trModule T8274.$tcN1 0# GHC.Types.krep$* 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 b041046cb9..6b88b58a88 100644 --- a/testsuite/tests/th/TH_Roles2.stderr +++ b/testsuite/tests/th/TH_Roles2.stderr @@ -16,10 +16,10 @@ TH_Roles2.$tcT TH_Roles2.$trModule (GHC.Types.TrNameS "T"#) 1 - krep_a4bG -krep_a4bH [InlPrag=[~]] = GHC.Types.KindRepVar 0 -krep_a4bG [InlPrag=[~]] = GHC.Types.KindRepFun krep_a4bH krep_a4bI -krep_a4bI [InlPrag=[~]] = GHC.Types.KindRepTYPE GHC.Types.LiftedRep + krep_a4bp +krep_a4bq [InlPrag=[~]] = GHC.Types.KindRepVar 0 +krep_a4bp [InlPrag=[~]] + = GHC.Types.KindRepFun krep_a4bq GHC.Types.krep$* TH_Roles2.$trModule = GHC.Types.Module (GHC.Types.TrNameS "main"#) (GHC.Types.TrNameS "TH_Roles2"#) |