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

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

{-# 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, word8Ty,

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

        -- * NonEmpty
        nonEmptyTyCon, nonEmptyTyConName,
        nonEmptyDataCon, nonEmptyDataConName,

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

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

        -- ** Constraint tuples
        cTupleTyCon, cTupleTyConName, cTupleTyConNames, isCTupleTyConName,
        cTupleTyConNameArity_maybe,
        cTupleDataCon, cTupleDataConName, cTupleDataConNames,
        cTupleSelId, cTupleSelIdName,

        -- * Any
        anyTyCon, anyTy, anyTypeOfKind,

        -- * Recovery TyCon
        makeRecoveryTyCon,

        -- * Sums
        mkSumTy, sumTyCon, sumDataCon,

        -- * Kinds
        typeSymbolKindCon, typeSymbolKind,
        isLiftedTypeKindTyConName,
        typeToTypeKind,
        liftedRepTyCon, unliftedRepTyCon,
        constraintKind, liftedTypeKind, unliftedTypeKind, zeroBitTypeKind,
        constraintKindTyCon, liftedTypeKindTyCon, unliftedTypeKindTyCon,
        constraintKindTyConName, liftedTypeKindTyConName, unliftedTypeKindTyConName,
        liftedRepTyConName, unliftedRepTyConName,

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

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

        boxedRepDataConTyCon,
        runtimeRepTy, levityTy, liftedRepTy, unliftedRepTy, zeroBitRepTy,

        vecRepDataConTyCon, tupleRepDataConTyCon, sumRepDataConTyCon,

        liftedDataConTyCon, unliftedDataConTyCon,
        liftedDataConTy, unliftedDataConTy,

        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

import GHC.Prelude

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

-- friends:
import GHC.Builtin.Names
import GHC.Builtin.Types.Prim
import GHC.Builtin.Uniques

-- others:
import GHC.Core.Coercion.Axiom
import GHC.Types.Id
import GHC.Types.TyThing
import GHC.Types.SourceText
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 qualified GHC.Core.TyCo.Rep as TyCoRep (Type(TyConApp))
import GHC.Types.RepType
import GHC.Core.DataCon
import 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.Basic
import GHC.Types.ForeignCall
import GHC.Types.Unique.Set
import Data.Array
import GHC.Data.FastString
import GHC.Data.BooleanFormula ( mkAnd )

import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain

import qualified Data.ByteString.Char8 as BS

import Data.List        ( elemIndex, intersperse )

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

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

{-
Note [Wired-in Types and Type Constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

This module include a lot of wired-in types and type constructors. Here,
these are presented in a tabular format to make it easier to find the
wired-in type identifier corresponding to a known Haskell type. Data
constructors are nested under their corresponding types with two spaces
of indentation.

Identifier              Type    Haskell name          Notes
----------------------------------------------------------------------------
liftedTypeKindTyCon     TyCon   GHC.Types.Type        Synonym for: TYPE LiftedRep
unliftedTypeKindTyCon   TyCon   GHC.Types.Type        Synonym for: TYPE UnliftedRep
liftedRepTyCon          TyCon   GHC.Types.LiftedRep   Synonym for: 'BoxedRep 'Lifted
unliftedRepTyCon        TyCon   GHC.Types.LiftedRep   Synonym for: 'BoxedRep 'Unlifted
levityTyCon             TyCon   GHC.Types.Levity      Data type
  liftedDataConTyCon    TyCon   GHC.Types.Lifted      Data constructor
  unliftedDataConTyCon  TyCon   GHC.Types.Unlifted    Data constructor
vecCountTyCon           TyCon   GHC.Types.VecCount    Data type
  vec2DataConTy         Type    GHC.Types.Vec2        Data constructor
  vec4DataConTy         Type    GHC.Types.Vec4        Data constructor
  vec8DataConTy         Type    GHC.Types.Vec8        Data constructor
  vec16DataConTy        Type    GHC.Types.Vec16       Data constructor
  vec32DataConTy        Type    GHC.Types.Vec32       Data constructor
  vec64DataConTy        Type    GHC.Types.Vec64       Data constructor
runtimeRepTyCon         TyCon   GHC.Types.RuntimeRep  Data type
  boxedRepDataConTyCon  TyCon   GHC.Types.BoxedRep    Data constructor
  intRepDataConTy       Type    GHC.Types.IntRep      Data constructor
  doubleRepDataConTy    Type    GHC.Types.DoubleRep   Data constructor
  floatRepDataConTy     Type    GHC.Types.FloatRep    Data constructor
boolTyCon               TyCon   GHC.Types.Bool        Data type
  trueDataCon           DataCon GHC.Types.True        Data constructor
  falseDataCon          DataCon GHC.Types.False       Data constructor
  promotedTrueDataCon   TyCon   GHC.Types.True        Data constructor
  promotedFalseDataCon  TyCon   GHC.Types.False       Data constructor

************************************************************************
*                                                                      *
\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

                -- Solo (i.e., the bosed 1-tuple) is also not treated
                -- like other tuples (i.e. we /do/ include it here),
                -- since it does not use special syntax like other tuples
                -- See Note [One-tuples] (Wrinkle: Make boxed one-tuple names
                -- have known keys) in GHC.Builtin.Types.
                , TyCon
soloTyCon

                , TyCon
anyTyCon
                , TyCon
boolTyCon
                , TyCon
charTyCon
                , TyCon
stringTyCon
                , TyCon
doubleTyCon
                , TyCon
floatTyCon
                , TyCon
intTyCon
                , TyCon
wordTyCon
                , TyCon
listTyCon
                , TyCon
orderingTyCon
                , TyCon
maybeTyCon
                , TyCon
heqTyCon
                , TyCon
eqTyCon
                , TyCon
coercibleTyCon
                , TyCon
typeSymbolKindCon
                , TyCon
runtimeRepTyCon
                , TyCon
levityTyCon
                , TyCon
vecCountTyCon
                , TyCon
vecElemTyCon
                , TyCon
constraintKindTyCon
                , TyCon
liftedTypeKindTyCon
                , TyCon
unliftedTypeKindTyCon
                , TyCon
multiplicityTyCon
                , TyCon
naturalTyCon
                , TyCon
integerTyCon
                , TyCon
liftedRepTyCon
                , TyCon
unliftedRepTyCon
                , TyCon
zeroBitRepTyCon
                , TyCon
zeroBitTypeTyCon
                , TyCon
nonEmptyTyCon
                ]

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

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

nonEmptyTyConName, nonEmptyDataConName :: Name
nonEmptyTyConName :: Name
nonEmptyTyConName   = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName   BuiltInSyntax
UserSyntax  Module
gHC_BASE ([Char] -> FastString
fsLit [Char]
"NonEmpty") Unique
nonEmptyTyConKey TyCon
nonEmptyTyCon
nonEmptyDataConName :: Name
nonEmptyDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax  Module
gHC_BASE ([Char] -> FastString
fsLit [Char]
":|") Unique
nonEmptyDataConKey DataCon
nonEmptyDataCon

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, 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
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)

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
typeSymbolKindConName :: Name
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, unliftedTypeKindTyConName, zeroBitTypeTyConName :: 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
unliftedTypeKindTyConName :: Name
unliftedTypeKindTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"UnliftedType") Unique
unliftedTypeKindTyConKey TyCon
unliftedTypeKindTyCon
zeroBitTypeTyConName :: Name
zeroBitTypeTyConName      = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"ZeroBitType")  Unique
zeroBitTypeTyConKey      TyCon
zeroBitTypeTyCon

liftedRepTyConName, unliftedRepTyConName, zeroBitRepTyConName :: Name
liftedRepTyConName :: Name
liftedRepTyConName   = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"LiftedRep")   Unique
liftedRepTyConKey   TyCon
liftedRepTyCon
unliftedRepTyConName :: Name
unliftedRepTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"UnliftedRep") Unique
unliftedRepTyConKey TyCon
unliftedRepTyCon
zeroBitRepTyConName :: Name
zeroBitRepTyConName  = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"ZeroBitRep")  Unique
zeroBitRepTyConKey  TyCon
zeroBitRepTyCon

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, boxedRepDataConName :: 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
boxedRepDataConName :: Name
boxedRepDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"BoxedRep") Unique
boxedRepDataConKey DataCon
boxedRepDataCon

levityTyConName, liftedDataConName, unliftedDataConName :: Name
levityTyConName :: Name
levityTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Levity") Unique
levityTyConKey TyCon
levityTyCon
liftedDataConName :: Name
liftedDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Lifted") Unique
liftedDataConKey DataCon
liftedDataCon
unliftedDataConName :: Name
unliftedDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Unlifted") Unique
unliftedDataConKey DataCon
unliftedDataCon


-- 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]
"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 Int
tag_map = TyCon -> NameEnv Int
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
-> Int
-> [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 Int -> Name -> Int
forall a. NameEnv a -> Name -> a
lookupNameEnv_NF NameEnv Int
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     = Bool -> Module -> Module
forall a. HasCallStack => Bool -> a -> a
assert (Name -> Bool
isExternalName Name
dc_name) (Module -> Module) -> Module -> Module
forall a b. (a -> b) -> a -> b
$
               (() :: Constraint) => 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
*                                                                      *
************************************************************************
-}

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

typeSymbolKind :: Kind
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 [] []

typeToTypeKind, constraintKind :: Kind
typeToTypeKind :: Type
typeToTypeKind   = Type
liftedTypeKind Type -> Type -> Type
`mkVisFunTyMany` Type
liftedTypeKind
constraintKind :: Type
constraintKind   = TyCon -> Type
mkTyConTy TyCon
constraintKindTyCon

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

Note [How tuples work]
~~~~~~~~~~~~~~~~~~~~~~
* 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
    - A wired-in type.
    - 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.Instance.Class.matchCTuple
    - Currently just go up to 64; 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.
    - Unlike BoxedTuples and UnboxedTuples, which only wire
      in type constructors and data constructors, ConstraintTuples also wire in
      superclass selector functions. For instance, $p1(%,%) and $p2(%,%) are
      the selectors for the binary constraint tuple.

* 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.

See also Note [Known-key names] in GHC.Builtin.Names.

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

      -- 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 -> Int -> Name
tup_name Boxity
Boxed Int
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 -> Int -> Name
tup_name Boxity
Boxed (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+ByteString -> Int
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 -> Int -> Name
tup_name Boxity
Unboxed Int
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 -> Int -> Name
tup_name Boxity
Unboxed Int
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 -> Int -> Name
tup_name Boxity
Unboxed (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+ByteString -> Int
BS.length ByteString
commas)

      -- unboxed sum tycon
      ByteString
_ | Just ByteString
rest <- ByteString
"(#" ByteString -> ByteString -> Maybe ByteString
`BS.stripPrefix` ByteString
name
        , (Int
nb_pipes, ByteString
rest') <- ByteString -> (Int, ByteString)
span_pipes 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
$ Int -> TyCon
sumTyCon (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
nb_pipes)

      -- unboxed sum datacon
      ByteString
_ | Just ByteString
rest <- ByteString
"(#" ByteString -> ByteString -> Maybe ByteString
`BS.stripPrefix` ByteString
name
        , (Int
nb_pipes1, ByteString
rest') <- ByteString -> (Int, ByteString)
span_pipes ByteString
rest
        , Just ByteString
rest'' <- ByteString
"_" ByteString -> ByteString -> Maybe ByteString
`BS.stripPrefix` ByteString
rest'
        , (Int
nb_pipes2, ByteString
rest''') <- ByteString -> (Int, ByteString)
span_pipes ByteString
rest''
        , ByteString
"#)" <- ByteString
rest'''
             -> let arity :: Int
arity = Int
nb_pipes1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nb_pipes2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                    alt :: Int
alt = Int
nb_pipes1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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
$ Int -> Int -> DataCon
sumDataCon Int
alt Int
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

    span_pipes :: BS.ByteString -> (Int, BS.ByteString)
    span_pipes :: ByteString -> (Int, ByteString)
span_pipes = Int -> ByteString -> (Int, ByteString)
forall {a}. Num a => a -> ByteString -> (a, ByteString)
go Int
0
      where
        go :: a -> ByteString -> (a, ByteString)
go a
nb_pipes ByteString
bs = case ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
bs of
          Just (Char
'|',ByteString
rest) -> a -> ByteString -> (a, ByteString)
go (a
nb_pipes a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) ByteString
rest
          Just (Char
' ',ByteString
rest) -> a -> ByteString -> (a, ByteString)
go a
nb_pipes       ByteString
rest
          Maybe (Char, ByteString)
_               -> (a
nb_pipes, ByteString
bs)

    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 -> Int -> Name
tup_name Boxity
boxity Int
arity
      = Name -> Name -> Name
choose_ns (TyCon -> Name
forall a. NamedThing a => a -> Name
getName (Boxity -> Int -> TyCon
tupleTyCon   Boxity
boxity Int
arity))
                  (DataCon -> Name
forall a. NamedThing a => a -> Name
getName (Boxity -> Int -> DataCon
tupleDataCon Boxity
boxity Int
arity))

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

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

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

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

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

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

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

cTupleTyCon :: Arity -> TyCon
cTupleTyCon :: Int -> TyCon
cTupleTyCon Int
i
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mAX_CTUPLE_SIZE = (TyCon, DataCon, Array Int TyVar) -> TyCon
forall a b c. (a, b, c) -> a
fstOf3 (Int -> (TyCon, DataCon, Array Int TyVar)
mk_ctuple Int
i) -- Build one specially
  | Bool
otherwise           = (TyCon, DataCon, Array Int TyVar) -> TyCon
forall a b c. (a, b, c) -> a
fstOf3 (Array Int (TyCon, DataCon, Array Int TyVar)
cTupleArr Array Int (TyCon, DataCon, Array Int TyVar)
-> Int -> (TyCon, DataCon, Array Int TyVar)
forall i e. Ix i => Array i e -> i -> e
! Int
i)

cTupleTyConName :: Arity -> Name
cTupleTyConName :: Int -> Name
cTupleTyConName Int
a = TyCon -> Name
tyConName (Int -> TyCon
cTupleTyCon Int
a)

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

cTupleTyConKeys :: UniqSet Unique
cTupleTyConKeys :: UniqSet Unique
cTupleTyConKeys = [Unique] -> UniqSet Unique
forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet ([Unique] -> UniqSet Unique) -> [Unique] -> UniqSet Unique
forall a b. (a -> b) -> a -> b
$ (Name -> Unique) -> [Name] -> [Unique]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Unique
forall a. Uniquable a => a -> Unique
getUnique [Name]
cTupleTyConNames

isCTupleTyConName :: Name -> Bool
isCTupleTyConName :: Name -> Bool
isCTupleTyConName Name
n
 = Bool -> SDoc -> Bool -> Bool
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Name -> Bool
isExternalName Name
n) (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
   Name -> Unique
forall a. Uniquable a => a -> Unique
getUnique Name
n Unique -> UniqSet Unique -> Bool
forall a. Uniquable a => a -> UniqSet a -> Bool
`elementOfUniqSet` UniqSet Unique
cTupleTyConKeys

-- | If the given name is that of a constraint tuple, return its arity.
cTupleTyConNameArity_maybe :: Name -> Maybe Arity
cTupleTyConNameArity_maybe :: Name -> Maybe Int
cTupleTyConNameArity_maybe Name
n
  | Bool -> Bool
not (Name -> Bool
isCTupleTyConName Name
n) = Maybe Int
forall a. Maybe a
Nothing
  | Bool
otherwise = (Int -> Int) -> Maybe Int -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Int
forall {a}. (Ord a, Num a) => a -> a
adjustArity (Name
n Name -> [Name] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
`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

cTupleDataCon :: Arity -> DataCon
cTupleDataCon :: Int -> DataCon
cTupleDataCon Int
i
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mAX_CTUPLE_SIZE = (TyCon, DataCon, Array Int TyVar) -> DataCon
forall a b c. (a, b, c) -> b
sndOf3 (Int -> (TyCon, DataCon, Array Int TyVar)
mk_ctuple Int
i) -- Build one specially
  | Bool
otherwise           = (TyCon, DataCon, Array Int TyVar) -> DataCon
forall a b c. (a, b, c) -> b
sndOf3 (Array Int (TyCon, DataCon, Array Int TyVar)
cTupleArr Array Int (TyCon, DataCon, Array Int TyVar)
-> Int -> (TyCon, DataCon, Array Int TyVar)
forall i e. Ix i => Array i e -> i -> e
! Int
i)

cTupleDataConName :: Arity -> Name
cTupleDataConName :: Int -> Name
cTupleDataConName Int
i = DataCon -> Name
dataConName (Int -> DataCon
cTupleDataCon Int
i)

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

cTupleSelId :: ConTag -- Superclass position
            -> Arity  -- Arity
            -> Id
cTupleSelId :: Int -> Int -> TyVar
cTupleSelId Int
sc_pos Int
arity
  | Int
sc_pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
arity
  = [Char] -> TyVar
forall a. [Char] -> a
panic ([Char]
"cTupleSelId: index out of bounds: superclass position: "
           [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
sc_pos [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" > arity " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
arity)

  | Int
sc_pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
  = [Char] -> TyVar
forall a. [Char] -> a
panic ([Char]
"cTupleSelId: Superclass positions start from 1. "
           [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"(superclass position: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
sc_pos
           [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", arity: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
arity [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")")

  | Int
arity Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
  = [Char] -> TyVar
forall a. [Char] -> a
panic ([Char]
"cTupleSelId: Arity starts from 2. "
           [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"(superclass position: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
sc_pos
           [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", arity: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
arity [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")")

  | Int
arity Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mAX_CTUPLE_SIZE
  = (TyCon, DataCon, Array Int TyVar) -> Array Int TyVar
forall a b c. (a, b, c) -> c
thdOf3 (Int -> (TyCon, DataCon, Array Int TyVar)
mk_ctuple Int
arity) Array Int TyVar -> Int -> TyVar
forall i e. Ix i => Array i e -> i -> e
! (Int
sc_pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)  -- Build one specially

  | Bool
otherwise
  = (TyCon, DataCon, Array Int TyVar) -> Array Int TyVar
forall a b c. (a, b, c) -> c
thdOf3 (Array Int (TyCon, DataCon, Array Int TyVar)
cTupleArr Array Int (TyCon, DataCon, Array Int TyVar)
-> Int -> (TyCon, DataCon, Array Int TyVar)
forall i e. Ix i => Array i e -> i -> e
! Int
arity) Array Int TyVar -> Int -> TyVar
forall i e. Ix i => Array i e -> i -> e
! (Int
sc_pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

cTupleSelIdName :: ConTag -- Superclass position
                -> Arity  -- Arity
                -> Name
cTupleSelIdName :: Int -> Int -> Name
cTupleSelIdName Int
sc_pos Int
arity = TyVar -> Name
idName (Int -> Int -> TyVar
cTupleSelId Int
sc_pos Int
arity)

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

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

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

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

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

mkPromotedPairTy :: Kind -> Kind -> Type -> Type -> Type
mkPromotedPairTy :: Type -> Type -> Type -> Type -> Type
mkPromotedPairTy Type
k1 Type
k2 Type
t1 Type
t2 = TyCon -> [Type] -> Type
mkTyConApp (Boxity -> Int -> TyCon
promotedTupleDataCon Boxity
Boxed Int
2) [Type
k1,Type
k2,Type
t1,Type
t2]

isPromotedPairType :: Type -> Maybe (Type, Type)
isPromotedPairType :: Type -> Maybe (Type, Type)
isPromotedPairType Type
t
  | Just (TyCon
tc, [Type
_,Type
_,Type
x,Type
y]) <- (() :: Constraint) => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
t
  , TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== Boxity -> Int -> TyCon
promotedTupleDataCon Boxity
Boxed Int
2
  = (Type, Type) -> Maybe (Type, Type)
forall a. a -> Maybe a
Just (Type
x, Type
y)
  | Bool
otherwise = Maybe (Type, Type)
forall a. Maybe a
Nothing

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

-- | Cached type constructors, data constructors, and superclass selectors for
-- constraint tuples. The outer array is indexed by the arity of the constraint
-- tuple and the inner array is indexed by the superclass position.
cTupleArr :: Array Int (TyCon, DataCon, Array Int Id)
cTupleArr :: Array Int (TyCon, DataCon, Array Int TyVar)
cTupleArr = (Int, Int)
-> [(TyCon, DataCon, Array Int TyVar)]
-> Array Int (TyCon, DataCon, Array Int TyVar)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
mAX_CTUPLE_SIZE) [Int -> (TyCon, DataCon, Array Int TyVar)
mk_ctuple Int
i | Int
i <- [Int
0..Int
mAX_CTUPLE_SIZE]]
  -- Although GHC does not make use of unary constraint tuples
  -- (see Note [Ignore unary constraint tuples] in GHC.Tc.Gen.HsType),
  -- this array creates one anyway. This is primarily motivated by the fact
  -- that (1) the indices of an Array must be contiguous, and (2) we would like
  -- the index of a constraint tuple in this Array to correspond to its Arity.
  -- We could envision skipping over the unary constraint tuple and having index
  -- 1 correspond to a 2-constraint tuple (and so on), but that's more
  -- complicated than it's worth.

-- | 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
mkTYPEapp (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 -> Int -> (TyCon, DataCon)
mk_tuple Boxity
Boxed Int
arity = (TyCon
tycon, DataCon
tuple_con)
  where
    tycon :: TyCon
tycon = Name
-> [TyConBinder]
-> Type
-> Int
-> DataCon
-> TupleSort
-> AlgTyConFlav
-> TyCon
mkTupleTyCon Name
tc_name [TyConBinder]
tc_binders Type
tc_res_kind Int
tc_arity DataCon
tuple_con
                         TupleSort
BoxedTuple AlgTyConFlav
flavour

    tc_binders :: [TyConBinder]
tc_binders  = [Type] -> [TyConBinder]
mkTemplateAnonTyConBinders (Int -> Type -> [Type]
forall a. Int -> a -> [a]
replicate Int
arity Type
liftedTypeKind)
    tc_res_kind :: Type
tc_res_kind = Type
liftedTypeKind
    tc_arity :: Int
tc_arity    = Int
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 -> Int -> OccName
mkTupleOcc NameSpace
tcName Boxity
boxity Int
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 -> Int -> OccName
mkTupleOcc NameSpace
dataName Boxity
boxity Int
arity) Unique
dc_uniq
                            (ConLike -> TyThing
AConLike (DataCon -> ConLike
RealDataCon DataCon
tuple_con)) BuiltInSyntax
BuiltInSyntax
    tc_uniq :: Unique
tc_uniq = Boxity -> Int -> Unique
mkTupleTyConUnique   Boxity
boxity Int
arity
    dc_uniq :: Unique
dc_uniq = Boxity -> Int -> Unique
mkTupleDataConUnique Boxity
boxity Int
arity

mk_tuple Boxity
Unboxed Int
arity = (TyCon
tycon, DataCon
tuple_con)
  where
    tycon :: TyCon
tycon = Name
-> [TyConBinder]
-> Type
-> Int
-> DataCon
-> TupleSort
-> AlgTyConFlav
-> TyCon
mkTupleTyCon Name
tc_name [TyConBinder]
tc_binders Type
tc_res_kind Int
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 -> TYPE (TupleRep [k1, k2])
    tc_binders :: [TyConBinder]
tc_binders = [Type] -> ([Type] -> [Type]) -> [TyConBinder]
mkTemplateTyConBinders (Int -> Type -> [Type]
forall a. Int -> a -> [a]
replicate Int
arity Type
runtimeRepTy)
                                        (\[Type]
ks -> (Type -> Type) -> [Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Type
mkTYPEapp [Type]
ks)

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

    tc_arity :: Int
tc_arity    = Int
arity Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2
    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
    ([Type]
rr_tys, [Type]
dc_arg_tys) = Int -> [Type] -> ([Type], [Type])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
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 -> Int -> OccName
mkTupleOcc NameSpace
tcName Boxity
boxity Int
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 -> Int -> OccName
mkTupleOcc NameSpace
dataName Boxity
boxity Int
arity) Unique
dc_uniq
                            (ConLike -> TyThing
AConLike (DataCon -> ConLike
RealDataCon DataCon
tuple_con)) BuiltInSyntax
BuiltInSyntax
    tc_uniq :: Unique
tc_uniq = Boxity -> Int -> Unique
mkTupleTyConUnique   Boxity
boxity Int
arity
    dc_uniq :: Unique
dc_uniq = Boxity -> Int -> Unique
mkTupleDataConUnique Boxity
boxity Int
arity

mk_ctuple :: Arity -> (TyCon, DataCon, Array ConTagZ Id)
mk_ctuple :: Int -> (TyCon, DataCon, Array Int TyVar)
mk_ctuple Int
arity = (TyCon
tycon, DataCon
tuple_con, Array Int TyVar
sc_sel_ids_arr)
  where
    tycon :: TyCon
tycon = Name
-> [TyConBinder] -> [Role] -> AlgTyConRhs -> Class -> Name -> TyCon
mkClassTyCon Name
tc_name [TyConBinder]
binders [Role]
roles
                         AlgTyConRhs
rhs Class
klass
                         (Name -> Name
mkPrelTyConRepName Name
tc_name)

    klass :: Class
klass     = TyCon -> [Type] -> [TyVar] -> Class
mk_ctuple_class TyCon
tycon [Type]
sc_theta [TyVar]
sc_sel_ids
    tuple_con :: DataCon
tuple_con = Name -> [TyVar] -> [Scaled Type] -> TyCon -> DataCon
pcDataConW Name
dc_name [TyVar]
tvs ((Type -> Scaled Type) -> [Type] -> [Scaled Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Scaled Type
forall a. a -> Scaled a
unrestricted [Type]
sc_theta) TyCon
tycon

    binders :: [TyConBinder]
binders = [Type] -> [TyConBinder]
mkTemplateAnonTyConBinders (Int -> Type -> [Type]
forall a. Int -> a -> [a]
replicate Int
arity Type
constraintKind)
    roles :: [Role]
roles   = Int -> Role -> [Role]
forall a. Int -> a -> [a]
replicate Int
arity Role
Nominal
    rhs :: AlgTyConRhs
rhs     = TupleTyCon{data_con :: DataCon
data_con = DataCon
tuple_con, tup_sort :: TupleSort
tup_sort = TupleSort
ConstraintTuple}

    modu :: Module
modu    = Module
gHC_CLASSES
    tc_name :: Name
tc_name = Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
mkWiredInName Module
modu (NameSpace -> Int -> OccName
mkCTupleOcc NameSpace
tcName Int
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 -> Int -> OccName
mkCTupleOcc NameSpace
dataName Int
arity) Unique
dc_uniq
                            (ConLike -> TyThing
AConLike (DataCon -> ConLike
RealDataCon DataCon
tuple_con)) BuiltInSyntax
BuiltInSyntax
    tc_uniq :: Unique
tc_uniq = Int -> Unique
mkCTupleTyConUnique   Int
arity
    dc_uniq :: Unique
dc_uniq = Int -> Unique
mkCTupleDataConUnique Int
arity

    tvs :: [TyVar]
tvs            = [TyConBinder] -> [TyVar]
forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
binders
    sc_theta :: [Type]
sc_theta       = (TyVar -> Type) -> [TyVar] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map TyVar -> Type
mkTyVarTy [TyVar]
tvs
    sc_sel_ids :: [TyVar]
sc_sel_ids     = [Int -> TyVar
mk_sc_sel_id Int
sc_pos | Int
sc_pos <- [Int
0..Int
arityInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]
    sc_sel_ids_arr :: Array Int TyVar
sc_sel_ids_arr = (Int, Int) -> [TyVar] -> Array Int TyVar
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
arityInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [TyVar]
sc_sel_ids

    mk_sc_sel_id :: Int -> TyVar
mk_sc_sel_id Int
sc_pos =
      let sc_sel_id_uniq :: Unique
sc_sel_id_uniq = Int -> Int -> Unique
mkCTupleSelIdUnique Int
sc_pos Int
arity
          sc_sel_id_occ :: OccName
sc_sel_id_occ  = NameSpace -> Int -> OccName
mkCTupleOcc NameSpace
tcName Int
arity
          sc_sel_id_name :: Name
sc_sel_id_name = Module -> FastString -> Unique -> TyVar -> Name
mkWiredInIdName
                             Module
gHC_CLASSES
                             (OccName -> FastString
occNameFS (Int -> OccName -> OccName
mkSuperDictSelOcc Int
sc_pos OccName
sc_sel_id_occ))
                             Unique
sc_sel_id_uniq
                             TyVar
sc_sel_id
          sc_sel_id :: TyVar
sc_sel_id      = Name -> Class -> TyVar
mkDictSelId Name
sc_sel_id_name Class
klass

      in TyVar
sc_sel_id

unitTyCon :: TyCon
unitTyCon :: TyCon
unitTyCon = Boxity -> Int -> TyCon
tupleTyCon Boxity
Boxed Int
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. HasCallStack => [a] -> a
head (TyCon -> [DataCon]
tyConDataCons TyCon
unitTyCon)

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

soloTyCon :: TyCon
soloTyCon :: TyCon
soloTyCon = Boxity -> Int -> TyCon
tupleTyCon Boxity
Boxed Int
1

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

unboxedUnitTy :: Type
unboxedUnitTy :: Type
unboxedUnitTy = TyCon -> Type
mkTyConTy TyCon
unboxedUnitTyCon

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

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


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

-- | OccName for n-ary unboxed sum type constructor.
mkSumTyConOcc :: Arity -> OccName
mkSumTyConOcc :: Int -> OccName
mkSumTyConOcc Int
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
' ' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
bars [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" #)"
    bars :: [Char]
bars = Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
intersperse Char
' ' ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Char
'|'

-- | OccName for i-th alternative of n-ary unboxed sum data constructor.
mkSumDataConOcc :: ConTag -> Arity -> OccName
mkSumDataConOcc :: Int -> Int -> OccName
mkSumDataConOcc Int
alt Int
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]
: Char
' ' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Int -> [Char]
bars Int
alt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Char
'_' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Int -> [Char]
bars (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
alt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" #)"
    bars :: Int -> [Char]
bars Int
i = Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
intersperse Char
' ' ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
i Char
'|'

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

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

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

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

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

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

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

  | Bool
otherwise
  = (TyCon, Array Int DataCon) -> Array Int DataCon
forall a b. (a, b) -> b
snd (Array Int (TyCon, Array Int DataCon)
unboxedSumArr Array Int (TyCon, Array Int DataCon)
-> Int -> (TyCon, Array Int DataCon)
forall i e. Ix i => Array i e -> i -> e
! Int
arity) Array Int DataCon -> Int -> DataCon
forall i e. Ix i => Array i e -> i -> e
! (Int
alt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
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 Int (TyCon, Array Int DataCon)
unboxedSumArr = (Int, Int)
-> [(TyCon, Array Int DataCon)]
-> Array Int (TyCon, Array Int DataCon)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
2,Int
mAX_SUM_SIZE) [Int -> (TyCon, Array Int DataCon)
mk_sum Int
i | Int
i <- [Int
2..Int
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 :: Int -> (TyCon, Array Int DataCon)
mk_sum Int
arity = (TyCon
tycon, Array Int DataCon
sum_cons)
  where
    tycon :: TyCon
tycon   = Name
-> [TyConBinder]
-> Type
-> Int
-> [TyVar]
-> [DataCon]
-> AlgTyConFlav
-> TyCon
mkSumTyCon Name
tc_name [TyConBinder]
tc_binders Type
tc_res_kind (Int
arity Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) [TyVar]
tyvars (Array Int DataCon -> [DataCon]
forall i e. Array i e -> [e]
elems Array Int DataCon
sum_cons)
                         AlgTyConFlav
UnboxedSumTyCon

    tc_binders :: [TyConBinder]
tc_binders = [Type] -> ([Type] -> [Type]) -> [TyConBinder]
mkTemplateTyConBinders (Int -> Type -> [Type]
forall a. Int -> a -> [a]
replicate Int
arity Type
runtimeRepTy)
                                        (\[Type]
ks -> (Type -> Type) -> [Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Type
mkTYPEapp [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) = Int -> [Type] -> ([Type], [Type])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
arity ([TyVar] -> [Type]
mkTyVarTys [TyVar]
tyvars)

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

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

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

    tc_uniq :: Unique
tc_uniq   = Int -> Unique
mkSumTyConUnique   Int
arity
    dc_uniq :: Int -> Unique
dc_uniq Int
i = Int -> Int -> Unique
mkSumDataConUnique Int
i Int
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

mk_ctuple_class :: TyCon -> ThetaType -> [Id] -> Class
mk_ctuple_class :: TyCon -> [Type] -> [TyVar] -> Class
mk_ctuple_class TyCon
tycon [Type]
sc_theta [TyVar]
sc_sel_ids
  = Name
-> [TyVar]
-> [FunDep TyVar]
-> [Type]
-> [TyVar]
-> [ClassATItem]
-> [ClassOpItem]
-> ClassMinimalDef
-> TyCon
-> Class
mkClass (TyCon -> Name
tyConName TyCon
tycon) (TyCon -> [TyVar]
tyConTyVars TyCon
tycon) [] [Type]
sc_theta [TyVar]
sc_sel_ids
            [] [] ([LBooleanFormula Name] -> ClassMinimalDef
forall a. Eq a => [LBooleanFormula a] -> BooleanFormula a
mkAnd []) TyCon
tycon

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

{- Multiplicity polymorphism is implemented very similarly to representation
 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
mkTYPEapp Type
runtimeRep1Ty
                                                , Type -> Type
mkTYPEapp 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


{- *********************************************************************
*                                                                      *
      Type synonyms (all declared in ghc-prim:GHC.Types)

         type Type         = TYPE LiftedRep    -- liftedTypeKind
         type UnliftedType = TYPE UnliftedRep  -- unliftedTypeKind
         type LiftedRep    = BoxedRep Lifted   -- liftedRepTy
         type UnliftedRep  = BoxedRep Unlifted -- unliftedRepTy

*                                                                      *
********************************************************************* -}

-- For these synonyms, see
-- Note [TYPE and RuntimeRep] in GHC.Builtin.Types.Prim, and
-- Note [Using synonyms to compress types] in GHC.Core.Type

----------------------
-- @type Type = TYPE ('BoxedRep 'Lifted)@
liftedTypeKindTyCon :: TyCon
liftedTypeKindTyCon :: TyCon
liftedTypeKindTyCon
  = Name -> [TyConBinder] -> Type -> [Role] -> Type -> TyCon
buildSynTyCon Name
liftedTypeKindTyConName [] Type
liftedTypeKind [] Type
rhs
  where
    rhs :: Type
rhs = TyCon -> [Type] -> Type
TyCoRep.TyConApp TyCon
tYPETyCon [Type
liftedRepTy]

liftedTypeKind :: Type
liftedTypeKind :: Type
liftedTypeKind = TyCon -> Type
mkTyConTy TyCon
liftedTypeKindTyCon

----------------------
-- | @type UnliftedType = TYPE ('BoxedRep 'Unlifted)@
unliftedTypeKindTyCon :: TyCon
unliftedTypeKindTyCon :: TyCon
unliftedTypeKindTyCon
  = Name -> [TyConBinder] -> Type -> [Role] -> Type -> TyCon
buildSynTyCon Name
unliftedTypeKindTyConName [] Type
liftedTypeKind [] Type
rhs
  where
    rhs :: Type
rhs = TyCon -> [Type] -> Type
TyCoRep.TyConApp TyCon
tYPETyCon [Type
unliftedRepTy]

unliftedTypeKind :: Type
unliftedTypeKind :: Type
unliftedTypeKind = TyCon -> Type
mkTyConTy TyCon
unliftedTypeKindTyCon

----------------------
-- @type ZeroBitType = TYPE ZeroBitRep
zeroBitTypeTyCon :: TyCon
zeroBitTypeTyCon :: TyCon
zeroBitTypeTyCon
  = Name -> [TyConBinder] -> Type -> [Role] -> Type -> TyCon
buildSynTyCon Name
zeroBitTypeTyConName [] Type
liftedTypeKind [] Type
rhs
  where
    rhs :: Type
rhs = TyCon -> [Type] -> Type
TyCoRep.TyConApp TyCon
tYPETyCon [Type
zeroBitRepTy]

zeroBitTypeKind :: Type
zeroBitTypeKind :: Type
zeroBitTypeKind = TyCon -> Type
mkTyConTy TyCon
zeroBitTypeTyCon

----------------------
-- | @type LiftedRep = 'BoxedRep 'Lifted@
liftedRepTyCon :: TyCon
liftedRepTyCon :: TyCon
liftedRepTyCon
  = Name -> [TyConBinder] -> Type -> [Role] -> Type -> TyCon
buildSynTyCon Name
liftedRepTyConName [] Type
runtimeRepTy [] Type
rhs
  where
    rhs :: Type
rhs = TyCon -> [Type] -> Type
TyCoRep.TyConApp TyCon
boxedRepDataConTyCon [Type
liftedDataConTy]

liftedRepTy :: Type
liftedRepTy :: Type
liftedRepTy = TyCon -> Type
mkTyConTy TyCon
liftedRepTyCon

----------------------
-- | @type UnliftedRep = 'BoxedRep 'Unlifted@
unliftedRepTyCon :: TyCon
unliftedRepTyCon :: TyCon
unliftedRepTyCon
  = Name -> [TyConBinder] -> Type -> [Role] -> Type -> TyCon
buildSynTyCon Name
unliftedRepTyConName [] Type
runtimeRepTy [] Type
rhs
  where
    rhs :: Type
rhs = TyCon -> [Type] -> Type
TyCoRep.TyConApp TyCon
boxedRepDataConTyCon [Type
unliftedDataConTy]

unliftedRepTy :: Type
unliftedRepTy :: Type
unliftedRepTy = TyCon -> Type
mkTyConTy TyCon
unliftedRepTyCon

----------------------
-- | @type ZeroBitRep = 'Tuple '[]
zeroBitRepTyCon :: TyCon
zeroBitRepTyCon :: TyCon
zeroBitRepTyCon
  = Name -> [TyConBinder] -> Type -> [Role] -> Type -> TyCon
buildSynTyCon Name
zeroBitRepTyConName [] Type
runtimeRepTy [] Type
rhs
  where
    rhs :: Type
rhs = TyCon -> [Type] -> Type
TyCoRep.TyConApp TyCon
tupleRepDataConTyCon [Type -> [Type] -> Type
mkPromotedListTy Type
runtimeRepTy []]

zeroBitRepTy :: Type
zeroBitRepTy :: Type
zeroBitRepTy = TyCon -> Type
mkTyConTy TyCon
zeroBitRepTyCon


{- *********************************************************************
*                                                                      *
      data Levity = Lifted | Unlifted
*                                                                      *
********************************************************************* -}

levityTyCon :: TyCon
levityTyCon :: TyCon
levityTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
levityTyConName Maybe CType
forall a. Maybe a
Nothing [] [DataCon
liftedDataCon,DataCon
unliftedDataCon]

levityTy :: Type
levityTy :: Type
levityTy = TyCon -> Type
mkTyConTy TyCon
levityTyCon

liftedDataCon, unliftedDataCon :: DataCon
liftedDataCon :: DataCon
liftedDataCon = Name -> [Type] -> TyCon -> RuntimeRepInfo -> DataCon
pcSpecialDataCon Name
liftedDataConName
    [] TyCon
levityTyCon RuntimeRepInfo
LiftedInfo
unliftedDataCon :: DataCon
unliftedDataCon = Name -> [Type] -> TyCon -> RuntimeRepInfo -> DataCon
pcSpecialDataCon Name
unliftedDataConName
    [] TyCon
levityTyCon RuntimeRepInfo
UnliftedInfo

liftedDataConTyCon :: TyCon
liftedDataConTyCon :: TyCon
liftedDataConTyCon = DataCon -> TyCon
promoteDataCon DataCon
liftedDataCon

unliftedDataConTyCon :: TyCon
unliftedDataConTyCon :: TyCon
unliftedDataConTyCon = DataCon -> TyCon
promoteDataCon DataCon
unliftedDataCon

liftedDataConTy :: Type
liftedDataConTy :: Type
liftedDataConTy = TyCon -> Type
mkTyConTy TyCon
liftedDataConTyCon

unliftedDataConTy :: Type
unliftedDataConTy :: Type
unliftedDataConTy = TyCon -> Type
mkTyConTy TyCon
unliftedDataConTyCon


{- *********************************************************************
*                                                                      *
    See Note [Wiring in RuntimeRep]
        data RuntimeRep = VecRep VecCount VecElem
                        | TupleRep [RuntimeRep]
                        | SumRep [RuntimeRep]
                        | BoxedRep Levity
                        | IntRep | Int8Rep | ...etc...
*                                                                      *
********************************************************************* -}

{- 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.
-}

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
boxedRepDataCon DataCon -> [DataCon] -> [DataCon]
forall a. a -> [a] -> [a]
: [DataCon]
runtimeRepSimpleDataCons)

runtimeRepTy :: Type
runtimeRepTy :: Type
runtimeRepTy = TyCon -> Type
mkTyConTy TyCon
runtimeRepTyCon

boxedRepDataCon :: DataCon
boxedRepDataCon :: DataCon
boxedRepDataCon = Name -> [Type] -> TyCon -> RuntimeRepInfo -> DataCon
pcSpecialDataCon Name
boxedRepDataConName
  [ Type
levityTy ] TyCon
runtimeRepTyCon (([Type] -> [PrimRep]) -> RuntimeRepInfo
RuntimeRep [Type] -> [PrimRep]
prim_rep_fun)
  where
    -- See Note [Getting from RuntimeRep to PrimRep] in RepType
    prim_rep_fun :: [Type] -> [PrimRep]
prim_rep_fun [Type
lev]
      = case TyCon -> RuntimeRepInfo
tyConRuntimeRepInfo ((() :: Constraint) => Type -> TyCon
Type -> TyCon
tyConAppTyCon Type
lev) of
          RuntimeRepInfo
LiftedInfo -> [PrimRep
LiftedRep]
          RuntimeRepInfo
UnliftedInfo -> [PrimRep
UnliftedRep]
          RuntimeRepInfo
_ -> [Char] -> SDoc -> [PrimRep]
forall a. HasCallStack => [Char] -> SDoc -> a
pprPanic [Char]
"boxedRepDataCon" (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
lev)
    prim_rep_fun [Type]
args
      = [Char] -> SDoc -> [PrimRep]
forall a. HasCallStack => [Char] -> SDoc -> a
pprPanic [Char]
"boxedRepDataCon" ([Type] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type]
args)


boxedRepDataConTyCon :: TyCon
boxedRepDataConTyCon :: TyCon
boxedRepDataConTyCon = DataCon -> TyCon
promoteDataCon DataCon
boxedRepDataCon

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 Int
n <- TyCon -> RuntimeRepInfo
tyConRuntimeRepInfo ((() :: Constraint) => Type -> TyCon
Type -> TyCon
tyConAppTyCon Type
count)
      , VecElem  PrimElemRep
e <- TyCon -> RuntimeRepInfo
tyConRuntimeRepInfo ((() :: Constraint) => Type -> TyCon
Type -> TyCon
tyConAppTyCon Type
elem)
      = [Int -> PrimElemRep -> PrimRep
VecRep Int
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 ((() :: Constraint) => 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 ((() :: Constraint) => 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]
runtimeRepSimpleDataCons :: [DataCon]
runtimeRepSimpleDataCons
  = (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
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]
intRepDataConTy,
  int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy,
  wordRepDataConTy,
  word8RepDataConTy, word16RepDataConTy, word32RepDataConTy, word64RepDataConTy,
  addrRepDataConTy,
  floatRepDataConTy, doubleRepDataConTy :: Type
[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 = (Int -> Name -> DataCon) -> [Int] -> [Name] -> [DataCon]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWithLazy Int -> Name -> DataCon
mk_vec_count_dc
                     [ Int
2, Int
4, Int
8, Int
16, Int
32, Int
64 ]
                     [Name]
vecCountDataConNames
  where
    mk_vec_count_dc :: Int -> Name -> DataCon
mk_vec_count_dc Int
n Name
name
      = Name -> [Type] -> TyCon -> RuntimeRepInfo -> DataCon
pcSpecialDataCon Name
name [] TyCon
vecCountTyCon (Int -> RuntimeRepInfo
VecCount Int
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

{- *********************************************************************
*                                                                      *
     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
mkTyConTy 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
word8PrimTy] 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)

-- NonEmpty lists (used for 'ProjectionE')
nonEmptyTyCon :: TyCon
nonEmptyTyCon :: TyCon
nonEmptyTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
nonEmptyTyConName Maybe CType
forall a. Maybe a
Nothing [TyVar
alphaTyVar] [DataCon
nonEmptyDataCon]

nonEmptyDataCon :: DataCon
nonEmptyDataCon :: DataCon
nonEmptyDataCon = Bool
-> Name
-> [TyVar]
-> [TyVar]
-> [TyVar]
-> [Scaled Type]
-> TyCon
-> DataCon
pcDataConWithFixity Bool
True {- Declared infix -}
                    Name
nonEmptyDataConName
                    [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
nonEmptyTyCon

-- 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

mkPromotedMaybeTy :: Kind -> Maybe Type -> Type
mkPromotedMaybeTy :: Type -> Maybe Type -> Type
mkPromotedMaybeTy Type
k (Just Type
x) = TyCon -> [Type] -> Type
mkTyConApp TyCon
promotedJustDataCon [Type
k,Type
x]
mkPromotedMaybeTy Type
k Maybe Type
Nothing  = TyCon -> [Type] -> Type
mkTyConApp TyCon
promotedNothingDataCon [Type
k]

mkMaybeTy :: Type -> Kind
mkMaybeTy :: Type -> Type
mkMaybeTy Type
t = TyCon -> [Type] -> Type
mkTyConApp TyCon
maybeTyCon [Type
t]

isPromotedMaybeTy :: Type -> Maybe (Maybe Type)
isPromotedMaybeTy :: Type -> Maybe (Maybe Type)
isPromotedMaybeTy Type
t
  | Just (TyCon
tc,[Type
_,Type
x]) <- (() :: Constraint) => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
t, TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
promotedJustDataCon = Maybe Type -> Maybe (Maybe Type)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Type -> Maybe (Maybe Type))
-> Maybe Type -> Maybe (Maybe Type)
forall a b. (a -> b) -> a -> b
$ Type -> Maybe Type
forall a. a -> Maybe a
Just Type
x
  | Just (TyCon
tc,[Type
_])   <- (() :: Constraint) => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
t, TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
promotedNothingDataCon = Maybe Type -> Maybe (Maybe Type)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Type -> Maybe (Maybe Type))
-> Maybe Type -> Maybe (Maybe Type)
forall a b. (a -> b) -> a -> b
$ Maybe Type
forall a. Maybe a
Nothing
  | Bool
otherwise = Maybe (Maybe Type)
forall a. Maybe a
Nothing


{-
** *********************************************************************
*                                                                      *
            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 -> Int -> TyCon
tupleTyCon Boxity
Boxed ([Type] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
tys)) [Type]
tys
mkTupleTy1 Boxity
Unboxed [Type]
tys  = TyCon -> [Type] -> Type
mkTyConApp (Boxity -> Int -> TyCon
tupleTyCon Boxity
Unboxed ([Type] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
tys))
                                         ((Type -> Type) -> [Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map (() :: Constraint) => 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 (Int -> TyCon
sumTyCon ([Type] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
tys))
                         ((Type -> Type) -> [Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map (() :: Constraint) => 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 a b. (a -> b -> b) -> b -> [a] -> b
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]) <- (() :: Constraint) => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
list_ty
      = Bool -> [Type] -> [Type]
forall a. HasCallStack => Bool -> a -> a
assert (TyCon
tc TyCon -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
consDataConKey) ([Type] -> [Type]) -> [Type] -> [Type]
forall a b. (a -> b) -> a -> b
$
        Type
t Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
: Type -> [Type]
go Type
ts

      | Just (TyCon
tc, [Type
_k]) <- (() :: Constraint) => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
list_ty
      = Bool -> [Type] -> [Type]
forall a. HasCallStack => Bool -> a -> a
assert (TyCon
tc TyCon -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
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


-- | Replaces constraint tuple names with corresponding boxed ones.
filterCTuple :: RdrName -> RdrName
filterCTuple :: RdrName -> RdrName
filterCTuple (Exact Name
n)
  | Just Int
arity <- Name -> Maybe Int
cTupleTyConNameArity_maybe Name
n
  = Name -> RdrName
Exact (Name -> RdrName) -> Name -> RdrName
forall a b. (a -> b) -> a -> b
$ TupleSort -> Int -> Name
tupleTyConName TupleSort
BoxedTuple Int
arity
filterCTuple RdrName
rdr = RdrName
rdr