{-
(c) The GRASP Project, Glasgow University, 1994-1998

Wired-in knowledge about {\em non-primitive} types
-}

{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

-- | This module is about types that can be defined in Haskell, but which
--   must be wired into the compiler nonetheless.  C.f module "GHC.Builtin.Types.Prim"
module GHC.Builtin.Types (
        -- * Helper functions defined here
        mkWiredInTyConName, -- This is used in GHC.Builtin.Types.Literals to define the
                            -- built-in functions for evaluation.

        mkWiredInIdName,    -- used in GHC.Types.Id.Make

        -- * All wired in things
        wiredInTyCons, isBuiltInOcc_maybe,

        -- * Bool
        boolTy, boolTyCon, boolTyCon_RDR, boolTyConName,
        trueDataCon,  trueDataConId,  true_RDR,
        falseDataCon, falseDataConId, false_RDR,
        promotedFalseDataCon, promotedTrueDataCon,

        -- * Ordering
        orderingTyCon,
        ordLTDataCon, ordLTDataConId,
        ordEQDataCon, ordEQDataConId,
        ordGTDataCon, ordGTDataConId,
        promotedLTDataCon, promotedEQDataCon, promotedGTDataCon,

        -- * Boxing primitive types
        boxingDataCon_maybe,

        -- * Char
        charTyCon, charDataCon, charTyCon_RDR,
        charTy, stringTy, charTyConName, stringTyCon_RDR,

        -- * Double
        doubleTyCon, doubleDataCon, doubleTy, doubleTyConName,

        -- * Float
        floatTyCon, floatDataCon, floatTy, floatTyConName,

        -- * Int
        intTyCon, intDataCon, intTyCon_RDR, intDataCon_RDR, intTyConName,
        intTy,

        -- * Word
        wordTyCon, wordDataCon, wordTyConName, wordTy,

        -- * Word8
        word8TyCon, word8DataCon, word8TyConName, word8Ty,

        -- * List
        listTyCon, listTyCon_RDR, listTyConName, listTyConKey,
        nilDataCon, nilDataConName, nilDataConKey,
        consDataCon_RDR, consDataCon, consDataConName,
        promotedNilDataCon, promotedConsDataCon,
        mkListTy, mkPromotedListTy,

        -- * Maybe
        maybeTyCon, maybeTyConName,
        nothingDataCon, nothingDataConName, promotedNothingDataCon,
        justDataCon, justDataConName, promotedJustDataCon,

        -- * Tuples
        mkTupleTy, mkTupleTy1, mkBoxedTupleTy, mkTupleStr,
        tupleTyCon, tupleDataCon, tupleTyConName, tupleDataConName,
        promotedTupleDataCon,
        unitTyCon, unitDataCon, unitDataConId, unitTy, unitTyConKey,
        pairTyCon,
        unboxedUnitTyCon, unboxedUnitDataCon,
        unboxedTupleKind, unboxedSumKind,

        -- ** Constraint tuples
        cTupleTyConName, cTupleTyConNames, isCTupleTyConName,
        cTupleTyConNameArity_maybe,
        cTupleDataConName, cTupleDataConNames,

        -- * Any
        anyTyCon, anyTy, anyTypeOfKind,

        -- * Recovery TyCon
        makeRecoveryTyCon,

        -- * Sums
        mkSumTy, sumTyCon, sumDataCon,

        -- * Kinds
        typeNatKindCon, typeNatKind, typeSymbolKindCon, typeSymbolKind,
        isLiftedTypeKindTyConName, liftedTypeKind,
        typeToTypeKind, constraintKind,
        liftedTypeKindTyCon, constraintKindTyCon,  constraintKindTyConName,
        liftedTypeKindTyConName,

        -- * Equality predicates
        heqTyCon, heqTyConName, heqClass, heqDataCon,
        eqTyCon, eqTyConName, eqClass, eqDataCon, eqTyCon_RDR,
        coercibleTyCon, coercibleTyConName, coercibleDataCon, coercibleClass,

        -- * RuntimeRep and friends
        runtimeRepTyCon, vecCountTyCon, vecElemTyCon,

        runtimeRepTy, liftedRepTy, liftedRepDataCon, liftedRepDataConTyCon,

        vecRepDataConTyCon, tupleRepDataConTyCon, sumRepDataConTyCon,

        liftedRepDataConTy, unliftedRepDataConTy,
        intRepDataConTy,
        int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy,
        wordRepDataConTy,
        word8RepDataConTy, word16RepDataConTy, word32RepDataConTy, word64RepDataConTy,
        addrRepDataConTy,
        floatRepDataConTy, doubleRepDataConTy,

        vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy,
        vec64DataConTy,

        int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy,
        int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy,
        word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy,

        doubleElemRepDataConTy,

        -- * Multiplicity and friends
        multiplicityTyConName, oneDataConName, manyDataConName, multiplicityTy,
        multiplicityTyCon, oneDataCon, manyDataCon, oneDataConTy, manyDataConTy,
        oneDataConTyCon, manyDataConTyCon,
        multMulTyCon,

        unrestrictedFunTyCon, unrestrictedFunTyConName,

        -- * Bignum
        integerTy, integerTyCon, integerTyConName,
        integerISDataCon, integerISDataConName,
        integerIPDataCon, integerIPDataConName,
        integerINDataCon, integerINDataConName,
        naturalTy, naturalTyCon, naturalTyConName,
        naturalNSDataCon, naturalNSDataConName,
        naturalNBDataCon, naturalNBDataConName

    ) where

#include "HsVersions.h"

import GHC.Prelude

import {-# SOURCE #-} GHC.Types.Id.Make ( mkDataConWorkId, mkDictSelId )

-- friends:
import GHC.Builtin.Names
import GHC.Builtin.Types.Prim
import {-# SOURCE #-} GHC.Builtin.Uniques

-- others:
import GHC.Core.Coercion.Axiom
import GHC.Types.Id
import GHC.Types.Var (VarBndr (Bndr))
import GHC.Settings.Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE )
import GHC.Unit.Module        ( Module )
import GHC.Core.Type
import GHC.Types.RepType
import GHC.Core.DataCon
import {-# SOURCE #-} GHC.Core.ConLike
import GHC.Core.TyCon
import GHC.Core.Class     ( Class, mkClass )
import GHC.Types.Name.Reader
import GHC.Types.Name as Name
import GHC.Types.Name.Env ( NameEnv, mkNameEnv, lookupNameEnv, lookupNameEnv_NF )
import GHC.Types.Name.Set ( NameSet, mkNameSet, elemNameSet )
import GHC.Types.Basic
import GHC.Types.ForeignCall
import GHC.Types.SrcLoc   ( noSrcSpan )
import GHC.Types.Unique
import Data.Array
import GHC.Data.FastString
import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Data.BooleanFormula ( mkAnd )

import qualified Data.ByteString.Char8 as BS

import Data.List        ( elemIndex )

alpha_tyvar :: [TyVar]
alpha_tyvar :: [TyVar]
alpha_tyvar = [TyVar
alphaTyVar]

alpha_ty :: [Type]
alpha_ty :: [Type]
alpha_ty = [Type
alphaTy]

{-
Note [Wiring in RuntimeRep]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
The RuntimeRep type (and friends) in GHC.Types has a bunch of constructors,
making it a pain to wire in. To ease the pain somewhat, we use lists of
the different bits, like Uniques, Names, DataCons. These lists must be
kept in sync with each other. The rule is this: use the order as declared
in GHC.Types. All places where such lists exist should contain a reference
to this Note, so a search for this Note's name should find all the lists.

See also Note [Getting from RuntimeRep to PrimRep] in GHC.Types.RepType.

************************************************************************
*                                                                      *
\subsection{Wired in type constructors}
*                                                                      *
************************************************************************

If you change which things are wired in, make sure you change their
names in GHC.Builtin.Names, so they use wTcQual, wDataQual, etc
-}

-- This list is used only to define GHC.Builtin.Utils.wiredInThings. That in turn
-- is used to initialise the name environment carried around by the renamer.
-- This means that if we look up the name of a TyCon (or its implicit binders)
-- that occurs in this list that name will be assigned the wired-in key we
-- define here.
--
-- Because of their infinite nature, this list excludes
--   * tuples, including boxed, unboxed and constraint tuples
---       (mkTupleTyCon, unitTyCon, pairTyCon)
--   * unboxed sums (sumTyCon)
-- See Note [Infinite families of known-key names] in GHC.Builtin.Names
--
-- See also Note [Known-key names]
wiredInTyCons :: [TyCon]

wiredInTyCons :: [TyCon]
wiredInTyCons = [ -- Units are not treated like other tuples, because they
                  -- are defined in GHC.Base, and there's only a few of them. We
                  -- put them in wiredInTyCons so that they will pre-populate
                  -- the name cache, so the parser in isBuiltInOcc_maybe doesn't
                  -- need to look out for them.
                  TyCon
unitTyCon
                , TyCon
unboxedUnitTyCon
                , TyCon
anyTyCon
                , TyCon
boolTyCon
                , TyCon
charTyCon
                , TyCon
stringTyCon
                , TyCon
doubleTyCon
                , TyCon
floatTyCon
                , TyCon
intTyCon
                , TyCon
wordTyCon
                , TyCon
word8TyCon
                , TyCon
listTyCon
                , TyCon
orderingTyCon
                , TyCon
maybeTyCon
                , TyCon
heqTyCon
                , TyCon
eqTyCon
                , TyCon
coercibleTyCon
                , TyCon
typeNatKindCon
                , TyCon
typeSymbolKindCon
                , TyCon
runtimeRepTyCon
                , TyCon
vecCountTyCon
                , TyCon
vecElemTyCon
                , TyCon
constraintKindTyCon
                , TyCon
liftedTypeKindTyCon
                , TyCon
multiplicityTyCon
                , TyCon
naturalTyCon
                , TyCon
integerTyCon
                ]

mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
built_in Module
modu FastString
fs Unique
unique TyCon
tycon
  = Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
mkWiredInName Module
modu (FastString -> OccName
mkTcOccFS FastString
fs) Unique
unique
                  (TyCon -> TyThing
ATyCon TyCon
tycon)        -- Relevant TyCon
                  BuiltInSyntax
built_in

mkWiredInDataConName :: BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName :: BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
built_in Module
modu FastString
fs Unique
unique DataCon
datacon
  = Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
mkWiredInName Module
modu (FastString -> OccName
mkDataOccFS FastString
fs) Unique
unique
                  (ConLike -> TyThing
AConLike (DataCon -> ConLike
RealDataCon DataCon
datacon))    -- Relevant DataCon
                  BuiltInSyntax
built_in

mkWiredInIdName :: Module -> FastString -> Unique -> Id -> Name
mkWiredInIdName :: Module -> FastString -> Unique -> TyVar -> Name
mkWiredInIdName Module
mod FastString
fs Unique
uniq TyVar
id
 = Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
mkWiredInName Module
mod (NameSpace -> FastString -> OccName
mkOccNameFS NameSpace
Name.varName FastString
fs) Unique
uniq (TyVar -> TyThing
AnId TyVar
id) BuiltInSyntax
UserSyntax

-- See Note [Kind-changing of (~) and Coercible]
-- in libraries/ghc-prim/GHC/Types.hs
eqTyConName, eqDataConName, eqSCSelIdName :: Name
eqTyConName :: Name
eqTyConName   = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName   BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"~")   Unique
eqTyConKey   TyCon
eqTyCon
eqDataConName :: Name
eqDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Eq#") Unique
eqDataConKey DataCon
eqDataCon
eqSCSelIdName :: Name
eqSCSelIdName = Module -> FastString -> Unique -> TyVar -> Name
mkWiredInIdName Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"eq_sel") Unique
eqSCSelIdKey TyVar
eqSCSelId

{- Note [eqTyCon (~) is built-in syntax]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The (~) type operator used in equality constraints (a~b) is considered built-in
syntax. This has a few consequences:

* The user is not allowed to define their own type constructors with this name:

    ghci> class a ~ b
    <interactive>:1:1: error: Illegal binding of built-in syntax: ~

* Writing (a ~ b) does not require enabling -XTypeOperators. It does, however,
  require -XGADTs or -XTypeFamilies.

* The (~) type operator is always in scope. It doesn't need to be imported,
  and it cannot be hidden.

* We have a bunch of special cases in the compiler to arrange all of the above.

There's no particular reason for (~) to be special, but fixing this would be a
breaking change.
-}
eqTyCon_RDR :: RdrName
eqTyCon_RDR :: RdrName
eqTyCon_RDR = Name -> RdrName
nameRdrName Name
eqTyConName

-- See Note [Kind-changing of (~) and Coercible]
-- in libraries/ghc-prim/GHC/Types.hs
heqTyConName, heqDataConName, heqSCSelIdName :: Name
heqTyConName :: Name
heqTyConName   = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName   BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"~~")   Unique
heqTyConKey      TyCon
heqTyCon
heqDataConName :: Name
heqDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"HEq#") Unique
heqDataConKey DataCon
heqDataCon
heqSCSelIdName :: Name
heqSCSelIdName = Module -> FastString -> Unique -> TyVar -> Name
mkWiredInIdName Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"heq_sel") Unique
heqSCSelIdKey TyVar
heqSCSelId

-- See Note [Kind-changing of (~) and Coercible] in libraries/ghc-prim/GHC/Types.hs
coercibleTyConName, coercibleDataConName, coercibleSCSelIdName :: Name
coercibleTyConName :: Name
coercibleTyConName   = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName   BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Coercible")  Unique
coercibleTyConKey   TyCon
coercibleTyCon
coercibleDataConName :: Name
coercibleDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"MkCoercible") Unique
coercibleDataConKey DataCon
coercibleDataCon
coercibleSCSelIdName :: Name
coercibleSCSelIdName = Module -> FastString -> Unique -> TyVar -> Name
mkWiredInIdName Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"coercible_sel") Unique
coercibleSCSelIdKey TyVar
coercibleSCSelId

charTyConName, charDataConName, intTyConName, intDataConName, stringTyConName :: Name
charTyConName :: Name
charTyConName     = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName   BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Char")   Unique
charTyConKey TyCon
charTyCon
charDataConName :: Name
charDataConName   = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"C#")     Unique
charDataConKey DataCon
charDataCon
stringTyConName :: Name
stringTyConName   = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName   BuiltInSyntax
UserSyntax Module
gHC_BASE  ([Char] -> FastString
fsLit [Char]
"String") Unique
stringTyConKey TyCon
stringTyCon
intTyConName :: Name
intTyConName      = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName   BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Int")    Unique
intTyConKey   TyCon
intTyCon
intDataConName :: Name
intDataConName    = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"I#")     Unique
intDataConKey  DataCon
intDataCon

boolTyConName, falseDataConName, trueDataConName :: Name
boolTyConName :: Name
boolTyConName     = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName   BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Bool") Unique
boolTyConKey TyCon
boolTyCon
falseDataConName :: Name
falseDataConName  = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"False") Unique
falseDataConKey DataCon
falseDataCon
trueDataConName :: Name
trueDataConName   = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"True")  Unique
trueDataConKey  DataCon
trueDataCon

listTyConName, nilDataConName, consDataConName :: Name
listTyConName :: Name
listTyConName     = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName   BuiltInSyntax
BuiltInSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"[]") Unique
listTyConKey TyCon
listTyCon
nilDataConName :: Name
nilDataConName    = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
BuiltInSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"[]") Unique
nilDataConKey DataCon
nilDataCon
consDataConName :: Name
consDataConName   = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
BuiltInSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
":") Unique
consDataConKey DataCon
consDataCon

maybeTyConName, nothingDataConName, justDataConName :: Name
maybeTyConName :: Name
maybeTyConName     = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName   BuiltInSyntax
UserSyntax Module
gHC_MAYBE ([Char] -> FastString
fsLit [Char]
"Maybe")
                                          Unique
maybeTyConKey TyCon
maybeTyCon
nothingDataConName :: Name
nothingDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_MAYBE ([Char] -> FastString
fsLit [Char]
"Nothing")
                                          Unique
nothingDataConKey DataCon
nothingDataCon
justDataConName :: Name
justDataConName    = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_MAYBE ([Char] -> FastString
fsLit [Char]
"Just")
                                          Unique
justDataConKey DataCon
justDataCon

wordTyConName, wordDataConName, word8TyConName, word8DataConName :: Name
wordTyConName :: Name
wordTyConName      = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName   BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Word")   Unique
wordTyConKey     TyCon
wordTyCon
wordDataConName :: Name
wordDataConName    = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"W#")     Unique
wordDataConKey   DataCon
wordDataCon
word8TyConName :: Name
word8TyConName     = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName   BuiltInSyntax
UserSyntax Module
gHC_WORD  ([Char] -> FastString
fsLit [Char]
"Word8")  Unique
word8TyConKey    TyCon
word8TyCon
word8DataConName :: Name
word8DataConName   = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_WORD  ([Char] -> FastString
fsLit [Char]
"W8#")    Unique
word8DataConKey  DataCon
word8DataCon

floatTyConName, floatDataConName, doubleTyConName, doubleDataConName :: Name
floatTyConName :: Name
floatTyConName     = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName   BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Float")  Unique
floatTyConKey    TyCon
floatTyCon
floatDataConName :: Name
floatDataConName   = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"F#")     Unique
floatDataConKey  DataCon
floatDataCon
doubleTyConName :: Name
doubleTyConName    = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName   BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Double") Unique
doubleTyConKey   TyCon
doubleTyCon
doubleDataConName :: Name
doubleDataConName  = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"D#")     Unique
doubleDataConKey DataCon
doubleDataCon

-- Any

{-
Note [Any types]
~~~~~~~~~~~~~~~~
The type constructor Any,

    type family Any :: k where { }

It has these properties:

  * Note that 'Any' is kind polymorphic since in some program we may
    need to use Any to fill in a type variable of some kind other than *
    (see #959 for examples).  Its kind is thus `forall k. k``.

  * It is defined in module GHC.Types, and exported so that it is
    available to users.  For this reason it's treated like any other
    wired-in type:
      - has a fixed unique, anyTyConKey,
      - lives in the global name cache

  * It is a *closed* type family, with no instances.  This means that
    if   ty :: '(k1, k2)  we add a given coercion
             g :: ty ~ (Fst ty, Snd ty)
    If Any was a *data* type, then we'd get inconsistency because 'ty'
    could be (Any '(k1,k2)) and then we'd have an equality with Any on
    one side and '(,) on the other. See also #9097 and #9636.

  * When instantiated at a lifted type it is inhabited by at least one value,
    namely bottom

  * You can safely coerce any /lifted/ type to Any, and back with unsafeCoerce.

  * It does not claim to be a *data* type, and that's important for
    the code generator, because the code gen may *enter* a data value
    but never enters a function value.

  * It is wired-in so we can easily refer to it where we don't have a name
    environment (e.g. see Rules.matchRule for one example)

  * If (Any k) is the type of a value, it must be a /lifted/ value. So
    if we have (Any @(TYPE rr)) then rr must be 'LiftedRep.  See
    Note [TYPE and RuntimeRep] in GHC.Builtin.Types.Prim.  This is a convenient
    invariant, and makes isUnliftedTyCon well-defined; otherwise what
    would (isUnliftedTyCon Any) be?

It's used to instantiate un-constrained type variables after type checking. For
example, 'length' has type

  length :: forall a. [a] -> Int

and the list datacon for the empty list has type

  [] :: forall a. [a]

In order to compose these two terms as @length []@ a type
application is required, but there is no constraint on the
choice.  In this situation GHC uses 'Any',

> length (Any *) ([] (Any *))

Above, we print kinds explicitly, as if with --fprint-explicit-kinds.

The Any tycon used to be quite magic, but we have since been able to
implement it merely with an empty kind polymorphic type family. See #10886 for a
bit of history.
-}


anyTyConName :: Name
anyTyConName :: Name
anyTyConName =
    BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Any") Unique
anyTyConKey TyCon
anyTyCon

anyTyCon :: TyCon
anyTyCon :: TyCon
anyTyCon = Name
-> [TyConBinder]
-> Type
-> Maybe Name
-> FamTyConFlav
-> Maybe Class
-> Injectivity
-> TyCon
mkFamilyTyCon Name
anyTyConName [TyConBinder]
binders Type
res_kind Maybe Name
forall a. Maybe a
Nothing
                         (Maybe (CoAxiom Branched) -> FamTyConFlav
ClosedSynFamilyTyCon Maybe (CoAxiom Branched)
forall a. Maybe a
Nothing)
                         Maybe Class
forall a. Maybe a
Nothing
                         Injectivity
NotInjective
  where
    binders :: [TyConBinder]
binders@[TyConBinder
kv] = [Type] -> [TyConBinder]
mkTemplateKindTyConBinders [Type
liftedTypeKind]
    res_kind :: Type
res_kind = TyVar -> Type
mkTyVarTy (TyConBinder -> TyVar
forall tv argf. VarBndr tv argf -> tv
binderVar TyConBinder
kv)

anyTy :: Type
anyTy :: Type
anyTy = TyCon -> Type
mkTyConTy TyCon
anyTyCon

anyTypeOfKind :: Kind -> Type
anyTypeOfKind :: Type -> Type
anyTypeOfKind Type
kind = TyCon -> [Type] -> Type
mkTyConApp TyCon
anyTyCon [Type
kind]

-- | Make a fake, recovery 'TyCon' from an existing one.
-- Used when recovering from errors in type declarations
makeRecoveryTyCon :: TyCon -> TyCon
makeRecoveryTyCon :: TyCon -> TyCon
makeRecoveryTyCon TyCon
tc
  = Name
-> [TyConBinder]
-> Type
-> [(Name, TyVar)]
-> Bool
-> TyConFlavour
-> TyCon
mkTcTyCon (TyCon -> Name
tyConName TyCon
tc)
              [TyConBinder]
bndrs Type
res_kind
              [(Name, TyVar)]
noTcTyConScopedTyVars
              Bool
True             -- Fully generalised
              TyConFlavour
flavour          -- Keep old flavour
  where
    flavour :: TyConFlavour
flavour = TyCon -> TyConFlavour
tyConFlavour TyCon
tc
    [TyVar
kv] = [Type] -> [TyVar]
mkTemplateKindVars [Type
liftedTypeKind]
    ([TyConBinder]
bndrs, Type
res_kind)
       = case TyConFlavour
flavour of
           TyConFlavour
PromotedDataConFlavour -> ([ArgFlag -> TyVar -> TyConBinder
mkNamedTyConBinder ArgFlag
Inferred TyVar
kv], TyVar -> Type
mkTyVarTy TyVar
kv)
           TyConFlavour
_ -> (TyCon -> [TyConBinder]
tyConBinders TyCon
tc, TyCon -> Type
tyConResKind TyCon
tc)
        -- For data types we have already validated their kind, so it
        -- makes sense to keep it. For promoted data constructors we haven't,
        -- so we recover with kind (forall k. k).  Otherwise consider
        --     data T a where { MkT :: Show a => T a }
        -- If T is for some reason invalid, we don't want to fall over
        -- at (promoted) use-sites of MkT.

-- Kinds
typeNatKindConName, typeSymbolKindConName :: Name
typeNatKindConName :: Name
typeNatKindConName    = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Nat")    Unique
typeNatKindConNameKey    TyCon
typeNatKindCon
typeSymbolKindConName :: Name
typeSymbolKindConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Symbol") Unique
typeSymbolKindConNameKey TyCon
typeSymbolKindCon

constraintKindTyConName :: Name
constraintKindTyConName :: Name
constraintKindTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Constraint") Unique
constraintKindTyConKey   TyCon
constraintKindTyCon

liftedTypeKindTyConName :: Name
liftedTypeKindTyConName :: Name
liftedTypeKindTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Type") Unique
liftedTypeKindTyConKey TyCon
liftedTypeKindTyCon

multiplicityTyConName :: Name
multiplicityTyConName :: Name
multiplicityTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Multiplicity")
                          Unique
multiplicityTyConKey TyCon
multiplicityTyCon

oneDataConName, manyDataConName :: Name
oneDataConName :: Name
oneDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
BuiltInSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"One") Unique
oneDataConKey DataCon
oneDataCon
manyDataConName :: Name
manyDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
BuiltInSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Many") Unique
manyDataConKey DataCon
manyDataCon
 -- It feels wrong to have One and Many be BuiltInSyntax. But otherwise,
 -- `Many`, in particular, is considered out of scope unless an appropriate
 -- file is open. The problem with this is that `Many` appears implicitly in
 -- types every time there is an `(->)`, hence out-of-scope errors get
 -- reported. Making them built-in make it so that they are always considered in
 -- scope.

runtimeRepTyConName, vecRepDataConName, tupleRepDataConName, sumRepDataConName :: Name
runtimeRepTyConName :: Name
runtimeRepTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"RuntimeRep") Unique
runtimeRepTyConKey TyCon
runtimeRepTyCon
vecRepDataConName :: Name
vecRepDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"VecRep") Unique
vecRepDataConKey DataCon
vecRepDataCon
tupleRepDataConName :: Name
tupleRepDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"TupleRep") Unique
tupleRepDataConKey DataCon
tupleRepDataCon
sumRepDataConName :: Name
sumRepDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"SumRep") Unique
sumRepDataConKey DataCon
sumRepDataCon

-- See Note [Wiring in RuntimeRep]
runtimeRepSimpleDataConNames :: [Name]
runtimeRepSimpleDataConNames :: [Name]
runtimeRepSimpleDataConNames
  = (FastString -> Unique -> DataCon -> Name)
-> [FastString] -> [Unique] -> [DataCon] -> [Name]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3Lazy FastString -> Unique -> DataCon -> Name
mk_special_dc_name
      [ [Char] -> FastString
fsLit [Char]
"LiftedRep", [Char] -> FastString
fsLit [Char]
"UnliftedRep"
      , [Char] -> FastString
fsLit [Char]
"IntRep"
      , [Char] -> FastString
fsLit [Char]
"Int8Rep", [Char] -> FastString
fsLit [Char]
"Int16Rep", [Char] -> FastString
fsLit [Char]
"Int32Rep", [Char] -> FastString
fsLit [Char]
"Int64Rep"
      , [Char] -> FastString
fsLit [Char]
"WordRep"
      , [Char] -> FastString
fsLit [Char]
"Word8Rep", [Char] -> FastString
fsLit [Char]
"Word16Rep", [Char] -> FastString
fsLit [Char]
"Word32Rep", [Char] -> FastString
fsLit [Char]
"Word64Rep"
      , [Char] -> FastString
fsLit [Char]
"AddrRep"
      , [Char] -> FastString
fsLit [Char]
"FloatRep", [Char] -> FastString
fsLit [Char]
"DoubleRep"
      ]
      [Unique]
runtimeRepSimpleDataConKeys
      [DataCon]
runtimeRepSimpleDataCons

vecCountTyConName :: Name
vecCountTyConName :: Name
vecCountTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"VecCount") Unique
vecCountTyConKey TyCon
vecCountTyCon

-- See Note [Wiring in RuntimeRep]
vecCountDataConNames :: [Name]
vecCountDataConNames :: [Name]
vecCountDataConNames = (FastString -> Unique -> DataCon -> Name)
-> [FastString] -> [Unique] -> [DataCon] -> [Name]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3Lazy FastString -> Unique -> DataCon -> Name
mk_special_dc_name
                         [ [Char] -> FastString
fsLit [Char]
"Vec2", [Char] -> FastString
fsLit [Char]
"Vec4", [Char] -> FastString
fsLit [Char]
"Vec8"
                         , [Char] -> FastString
fsLit [Char]
"Vec16", [Char] -> FastString
fsLit [Char]
"Vec32", [Char] -> FastString
fsLit [Char]
"Vec64" ]
                         [Unique]
vecCountDataConKeys
                         [DataCon]
vecCountDataCons

vecElemTyConName :: Name
vecElemTyConName :: Name
vecElemTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"VecElem") Unique
vecElemTyConKey TyCon
vecElemTyCon

-- See Note [Wiring in RuntimeRep]
vecElemDataConNames :: [Name]
vecElemDataConNames :: [Name]
vecElemDataConNames = (FastString -> Unique -> DataCon -> Name)
-> [FastString] -> [Unique] -> [DataCon] -> [Name]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3Lazy FastString -> Unique -> DataCon -> Name
mk_special_dc_name
                        [ [Char] -> FastString
fsLit [Char]
"Int8ElemRep", [Char] -> FastString
fsLit [Char]
"Int16ElemRep", [Char] -> FastString
fsLit [Char]
"Int32ElemRep"
                        , [Char] -> FastString
fsLit [Char]
"Int64ElemRep", [Char] -> FastString
fsLit [Char]
"Word8ElemRep", [Char] -> FastString
fsLit [Char]
"Word16ElemRep"
                        , [Char] -> FastString
fsLit [Char]
"Word32ElemRep", [Char] -> FastString
fsLit [Char]
"Word64ElemRep"
                        , [Char] -> FastString
fsLit [Char]
"FloatElemRep", [Char] -> FastString
fsLit [Char]
"DoubleElemRep" ]
                        [Unique]
vecElemDataConKeys
                        [DataCon]
vecElemDataCons

mk_special_dc_name :: FastString -> Unique -> DataCon -> Name
mk_special_dc_name :: FastString -> Unique -> DataCon -> Name
mk_special_dc_name FastString
fs Unique
u DataCon
dc = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES FastString
fs Unique
u DataCon
dc

boolTyCon_RDR, false_RDR, true_RDR, intTyCon_RDR, charTyCon_RDR, stringTyCon_RDR,
    intDataCon_RDR, listTyCon_RDR, consDataCon_RDR :: RdrName
boolTyCon_RDR :: RdrName
boolTyCon_RDR   = Name -> RdrName
nameRdrName Name
boolTyConName
false_RDR :: RdrName
false_RDR       = Name -> RdrName
nameRdrName Name
falseDataConName
true_RDR :: RdrName
true_RDR        = Name -> RdrName
nameRdrName Name
trueDataConName
intTyCon_RDR :: RdrName
intTyCon_RDR    = Name -> RdrName
nameRdrName Name
intTyConName
charTyCon_RDR :: RdrName
charTyCon_RDR   = Name -> RdrName
nameRdrName Name
charTyConName
stringTyCon_RDR :: RdrName
stringTyCon_RDR = Name -> RdrName
nameRdrName Name
stringTyConName
intDataCon_RDR :: RdrName
intDataCon_RDR  = Name -> RdrName
nameRdrName Name
intDataConName
listTyCon_RDR :: RdrName
listTyCon_RDR   = Name -> RdrName
nameRdrName Name
listTyConName
consDataCon_RDR :: RdrName
consDataCon_RDR = Name -> RdrName
nameRdrName Name
consDataConName

{-
************************************************************************
*                                                                      *
\subsection{mkWiredInTyCon}
*                                                                      *
************************************************************************
-}

-- This function assumes that the types it creates have all parameters at
-- Representational role, and that there is no kind polymorphism.
pcTyCon :: Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon :: Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
name Maybe CType
cType [TyVar]
tyvars [DataCon]
cons
  = Name
-> [TyConBinder]
-> Type
-> [Role]
-> Maybe CType
-> [Type]
-> AlgTyConRhs
-> AlgTyConFlav
-> Bool
-> TyCon
mkAlgTyCon Name
name
                (AnonArgFlag -> [TyVar] -> [TyConBinder]
mkAnonTyConBinders AnonArgFlag
VisArg [TyVar]
tyvars)
                Type
liftedTypeKind
                ((TyVar -> Role) -> [TyVar] -> [Role]
forall a b. (a -> b) -> [a] -> [b]
map (Role -> TyVar -> Role
forall a b. a -> b -> a
const Role
Representational) [TyVar]
tyvars)
                Maybe CType
cType
                []              -- No stupid theta
                ([DataCon] -> AlgTyConRhs
mkDataTyConRhs [DataCon]
cons)
                (Name -> AlgTyConFlav
VanillaAlgTyCon (Name -> Name
mkPrelTyConRepName Name
name))
                Bool
False           -- Not in GADT syntax

pcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
n [TyVar]
univs [Type]
tys = Name -> [TyVar] -> [Scaled Type] -> TyCon -> DataCon
pcDataConW Name
n [TyVar]
univs ((Type -> Scaled Type) -> [Type] -> [Scaled Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Scaled Type
forall a. a -> Scaled a
linear [Type]
tys)

pcDataConW :: Name -> [TyVar] -> [Scaled Type] -> TyCon -> DataCon
pcDataConW :: Name -> [TyVar] -> [Scaled Type] -> TyCon -> DataCon
pcDataConW Name
n [TyVar]
univs [Scaled Type]
tys = Bool
-> Name
-> [TyVar]
-> [TyVar]
-> [TyVar]
-> [Scaled Type]
-> TyCon
-> DataCon
pcDataConWithFixity Bool
False Name
n [TyVar]
univs
                      []    -- no ex_tvs
                      [TyVar]
univs -- the univs are precisely the user-written tyvars
                      [Scaled Type]
tys

pcDataConWithFixity :: Bool      -- ^ declared infix?
                    -> Name      -- ^ datacon name
                    -> [TyVar]   -- ^ univ tyvars
                    -> [TyCoVar] -- ^ ex tycovars
                    -> [TyCoVar] -- ^ user-written tycovars
                    -> [Scaled Type]    -- ^ args
                    -> TyCon
                    -> DataCon
pcDataConWithFixity :: Bool
-> Name
-> [TyVar]
-> [TyVar]
-> [TyVar]
-> [Scaled Type]
-> TyCon
-> DataCon
pcDataConWithFixity Bool
infx Name
n = Bool
-> Name
-> Unique
-> RuntimeRepInfo
-> [TyVar]
-> [TyVar]
-> [TyVar]
-> [Scaled Type]
-> TyCon
-> DataCon
pcDataConWithFixity' Bool
infx Name
n (Unique -> Unique
dataConWorkerUnique (Name -> Unique
nameUnique Name
n))
                                                  RuntimeRepInfo
NoRRI
-- The Name's unique is the first of two free uniques;
-- the first is used for the datacon itself,
-- the second is used for the "worker name"
--
-- To support this the mkPreludeDataConUnique function "allocates"
-- one DataCon unique per pair of Ints.

pcDataConWithFixity' :: Bool -> Name -> Unique -> RuntimeRepInfo
                     -> [TyVar] -> [TyCoVar] -> [TyCoVar]
                     -> [Scaled Type] -> TyCon -> DataCon
-- The Name should be in the DataName name space; it's the name
-- of the DataCon itself.
--
-- IMPORTANT NOTE:
--    if you try to wire-in a /GADT/ data constructor you will
--    find it hard (we did).  You will need wrapper and worker
--    Names, a DataConBoxer, DataConRep, EqSpec, etc.
--    Try hard not to wire-in GADT data types. You will live
--    to regret doing so (we do).

pcDataConWithFixity' :: Bool
-> Name
-> Unique
-> RuntimeRepInfo
-> [TyVar]
-> [TyVar]
-> [TyVar]
-> [Scaled Type]
-> TyCon
-> DataCon
pcDataConWithFixity' Bool
declared_infix Name
dc_name Unique
wrk_key RuntimeRepInfo
rri
                     [TyVar]
tyvars [TyVar]
ex_tyvars [TyVar]
user_tyvars [Scaled Type]
arg_tys TyCon
tycon
  = DataCon
data_con
  where
    tag_map :: NameEnv Arity
tag_map = TyCon -> NameEnv Arity
mkTyConTagMap TyCon
tycon
    -- This constructs the constructor Name to ConTag map once per
    -- constructor, which is quadratic. It's OK here, because it's
    -- only called for wired in data types that don't have a lot of
    -- constructors. It's also likely that GHC will lift tag_map, since
    -- we call pcDataConWithFixity' with static TyCons in the same module.
    -- See Note [Constructor tag allocation] and #14657
    data_con :: DataCon
data_con = Name
-> Bool
-> Name
-> [HsSrcBang]
-> [FieldLabel]
-> [TyVar]
-> [TyVar]
-> [InvisTVBinder]
-> [EqSpec]
-> [Type]
-> [Scaled Type]
-> Type
-> RuntimeRepInfo
-> TyCon
-> Arity
-> [Type]
-> TyVar
-> DataConRep
-> DataCon
mkDataCon Name
dc_name Bool
declared_infix Name
prom_info
                ((Scaled Type -> HsSrcBang) -> [Scaled Type] -> [HsSrcBang]
forall a b. (a -> b) -> [a] -> [b]
map (HsSrcBang -> Scaled Type -> HsSrcBang
forall a b. a -> b -> a
const HsSrcBang
no_bang) [Scaled Type]
arg_tys)
                []      -- No labelled fields
                [TyVar]
tyvars [TyVar]
ex_tyvars
                (Specificity -> [TyVar] -> [InvisTVBinder]
forall vis. vis -> [TyVar] -> [VarBndr TyVar vis]
mkTyVarBinders Specificity
SpecifiedSpec [TyVar]
user_tyvars)
                []      -- No equality spec
                []      -- No theta
                [Scaled Type]
arg_tys (TyCon -> [Type] -> Type
mkTyConApp TyCon
tycon ([TyVar] -> [Type]
mkTyVarTys [TyVar]
tyvars))
                RuntimeRepInfo
rri
                TyCon
tycon
                (NameEnv Arity -> Name -> Arity
forall a. NameEnv a -> Name -> a
lookupNameEnv_NF NameEnv Arity
tag_map Name
dc_name)
                []      -- No stupid theta
                (Name -> DataCon -> TyVar
mkDataConWorkId Name
wrk_name DataCon
data_con)
                DataConRep
NoDataConRep    -- Wired-in types are too simple to need wrappers

    no_bang :: HsSrcBang
no_bang = SourceText -> SrcUnpackedness -> SrcStrictness -> HsSrcBang
HsSrcBang SourceText
NoSourceText SrcUnpackedness
NoSrcUnpack SrcStrictness
NoSrcStrict

    wrk_name :: Name
wrk_name = DataCon -> Unique -> Name
mkDataConWorkerName DataCon
data_con Unique
wrk_key

    prom_info :: Name
prom_info = Name -> Name
mkPrelTyConRepName Name
dc_name

mkDataConWorkerName :: DataCon -> Unique -> Name
mkDataConWorkerName :: DataCon -> Unique -> Name
mkDataConWorkerName DataCon
data_con Unique
wrk_key =
    Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
mkWiredInName Module
modu OccName
wrk_occ Unique
wrk_key
                  (TyVar -> TyThing
AnId (DataCon -> TyVar
dataConWorkId DataCon
data_con)) BuiltInSyntax
UserSyntax
  where
    modu :: Module
modu     = ASSERT( isExternalName dc_name )
               HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
dc_name
    dc_name :: Name
dc_name = DataCon -> Name
dataConName DataCon
data_con
    dc_occ :: OccName
dc_occ  = Name -> OccName
nameOccName Name
dc_name
    wrk_occ :: OccName
wrk_occ = OccName -> OccName
mkDataConWorkerOcc OccName
dc_occ

-- used for RuntimeRep and friends
pcSpecialDataCon :: Name -> [Type] -> TyCon -> RuntimeRepInfo -> DataCon
pcSpecialDataCon :: Name -> [Type] -> TyCon -> RuntimeRepInfo -> DataCon
pcSpecialDataCon Name
dc_name [Type]
arg_tys TyCon
tycon RuntimeRepInfo
rri
  = Bool
-> Name
-> Unique
-> RuntimeRepInfo
-> [TyVar]
-> [TyVar]
-> [TyVar]
-> [Scaled Type]
-> TyCon
-> DataCon
pcDataConWithFixity' Bool
False Name
dc_name (Unique -> Unique
dataConWorkerUnique (Name -> Unique
nameUnique Name
dc_name)) RuntimeRepInfo
rri
                         [] [] [] ((Type -> Scaled Type) -> [Type] -> [Scaled Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Scaled Type
forall a. a -> Scaled a
linear [Type]
arg_tys) TyCon
tycon

{-
************************************************************************
*                                                                      *
      Kinds
*                                                                      *
************************************************************************
-}

typeNatKindCon, typeSymbolKindCon :: TyCon
-- data Nat
-- data Symbol
typeNatKindCon :: TyCon
typeNatKindCon    = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
typeNatKindConName    Maybe CType
forall a. Maybe a
Nothing [] []
typeSymbolKindCon :: TyCon
typeSymbolKindCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
typeSymbolKindConName Maybe CType
forall a. Maybe a
Nothing [] []

typeNatKind, typeSymbolKind :: Kind
typeNatKind :: Type
typeNatKind    = TyCon -> Type
mkTyConTy TyCon
typeNatKindCon
typeSymbolKind :: Type
typeSymbolKind = TyCon -> Type
mkTyConTy TyCon
typeSymbolKindCon

constraintKindTyCon :: TyCon
-- 'TyCon.isConstraintKindCon' assumes that this is an AlgTyCon!
constraintKindTyCon :: TyCon
constraintKindTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
constraintKindTyConName Maybe CType
forall a. Maybe a
Nothing [] []

liftedTypeKind, typeToTypeKind, constraintKind :: Kind
liftedTypeKind :: Type
liftedTypeKind   = Type -> Type
tYPE Type
liftedRepTy
typeToTypeKind :: Type
typeToTypeKind   = Type
liftedTypeKind Type -> Type -> Type
`mkVisFunTyMany` Type
liftedTypeKind
constraintKind :: Type
constraintKind   = TyCon -> [Type] -> Type
mkTyConApp TyCon
constraintKindTyCon []

{-
************************************************************************
*                                                                      *
                Stuff for dealing with tuples
*                                                                      *
************************************************************************

Note [How tuples work]  See also Note [Known-key names] in GHC.Builtin.Names
~~~~~~~~~~~~~~~~~~~~~~
* There are three families of tuple TyCons and corresponding
  DataCons, expressed by the type BasicTypes.TupleSort:
    data TupleSort = BoxedTuple | UnboxedTuple | ConstraintTuple

* All three families are AlgTyCons, whose AlgTyConRhs is TupleTyCon

* BoxedTuples
    - A wired-in type
    - Data type declarations in GHC.Tuple
    - The data constructors really have an info table

* UnboxedTuples
    - A wired-in type
    - Have a pretend DataCon, defined in GHC.Prim,
      but no actual declaration and no info table

* ConstraintTuples
    - Are known-key rather than wired-in. Reason: it's awkward to
      have all the superclass selectors wired-in.
    - Declared as classes in GHC.Classes, e.g.
         class (c1,c2) => (c1,c2)
    - Given constraints: the superclasses automatically become available
    - Wanted constraints: there is a built-in instance
         instance (c1,c2) => (c1,c2)
      See GHC.Tc.Solver.Interact.matchCTuple
    - Currently just go up to 62; beyond that
      you have to use manual nesting
    - Their OccNames look like (%,,,%), so they can easily be
      distinguished from term tuples.  But (following Haskell) we
      pretty-print saturated constraint tuples with round parens;
      see BasicTypes.tupleParens.

* In quite a lot of places things are restricted just to
  BoxedTuple/UnboxedTuple, and then we used BasicTypes.Boxity to distinguish
  E.g. tupleTyCon has a Boxity argument

* When looking up an OccName in the original-name cache
  (GHC.Iface.Env.lookupOrigNameCache), we spot the tuple OccName to make sure
  we get the right wired-in name.  This guy can't tell the difference
  between BoxedTuple and ConstraintTuple (same OccName!), so tuples
  are not serialised into interface files using OccNames at all.

* Serialization to interface files works via the usual mechanism for known-key
  things: instead of serializing the OccName we just serialize the key. During
  deserialization we lookup the Name associated with the unique with the logic
  in GHC.Builtin.Uniques. See Note [Symbol table representation of names] for details.

Note [One-tuples]
~~~~~~~~~~~~~~~~~
GHC supports both boxed and unboxed one-tuples:
 - Unboxed one-tuples are sometimes useful when returning a
   single value after CPR analysis
 - A boxed one-tuple is used by GHC.HsToCore.Utils.mkSelectorBinds, when
   there is just one binder
Basically it keeps everything uniform.

However the /naming/ of the type/data constructors for one-tuples is a
bit odd:
  3-tuples:  (,,)   (,,)#
  2-tuples:  (,)    (,)#
  1-tuples:  ??
  0-tuples:  ()     ()#

Zero-tuples have used up the logical name. So we use 'Solo' and 'Solo#'
for one-tuples.  So in ghc-prim:GHC.Tuple we see the declarations:
  data ()     = ()
  data Solo a = Solo a
  data (a,b)  = (a,b)

There is no way to write a boxed one-tuple in Haskell using tuple syntax.
They can, however, be written using other methods:

1. They can be written directly by importing them from GHC.Tuple.
2. They can be generated by way of Template Haskell or in `deriving` code.

There is nothing special about one-tuples in Core; in particular, they have no
custom pretty-printing, just using `Solo`.

Note that there is *not* a unary constraint tuple, unlike for other forms of
tuples. See [Ignore unary constraint tuples] in GHC.Tc.Gen.HsType for more
details.

See also Note [Flattening one-tuples] in GHC.Core.Make and
Note [Don't flatten tuples from HsSyn] in GHC.Core.Make.

-----
-- Wrinkle: Make boxed one-tuple names have known keys
-----

We make boxed one-tuple names have known keys so that `data Solo a = Solo a`,
defined in GHC.Tuple, will be used when one-tuples are spliced in through
Template Haskell. This program (from #18097) crucially relies on this:

  case $( tupE [ [| "ok" |] ] ) of Solo x -> putStrLn x

Unless Solo has a known key, the type of `$( tupE [ [| "ok" |] ] )` (an
ExplicitTuple of length 1) will not match the type of Solo (an ordinary
data constructor used in a pattern). Making Solo known-key allows GHC to make
this connection.

Unlike Solo, every other tuple is /not/ known-key
(see Note [Infinite families of known-key names] in GHC.Builtin.Names). The
main reason for this exception is that other tuples are written with special
syntax, and as a result, they are renamed using a special `isBuiltInOcc_maybe`
function (see Note [Built-in syntax and the OrigNameCache] in GHC.Types.Name.Cache).
In contrast, Solo is just an ordinary data type with no special syntax, so it
doesn't really make sense to handle it in `isBuiltInOcc_maybe`. Making Solo
known-key is the next-best way to teach the internals of the compiler about it.
-}

-- | Built-in syntax isn't "in scope" so these OccNames map to wired-in Names
-- with BuiltInSyntax. However, this should only be necessary while resolving
-- names produced by Template Haskell splices since we take care to encode
-- built-in syntax names specially in interface files. See
-- Note [Symbol table representation of names].
--
-- Moreover, there is no need to include names of things that the user can't
-- write (e.g. type representation bindings like $tc(,,,)).
isBuiltInOcc_maybe :: OccName -> Maybe Name
isBuiltInOcc_maybe :: OccName -> Maybe Name
isBuiltInOcc_maybe OccName
occ =
    case ByteString
name of
      ByteString
"[]" -> Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ Name -> Name -> Name
choose_ns Name
listTyConName Name
nilDataConName
      ByteString
":"    -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
consDataConName

      -- equality tycon
      ByteString
"~"    -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
eqTyConName

      -- function tycon
      ByteString
"FUN"  -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
funTyConName
      ByteString
"->"  -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
unrestrictedFunTyConName

      -- boxed tuple data/tycon
      -- We deliberately exclude Solo (the boxed 1-tuple).
      -- See Note [One-tuples] (Wrinkle: Make boxed one-tuple names have known keys)
      ByteString
"()"    -> Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ Boxity -> Arity -> Name
tup_name Boxity
Boxed Arity
0
      ByteString
_ | Just ByteString
rest <- ByteString
"(" ByteString -> ByteString -> Maybe ByteString
`BS.stripPrefix` ByteString
name
        , (ByteString
commas, ByteString
rest') <- (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
',') ByteString
rest
        , ByteString
")" <- ByteString
rest'
             -> Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ Boxity -> Arity -> Name
tup_name Boxity
Boxed (Arity
1Arity -> Arity -> Arity
forall a. Num a => a -> a -> a
+ByteString -> Arity
BS.length ByteString
commas)

      -- unboxed tuple data/tycon
      ByteString
"(##)"  -> Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ Boxity -> Arity -> Name
tup_name Boxity
Unboxed Arity
0
      ByteString
"Solo#" -> Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ Boxity -> Arity -> Name
tup_name Boxity
Unboxed Arity
1
      ByteString
_ | Just ByteString
rest <- ByteString
"(#" ByteString -> ByteString -> Maybe ByteString
`BS.stripPrefix` ByteString
name
        , (ByteString
commas, ByteString
rest') <- (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
',') ByteString
rest
        , ByteString
"#)" <- ByteString
rest'
             -> Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ Boxity -> Arity -> Name
tup_name Boxity
Unboxed (Arity
1Arity -> Arity -> Arity
forall a. Num a => a -> a -> a
+ByteString -> Arity
BS.length ByteString
commas)

      -- unboxed sum tycon
      ByteString
_ | Just ByteString
rest <- ByteString
"(#" ByteString -> ByteString -> Maybe ByteString
`BS.stripPrefix` ByteString
name
        , (ByteString
pipes, ByteString
rest') <- (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'|') ByteString
rest
        , ByteString
"#)" <- ByteString
rest'
             -> Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ TyCon -> Name
tyConName (TyCon -> Name) -> TyCon -> Name
forall a b. (a -> b) -> a -> b
$ Arity -> TyCon
sumTyCon (Arity
1Arity -> Arity -> Arity
forall a. Num a => a -> a -> a
+ByteString -> Arity
BS.length ByteString
pipes)

      -- unboxed sum datacon
      ByteString
_ | Just ByteString
rest <- ByteString
"(#" ByteString -> ByteString -> Maybe ByteString
`BS.stripPrefix` ByteString
name
        , (ByteString
pipes1, ByteString
rest') <- (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'|') ByteString
rest
        , Just ByteString
rest'' <- ByteString
"_" ByteString -> ByteString -> Maybe ByteString
`BS.stripPrefix` ByteString
rest'
        , (ByteString
pipes2, ByteString
rest''') <- (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'|') ByteString
rest''
        , ByteString
"#)" <- ByteString
rest'''
             -> let arity :: Arity
arity = ByteString -> Arity
BS.length ByteString
pipes1 Arity -> Arity -> Arity
forall a. Num a => a -> a -> a
+ ByteString -> Arity
BS.length ByteString
pipes2 Arity -> Arity -> Arity
forall a. Num a => a -> a -> a
+ Arity
1
                    alt :: Arity
alt = ByteString -> Arity
BS.length ByteString
pipes1 Arity -> Arity -> Arity
forall a. Num a => a -> a -> a
+ Arity
1
                in Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ DataCon -> Name
dataConName (DataCon -> Name) -> DataCon -> Name
forall a b. (a -> b) -> a -> b
$ Arity -> Arity -> DataCon
sumDataCon Arity
alt Arity
arity
      ByteString
_ -> Maybe Name
forall a. Maybe a
Nothing
  where
    name :: ByteString
name = FastString -> ByteString
bytesFS (FastString -> ByteString) -> FastString -> ByteString
forall a b. (a -> b) -> a -> b
$ OccName -> FastString
occNameFS OccName
occ

    choose_ns :: Name -> Name -> Name
    choose_ns :: Name -> Name -> Name
choose_ns Name
tc Name
dc
      | NameSpace -> Bool
isTcClsNameSpace NameSpace
ns   = Name
tc
      | NameSpace -> Bool
isDataConNameSpace NameSpace
ns = Name
dc
      | Bool
otherwise             = [Char] -> SDoc -> Name
forall a. HasCallStack => [Char] -> SDoc -> a
pprPanic [Char]
"tup_name" (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ)
      where ns :: NameSpace
ns = OccName -> NameSpace
occNameSpace OccName
occ

    tup_name :: Boxity -> Arity -> Name
tup_name Boxity
boxity Arity
arity
      = Name -> Name -> Name
choose_ns (TyCon -> Name
forall a. NamedThing a => a -> Name
getName (Boxity -> Arity -> TyCon
tupleTyCon   Boxity
boxity Arity
arity))
                  (DataCon -> Name
forall a. NamedThing a => a -> Name
getName (Boxity -> Arity -> DataCon
tupleDataCon Boxity
boxity Arity
arity))

mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
-- No need to cache these, the caching is done in mk_tuple
mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
mkTupleOcc NameSpace
ns Boxity
Boxed   Arity
ar = NameSpace -> [Char] -> OccName
mkOccName NameSpace
ns (Arity -> [Char]
mkBoxedTupleStr   Arity
ar)
mkTupleOcc NameSpace
ns Boxity
Unboxed Arity
ar = NameSpace -> [Char] -> OccName
mkOccName NameSpace
ns (Arity -> [Char]
mkUnboxedTupleStr Arity
ar)

mkCTupleOcc :: NameSpace -> Arity -> OccName
mkCTupleOcc :: NameSpace -> Arity -> OccName
mkCTupleOcc NameSpace
ns Arity
ar = NameSpace -> [Char] -> OccName
mkOccName NameSpace
ns (Arity -> [Char]
mkConstraintTupleStr Arity
ar)

mkTupleStr :: Boxity -> Arity -> String
mkTupleStr :: Boxity -> Arity -> [Char]
mkTupleStr Boxity
Boxed   = Arity -> [Char]
mkBoxedTupleStr
mkTupleStr Boxity
Unboxed = Arity -> [Char]
mkUnboxedTupleStr

mkBoxedTupleStr :: Arity -> String
mkBoxedTupleStr :: Arity -> [Char]
mkBoxedTupleStr Arity
0  = [Char]
"()"
mkBoxedTupleStr Arity
1  = [Char]
"Solo"   -- See Note [One-tuples]
mkBoxedTupleStr Arity
ar = Char
'(' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Arity -> [Char]
commas Arity
ar [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"

mkUnboxedTupleStr :: Arity -> String
mkUnboxedTupleStr :: Arity -> [Char]
mkUnboxedTupleStr Arity
0  = [Char]
"(##)"
mkUnboxedTupleStr Arity
1  = [Char]
"Solo#"  -- See Note [One-tuples]
mkUnboxedTupleStr Arity
ar = [Char]
"(#" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Arity -> [Char]
commas Arity
ar [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"#)"

mkConstraintTupleStr :: Arity -> String
mkConstraintTupleStr :: Arity -> [Char]
mkConstraintTupleStr Arity
0  = [Char]
"(%%)"
mkConstraintTupleStr Arity
1  = [Char]
"Solo%"   -- See Note [One-tuples]
mkConstraintTupleStr Arity
ar = [Char]
"(%" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Arity -> [Char]
commas Arity
ar [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"%)"

commas :: Arity -> String
commas :: Arity -> [Char]
commas Arity
ar = Arity -> [Char] -> [Char]
forall a. Arity -> [a] -> [a]
take (Arity
arArity -> Arity -> Arity
forall a. Num a => a -> a -> a
-Arity
1) (Char -> [Char]
forall a. a -> [a]
repeat Char
',')

cTupleTyConName :: Arity -> Name
cTupleTyConName :: Arity -> Name
cTupleTyConName Arity
arity
  = Unique -> Module -> OccName -> SrcSpan -> Name
mkExternalName (Arity -> Unique
mkCTupleTyConUnique Arity
arity) Module
gHC_CLASSES
                   (NameSpace -> Arity -> OccName
mkCTupleOcc NameSpace
tcName Arity
arity) SrcSpan
noSrcSpan

cTupleTyConNames :: [Name]
cTupleTyConNames :: [Name]
cTupleTyConNames = (Arity -> Name) -> [Arity] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Arity -> Name
cTupleTyConName (Arity
0 Arity -> [Arity] -> [Arity]
forall a. a -> [a] -> [a]
: [Arity
2..Arity
mAX_CTUPLE_SIZE])

cTupleTyConNameSet :: NameSet
cTupleTyConNameSet :: NameSet
cTupleTyConNameSet = [Name] -> NameSet
mkNameSet [Name]
cTupleTyConNames

isCTupleTyConName :: Name -> Bool
-- Use Type.isCTupleClass where possible
isCTupleTyConName :: Name -> Bool
isCTupleTyConName Name
n
 = ASSERT2( isExternalName n, ppr n )
   HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
n Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
gHC_CLASSES
   Bool -> Bool -> Bool
&& Name
n Name -> NameSet -> Bool
`elemNameSet` NameSet
cTupleTyConNameSet

-- | If the given name is that of a constraint tuple, return its arity.
-- Note that this is inefficient.
cTupleTyConNameArity_maybe :: Name -> Maybe Arity
cTupleTyConNameArity_maybe :: Name -> Maybe Arity
cTupleTyConNameArity_maybe Name
n
  | Bool -> Bool
not (Name -> Bool
isCTupleTyConName Name
n) = Maybe Arity
forall a. Maybe a
Nothing
  | Bool
otherwise = (Arity -> Arity) -> Maybe Arity -> Maybe Arity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Arity -> Arity
forall {a}. (Ord a, Num a) => a -> a
adjustArity (Name
n Name -> [Name] -> Maybe Arity
forall a. Eq a => a -> [a] -> Maybe Arity
`elemIndex` [Name]
cTupleTyConNames)
  where
    -- Since `cTupleTyConNames` jumps straight from the `0` to the `2`
    -- case, we have to adjust accordingly our calculated arity.
    adjustArity :: a -> a
adjustArity a
a = if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 then a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
1 else a
a

cTupleDataConName :: Arity -> Name
cTupleDataConName :: Arity -> Name
cTupleDataConName Arity
arity
  = Unique -> Module -> OccName -> SrcSpan -> Name
mkExternalName (Arity -> Unique
mkCTupleDataConUnique Arity
arity) Module
gHC_CLASSES
                   (NameSpace -> Arity -> OccName
mkCTupleOcc NameSpace
dataName Arity
arity) SrcSpan
noSrcSpan

cTupleDataConNames :: [Name]
cTupleDataConNames :: [Name]
cTupleDataConNames = (Arity -> Name) -> [Arity] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Arity -> Name
cTupleDataConName (Arity
0 Arity -> [Arity] -> [Arity]
forall a. a -> [a] -> [a]
: [Arity
2..Arity
mAX_CTUPLE_SIZE])

tupleTyCon :: Boxity -> Arity -> TyCon
tupleTyCon :: Boxity -> Arity -> TyCon
tupleTyCon Boxity
sort Arity
i | Arity
i Arity -> Arity -> Bool
forall a. Ord a => a -> a -> Bool
> Arity
mAX_TUPLE_SIZE = (TyCon, DataCon) -> TyCon
forall a b. (a, b) -> a
fst (Boxity -> Arity -> (TyCon, DataCon)
mk_tuple Boxity
sort Arity
i)  -- Build one specially
tupleTyCon Boxity
Boxed   Arity
i = (TyCon, DataCon) -> TyCon
forall a b. (a, b) -> a
fst (Array Arity (TyCon, DataCon)
boxedTupleArr   Array Arity (TyCon, DataCon) -> Arity -> (TyCon, DataCon)
forall i e. Ix i => Array i e -> i -> e
! Arity
i)
tupleTyCon Boxity
Unboxed Arity
i = (TyCon, DataCon) -> TyCon
forall a b. (a, b) -> a
fst (Array Arity (TyCon, DataCon)
unboxedTupleArr Array Arity (TyCon, DataCon) -> Arity -> (TyCon, DataCon)
forall i e. Ix i => Array i e -> i -> e
! Arity
i)

tupleTyConName :: TupleSort -> Arity -> Name
tupleTyConName :: TupleSort -> Arity -> Name
tupleTyConName TupleSort
ConstraintTuple Arity
a = Arity -> Name
cTupleTyConName Arity
a
tupleTyConName TupleSort
BoxedTuple      Arity
a = TyCon -> Name
tyConName (Boxity -> Arity -> TyCon
tupleTyCon Boxity
Boxed Arity
a)
tupleTyConName TupleSort
UnboxedTuple    Arity
a = TyCon -> Name
tyConName (Boxity -> Arity -> TyCon
tupleTyCon Boxity
Unboxed Arity
a)

promotedTupleDataCon :: Boxity -> Arity -> TyCon
promotedTupleDataCon :: Boxity -> Arity -> TyCon
promotedTupleDataCon Boxity
boxity Arity
i = DataCon -> TyCon
promoteDataCon (Boxity -> Arity -> DataCon
tupleDataCon Boxity
boxity Arity
i)

tupleDataCon :: Boxity -> Arity -> DataCon
tupleDataCon :: Boxity -> Arity -> DataCon
tupleDataCon Boxity
sort Arity
i | Arity
i Arity -> Arity -> Bool
forall a. Ord a => a -> a -> Bool
> Arity
mAX_TUPLE_SIZE = (TyCon, DataCon) -> DataCon
forall a b. (a, b) -> b
snd (Boxity -> Arity -> (TyCon, DataCon)
mk_tuple Boxity
sort Arity
i)    -- Build one specially
tupleDataCon Boxity
Boxed   Arity
i = (TyCon, DataCon) -> DataCon
forall a b. (a, b) -> b
snd (Array Arity (TyCon, DataCon)
boxedTupleArr   Array Arity (TyCon, DataCon) -> Arity -> (TyCon, DataCon)
forall i e. Ix i => Array i e -> i -> e
! Arity
i)
tupleDataCon Boxity
Unboxed Arity
i = (TyCon, DataCon) -> DataCon
forall a b. (a, b) -> b
snd (Array Arity (TyCon, DataCon)
unboxedTupleArr Array Arity (TyCon, DataCon) -> Arity -> (TyCon, DataCon)
forall i e. Ix i => Array i e -> i -> e
! Arity
i)

tupleDataConName :: Boxity -> Arity -> Name
tupleDataConName :: Boxity -> Arity -> Name
tupleDataConName Boxity
sort Arity
i = DataCon -> Name
dataConName (Boxity -> Arity -> DataCon
tupleDataCon Boxity
sort Arity
i)

boxedTupleArr, unboxedTupleArr :: Array Int (TyCon,DataCon)
boxedTupleArr :: Array Arity (TyCon, DataCon)
boxedTupleArr   = (Arity, Arity)
-> [(TyCon, DataCon)] -> Array Arity (TyCon, DataCon)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Arity
0,Arity
mAX_TUPLE_SIZE) [Boxity -> Arity -> (TyCon, DataCon)
mk_tuple Boxity
Boxed   Arity
i | Arity
i <- [Arity
0..Arity
mAX_TUPLE_SIZE]]
unboxedTupleArr :: Array Arity (TyCon, DataCon)
unboxedTupleArr = (Arity, Arity)
-> [(TyCon, DataCon)] -> Array Arity (TyCon, DataCon)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Arity
0,Arity
mAX_TUPLE_SIZE) [Boxity -> Arity -> (TyCon, DataCon)
mk_tuple Boxity
Unboxed Arity
i | Arity
i <- [Arity
0..Arity
mAX_TUPLE_SIZE]]

-- | Given the TupleRep/SumRep tycon and list of RuntimeReps of the unboxed
-- tuple/sum arguments, produces the return kind of an unboxed tuple/sum type
-- constructor. @unboxedTupleSumKind [IntRep, LiftedRep] --> TYPE (TupleRep/SumRep
-- [IntRep, LiftedRep])@
unboxedTupleSumKind :: TyCon -> [Type] -> Kind
unboxedTupleSumKind :: TyCon -> [Type] -> Type
unboxedTupleSumKind TyCon
tc [Type]
rr_tys
  = Type -> Type
tYPE (TyCon -> [Type] -> Type
mkTyConApp TyCon
tc [Type -> [Type] -> Type
mkPromotedListTy Type
runtimeRepTy [Type]
rr_tys])

-- | Specialization of 'unboxedTupleSumKind' for tuples
unboxedTupleKind :: [Type] -> Kind
unboxedTupleKind :: [Type] -> Type
unboxedTupleKind = TyCon -> [Type] -> Type
unboxedTupleSumKind TyCon
tupleRepDataConTyCon

mk_tuple :: Boxity -> Int -> (TyCon,DataCon)
mk_tuple :: Boxity -> Arity -> (TyCon, DataCon)
mk_tuple Boxity
Boxed Arity
arity = (TyCon
tycon, DataCon
tuple_con)
  where
    tycon :: TyCon
tycon = Name
-> [TyConBinder]
-> Type
-> Arity
-> DataCon
-> TupleSort
-> AlgTyConFlav
-> TyCon
mkTupleTyCon Name
tc_name [TyConBinder]
tc_binders Type
tc_res_kind Arity
tc_arity DataCon
tuple_con
                         TupleSort
BoxedTuple AlgTyConFlav
flavour

    tc_binders :: [TyConBinder]
tc_binders  = [Type] -> [TyConBinder]
mkTemplateAnonTyConBinders (Arity -> Type -> [Type]
forall a. Arity -> a -> [a]
replicate Arity
arity Type
liftedTypeKind)
    tc_res_kind :: Type
tc_res_kind = Type
liftedTypeKind
    tc_arity :: Arity
tc_arity    = Arity
arity
    flavour :: AlgTyConFlav
flavour     = Name -> AlgTyConFlav
VanillaAlgTyCon (Name -> Name
mkPrelTyConRepName Name
tc_name)

    dc_tvs :: [TyVar]
dc_tvs     = [TyConBinder] -> [TyVar]
forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
tc_binders
    dc_arg_tys :: [Type]
dc_arg_tys = [TyVar] -> [Type]
mkTyVarTys [TyVar]
dc_tvs
    tuple_con :: DataCon
tuple_con  = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
dc_name [TyVar]
dc_tvs [Type]
dc_arg_tys TyCon
tycon

    boxity :: Boxity
boxity  = Boxity
Boxed
    modu :: Module
modu    = Module
gHC_TUPLE
    tc_name :: Name
tc_name = Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
mkWiredInName Module
modu (NameSpace -> Boxity -> Arity -> OccName
mkTupleOcc NameSpace
tcName Boxity
boxity Arity
arity) Unique
tc_uniq
                         (TyCon -> TyThing
ATyCon TyCon
tycon) BuiltInSyntax
BuiltInSyntax
    dc_name :: Name
dc_name = Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
mkWiredInName Module
modu (NameSpace -> Boxity -> Arity -> OccName
mkTupleOcc NameSpace
dataName Boxity
boxity Arity
arity) Unique
dc_uniq
                            (ConLike -> TyThing
AConLike (DataCon -> ConLike
RealDataCon DataCon
tuple_con)) BuiltInSyntax
BuiltInSyntax
    tc_uniq :: Unique
tc_uniq = Boxity -> Arity -> Unique
mkTupleTyConUnique   Boxity
boxity Arity
arity
    dc_uniq :: Unique
dc_uniq = Boxity -> Arity -> Unique
mkTupleDataConUnique Boxity
boxity Arity
arity

mk_tuple Boxity
Unboxed Arity
arity = (TyCon
tycon, DataCon
tuple_con)
  where
    tycon :: TyCon
tycon = Name
-> [TyConBinder]
-> Type
-> Arity
-> DataCon
-> TupleSort
-> AlgTyConFlav
-> TyCon
mkTupleTyCon Name
tc_name [TyConBinder]
tc_binders Type
tc_res_kind Arity
tc_arity DataCon
tuple_con
                         TupleSort
UnboxedTuple AlgTyConFlav
flavour

    -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon
    -- Kind:  forall (k1:RuntimeRep) (k2:RuntimeRep). TYPE k1 -> TYPE k2 -> #
    tc_binders :: [TyConBinder]
tc_binders = [Type] -> ([Type] -> [Type]) -> [TyConBinder]
mkTemplateTyConBinders (Arity -> Type -> [Type]
forall a. Arity -> a -> [a]
replicate Arity
arity Type
runtimeRepTy)
                                        (\[Type]
ks -> (Type -> Type) -> [Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Type
tYPE [Type]
ks)

    tc_res_kind :: Type
tc_res_kind = [Type] -> Type
unboxedTupleKind [Type]
rr_tys

    tc_arity :: Arity
tc_arity    = Arity
arity Arity -> Arity -> Arity
forall a. Num a => a -> a -> a
* Arity
2
    flavour :: AlgTyConFlav
flavour     = Maybe Name -> AlgTyConFlav
UnboxedAlgTyCon (Maybe Name -> AlgTyConFlav) -> Maybe Name -> AlgTyConFlav
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Name
mkPrelTyConRepName Name
tc_name)

    dc_tvs :: [TyVar]
dc_tvs               = [TyConBinder] -> [TyVar]
forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
tc_binders
    ([Type]
rr_tys, [Type]
dc_arg_tys) = Arity -> [Type] -> ([Type], [Type])
forall a. Arity -> [a] -> ([a], [a])
splitAt Arity
arity ([TyVar] -> [Type]
mkTyVarTys [TyVar]
dc_tvs)
    tuple_con :: DataCon
tuple_con            = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
dc_name [TyVar]
dc_tvs [Type]
dc_arg_tys TyCon
tycon

    boxity :: Boxity
boxity  = Boxity
Unboxed
    modu :: Module
modu    = Module
gHC_PRIM
    tc_name :: Name
tc_name = Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
mkWiredInName Module
modu (NameSpace -> Boxity -> Arity -> OccName
mkTupleOcc NameSpace
tcName Boxity
boxity Arity
arity) Unique
tc_uniq
                         (TyCon -> TyThing
ATyCon TyCon
tycon) BuiltInSyntax
BuiltInSyntax
    dc_name :: Name
dc_name = Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
mkWiredInName Module
modu (NameSpace -> Boxity -> Arity -> OccName
mkTupleOcc NameSpace
dataName Boxity
boxity Arity
arity) Unique
dc_uniq
                            (ConLike -> TyThing
AConLike (DataCon -> ConLike
RealDataCon DataCon
tuple_con)) BuiltInSyntax
BuiltInSyntax
    tc_uniq :: Unique
tc_uniq = Boxity -> Arity -> Unique
mkTupleTyConUnique   Boxity
boxity Arity
arity
    dc_uniq :: Unique
dc_uniq = Boxity -> Arity -> Unique
mkTupleDataConUnique Boxity
boxity Arity
arity

unitTyCon :: TyCon
unitTyCon :: TyCon
unitTyCon = Boxity -> Arity -> TyCon
tupleTyCon Boxity
Boxed Arity
0

unitTyConKey :: Unique
unitTyConKey :: Unique
unitTyConKey = TyCon -> Unique
forall a. Uniquable a => a -> Unique
getUnique TyCon
unitTyCon

unitDataCon :: DataCon
unitDataCon :: DataCon
unitDataCon   = [DataCon] -> DataCon
forall a. [a] -> a
head (TyCon -> [DataCon]
tyConDataCons TyCon
unitTyCon)

unitDataConId :: Id
unitDataConId :: TyVar
unitDataConId = DataCon -> TyVar
dataConWorkId DataCon
unitDataCon

pairTyCon :: TyCon
pairTyCon :: TyCon
pairTyCon = Boxity -> Arity -> TyCon
tupleTyCon Boxity
Boxed Arity
2

unboxedUnitTyCon :: TyCon
unboxedUnitTyCon :: TyCon
unboxedUnitTyCon = Boxity -> Arity -> TyCon
tupleTyCon Boxity
Unboxed Arity
0

unboxedUnitDataCon :: DataCon
unboxedUnitDataCon :: DataCon
unboxedUnitDataCon = Boxity -> Arity -> DataCon
tupleDataCon   Boxity
Unboxed Arity
0


{- *********************************************************************
*                                                                      *
      Unboxed sums
*                                                                      *
********************************************************************* -}

-- | OccName for n-ary unboxed sum type constructor.
mkSumTyConOcc :: Arity -> OccName
mkSumTyConOcc :: Arity -> OccName
mkSumTyConOcc Arity
n = NameSpace -> [Char] -> OccName
mkOccName NameSpace
tcName [Char]
str
  where
    -- No need to cache these, the caching is done in mk_sum
    str :: [Char]
str = Char
'(' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'#' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
bars [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"#)"
    bars :: [Char]
bars = Arity -> Char -> [Char]
forall a. Arity -> a -> [a]
replicate (Arity
nArity -> Arity -> Arity
forall a. Num a => a -> a -> a
-Arity
1) Char
'|'

-- | OccName for i-th alternative of n-ary unboxed sum data constructor.
mkSumDataConOcc :: ConTag -> Arity -> OccName
mkSumDataConOcc :: Arity -> Arity -> OccName
mkSumDataConOcc Arity
alt Arity
n = NameSpace -> [Char] -> OccName
mkOccName NameSpace
dataName [Char]
str
  where
    -- No need to cache these, the caching is done in mk_sum
    str :: [Char]
str = Char
'(' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'#' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Arity -> [Char]
bars Arity
alt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Char
'_' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Arity -> [Char]
bars (Arity
n Arity -> Arity -> Arity
forall a. Num a => a -> a -> a
- Arity
alt Arity -> Arity -> Arity
forall a. Num a => a -> a -> a
- Arity
1) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"#)"
    bars :: Arity -> [Char]
bars Arity
i = Arity -> Char -> [Char]
forall a. Arity -> a -> [a]
replicate Arity
i Char
'|'

-- | Type constructor for n-ary unboxed sum.
sumTyCon :: Arity -> TyCon
sumTyCon :: Arity -> TyCon
sumTyCon Arity
arity
  | Arity
arity Arity -> Arity -> Bool
forall a. Ord a => a -> a -> Bool
> Arity
mAX_SUM_SIZE
  = (TyCon, Array Arity DataCon) -> TyCon
forall a b. (a, b) -> a
fst (Arity -> (TyCon, Array Arity DataCon)
mk_sum Arity
arity)  -- Build one specially

  | Arity
arity Arity -> Arity -> Bool
forall a. Ord a => a -> a -> Bool
< Arity
2
  = [Char] -> TyCon
forall a. [Char] -> a
panic ([Char]
"sumTyCon: Arity starts from 2. (arity: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Arity -> [Char]
forall a. Show a => a -> [Char]
show Arity
arity [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")")

  | Bool
otherwise
  = (TyCon, Array Arity DataCon) -> TyCon
forall a b. (a, b) -> a
fst (Array Arity (TyCon, Array Arity DataCon)
unboxedSumArr Array Arity (TyCon, Array Arity DataCon)
-> Arity -> (TyCon, Array Arity DataCon)
forall i e. Ix i => Array i e -> i -> e
! Arity
arity)

-- | Data constructor for i-th alternative of a n-ary unboxed sum.
sumDataCon :: ConTag -- Alternative
           -> Arity  -- Arity
           -> DataCon
sumDataCon :: Arity -> Arity -> DataCon
sumDataCon Arity
alt Arity
arity
  | Arity
alt Arity -> Arity -> Bool
forall a. Ord a => a -> a -> Bool
> Arity
arity
  = [Char] -> DataCon
forall a. [Char] -> a
panic ([Char]
"sumDataCon: index out of bounds: alt: "
           [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Arity -> [Char]
forall a. Show a => a -> [Char]
show Arity
alt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" > arity " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Arity -> [Char]
forall a. Show a => a -> [Char]
show Arity
arity)

  | Arity
alt Arity -> Arity -> Bool
forall a. Ord a => a -> a -> Bool
<= Arity
0
  = [Char] -> DataCon
forall a. [Char] -> a
panic ([Char]
"sumDataCon: Alts start from 1. (alt: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Arity -> [Char]
forall a. Show a => a -> [Char]
show Arity
alt
           [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", arity: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Arity -> [Char]
forall a. Show a => a -> [Char]
show Arity
arity [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")")

  | Arity
arity Arity -> Arity -> Bool
forall a. Ord a => a -> a -> Bool
< Arity
2
  = [Char] -> DataCon
forall a. [Char] -> a
panic ([Char]
"sumDataCon: Arity starts from 2. (alt: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Arity -> [Char]
forall a. Show a => a -> [Char]
show Arity
alt
           [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", arity: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Arity -> [Char]
forall a. Show a => a -> [Char]
show Arity
arity [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")")

  | Arity
arity Arity -> Arity -> Bool
forall a. Ord a => a -> a -> Bool
> Arity
mAX_SUM_SIZE
  = (TyCon, Array Arity DataCon) -> Array Arity DataCon
forall a b. (a, b) -> b
snd (Arity -> (TyCon, Array Arity DataCon)
mk_sum Arity
arity) Array Arity DataCon -> Arity -> DataCon
forall i e. Ix i => Array i e -> i -> e
! (Arity
alt Arity -> Arity -> Arity
forall a. Num a => a -> a -> a
- Arity
1)  -- Build one specially

  | Bool
otherwise
  = (TyCon, Array Arity DataCon) -> Array Arity DataCon
forall a b. (a, b) -> b
snd (Array Arity (TyCon, Array Arity DataCon)
unboxedSumArr Array Arity (TyCon, Array Arity DataCon)
-> Arity -> (TyCon, Array Arity DataCon)
forall i e. Ix i => Array i e -> i -> e
! Arity
arity) Array Arity DataCon -> Arity -> DataCon
forall i e. Ix i => Array i e -> i -> e
! (Arity
alt Arity -> Arity -> Arity
forall a. Num a => a -> a -> a
- Arity
1)

-- | Cached type and data constructors for sums. The outer array is
-- indexed by the arity of the sum and the inner array is indexed by
-- the alternative.
unboxedSumArr :: Array Int (TyCon, Array Int DataCon)
unboxedSumArr :: Array Arity (TyCon, Array Arity DataCon)
unboxedSumArr = (Arity, Arity)
-> [(TyCon, Array Arity DataCon)]
-> Array Arity (TyCon, Array Arity DataCon)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Arity
2,Arity
mAX_SUM_SIZE) [Arity -> (TyCon, Array Arity DataCon)
mk_sum Arity
i | Arity
i <- [Arity
2..Arity
mAX_SUM_SIZE]]

-- | Specialization of 'unboxedTupleSumKind' for sums
unboxedSumKind :: [Type] -> Kind
unboxedSumKind :: [Type] -> Type
unboxedSumKind = TyCon -> [Type] -> Type
unboxedTupleSumKind TyCon
sumRepDataConTyCon

-- | Create type constructor and data constructors for n-ary unboxed sum.
mk_sum :: Arity -> (TyCon, Array ConTagZ DataCon)
mk_sum :: Arity -> (TyCon, Array Arity DataCon)
mk_sum Arity
arity = (TyCon
tycon, Array Arity DataCon
sum_cons)
  where
    tycon :: TyCon
tycon   = Name
-> [TyConBinder]
-> Type
-> Arity
-> [TyVar]
-> [DataCon]
-> AlgTyConFlav
-> TyCon
mkSumTyCon Name
tc_name [TyConBinder]
tc_binders Type
tc_res_kind (Arity
arity Arity -> Arity -> Arity
forall a. Num a => a -> a -> a
* Arity
2) [TyVar]
tyvars (Array Arity DataCon -> [DataCon]
forall i e. Array i e -> [e]
elems Array Arity DataCon
sum_cons)
                         (Maybe Name -> AlgTyConFlav
UnboxedAlgTyCon Maybe Name
forall a. Maybe a
rep_name)

    -- Unboxed sums are currently not Typeable due to efficiency concerns. See #13276.
    rep_name :: Maybe a
rep_name = Maybe a
forall a. Maybe a
Nothing -- Just $ mkPrelTyConRepName tc_name

    tc_binders :: [TyConBinder]
tc_binders = [Type] -> ([Type] -> [Type]) -> [TyConBinder]
mkTemplateTyConBinders (Arity -> Type -> [Type]
forall a. Arity -> a -> [a]
replicate Arity
arity Type
runtimeRepTy)
                                        (\[Type]
ks -> (Type -> Type) -> [Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Type
tYPE [Type]
ks)

    tyvars :: [TyVar]
tyvars = [TyConBinder] -> [TyVar]
forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
tc_binders

    tc_res_kind :: Type
tc_res_kind = [Type] -> Type
unboxedSumKind [Type]
rr_tys

    ([Type]
rr_tys, [Type]
tyvar_tys) = Arity -> [Type] -> ([Type], [Type])
forall a. Arity -> [a] -> ([a], [a])
splitAt Arity
arity ([TyVar] -> [Type]
mkTyVarTys [TyVar]
tyvars)

    tc_name :: Name
tc_name = Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
mkWiredInName Module
gHC_PRIM (Arity -> OccName
mkSumTyConOcc Arity
arity) Unique
tc_uniq
                            (TyCon -> TyThing
ATyCon TyCon
tycon) BuiltInSyntax
BuiltInSyntax

    sum_cons :: Array Arity DataCon
sum_cons = (Arity, Arity) -> [DataCon] -> Array Arity DataCon
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Arity
0,Arity
arityArity -> Arity -> Arity
forall a. Num a => a -> a -> a
-Arity
1) [Arity -> DataCon
sum_con Arity
i | Arity
i <- [Arity
0..Arity
arityArity -> Arity -> Arity
forall a. Num a => a -> a -> a
-Arity
1]]
    sum_con :: Arity -> DataCon
sum_con Arity
i = let dc :: DataCon
dc = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
dc_name
                                   [TyVar]
tyvars -- univ tyvars
                                   [[Type]
tyvar_tys [Type] -> Arity -> Type
forall a. [a] -> Arity -> a
!! Arity
i] -- arg types
                                   TyCon
tycon

                    dc_name :: Name
dc_name = Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
mkWiredInName Module
gHC_PRIM
                                            (Arity -> Arity -> OccName
mkSumDataConOcc Arity
i Arity
arity)
                                            (Arity -> Unique
dc_uniq Arity
i)
                                            (ConLike -> TyThing
AConLike (DataCon -> ConLike
RealDataCon DataCon
dc))
                                            BuiltInSyntax
BuiltInSyntax
                in DataCon
dc

    tc_uniq :: Unique
tc_uniq   = Arity -> Unique
mkSumTyConUnique   Arity
arity
    dc_uniq :: Arity -> Unique
dc_uniq Arity
i = Arity -> Arity -> Unique
mkSumDataConUnique Arity
i Arity
arity

{-
************************************************************************
*                                                                      *
              Equality types and classes
*                                                                      *
********************************************************************* -}

-- See Note [The equality types story] in GHC.Builtin.Types.Prim
-- ((~~) :: forall k1 k2 (a :: k1) (b :: k2). a -> b -> Constraint)
--
-- It's tempting to put functional dependencies on (~~), but it's not
-- necessary because the functional-dependency coverage check looks
-- through superclasses, and (~#) is handled in that check.

eqTyCon,   heqTyCon,   coercibleTyCon   :: TyCon
eqClass,   heqClass,   coercibleClass   :: Class
eqDataCon, heqDataCon, coercibleDataCon :: DataCon
eqSCSelId, heqSCSelId, coercibleSCSelId :: Id

(TyCon
eqTyCon, Class
eqClass, DataCon
eqDataCon, TyVar
eqSCSelId)
  = (TyCon
tycon, Class
klass, DataCon
datacon, TyVar
sc_sel_id)
  where
    tycon :: TyCon
tycon     = Name
-> [TyConBinder] -> [Role] -> AlgTyConRhs -> Class -> Name -> TyCon
mkClassTyCon Name
eqTyConName [TyConBinder]
binders [Role]
roles
                             AlgTyConRhs
rhs Class
klass
                             (Name -> Name
mkPrelTyConRepName Name
eqTyConName)
    klass :: Class
klass     = TyCon -> Type -> TyVar -> Class
mk_class TyCon
tycon Type
sc_pred TyVar
sc_sel_id
    datacon :: DataCon
datacon   = Name -> [TyVar] -> [Scaled Type] -> TyCon -> DataCon
pcDataConW Name
eqDataConName [TyVar]
tvs [Type -> Scaled Type
forall a. a -> Scaled a
unrestricted Type
sc_pred] TyCon
tycon

    -- Kind: forall k. k -> k -> Constraint
    binders :: [TyConBinder]
binders   = [Type] -> ([Type] -> [Type]) -> [TyConBinder]
mkTemplateTyConBinders [Type
liftedTypeKind] (\[Type
k] -> [Type
k,Type
k])
    roles :: [Role]
roles     = [Role
Nominal, Role
Nominal, Role
Nominal]
    rhs :: AlgTyConRhs
rhs       = [DataCon] -> AlgTyConRhs
mkDataTyConRhs [DataCon
datacon]

    tvs :: [TyVar]
tvs@[TyVar
k,TyVar
a,TyVar
b] = [TyConBinder] -> [TyVar]
forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
binders
    sc_pred :: Type
sc_pred     = TyCon -> [Type] -> Type
mkTyConApp TyCon
eqPrimTyCon ([TyVar] -> [Type]
mkTyVarTys [TyVar
k,TyVar
k,TyVar
a,TyVar
b])
    sc_sel_id :: TyVar
sc_sel_id   = Name -> Class -> TyVar
mkDictSelId Name
eqSCSelIdName Class
klass

(TyCon
heqTyCon, Class
heqClass, DataCon
heqDataCon, TyVar
heqSCSelId)
  = (TyCon
tycon, Class
klass, DataCon
datacon, TyVar
sc_sel_id)
  where
    tycon :: TyCon
tycon     = Name
-> [TyConBinder] -> [Role] -> AlgTyConRhs -> Class -> Name -> TyCon
mkClassTyCon Name
heqTyConName [TyConBinder]
binders [Role]
roles
                             AlgTyConRhs
rhs Class
klass
                             (Name -> Name
mkPrelTyConRepName Name
heqTyConName)
    klass :: Class
klass     = TyCon -> Type -> TyVar -> Class
mk_class TyCon
tycon Type
sc_pred TyVar
sc_sel_id
    datacon :: DataCon
datacon   = Name -> [TyVar] -> [Scaled Type] -> TyCon -> DataCon
pcDataConW Name
heqDataConName [TyVar]
tvs [Type -> Scaled Type
forall a. a -> Scaled a
unrestricted Type
sc_pred] TyCon
tycon

    -- Kind: forall k1 k2. k1 -> k2 -> Constraint
    binders :: [TyConBinder]
binders   = [Type] -> ([Type] -> [Type]) -> [TyConBinder]
mkTemplateTyConBinders [Type
liftedTypeKind, Type
liftedTypeKind] [Type] -> [Type]
forall a. a -> a
id
    roles :: [Role]
roles     = [Role
Nominal, Role
Nominal, Role
Nominal, Role
Nominal]
    rhs :: AlgTyConRhs
rhs       = [DataCon] -> AlgTyConRhs
mkDataTyConRhs [DataCon
datacon]

    tvs :: [TyVar]
tvs       = [TyConBinder] -> [TyVar]
forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
binders
    sc_pred :: Type
sc_pred   = TyCon -> [Type] -> Type
mkTyConApp TyCon
eqPrimTyCon ([TyVar] -> [Type]
mkTyVarTys [TyVar]
tvs)
    sc_sel_id :: TyVar
sc_sel_id = Name -> Class -> TyVar
mkDictSelId Name
heqSCSelIdName Class
klass

(TyCon
coercibleTyCon, Class
coercibleClass, DataCon
coercibleDataCon, TyVar
coercibleSCSelId)
  = (TyCon
tycon, Class
klass, DataCon
datacon, TyVar
sc_sel_id)
  where
    tycon :: TyCon
tycon     = Name
-> [TyConBinder] -> [Role] -> AlgTyConRhs -> Class -> Name -> TyCon
mkClassTyCon Name
coercibleTyConName [TyConBinder]
binders [Role]
roles
                             AlgTyConRhs
rhs Class
klass
                             (Name -> Name
mkPrelTyConRepName Name
coercibleTyConName)
    klass :: Class
klass     = TyCon -> Type -> TyVar -> Class
mk_class TyCon
tycon Type
sc_pred TyVar
sc_sel_id
    datacon :: DataCon
datacon   = Name -> [TyVar] -> [Scaled Type] -> TyCon -> DataCon
pcDataConW Name
coercibleDataConName [TyVar]
tvs [Type -> Scaled Type
forall a. a -> Scaled a
unrestricted Type
sc_pred] TyCon
tycon

    -- Kind: forall k. k -> k -> Constraint
    binders :: [TyConBinder]
binders   = [Type] -> ([Type] -> [Type]) -> [TyConBinder]
mkTemplateTyConBinders [Type
liftedTypeKind] (\[Type
k] -> [Type
k,Type
k])
    roles :: [Role]
roles     = [Role
Nominal, Role
Representational, Role
Representational]
    rhs :: AlgTyConRhs
rhs       = [DataCon] -> AlgTyConRhs
mkDataTyConRhs [DataCon
datacon]

    tvs :: [TyVar]
tvs@[TyVar
k,TyVar
a,TyVar
b] = [TyConBinder] -> [TyVar]
forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
binders
    sc_pred :: Type
sc_pred     = TyCon -> [Type] -> Type
mkTyConApp TyCon
eqReprPrimTyCon ([TyVar] -> [Type]
mkTyVarTys [TyVar
k, TyVar
k, TyVar
a, TyVar
b])
    sc_sel_id :: TyVar
sc_sel_id   = Name -> Class -> TyVar
mkDictSelId Name
coercibleSCSelIdName Class
klass

mk_class :: TyCon -> PredType -> Id -> Class
mk_class :: TyCon -> Type -> TyVar -> Class
mk_class TyCon
tycon Type
sc_pred TyVar
sc_sel_id
  = Name
-> [TyVar]
-> [FunDep TyVar]
-> [Type]
-> [TyVar]
-> [ClassATItem]
-> [ClassOpItem]
-> ClassMinimalDef
-> TyCon
-> Class
mkClass (TyCon -> Name
tyConName TyCon
tycon) (TyCon -> [TyVar]
tyConTyVars TyCon
tycon) [] [Type
sc_pred] [TyVar
sc_sel_id]
            [] [] ([LBooleanFormula Name] -> ClassMinimalDef
forall a. Eq a => [LBooleanFormula a] -> BooleanFormula a
mkAnd []) TyCon
tycon



{- *********************************************************************
*                                                                      *
                Multiplicity Polymorphism
*                                                                      *
********************************************************************* -}

{- Multiplicity polymorphism is implemented very similarly to levity
 polymorphism. We write in the multiplicity kind and the One and Many
 types which can appear in user programs. These are defined properly in GHC.Types.

data Multiplicity = One | Many
-}

multiplicityTy :: Type
multiplicityTy :: Type
multiplicityTy = TyCon -> Type
mkTyConTy TyCon
multiplicityTyCon

multiplicityTyCon :: TyCon
multiplicityTyCon :: TyCon
multiplicityTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
multiplicityTyConName Maybe CType
forall a. Maybe a
Nothing []
                          [DataCon
oneDataCon, DataCon
manyDataCon]

oneDataCon, manyDataCon :: DataCon
oneDataCon :: DataCon
oneDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
oneDataConName [] [] TyCon
multiplicityTyCon
manyDataCon :: DataCon
manyDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
manyDataConName [] [] TyCon
multiplicityTyCon

oneDataConTy, manyDataConTy :: Type
oneDataConTy :: Type
oneDataConTy = TyCon -> Type
mkTyConTy TyCon
oneDataConTyCon
manyDataConTy :: Type
manyDataConTy = TyCon -> Type
mkTyConTy TyCon
manyDataConTyCon

oneDataConTyCon, manyDataConTyCon :: TyCon
oneDataConTyCon :: TyCon
oneDataConTyCon = DataCon -> TyCon
promoteDataCon DataCon
oneDataCon
manyDataConTyCon :: TyCon
manyDataConTyCon = DataCon -> TyCon
promoteDataCon DataCon
manyDataCon

multMulTyConName :: Name
multMulTyConName :: Name
multMulTyConName =
    BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"MultMul") Unique
multMulTyConKey TyCon
multMulTyCon

multMulTyCon :: TyCon
multMulTyCon :: TyCon
multMulTyCon = Name
-> [TyConBinder]
-> Type
-> Maybe Name
-> FamTyConFlav
-> Maybe Class
-> Injectivity
-> TyCon
mkFamilyTyCon Name
multMulTyConName [TyConBinder]
binders Type
multiplicityTy Maybe Name
forall a. Maybe a
Nothing
                         (BuiltInSynFamily -> FamTyConFlav
BuiltInSynFamTyCon BuiltInSynFamily
trivialBuiltInFamily)
                         Maybe Class
forall a. Maybe a
Nothing
                         Injectivity
NotInjective
  where
    binders :: [TyConBinder]
binders = [Type] -> [TyConBinder]
mkTemplateAnonTyConBinders [Type
multiplicityTy, Type
multiplicityTy]

unrestrictedFunTy :: Type
unrestrictedFunTy :: Type
unrestrictedFunTy = Type -> Type
functionWithMultiplicity Type
manyDataConTy

unrestrictedFunTyCon :: TyCon
unrestrictedFunTyCon :: TyCon
unrestrictedFunTyCon = Name -> [TyConBinder] -> Type -> [Role] -> Type -> TyCon
buildSynTyCon Name
unrestrictedFunTyConName [] Type
arrowKind [] Type
unrestrictedFunTy
  where arrowKind :: Type
arrowKind = [TyConBinder] -> Type -> Type
mkTyConKind [TyConBinder]
binders Type
liftedTypeKind
        -- See also funTyCon
        binders :: [TyConBinder]
binders = [ TyVar -> TyConBndrVis -> TyConBinder
forall var argf. var -> argf -> VarBndr var argf
Bndr TyVar
runtimeRep1TyVar (ArgFlag -> TyConBndrVis
NamedTCB ArgFlag
Inferred)
                  , TyVar -> TyConBndrVis -> TyConBinder
forall var argf. var -> argf -> VarBndr var argf
Bndr TyVar
runtimeRep2TyVar (ArgFlag -> TyConBndrVis
NamedTCB ArgFlag
Inferred)
                  ]
                  [TyConBinder] -> [TyConBinder] -> [TyConBinder]
forall a. [a] -> [a] -> [a]
++ [Type] -> [TyConBinder]
mkTemplateAnonTyConBinders [ Type -> Type
tYPE Type
runtimeRep1Ty
                                                , Type -> Type
tYPE Type
runtimeRep2Ty
                                                ]

unrestrictedFunTyConName :: Name
unrestrictedFunTyConName :: Name
unrestrictedFunTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
BuiltInSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"->") Unique
unrestrictedFunTyConKey TyCon
unrestrictedFunTyCon

{- *********************************************************************
*                                                                      *
                Kinds and RuntimeRep
*                                                                      *
********************************************************************* -}

-- For information about the usage of the following type,
-- see Note [TYPE and RuntimeRep] in module GHC.Builtin.Types.Prim
runtimeRepTy :: Type
runtimeRepTy :: Type
runtimeRepTy = TyCon -> Type
mkTyConTy TyCon
runtimeRepTyCon

-- Type synonyms; see Note [TYPE and RuntimeRep] in GHC.Builtin.Types.Prim
-- type Type = tYPE 'LiftedRep
liftedTypeKindTyCon :: TyCon
liftedTypeKindTyCon :: TyCon
liftedTypeKindTyCon   = Name -> [TyConBinder] -> Type -> [Role] -> Type -> TyCon
buildSynTyCon Name
liftedTypeKindTyConName
                                       [] Type
liftedTypeKind []
                                       (Type -> Type
tYPE Type
liftedRepTy)

runtimeRepTyCon :: TyCon
runtimeRepTyCon :: TyCon
runtimeRepTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
runtimeRepTyConName Maybe CType
forall a. Maybe a
Nothing []
                          (DataCon
vecRepDataCon DataCon -> [DataCon] -> [DataCon]
forall a. a -> [a] -> [a]
: DataCon
tupleRepDataCon DataCon -> [DataCon] -> [DataCon]
forall a. a -> [a] -> [a]
:
                           DataCon
sumRepDataCon DataCon -> [DataCon] -> [DataCon]
forall a. a -> [a] -> [a]
: [DataCon]
runtimeRepSimpleDataCons)

vecRepDataCon :: DataCon
vecRepDataCon :: DataCon
vecRepDataCon = Name -> [Type] -> TyCon -> RuntimeRepInfo -> DataCon
pcSpecialDataCon Name
vecRepDataConName [ TyCon -> Type
mkTyConTy TyCon
vecCountTyCon
                                                   , TyCon -> Type
mkTyConTy TyCon
vecElemTyCon ]
                                 TyCon
runtimeRepTyCon
                                 (([Type] -> [PrimRep]) -> RuntimeRepInfo
RuntimeRep [Type] -> [PrimRep]
prim_rep_fun)
  where
    -- See Note [Getting from RuntimeRep to PrimRep] in GHC.Types.RepType
    prim_rep_fun :: [Type] -> [PrimRep]
prim_rep_fun [Type
count, Type
elem]
      | VecCount Arity
n <- TyCon -> RuntimeRepInfo
tyConRuntimeRepInfo (Type -> TyCon
tyConAppTyCon Type
count)
      , VecElem  PrimElemRep
e <- TyCon -> RuntimeRepInfo
tyConRuntimeRepInfo (Type -> TyCon
tyConAppTyCon Type
elem)
      = [Arity -> PrimElemRep -> PrimRep
VecRep Arity
n PrimElemRep
e]
    prim_rep_fun [Type]
args
      = [Char] -> SDoc -> [PrimRep]
forall a. HasCallStack => [Char] -> SDoc -> a
pprPanic [Char]
"vecRepDataCon" ([Type] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type]
args)

vecRepDataConTyCon :: TyCon
vecRepDataConTyCon :: TyCon
vecRepDataConTyCon = DataCon -> TyCon
promoteDataCon DataCon
vecRepDataCon

tupleRepDataCon :: DataCon
tupleRepDataCon :: DataCon
tupleRepDataCon = Name -> [Type] -> TyCon -> RuntimeRepInfo -> DataCon
pcSpecialDataCon Name
tupleRepDataConName [ Type -> Type
mkListTy Type
runtimeRepTy ]
                                   TyCon
runtimeRepTyCon (([Type] -> [PrimRep]) -> RuntimeRepInfo
RuntimeRep [Type] -> [PrimRep]
prim_rep_fun)
  where
    -- See Note [Getting from RuntimeRep to PrimRep] in GHC.Types.RepType
    prim_rep_fun :: [Type] -> [PrimRep]
prim_rep_fun [Type
rr_ty_list]
      = (Type -> [PrimRep]) -> [Type] -> [PrimRep]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (HasDebugCallStack => SDoc -> Type -> [PrimRep]
SDoc -> Type -> [PrimRep]
runtimeRepPrimRep SDoc
doc) [Type]
rr_tys
      where
        rr_tys :: [Type]
rr_tys = Type -> [Type]
extractPromotedList Type
rr_ty_list
        doc :: SDoc
doc    = [Char] -> SDoc
text [Char]
"tupleRepDataCon" SDoc -> SDoc -> SDoc
<+> [Type] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type]
rr_tys
    prim_rep_fun [Type]
args
      = [Char] -> SDoc -> [PrimRep]
forall a. HasCallStack => [Char] -> SDoc -> a
pprPanic [Char]
"tupleRepDataCon" ([Type] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type]
args)

tupleRepDataConTyCon :: TyCon
tupleRepDataConTyCon :: TyCon
tupleRepDataConTyCon = DataCon -> TyCon
promoteDataCon DataCon
tupleRepDataCon

sumRepDataCon :: DataCon
sumRepDataCon :: DataCon
sumRepDataCon = Name -> [Type] -> TyCon -> RuntimeRepInfo -> DataCon
pcSpecialDataCon Name
sumRepDataConName [ Type -> Type
mkListTy Type
runtimeRepTy ]
                                 TyCon
runtimeRepTyCon (([Type] -> [PrimRep]) -> RuntimeRepInfo
RuntimeRep [Type] -> [PrimRep]
prim_rep_fun)
  where
    -- See Note [Getting from RuntimeRep to PrimRep] in GHC.Types.RepType
    prim_rep_fun :: [Type] -> [PrimRep]
prim_rep_fun [Type
rr_ty_list]
      = (SlotTy -> PrimRep) -> [SlotTy] -> [PrimRep]
forall a b. (a -> b) -> [a] -> [b]
map SlotTy -> PrimRep
slotPrimRep ([[PrimRep]] -> [SlotTy]
ubxSumRepType [[PrimRep]]
prim_repss)
      where
        rr_tys :: [Type]
rr_tys     = Type -> [Type]
extractPromotedList Type
rr_ty_list
        doc :: SDoc
doc        = [Char] -> SDoc
text [Char]
"sumRepDataCon" SDoc -> SDoc -> SDoc
<+> [Type] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type]
rr_tys
        prim_repss :: [[PrimRep]]
prim_repss = (Type -> [PrimRep]) -> [Type] -> [[PrimRep]]
forall a b. (a -> b) -> [a] -> [b]
map (HasDebugCallStack => SDoc -> Type -> [PrimRep]
SDoc -> Type -> [PrimRep]
runtimeRepPrimRep SDoc
doc) [Type]
rr_tys
    prim_rep_fun [Type]
args
      = [Char] -> SDoc -> [PrimRep]
forall a. HasCallStack => [Char] -> SDoc -> a
pprPanic [Char]
"sumRepDataCon" ([Type] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type]
args)

sumRepDataConTyCon :: TyCon
sumRepDataConTyCon :: TyCon
sumRepDataConTyCon = DataCon -> TyCon
promoteDataCon DataCon
sumRepDataCon

-- See Note [Wiring in RuntimeRep]
-- See Note [Getting from RuntimeRep to PrimRep] in GHC.Types.RepType
runtimeRepSimpleDataCons :: [DataCon]
liftedRepDataCon :: DataCon
runtimeRepSimpleDataCons :: [DataCon]
runtimeRepSimpleDataCons@(DataCon
liftedRepDataCon : [DataCon]
_)
  = (PrimRep -> Name -> DataCon) -> [PrimRep] -> [Name] -> [DataCon]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWithLazy PrimRep -> Name -> DataCon
mk_runtime_rep_dc
    [ PrimRep
LiftedRep, PrimRep
UnliftedRep
    , PrimRep
IntRep
    , PrimRep
Int8Rep, PrimRep
Int16Rep, PrimRep
Int32Rep, PrimRep
Int64Rep
    , PrimRep
WordRep
    , PrimRep
Word8Rep, PrimRep
Word16Rep, PrimRep
Word32Rep, PrimRep
Word64Rep
    , PrimRep
AddrRep
    , PrimRep
FloatRep, PrimRep
DoubleRep
    ]
    [Name]
runtimeRepSimpleDataConNames
  where
    mk_runtime_rep_dc :: PrimRep -> Name -> DataCon
mk_runtime_rep_dc PrimRep
primrep Name
name
      = Name -> [Type] -> TyCon -> RuntimeRepInfo -> DataCon
pcSpecialDataCon Name
name [] TyCon
runtimeRepTyCon (([Type] -> [PrimRep]) -> RuntimeRepInfo
RuntimeRep (\[Type]
_ -> [PrimRep
primrep]))

-- See Note [Wiring in RuntimeRep]
liftedRepDataConTy, unliftedRepDataConTy,
  intRepDataConTy,
  int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy,
  wordRepDataConTy,
  word8RepDataConTy, word16RepDataConTy, word32RepDataConTy, word64RepDataConTy,
  addrRepDataConTy,
  floatRepDataConTy, doubleRepDataConTy :: Type
[Type
liftedRepDataConTy, Type
unliftedRepDataConTy,
   Type
intRepDataConTy,
   Type
int8RepDataConTy, Type
int16RepDataConTy, Type
int32RepDataConTy, Type
int64RepDataConTy,
   Type
wordRepDataConTy,
   Type
word8RepDataConTy, Type
word16RepDataConTy, Type
word32RepDataConTy, Type
word64RepDataConTy,
   Type
addrRepDataConTy,
   Type
floatRepDataConTy, Type
doubleRepDataConTy
   ]
  = (DataCon -> Type) -> [DataCon] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map (TyCon -> Type
mkTyConTy (TyCon -> Type) -> (DataCon -> TyCon) -> DataCon -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataCon -> TyCon
promoteDataCon) [DataCon]
runtimeRepSimpleDataCons

vecCountTyCon :: TyCon
vecCountTyCon :: TyCon
vecCountTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
vecCountTyConName Maybe CType
forall a. Maybe a
Nothing [] [DataCon]
vecCountDataCons

-- See Note [Wiring in RuntimeRep]
vecCountDataCons :: [DataCon]
vecCountDataCons :: [DataCon]
vecCountDataCons = (Arity -> Name -> DataCon) -> [Arity] -> [Name] -> [DataCon]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWithLazy Arity -> Name -> DataCon
mk_vec_count_dc
                     [ Arity
2, Arity
4, Arity
8, Arity
16, Arity
32, Arity
64 ]
                     [Name]
vecCountDataConNames
  where
    mk_vec_count_dc :: Arity -> Name -> DataCon
mk_vec_count_dc Arity
n Name
name
      = Name -> [Type] -> TyCon -> RuntimeRepInfo -> DataCon
pcSpecialDataCon Name
name [] TyCon
vecCountTyCon (Arity -> RuntimeRepInfo
VecCount Arity
n)

-- See Note [Wiring in RuntimeRep]
vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy,
  vec64DataConTy :: Type
[Type
vec2DataConTy, Type
vec4DataConTy, Type
vec8DataConTy, Type
vec16DataConTy, Type
vec32DataConTy,
  Type
vec64DataConTy] = (DataCon -> Type) -> [DataCon] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map (TyCon -> Type
mkTyConTy (TyCon -> Type) -> (DataCon -> TyCon) -> DataCon -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataCon -> TyCon
promoteDataCon) [DataCon]
vecCountDataCons

vecElemTyCon :: TyCon
vecElemTyCon :: TyCon
vecElemTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
vecElemTyConName Maybe CType
forall a. Maybe a
Nothing [] [DataCon]
vecElemDataCons

-- See Note [Wiring in RuntimeRep]
vecElemDataCons :: [DataCon]
vecElemDataCons :: [DataCon]
vecElemDataCons = (PrimElemRep -> Name -> DataCon)
-> [PrimElemRep] -> [Name] -> [DataCon]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWithLazy PrimElemRep -> Name -> DataCon
mk_vec_elem_dc
                    [ PrimElemRep
Int8ElemRep, PrimElemRep
Int16ElemRep, PrimElemRep
Int32ElemRep, PrimElemRep
Int64ElemRep
                    , PrimElemRep
Word8ElemRep, PrimElemRep
Word16ElemRep, PrimElemRep
Word32ElemRep, PrimElemRep
Word64ElemRep
                    , PrimElemRep
FloatElemRep, PrimElemRep
DoubleElemRep ]
                    [Name]
vecElemDataConNames
  where
    mk_vec_elem_dc :: PrimElemRep -> Name -> DataCon
mk_vec_elem_dc PrimElemRep
elem Name
name
      = Name -> [Type] -> TyCon -> RuntimeRepInfo -> DataCon
pcSpecialDataCon Name
name [] TyCon
vecElemTyCon (PrimElemRep -> RuntimeRepInfo
VecElem PrimElemRep
elem)

-- See Note [Wiring in RuntimeRep]
int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy,
  int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy,
  word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy,
  doubleElemRepDataConTy :: Type
[Type
int8ElemRepDataConTy, Type
int16ElemRepDataConTy, Type
int32ElemRepDataConTy,
  Type
int64ElemRepDataConTy, Type
word8ElemRepDataConTy, Type
word16ElemRepDataConTy,
  Type
word32ElemRepDataConTy, Type
word64ElemRepDataConTy, Type
floatElemRepDataConTy,
  Type
doubleElemRepDataConTy] = (DataCon -> Type) -> [DataCon] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map (TyCon -> Type
mkTyConTy (TyCon -> Type) -> (DataCon -> TyCon) -> DataCon -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataCon -> TyCon
promoteDataCon)
                                [DataCon]
vecElemDataCons

liftedRepDataConTyCon :: TyCon
liftedRepDataConTyCon :: TyCon
liftedRepDataConTyCon = DataCon -> TyCon
promoteDataCon DataCon
liftedRepDataCon

-- The type ('LiftedRep)
liftedRepTy :: Type
liftedRepTy :: Type
liftedRepTy = Type
liftedRepDataConTy

{- *********************************************************************
*                                                                      *
     The boxed primitive types: Char, Int, etc
*                                                                      *
********************************************************************* -}

boxingDataCon_maybe :: TyCon -> Maybe DataCon
--    boxingDataCon_maybe Char# = C#
--    boxingDataCon_maybe Int#  = I#
--    ... etc ...
-- See Note [Boxing primitive types]
boxingDataCon_maybe :: TyCon -> Maybe DataCon
boxingDataCon_maybe TyCon
tc
  = NameEnv DataCon -> Name -> Maybe DataCon
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv NameEnv DataCon
boxing_constr_env (TyCon -> Name
tyConName TyCon
tc)

boxing_constr_env :: NameEnv DataCon
boxing_constr_env :: NameEnv DataCon
boxing_constr_env
  = [(Name, DataCon)] -> NameEnv DataCon
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(Name
charPrimTyConName  , DataCon
charDataCon  )
              ,(Name
intPrimTyConName   , DataCon
intDataCon   )
              ,(Name
wordPrimTyConName  , DataCon
wordDataCon  )
              ,(Name
floatPrimTyConName , DataCon
floatDataCon )
              ,(Name
doublePrimTyConName, DataCon
doubleDataCon) ]

{- Note [Boxing primitive types]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For a handful of primitive types (Int, Char, Word, Float, Double),
we can readily box and an unboxed version (Int#, Char# etc) using
the corresponding data constructor.  This is useful in a couple
of places, notably let-floating -}


charTy :: Type
charTy :: Type
charTy = TyCon -> Type
mkTyConTy TyCon
charTyCon

charTyCon :: TyCon
charTyCon :: TyCon
charTyCon   = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
charTyConName
                   (CType -> Maybe CType
forall a. a -> Maybe a
Just (SourceText -> Maybe Header -> (SourceText, FastString) -> CType
CType SourceText
NoSourceText Maybe Header
forall a. Maybe a
Nothing
                                  (SourceText
NoSourceText,[Char] -> FastString
fsLit [Char]
"HsChar")))
                   [] [DataCon
charDataCon]
charDataCon :: DataCon
charDataCon :: DataCon
charDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
charDataConName [] [Type
charPrimTy] TyCon
charTyCon

stringTy :: Type
stringTy :: Type
stringTy = TyCon -> [Type] -> Type
mkTyConApp TyCon
stringTyCon []

stringTyCon :: TyCon
-- We have this wired-in so that Haskell literal strings
-- get type String (in hsLitType), which in turn influences
-- inferred types and error messages
stringTyCon :: TyCon
stringTyCon = Name -> [TyConBinder] -> Type -> [Role] -> Type -> TyCon
buildSynTyCon Name
stringTyConName
                            [] Type
liftedTypeKind []
                            (Type -> Type
mkListTy Type
charTy)

intTy :: Type
intTy :: Type
intTy = TyCon -> Type
mkTyConTy TyCon
intTyCon

intTyCon :: TyCon
intTyCon :: TyCon
intTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
intTyConName
               (CType -> Maybe CType
forall a. a -> Maybe a
Just (SourceText -> Maybe Header -> (SourceText, FastString) -> CType
CType SourceText
NoSourceText Maybe Header
forall a. Maybe a
Nothing (SourceText
NoSourceText,[Char] -> FastString
fsLit [Char]
"HsInt")))
                 [] [DataCon
intDataCon]
intDataCon :: DataCon
intDataCon :: DataCon
intDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
intDataConName [] [Type
intPrimTy] TyCon
intTyCon

wordTy :: Type
wordTy :: Type
wordTy = TyCon -> Type
mkTyConTy TyCon
wordTyCon

wordTyCon :: TyCon
wordTyCon :: TyCon
wordTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
wordTyConName
            (CType -> Maybe CType
forall a. a -> Maybe a
Just (SourceText -> Maybe Header -> (SourceText, FastString) -> CType
CType SourceText
NoSourceText Maybe Header
forall a. Maybe a
Nothing (SourceText
NoSourceText, [Char] -> FastString
fsLit [Char]
"HsWord")))
               [] [DataCon
wordDataCon]
wordDataCon :: DataCon
wordDataCon :: DataCon
wordDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
wordDataConName [] [Type
wordPrimTy] TyCon
wordTyCon

word8Ty :: Type
word8Ty :: Type
word8Ty = TyCon -> Type
mkTyConTy TyCon
word8TyCon

word8TyCon :: TyCon
word8TyCon :: TyCon
word8TyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
word8TyConName
                     (CType -> Maybe CType
forall a. a -> Maybe a
Just (SourceText -> Maybe Header -> (SourceText, FastString) -> CType
CType SourceText
NoSourceText Maybe Header
forall a. Maybe a
Nothing
                            (SourceText
NoSourceText, [Char] -> FastString
fsLit [Char]
"HsWord8"))) []
                     [DataCon
word8DataCon]
word8DataCon :: DataCon
word8DataCon :: DataCon
word8DataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
word8DataConName [] [Type
wordPrimTy] TyCon
word8TyCon

floatTy :: Type
floatTy :: Type
floatTy = TyCon -> Type
mkTyConTy TyCon
floatTyCon

floatTyCon :: TyCon
floatTyCon :: TyCon
floatTyCon   = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
floatTyConName
                      (CType -> Maybe CType
forall a. a -> Maybe a
Just (SourceText -> Maybe Header -> (SourceText, FastString) -> CType
CType SourceText
NoSourceText Maybe Header
forall a. Maybe a
Nothing
                             (SourceText
NoSourceText, [Char] -> FastString
fsLit [Char]
"HsFloat"))) []
                      [DataCon
floatDataCon]
floatDataCon :: DataCon
floatDataCon :: DataCon
floatDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon         Name
floatDataConName [] [Type
floatPrimTy] TyCon
floatTyCon

doubleTy :: Type
doubleTy :: Type
doubleTy = TyCon -> Type
mkTyConTy TyCon
doubleTyCon

doubleTyCon :: TyCon
doubleTyCon :: TyCon
doubleTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
doubleTyConName
                      (CType -> Maybe CType
forall a. a -> Maybe a
Just (SourceText -> Maybe Header -> (SourceText, FastString) -> CType
CType SourceText
NoSourceText Maybe Header
forall a. Maybe a
Nothing
                             (SourceText
NoSourceText,[Char] -> FastString
fsLit [Char]
"HsDouble"))) []
                      [DataCon
doubleDataCon]

doubleDataCon :: DataCon
doubleDataCon :: DataCon
doubleDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
doubleDataConName [] [Type
doublePrimTy] TyCon
doubleTyCon

{-
************************************************************************
*                                                                      *
              The Bool type
*                                                                      *
************************************************************************

An ordinary enumeration type, but deeply wired in.  There are no
magical operations on @Bool@ (just the regular Prelude code).

{\em BEGIN IDLE SPECULATION BY SIMON}

This is not the only way to encode @Bool@.  A more obvious coding makes
@Bool@ just a boxed up version of @Bool#@, like this:
\begin{verbatim}
type Bool# = Int#
data Bool = MkBool Bool#
\end{verbatim}

Unfortunately, this doesn't correspond to what the Report says @Bool@
looks like!  Furthermore, we get slightly less efficient code (I
think) with this coding. @gtInt@ would look like this:

\begin{verbatim}
gtInt :: Int -> Int -> Bool
gtInt x y = case x of I# x# ->
            case y of I# y# ->
            case (gtIntPrim x# y#) of
                b# -> MkBool b#
\end{verbatim}

Notice that the result of the @gtIntPrim@ comparison has to be turned
into an integer (here called @b#@), and returned in a @MkBool@ box.

The @if@ expression would compile to this:
\begin{verbatim}
case (gtInt x y) of
  MkBool b# -> case b# of { 1# -> e1; 0# -> e2 }
\end{verbatim}

I think this code is a little less efficient than the previous code,
but I'm not certain.  At all events, corresponding with the Report is
important.  The interesting thing is that the language is expressive
enough to describe more than one alternative; and that a type doesn't
necessarily need to be a straightforwardly boxed version of its
primitive counterpart.

{\em END IDLE SPECULATION BY SIMON}
-}

boolTy :: Type
boolTy :: Type
boolTy = TyCon -> Type
mkTyConTy TyCon
boolTyCon

boolTyCon :: TyCon
boolTyCon :: TyCon
boolTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
boolTyConName
                    (CType -> Maybe CType
forall a. a -> Maybe a
Just (SourceText -> Maybe Header -> (SourceText, FastString) -> CType
CType SourceText
NoSourceText Maybe Header
forall a. Maybe a
Nothing
                           (SourceText
NoSourceText, [Char] -> FastString
fsLit [Char]
"HsBool")))
                    [] [DataCon
falseDataCon, DataCon
trueDataCon]

falseDataCon, trueDataCon :: DataCon
falseDataCon :: DataCon
falseDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
falseDataConName [] [] TyCon
boolTyCon
trueDataCon :: DataCon
trueDataCon  = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
trueDataConName  [] [] TyCon
boolTyCon

falseDataConId, trueDataConId :: Id
falseDataConId :: TyVar
falseDataConId = DataCon -> TyVar
dataConWorkId DataCon
falseDataCon
trueDataConId :: TyVar
trueDataConId  = DataCon -> TyVar
dataConWorkId DataCon
trueDataCon

orderingTyCon :: TyCon
orderingTyCon :: TyCon
orderingTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
orderingTyConName Maybe CType
forall a. Maybe a
Nothing
                        [] [DataCon
ordLTDataCon, DataCon
ordEQDataCon, DataCon
ordGTDataCon]

ordLTDataCon, ordEQDataCon, ordGTDataCon :: DataCon
ordLTDataCon :: DataCon
ordLTDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
ordLTDataConName  [] [] TyCon
orderingTyCon
ordEQDataCon :: DataCon
ordEQDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
ordEQDataConName  [] [] TyCon
orderingTyCon
ordGTDataCon :: DataCon
ordGTDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
ordGTDataConName  [] [] TyCon
orderingTyCon

ordLTDataConId, ordEQDataConId, ordGTDataConId :: Id
ordLTDataConId :: TyVar
ordLTDataConId = DataCon -> TyVar
dataConWorkId DataCon
ordLTDataCon
ordEQDataConId :: TyVar
ordEQDataConId = DataCon -> TyVar
dataConWorkId DataCon
ordEQDataCon
ordGTDataConId :: TyVar
ordGTDataConId = DataCon -> TyVar
dataConWorkId DataCon
ordGTDataCon

{-
************************************************************************
*                                                                      *
            The List type
   Special syntax, deeply wired in,
   but otherwise an ordinary algebraic data type
*                                                                      *
************************************************************************

       data [] a = [] | a : (List a)
-}

mkListTy :: Type -> Type
mkListTy :: Type -> Type
mkListTy Type
ty = TyCon -> [Type] -> Type
mkTyConApp TyCon
listTyCon [Type
ty]

listTyCon :: TyCon
listTyCon :: TyCon
listTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
listTyConName Maybe CType
forall a. Maybe a
Nothing [TyVar
alphaTyVar] [DataCon
nilDataCon, DataCon
consDataCon]

-- See also Note [Empty lists] in GHC.Hs.Expr.
nilDataCon :: DataCon
nilDataCon :: DataCon
nilDataCon  = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
nilDataConName [TyVar]
alpha_tyvar [] TyCon
listTyCon

consDataCon :: DataCon
consDataCon :: DataCon
consDataCon = Bool
-> Name
-> [TyVar]
-> [TyVar]
-> [TyVar]
-> [Scaled Type]
-> TyCon
-> DataCon
pcDataConWithFixity Bool
True {- Declared infix -}
               Name
consDataConName
               [TyVar]
alpha_tyvar [] [TyVar]
alpha_tyvar
               ((Type -> Scaled Type) -> [Type] -> [Scaled Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Scaled Type
forall a. a -> Scaled a
linear [Type
alphaTy, TyCon -> [Type] -> Type
mkTyConApp TyCon
listTyCon [Type]
alpha_ty]) TyCon
listTyCon
-- Interesting: polymorphic recursion would help here.
-- We can't use (mkListTy alphaTy) in the defn of consDataCon, else mkListTy
-- gets the over-specific type (Type -> Type)

-- Wired-in type Maybe

maybeTyCon :: TyCon
maybeTyCon :: TyCon
maybeTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
maybeTyConName Maybe CType
forall a. Maybe a
Nothing [TyVar]
alpha_tyvar
                     [DataCon
nothingDataCon, DataCon
justDataCon]

nothingDataCon :: DataCon
nothingDataCon :: DataCon
nothingDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
nothingDataConName [TyVar]
alpha_tyvar [] TyCon
maybeTyCon

justDataCon :: DataCon
justDataCon :: DataCon
justDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
justDataConName [TyVar]
alpha_tyvar [Type
alphaTy] TyCon
maybeTyCon

{-
** *********************************************************************
*                                                                      *
            The tuple types
*                                                                      *
************************************************************************

The tuple types are definitely magic, because they form an infinite
family.

\begin{itemize}
\item
They have a special family of type constructors, of type @TyCon@
These contain the tycon arity, but don't require a Unique.

\item
They have a special family of constructors, of type
@Id@. Again these contain their arity but don't need a Unique.

\item
There should be a magic way of generating the info tables and
entry code for all tuples.

But at the moment we just compile a Haskell source
file\srcloc{lib/prelude/...} containing declarations like:
\begin{verbatim}
data Tuple0             = Tup0
data Tuple2  a b        = Tup2  a b
data Tuple3  a b c      = Tup3  a b c
data Tuple4  a b c d    = Tup4  a b c d
...
\end{verbatim}
The print-names associated with the magic @Id@s for tuple constructors
``just happen'' to be the same as those generated by these
declarations.

\item
The instance environment should have a magic way to know
that each tuple type is an instances of classes @Eq@, @Ix@, @Ord@ and
so on. \ToDo{Not implemented yet.}

\item
There should also be a way to generate the appropriate code for each
of these instances, but (like the info tables and entry code) it is
done by enumeration\srcloc{lib/prelude/InTup?.hs}.
\end{itemize}
-}

-- | Make a tuple type. The list of types should /not/ include any
-- RuntimeRep specifications. Boxed 1-tuples are flattened.
-- See Note [One-tuples]
mkTupleTy :: Boxity -> [Type] -> Type
-- Special case for *boxed* 1-tuples, which are represented by the type itself
mkTupleTy :: Boxity -> [Type] -> Type
mkTupleTy Boxity
Boxed   [Type
ty] = Type
ty
mkTupleTy Boxity
boxity  [Type]
tys  = Boxity -> [Type] -> Type
mkTupleTy1 Boxity
boxity [Type]
tys

-- | Make a tuple type. The list of types should /not/ include any
-- RuntimeRep specifications. Boxed 1-tuples are *not* flattened.
-- See Note [One-tuples] and Note [Don't flatten tuples from HsSyn]
-- in "GHC.Core.Make"
mkTupleTy1 :: Boxity -> [Type] -> Type
mkTupleTy1 :: Boxity -> [Type] -> Type
mkTupleTy1 Boxity
Boxed   [Type]
tys  = TyCon -> [Type] -> Type
mkTyConApp (Boxity -> Arity -> TyCon
tupleTyCon Boxity
Boxed ([Type] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length [Type]
tys)) [Type]
tys
mkTupleTy1 Boxity
Unboxed [Type]
tys  = TyCon -> [Type] -> Type
mkTyConApp (Boxity -> Arity -> TyCon
tupleTyCon Boxity
Unboxed ([Type] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length [Type]
tys))
                                         ((Type -> Type) -> [Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map HasDebugCallStack => Type -> Type
Type -> Type
getRuntimeRep [Type]
tys [Type] -> [Type] -> [Type]
forall a. [a] -> [a] -> [a]
++ [Type]
tys)

-- | Build the type of a small tuple that holds the specified type of thing
-- Flattens 1-tuples. See Note [One-tuples].
mkBoxedTupleTy :: [Type] -> Type
mkBoxedTupleTy :: [Type] -> Type
mkBoxedTupleTy [Type]
tys = Boxity -> [Type] -> Type
mkTupleTy Boxity
Boxed [Type]
tys

unitTy :: Type
unitTy :: Type
unitTy = Boxity -> [Type] -> Type
mkTupleTy Boxity
Boxed []

{- *********************************************************************
*                                                                      *
            The sum types
*                                                                      *
************************************************************************
-}

mkSumTy :: [Type] -> Type
mkSumTy :: [Type] -> Type
mkSumTy [Type]
tys = TyCon -> [Type] -> Type
mkTyConApp (Arity -> TyCon
sumTyCon ([Type] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length [Type]
tys))
                         ((Type -> Type) -> [Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map HasDebugCallStack => Type -> Type
Type -> Type
getRuntimeRep [Type]
tys [Type] -> [Type] -> [Type]
forall a. [a] -> [a] -> [a]
++ [Type]
tys)

-- Promoted Booleans

promotedFalseDataCon, promotedTrueDataCon :: TyCon
promotedTrueDataCon :: TyCon
promotedTrueDataCon   = DataCon -> TyCon
promoteDataCon DataCon
trueDataCon
promotedFalseDataCon :: TyCon
promotedFalseDataCon  = DataCon -> TyCon
promoteDataCon DataCon
falseDataCon

-- Promoted Maybe
promotedNothingDataCon, promotedJustDataCon :: TyCon
promotedNothingDataCon :: TyCon
promotedNothingDataCon = DataCon -> TyCon
promoteDataCon DataCon
nothingDataCon
promotedJustDataCon :: TyCon
promotedJustDataCon    = DataCon -> TyCon
promoteDataCon DataCon
justDataCon

-- Promoted Ordering

promotedLTDataCon
  , promotedEQDataCon
  , promotedGTDataCon
  :: TyCon
promotedLTDataCon :: TyCon
promotedLTDataCon     = DataCon -> TyCon
promoteDataCon DataCon
ordLTDataCon
promotedEQDataCon :: TyCon
promotedEQDataCon     = DataCon -> TyCon
promoteDataCon DataCon
ordEQDataCon
promotedGTDataCon :: TyCon
promotedGTDataCon     = DataCon -> TyCon
promoteDataCon DataCon
ordGTDataCon

-- Promoted List
promotedConsDataCon, promotedNilDataCon :: TyCon
promotedConsDataCon :: TyCon
promotedConsDataCon   = DataCon -> TyCon
promoteDataCon DataCon
consDataCon
promotedNilDataCon :: TyCon
promotedNilDataCon    = DataCon -> TyCon
promoteDataCon DataCon
nilDataCon

-- | Make a *promoted* list.
mkPromotedListTy :: Kind   -- ^ of the elements of the list
                 -> [Type] -- ^ elements
                 -> Type
mkPromotedListTy :: Type -> [Type] -> Type
mkPromotedListTy Type
k [Type]
tys
  = (Type -> Type -> Type) -> Type -> [Type] -> Type
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Type -> Type -> Type
cons Type
nil [Type]
tys
  where
    cons :: Type  -- element
         -> Type  -- list
         -> Type
    cons :: Type -> Type -> Type
cons Type
elt Type
list = TyCon -> [Type] -> Type
mkTyConApp TyCon
promotedConsDataCon [Type
k, Type
elt, Type
list]

    nil :: Type
    nil :: Type
nil = TyCon -> [Type] -> Type
mkTyConApp TyCon
promotedNilDataCon [Type
k]

-- | Extract the elements of a promoted list. Panics if the type is not a
-- promoted list
extractPromotedList :: Type    -- ^ The promoted list
                    -> [Type]
extractPromotedList :: Type -> [Type]
extractPromotedList Type
tys = Type -> [Type]
go Type
tys
  where
    go :: Type -> [Type]
go Type
list_ty
      | Just (TyCon
tc, [Type
_k, Type
t, Type
ts]) <- HasDebugCallStack => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
list_ty
      = ASSERT( tc `hasKey` consDataConKey )
        Type
t Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
: Type -> [Type]
go Type
ts

      | Just (TyCon
tc, [Type
_k]) <- HasDebugCallStack => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
list_ty
      = ASSERT( tc `hasKey` nilDataConKey )
        []

      | Bool
otherwise
      = [Char] -> SDoc -> [Type]
forall a. HasCallStack => [Char] -> SDoc -> a
pprPanic [Char]
"extractPromotedList" (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
tys)



---------------------------------------
-- ghc-bignum
---------------------------------------

integerTyConName
   , integerISDataConName
   , integerIPDataConName
   , integerINDataConName
   :: Name
integerTyConName :: Name
integerTyConName
   = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName
      BuiltInSyntax
UserSyntax
      Module
gHC_NUM_INTEGER
      ([Char] -> FastString
fsLit [Char]
"Integer")
      Unique
integerTyConKey
      TyCon
integerTyCon
integerISDataConName :: Name
integerISDataConName
   = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName
      BuiltInSyntax
UserSyntax
      Module
gHC_NUM_INTEGER
      ([Char] -> FastString
fsLit [Char]
"IS")
      Unique
integerISDataConKey
      DataCon
integerISDataCon
integerIPDataConName :: Name
integerIPDataConName
   = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName
      BuiltInSyntax
UserSyntax
      Module
gHC_NUM_INTEGER
      ([Char] -> FastString
fsLit [Char]
"IP")
      Unique
integerIPDataConKey
      DataCon
integerIPDataCon
integerINDataConName :: Name
integerINDataConName
   = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName
      BuiltInSyntax
UserSyntax
      Module
gHC_NUM_INTEGER
      ([Char] -> FastString
fsLit [Char]
"IN")
      Unique
integerINDataConKey
      DataCon
integerINDataCon

integerTy :: Type
integerTy :: Type
integerTy = TyCon -> Type
mkTyConTy TyCon
integerTyCon

integerTyCon :: TyCon
integerTyCon :: TyCon
integerTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
integerTyConName Maybe CType
forall a. Maybe a
Nothing []
                  [DataCon
integerISDataCon, DataCon
integerIPDataCon, DataCon
integerINDataCon]

integerISDataCon :: DataCon
integerISDataCon :: DataCon
integerISDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
integerISDataConName [] [Type
intPrimTy] TyCon
integerTyCon

integerIPDataCon :: DataCon
integerIPDataCon :: DataCon
integerIPDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
integerIPDataConName [] [Type
byteArrayPrimTy] TyCon
integerTyCon

integerINDataCon :: DataCon
integerINDataCon :: DataCon
integerINDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
integerINDataConName [] [Type
byteArrayPrimTy] TyCon
integerTyCon

naturalTyConName
   , naturalNSDataConName
   , naturalNBDataConName
   :: Name
naturalTyConName :: Name
naturalTyConName
   = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName
      BuiltInSyntax
UserSyntax
      Module
gHC_NUM_NATURAL
      ([Char] -> FastString
fsLit [Char]
"Natural")
      Unique
naturalTyConKey
      TyCon
naturalTyCon
naturalNSDataConName :: Name
naturalNSDataConName
   = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName
      BuiltInSyntax
UserSyntax
      Module
gHC_NUM_NATURAL
      ([Char] -> FastString
fsLit [Char]
"NS")
      Unique
naturalNSDataConKey
      DataCon
naturalNSDataCon
naturalNBDataConName :: Name
naturalNBDataConName
   = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName
      BuiltInSyntax
UserSyntax
      Module
gHC_NUM_NATURAL
      ([Char] -> FastString
fsLit [Char]
"NB")
      Unique
naturalNBDataConKey
      DataCon
naturalNBDataCon

naturalTy :: Type
naturalTy :: Type
naturalTy = TyCon -> Type
mkTyConTy TyCon
naturalTyCon

naturalTyCon :: TyCon
naturalTyCon :: TyCon
naturalTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
naturalTyConName Maybe CType
forall a. Maybe a
Nothing []
                  [DataCon
naturalNSDataCon, DataCon
naturalNBDataCon]

naturalNSDataCon :: DataCon
naturalNSDataCon :: DataCon
naturalNSDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
naturalNSDataConName [] [Type
wordPrimTy] TyCon
naturalTyCon

naturalNBDataCon :: DataCon
naturalNBDataCon :: DataCon
naturalNBDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
naturalNBDataConName [] [Type
byteArrayPrimTy] TyCon
naturalTyCon