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

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

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ParallelListComp #-}
{-# LANGUAGE MultiWayIf #-}

{-# 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, isTupleTyOcc_maybe, isSumTyOcc_maybe,
        isPunOcc_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, BoxingInfo(..),

        -- * 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, extractPromotedList,

        -- * 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, mkConstraintTupleTy,

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

        -- * Any
        anyTyCon, anyTy, anyTypeOfKind, zonkAnyTyCon,

        -- * Recovery TyCon
        makeRecoveryTyCon,

        -- * Sums
        mkSumTy, sumTyCon, sumDataCon,

        -- * Kinds
        typeSymbolKindCon, typeSymbolKind,
        isLiftedTypeKindTyConName,
        typeToTypeKind,
        liftedRepTyCon, unliftedRepTyCon,
        tYPETyCon, tYPETyConName, tYPEKind,
        cONSTRAINTTyCon, cONSTRAINTTyConName, cONSTRAINTKind,
        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, vecCountTyCon, vecElemTyCon,

        boxedRepDataConTyCon,
        runtimeRepTy, liftedRepTy, unliftedRepTy, zeroBitRepTy,

        vecRepDataConTyCon, tupleRepDataConTyCon, sumRepDataConTyCon,

        -- * Levity
        levityTyCon, levityTy,
        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,

         pretendNameIsInScope,
    ) 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( Expr(Type), mkConApp )
import GHC.Core.Coercion.Axiom
import GHC.Core.Type
import GHC.Types.Id
import GHC.Core.DataCon
import GHC.Core.ConLike
import GHC.Core.TyCon
import GHC.Core.Class     ( Class, mkClass )
import GHC.Core.Map.Type  ( TypeMap, emptyTypeMap, extendTypeMap, lookupTypeMap )
import qualified GHC.Core.TyCo.Rep as TyCoRep ( Type(TyConApp) )

import GHC.Types.TyThing
import GHC.Types.SourceText
import GHC.Types.Var ( VarBndr (Bndr), tyVarName )
import GHC.Types.RepType
import GHC.Types.Name.Reader
import GHC.Types.Name as Name
import GHC.Types.Name.Env ( lookupNameEnv_NF, mkNameEnv )
import GHC.Types.Basic
import GHC.Types.ForeignCall
import GHC.Types.Unique.Set

import {-# SOURCE #-} GHC.Tc.Types.Origin
  ( FixedRuntimeRepOrigin(..), mkFRRUnboxedTuple, mkFRRUnboxedSum )
import {-# SOURCE #-} GHC.Tc.Utils.TcType
  ( ConcreteTvOrigin(..), ConcreteTyVars, noConcreteTyVars )

import GHC.Settings.Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE )
import GHC.Unit.Module        ( Module )

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 qualified Data.ByteString.Char8 as BS

import Data.Foldable
import Data.List        ( elemIndex, intersperse )
import Numeric          ( showInt )

import Data.Char (ord, isDigit)
import Control.Applicative ((<|>))

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 = ((Type, DataCon) -> TyCon) -> [(Type, DataCon)] -> [TyCon]
forall a b. (a -> b) -> [a] -> [b]
map (DataCon -> TyCon
dataConTyCon (DataCon -> TyCon)
-> ((Type, DataCon) -> DataCon) -> (Type, DataCon) -> TyCon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type, DataCon) -> DataCon
forall a b. (a, b) -> b
snd) [(Type, DataCon)]
boxingDataCons
             [TyCon] -> [TyCon] -> [TyCon]
forall a. [a] -> [a] -> [a]
++ [ -- 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 boxed 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
zonkAnyTyCon
                , 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
                ]

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_INTERNAL_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
UserSyntax    Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"List") Unique
listTyConKey TyCon
listTyCon
nilDataConName :: Name
nilDataConName    = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
BuiltInSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"[]") Unique
nilDataConKey DataCon
nilDataCon
consDataConName :: Name
consDataConName   = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
BuiltInSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
":") Unique
consDataConKey DataCon
consDataCon

maybeTyConName, nothingDataConName, justDataConName :: Name
maybeTyConName :: Name
maybeTyConName     = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName   BuiltInSyntax
UserSyntax Module
gHC_INTERNAL_MAYBE ([Char] -> FastString
fsLit [Char]
"Maybe")
                                          Unique
maybeTyConKey TyCon
maybeTyCon
nothingDataConName :: Name
nothingDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_INTERNAL_MAYBE ([Char] -> FastString
fsLit [Char]
"Nothing")
                                          Unique
nothingDataConKey DataCon
nothingDataCon
justDataConName :: Name
justDataConName    = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_INTERNAL_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_INTERNAL_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 constructors `Any` and `ZonkAny` are closed type families declared thus:

    type family Any     :: forall k.        k where { }
    type family ZonkAny :: forall k. Nat -> k where { }

They are used when we want a type of a particular kind, but we don't really care
what that type is.  The leading example is this: `ZonkAny` is used to instantiate
un-constrained type variables after type checking. For example, consider the
term (length [] :: Int), where

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

We must type-apply `length` and `[]`, but to what type? It doesn't matter!
The typechecker will end up with

  length @alpha ([] @alpha)

where `alpha` is an un-constrained unification variable.  The "zonking" process zaps
that unconstrained `alpha` to an arbitrary type (ZonkAny @Type 3), where the `3` is
arbitrary (see wrinkle (Any5) below).  This is done in `GHC.Tc.Zonk.Type.commitFlexi`.
So we end up with

  length @(ZonkAny @Type 3) ([] @(ZonkAny @Type 3))

`Any` and `ZonkAny` differ only in the presence of the `Nat` argument; see
wrinkle (Any4).

Wrinkles:

(Any1) `Any` and `ZonkAny` are kind polymorphic since in some program we may
   need to use `ZonkAny` to fill in a type variable of some kind other than *
   (see #959 for examples).

(Any2) They are /closed/ type families, with no instances.  For example, suppose that
   with  alpha :: '(k1, k2)  we add a given coercion
             g :: alpha ~ (Fst alpha, Snd alpha)
   and we zonked alpha = ZonkAny @(k1,k2) n.  Then, if `ZonkAny` was a /data/ type,
   we'd get inconsistency because we'd have a Given equality with `ZonkAny` on one
   side and '(,) on the other. See also #9097 and #9636.

   See #25244 for a suggestion that we instead use an /open/ type family for which
   you cannot provide instances.  Probably the difference is not very important.

(Any3) They do not claim to be /data/ types, and that's important for
   the code generator, because the code gen may /enter/ a data value
   but never enters a function value.

(Any4) `ZonkAny` takes a `Nat` argument so that we can readily make up /distinct/
   types (#24817).  Consider

     data SBool a where { STrue :: SBool True; SFalse :: SBool False }

     foo :: forall a b. (SBool a, SBool b)

     bar :: Bool
     bar = case foo @alpha @beta of
             (STrue, SFalse) -> True   -- This branch is not inaccessible!
             _               -> False

   Now, what are `alpha` and `beta`? If we zonk both of them to the same type
   `Any @Type`, the pattern-match checker will (wrongly) report that the first
   branch is inaccessible.  So we zonk them to two /different/ types:
       alpha :=  ZonkAny @Type 4   and   beta :=  ZonkAny @Type k 5
   (The actual numbers are arbitrary; they just need to differ.)

   The unique-name generation comes from field `tcg_zany_n` of `TcGblEnv`; and
   `GHC.Tc.Zonk.Type.commitFlexi` calls `GHC.Tc.Utils.Monad.newZonkAnyType` to
   make up a fresh type.

   If this example seems unconvincing (e.g. in this case foo must be bottom)
   see #24817 for larger but more compelling examples.

(Any5) `Any` and `ZonkAny` are 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)

(Any6) `Any` is defined in library module ghc-prim: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
    Currently `ZonkAny` is not available to users; but it could easily be.

(Any7) Properties of `Any`:
  * When `Any` is 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`.

  * You can safely coerce any /unlifted/ type to `Any` and back with `unsafeCoerceUnlifted`.

  * You can coerce /any/ type to `Any` and back with `unsafeCoerce#`, but it's only safe when
    the kinds of both the type and `Any` match.

  * For lifted/unlifted types `unsafeCoerce[Unlifted]` should be preferred over
    `unsafeCoerce#` as they prevent accidentally coercing between types with kinds
    that don't match.

    See examples in ghc-prim:GHC.Types

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
-- See Note [Any types]
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]

zonkAnyTyConName :: Name
zonkAnyTyConName :: Name
zonkAnyTyConName =
    BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"ZonkAny") Unique
zonkAnyTyConKey TyCon
zonkAnyTyCon

zonkAnyTyCon :: TyCon
-- ZonkAnyTyCon :: forall k. Nat -> k
-- See Note [Any types]
zonkAnyTyCon :: TyCon
zonkAnyTyCon = Name
-> [TyConBinder]
-> Type
-> Maybe Name
-> FamTyConFlav
-> Maybe Class
-> Injectivity
-> TyCon
mkFamilyTyCon Name
zonkAnyTyConName
                         [ ForAllTyFlag -> TyVar -> TyConBinder
mkNamedTyConBinder ForAllTyFlag
Specified TyVar
kv
                         , TyVar -> TyConBinder
mkAnonTyConBinder TyVar
nat_kv ]
                         (TyVar -> Type
mkTyVarTy TyVar
kv)
                         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
    [TyVar
kv,TyVar
nat_kv] = [Type] -> [TyVar]
mkTemplateKindVars [Type
liftedTypeKind, Type
naturalTy]

-- | 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
-> TyCon
mkTcTyCon (TyCon -> Name
tyConName TyCon
tc)
              [TyConBinder]
bndrs Type
res_kind
              [(Name, TyVar)]
noTcTyConScopedTyVars
              Bool
True             -- Fully generalised
              TyConFlavour TyCon
flavour          -- Keep old flavour
  where
    flavour :: TyConFlavour TyCon
flavour = TyCon -> TyConFlavour TyCon
tyConFlavour TyCon
tc
    [TyVar
kv] = [Type] -> [TyVar]
mkTemplateKindVars [Type
liftedTypeKind]
    ([TyConBinder]
bndrs, Type
res_kind)
       = case TyConFlavour TyCon
flavour of
           TyConFlavour TyCon
PromotedDataConFlavour -> ([ForAllTyFlag -> TyVar -> TyConBinder
mkNamedTyConBinder ForAllTyFlag
Inferred TyVar
kv], TyVar -> Type
mkTyVarTy TyVar
kv)
           TyConFlavour TyCon
_ -> (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


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
                ([TyVar] -> [TyConBinder]
mkAnonTyConBinders [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] -> ConcreteTyVars -> [Type] -> TyCon -> DataCon
pcRepPolyDataCon Name
n [TyVar]
univs ConcreteTyVars
noConcreteTyVars [Type]
tys

pcRepPolyDataCon :: Name -> [TyVar] -> ConcreteTyVars
                 -> [Type] -> TyCon -> DataCon
pcRepPolyDataCon :: Name -> [TyVar] -> ConcreteTyVars -> [Type] -> TyCon -> DataCon
pcRepPolyDataCon Name
n [TyVar]
univs ConcreteTyVars
conc_tvs [Type]
tys
  = Bool
-> Name
-> [TyVar]
-> [TyVar]
-> ConcreteTyVars
-> [TyVar]
-> [Type]
-> [Scaled Type]
-> TyCon
-> DataCon
pcDataConWithFixity Bool
False Name
n
      [TyVar]
univs
      []    -- no ex_tvs
      ConcreteTyVars
conc_tvs
      [TyVar]
univs -- the univs are precisely the user-written tyvars
      []    -- No theta
      ((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)

pcDataConConstraint :: Name -> [TyVar] -> ThetaType -> TyCon -> DataCon
-- Used for data constructors whose arguments are all constraints.
-- Notably constraint tuples, Eq# etc.
pcDataConConstraint :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataConConstraint Name
n [TyVar]
univs [Type]
theta
  = Bool
-> Name
-> [TyVar]
-> [TyVar]
-> ConcreteTyVars
-> [TyVar]
-> [Type]
-> [Scaled Type]
-> TyCon
-> DataCon
pcDataConWithFixity Bool
False Name
n
      [TyVar]
univs
      []           -- No ex_tvs
      ConcreteTyVars
noConcreteTyVars
      [TyVar]
univs        -- The univs are precisely the user-written tyvars
      [Type]
theta        -- All constraint arguments
      []           -- No value arguments

-- Used for RuntimeRep and friends; things with PromDataConInfo
pcSpecialDataCon :: Name -> [Type] -> TyCon -> PromDataConInfo -> DataCon
pcSpecialDataCon :: Name -> [Type] -> TyCon -> PromDataConInfo -> DataCon
pcSpecialDataCon Name
dc_name [Type]
arg_tys TyCon
tycon PromDataConInfo
rri
  = Bool
-> Name
-> Unique
-> PromDataConInfo
-> [TyVar]
-> [TyVar]
-> ConcreteTyVars
-> [TyVar]
-> [Type]
-> [Scaled Type]
-> TyCon
-> DataCon
pcDataConWithFixity' Bool
False Name
dc_name
                         (Unique -> Unique
dataConWorkerUnique (Name -> Unique
nameUnique Name
dc_name)) PromDataConInfo
rri
                         [] [] ConcreteTyVars
noConcreteTyVars [] [] ((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

pcDataConWithFixity :: Bool      -- ^ declared infix?
                    -> Name      -- ^ datacon name
                    -> [TyVar]   -- ^ univ tyvars
                    -> [TyCoVar] -- ^ ex tycovars
                    -> ConcreteTyVars
                                 -- ^ concrete tyvars
                    -> [TyCoVar] -- ^ user-written tycovars
                    -> ThetaType
                    -> [Scaled Type]    -- ^ args
                    -> TyCon
                    -> DataCon
pcDataConWithFixity :: Bool
-> Name
-> [TyVar]
-> [TyVar]
-> ConcreteTyVars
-> [TyVar]
-> [Type]
-> [Scaled Type]
-> TyCon
-> DataCon
pcDataConWithFixity Bool
infx Name
n = Bool
-> Name
-> Unique
-> PromDataConInfo
-> [TyVar]
-> [TyVar]
-> ConcreteTyVars
-> [TyVar]
-> [Type]
-> [Scaled Type]
-> TyCon
-> DataCon
pcDataConWithFixity' Bool
infx Name
n
                                 (Unique -> Unique
dataConWorkerUnique (Name -> Unique
nameUnique Name
n)) PromDataConInfo
NoPromInfo
-- 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 -> PromDataConInfo
                     -> [TyVar] -> [TyCoVar]
                     -> ConcreteTyVars
                     -> [TyCoVar]
                     -> ThetaType -> [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
-> PromDataConInfo
-> [TyVar]
-> [TyVar]
-> ConcreteTyVars
-> [TyVar]
-> [Type]
-> [Scaled Type]
-> TyCon
-> DataCon
pcDataConWithFixity' Bool
declared_infix Name
dc_name Unique
wrk_key PromDataConInfo
rri
                     [TyVar]
tyvars [TyVar]
ex_tyvars ConcreteTyVars
conc_tyvars [TyVar]
user_tyvars [Type]
theta [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]
-> [HsImplBang]
-> [StrictnessMark]
-> [FieldLabel]
-> [TyVar]
-> [TyVar]
-> ConcreteTyVars
-> [InvisTVBinder]
-> [EqSpec]
-> [Type]
-> [Scaled Type]
-> Type
-> PromDataConInfo
-> 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)
                ((Scaled Type -> HsImplBang) -> [Scaled Type] -> [HsImplBang]
forall a b. (a -> b) -> [a] -> [b]
map (HsImplBang -> Scaled Type -> HsImplBang
forall a b. a -> b -> a
const HsImplBang
HsLazy) [Scaled Type]
arg_tys)
                ((Scaled Type -> StrictnessMark)
-> [Scaled Type] -> [StrictnessMark]
forall a b. (a -> b) -> [a] -> [b]
map (StrictnessMark -> Scaled Type -> StrictnessMark
forall a b. a -> b -> a
const StrictnessMark
NotMarkedStrict) [Scaled Type]
arg_tys)
                []      -- No labelled fields
                [TyVar]
tyvars [TyVar]
ex_tyvars
                ConcreteTyVars
conc_tyvars
                (Specificity -> [TyVar] -> [InvisTVBinder]
forall vis. vis -> [TyVar] -> [VarBndr TyVar vis]
mkTyVarBinders Specificity
SpecifiedSpec [TyVar]
user_tyvars)
                []      -- No equality spec
                [Type]
theta
                [Scaled Type]
arg_tys (TyCon -> [Type] -> Type
mkTyConApp TyCon
tycon ([TyVar] -> [Type]
mkTyVarTys [TyVar]
tyvars))
                PromDataConInfo
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
mkHsSrcBang 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
$
               HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
dc_name
    dc_name :: Name
dc_name = DataCon -> Name
dataConName DataCon
data_con
    dc_occ :: OccName
dc_occ  = Name -> OccName
nameOccName Name
dc_name
    wrk_occ :: OccName
wrk_occ = OccName -> OccName
mkDataConWorkerOcc OccName
dc_occ


{-
************************************************************************
*                                                                      *
              Symbol
*                                                                      *
************************************************************************
-}

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


{-
************************************************************************
*                                                                      *
                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
    - Data type declarations in GHC.Types
      but no actual declaration and no info table

* ConstraintTuples
    - A wired-in type.
    - Declared as classes in GHC.Classes, e.g.
         class (c1,c2) => CTuple2 c1 c2
    - Given constraints: the superclasses automatically become available
    - Wanted constraints: there is a built-in instance
         instance (c1,c2) => CTuple2 c1 c2
      See GHC.Tc.Instance.Class.matchCTuple
    - Currently just go up to 64; beyond that
      you have to use manual nesting
    - Unlike BoxedTuples and UnboxedTuples, which only wire
      in type constructors and data constructors, ConstraintTuples also wire in
      superclass selector functions. For instance, $p1CTuple2 and $p2CTuple2 are
      the selectors for the binary constraint tuple.
    - The parenthesis syntax for grouping constraints in contexts is not treated
      as a constraint tuple. The parser starts with a tuple type, then a
      postprocessing action extracts the individual constraints as a list and
      stores them in the context field of types like HsQualTy.

* 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:  Tuple3   (,,)#
  2-tuples:  Tuple2   (,)#
  1-tuples:  ??
  0-tuples:  Unit     ()#

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 Unit = ()
  data Solo a = MkSolo a
  data Tuple2 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 = MkSolo 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 MkSolo 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] in GHC.Iface.Binary.
--
-- 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

      -- 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
"(# #)" -> 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 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (NameSpace -> SDoc
pprNameSpace NameSpace
ns))
      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))

isTupleTyOcc_maybe :: Module -> OccName -> Maybe Name
isTupleTyOcc_maybe :: Module -> OccName -> Maybe Name
isTupleTyOcc_maybe Module
mod OccName
occ
  | Module
mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
gHC_INTERNAL_TUPLE Bool -> Bool -> Bool
|| Module
mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
gHC_TYPES
  = Maybe Name
match_occ
  where
    match_occ :: Maybe Name
match_occ
      | OccName
occ OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
unitTyConName = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
unitTyConName
      | OccName
occ OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
soloTyConName = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
soloTyConName
      | OccName
occ OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
unboxedUnitTyConName = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
unboxedUnitTyConName
      | OccName
occ OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
unboxedSoloTyConName = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
unboxedSoloTyConName
      | Bool
otherwise = OccName -> Maybe Name
isTupleNTyOcc_maybe OccName
occ
isTupleTyOcc_maybe Module
_ OccName
_ = Maybe Name
forall a. Maybe a
Nothing

isCTupleOcc_maybe :: Module -> OccName -> Maybe Name
isCTupleOcc_maybe :: Module -> OccName -> Maybe Name
isCTupleOcc_maybe Module
mod OccName
occ
  | Module
mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
gHC_CLASSES
  = Maybe Name
match_occ
  where
    match_occ :: Maybe Name
match_occ
      | OccName
occ OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> OccName
forall name. HasOccName name => name -> OccName
occName (Int -> Name
cTupleTyConName Int
0) = Name -> Maybe Name
forall a. a -> Maybe a
Just (Int -> Name
cTupleTyConName Int
0)
      | OccName
occ OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> OccName
forall name. HasOccName name => name -> OccName
occName (Int -> Name
cTupleTyConName Int
1) = Name -> Maybe Name
forall a. a -> Maybe a
Just (Int -> Name
cTupleTyConName Int
1)
      | Char
'C':Char
'T':Char
'u':Char
'p':Char
'l':Char
'e' : [Char]
rest <- OccName -> [Char]
occNameString OccName
occ
      , Just (TupleSort
BoxedTuple, Int
num) <- [Char] -> Maybe (TupleSort, Int)
arity_and_boxity [Char]
rest
      , Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 Bool -> Bool -> Bool
&& Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
64
           = Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ Int -> Name
cTupleTyConName Int
num
      | Bool
otherwise = Maybe Name
forall a. Maybe a
Nothing

isCTupleOcc_maybe Module
_ OccName
_ = Maybe Name
forall a. Maybe a
Nothing

-- | This is only for Tuple<n>, not for Unit or Solo
isTupleNTyOcc_maybe :: OccName -> Maybe Name
isTupleNTyOcc_maybe :: OccName -> Maybe Name
isTupleNTyOcc_maybe OccName
occ =
  case OccName -> [Char]
occNameString OccName
occ of
    Char
'T':Char
'u':Char
'p':Char
'l':Char
'e':[Char]
str | Just (TupleSort
sort, Int
n) <- [Char] -> Maybe (TupleSort, Int)
arity_and_boxity [Char]
str, Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
      -> Name -> Maybe Name
forall a. a -> Maybe a
Just (TupleSort -> Int -> Name
tupleTyConName TupleSort
sort Int
n)
    [Char]
_ -> Maybe Name
forall a. Maybe a
Nothing

isSumTyOcc_maybe :: Module -> OccName -> Maybe Name
isSumTyOcc_maybe :: Module -> OccName -> Maybe Name
isSumTyOcc_maybe Module
mod OccName
occ | Module
mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
gHC_TYPES =
  OccName -> Maybe Name
isSumNTyOcc_maybe OccName
occ
isSumTyOcc_maybe Module
_ OccName
_ = Maybe Name
forall a. Maybe a
Nothing

isSumNTyOcc_maybe :: OccName -> Maybe Name
isSumNTyOcc_maybe :: OccName -> Maybe Name
isSumNTyOcc_maybe OccName
occ =
  case OccName -> [Char]
occNameString OccName
occ of
    Char
'S':Char
'u':Char
'm':[Char]
str | Just (TupleSort
UnboxedTuple, Int
n) <- [Char] -> Maybe (TupleSort, Int)
arity_and_boxity [Char]
str, Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
      -> Name -> Maybe Name
forall a. a -> Maybe a
Just (TyCon -> Name
tyConName (Int -> TyCon
sumTyCon Int
n))
    [Char]
_ -> Maybe Name
forall a. Maybe a
Nothing

-- | See Note [Small Ints parsing]
--
-- Analyze a string as the suffix of an OccName of a tuple or sum tycon to
-- determine its arity and boxity (based on the presence of a @#@).
arity_and_boxity :: String -> Maybe (TupleSort, Int)
arity_and_boxity :: [Char] -> Maybe (TupleSort, Int)
arity_and_boxity [Char]
s = case [Char]
s of
  Char
c1 : [Char]
t1 | Char -> Bool
isDigit Char
c1 -> case [Char]
t1 of
    [] -> (TupleSort, Int) -> Maybe (TupleSort, Int)
forall a. a -> Maybe a
Just (TupleSort
BoxedTuple, Char -> Int
digit_to_int Char
c1)
    [Char
'#'] -> (TupleSort, Int) -> Maybe (TupleSort, Int)
forall a. a -> Maybe a
Just (TupleSort
UnboxedTuple, Char -> Int
digit_to_int Char
c1)
    Char
c2 : [Char]
t2 | Char -> Bool
isDigit Char
c2 ->
      let ar :: Int
ar = Char -> Int
digit_to_int Char
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
digit_to_int Char
c2
      in case [Char]
t2 of
        [] -> (TupleSort, Int) -> Maybe (TupleSort, Int)
forall a. a -> Maybe a
Just (TupleSort
BoxedTuple, Int
ar)
        [Char
'#'] -> (TupleSort, Int) -> Maybe (TupleSort, Int)
forall a. a -> Maybe a
Just (TupleSort
UnboxedTuple, Int
ar)
        [Char]
_ -> Maybe (TupleSort, Int)
forall a. Maybe a
Nothing
    [Char]
_ -> Maybe (TupleSort, Int)
forall a. Maybe a
Nothing
  [Char]
_ -> Maybe (TupleSort, Int)
forall a. Maybe a
Nothing
  where
    digit_to_int :: Char -> Int
    digit_to_int :: Char -> Int
digit_to_int Char
c = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0'

{-
Note [Small Ints parsing]
~~~~~~~~~~~~~~~~~~~~~~~~~
Currently, tuples in Haskell have a maximum arity of 64.
To parse strings of length 1 and 2 more efficiently, we
can utilize an ad-hoc solution that matches their characters.
This results in a speedup of up to 40 times compared to using
`readMaybe @Int` on my machine.
-}

-- When resolving names produced by Template Haskell (see thOrigRdrName
-- in GHC.ThToHs), we want ghc-prim:GHC.Types.List to yield an Exact name, not
-- an Orig name.
--
-- This matters for pretty-printing under ListTuplePuns. If we don't do it,
-- then -ddump-splices will print ''[] as ''GHC.Types.List.
--
-- Test case: th/T13776
--
isPunOcc_maybe :: Module -> OccName -> Maybe Name
isPunOcc_maybe :: Module -> OccName -> Maybe Name
isPunOcc_maybe Module
mod OccName
occ
  | Module
mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
gHC_TYPES, OccName
occ OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
listTyConName
  = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
listTyConName
  | Module
mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
gHC_TYPES, OccName
occ OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
unboxedSoloDataConName
  = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
unboxedSoloDataConName
  | Bool
otherwise
  = Module -> OccName -> Maybe Name
isTupleTyOcc_maybe Module
mod OccName
occ Maybe Name -> Maybe Name -> Maybe Name
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    Module -> OccName -> Maybe Name
isCTupleOcc_maybe  Module
mod OccName
occ Maybe Name -> Maybe Name -> Maybe Name
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    Module -> OccName -> Maybe Name
isSumTyOcc_maybe   Module
mod OccName
occ

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 (NameSpace -> Int -> [Char]
mkBoxedTupleStr NameSpace
ns Int
ar)
mkTupleOcc NameSpace
ns Boxity
Unboxed Int
ar = NameSpace -> [Char] -> OccName
mkOccName NameSpace
ns (NameSpace -> Int -> [Char]
mkUnboxedTupleStr NameSpace
ns 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 -> NameSpace -> Arity -> String
mkTupleStr :: Boxity -> NameSpace -> Int -> [Char]
mkTupleStr Boxity
Boxed   = NameSpace -> Int -> [Char]
mkBoxedTupleStr
mkTupleStr Boxity
Unboxed = NameSpace -> Int -> [Char]
mkUnboxedTupleStr

mkBoxedTupleStr :: NameSpace -> Arity -> String
mkBoxedTupleStr :: NameSpace -> Int -> [Char]
mkBoxedTupleStr NameSpace
ns Int
0
  | NameSpace -> Bool
isDataConNameSpace NameSpace
ns = [Char]
"()"
  | Bool
otherwise             = [Char]
"Unit"
mkBoxedTupleStr NameSpace
ns Int
1
  | NameSpace -> Bool
isDataConNameSpace NameSpace
ns = [Char]
"MkSolo"  -- See Note [One-tuples]
  | Bool
otherwise             = [Char]
"Solo"
mkBoxedTupleStr NameSpace
ns Int
ar
  | NameSpace -> Bool
isDataConNameSpace NameSpace
ns = Char
'(' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Int -> [Char]
commas Int
ar [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"
  | Bool
otherwise             = [Char]
"Tuple" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char] -> [Char]
forall a. Integral a => a -> [Char] -> [Char]
showInt Int
ar [Char]
""


mkUnboxedTupleStr :: NameSpace -> Arity -> String
mkUnboxedTupleStr :: NameSpace -> Int -> [Char]
mkUnboxedTupleStr NameSpace
ns Int
0
  | NameSpace -> Bool
isDataConNameSpace NameSpace
ns = [Char]
"(##)"
  | Bool
otherwise             = [Char]
"Unit#"
mkUnboxedTupleStr NameSpace
ns Int
1
  | NameSpace -> Bool
isDataConNameSpace NameSpace
ns = [Char]
"MkSolo#"  -- See Note [One-tuples]
  | Bool
otherwise             = [Char]
"Solo#"
mkUnboxedTupleStr NameSpace
ns Int
ar
  | NameSpace -> Bool
isDataConNameSpace NameSpace
ns = [Char]
"(#" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
commas Int
ar [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"#)"
  | Bool
otherwise             = [Char]
"Tuple" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
ar [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"#"

mkConstraintTupleStr :: Arity -> String
mkConstraintTupleStr :: Int -> [Char]
mkConstraintTupleStr Int
0 = [Char]
"CUnit"
mkConstraintTupleStr Int
1 = [Char]
"CSolo"
mkConstraintTupleStr Int
ar = [Char]
"CTuple" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
ar

commas :: Arity -> String
commas :: Int -> [Char]
commas Int
ar = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
arInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) 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 :: UniqueSet
cTupleTyConKeys :: UniqueSet
cTupleTyConKeys = [Unique] -> UniqueSet
fromListUniqueSet ([Unique] -> UniqueSet) -> [Unique] -> UniqueSet
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 -> UniqueSet -> Bool
`memberUniqueSet` UniqueSet
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. HasCallStack => [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. HasCallStack => [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
1
  = [Char] -> TyVar
forall a. HasCallStack => [Char] -> a
panic ([Char]
"cTupleSelId: Arity starts 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
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]) <- HasDebugCallStack => 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
-> DataCon
-> TupleSort
-> AlgTyConFlav
-> TyCon
mkTupleTyCon Name
tc_name [TyConBinder]
tc_binders Type
tc_res_kind 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
    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_INTERNAL_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
UserSyntax
    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
-> DataCon
-> TupleSort
-> AlgTyConFlav
-> TyCon
mkTupleTyCon Name
tc_name [TyConBinder]
tc_binders Type
tc_res_kind 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
    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
    ([TyVar]
rr_tvs, [TyVar]
dc_arg_tvs) = Int -> [TyVar] -> ([TyVar], [TyVar])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
arity [TyVar]
dc_tvs
    rr_tys :: [Type]
rr_tys               = [TyVar] -> [Type]
mkTyVarTys [TyVar]
rr_tvs
    dc_arg_tys :: [Type]
dc_arg_tys           = [TyVar] -> [Type]
mkTyVarTys [TyVar]
dc_arg_tvs
    tuple_con :: DataCon
tuple_con            = Name -> [TyVar] -> ConcreteTyVars -> [Type] -> TyCon -> DataCon
pcRepPolyDataCon Name
dc_name [TyVar]
dc_tvs ConcreteTyVars
conc_tvs [Type]
dc_arg_tys TyCon
tycon
    conc_tvs :: ConcreteTyVars
conc_tvs =
      [(Name, ConcreteTvOrigin)] -> ConcreteTyVars
forall a. [(Name, a)] -> NameEnv a
mkNameEnv
        [ (TyVar -> Name
tyVarName TyVar
rr_tv, FixedRuntimeRepOrigin -> ConcreteTvOrigin
ConcreteFRR (FixedRuntimeRepOrigin -> ConcreteTvOrigin)
-> FixedRuntimeRepOrigin -> ConcreteTvOrigin
forall a b. (a -> b) -> a -> b
$ Type -> FixedRuntimeRepContext -> FixedRuntimeRepOrigin
FixedRuntimeRepOrigin Type
ty (FixedRuntimeRepContext -> FixedRuntimeRepOrigin)
-> FixedRuntimeRepContext -> FixedRuntimeRepOrigin
forall a b. (a -> b) -> a -> b
$ Int -> FixedRuntimeRepContext
mkFRRUnboxedTuple Int
pos)
        | TyVar
rr_tv <- [TyVar]
rr_tvs
        | Type
ty <- [Type]
dc_arg_tys
        | Int
pos <- [Int
1..Int
arity] ]

    boxity :: Boxity
boxity  = Boxity
Unboxed
    modu :: Module
modu    = Module
gHC_TYPES
    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
UserSyntax
    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] -> [Type] -> TyCon -> DataCon
pcDataConConstraint Name
dc_name [TyVar]
tvs [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
UserSyntax
    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

unitTyConName :: Name
unitTyConName :: Name
unitTyConName = TyCon -> Name
tyConName TyCon
unitTyCon

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

soloTyConName :: Name
soloTyConName :: Name
soloTyConName = TyCon -> Name
tyConName TyCon
soloTyCon

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

unboxedUnitTyConName :: Name
unboxedUnitTyConName :: Name
unboxedUnitTyConName = TyCon -> Name
tyConName TyCon
unboxedUnitTyCon

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

unboxedSoloTyCon :: TyCon
unboxedSoloTyCon :: TyCon
unboxedSoloTyCon = Boxity -> Int -> TyCon
tupleTyCon Boxity
Unboxed Int
1

unboxedSoloTyConName :: Name
unboxedSoloTyConName :: Name
unboxedSoloTyConName = TyCon -> Name
tyConName TyCon
unboxedSoloTyCon

unboxedSoloDataConName :: Name
unboxedSoloDataConName :: Name
unboxedSoloDataConName = Boxity -> Int -> Name
tupleDataConName Boxity
Unboxed Int
1

{- *********************************************************************
*                                                                      *
      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]
"Sum" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [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. HasCallStack => [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. HasCallStack => [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. HasCallStack => [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. HasCallStack => [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 -> [DataCon] -> AlgTyConFlav -> TyCon
mkSumTyCon Name
tc_name [TyConBinder]
tc_binders Type
tc_res_kind (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

    ([TyVar]
rr_tvs, [TyVar]
dc_arg_tvs) = Int -> [TyVar] -> ([TyVar], [TyVar])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
arity [TyVar]
tyvars
    rr_tys :: [Type]
rr_tys               = [TyVar] -> [Type]
mkTyVarTys [TyVar]
rr_tvs
    dc_arg_tys :: [Type]
dc_arg_tys           = [TyVar] -> [Type]
mkTyVarTys [TyVar]
dc_arg_tvs

    conc_tvs :: ConcreteTyVars
conc_tvs =
      [(Name, ConcreteTvOrigin)] -> ConcreteTyVars
forall a. [(Name, a)] -> NameEnv a
mkNameEnv
        [ (TyVar -> Name
tyVarName TyVar
rr_tv, FixedRuntimeRepOrigin -> ConcreteTvOrigin
ConcreteFRR (FixedRuntimeRepOrigin -> ConcreteTvOrigin)
-> FixedRuntimeRepOrigin -> ConcreteTvOrigin
forall a b. (a -> b) -> a -> b
$ Type -> FixedRuntimeRepContext -> FixedRuntimeRepOrigin
FixedRuntimeRepOrigin Type
ty (FixedRuntimeRepContext -> FixedRuntimeRepOrigin)
-> FixedRuntimeRepContext -> FixedRuntimeRepOrigin
forall a b. (a -> b) -> a -> b
$ Maybe Int -> FixedRuntimeRepContext
mkFRRUnboxedSum (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
pos))
        | TyVar
rr_tv <- [TyVar]
rr_tvs
        | Type
ty <- [Type]
dc_arg_tys
        | Int
pos <- [Int
1..Int
arity] ]

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

    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] -> ConcreteTyVars -> [Type] -> TyCon -> DataCon
pcRepPolyDataCon Name
dc_name
                  [TyVar]
tyvars -- univ tyvars
                  ConcreteTyVars
conc_tvs
                  [[Type]
dc_arg_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_TYPES
                                  (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] -> [Type] -> TyCon -> DataCon
pcDataConConstraint Name
eqDataConName [TyVar]
tvs [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] -> [Type] -> TyCon -> DataCon
pcDataConConstraint Name
heqDataConName [TyVar]
tvs [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] -> [Type] -> TyCon -> DataCon
pcDataConConstraint Name
coercibleDataConName [TyVar]
tvs [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]
-> [([TyVar], [TyVar])]
-> [Type]
-> [TyVar]
-> [ClassATItem]
-> [ClassOpItem]
-> BooleanFormula GhcRn
-> TyCon
-> Class
mkClass (TyCon -> Name
tyConName TyCon
tycon) (TyCon -> [TyVar]
tyConTyVars TyCon
tycon) [] [Type
sc_pred] [TyVar
sc_sel_id]
            [] [] ([LBooleanFormula GhcRn] -> BooleanFormula GhcRn
forall p.
(UnXRec p, Eq (LIdP p), Eq (LBooleanFormula p)) =>
[LBooleanFormula p] -> BooleanFormula p
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]
-> [([TyVar], [TyVar])]
-> [Type]
-> [TyVar]
-> [ClassATItem]
-> [ClassOpItem]
-> BooleanFormula GhcRn
-> TyCon
-> Class
mkClass (TyCon -> Name
tyConName TyCon
tycon) (TyCon -> [TyVar]
tyConTyVars TyCon
tycon) [] [Type]
sc_theta [TyVar]
sc_sel_ids
            [] [] ([LBooleanFormula GhcRn] -> BooleanFormula GhcRn
forall p.
(UnXRec p, Eq (LIdP p), Eq (LBooleanFormula p)) =>
[LBooleanFormula p] -> BooleanFormula p
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
-}

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
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"One") Unique
oneDataConKey DataCon
oneDataCon
manyDataConName :: Name
manyDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Many") Unique
manyDataConKey DataCon
manyDataCon

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]

------------------------
-- type (->) :: forall (rep1 :: RuntimeRep) (rep2 :: RuntimeRep).
--              TYPE rep1 -> TYPE rep2 -> Type
-- type (->) = FUN 'Many
unrestrictedFunTyCon :: TyCon
unrestrictedFunTyCon :: TyCon
unrestrictedFunTyCon
  = Name -> [TyConBinder] -> Type -> [Role] -> Type -> TyCon
buildSynTyCon Name
unrestrictedFunTyConName [] Type
arrowKind []
                  (TyCon -> [Type] -> Type
TyCoRep.TyConApp TyCon
fUNTyCon [Type
manyDataConTy])
  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 (ForAllTyFlag -> TyConBndrVis
NamedTCB ForAllTyFlag
Inferred)
              , TyVar -> TyConBndrVis -> TyConBinder
forall var argf. var -> argf -> VarBndr var argf
Bndr TyVar
runtimeRep2TyVar (ForAllTyFlag -> TyConBndrVis
NamedTCB ForAllTyFlag
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 CONSTRAINT   :: RuntimeRep -> Type -- primitive; cONSTRAINTKind
         type Constraint   = CONSTRAINT LiftedRep  :: Type    -- constraintKind

         type TYPE         :: RuntimeRep -> Type  -- primitive; tYPEKind
         type Type         = TYPE LiftedRep   :: Type         -- liftedTypeKind
         type UnliftedType = TYPE UnliftedRep :: Type         -- unliftedTypeKind

         type LiftedRep    = BoxedRep Lifted   :: RuntimeRep  -- liftedRepTy
         type UnliftedRep  = BoxedRep Unlifted :: RuntimeRep  -- unliftedRepTy

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

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

{- Note [Naked FunTy]
~~~~~~~~~~~~~~~~~~~~~
GHC.Core.TyCo.Rep.mkFunTy has assertions about the consistency of the argument
flag and arg/res types.  But when constructing the kinds of tYPETyCon and
cONSTRAINTTyCon we don't want to make these checks because
     TYPE :: RuntimeRep -> Type
i.e. TYPE :: RuntimeRep -> TYPE LiftedRep

so the check will loop infinitely.  Hence the use of a naked FunTy
constructor in tTYPETyCon and cONSTRAINTTyCon.
-}


----------------------
-- type Constraint = CONSTRAINT LiftedRep
constraintKindTyCon :: TyCon
constraintKindTyCon :: TyCon
constraintKindTyCon
  = Name -> [TyConBinder] -> Type -> [Role] -> Type -> TyCon
buildSynTyCon Name
constraintKindTyConName [] Type
liftedTypeKind [] Type
rhs
  where
    rhs :: Type
rhs = TyCon -> [Type] -> Type
TyCoRep.TyConApp TyCon
cONSTRAINTTyCon [Type
liftedRepTy]

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

constraintKind :: Kind
constraintKind :: Type
constraintKind = TyCon -> Type
mkTyConTy TyCon
constraintKindTyCon

----------------------
-- type Type = TYPE LiftedRep
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]

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

liftedTypeKind, typeToTypeKind :: Type
liftedTypeKind :: Type
liftedTypeKind = TyCon -> Type
mkTyConTy TyCon
liftedTypeKindTyCon
typeToTypeKind :: Type
typeToTypeKind = Type
liftedTypeKind HasDebugCallStack => Type -> Type -> Type
Type -> Type -> Type
`mkVisFunTyMany` Type
liftedTypeKind

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

unliftedTypeKindTyConName :: Name
unliftedTypeKindTyConName :: Name
unliftedTypeKindTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"UnliftedType")
                                                Unique
unliftedTypeKindTyConKey TyCon
unliftedTypeKindTyCon

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


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

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

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 -> PromDataConInfo -> DataCon
pcSpecialDataCon Name
liftedDataConName
    [] TyCon
levityTyCon (Levity -> PromDataConInfo
Levity Levity
Lifted)
unliftedDataCon :: DataCon
unliftedDataCon = Name -> [Type] -> TyCon -> PromDataConInfo -> DataCon
pcSpecialDataCon Name
unliftedDataConName
    [] TyCon
levityTyCon (Levity -> PromDataConInfo
Levity Levity
Unlifted)

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 []
    -- Here we list all the data constructors
    -- of the RuntimeRep data type
    (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

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   = FastString -> Unique -> DataCon -> Name
mk_runtime_rep_dc_name ([Char] -> FastString
fsLit [Char]
"VecRep")   Unique
vecRepDataConKey   DataCon
vecRepDataCon
tupleRepDataConName :: Name
tupleRepDataConName = FastString -> Unique -> DataCon -> Name
mk_runtime_rep_dc_name ([Char] -> FastString
fsLit [Char]
"TupleRep") Unique
tupleRepDataConKey DataCon
tupleRepDataCon
sumRepDataConName :: Name
sumRepDataConName   = FastString -> Unique -> DataCon -> Name
mk_runtime_rep_dc_name ([Char] -> FastString
fsLit [Char]
"SumRep")   Unique
sumRepDataConKey   DataCon
sumRepDataCon
boxedRepDataConName :: Name
boxedRepDataConName = FastString -> Unique -> DataCon -> Name
mk_runtime_rep_dc_name ([Char] -> FastString
fsLit [Char]
"BoxedRep") Unique
boxedRepDataConKey DataCon
boxedRepDataCon

mk_runtime_rep_dc_name :: FastString -> Unique -> DataCon -> Name
mk_runtime_rep_dc_name :: FastString -> Unique -> DataCon -> Name
mk_runtime_rep_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

boxedRepDataCon :: DataCon
boxedRepDataCon :: DataCon
boxedRepDataCon = Name -> [Type] -> TyCon -> PromDataConInfo -> DataCon
pcSpecialDataCon Name
boxedRepDataConName
  [ Type
levityTy ] TyCon
runtimeRepTyCon (([Type] -> [PrimRep]) -> PromDataConInfo
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 Type -> Maybe TyCon
tyConAppTyCon_maybe Type
lev of
          Just TyCon
tc -> case TyCon -> PromDataConInfo
tyConPromDataConInfo TyCon
tc of
            Levity Levity
l -> [Maybe Levity -> PrimRep
BoxedRep (Levity -> Maybe Levity
forall a. a -> Maybe a
Just Levity
l)]
            PromDataConInfo
_        -> [Maybe Levity -> PrimRep
BoxedRep Maybe Levity
forall a. Maybe a
Nothing]
          Maybe TyCon
Nothing    -> [Maybe Levity -> PrimRep
BoxedRep Maybe Levity
forall a. Maybe a
Nothing]
    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

tupleRepDataCon :: DataCon
tupleRepDataCon :: DataCon
tupleRepDataCon = Name -> [Type] -> TyCon -> PromDataConInfo -> DataCon
pcSpecialDataCon Name
tupleRepDataConName [ Type -> Type
mkListTy Type
runtimeRepTy ]
                                   TyCon
runtimeRepTyCon (([Type] -> [PrimRep]) -> PromDataConInfo
RuntimeRep [Type] -> [PrimRep]
prim_rep_fun)
  where
    -- See Note [Getting from RuntimeRep to PrimRep] in GHC.Types.RepType
    prim_rep_fun :: [Type] -> [PrimRep]
prim_rep_fun [Type
rr_ty_list]
      = (Type -> [PrimRep]) -> [Type] -> [PrimRep]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (HasDebugCallStack => SDoc -> Type -> [PrimRep]
SDoc -> Type -> [PrimRep]
runtimeRepPrimRep SDoc
doc) [Type]
rr_tys
      where
        rr_tys :: [Type]
rr_tys = Type -> [Type]
extractPromotedList Type
rr_ty_list
        doc :: SDoc
doc    = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"tupleRepDataCon" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [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 -> PromDataConInfo -> DataCon
pcSpecialDataCon Name
sumRepDataConName [ Type -> Type
mkListTy Type
runtimeRepTy ]
                                 TyCon
runtimeRepTyCon (([Type] -> [PrimRep]) -> PromDataConInfo
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 (NonEmpty SlotTy -> [SlotTy]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([[PrimRep]] -> NonEmpty SlotTy
ubxSumRepType [[PrimRep]]
prim_repss))
      where
        rr_tys :: [Type]
rr_tys     = Type -> [Type]
extractPromotedList Type
rr_ty_list
        doc :: SDoc
doc        = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"sumRepDataCon" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Type] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type]
rr_tys
        prim_repss :: [[PrimRep]]
prim_repss = (Type -> [PrimRep]) -> [Type] -> [[PrimRep]]
forall a b. (a -> b) -> [a] -> [b]
map (HasDebugCallStack => SDoc -> Type -> [PrimRep]
SDoc -> Type -> [PrimRep]
runtimeRepPrimRep SDoc
doc) [Type]
rr_tys
    prim_rep_fun [Type]
args
      = [Char] -> SDoc -> [PrimRep]
forall a. HasCallStack => [Char] -> SDoc -> a
pprPanic [Char]
"sumRepDataCon" ([Type] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type]
args)

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

-- See Note [Wiring in RuntimeRep]
-- See Note [Getting from RuntimeRep to PrimRep] in GHC.Types.RepType
runtimeRepSimpleDataCons :: [DataCon]
runtimeRepSimpleDataCons :: [DataCon]
runtimeRepSimpleDataCons
  = (Unique -> (FastString, PrimRep) -> DataCon)
-> [Unique] -> [(FastString, PrimRep)] -> [DataCon]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Unique -> (FastString, PrimRep) -> DataCon
mk_runtime_rep_dc [Unique]
runtimeRepSimpleDataConKeys
            [ ([Char] -> FastString
fsLit [Char]
"IntRep",    PrimRep
IntRep)
            , ([Char] -> FastString
fsLit [Char]
"Int8Rep",   PrimRep
Int8Rep)
            , ([Char] -> FastString
fsLit [Char]
"Int16Rep",  PrimRep
Int16Rep)
            , ([Char] -> FastString
fsLit [Char]
"Int32Rep",  PrimRep
Int32Rep)
            , ([Char] -> FastString
fsLit [Char]
"Int64Rep",  PrimRep
Int64Rep)
            , ([Char] -> FastString
fsLit [Char]
"WordRep",   PrimRep
WordRep)
            , ([Char] -> FastString
fsLit [Char]
"Word8Rep",  PrimRep
Word8Rep)
            , ([Char] -> FastString
fsLit [Char]
"Word16Rep", PrimRep
Word16Rep)
            , ([Char] -> FastString
fsLit [Char]
"Word32Rep", PrimRep
Word32Rep)
            , ([Char] -> FastString
fsLit [Char]
"Word64Rep", PrimRep
Word64Rep)
            , ([Char] -> FastString
fsLit [Char]
"AddrRep",   PrimRep
AddrRep)
            , ([Char] -> FastString
fsLit [Char]
"FloatRep",  PrimRep
FloatRep)
            , ([Char] -> FastString
fsLit [Char]
"DoubleRep", PrimRep
DoubleRep) ]
  where
    mk_runtime_rep_dc :: Unique -> (FastString, PrimRep) -> DataCon
    mk_runtime_rep_dc :: Unique -> (FastString, PrimRep) -> DataCon
mk_runtime_rep_dc Unique
uniq (FastString
fs, PrimRep
primrep)
      = DataCon
data_con
      where
        data_con :: DataCon
data_con = Name -> [Type] -> TyCon -> PromDataConInfo -> DataCon
pcSpecialDataCon Name
dc_name [] TyCon
runtimeRepTyCon (([Type] -> [PrimRep]) -> PromDataConInfo
RuntimeRep (\[Type]
_ -> [PrimRep
primrep]))
        dc_name :: Name
dc_name  = FastString -> Unique -> DataCon -> Name
mk_runtime_rep_dc_name FastString
fs Unique
uniq DataCon
data_con

-- See Note [Wiring in RuntimeRep]
intRepDataConTy,
  int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy,
  wordRepDataConTy,
  word8RepDataConTy, word16RepDataConTy, word32RepDataConTy, word64RepDataConTy,
  addrRepDataConTy,
  floatRepDataConTy, doubleRepDataConTy :: RuntimeRepType
[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

----------------------
-- | @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 []]

zeroBitRepTyConName :: Name
zeroBitRepTyConName :: Name
zeroBitRepTyConName  = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"ZeroBitRep")
                                          Unique
zeroBitRepTyConKey  TyCon
zeroBitRepTyCon

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

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

zeroBitTypeTyConName :: Name
zeroBitTypeTyConName :: Name
zeroBitTypeTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"ZeroBitType")
                                          Unique
zeroBitTypeTyConKey TyCon
zeroBitTypeTyCon

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]

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

liftedRepTy :: RuntimeRepType
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]

unliftedRepTyConName :: Name
unliftedRepTyConName :: Name
unliftedRepTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"UnliftedRep")
                                          Unique
unliftedRepTyConKey TyCon
unliftedRepTyCon

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


{- *********************************************************************
*                                                                      *
         VecCount, VecElem
*                                                                      *
********************************************************************* -}

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

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

vecRepDataCon :: DataCon
vecRepDataCon :: DataCon
vecRepDataCon = Name -> [Type] -> TyCon -> PromDataConInfo -> DataCon
pcSpecialDataCon Name
vecRepDataConName [ TyCon -> Type
mkTyConTy TyCon
vecCountTyCon
                                                   , TyCon -> Type
mkTyConTy TyCon
vecElemTyCon ]
                                 TyCon
runtimeRepTyCon
                                 (([Type] -> [PrimRep]) -> PromDataConInfo
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 -> PromDataConInfo
tyConPromDataConInfo (HasDebugCallStack => Type -> TyCon
Type -> TyCon
tyConAppTyCon Type
count)
      , VecElem  PrimElemRep
e <- TyCon -> PromDataConInfo
tyConPromDataConInfo (HasDebugCallStack => 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

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 -> Unique -> DataCon) -> [Int] -> [Unique] -> [DataCon]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Unique -> DataCon
mk_vec_count_dc [Int
1..Int
6] [Unique]
vecCountDataConKeys
  where
    mk_vec_count_dc :: Int -> Unique -> DataCon
mk_vec_count_dc Int
logN Unique
key = DataCon
con
      where
        n :: Int
n = Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
logN :: Int)
        name :: Name
name = FastString -> Unique -> DataCon -> Name
mk_runtime_rep_dc_name ([Char] -> FastString
fsLit ([Char]
"Vec" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n)) Unique
key DataCon
con
        con :: DataCon
con = Name -> [Type] -> TyCon -> PromDataConInfo -> DataCon
pcSpecialDataCon Name
name [] TyCon
vecCountTyCon (Int -> PromDataConInfo
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 = (FastString -> PrimElemRep -> Unique -> DataCon)
-> [FastString] -> [PrimElemRep] -> [Unique] -> [DataCon]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 FastString -> PrimElemRep -> Unique -> DataCon
mk_vec_elem_dc
  [ [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" ]
  [ PrimElemRep
Int8ElemRep, PrimElemRep
Int16ElemRep, PrimElemRep
Int32ElemRep, PrimElemRep
Int64ElemRep
  , PrimElemRep
Word8ElemRep, PrimElemRep
Word16ElemRep, PrimElemRep
Word32ElemRep, PrimElemRep
Word64ElemRep
  , PrimElemRep
FloatElemRep, PrimElemRep
DoubleElemRep ]
    [Unique]
vecElemDataConKeys
  where
    mk_vec_elem_dc :: FastString -> PrimElemRep -> Unique -> DataCon
mk_vec_elem_dc FastString
nameFs PrimElemRep
elemRep Unique
key = DataCon
con
      where
        name :: Name
name = FastString -> Unique -> DataCon -> Name
mk_runtime_rep_dc_name FastString
nameFs Unique
key DataCon
con
        con :: DataCon
con = Name -> [Type] -> TyCon -> PromDataConInfo -> DataCon
pcSpecialDataCon Name
name [] TyCon
vecElemTyCon (PrimElemRep -> PromDataConInfo
VecElem PrimElemRep
elemRep)

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

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

{- *********************************************************************
*                                                                      *
              Boxing data constructors
*                                                                      *
********************************************************************* -}

{- Note [Boxing constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In ghc-prim:GHC.Types we have a family of data types, one for each RuntimeRep
that "box" unlifted values into a (boxed, lifted) value of kind Type. For example

  type Int8Box :: TYPE Int8Rep -> Type
  data Int8Box (a :: TYPE Int8Rep) = MkInt8Box a
    -- MkInt8Box :: forall (a :: TYPE Int8Rep). a -> Int8Box a

Then we can package an `Int8#` into an `Int8Box` with `MkInt8Box`.  We can also
package up a (lifted) Constraint as a value of kind Type.

There are a fixed number of RuntimeReps, so we only need a fixed number
of boxing types.  (For TupleRep we need to box recursively; not yet done,
see #22336.)

This is used:

* In desugaring, when we need to package up a bunch of values into a tuple,
  for example when desugaring arrows.  See Note [Big tuples] in GHC.Core.Make.

* In let-floating when we want to float an unlifted sub-expression.
  See Note [Floating MFEs of unlifted type] in GHC.Core.Opt.SetLevels

In this module we make wired-in data type declarations for all of
these boxing functions.  The goal is to define boxingDataCon_maybe.

Wrinkles
(W1) The runtime system has special treatment (e.g. commoning up during GC)
     for Int and Char values. See  Note [CHARLIKE and INTLIKE closures] and
     Note [Precomputed static closures] in the RTS.

     So we treat Int# and Char# specially, in specialBoxingDataCon_maybe
-}

data BoxingInfo b
  = BI_NoBoxNeeded   -- The type has kind Type, so there is nothing to do

  | BI_NoBoxAvailable  -- The type does not have kind Type, but sadly we
                       -- don't have a boxing data constructor either

  | BI_Box             -- The type does not have kind Type, and we do have a
                       -- boxing data constructor; here it is
      { forall b. BoxingInfo b -> DataCon
bi_data_con   :: DataCon
      , forall b. BoxingInfo b -> Expr b
bi_inst_con   :: Expr b
      , forall b. BoxingInfo b -> Type
bi_boxed_type :: Type }
    -- e.g. BI_Box { bi_data_con = I#, bi_inst_con = I#, bi_boxed_type = Int }
    --        recall: data Int = I# Int#
    --
    --      BI_Box { bi_data_con = MkInt8Box, bi_inst_con = MkInt8Box @ty
    --             , bi_boxed_type = Int8Box ty }
    --        recall: data Int8Box (a :: TYPE Int8Rep) = MkIntBox a

boxingDataCon :: Type -> BoxingInfo b
-- ^ Given a type 'ty', if 'ty' is not of kind Type, return a data constructor that
--   will box it, and the type of the boxed thing, which /does/ now have kind Type.
-- See Note [Boxing constructors]
boxingDataCon :: forall b. Type -> BoxingInfo b
boxingDataCon Type
ty
  | Type -> Bool
tcIsLiftedTypeKind Type
kind
  = BoxingInfo b
forall b. BoxingInfo b
BI_NoBoxNeeded    -- Fast path for Type

  | Just DataCon
box_con <- Type -> Maybe DataCon
specialBoxingDataCon_maybe Type
ty
  = BI_Box { bi_data_con :: DataCon
bi_data_con = DataCon
box_con, bi_inst_con :: Expr b
bi_inst_con = DataCon -> [Expr b] -> Expr b
forall b. DataCon -> [Arg b] -> Arg b
mkConApp DataCon
box_con []
           , bi_boxed_type :: Type
bi_boxed_type = TyCon -> Type
tyConNullaryTy (DataCon -> TyCon
dataConTyCon DataCon
box_con) }

  | Just DataCon
box_con <- TypeMap DataCon -> Type -> Maybe DataCon
forall a. TypeMap a -> Type -> Maybe a
lookupTypeMap TypeMap DataCon
boxingDataConMap Type
kind
  = BI_Box { bi_data_con :: DataCon
bi_data_con = DataCon
box_con, bi_inst_con :: Expr b
bi_inst_con = DataCon -> [Expr b] -> Expr b
forall b. DataCon -> [Arg b] -> Arg b
mkConApp DataCon
box_con [Type -> Expr b
forall b. Type -> Expr b
Type Type
ty]
           , bi_boxed_type :: Type
bi_boxed_type = TyCon -> [Type] -> Type
mkTyConApp (DataCon -> TyCon
dataConTyCon DataCon
box_con) [Type
ty] }

  | Bool
otherwise
  = BoxingInfo b
forall b. BoxingInfo b
BI_NoBoxAvailable

  where
    kind :: Type
kind = HasDebugCallStack => Type -> Type
Type -> Type
typeKind Type
ty

specialBoxingDataCon_maybe :: Type -> Maybe DataCon
-- ^ See Note [Boxing constructors] wrinkle (W1)
specialBoxingDataCon_maybe :: Type -> Maybe DataCon
specialBoxingDataCon_maybe Type
ty
  = case HasDebugCallStack => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
ty of
      Just (TyCon
tc, [Type]
_) | TyCon
tc TyCon -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
intPrimTyConKey  -> DataCon -> Maybe DataCon
forall a. a -> Maybe a
Just DataCon
intDataCon
                   | TyCon
tc TyCon -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
charPrimTyConKey -> DataCon -> Maybe DataCon
forall a. a -> Maybe a
Just DataCon
charDataCon
      Maybe (TyCon, [Type])
_ -> Maybe DataCon
forall a. Maybe a
Nothing

boxingDataConMap :: TypeMap DataCon
-- See Note [Boxing constructors]
boxingDataConMap :: TypeMap DataCon
boxingDataConMap = (TypeMap DataCon -> (Type, DataCon) -> TypeMap DataCon)
-> TypeMap DataCon -> [(Type, DataCon)] -> TypeMap DataCon
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl TypeMap DataCon -> (Type, DataCon) -> TypeMap DataCon
forall {a}. TypeMap a -> (Type, a) -> TypeMap a
add TypeMap DataCon
forall a. TypeMap a
emptyTypeMap [(Type, DataCon)]
boxingDataCons
  where
    add :: TypeMap a -> (Type, a) -> TypeMap a
add TypeMap a
bdcm (Type
kind, a
boxing_con) = TypeMap a -> Type -> a -> TypeMap a
forall a. TypeMap a -> Type -> a -> TypeMap a
extendTypeMap TypeMap a
bdcm Type
kind a
boxing_con

boxingDataCons :: [(Kind, DataCon)]
-- The Kind is the kind of types for which the DataCon is the right boxing
boxingDataCons :: [(Type, DataCon)]
boxingDataCons = (Unique -> (Type, FastString, FastString) -> (Type, DataCon))
-> [Unique]
-> [(Type, FastString, FastString)]
-> [(Type, DataCon)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Unique -> (Type, FastString, FastString) -> (Type, DataCon)
mkBoxingDataCon
  ((Int -> Unique) -> [Int] -> [Unique]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Unique
mkBoxingTyConUnique [Int
1..])
  [ (Type -> Type
mkTYPEapp Type
wordRepDataConTy, [Char] -> FastString
fsLit [Char]
"WordBox", [Char] -> FastString
fsLit [Char]
"MkWordBox")
  , (Type -> Type
mkTYPEapp Type
intRepDataConTy,  [Char] -> FastString
fsLit [Char]
"IntBox",  [Char] -> FastString
fsLit [Char]
"MkIntBox")

  , (Type -> Type
mkTYPEapp Type
floatRepDataConTy,  [Char] -> FastString
fsLit [Char]
"FloatBox",  [Char] -> FastString
fsLit [Char]
"MkFloatBox")
  , (Type -> Type
mkTYPEapp Type
doubleRepDataConTy,  [Char] -> FastString
fsLit [Char]
"DoubleBox",  [Char] -> FastString
fsLit [Char]
"MkDoubleBox")

  , (Type -> Type
mkTYPEapp Type
int8RepDataConTy,  [Char] -> FastString
fsLit [Char]
"Int8Box",  [Char] -> FastString
fsLit [Char]
"MkInt8Box")
  , (Type -> Type
mkTYPEapp Type
int16RepDataConTy, [Char] -> FastString
fsLit [Char]
"Int16Box", [Char] -> FastString
fsLit [Char]
"MkInt16Box")
  , (Type -> Type
mkTYPEapp Type
int32RepDataConTy, [Char] -> FastString
fsLit [Char]
"Int32Box", [Char] -> FastString
fsLit [Char]
"MkInt32Box")
  , (Type -> Type
mkTYPEapp Type
int64RepDataConTy, [Char] -> FastString
fsLit [Char]
"Int64Box", [Char] -> FastString
fsLit [Char]
"MkInt64Box")

  , (Type -> Type
mkTYPEapp Type
word8RepDataConTy,  [Char] -> FastString
fsLit [Char]
"Word8Box",   [Char] -> FastString
fsLit [Char]
"MkWord8Box")
  , (Type -> Type
mkTYPEapp Type
word16RepDataConTy, [Char] -> FastString
fsLit [Char]
"Word16Box",  [Char] -> FastString
fsLit [Char]
"MkWord16Box")
  , (Type -> Type
mkTYPEapp Type
word32RepDataConTy, [Char] -> FastString
fsLit [Char]
"Word32Box",  [Char] -> FastString
fsLit [Char]
"MkWord32Box")
  , (Type -> Type
mkTYPEapp Type
word64RepDataConTy, [Char] -> FastString
fsLit [Char]
"Word64Box",  [Char] -> FastString
fsLit [Char]
"MkWord64Box")

  , (Type
unliftedTypeKind, [Char] -> FastString
fsLit [Char]
"LiftBox", [Char] -> FastString
fsLit [Char]
"MkLiftBox")
  , (Type
constraintKind,   [Char] -> FastString
fsLit [Char]
"DictBox", [Char] -> FastString
fsLit [Char]
"MkDictBox") ]

mkBoxingDataCon :: Unique -> (Kind, FastString, FastString) -> (Kind, DataCon)
mkBoxingDataCon :: Unique -> (Type, FastString, FastString) -> (Type, DataCon)
mkBoxingDataCon Unique
uniq_tc (Type
kind, FastString
fs_tc, FastString
fs_dc)
  = (Type
kind, DataCon
dc)
  where
    uniq_dc :: Unique
uniq_dc = Unique -> Unique
boxingDataConUnique Unique
uniq_tc

    (TyVar
tv:[TyVar]
_) = [Type] -> [TyVar]
mkTemplateTyVars (Type -> [Type]
forall a. a -> [a]
repeat Type
kind)
    tc :: TyCon
tc = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
tc_name Maybe CType
forall a. Maybe a
Nothing [TyVar
tv] [DataCon
dc]
    tc_name :: Name
tc_name = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES FastString
fs_tc Unique
uniq_tc TyCon
tc

    dc :: DataCon
dc | Type -> Bool
isConstraintKind Type
kind
       = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataConConstraint Name
dc_name [TyVar
tv] [TyVar -> Type
mkTyVarTy TyVar
tv] TyCon
tc
       | Bool
otherwise
       = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon           Name
dc_name [TyVar
tv] [TyVar -> Type
mkTyVarTy TyVar
tv] TyCon
tc
    dc_name :: Name
dc_name = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES FastString
fs_dc Unique
uniq_dc DataCon
dc

{-
************************************************************************
*                                                                      *
              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]
-> ConcreteTyVars
-> [TyVar]
-> [Type]
-> [Scaled Type]
-> TyCon
-> DataCon
pcDataConWithFixity Bool
True {- Declared infix -}
               Name
consDataConName
               [TyVar]
alpha_tyvar [] ConcreteTyVars
noConcreteTyVars [TyVar]
alpha_tyvar []
               ((Type -> Scaled Type) -> [Type] -> [Scaled Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Scaled Type
forall a. a -> Scaled a
linear [Type
alphaTy, TyCon -> [Type] -> Type
mkTyConApp TyCon
listTyCon [Type]
alpha_ty])
               TyCon
listTyCon

-- Interesting: polymorphic recursion would help here.
-- We can't use (mkListTy alphaTy) in the defn of consDataCon, else mkListTy
-- gets the over-specific type (Type -> Type)

-- Wired-in type Maybe

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

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

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

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]) <- HasDebugCallStack => 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
_])   <- HasDebugCallStack => 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 HasDebugCallStack => Type -> Type
Type -> Type
getRuntimeRep [Type]
tys [Type] -> [Type] -> [Type]
forall a. [a] -> [a] -> [a]
++ [Type]
tys)

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

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

-- Make a constraint tuple, flattening a 1-tuple as usual
-- If we get a constraint tuple that is bigger than the pre-built
--   ones (in ghc-prim:GHC.Tuple), then just make one up anyway; it won't
--   have an info table in the RTS, so we can't use it at runtime.  But
--   this is used only in filling in extra-constraint wildcards, so it
--   never is used at runtime anyway
--   See GHC.Tc.Gen.HsType Note [Extra-constraint holes in partial type signatures]
mkConstraintTupleTy :: [Type] -> Type
mkConstraintTupleTy :: [Type] -> Type
mkConstraintTupleTy [Type
ty] = Type
ty
mkConstraintTupleTy [Type]
tys = TyCon -> [Type] -> Type
mkTyConApp (Int -> TyCon
cTupleTyCon ([Type] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
tys)) [Type]
tys


{- *********************************************************************
*                                                                      *
            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 HasDebugCallStack => Type -> Type
Type -> Type
getRuntimeRep [Type]
tys [Type] -> [Type] -> [Type]
forall a. [a] -> [a] -> [a]
++ [Type]
tys)

-- Promoted Booleans

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

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

-- Promoted Ordering

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

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

-- | Make a *promoted* list.
mkPromotedListTy :: Kind   -- ^ of the elements of the list
                 -> [Type] -- ^ elements
                 -> Type
mkPromotedListTy :: Type -> [Type] -> Type
mkPromotedListTy Type
k [Type]
tys
  = (Type -> Type -> Type) -> Type -> [Type] -> Type
forall 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]) <- HasDebugCallStack => 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]) <- HasDebugCallStack => 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_INTERNAL_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_INTERNAL_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_INTERNAL_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_INTERNAL_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_INTERNAL_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_INTERNAL_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_INTERNAL_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

{-
************************************************************************
*                                                                      *
   Semi-builtin names
*                                                                      *
************************************************************************

Note [pretendNameIsInScope]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
In general, we filter out instances that mention types whose names are
not in scope. However, in the situations listed below, we make an exception
for some commonly used names, such as Data.Kind.Type, which may not actually
be in scope but should be treated as though they were in scope.
This includes built-in names, as well as a few extra names such as
'Type', 'TYPE', 'BoxedRep', etc.

Situations in which we apply this special logic:

  - GHCi's :info command, see GHC.Runtime.Eval.getInfo.
    This fixes #1581.

  - When reporting instance overlap errors. Not doing so could mean
    that we would omit instances for typeclasses like

      type Cls :: k -> Constraint
      class Cls a

    because BoxedRep/Lifted were not in scope.
    See GHC.Tc.Errors.potentialInstancesErrMsg.
    This fixes one of the issues reported in #20465.
-}

-- | Should this name be considered in-scope, even though it technically isn't?
--
-- This ensures that we don't filter out information because, e.g.,
-- Data.Kind.Type isn't imported.
--
-- See Note [pretendNameIsInScope].
pretendNameIsInScope :: Name -> Bool
pretendNameIsInScope :: Name -> Bool
pretendNameIsInScope Name
n
  = Name -> Bool
isBuiltInSyntax Name
n
  Bool -> Bool -> Bool
|| Name -> Bool
isTupleTyConName Name
n
  Bool -> Bool -> Bool
|| Name -> Bool
isSumTyConName Name
n
  Bool -> Bool -> Bool
|| Name -> Bool
isCTupleTyConName Name
n
  Bool -> Bool -> Bool
|| (Unique -> Bool) -> [Unique] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Name
n Name -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey`)
    [ Unique
liftedTypeKindTyConKey, Unique
unliftedTypeKindTyConKey
    , Unique
liftedDataConKey, Unique
unliftedDataConKey
    , Unique
tYPETyConKey
    , Unique
cONSTRAINTTyConKey
    , Unique
runtimeRepTyConKey, Unique
boxedRepDataConKey
    , Unique
eqTyConKey
    , Unique
listTyConKey
    , Unique
oneDataConKey
    , Unique
manyDataConKey
    , Unique
fUNTyConKey, Unique
unrestrictedFunTyConKey ]