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

\section[TysWiredIn]{Wired-in knowledge about {\em non-primitive} types}
-}

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

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

        mkWiredInIdName,    -- used in MkId

        -- * All wired in things
        wiredInTyCons, isBuiltInOcc_maybe,

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

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

        -- * Boxing primitive types
        boxingDataCon_maybe,

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

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

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

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

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

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

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

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

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

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

        -- * Any
        anyTyCon, anyTy, anyTypeOfKind,

        -- * Recovery TyCon
        makeRecoveryTyCon,

        -- * Sums
        mkSumTy, sumTyCon, sumDataCon,

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

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

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

        runtimeRepTy, liftedRepTy, liftedRepDataCon, liftedRepDataConTyCon,

        vecRepDataConTyCon, tupleRepDataConTyCon, sumRepDataConTyCon,

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

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

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

    ) where

#include "HsVersions.h"

import GhcPrelude

import {-# SOURCE #-} MkId( mkDataConWorkId, mkDictSelId )

-- friends:
import PrelNames
import TysPrim
import {-# SOURCE #-} KnownUniques

-- others:
import CoAxiom
import Id
import Constants        ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE )
import Module           ( Module )
import Type
import RepType
import DataCon
import {-# SOURCE #-} ConLike
import TyCon
import Class            ( Class, mkClass )
import RdrName
import Name
import NameEnv          ( NameEnv, mkNameEnv, lookupNameEnv, lookupNameEnv_NF )
import NameSet          ( NameSet, mkNameSet, elemNameSet )
import BasicTypes       ( Arity, Boxity(..), TupleSort(..), ConTagZ,
                          SourceText(..) )
import ForeignCall
import SrcLoc           ( noSrcSpan )
import Unique
import Data.Array
import FastString
import Outputable
import Util
import BooleanFormula   ( mkAnd )

import qualified Data.ByteString.Char8 as BS

import Data.List        ( elemIndex )

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

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

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

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

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

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

-- This list is used only to define PrelInfo.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, Any and implicit
-- parameter TyCons (see Note [Built-in syntax and the OrigNameCache]).
--
-- See also Note [Known-key names]
wiredInTyCons :: [TyCon]

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

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 (String -> FastString
fsLit String
"~")   Unique
eqTyConKey   TyCon
eqTyCon
eqDataConName :: Name
eqDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES (String -> FastString
fsLit String
"Eq#") Unique
eqDataConKey DataCon
eqDataCon
eqSCSelIdName :: Name
eqSCSelIdName = Module -> FastString -> Unique -> TyVar -> Name
mkWiredInIdName Module
gHC_TYPES (String -> FastString
fsLit String
"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 (String -> FastString
fsLit String
"~~")   Unique
heqTyConKey      TyCon
heqTyCon
heqDataConName :: Name
heqDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES (String -> FastString
fsLit String
"HEq#") Unique
heqDataConKey DataCon
heqDataCon
heqSCSelIdName :: Name
heqSCSelIdName = Module -> FastString -> Unique -> TyVar -> Name
mkWiredInIdName Module
gHC_TYPES (String -> FastString
fsLit String
"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 (String -> FastString
fsLit String
"Coercible")  Unique
coercibleTyConKey   TyCon
coercibleTyCon
coercibleDataConName :: Name
coercibleDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES (String -> FastString
fsLit String
"MkCoercible") Unique
coercibleDataConKey DataCon
coercibleDataCon
coercibleSCSelIdName :: Name
coercibleSCSelIdName = Module -> FastString -> Unique -> TyVar -> Name
mkWiredInIdName Module
gHC_TYPES (String -> FastString
fsLit String
"coercible_sel") Unique
coercibleSCSelIdKey TyVar
coercibleSCSelId

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

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

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

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

wordTyConName, wordDataConName, word8TyConName, word8DataConName :: Name
wordTyConName :: Name
wordTyConName      = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName   BuiltInSyntax
UserSyntax Module
gHC_TYPES (String -> FastString
fsLit String
"Word")   Unique
wordTyConKey     TyCon
wordTyCon
wordDataConName :: Name
wordDataConName    = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES (String -> FastString
fsLit String
"W#")     Unique
wordDataConKey   DataCon
wordDataCon
word8TyConName :: Name
word8TyConName     = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName   BuiltInSyntax
UserSyntax Module
gHC_WORD  (String -> FastString
fsLit String
"Word8")  Unique
word8TyConKey    TyCon
word8TyCon
word8DataConName :: Name
word8DataConName   = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_WORD  (String -> FastString
fsLit String
"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 (String -> FastString
fsLit String
"Float")  Unique
floatTyConKey    TyCon
floatTyCon
floatDataConName :: Name
floatDataConName   = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES (String -> FastString
fsLit String
"F#")     Unique
floatDataConKey  DataCon
floatDataCon
doubleTyConName :: Name
doubleTyConName    = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName   BuiltInSyntax
UserSyntax Module
gHC_TYPES (String -> FastString
fsLit String
"Double") Unique
doubleTyConKey   TyCon
doubleTyCon
doubleDataConName :: Name
doubleDataConName  = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES (String -> FastString
fsLit String
"D#")     Unique
doubleDataConKey DataCon
doubleDataCon

-- Any

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

    type family Any :: k where { }

It has these properties:

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

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

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

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

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

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

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

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

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

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

and the list datacon for the empty list has type

  [] :: forall a. [a]

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

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

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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

boolTyCon_RDR, false_RDR, true_RDR, intTyCon_RDR, charTyCon_RDR,
    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
intDataCon_RDR :: RdrName
intDataCon_RDR  = Name -> RdrName
nameRdrName Name
intDataConName
listTyCon_RDR :: RdrName
listTyCon_RDR   = Name -> RdrName
nameRdrName Name
listTyConName
consDataCon_RDR :: RdrName
consDataCon_RDR = Name -> RdrName
nameRdrName Name
consDataConName

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

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

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

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

pcDataConWithFixity' :: Bool -> Name -> Unique -> RuntimeRepInfo
                     -> [TyVar] -> [TyCoVar] -> [TyCoVar]
                     -> [Type] -> TyCon -> DataCon
-- The Name should be in the DataName name space; it's the name
-- of the DataCon itself.

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

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

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

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

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

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

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

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

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

constraintKindTyCon :: TyCon
constraintKindTyCon :: TyCon
constraintKindTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
constraintKindTyConName Maybe CType
forall a. Maybe a
Nothing [] []

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

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

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

* All three families are AlgTyCons, whose AlgTyConRhs is TupleTyCon

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

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

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

* In quite a lot of places things are restrcted 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
  (IfaceEnv.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 KnownUniques. See Note [Symbol table representation of names] for details.

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

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

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

There is no way to write a boxed one-tuple in Haskell, but it can be
created in Template Haskell or in, e.g., `deriving` code. There is
nothing special about one-tuples in Core; in particular, they have no
custom pretty-printing, just using `Unit`.

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

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

-}

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

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

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

      -- boxed 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 -> ConTag -> Name
tup_name Boxity
Boxed ConTag
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 -> ConTag -> Name
tup_name Boxity
Boxed (ConTag
1ConTag -> ConTag -> ConTag
forall a. Num a => a -> a -> a
+ByteString -> ConTag
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 -> ConTag -> Name
tup_name Boxity
Unboxed ConTag
0
      ByteString
"Unit#" -> Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ Boxity -> ConTag -> Name
tup_name Boxity
Unboxed ConTag
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 -> ConTag -> Name
tup_name Boxity
Unboxed (ConTag
1ConTag -> ConTag -> ConTag
forall a. Num a => a -> a -> a
+ByteString -> ConTag
BS.length ByteString
commas)

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

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

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

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

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

mkCTupleOcc :: NameSpace -> Arity -> OccName
mkCTupleOcc :: NameSpace -> ConTag -> OccName
mkCTupleOcc NameSpace
ns ConTag
ar = NameSpace -> String -> OccName
mkOccName NameSpace
ns (ConTag -> String
mkConstraintTupleStr ConTag
ar)

mkTupleStr :: Boxity -> Arity -> String
mkTupleStr :: Boxity -> ConTag -> String
mkTupleStr Boxity
Boxed   = ConTag -> String
mkBoxedTupleStr
mkTupleStr Boxity
Unboxed = ConTag -> String
mkUnboxedTupleStr

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

-- See Note [The equality types story] in TysPrim
-- ((~~) :: 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
pcDataCon 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
pcDataCon 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
pcDataCon 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]
-> [FunDep TyVar]
-> [Type]
-> [TyVar]
-> [ClassATItem]
-> [ClassOpItem]
-> ClassMinimalDef
-> TyCon
-> Class
mkClass (TyCon -> Name
tyConName TyCon
tycon) (TyCon -> [TyVar]
tyConTyVars TyCon
tycon) [] [Type
sc_pred] [TyVar
sc_sel_id]
            [] [] ([LBooleanFormula Name] -> ClassMinimalDef
forall a. Eq a => [LBooleanFormula a] -> BooleanFormula a
mkAnd []) TyCon
tycon



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

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

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

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

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

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

tupleRepDataCon :: DataCon
tupleRepDataCon :: DataCon
tupleRepDataCon = Name -> [Type] -> TyCon -> RuntimeRepInfo -> DataCon
pcSpecialDataCon Name
tupleRepDataConName [ Type -> Type
mkListTy Type
runtimeRepTy ]
                                   TyCon
runtimeRepTyCon (([Type] -> [PrimRep]) -> RuntimeRepInfo
RuntimeRep [Type] -> [PrimRep]
prim_rep_fun)
  where
    -- See Note [Getting from RuntimeRep to PrimRep] in 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    = String -> SDoc
text String
"tupleRepDataCon" SDoc -> SDoc -> SDoc
<+> [Type] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type]
rr_tys
    prim_rep_fun [Type]
args
      = String -> SDoc -> [PrimRep]
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tupleRepDataCon" ([Type] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type]
args)

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

sumRepDataCon :: DataCon
sumRepDataCon :: DataCon
sumRepDataCon = Name -> [Type] -> TyCon -> RuntimeRepInfo -> DataCon
pcSpecialDataCon Name
sumRepDataConName [ Type -> Type
mkListTy Type
runtimeRepTy ]
                                 TyCon
runtimeRepTyCon (([Type] -> [PrimRep]) -> RuntimeRepInfo
RuntimeRep [Type] -> [PrimRep]
prim_rep_fun)
  where
    -- See Note [Getting from RuntimeRep to PrimRep] in RepType
    prim_rep_fun :: [Type] -> [PrimRep]
prim_rep_fun [Type
rr_ty_list]
      = (SlotTy -> PrimRep) -> [SlotTy] -> [PrimRep]
forall a b. (a -> b) -> [a] -> [b]
map SlotTy -> PrimRep
slotPrimRep ([[PrimRep]] -> [SlotTy]
ubxSumRepType [[PrimRep]]
prim_repss)
      where
        rr_tys :: [Type]
rr_tys     = Type -> [Type]
extractPromotedList Type
rr_ty_list
        doc :: SDoc
doc        = String -> SDoc
text String
"sumRepDataCon" SDoc -> SDoc -> SDoc
<+> [Type] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type]
rr_tys
        prim_repss :: [[PrimRep]]
prim_repss = (Type -> [PrimRep]) -> [Type] -> [[PrimRep]]
forall a b. (a -> b) -> [a] -> [b]
map (HasDebugCallStack => SDoc -> Type -> [PrimRep]
SDoc -> Type -> [PrimRep]
runtimeRepPrimRep SDoc
doc) [Type]
rr_tys
    prim_rep_fun [Type]
args
      = String -> SDoc -> [PrimRep]
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"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 RepType
runtimeRepSimpleDataCons :: [DataCon]
liftedRepDataCon :: DataCon
runtimeRepSimpleDataCons :: [DataCon]
runtimeRepSimpleDataCons@(DataCon
liftedRepDataCon : [DataCon]
_)
  = (PrimRep -> Name -> DataCon) -> [PrimRep] -> [Name] -> [DataCon]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWithLazy PrimRep -> Name -> DataCon
mk_runtime_rep_dc
    [ PrimRep
LiftedRep, PrimRep
UnliftedRep
    , PrimRep
IntRep
    , PrimRep
Int8Rep, PrimRep
Int16Rep, PrimRep
Int32Rep, PrimRep
Int64Rep
    , PrimRep
WordRep
    , PrimRep
Word8Rep, PrimRep
Word16Rep, PrimRep
Word32Rep, PrimRep
Word64Rep
    , PrimRep
AddrRep
    , PrimRep
FloatRep, PrimRep
DoubleRep
    ]
    [Name]
runtimeRepSimpleDataConNames
  where
    mk_runtime_rep_dc :: PrimRep -> Name -> DataCon
mk_runtime_rep_dc PrimRep
primrep Name
name
      = Name -> [Type] -> TyCon -> RuntimeRepInfo -> DataCon
pcSpecialDataCon Name
name [] TyCon
runtimeRepTyCon (([Type] -> [PrimRep]) -> RuntimeRepInfo
RuntimeRep (\[Type]
_ -> [PrimRep
primrep]))

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

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

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

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

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

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

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

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

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

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

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

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

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


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

charTyCon :: TyCon
charTyCon :: TyCon
charTyCon   = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
charTyConName
                   (CType -> Maybe CType
forall a. a -> Maybe a
Just (SourceText -> Maybe Header -> (SourceText, FastString) -> CType
CType SourceText
NoSourceText Maybe Header
forall a. Maybe a
Nothing
                                  (SourceText
NoSourceText,String -> FastString
fsLit String
"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 = Type -> Type
mkListTy Type
charTy -- convenience only

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,String -> FastString
fsLit String
"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, String -> FastString
fsLit String
"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, String -> FastString
fsLit String
"HsWord8"))) []
                     [DataCon
word8DataCon]
word8DataCon :: DataCon
word8DataCon :: DataCon
word8DataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
word8DataConName [] [Type
wordPrimTy] TyCon
word8TyCon

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

floatTyCon :: TyCon
floatTyCon :: TyCon
floatTyCon   = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
floatTyConName
                      (CType -> Maybe CType
forall a. a -> Maybe a
Just (SourceText -> Maybe Header -> (SourceText, FastString) -> CType
CType SourceText
NoSourceText Maybe Header
forall a. Maybe a
Nothing
                             (SourceText
NoSourceText, String -> FastString
fsLit String
"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,String -> FastString
fsLit String
"HsDouble"))) []
                      [DataCon
doubleDataCon]

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

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

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

{\em BEGIN IDLE SPECULATION BY SIMON}

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

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

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

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

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

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

{\em END IDLE SPECULATION BY SIMON}
-}

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

boolTyCon :: TyCon
boolTyCon :: TyCon
boolTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
boolTyConName
                    (CType -> Maybe CType
forall a. a -> Maybe a
Just (SourceText -> Maybe Header -> (SourceText, FastString) -> CType
CType SourceText
NoSourceText Maybe Header
forall a. Maybe a
Nothing
                           (SourceText
NoSourceText, String -> FastString
fsLit String
"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
-> [TyVar]
-> [Role]
-> Maybe CType
-> [Type]
-> AlgTyConRhs
-> Bool
-> AlgTyConFlav
-> TyCon
buildAlgTyCon Name
listTyConName [TyVar]
alpha_tyvar [Role
Representational]
                Maybe CType
forall a. Maybe a
Nothing []
                ([DataCon] -> AlgTyConRhs
mkDataTyConRhs [DataCon
nilDataCon, DataCon
consDataCon])
                Bool
False
                (Name -> AlgTyConFlav
VanillaAlgTyCon (Name -> AlgTyConFlav) -> Name -> AlgTyConFlav
forall a b. (a -> b) -> a -> b
$ Name -> Name
mkPrelTyConRepName Name
listTyConName)

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

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

-- Wired-in type Maybe

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

-- Promoted Booleans

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

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

-- Promoted Ordering

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

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

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

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

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

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

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