Produce KindReps for common kinds in GHC.Types
authorBen Gamari <bgamari.foss@gmail.com>
Fri, 3 Mar 2017 20:47:47 +0000 (15:47 -0500)
committerBen Gamari <ben@smart-cactus.org>
Fri, 3 Mar 2017 20:47:48 +0000 (15:47 -0500)
Unfortunately this comes with a fair bit of implementation cost. Perhaps
some refactoring would help, but in the interest of getting 8.2 out the
door I'm pushing as-is.

While this doesn't have nearly the effect on compiler allocations
that D3166 has, it's still nothing to sneeze at. nofib shows,
```
------------------------------------------------------------------------
        Program               master           D3166            D3219
------------------------------------------------------------------------
        -1 s.d.                -----          -3.555%          -4.081%
        +1 s.d.                -----          +1.937%          +1.593%
        Average                -----          -0.847%          -1.285%
```

Test Plan: Validate

Reviewers: austin

Subscribers: thomie, simonmar

Differential Revision: https://phabricator.haskell.org/D3219

14 files changed:
compiler/prelude/PrelNames.hs
compiler/typecheck/TcTypeable.hs
testsuite/tests/deSugar/should_compile/T2431.stderr
testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr
testsuite/tests/roles/should_compile/Roles1.stderr
testsuite/tests/roles/should_compile/Roles13.stderr
testsuite/tests/roles/should_compile/Roles14.stderr
testsuite/tests/roles/should_compile/Roles2.stderr
testsuite/tests/roles/should_compile/Roles3.stderr
testsuite/tests/roles/should_compile/Roles4.stderr
testsuite/tests/roles/should_compile/T8958.stderr
testsuite/tests/simplCore/should_compile/T7360.stderr
testsuite/tests/simplCore/should_compile/T8274.stdout
testsuite/tests/th/TH_Roles2.stderr

index 0ae3867..e3ebd6a 100644 (file)
@@ -244,6 +244,11 @@ basicKnownKeyNames
         typeSymbolTypeRepName, typeNatTypeRepName,
         trGhcPrimModuleName,
 
+        -- KindReps for common cases
+        starKindRepName,
+        starArrStarKindRepName,
+        starArrStarArrStarKindRepName,
+
         -- Dynamic
         toDynName,
 
@@ -1268,6 +1273,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
@@ -2326,6 +2337,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
@@ -2350,14 +2367,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
 
 {-
 ************************************************************************
index 875296e..b67ae54 100644 (file)
@@ -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,25 +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 }
@@ -291,7 +310,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)
@@ -299,18 +319,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".
@@ -419,9 +443,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
@@ -432,23 +458,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'
@@ -470,13 +537,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
@@ -492,15 +565,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'
@@ -511,8 +584,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
 
index 1fd5b44..aaa1696 100644 (file)
@@ -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[2]] :: 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
 
 
 
index fe79f2b..3725b6f 100644 (file)
@@ -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})} 
    ({ <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 
index ae4570a..e9f7823 100644 (file)
@@ -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,16 @@ $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 +162,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=[~]]
index 6a5e31d..6b7bb55 100644 (file)
@@ -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
 
 
 
index 08ca28f..ce4ddd3 100644 (file)
@@ -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
index b96d173..23d253e 100644 (file)
@@ -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=[~]]
index 7f9f1a3..cc9ce91 100644 (file)
@@ -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
index 205a4d5..ac9d08b 100644 (file)
@@ -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=[~]]
index 22cc6ca..bb20002 100644 (file)
@@ -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[]
index 22a7a64..118ebbe 100644 (file)
@@ -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[2]] :: 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
index a8e7954..12ab243 100644 (file)
@@ -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
index 37dcbaa..65b8c1d 100644 (file)
@@ -16,12 +16,10 @@ TH_Roles2.$tcT
       TH_Roles2.$trModule
       (GHC.Types.TrNameS "T"#)
       1
-      $krep_a3U5
-$krep_a3U6 [InlPrag=[~]] = GHC.Types.KindRepVar 0
-$krep_a3U5 [InlPrag=[~]]
-  = GHC.Types.KindRepFun $krep_a3U6 $krep_a3U7
-$krep_a3U7 [InlPrag=[~]]
-  = GHC.Types.KindRepTYPE GHC.Types.LiftedRep
+      $krep_a3TO
+$krep_a3TP [InlPrag=[~]] = GHC.Types.KindRepVar 0
+$krep_a3TO [InlPrag=[~]]
+  = GHC.Types.KindRepFun $krep_a3TP GHC.Types.krep$*
 TH_Roles2.$trModule
   = GHC.Types.Module
       (GHC.Types.TrNameS "main"#) (GHC.Types.TrNameS "TH_Roles2"#)