never executed always true always false
    1 {-
    2 (c) The AQUA Project, Glasgow University, 1994-1998
    3 
    4 
    5 Wired-in knowledge about primitive types
    6 -}
    7 
    8 {-# LANGUAGE CPP #-}
    9 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
   10 
   11 -- | This module defines TyCons that can't be expressed in Haskell.
   12 --   They are all, therefore, wired-in TyCons.  C.f module "GHC.Builtin.Types"
   13 module GHC.Builtin.Types.Prim(
   14         mkPrimTyConName, -- For implicit parameters in GHC.Builtin.Types only
   15 
   16         mkTemplateKindVar, mkTemplateKindVars,
   17         mkTemplateTyVars, mkTemplateTyVarsFrom,
   18         mkTemplateKiTyVars, mkTemplateKiTyVar,
   19 
   20         mkTemplateTyConBinders, mkTemplateKindTyConBinders,
   21         mkTemplateAnonTyConBinders,
   22 
   23         alphaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,
   24         alphaTyVarSpec, betaTyVarSpec, gammaTyVarSpec, deltaTyVarSpec,
   25         alphaTys, alphaTy, betaTy, gammaTy, deltaTy,
   26         alphaTyVarsUnliftedRep, alphaTyVarUnliftedRep,
   27         alphaTysUnliftedRep, alphaTyUnliftedRep,
   28         runtimeRep1TyVar, runtimeRep2TyVar, runtimeRep3TyVar,
   29         runtimeRep1TyVarInf, runtimeRep2TyVarInf,
   30         runtimeRep1Ty, runtimeRep2Ty, runtimeRep3Ty,
   31         levity1TyVar, levity2TyVar,
   32         levity1TyVarInf, levity2TyVarInf,
   33         levity1Ty, levity2Ty,
   34 
   35         openAlphaTyVar, openBetaTyVar, openGammaTyVar,
   36         openAlphaTyVarSpec, openBetaTyVarSpec, openGammaTyVarSpec,
   37         openAlphaTy, openBetaTy, openGammaTy,
   38 
   39         levPolyAlphaTyVar, levPolyBetaTyVar,
   40         levPolyAlphaTyVarSpec, levPolyBetaTyVarSpec,
   41         levPolyAlphaTy, levPolyBetaTy,
   42 
   43         multiplicityTyVar1, multiplicityTyVar2,
   44 
   45         -- Kind constructors...
   46         tYPETyCon, tYPETyConName,
   47 
   48         -- Kinds
   49         tYPE, primRepToRuntimeRep, primRepsToRuntimeRep,
   50 
   51         functionWithMultiplicity,
   52         funTyCon, funTyConName,
   53         unexposedPrimTyCons, exposedPrimTyCons, primTyCons,
   54 
   55         charPrimTyCon,          charPrimTy, charPrimTyConName,
   56         intPrimTyCon,           intPrimTy, intPrimTyConName,
   57         wordPrimTyCon,          wordPrimTy, wordPrimTyConName,
   58         addrPrimTyCon,          addrPrimTy, addrPrimTyConName,
   59         floatPrimTyCon,         floatPrimTy, floatPrimTyConName,
   60         doublePrimTyCon,        doublePrimTy, doublePrimTyConName,
   61 
   62         statePrimTyCon,         mkStatePrimTy,
   63         realWorldTyCon,         realWorldTy, realWorldStatePrimTy,
   64 
   65         proxyPrimTyCon,         mkProxyPrimTy,
   66 
   67         arrayPrimTyCon, mkArrayPrimTy,
   68         byteArrayPrimTyCon,     byteArrayPrimTy,
   69         arrayArrayPrimTyCon, mkArrayArrayPrimTy,
   70         smallArrayPrimTyCon, mkSmallArrayPrimTy,
   71         mutableArrayPrimTyCon, mkMutableArrayPrimTy,
   72         mutableByteArrayPrimTyCon, mkMutableByteArrayPrimTy,
   73         mutableArrayArrayPrimTyCon, mkMutableArrayArrayPrimTy,
   74         smallMutableArrayPrimTyCon, mkSmallMutableArrayPrimTy,
   75         mutVarPrimTyCon, mkMutVarPrimTy,
   76 
   77         mVarPrimTyCon,                  mkMVarPrimTy,
   78         ioPortPrimTyCon,                mkIOPortPrimTy,
   79         tVarPrimTyCon,                  mkTVarPrimTy,
   80         stablePtrPrimTyCon,             mkStablePtrPrimTy,
   81         stableNamePrimTyCon,            mkStableNamePrimTy,
   82         compactPrimTyCon,               compactPrimTy,
   83         bcoPrimTyCon,                   bcoPrimTy,
   84         weakPrimTyCon,                  mkWeakPrimTy,
   85         threadIdPrimTyCon,              threadIdPrimTy,
   86         stackSnapshotPrimTyCon,         stackSnapshotPrimTy,
   87 
   88         int8PrimTyCon,          int8PrimTy, int8PrimTyConName,
   89         word8PrimTyCon,         word8PrimTy, word8PrimTyConName,
   90 
   91         int16PrimTyCon,         int16PrimTy, int16PrimTyConName,
   92         word16PrimTyCon,        word16PrimTy, word16PrimTyConName,
   93 
   94         int32PrimTyCon,         int32PrimTy, int32PrimTyConName,
   95         word32PrimTyCon,        word32PrimTy, word32PrimTyConName,
   96 
   97         int64PrimTyCon,         int64PrimTy, int64PrimTyConName,
   98         word64PrimTyCon,        word64PrimTy, word64PrimTyConName,
   99 
  100         eqPrimTyCon,            -- ty1 ~# ty2
  101         eqReprPrimTyCon,        -- ty1 ~R# ty2  (at role Representational)
  102         eqPhantPrimTyCon,       -- ty1 ~P# ty2  (at role Phantom)
  103         equalityTyCon,
  104 
  105         concretePrimTyCon,
  106 
  107         -- * SIMD
  108 #include "primop-vector-tys-exports.hs-incl"
  109   ) where
  110 
  111 import GHC.Prelude
  112 
  113 import {-# SOURCE #-} GHC.Builtin.Types
  114   ( runtimeRepTy, levityTy, unboxedTupleKind, liftedTypeKind
  115   , boxedRepDataConTyCon, vecRepDataConTyCon, tupleRepDataConTyCon
  116   , liftedRepTy, unliftedRepTy
  117   , intRepDataConTy
  118   , int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy
  119   , wordRepDataConTy
  120   , word16RepDataConTy, word8RepDataConTy, word32RepDataConTy, word64RepDataConTy
  121   , addrRepDataConTy
  122   , floatRepDataConTy, doubleRepDataConTy
  123   , vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy
  124   , vec64DataConTy
  125   , int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy
  126   , int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy
  127   , word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy
  128   , doubleElemRepDataConTy
  129   , mkPromotedListTy, multiplicityTy )
  130 
  131 import GHC.Types.Var    ( TyVarBinder, TyVar
  132                         , mkTyVar, mkTyVarBinder, mkTyVarBinders )
  133 import GHC.Types.Name
  134 import {-# SOURCE #-} GHC.Types.TyThing
  135 import GHC.Core.TyCon
  136 import GHC.Types.SrcLoc
  137 import GHC.Types.Unique
  138 import GHC.Builtin.Uniques
  139 import GHC.Builtin.Names
  140 import GHC.Data.FastString
  141 import GHC.Utils.Outputable
  142 import GHC.Utils.Panic
  143 import GHC.Core.TyCo.Rep -- Doesn't need special access, but this is easier to avoid
  144                          -- import loops which show up if you import Type instead
  145 import {-# SOURCE #-} GHC.Core.Type ( mkTyConTy, mkTyConApp, tYPE )
  146 
  147 import Data.Char
  148 
  149 {-
  150 ************************************************************************
  151 *                                                                      *
  152 \subsection{Primitive type constructors}
  153 *                                                                      *
  154 ************************************************************************
  155 -}
  156 
  157 primTyCons :: [TyCon]
  158 primTyCons = unexposedPrimTyCons ++ exposedPrimTyCons
  159 
  160 -- | Primitive 'TyCon's that are defined in GHC.Prim but not exposed.
  161 -- It's important to keep these separate as we don't want users to be able to
  162 -- write them (see #15209) or see them in GHCi's @:browse@ output
  163 -- (see #12023).
  164 unexposedPrimTyCons :: [TyCon]
  165 unexposedPrimTyCons
  166   = [ eqPrimTyCon
  167     , eqReprPrimTyCon
  168     , eqPhantPrimTyCon
  169     , concretePrimTyCon
  170     ]
  171 
  172 -- | Primitive 'TyCon's that are defined in, and exported from, GHC.Prim.
  173 exposedPrimTyCons :: [TyCon]
  174 exposedPrimTyCons
  175   = [ addrPrimTyCon
  176     , arrayPrimTyCon
  177     , byteArrayPrimTyCon
  178     , arrayArrayPrimTyCon
  179     , smallArrayPrimTyCon
  180     , charPrimTyCon
  181     , doublePrimTyCon
  182     , floatPrimTyCon
  183     , intPrimTyCon
  184     , int8PrimTyCon
  185     , int16PrimTyCon
  186     , int32PrimTyCon
  187     , int64PrimTyCon
  188     , bcoPrimTyCon
  189     , weakPrimTyCon
  190     , mutableArrayPrimTyCon
  191     , mutableByteArrayPrimTyCon
  192     , mutableArrayArrayPrimTyCon
  193     , smallMutableArrayPrimTyCon
  194     , mVarPrimTyCon
  195     , ioPortPrimTyCon
  196     , tVarPrimTyCon
  197     , mutVarPrimTyCon
  198     , realWorldTyCon
  199     , stablePtrPrimTyCon
  200     , stableNamePrimTyCon
  201     , compactPrimTyCon
  202     , statePrimTyCon
  203     , proxyPrimTyCon
  204     , threadIdPrimTyCon
  205     , wordPrimTyCon
  206     , word8PrimTyCon
  207     , word16PrimTyCon
  208     , word32PrimTyCon
  209     , word64PrimTyCon
  210     , stackSnapshotPrimTyCon
  211 
  212     , tYPETyCon
  213     , funTyCon
  214 
  215 #include "primop-vector-tycons.hs-incl"
  216     ]
  217 
  218 mkPrimTc :: FastString -> Unique -> TyCon -> Name
  219 mkPrimTc fs unique tycon
  220   = mkWiredInName gHC_PRIM (mkTcOccFS fs)
  221                   unique
  222                   (mkATyCon tycon)        -- Relevant TyCon
  223                   UserSyntax
  224 
  225 mkBuiltInPrimTc :: FastString -> Unique -> TyCon -> Name
  226 mkBuiltInPrimTc fs unique tycon
  227   = mkWiredInName gHC_PRIM (mkTcOccFS fs)
  228                   unique
  229                   (mkATyCon tycon)        -- Relevant TyCon
  230                   BuiltInSyntax
  231 
  232 
  233 charPrimTyConName, intPrimTyConName, int8PrimTyConName, int16PrimTyConName, int32PrimTyConName, int64PrimTyConName,
  234   wordPrimTyConName, word32PrimTyConName, word8PrimTyConName, word16PrimTyConName, word64PrimTyConName,
  235   addrPrimTyConName, floatPrimTyConName, doublePrimTyConName,
  236   statePrimTyConName, proxyPrimTyConName, realWorldTyConName,
  237   arrayPrimTyConName, arrayArrayPrimTyConName, smallArrayPrimTyConName, byteArrayPrimTyConName,
  238   mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, mutableArrayArrayPrimTyConName,
  239   smallMutableArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName,
  240   ioPortPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName,
  241   stableNamePrimTyConName, compactPrimTyConName, bcoPrimTyConName,
  242   weakPrimTyConName, threadIdPrimTyConName,
  243   eqPrimTyConName, eqReprPrimTyConName, eqPhantPrimTyConName,
  244   stackSnapshotPrimTyConName,
  245   concretePrimTyConName :: Name
  246 charPrimTyConName             = mkPrimTc (fsLit "Char#") charPrimTyConKey charPrimTyCon
  247 intPrimTyConName              = mkPrimTc (fsLit "Int#") intPrimTyConKey  intPrimTyCon
  248 int8PrimTyConName             = mkPrimTc (fsLit "Int8#") int8PrimTyConKey int8PrimTyCon
  249 int16PrimTyConName            = mkPrimTc (fsLit "Int16#") int16PrimTyConKey int16PrimTyCon
  250 int32PrimTyConName            = mkPrimTc (fsLit "Int32#") int32PrimTyConKey int32PrimTyCon
  251 int64PrimTyConName            = mkPrimTc (fsLit "Int64#") int64PrimTyConKey int64PrimTyCon
  252 wordPrimTyConName             = mkPrimTc (fsLit "Word#") wordPrimTyConKey wordPrimTyCon
  253 word8PrimTyConName            = mkPrimTc (fsLit "Word8#") word8PrimTyConKey word8PrimTyCon
  254 word16PrimTyConName           = mkPrimTc (fsLit "Word16#") word16PrimTyConKey word16PrimTyCon
  255 word32PrimTyConName           = mkPrimTc (fsLit "Word32#") word32PrimTyConKey word32PrimTyCon
  256 word64PrimTyConName           = mkPrimTc (fsLit "Word64#") word64PrimTyConKey word64PrimTyCon
  257 addrPrimTyConName             = mkPrimTc (fsLit "Addr#") addrPrimTyConKey addrPrimTyCon
  258 floatPrimTyConName            = mkPrimTc (fsLit "Float#") floatPrimTyConKey floatPrimTyCon
  259 doublePrimTyConName           = mkPrimTc (fsLit "Double#") doublePrimTyConKey doublePrimTyCon
  260 statePrimTyConName            = mkPrimTc (fsLit "State#") statePrimTyConKey statePrimTyCon
  261 proxyPrimTyConName            = mkPrimTc (fsLit "Proxy#") proxyPrimTyConKey proxyPrimTyCon
  262 eqPrimTyConName               = mkPrimTc (fsLit "~#") eqPrimTyConKey eqPrimTyCon
  263 eqReprPrimTyConName           = mkBuiltInPrimTc (fsLit "~R#") eqReprPrimTyConKey eqReprPrimTyCon
  264 eqPhantPrimTyConName          = mkBuiltInPrimTc (fsLit "~P#") eqPhantPrimTyConKey eqPhantPrimTyCon
  265 realWorldTyConName            = mkPrimTc (fsLit "RealWorld") realWorldTyConKey realWorldTyCon
  266 arrayPrimTyConName            = mkPrimTc (fsLit "Array#") arrayPrimTyConKey arrayPrimTyCon
  267 byteArrayPrimTyConName        = mkPrimTc (fsLit "ByteArray#") byteArrayPrimTyConKey byteArrayPrimTyCon
  268 arrayArrayPrimTyConName       = mkPrimTc (fsLit "ArrayArray#") arrayArrayPrimTyConKey arrayArrayPrimTyCon
  269 smallArrayPrimTyConName       = mkPrimTc (fsLit "SmallArray#") smallArrayPrimTyConKey smallArrayPrimTyCon
  270 mutableArrayPrimTyConName     = mkPrimTc (fsLit "MutableArray#") mutableArrayPrimTyConKey mutableArrayPrimTyCon
  271 mutableByteArrayPrimTyConName = mkPrimTc (fsLit "MutableByteArray#") mutableByteArrayPrimTyConKey mutableByteArrayPrimTyCon
  272 mutableArrayArrayPrimTyConName= mkPrimTc (fsLit "MutableArrayArray#") mutableArrayArrayPrimTyConKey mutableArrayArrayPrimTyCon
  273 smallMutableArrayPrimTyConName= mkPrimTc (fsLit "SmallMutableArray#") smallMutableArrayPrimTyConKey smallMutableArrayPrimTyCon
  274 mutVarPrimTyConName           = mkPrimTc (fsLit "MutVar#") mutVarPrimTyConKey mutVarPrimTyCon
  275 ioPortPrimTyConName           = mkPrimTc (fsLit "IOPort#") ioPortPrimTyConKey ioPortPrimTyCon
  276 mVarPrimTyConName             = mkPrimTc (fsLit "MVar#") mVarPrimTyConKey mVarPrimTyCon
  277 tVarPrimTyConName             = mkPrimTc (fsLit "TVar#") tVarPrimTyConKey tVarPrimTyCon
  278 stablePtrPrimTyConName        = mkPrimTc (fsLit "StablePtr#") stablePtrPrimTyConKey stablePtrPrimTyCon
  279 stableNamePrimTyConName       = mkPrimTc (fsLit "StableName#") stableNamePrimTyConKey stableNamePrimTyCon
  280 compactPrimTyConName          = mkPrimTc (fsLit "Compact#") compactPrimTyConKey compactPrimTyCon
  281 stackSnapshotPrimTyConName    = mkPrimTc (fsLit "StackSnapshot#") stackSnapshotPrimTyConKey stackSnapshotPrimTyCon
  282 bcoPrimTyConName              = mkPrimTc (fsLit "BCO") bcoPrimTyConKey bcoPrimTyCon
  283 weakPrimTyConName             = mkPrimTc (fsLit "Weak#") weakPrimTyConKey weakPrimTyCon
  284 threadIdPrimTyConName         = mkPrimTc (fsLit "ThreadId#") threadIdPrimTyConKey threadIdPrimTyCon
  285 concretePrimTyConName         = mkPrimTc (fsLit "Concrete#") concretePrimTyConKey concretePrimTyCon
  286 
  287 {-
  288 ************************************************************************
  289 *                                                                      *
  290 \subsection{Support code}
  291 *                                                                      *
  292 ************************************************************************
  293 
  294 alphaTyVars is a list of type variables for use in templates:
  295         ["a", "b", ..., "z", "t1", "t2", ... ]
  296 -}
  297 
  298 mkTemplateKindVar :: Kind -> TyVar
  299 mkTemplateKindVar = mkTyVar (mk_tv_name 0 "k")
  300 
  301 mkTemplateKindVars :: [Kind] -> [TyVar]
  302 -- k0  with unique (mkAlphaTyVarUnique 0)
  303 -- k1  with unique (mkAlphaTyVarUnique 1)
  304 -- ... etc
  305 mkTemplateKindVars [kind] = [mkTemplateKindVar kind]
  306   -- Special case for one kind: just "k"
  307 mkTemplateKindVars kinds
  308   = [ mkTyVar (mk_tv_name u ('k' : show u)) kind
  309     | (kind, u) <- kinds `zip` [0..] ]
  310 mk_tv_name :: Int -> String -> Name
  311 mk_tv_name u s = mkInternalName (mkAlphaTyVarUnique u)
  312                                 (mkTyVarOccFS (mkFastString s))
  313                                 noSrcSpan
  314 
  315 mkTemplateTyVarsFrom :: Int -> [Kind] -> [TyVar]
  316 -- a  with unique (mkAlphaTyVarUnique n)
  317 -- b  with unique (mkAlphaTyVarUnique n+1)
  318 -- ... etc
  319 -- Typically called as
  320 --   mkTemplateTyVarsFrom (length kv_bndrs) kinds
  321 -- where kv_bndrs are the kind-level binders of a TyCon
  322 mkTemplateTyVarsFrom n kinds
  323   = [ mkTyVar name kind
  324     | (kind, index) <- zip kinds [0..],
  325       let ch_ord = index + ord 'a'
  326           name_str | ch_ord <= ord 'z' = [chr ch_ord]
  327                    | otherwise         = 't':show index
  328           name = mk_tv_name (index + n) name_str
  329     ]
  330 
  331 mkTemplateTyVars :: [Kind] -> [TyVar]
  332 mkTemplateTyVars = mkTemplateTyVarsFrom 1
  333 
  334 mkTemplateTyConBinders
  335     :: [Kind]                -- [k1, .., kn]   Kinds of kind-forall'd vars
  336     -> ([Kind] -> [Kind])    -- Arg is [kv1:k1, ..., kvn:kn]
  337                              --     same length as first arg
  338                              -- Result is anon arg kinds
  339     -> [TyConBinder]
  340 mkTemplateTyConBinders kind_var_kinds mk_anon_arg_kinds
  341   = kv_bndrs ++ tv_bndrs
  342   where
  343     kv_bndrs   = mkTemplateKindTyConBinders kind_var_kinds
  344     anon_kinds = mk_anon_arg_kinds (mkTyVarTys (binderVars kv_bndrs))
  345     tv_bndrs   = mkTemplateAnonTyConBindersFrom (length kv_bndrs) anon_kinds
  346 
  347 mkTemplateKiTyVars
  348     :: [Kind]                -- [k1, .., kn]   Kinds of kind-forall'd vars
  349     -> ([Kind] -> [Kind])    -- Arg is [kv1:k1, ..., kvn:kn]
  350                              --     same length as first arg
  351                              -- Result is anon arg kinds [ak1, .., akm]
  352     -> [TyVar]   -- [kv1:k1, ..., kvn:kn, av1:ak1, ..., avm:akm]
  353 -- Example: if you want the tyvars for
  354 --   forall (r:RuntimeRep) (a:TYPE r) (b:*). blah
  355 -- call mkTemplateKiTyVars [RuntimeRep] (\[r] -> [TYPE r, *])
  356 mkTemplateKiTyVars kind_var_kinds mk_arg_kinds
  357   = kv_bndrs ++ tv_bndrs
  358   where
  359     kv_bndrs   = mkTemplateKindVars kind_var_kinds
  360     anon_kinds = mk_arg_kinds (mkTyVarTys kv_bndrs)
  361     tv_bndrs   = mkTemplateTyVarsFrom (length kv_bndrs) anon_kinds
  362 
  363 mkTemplateKiTyVar
  364     :: Kind                  -- [k1, .., kn]   Kind of kind-forall'd var
  365     -> (Kind -> [Kind])      -- Arg is kv1:k1
  366                              -- Result is anon arg kinds [ak1, .., akm]
  367     -> [TyVar]   -- [kv1:k1, ..., kvn:kn, av1:ak1, ..., avm:akm]
  368 -- Example: if you want the tyvars for
  369 --   forall (r:RuntimeRep) (a:TYPE r) (b:*). blah
  370 -- call mkTemplateKiTyVar RuntimeRep (\r -> [TYPE r, *])
  371 mkTemplateKiTyVar kind mk_arg_kinds
  372   = kv_bndr : tv_bndrs
  373   where
  374     kv_bndr    = mkTemplateKindVar kind
  375     anon_kinds = mk_arg_kinds (mkTyVarTy kv_bndr)
  376     tv_bndrs   = mkTemplateTyVarsFrom 1 anon_kinds
  377 
  378 mkTemplateKindTyConBinders :: [Kind] -> [TyConBinder]
  379 -- Makes named, Specified binders
  380 mkTemplateKindTyConBinders kinds = [mkNamedTyConBinder Specified tv | tv <- mkTemplateKindVars kinds]
  381 
  382 mkTemplateAnonTyConBinders :: [Kind] -> [TyConBinder]
  383 mkTemplateAnonTyConBinders kinds = mkAnonTyConBinders VisArg (mkTemplateTyVars kinds)
  384 
  385 mkTemplateAnonTyConBindersFrom :: Int -> [Kind] -> [TyConBinder]
  386 mkTemplateAnonTyConBindersFrom n kinds = mkAnonTyConBinders VisArg (mkTemplateTyVarsFrom n kinds)
  387 
  388 alphaTyVars :: [TyVar]
  389 alphaTyVars = mkTemplateTyVars $ repeat liftedTypeKind
  390 
  391 alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar :: TyVar
  392 (alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars
  393 
  394 alphaTyVarSpec, betaTyVarSpec, gammaTyVarSpec, deltaTyVarSpec :: TyVarBinder
  395 (alphaTyVarSpec:betaTyVarSpec:gammaTyVarSpec:deltaTyVarSpec:_) = mkTyVarBinders Specified alphaTyVars
  396 
  397 alphaTys :: [Type]
  398 alphaTys = mkTyVarTys alphaTyVars
  399 alphaTy, betaTy, gammaTy, deltaTy :: Type
  400 (alphaTy:betaTy:gammaTy:deltaTy:_) = alphaTys
  401 
  402 alphaTyVarsUnliftedRep :: [TyVar]
  403 alphaTyVarsUnliftedRep = mkTemplateTyVars $ repeat (tYPE unliftedRepTy)
  404 
  405 alphaTyVarUnliftedRep :: TyVar
  406 (alphaTyVarUnliftedRep:_) = alphaTyVarsUnliftedRep
  407 
  408 alphaTysUnliftedRep :: [Type]
  409 alphaTysUnliftedRep = mkTyVarTys alphaTyVarsUnliftedRep
  410 alphaTyUnliftedRep :: Type
  411 (alphaTyUnliftedRep:_) = alphaTysUnliftedRep
  412 
  413 runtimeRep1TyVar, runtimeRep2TyVar, runtimeRep3TyVar :: TyVar
  414 (runtimeRep1TyVar : runtimeRep2TyVar : runtimeRep3TyVar : _)
  415   = drop 16 (mkTemplateTyVars (repeat runtimeRepTy))  -- selects 'q','r'
  416 
  417 runtimeRep1TyVarInf, runtimeRep2TyVarInf :: TyVarBinder
  418 runtimeRep1TyVarInf = mkTyVarBinder Inferred runtimeRep1TyVar
  419 runtimeRep2TyVarInf = mkTyVarBinder Inferred runtimeRep2TyVar
  420 
  421 runtimeRep1Ty, runtimeRep2Ty, runtimeRep3Ty :: Type
  422 runtimeRep1Ty = mkTyVarTy runtimeRep1TyVar
  423 runtimeRep2Ty = mkTyVarTy runtimeRep2TyVar
  424 runtimeRep3Ty = mkTyVarTy runtimeRep3TyVar
  425 openAlphaTyVar, openBetaTyVar, openGammaTyVar :: TyVar
  426 -- alpha :: TYPE r1
  427 -- beta  :: TYPE r2
  428 -- gamma :: TYPE r3
  429 [openAlphaTyVar,openBetaTyVar,openGammaTyVar]
  430   = mkTemplateTyVars [tYPE runtimeRep1Ty, tYPE runtimeRep2Ty, tYPE runtimeRep3Ty]
  431 
  432 openAlphaTyVarSpec, openBetaTyVarSpec, openGammaTyVarSpec :: TyVarBinder
  433 openAlphaTyVarSpec = mkTyVarBinder Specified openAlphaTyVar
  434 openBetaTyVarSpec  = mkTyVarBinder Specified openBetaTyVar
  435 openGammaTyVarSpec = mkTyVarBinder Specified openGammaTyVar
  436 
  437 openAlphaTy, openBetaTy, openGammaTy :: Type
  438 openAlphaTy = mkTyVarTy openAlphaTyVar
  439 openBetaTy  = mkTyVarTy openBetaTyVar
  440 openGammaTy = mkTyVarTy openGammaTyVar
  441 
  442 levity1TyVar, levity2TyVar :: TyVar
  443 (levity2TyVar : levity1TyVar : _) -- NB: levity2TyVar before levity1TyVar
  444   = drop 10 (mkTemplateTyVars (repeat levityTy)) -- selects 'k', 'l'
  445 -- The ordering of levity2TyVar before levity1TyVar is chosen so that
  446 -- the more common levity1TyVar uses the levity variable 'l'.
  447 
  448 levity1TyVarInf, levity2TyVarInf :: TyVarBinder
  449 levity1TyVarInf = mkTyVarBinder Inferred levity1TyVar
  450 levity2TyVarInf = mkTyVarBinder Inferred levity2TyVar
  451 
  452 levity1Ty, levity2Ty :: Type
  453 levity1Ty = mkTyVarTy levity1TyVar
  454 levity2Ty = mkTyVarTy levity2TyVar
  455 
  456 levPolyAlphaTyVar, levPolyBetaTyVar :: TyVar
  457 [levPolyAlphaTyVar, levPolyBetaTyVar] =
  458   mkTemplateTyVars
  459     [tYPE (mkTyConApp boxedRepDataConTyCon [levity1Ty])
  460     ,tYPE (mkTyConApp boxedRepDataConTyCon [levity2Ty])]
  461 -- alpha :: TYPE ('BoxedRep l)
  462 -- beta  :: TYPE ('BoxedRep k)
  463 
  464 levPolyAlphaTyVarSpec, levPolyBetaTyVarSpec :: TyVarBinder
  465 levPolyAlphaTyVarSpec = mkTyVarBinder Specified levPolyAlphaTyVar
  466 levPolyBetaTyVarSpec  = mkTyVarBinder Specified levPolyBetaTyVar
  467 
  468 levPolyAlphaTy, levPolyBetaTy :: Type
  469 levPolyAlphaTy = mkTyVarTy levPolyAlphaTyVar
  470 levPolyBetaTy  = mkTyVarTy levPolyBetaTyVar
  471 
  472 multiplicityTyVar1, multiplicityTyVar2  :: TyVar
  473 (multiplicityTyVar1 : multiplicityTyVar2 : _)
  474    = drop 13 (mkTemplateTyVars (repeat multiplicityTy))  -- selects 'n', 'm'
  475 
  476 
  477 {-
  478 ************************************************************************
  479 *                                                                      *
  480                 FunTyCon
  481 *                                                                      *
  482 ************************************************************************
  483 -}
  484 
  485 funTyConName :: Name
  486 funTyConName = mkPrimTyConName (fsLit "FUN") funTyConKey funTyCon
  487 
  488 -- | The @FUN@ type constructor.
  489 --
  490 -- @
  491 -- FUN :: forall (m :: Multiplicity) ->
  492 --        forall {rep1 :: RuntimeRep} {rep2 :: RuntimeRep}.
  493 --        TYPE rep1 -> TYPE rep2 -> *
  494 -- @
  495 --
  496 -- The runtime representations quantification is left inferred. This
  497 -- means they cannot be specified with @-XTypeApplications@.
  498 --
  499 -- This is a deliberate choice to allow future extensions to the
  500 -- function arrow. To allow visible application a type synonym can be
  501 -- defined:
  502 --
  503 -- @
  504 -- type Arr :: forall (rep1 :: RuntimeRep) (rep2 :: RuntimeRep).
  505 --             TYPE rep1 -> TYPE rep2 -> Type
  506 -- type Arr = FUN 'Many
  507 -- @
  508 --
  509 funTyCon :: TyCon
  510 funTyCon = mkFunTyCon funTyConName tc_bndrs tc_rep_nm
  511   where
  512     -- See also unrestrictedFunTyCon
  513     tc_bndrs = [ mkNamedTyConBinder Required multiplicityTyVar1
  514                , mkNamedTyConBinder Inferred runtimeRep1TyVar
  515                , mkNamedTyConBinder Inferred runtimeRep2TyVar ]
  516                ++ mkTemplateAnonTyConBinders [ tYPE runtimeRep1Ty
  517                                              , tYPE runtimeRep2Ty
  518                                              ]
  519     tc_rep_nm = mkPrelTyConRepName funTyConName
  520 
  521 {-
  522 ************************************************************************
  523 *                                                                      *
  524                 Kinds
  525 *                                                                      *
  526 ************************************************************************
  527 
  528 Note [TYPE and RuntimeRep]
  529 ~~~~~~~~~~~~~~~~~~~~~~~~~~
  530 All types that classify values have a kind of the form (TYPE rr), where
  531 
  532     data RuntimeRep     -- Defined in ghc-prim:GHC.Types
  533       = BoxedRep Levity
  534       | IntRep
  535       | FloatRep
  536       .. etc ..
  537 
  538     data Levity = Lifted | Unlifted
  539 
  540     rr :: RuntimeRep
  541 
  542     TYPE :: RuntimeRep -> TYPE 'LiftedRep  -- Built in
  543 
  544 So for example:
  545     Int        :: TYPE ('BoxedRep 'Lifted)
  546     Array# Int :: TYPE ('BoxedRep 'Unlifted)
  547     Int#       :: TYPE 'IntRep
  548     Float#     :: TYPE 'FloatRep
  549     Maybe      :: TYPE ('BoxedRep 'Lifted) -> TYPE ('BoxedRep 'Lifted)
  550     (# , #)    :: TYPE r1 -> TYPE r2 -> TYPE (TupleRep [r1, r2])
  551 
  552 We abbreviate '*' specially:
  553     type LiftedRep = 'BoxedRep 'Lifted
  554     type * = TYPE LiftedRep
  555 
  556 The 'rr' parameter tells us how the value is represented at runtime.
  557 
  558 Generally speaking, you can't be polymorphic in 'rr'.  E.g
  559    f :: forall (rr:RuntimeRep) (a:TYPE rr). a -> [a]
  560    f = /\(rr:RuntimeRep) (a:rr) \(a:rr). ...
  561 This is no good: we could not generate code for 'f', because the
  562 calling convention for 'f' varies depending on whether the argument is
  563 a a Int, Int#, or Float#.  (You could imagine generating specialised
  564 code, one for each instantiation of 'rr', but we don't do that.)
  565 
  566 Certain functions CAN be runtime-rep-polymorphic, because the code
  567 generator never has to manipulate a value of type 'a :: TYPE rr'.
  568 
  569 * error :: forall (rr:RuntimeRep) (a:TYPE rr). String -> a
  570   Code generator never has to manipulate the return value.
  571 
  572 * unsafeCoerce#, defined in Desugar.mkUnsafeCoercePair:
  573   Always inlined to be a no-op
  574      unsafeCoerce# :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)
  575                              (a :: TYPE r1) (b :: TYPE r2).
  576                              a -> b
  577 
  578 * Unboxed tuples, and unboxed sums, defined in GHC.Builtin.Types
  579   Always inlined, and hence specialised to the call site
  580      (#,#) :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)
  581                      (a :: TYPE r1) (b :: TYPE r2).
  582                      a -> b -> TYPE ('TupleRep '[r1, r2])
  583 
  584 Note [PrimRep and kindPrimRep]
  585 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  586 As part of its source code, in GHC.Core.TyCon, GHC has
  587   data PrimRep = BoxedRep Levity | IntRep | FloatRep | ...etc...
  588 
  589 Notice that
  590  * RuntimeRep is part of the syntax tree of the program being compiled
  591      (defined in a library: ghc-prim:GHC.Types)
  592  * PrimRep is part of GHC's source code.
  593      (defined in GHC.Core.TyCon)
  594 
  595 We need to get from one to the other; that is what kindPrimRep does.
  596 Suppose we have a value
  597    (v :: t) where (t :: k)
  598 Given this kind
  599     k = TyConApp "TYPE" [rep]
  600 GHC needs to be able to figure out how 'v' is represented at runtime.
  601 It expects 'rep' to be form
  602     TyConApp rr_dc args
  603 where 'rr_dc' is a promoteed data constructor from RuntimeRep. So
  604 now we need to go from 'dc' to the corresponding PrimRep.  We store this
  605 PrimRep in the promoted data constructor itself: see TyCon.promDcRepInfo.
  606 
  607 -}
  608 
  609 tYPETyCon :: TyCon
  610 tYPETyConName :: Name
  611 
  612 tYPETyCon = mkKindTyCon tYPETyConName
  613                         (mkTemplateAnonTyConBinders [runtimeRepTy])
  614                         liftedTypeKind
  615                         [Nominal]
  616                         (mkPrelTyConRepName tYPETyConName)
  617 
  618 --------------------------
  619 -- ... and now their names
  620 
  621 -- If you edit these, you may need to update the GHC formalism
  622 -- See Note [GHC Formalism] in GHC.Core.Lint
  623 tYPETyConName             = mkPrimTyConName (fsLit "TYPE") tYPETyConKey tYPETyCon
  624 
  625 mkPrimTyConName :: FastString -> Unique -> TyCon -> Name
  626 mkPrimTyConName = mkPrimTcName BuiltInSyntax
  627   -- All of the super kinds and kinds are defined in Prim,
  628   -- and use BuiltInSyntax, because they are never in scope in the source
  629 
  630 mkPrimTcName :: BuiltInSyntax -> FastString -> Unique -> TyCon -> Name
  631 mkPrimTcName built_in_syntax occ key tycon
  632   = mkWiredInName gHC_PRIM (mkTcOccFS occ) key (mkATyCon tycon) built_in_syntax
  633 
  634 -----------------------------
  635 
  636 -- Given a Multiplicity, applies FUN to it.
  637 functionWithMultiplicity :: Type -> Type
  638 functionWithMultiplicity mul = TyConApp funTyCon [mul]
  639 
  640 {-
  641 ************************************************************************
  642 *                                                                      *
  643    Basic primitive types (@Char#@, @Int#@, etc.)
  644 *                                                                      *
  645 ************************************************************************
  646 -}
  647 
  648 -- only used herein
  649 pcPrimTyCon :: Name -> [Role] -> PrimRep -> TyCon
  650 pcPrimTyCon name roles rep
  651   = mkPrimTyCon name binders result_kind roles
  652   where
  653     binders     = mkTemplateAnonTyConBinders (map (const liftedTypeKind) roles)
  654     result_kind = tYPE (primRepToRuntimeRep rep)
  655 
  656 -- | Convert a 'PrimRep' to a 'Type' of kind RuntimeRep
  657 -- Defined here to avoid (more) module loops
  658 primRepToRuntimeRep :: PrimRep -> Type
  659 primRepToRuntimeRep rep = case rep of
  660   VoidRep       -> mkTupleRep []
  661   LiftedRep     -> liftedRepTy
  662   UnliftedRep   -> unliftedRepTy
  663   IntRep        -> intRepDataConTy
  664   Int8Rep       -> int8RepDataConTy
  665   Int16Rep      -> int16RepDataConTy
  666   Int32Rep      -> int32RepDataConTy
  667   Int64Rep      -> int64RepDataConTy
  668   WordRep       -> wordRepDataConTy
  669   Word8Rep      -> word8RepDataConTy
  670   Word16Rep     -> word16RepDataConTy
  671   Word32Rep     -> word32RepDataConTy
  672   Word64Rep     -> word64RepDataConTy
  673   AddrRep       -> addrRepDataConTy
  674   FloatRep      -> floatRepDataConTy
  675   DoubleRep     -> doubleRepDataConTy
  676   VecRep n elem -> TyConApp vecRepDataConTyCon [n', elem']
  677     where
  678       n' = case n of
  679         2  -> vec2DataConTy
  680         4  -> vec4DataConTy
  681         8  -> vec8DataConTy
  682         16 -> vec16DataConTy
  683         32 -> vec32DataConTy
  684         64 -> vec64DataConTy
  685         _  -> pprPanic "Disallowed VecCount" (ppr n)
  686 
  687       elem' = case elem of
  688         Int8ElemRep   -> int8ElemRepDataConTy
  689         Int16ElemRep  -> int16ElemRepDataConTy
  690         Int32ElemRep  -> int32ElemRepDataConTy
  691         Int64ElemRep  -> int64ElemRepDataConTy
  692         Word8ElemRep  -> word8ElemRepDataConTy
  693         Word16ElemRep -> word16ElemRepDataConTy
  694         Word32ElemRep -> word32ElemRepDataConTy
  695         Word64ElemRep -> word64ElemRepDataConTy
  696         FloatElemRep  -> floatElemRepDataConTy
  697         DoubleElemRep -> doubleElemRepDataConTy
  698 
  699 -- | Given a list of types representing 'RuntimeRep's @reps@, construct
  700 -- @'TupleRep' reps@.
  701 mkTupleRep :: [Type] -> Type
  702 mkTupleRep reps = TyConApp tupleRepDataConTyCon [mkPromotedListTy runtimeRepTy reps]
  703 
  704 -- | Convert a list of 'PrimRep's to a 'Type' of kind RuntimeRep
  705 -- Defined here to avoid (more) module loops
  706 primRepsToRuntimeRep :: [PrimRep] -> Type
  707 primRepsToRuntimeRep [rep] = primRepToRuntimeRep rep
  708 primRepsToRuntimeRep reps  = mkTupleRep $ map primRepToRuntimeRep reps
  709 
  710 pcPrimTyCon0 :: Name -> PrimRep -> TyCon
  711 pcPrimTyCon0 name rep
  712   = pcPrimTyCon name [] rep
  713 
  714 charPrimTy :: Type
  715 charPrimTy      = mkTyConTy charPrimTyCon
  716 charPrimTyCon :: TyCon
  717 charPrimTyCon   = pcPrimTyCon0 charPrimTyConName WordRep
  718 
  719 intPrimTy :: Type
  720 intPrimTy       = mkTyConTy intPrimTyCon
  721 intPrimTyCon :: TyCon
  722 intPrimTyCon    = pcPrimTyCon0 intPrimTyConName IntRep
  723 
  724 int8PrimTy :: Type
  725 int8PrimTy     = mkTyConTy int8PrimTyCon
  726 int8PrimTyCon :: TyCon
  727 int8PrimTyCon  = pcPrimTyCon0 int8PrimTyConName Int8Rep
  728 
  729 int16PrimTy :: Type
  730 int16PrimTy    = mkTyConTy int16PrimTyCon
  731 int16PrimTyCon :: TyCon
  732 int16PrimTyCon = pcPrimTyCon0 int16PrimTyConName Int16Rep
  733 
  734 int32PrimTy :: Type
  735 int32PrimTy     = mkTyConTy int32PrimTyCon
  736 int32PrimTyCon :: TyCon
  737 int32PrimTyCon  = pcPrimTyCon0 int32PrimTyConName Int32Rep
  738 
  739 int64PrimTy :: Type
  740 int64PrimTy     = mkTyConTy int64PrimTyCon
  741 int64PrimTyCon :: TyCon
  742 int64PrimTyCon  = pcPrimTyCon0 int64PrimTyConName Int64Rep
  743 
  744 wordPrimTy :: Type
  745 wordPrimTy      = mkTyConTy wordPrimTyCon
  746 wordPrimTyCon :: TyCon
  747 wordPrimTyCon   = pcPrimTyCon0 wordPrimTyConName WordRep
  748 
  749 word8PrimTy :: Type
  750 word8PrimTy     = mkTyConTy word8PrimTyCon
  751 word8PrimTyCon :: TyCon
  752 word8PrimTyCon  = pcPrimTyCon0 word8PrimTyConName Word8Rep
  753 
  754 word16PrimTy :: Type
  755 word16PrimTy    = mkTyConTy word16PrimTyCon
  756 word16PrimTyCon :: TyCon
  757 word16PrimTyCon = pcPrimTyCon0 word16PrimTyConName Word16Rep
  758 
  759 word32PrimTy :: Type
  760 word32PrimTy    = mkTyConTy word32PrimTyCon
  761 word32PrimTyCon :: TyCon
  762 word32PrimTyCon = pcPrimTyCon0 word32PrimTyConName Word32Rep
  763 
  764 word64PrimTy :: Type
  765 word64PrimTy    = mkTyConTy word64PrimTyCon
  766 word64PrimTyCon :: TyCon
  767 word64PrimTyCon = pcPrimTyCon0 word64PrimTyConName Word64Rep
  768 
  769 addrPrimTy :: Type
  770 addrPrimTy      = mkTyConTy addrPrimTyCon
  771 addrPrimTyCon :: TyCon
  772 addrPrimTyCon   = pcPrimTyCon0 addrPrimTyConName AddrRep
  773 
  774 floatPrimTy     :: Type
  775 floatPrimTy     = mkTyConTy floatPrimTyCon
  776 floatPrimTyCon :: TyCon
  777 floatPrimTyCon  = pcPrimTyCon0 floatPrimTyConName FloatRep
  778 
  779 doublePrimTy :: Type
  780 doublePrimTy    = mkTyConTy doublePrimTyCon
  781 doublePrimTyCon :: TyCon
  782 doublePrimTyCon = pcPrimTyCon0 doublePrimTyConName DoubleRep
  783 
  784 {-
  785 ************************************************************************
  786 *                                                                      *
  787    The @State#@ type (and @_RealWorld@ types)
  788 *                                                                      *
  789 ************************************************************************
  790 
  791 Note [The equality types story]
  792 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  793 GHC sports a veritable menagerie of equality types:
  794 
  795          Type or  Lifted?  Hetero?  Role      Built in         Defining module
  796          class?    L/U                        TyCon
  797 -----------------------------------------------------------------------------------------
  798 ~#         T        U      hetero   nominal   eqPrimTyCon      GHC.Prim
  799 ~~         C        L      hetero   nominal   heqTyCon         GHC.Types
  800 ~          C        L      homo     nominal   eqTyCon          GHC.Types
  801 :~:        T        L      homo     nominal   (not built-in)   Data.Type.Equality
  802 :~~:       T        L      hetero   nominal   (not built-in)   Data.Type.Equality
  803 
  804 ~R#        T        U      hetero   repr      eqReprPrimTy     GHC.Prim
  805 Coercible  C        L      homo     repr      coercibleTyCon   GHC.Types
  806 Coercion   T        L      homo     repr      (not built-in)   Data.Type.Coercion
  807 ~P#        T        U      hetero   phantom   eqPhantPrimTyCon GHC.Prim
  808 
  809 Recall that "hetero" means the equality can related types of different
  810 kinds. Knowing that (t1 ~# t2) or (t1 ~R# t2) or even that (t1 ~P# t2)
  811 also means that (k1 ~# k2), where (t1 :: k1) and (t2 :: k2).
  812 
  813 To produce less confusion for end users, when not dumping and without
  814 -fprint-equality-relations, each of these groups is printed as the bottommost
  815 listed equality. That is, (~#) and (~~) are both rendered as (~) in
  816 error messages, and (~R#) is rendered as Coercible.
  817 
  818 Let's take these one at a time:
  819 
  820     --------------------------
  821     (~#) :: forall k1 k2. k1 -> k2 -> TYPE (TupleRep '[])
  822     --------------------------
  823 This is The Type Of Equality in GHC. It classifies nominal coercions.
  824 This type is used in the solver for recording equality constraints.
  825 It responds "yes" to Type.isEqPrimPred and classifies as an EqPred in
  826 Type.classifyPredType.
  827 
  828 All wanted constraints of this type are built with coercion holes.
  829 (See Note [Coercion holes] in GHC.Core.TyCo.Rep.) But see also
  830 Note [Deferred errors for coercion holes] in GHC.Tc.Errors to see how
  831 equality constraints are deferred.
  832 
  833 Within GHC, ~# is called eqPrimTyCon, and it is defined in GHC.Builtin.Types.Prim.
  834 
  835 
  836     --------------------------
  837     (~~) :: forall k1 k2. k1 -> k2 -> Constraint
  838     --------------------------
  839 This is (almost) an ordinary class, defined as if by
  840   class a ~# b => a ~~ b
  841   instance a ~# b => a ~~ b
  842 Here's what's unusual about it:
  843 
  844  * We can't actually declare it that way because we don't have syntax for ~#.
  845    And ~# isn't a constraint, so even if we could write it, it wouldn't kind
  846    check.
  847 
  848  * Users cannot write instances of it.
  849 
  850  * It is "naturally coherent". This means that the solver won't hesitate to
  851    solve a goal of type (a ~~ b) even if there is, say (Int ~~ c) in the
  852    context. (Normally, it waits to learn more, just in case the given
  853    influences what happens next.) See Note [Naturally coherent classes]
  854    in GHC.Tc.Solver.Interact.
  855 
  856  * It always terminates. That is, in the UndecidableInstances checks, we
  857    don't worry if a (~~) constraint is too big, as we know that solving
  858    equality terminates.
  859 
  860 On the other hand, this behaves just like any class w.r.t. eager superclass
  861 unpacking in the solver. So a lifted equality given quickly becomes an unlifted
  862 equality given. This is good, because the solver knows all about unlifted
  863 equalities. There is some special-casing in GHC.Tc.Solver.Interact.matchClassInst to
  864 pretend that there is an instance of this class, as we can't write the instance
  865 in Haskell.
  866 
  867 Within GHC, ~~ is called heqTyCon, and it is defined in GHC.Builtin.Types.
  868 
  869 
  870     --------------------------
  871     (~) :: forall k. k -> k -> Constraint
  872     --------------------------
  873 This is /exactly/ like (~~), except with a homogeneous kind.
  874 It is an almost-ordinary class defined as if by
  875   class a ~# b => (a :: k) ~ (b :: k)
  876   instance a ~# b => a ~ b
  877 
  878  * All the bullets for (~~) apply
  879 
  880  * In addition (~) is magical syntax, as ~ is a reserved symbol.
  881    It cannot be exported or imported.
  882 
  883 Within GHC, ~ is called eqTyCon, and it is defined in GHC.Builtin.Types.
  884 
  885 Historical note: prior to July 18 (~) was defined as a
  886   more-ordinary class with (~~) as a superclass.  But that made it
  887   special in different ways; and the extra superclass selections to
  888   get from (~) to (~#) via (~~) were tiresome.  Now it's defined
  889   uniformly with (~~) and Coercible; much nicer.)
  890 
  891 
  892     --------------------------
  893     (:~:) :: forall k. k -> k -> *
  894     (:~~:) :: forall k1 k2. k1 -> k2 -> *
  895     --------------------------
  896 These are perfectly ordinary GADTs, wrapping (~) and (~~) resp.
  897 They are not defined within GHC at all.
  898 
  899 
  900     --------------------------
  901     (~R#) :: forall k1 k2. k1 -> k2 -> TYPE (TupleRep '[])
  902     --------------------------
  903 The is the representational analogue of ~#. This is the type of representational
  904 equalities that the solver works on. All wanted constraints of this type are
  905 built with coercion holes.
  906 
  907 Within GHC, ~R# is called eqReprPrimTyCon, and it is defined in GHC.Builtin.Types.Prim.
  908 
  909 
  910     --------------------------
  911     Coercible :: forall k. k -> k -> Constraint
  912     --------------------------
  913 This is quite like (~~) in the way it's defined and treated within GHC, but
  914 it's homogeneous. Homogeneity helps with type inference (as GHC can solve one
  915 kind from the other) and, in my (Richard's) estimation, will be more intuitive
  916 for users.
  917 
  918 An alternative design included HCoercible (like (~~)) and Coercible (like (~)).
  919 One annoyance was that we want `coerce :: Coercible a b => a -> b`, and
  920 we need the type of coerce to be fully wired-in. So the HCoercible/Coercible
  921 split required that both types be fully wired-in. Instead of doing this,
  922 I just got rid of HCoercible, as I'm not sure who would use it, anyway.
  923 
  924 Within GHC, Coercible is called coercibleTyCon, and it is defined in
  925 GHC.Builtin.Types.
  926 
  927 
  928     --------------------------
  929     Coercion :: forall k. k -> k -> *
  930     --------------------------
  931 This is a perfectly ordinary GADT, wrapping Coercible. It is not defined
  932 within GHC at all.
  933 
  934 
  935     --------------------------
  936     (~P#) :: forall k1 k2. k1 -> k2 -> TYPE (TupleRep '[])
  937     --------------------------
  938 This is the phantom analogue of ~# and it is barely used at all.
  939 (The solver has no idea about this one.) Here is the motivation:
  940 
  941     data Phant a = MkPhant
  942     type role Phant phantom
  943 
  944     Phant <Int, Bool>_P :: Phant Int ~P# Phant Bool
  945 
  946 We just need to have something to put on that last line. You probably
  947 don't need to worry about it.
  948 
  949 
  950 
  951 Note [The State# TyCon]
  952 ~~~~~~~~~~~~~~~~~~~~~~~
  953 State# is the primitive, unlifted type of states.  It has one type parameter,
  954 thus
  955         State# RealWorld
  956 or
  957         State# s
  958 
  959 where s is a type variable. The only purpose of the type parameter is to
  960 keep different state threads separate.  It is represented by nothing at all.
  961 
  962 The type parameter to State# is intended to keep separate threads separate.
  963 Even though this parameter is not used in the definition of State#, it is
  964 given role Nominal to enforce its intended use.
  965 -}
  966 
  967 mkStatePrimTy :: Type -> Type
  968 mkStatePrimTy ty = TyConApp statePrimTyCon [ty]
  969 
  970 statePrimTyCon :: TyCon   -- See Note [The State# TyCon]
  971 statePrimTyCon   = pcPrimTyCon statePrimTyConName [Nominal] VoidRep
  972 
  973 {-
  974 RealWorld is deeply magical.  It is *primitive*, but it is not
  975 *unlifted* (hence ptrArg).  We never manipulate values of type
  976 RealWorld; it's only used in the type system, to parameterise State#.
  977 -}
  978 
  979 realWorldTyCon :: TyCon
  980 realWorldTyCon = mkLiftedPrimTyCon realWorldTyConName [] liftedTypeKind []
  981 realWorldTy :: Type
  982 realWorldTy          = mkTyConTy realWorldTyCon
  983 realWorldStatePrimTy :: Type
  984 realWorldStatePrimTy = mkStatePrimTy realWorldTy        -- State# RealWorld
  985 
  986 -- Note: the ``state-pairing'' types are not truly primitive,
  987 -- so they are defined in \tr{GHC.Builtin.Types}, not here.
  988 
  989 
  990 mkProxyPrimTy :: Type -> Type -> Type
  991 mkProxyPrimTy k ty = TyConApp proxyPrimTyCon [k, ty]
  992 
  993 proxyPrimTyCon :: TyCon
  994 proxyPrimTyCon = mkPrimTyCon proxyPrimTyConName binders res_kind [Nominal,Phantom]
  995   where
  996      -- Kind: forall k. k -> TYPE (TupleRep '[])
  997      binders = mkTemplateTyConBinders [liftedTypeKind] id
  998      res_kind = unboxedTupleKind []
  999 
 1000 
 1001 {- *********************************************************************
 1002 *                                                                      *
 1003                 Primitive equality constraints
 1004     See Note [The equality types story]
 1005 *                                                                      *
 1006 ********************************************************************* -}
 1007 
 1008 eqPrimTyCon :: TyCon  -- The representation type for equality predicates
 1009                       -- See Note [The equality types story]
 1010 eqPrimTyCon  = mkPrimTyCon eqPrimTyConName binders res_kind roles
 1011   where
 1012     -- Kind :: forall k1 k2. k1 -> k2 -> TYPE (TupleRep '[])
 1013     binders  = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] id
 1014     res_kind = unboxedTupleKind []
 1015     roles    = [Nominal, Nominal, Nominal, Nominal]
 1016 
 1017 -- like eqPrimTyCon, but the type for *Representational* coercions
 1018 -- this should only ever appear as the type of a covar. Its role is
 1019 -- interpreted in coercionRole
 1020 eqReprPrimTyCon :: TyCon   -- See Note [The equality types story]
 1021 eqReprPrimTyCon = mkPrimTyCon eqReprPrimTyConName binders res_kind roles
 1022   where
 1023     -- Kind :: forall k1 k2. k1 -> k2 -> TYPE (TupleRep '[])
 1024     binders  = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] id
 1025     res_kind = unboxedTupleKind []
 1026     roles    = [Nominal, Nominal, Representational, Representational]
 1027 
 1028 -- like eqPrimTyCon, but the type for *Phantom* coercions.
 1029 -- This is only used to make higher-order equalities. Nothing
 1030 -- should ever actually have this type!
 1031 eqPhantPrimTyCon :: TyCon
 1032 eqPhantPrimTyCon = mkPrimTyCon eqPhantPrimTyConName binders res_kind roles
 1033   where
 1034     -- Kind :: forall k1 k2. k1 -> k2 -> TYPE (TupleRep '[])
 1035     binders  = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] id
 1036     res_kind = unboxedTupleKind []
 1037     roles    = [Nominal, Nominal, Phantom, Phantom]
 1038 
 1039 -- | Given a Role, what TyCon is the type of equality predicates at that role?
 1040 equalityTyCon :: Role -> TyCon
 1041 equalityTyCon Nominal          = eqPrimTyCon
 1042 equalityTyCon Representational = eqReprPrimTyCon
 1043 equalityTyCon Phantom          = eqPhantPrimTyCon
 1044 
 1045 {- *********************************************************************
 1046 *                                                                      *
 1047                  The Concrete mechanism
 1048 *                                                                      *
 1049 ********************************************************************* -}
 1050 
 1051 -- See Note [The Concrete mechanism] in GHC.Tc.Utils.Concrete.
 1052 
 1053 -- type Concrete# :: forall k. k -> TYPE (TupleRep '[])
 1054 
 1055 concretePrimTyCon :: TyCon
 1056 concretePrimTyCon =
 1057   mkPrimTyCon concretePrimTyConName binders res_kind roles
 1058     where
 1059       -- Kind :: forall k. k -> TYPE (TupleRep '[])
 1060       binders = mkTemplateTyConBinders [liftedTypeKind] (\[k] -> [k])
 1061       res_kind = unboxedTupleKind []
 1062       roles   = [Nominal, Nominal]
 1063 
 1064 {- *********************************************************************
 1065 *                                                                      *
 1066              The primitive array types
 1067 *                                                                      *
 1068 ********************************************************************* -}
 1069 
 1070 arrayPrimTyCon, mutableArrayPrimTyCon, mutableByteArrayPrimTyCon,
 1071     byteArrayPrimTyCon, arrayArrayPrimTyCon, mutableArrayArrayPrimTyCon,
 1072     smallArrayPrimTyCon, smallMutableArrayPrimTyCon :: TyCon
 1073 arrayPrimTyCon             = pcPrimTyCon arrayPrimTyConName             [Representational] UnliftedRep
 1074 mutableArrayPrimTyCon      = pcPrimTyCon  mutableArrayPrimTyConName     [Nominal, Representational] UnliftedRep
 1075 mutableByteArrayPrimTyCon  = pcPrimTyCon mutableByteArrayPrimTyConName  [Nominal] UnliftedRep
 1076 byteArrayPrimTyCon         = pcPrimTyCon0 byteArrayPrimTyConName        UnliftedRep
 1077 arrayArrayPrimTyCon        = pcPrimTyCon0 arrayArrayPrimTyConName       UnliftedRep
 1078 mutableArrayArrayPrimTyCon = pcPrimTyCon mutableArrayArrayPrimTyConName [Nominal] UnliftedRep
 1079 smallArrayPrimTyCon        = pcPrimTyCon smallArrayPrimTyConName        [Representational] UnliftedRep
 1080 smallMutableArrayPrimTyCon = pcPrimTyCon smallMutableArrayPrimTyConName [Nominal, Representational] UnliftedRep
 1081 
 1082 mkArrayPrimTy :: Type -> Type
 1083 mkArrayPrimTy elt           = TyConApp arrayPrimTyCon [elt]
 1084 byteArrayPrimTy :: Type
 1085 byteArrayPrimTy             = mkTyConTy byteArrayPrimTyCon
 1086 mkArrayArrayPrimTy :: Type
 1087 mkArrayArrayPrimTy = mkTyConTy arrayArrayPrimTyCon
 1088 mkSmallArrayPrimTy :: Type -> Type
 1089 mkSmallArrayPrimTy elt = TyConApp smallArrayPrimTyCon [elt]
 1090 mkMutableArrayPrimTy :: Type -> Type -> Type
 1091 mkMutableArrayPrimTy s elt  = TyConApp mutableArrayPrimTyCon [s, elt]
 1092 mkMutableByteArrayPrimTy :: Type -> Type
 1093 mkMutableByteArrayPrimTy s  = TyConApp mutableByteArrayPrimTyCon [s]
 1094 mkMutableArrayArrayPrimTy :: Type -> Type
 1095 mkMutableArrayArrayPrimTy s = TyConApp mutableArrayArrayPrimTyCon [s]
 1096 mkSmallMutableArrayPrimTy :: Type -> Type -> Type
 1097 mkSmallMutableArrayPrimTy s elt = TyConApp smallMutableArrayPrimTyCon [s, elt]
 1098 
 1099 
 1100 {- *********************************************************************
 1101 *                                                                      *
 1102                 The mutable variable type
 1103 *                                                                      *
 1104 ********************************************************************* -}
 1105 
 1106 mutVarPrimTyCon :: TyCon
 1107 mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConName [Nominal, Representational] UnliftedRep
 1108 
 1109 mkMutVarPrimTy :: Type -> Type -> Type
 1110 mkMutVarPrimTy s elt        = TyConApp mutVarPrimTyCon [s, elt]
 1111 
 1112 {-
 1113 ************************************************************************
 1114 *                                                                      *
 1115 \subsection[TysPrim-io-port-var]{The synchronizing I/O Port type}
 1116 *                                                                      *
 1117 ************************************************************************
 1118 -}
 1119 
 1120 ioPortPrimTyCon :: TyCon
 1121 ioPortPrimTyCon = pcPrimTyCon ioPortPrimTyConName [Nominal, Representational] UnliftedRep
 1122 
 1123 mkIOPortPrimTy :: Type -> Type -> Type
 1124 mkIOPortPrimTy s elt          = TyConApp ioPortPrimTyCon [s, elt]
 1125 
 1126 {-
 1127 ************************************************************************
 1128 *                                                                      *
 1129    The synchronizing variable type
 1130 \subsection[TysPrim-synch-var]{The synchronizing variable type}
 1131 *                                                                      *
 1132 ************************************************************************
 1133 -}
 1134 
 1135 mVarPrimTyCon :: TyCon
 1136 mVarPrimTyCon = pcPrimTyCon mVarPrimTyConName [Nominal, Representational] UnliftedRep
 1137 
 1138 mkMVarPrimTy :: Type -> Type -> Type
 1139 mkMVarPrimTy s elt          = TyConApp mVarPrimTyCon [s, elt]
 1140 
 1141 {-
 1142 ************************************************************************
 1143 *                                                                      *
 1144    The transactional variable type
 1145 *                                                                      *
 1146 ************************************************************************
 1147 -}
 1148 
 1149 tVarPrimTyCon :: TyCon
 1150 tVarPrimTyCon = pcPrimTyCon tVarPrimTyConName [Nominal, Representational] UnliftedRep
 1151 
 1152 mkTVarPrimTy :: Type -> Type -> Type
 1153 mkTVarPrimTy s elt = TyConApp tVarPrimTyCon [s, elt]
 1154 
 1155 {-
 1156 ************************************************************************
 1157 *                                                                      *
 1158    The stable-pointer type
 1159 *                                                                      *
 1160 ************************************************************************
 1161 -}
 1162 
 1163 stablePtrPrimTyCon :: TyCon
 1164 stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConName [Representational] AddrRep
 1165 
 1166 mkStablePtrPrimTy :: Type -> Type
 1167 mkStablePtrPrimTy ty = TyConApp stablePtrPrimTyCon [ty]
 1168 
 1169 {-
 1170 ************************************************************************
 1171 *                                                                      *
 1172    The stable-name type
 1173 *                                                                      *
 1174 ************************************************************************
 1175 -}
 1176 
 1177 stableNamePrimTyCon :: TyCon
 1178 stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConName [Phantom] UnliftedRep
 1179 
 1180 mkStableNamePrimTy :: Type -> Type
 1181 mkStableNamePrimTy ty = TyConApp stableNamePrimTyCon [ty]
 1182 
 1183 {-
 1184 ************************************************************************
 1185 *                                                                      *
 1186    The Compact NFData (CNF) type
 1187 *                                                                      *
 1188 ************************************************************************
 1189 -}
 1190 
 1191 compactPrimTyCon :: TyCon
 1192 compactPrimTyCon = pcPrimTyCon0 compactPrimTyConName UnliftedRep
 1193 
 1194 compactPrimTy :: Type
 1195 compactPrimTy = mkTyConTy compactPrimTyCon
 1196 
 1197 {-
 1198 ************************************************************************
 1199 *                                                                      *
 1200    The @StackSnapshot#@ type
 1201 *                                                                      *
 1202 ************************************************************************
 1203 -}
 1204 
 1205 stackSnapshotPrimTyCon :: TyCon
 1206 stackSnapshotPrimTyCon = pcPrimTyCon0 stackSnapshotPrimTyConName UnliftedRep
 1207 
 1208 stackSnapshotPrimTy :: Type
 1209 stackSnapshotPrimTy = mkTyConTy stackSnapshotPrimTyCon
 1210 
 1211 
 1212 {-
 1213 ************************************************************************
 1214 *                                                                      *
 1215    The ``bytecode object'' type
 1216 *                                                                      *
 1217 ************************************************************************
 1218 -}
 1219 
 1220 -- Unlike most other primitive types, BCO is lifted. This is because in
 1221 -- general a BCO may be a thunk for the reasons given in Note [Updatable CAF
 1222 -- BCOs] in GHCi.CreateBCO.
 1223 bcoPrimTy    :: Type
 1224 bcoPrimTy    = mkTyConTy bcoPrimTyCon
 1225 bcoPrimTyCon :: TyCon
 1226 bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName LiftedRep
 1227 
 1228 {-
 1229 ************************************************************************
 1230 *                                                                      *
 1231    The ``weak pointer'' type
 1232 *                                                                      *
 1233 ************************************************************************
 1234 -}
 1235 
 1236 weakPrimTyCon :: TyCon
 1237 weakPrimTyCon = pcPrimTyCon weakPrimTyConName [Representational] UnliftedRep
 1238 
 1239 mkWeakPrimTy :: Type -> Type
 1240 mkWeakPrimTy v = TyConApp weakPrimTyCon [v]
 1241 
 1242 {-
 1243 ************************************************************************
 1244 *                                                                      *
 1245    The ``thread id'' type
 1246 *                                                                      *
 1247 ************************************************************************
 1248 
 1249 A thread id is represented by a pointer to the TSO itself, to ensure
 1250 that they are always unique and we can always find the TSO for a given
 1251 thread id.  However, this has the unfortunate consequence that a
 1252 ThreadId# for a given thread is treated as a root by the garbage
 1253 collector and can keep TSOs around for too long.
 1254 
 1255 Hence the programmer API for thread manipulation uses a weak pointer
 1256 to the thread id internally.
 1257 -}
 1258 
 1259 threadIdPrimTy :: Type
 1260 threadIdPrimTy    = mkTyConTy threadIdPrimTyCon
 1261 threadIdPrimTyCon :: TyCon
 1262 threadIdPrimTyCon = pcPrimTyCon0 threadIdPrimTyConName UnliftedRep
 1263 
 1264 {-
 1265 ************************************************************************
 1266 *                                                                      *
 1267 \subsection{SIMD vector types}
 1268 *                                                                      *
 1269 ************************************************************************
 1270 -}
 1271 
 1272 #include "primop-vector-tys.hs-incl"