Commit 6013321d authored by Ben Gamari's avatar Ben Gamari Committed by Ben Gamari

Unwire Typeable representation types

In order to make this work I needed to shuffle around typechecking a bit
such that `TyCon` and friends are available during compilation of
GHC.Types.  I also did a bit of refactoring of `TcTypeable`.

Test Plan: Validate

Reviewers: simonpj, austin

Subscribers: simonpj, thomie

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

GHC Trac Issues: #11120

(cherry picked from commit 206a8bf4)
parent d6ea90a2
......@@ -205,6 +205,11 @@ basicKnownKeyNames
ioTyConName, ioDataConName,
runMainIOName,
-- Type representation types
trModuleTyConName, trModuleDataConName,
trNameTyConName, trNameSDataConName, trNameDDataConName,
trTyConTyConName, trTyConDataConName,
-- Typeable
typeableClassName,
typeRepTyConName,
......@@ -1130,6 +1135,23 @@ rationalToDoubleName = varQual gHC_FLOAT (fsLit "rationalToDouble") rationalToDo
ixClassName :: Name
ixClassName = clsQual gHC_ARR (fsLit "Ix") ixClassKey
-- Typeable representation types
trModuleTyConName
, trModuleDataConName
, trNameTyConName
, trNameSDataConName
, trNameDDataConName
, trTyConTyConName
, trTyConDataConName
:: Name
trModuleTyConName = tcQual gHC_TYPES (fsLit "Module") trModuleTyConKey
trModuleDataConName = dcQual gHC_TYPES (fsLit "Module") trModuleDataConKey
trNameTyConName = tcQual gHC_TYPES (fsLit "TrName") trNameTyConKey
trNameSDataConName = dcQual gHC_TYPES (fsLit "TrNameS") trNameSDataConKey
trNameDDataConName = dcQual gHC_TYPES (fsLit "TrNameD") trNameDDataConKey
trTyConTyConName = tcQual gHC_TYPES (fsLit "TyCon") trTyConTyConKey
trTyConDataConName = dcQual gHC_TYPES (fsLit "TyCon") trTyConDataConKey
-- Class Typeable, and functions for constructing `Typeable` dictionaries
typeableClassName
, typeRepTyConName
......
......@@ -88,11 +88,6 @@ module TysWiredIn (
mkWiredInIdName, -- used in MkId
-- * Type representations
trModuleTyCon, trModuleDataCon,
trNameTyCon, trNameSDataCon, trNameDDataCon,
trTyConTyCon, trTyConDataCon,
-- * Levity
levityTy, levityTyCon, liftedDataCon, unliftedDataCon,
liftedPromDataCon, unliftedPromDataCon,
......@@ -188,9 +183,6 @@ wiredInTyCons = [ unitTyCon -- Not treated like other tuples, because
, liftedTypeKindTyCon
, starKindTyCon
, unicodeStarKindTyCon
, trModuleTyCon
, trTyConTyCon
, trNameTyCon
]
mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
......@@ -615,6 +607,7 @@ unboxedUnitDataCon = tupleDataCon Unboxed 0
********************************************************************* -}
-- See Note [The equality types story] in TysPrim
-- (:~~: :: forall k1 k2 (a :: k1) (b :: k2). a -> b -> Constraint)
heqTyCon, coercibleTyCon :: TyCon
heqClass, coercibleClass :: Class
heqDataCon, coercibleDataCon :: DataCon
......@@ -1063,56 +1056,3 @@ promotedGTDataCon = promoteDataCon gtDataCon
promotedConsDataCon, promotedNilDataCon :: TyCon
promotedConsDataCon = promoteDataCon consDataCon
promotedNilDataCon = promoteDataCon nilDataCon
-- * Type representation types
-- See Note [Grand plan for Typable] in TcTypeable.
trModuleTyConName, trNameTyConName, trTyConTyConName :: Name
trModuleTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Module")
trModuleTyConKey trModuleTyCon
trNameTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "TrName")
trNameTyConKey trNameTyCon
trTyConTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "TyCon")
trTyConTyConKey trTyConTyCon
trModuleDataConName, trTyConDataConName,
trNameSDataConName, trNameDDataConName :: Name
trModuleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "Module")
trModuleDataConKey trModuleDataCon
trTyConDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "TyCon")
trTyConDataConKey trTyConDataCon
trNameSDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "TrNameS")
trNameSDataConKey trNameSDataCon
trNameDDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "TrNameD")
trNameDDataConKey trNameDDataCon
trModuleTyCon :: TyCon
trModuleTyCon = pcNonRecDataTyCon trModuleTyConName Nothing [] [trModuleDataCon]
trModuleDataCon :: DataCon
trModuleDataCon = pcDataCon trModuleDataConName [] [trNameTy, trNameTy] trModuleTyCon
trModuleTy :: Type
trModuleTy = mkTyConTy trModuleTyCon
trNameTyCon :: TyCon
trNameTyCon = pcNonRecDataTyCon trNameTyConName Nothing [] [trNameSDataCon, trNameDDataCon]
trNameSDataCon, trNameDDataCon :: DataCon
trNameSDataCon = pcDataCon trNameSDataConName [] [addrPrimTy] trNameTyCon
trNameDDataCon = pcDataCon trNameDDataConName [] [stringTy] trNameTyCon
trNameTy :: Type
trNameTy = mkTyConTy trNameTyCon
trTyConTyCon :: TyCon
trTyConTyCon = pcNonRecDataTyCon trTyConTyConName Nothing [] [trTyConDataCon]
trTyConDataCon :: DataCon
trTyConDataCon = pcDataCon trTyConDataConName [] [fprint, fprint, trModuleTy, trNameTy] trTyConTyCon
where
-- TODO: This should be for the target, no?
#if WORD_SIZE_IN_BITS < 64
fprint = word64PrimTy
#else
fprint = wordPrimTy
#endif
......@@ -71,7 +71,7 @@ import TcType
import MkIface
import TcSimplify
import TcTyClsDecls
import TcTypeable( mkModIdBindings, mkPrimTypeableBinds )
import TcTypeable ( mkTypeableBinds )
import LoadIface
import TidyPgm ( mkBootModDetailsTc )
import RnNames
......@@ -471,21 +471,19 @@ tcRnSrcDecls :: Bool -- False => no 'module M(..) where' header at all
-- Returns the variables free in the decls
-- Reason: solely to report unused imports and bindings
tcRnSrcDecls explicit_mod_hdr decls
= do { -- Create a binding for $trModule
-- Do this before processing any data type declarations,
-- which need tcg_tr_module to be initialised
; tcg_env <- mkModIdBindings
; tcg_env <- setGblEnv tcg_env mkPrimTypeableBinds
-- Do all the declarations
; ((tcg_env, tcl_env), lie) <- setGblEnv tcg_env $
captureConstraints $
= do { -- Do all the declarations
; ((tcg_env, tcl_env), lie) <- captureConstraints $
do { (tcg_env, tcl_env) <- tc_rn_src_decls decls ;
; tcg_env <- setEnvs (tcg_env, tcl_env) $
checkMain explicit_mod_hdr
; return (tcg_env, tcl_env) }
; setEnvs (tcg_env, tcl_env) $ do {
-- Emit Typeable bindings
; tcg_env <- setGblEnv tcg_env mkTypeableBinds
; setGblEnv tcg_env $ do {
#ifdef GHCI
; finishTH
#endif /* GHCI */
......@@ -544,7 +542,7 @@ tcRnSrcDecls explicit_mod_hdr decls
; setGlobalTypeEnv tcg_env' final_type_env
} }
} } }
tc_rn_src_decls :: [LHsDecl RdrName]
-> TcM (TcGblEnv, TcLclEnv)
......
......@@ -30,7 +30,6 @@ module TcTyDecls(
import TcRnMonad
import TcEnv
import TcTypeable( mkTypeableBinds )
import TcBinds( tcRecSelBinds )
import TyCoRep( Type(..), TyBinder(..), delBinderVar )
import TcType
......@@ -864,10 +863,7 @@ tcAddImplicits tycons
do { traceTc "tcAddImplicits" $ vcat
[ text "tycons" <+> ppr tycons
, text "implicits" <+> ppr implicit_things ]
; gbl_env <- mkTypeableBinds tycons
; gbl_env <- setGblEnv gbl_env $
tcRecSelBinds (mkRecSelBinds tycons)
; return gbl_env }
; tcRecSelBinds (mkRecSelBinds tycons) }
where
implicit_things = concatMap implicitTyConThings tycons
def_meth_ids = mkDefaultMethodIds tycons
......
......@@ -3,9 +3,9 @@
(c) The GRASP/AQUA Project, Glasgow University, 1992-1999
-}
module TcTypeable(
mkTypeableBinds, mkPrimTypeableBinds, mkModIdBindings
) where
{-# LANGUAGE RecordWildCards #-}
module TcTypeable(mkTypeableBinds) where
import TcBinds( addTypecheckedBinds )
......@@ -14,8 +14,6 @@ import TcEnv
import TcRnMonad
import PrelNames
import TysPrim ( primTyCons )
import TysWiredIn ( trModuleTyCon, trModuleDataCon, trTyConTyCon
, trTyConDataCon, trNameSDataCon )
import Id
import Type
import TyCon
......@@ -28,9 +26,10 @@ import DynFlags
import Bag
import Fingerprint(Fingerprint(..), fingerprintString)
import Outputable
import Data.Word( Word64 )
import FastString ( FastString, mkFastString )
import Data.Word( Word64 )
{- Note [Grand plan for Typeable]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The overall plan is this:
......@@ -67,14 +66,16 @@ The overall plan is this:
There are many wrinkles:
* Since we generate $tcT for every data type T, the types TyCon and
Module must be available right from the start; so they are wired in (and
defined in ghc-prim:GHC.Types).
* The timing of when we produce this bindings is rather important: they must be
defined after the rest of the module has been typechecked since we need to be
able to lookup Module and TyCon in the type environment and we may be
currently compiling GHC.Types (where they are defined).
* GHC.Prim doesn't have any associated object code, so we need to put the
representations for types defined in this module elsewhere. We put these
in GHC.Types. TcTypeable.mkPrimTypeableBinds is responsible for injecting
the bindings for the GHC.Prim representions when compiling GHC.Types.
representations for types defined in this module elsewhere. We chose this
place to be GHC.Types. TcTypeable.mkPrimTypeableBinds is responsible for
injecting the bindings for the GHC.Prim representions when compiling
GHC.Types.
* TyCon.tyConRepModOcc is responsible for determining where to find
the representation binding for a given type. This is where we handle
......@@ -86,6 +87,32 @@ There are many wrinkles:
-}
-- | Generate the Typeable bindings for a module. This is the only
-- entry-point of this module and is invoked by the typechecker driver in
-- 'tcRnSrcDecls'.
--
-- See Note [Grand plan for Typeable] in TcTypeable.
mkTypeableBinds :: TcM TcGblEnv
mkTypeableBinds
= do { -- Create a binding for $trModule.
-- Do this before processing any data type declarations,
-- which need tcg_tr_module to be initialised
; tcg_env <- mkModIdBindings
-- Now we can generate the TyCon representations...
-- First we handle the primitive TyCons if we are compiling GHC.Types
; tcg_env <- setGblEnv tcg_env mkPrimTypeableBinds
-- Then we produce bindings for the user-defined types in this module.
; setGblEnv tcg_env $
let tycons = filter needs_typeable_binds (tcg_tcs tcg_env)
in mkTypeableTyConBinds tycons
}
where
needs_typeable_binds tc =
(not (isFamInstTyCon tc) && isAlgTyCon tc)
|| isDataFamilyTyCon tc
|| isClassTyCon tc
{- *********************************************************************
* *
Building top-level binding for $trModule
......@@ -96,20 +123,23 @@ mkModIdBindings :: TcM TcGblEnv
mkModIdBindings
= do { mod <- getModule
; loc <- getSrcSpanM
; mod_nm <- newGlobalBinder mod (mkVarOcc "$trModule") loc
; let mod_id = mkExportedVanillaId mod_nm
(mkTyConApp trModuleTyCon [])
mod_bind = mkVarBind mod_id (mkModIdRHS mod)
; mod_nm <- newGlobalBinder mod (mkVarOcc "$trModule") loc
; trModuleTyCon <- tcLookupTyCon trModuleTyConName
; let mod_id = mkExportedVanillaId mod_nm (mkTyConApp trModuleTyCon [])
; mod_bind <- mkVarBind mod_id <$> mkModIdRHS mod
; tcg_env <- tcExtendGlobalValEnv [mod_id] getGblEnv
; return (tcg_env { tcg_tr_module = Just mod_id }
`addTypecheckedBinds` [unitBag mod_bind]) }
mkModIdRHS :: Module -> LHsExpr Id
mkModIdRHS :: Module -> TcM (LHsExpr Id)
mkModIdRHS mod
= nlHsApps (dataConWrapId trModuleDataCon)
[ trNameLit (unitIdFS (moduleUnitId mod))
, trNameLit (moduleNameFS (moduleName mod)) ]
= do { trModuleDataCon <- tcLookupDataCon trModuleDataConName
; trNameLit <- mkTrNameLit
; return $ nlHsApps (dataConWrapId trModuleDataCon)
[ trNameLit (unitIdFS (moduleUnitId mod))
, trNameLit (moduleNameFS (moduleName mod)) ]
}
{- *********************************************************************
* *
......@@ -117,18 +147,16 @@ mkModIdRHS mod
* *
********************************************************************* -}
mkTypeableBinds :: [TyCon] -> TcM TcGblEnv
mkTypeableBinds tycons
= do { dflags <- getDynFlags
; gbl_env <- getGblEnv
-- | Generate TyCon bindings for a set of type constructors
mkTypeableTyConBinds :: [TyCon] -> TcM TcGblEnv
mkTypeableTyConBinds tycons
= do { gbl_env <- getGblEnv
; mod <- getModule
; let pkg_str = unitIdString (moduleUnitId mod)
mod_str = moduleNameString (moduleName mod)
mod_expr = case tcg_tr_module gbl_env of -- Should be set by now
; let mod_expr = case tcg_tr_module gbl_env of -- Should be set by now
Just mod_id -> nlHsVar mod_id
Nothing -> pprPanic "tcMkTypeableBinds" (ppr tycons)
stuff = (dflags, mod_expr, pkg_str, mod_str)
all_tycons = [ tc' | tc <- tycons, tc' <- tc : tyConATs tc ]
; stuff <- collect_stuff mod mod_expr
; let all_tycons = [ tc' | tc <- tycons, tc' <- tc : tyConATs tc ]
-- We need type representations for any associated types
tc_binds = map (mk_typeable_binds stuff) all_tycons
tycon_rep_ids = foldr ((++) . collectHsBindsBinders) [] tc_binds
......@@ -143,15 +171,28 @@ mkTypeableBinds tycons
-- See Note [Grand plan for Typeable] in this module.
mkPrimTypeableBinds :: TcM TcGblEnv
mkPrimTypeableBinds
= do { dflags <- getDynFlags
; mod <- getModule
; let prim_binds :: LHsBinds Id
prim_binds
| mod == gHC_TYPES = ghcPrimTypeableBinds dflags
| otherwise = emptyBag
prim_rep_ids = collectHsBindsBinders prim_binds
; gbl_env <- tcExtendGlobalValEnv prim_rep_ids getGblEnv
; return (gbl_env `addTypecheckedBinds` [prim_binds]) }
= do { mod <- getModule
; if mod == gHC_TYPES
then do { trModuleTyCon <- tcLookupTyCon trModuleTyConName
; let ghc_prim_module_id =
mkExportedVanillaId trGhcPrimModuleName
(mkTyConTy trModuleTyCon)
; ghc_prim_module_bind <- mkVarBind ghc_prim_module_id
<$> mkModIdRHS gHC_PRIM
; stuff <- collect_stuff gHC_PRIM (nlHsVar ghc_prim_module_id)
; let prim_binds :: LHsBinds Id
prim_binds = unitBag ghc_prim_module_bind
`unionBags` ghcPrimTypeableBinds stuff
prim_rep_ids = collectHsBindsBinders prim_binds
; gbl_env <- tcExtendGlobalValEnv prim_rep_ids getGblEnv
; return (gbl_env `addTypecheckedBinds` [prim_binds])
}
else getGblEnv
}
where
-- | Generate bindings for the type representation of the wired-in TyCons defined
-- by the virtual "GHC.Prim" module. This differs from the usual
......@@ -160,35 +201,50 @@ mkPrimTypeableBinds
-- "GHC.Types" yet are producing representations for types in "GHC.Prim").
--
-- See Note [Grand plan for Typeable] in this module.
ghcPrimTypeableBinds :: DynFlags -> LHsBinds Id
ghcPrimTypeableBinds dflags
= ghc_prim_module_bind `unionBags` unionManyBags (map mkBind all_prim_tys)
ghcPrimTypeableBinds :: TypeableStuff -> LHsBinds Id
ghcPrimTypeableBinds stuff
= unionManyBags (map mkBind all_prim_tys)
where
all_prim_tys :: [TyCon]
all_prim_tys = [ tc' | tc <- funTyCon : primTyCons
, tc' <- tc : tyConATs tc ]
ghc_prim_module_id =
mkExportedVanillaId trGhcPrimModuleName (mkTyConTy trModuleTyCon)
ghc_prim_module_bind =
unitBag $ mkVarBind ghc_prim_module_id (mkModIdRHS gHC_PRIM)
stuff :: TypeableStuff
stuff = (dflags, nlHsVar ghc_prim_module_id, "ghc-prim", "GHC.Prim")
mkBind :: TyCon -> LHsBinds Id
mkBind = mk_typeable_binds stuff
trNameLit :: FastString -> LHsExpr Id
trNameLit fs
= nlHsApps (dataConWrapId trNameSDataCon) [nlHsLit (mkHsStringPrimLit fs)]
type TypeableStuff
= ( DynFlags
, LHsExpr Id -- Of type GHC.Types.Module
, String -- Package name
, String -- Module name
)
data TypeableStuff
= Stuff { dflags :: DynFlags
, mod_rep :: LHsExpr Id -- ^ Of type GHC.Types.Module
, pkg_str :: String -- ^ Package name
, mod_str :: String -- ^ Module name
, trTyConTyCon :: TyCon -- ^ of @TyCon@
, trTyConDataCon :: DataCon -- ^ of @TyCon@
, trNameLit :: FastString -> LHsExpr Id
-- ^ To construct @TrName@s
}
-- | Collect various tidbits which we'll need to generate TyCon representations.
collect_stuff :: Module -> LHsExpr Id -> TcM TypeableStuff
collect_stuff mod mod_rep = do
dflags <- getDynFlags
let pkg_str = unitIdString (moduleUnitId mod)
mod_str = moduleNameString (moduleName mod)
trTyConTyCon <- tcLookupTyCon trTyConTyConName
trTyConDataCon <- tcLookupDataCon trTyConDataConName
trNameLit <- mkTrNameLit
return Stuff {..}
-- | Lookup the necessary pieces to construct the @trNameLit@. We do this so we
-- can save the work of repeating lookups when constructing many TyCon
-- representations.
mkTrNameLit :: TcM (FastString -> LHsExpr Id)
mkTrNameLit = do
trNameSDataCon <- tcLookupDataCon trNameSDataConName
let trNameLit :: FastString -> LHsExpr Id
trNameLit fs = nlHsApps (dataConWrapId trNameSDataCon)
[nlHsLit (mkHsStringPrimLit fs)]
return trNameLit
-- | Make bindings for the type representations of a 'TyCon' and its
-- promoted constructors.
......@@ -196,28 +252,26 @@ mk_typeable_binds :: TypeableStuff -> TyCon -> LHsBinds Id
mk_typeable_binds stuff tycon
= mkTyConRepBinds stuff tycon
`unionBags`
unionManyBags (map (mkTypeableDataConBinds stuff) (tyConDataCons tycon))
unionManyBags (map (mkTyConRepBinds stuff . promoteDataCon)
(tyConDataCons tycon))
-- | Make typeable bindings for the given 'TyCon'.
mkTyConRepBinds :: TypeableStuff -> TyCon -> LHsBinds Id
mkTyConRepBinds stuff tycon
mkTyConRepBinds stuff@(Stuff {..}) tycon
= case tyConRepName_maybe tycon of
Just rep_name -> unitBag (mkVarBind rep_id rep_rhs)
where
rep_id = mkExportedVanillaId rep_name (mkTyConApp trTyConTyCon [])
rep_id = mkExportedVanillaId rep_name (mkTyConTy trTyConTyCon)
rep_rhs = mkTyConRepRHS stuff tycon
_ -> emptyBag
-- | Produce typeable binds for the promoted 'TyCon' of a data constructor
mkTypeableDataConBinds :: TypeableStuff -> DataCon -> LHsBinds Id
mkTypeableDataConBinds stuff dc
= mkTyConRepBinds stuff (promoteDataCon dc)
-- | Produce the right-hand-side of a @TyCon@ representation.
mkTyConRepRHS :: TypeableStuff -> TyCon -> LHsExpr Id
mkTyConRepRHS (dflags, mod_expr, pkg_str, mod_str) tycon = rep_rhs
mkTyConRepRHS (Stuff {..}) tycon = rep_rhs
where
rep_rhs = nlHsApps (dataConWrapId trTyConDataCon)
[ nlHsLit (word64 high), nlHsLit (word64 low)
, mod_expr
, mod_rep
, trNameLit (mkFastString tycon_str) ]
tycon_str = add_tick (occNameString (getOccName tycon))
......@@ -232,4 +286,3 @@ mkTyConRepRHS (dflags, mod_expr, pkg_str, mod_str) tycon = rep_rhs
word64 :: Word64 -> HsLit
word64 | wORD_SIZE dflags == 4 = \n -> HsWord64Prim (show n) (toInteger n)
| otherwise = \n -> HsWordPrim (show n) (toInteger n)
......@@ -344,7 +344,7 @@ data Levity = Lifted | Unlifted
{- *********************************************************************
* *
Runtime represntation of TyCon
Runtime representation of TyCon
* *
********************************************************************* -}
......
......@@ -14,6 +14,11 @@ T2431.$WRefl [InlPrag=INLINE] :: forall a. a :~: a
T2431.$WRefl =
\ (@ a) -> T2431.Refl @ a @ a @~ (<a>_N :: a GHC.Prim.~# a)
-- RHS size: {terms: 4, types: 8, coercions: 0}
absurd :: forall a. Int :~: Bool -> a
[GblId, Arity=1, Caf=NoCafRefs, Str=DmdType <L,U>x]
absurd = \ (@ a4) (x :: Int :~: Bool) -> case x of _ [Occ=Dead] { }
-- RHS size: {terms: 2, types: 0, coercions: 0}
a :: GHC.Types.TrName
[GblId, Caf=NoCafRefs, Str=DmdType]
......@@ -53,10 +58,5 @@ T2431.$tc:~: =
GHC.Types.TyCon
9759653149176674453## 12942818337407067047## T2431.$trModule a3
-- RHS size: {terms: 4, types: 8, coercions: 0}
absurd :: forall a. Int :~: Bool -> a
[GblId, Arity=1, Caf=NoCafRefs, Str=DmdType <L,U>x]
absurd = \ (@ a4) (x :: Int :~: Bool) -> case x of _ [Occ=Dead] { }
......@@ -7,7 +7,7 @@
These potential instances exist:
instance Show TypeRep -- Defined in ‘Data.Typeable.Internal’
instance Show Ordering -- Defined in ‘GHC.Show’
instance Show Integer -- Defined in ‘GHC.Show’
instance Show TyCon -- Defined in ‘GHC.Show’
...plus 30 others
...plus 10 instances involving out-of-scope types
(use -fprint-potential-instances to see them all)
......
......@@ -2,81 +2,81 @@
==================== Tidy Core ====================
Result size of Tidy Core = {terms: 51, types: 20, coercions: 5}
-- RHS size: {terms: 2, types: 2, coercions: 0}
a :: Wrap Age -> Wrap Age
[GblId, Arity=1, Caf=NoCafRefs, Str=DmdType]
a = \ (ds :: Wrap Age) -> ds
-- RHS size: {terms: 1, types: 0, coercions: 5}
convert :: Wrap Age -> Int
[GblId, Arity=1, Caf=NoCafRefs, Str=DmdType]
convert =
a
`cast` (<Wrap Age>_R -> Roles13.N:Wrap[0] Roles13.N:Age[0]
:: (Wrap Age -> Wrap Age) ~R# (Wrap Age -> Int))
-- RHS size: {terms: 2, types: 0, coercions: 0}
a :: GHC.Types.TrName
a1 :: GHC.Types.TrName
[GblId, Caf=NoCafRefs, Str=DmdType]
a = GHC.Types.TrNameS "main"#
a1 = GHC.Types.TrNameS "main"#
-- RHS size: {terms: 2, types: 0, coercions: 0}
a1 :: GHC.Types.TrName
a2 :: GHC.Types.TrName
[GblId, Caf=NoCafRefs, Str=DmdType]
a1 = GHC.Types.TrNameS "Roles13"#
a2 = GHC.Types.TrNameS "Roles13"#
-- RHS size: {terms: 3, types: 0, coercions: 0}
Roles13.$trModule :: GHC.Types.Module
[GblId, Caf=NoCafRefs, Str=DmdType]
Roles13.$trModule = GHC.Types.Module a a1
Roles13.$trModule = GHC.Types.Module a1 a2
-- RHS size: {terms: 2, types: 0, coercions: 0}
a2 :: GHC.Types.TrName
a3 :: GHC.Types.TrName
[GblId, Caf=NoCafRefs, Str=DmdType]
a2 = GHC.Types.TrNameS "'MkAge"#
a3 = GHC.Types.TrNameS "'MkAge"#
-- RHS size: {terms: 5, types: 0, coercions: 0}
Roles13.$tc'MkAge :: GHC.Types.TyCon
[GblId, Caf=NoCafRefs, Str=DmdType]
Roles13.$tc'MkAge =
GHC.Types.TyCon
1226019810264079099## 12180888342844277416## Roles13.$trModule a2
1226019810264079099## 12180888342844277416## Roles13.$trModule a3
-- RHS size: {terms: 2, types: 0, coercions: 0}
a3 :: GHC.Types.TrName
a4 :: GHC.Types.TrName
[GblId, Caf=NoCafRefs, Str=DmdType]
a3 = GHC.Types.TrNameS "Age"#
a4 = GHC.Types.TrNameS "Age"#
-- RHS size: {terms: 5, types: 0, coercions: 0}
Roles13.$tcAge :: GHC.Types.TyCon
[GblId, Caf=NoCafRefs, Str=DmdType]
Roles13.$tcAge =
GHC.Types.TyCon
18304088376370610314## 1954648846714895105## Roles13.$trModule a3
18304088376370610314## 1954648846714895105## Roles13.$trModule a4
-- RHS size: {terms: 2, types: 0, coercions: 0}
a4 :: GHC.Types.TrName
a5 :: GHC.Types.TrName
[GblId, Caf=NoCafRefs, Str=DmdType]
a4 = GHC.Types.TrNameS "'MkWrap"#
a5 = GHC.Types.TrNameS "'MkWrap"#
-- RHS size: {terms: 5, types: 0, coercions: 0}
Roles13.$tc'MkWrap :: GHC.Types.TyCon
[GblId, Caf=NoCafRefs, Str=DmdType]
Roles13.$tc'MkWrap =
GHC.Types.TyCon
12402878715225676312## 13345418993613492500## Roles13.$trModule a4
12402878715225676312## 13345418993613492500## Roles13.$trModule a5
-- RHS size: {terms: 2, types: 0, coercions: 0}
a5 :: GHC.Types.TrName
a6 :: GHC.Types.TrName
[GblId, Caf=NoCafRefs, Str=DmdType]
a5 = GHC.Types.TrNameS "Wrap"#
a6 = GHC.Types.TrNameS "Wrap"#
-- RHS size: {terms: 5, types: 0, coercions: 0}
Roles13.$tcWrap :: GHC.Types.TyCon
[GblId, Caf=NoCafRefs, Str=DmdType]
Roles13.$tcWrap =
GHC.Types.TyCon
5278920226786541118## 14554440859491798587## Roles13.$trModule a5
-- RHS size: {terms: 2, types: 2, coercions: 0}
a6 :: Wrap Age -> Wrap Age
[GblId, Arity=1, Caf=NoCafRefs, Str=DmdType]
a6 = \ (ds :: Wrap Age) -> ds
-- RHS size: {terms: 1, types: 0, coercions: 5}
convert :: Wrap Age -> Int
[GblId, Arity=1, Caf=NoCafRefs, Str=DmdType]
convert =
a6
`cast` (<Wrap Age>_R -> Roles13.N:Wrap[0] Roles13.N:Age[0]
:: (Wrap Age -> Wrap Age) ~R# (Wrap Age -> Int))
5278920226786541118## 14554440859491798587## Roles13.$trModule a6