{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module GHC.Builtin.Types (
mkWiredInTyConName,
mkWiredInIdName,
wiredInTyCons, isBuiltInOcc_maybe, isPunOcc_maybe,
boolTy, boolTyCon, boolTyCon_RDR, boolTyConName,
trueDataCon, trueDataConId, true_RDR,
falseDataCon, falseDataConId, false_RDR,
promotedFalseDataCon, promotedTrueDataCon,
orderingTyCon,
ordLTDataCon, ordLTDataConId,
ordEQDataCon, ordEQDataConId,
ordGTDataCon, ordGTDataConId,
promotedLTDataCon, promotedEQDataCon, promotedGTDataCon,
boxingDataCon, BoxingInfo(..),
charTyCon, charDataCon, charTyCon_RDR,
charTy, stringTy, charTyConName, stringTyCon_RDR,
doubleTyCon, doubleDataCon, doubleTy, doubleTyConName,
floatTyCon, floatDataCon, floatTy, floatTyConName,
intTyCon, intDataCon, intTyCon_RDR, intDataCon_RDR, intTyConName,
intTy,
wordTyCon, wordDataCon, wordTyConName, wordTy,
word8TyCon, word8DataCon, word8Ty,
listTyCon, listTyCon_RDR, listTyConName, listTyConKey,
nilDataCon, nilDataConName, nilDataConKey,
consDataCon_RDR, consDataCon, consDataConName,
promotedNilDataCon, promotedConsDataCon,
mkListTy, mkPromotedListTy,
maybeTyCon, maybeTyConName,
nothingDataCon, nothingDataConName, promotedNothingDataCon,
justDataCon, justDataConName, promotedJustDataCon,
mkPromotedMaybeTy, mkMaybeTy, isPromotedMaybeTy,
mkTupleTy, mkTupleTy1, mkBoxedTupleTy, mkTupleStr,
tupleTyCon, tupleDataCon, tupleTyConName, tupleDataConName,
promotedTupleDataCon,
unitTyCon, unitDataCon, unitDataConId, unitTy, unitTyConKey,
soloTyCon,
pairTyCon, mkPromotedPairTy, isPromotedPairType,
unboxedUnitTy,
unboxedUnitTyCon, unboxedUnitDataCon,
unboxedTupleKind, unboxedSumKind,
filterCTuple, mkConstraintTupleTy,
cTupleTyCon, cTupleTyConName, cTupleTyConNames, isCTupleTyConName,
cTupleTyConNameArity_maybe,
cTupleDataCon, cTupleDataConName, cTupleDataConNames,
cTupleSelId, cTupleSelIdName,
anyTyCon, anyTy, anyTypeOfKind,
makeRecoveryTyCon,
mkSumTy, sumTyCon, sumDataCon,
typeSymbolKindCon, typeSymbolKind,
isLiftedTypeKindTyConName,
typeToTypeKind,
liftedRepTyCon, unliftedRepTyCon,
tYPETyCon, tYPETyConName, tYPEKind,
cONSTRAINTTyCon, cONSTRAINTTyConName, cONSTRAINTKind,
constraintKind, liftedTypeKind, unliftedTypeKind, zeroBitTypeKind,
constraintKindTyCon, liftedTypeKindTyCon, unliftedTypeKindTyCon,
constraintKindTyConName, liftedTypeKindTyConName, unliftedTypeKindTyConName,
liftedRepTyConName, unliftedRepTyConName,
heqTyCon, heqTyConName, heqClass, heqDataCon,
eqTyCon, eqTyConName, eqClass, eqDataCon, eqTyCon_RDR,
coercibleTyCon, coercibleTyConName, coercibleDataCon, coercibleClass,
runtimeRepTyCon, vecCountTyCon, vecElemTyCon,
boxedRepDataConTyCon,
runtimeRepTy, liftedRepTy, unliftedRepTy, zeroBitRepTy,
vecRepDataConTyCon, tupleRepDataConTyCon, sumRepDataConTyCon,
levityTyCon, levityTy,
liftedDataConTyCon, unliftedDataConTyCon,
liftedDataConTy, unliftedDataConTy,
intRepDataConTy,
int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy,
wordRepDataConTy,
word8RepDataConTy, word16RepDataConTy, word32RepDataConTy, word64RepDataConTy,
addrRepDataConTy,
floatRepDataConTy, doubleRepDataConTy,
vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy,
vec64DataConTy,
int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy,
int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy,
word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy,
doubleElemRepDataConTy,
multiplicityTyConName, oneDataConName, manyDataConName, multiplicityTy,
multiplicityTyCon, oneDataCon, manyDataCon, oneDataConTy, manyDataConTy,
oneDataConTyCon, manyDataConTyCon,
multMulTyCon,
unrestrictedFunTyCon, unrestrictedFunTyConName,
integerTy, integerTyCon, integerTyConName,
integerISDataCon, integerISDataConName,
integerIPDataCon, integerIPDataConName,
integerINDataCon, integerINDataConName,
naturalTy, naturalTyCon, naturalTyConName,
naturalNSDataCon, naturalNSDataConName,
naturalNBDataCon, naturalNBDataConName
) where
import GHC.Prelude
import {-# SOURCE #-} GHC.Types.Id.Make ( mkDataConWorkId, mkDictSelId )
import GHC.Builtin.Names
import GHC.Builtin.Types.Prim
import GHC.Builtin.Uniques
import GHC.Core( Expr(Type), mkConApp )
import GHC.Core.Coercion.Axiom
import GHC.Core.Type
import GHC.Types.Id
import GHC.Core.DataCon
import GHC.Core.ConLike
import GHC.Core.TyCon
import GHC.Core.Class ( Class, mkClass )
import GHC.Core.Map.Type ( TypeMap, emptyTypeMap, extendTypeMap, lookupTypeMap )
import qualified GHC.Core.TyCo.Rep as TyCoRep (Type(TyConApp))
import GHC.Types.TyThing
import GHC.Types.SourceText
import GHC.Types.Var ( VarBndr (Bndr) )
import GHC.Types.RepType
import GHC.Types.Name.Reader
import GHC.Types.Name as Name
import GHC.Types.Name.Env ( lookupNameEnv_NF )
import GHC.Types.Basic
import GHC.Types.ForeignCall
import GHC.Types.Unique.Set
import GHC.Settings.Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE )
import GHC.Unit.Module ( Module )
import Data.Array
import GHC.Data.FastString
import GHC.Data.BooleanFormula ( mkAnd )
import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
import qualified Data.ByteString.Char8 as BS
import Data.Foldable
import Data.List ( elemIndex, intersperse )
alpha_tyvar :: [TyVar]
alpha_tyvar :: [TyVar]
alpha_tyvar = [TyVar
alphaTyVar]
alpha_ty :: [Type]
alpha_ty :: [Type]
alpha_ty = [Type
alphaTy]
wiredInTyCons :: [TyCon]
wiredInTyCons :: [TyCon]
wiredInTyCons = ((Type, DataCon) -> TyCon) -> [(Type, DataCon)] -> [TyCon]
forall a b. (a -> b) -> [a] -> [b]
map (DataCon -> TyCon
dataConTyCon (DataCon -> TyCon)
-> ((Type, DataCon) -> DataCon) -> (Type, DataCon) -> TyCon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type, DataCon) -> DataCon
forall a b. (a, b) -> b
snd) [(Type, DataCon)]
boxingDataCons
[TyCon] -> [TyCon] -> [TyCon]
forall a. [a] -> [a] -> [a]
++ [
TyCon
unitTyCon
, TyCon
unboxedUnitTyCon
, TyCon
soloTyCon
, TyCon
anyTyCon
, TyCon
boolTyCon
, TyCon
charTyCon
, TyCon
stringTyCon
, TyCon
doubleTyCon
, TyCon
floatTyCon
, TyCon
intTyCon
, TyCon
wordTyCon
, TyCon
listTyCon
, TyCon
orderingTyCon
, TyCon
maybeTyCon
, TyCon
heqTyCon
, TyCon
eqTyCon
, TyCon
coercibleTyCon
, TyCon
typeSymbolKindCon
, TyCon
runtimeRepTyCon
, TyCon
levityTyCon
, TyCon
vecCountTyCon
, TyCon
vecElemTyCon
, TyCon
constraintKindTyCon
, TyCon
liftedTypeKindTyCon
, TyCon
unliftedTypeKindTyCon
, TyCon
multiplicityTyCon
, TyCon
naturalTyCon
, TyCon
integerTyCon
, TyCon
liftedRepTyCon
, TyCon
unliftedRepTyCon
, TyCon
zeroBitRepTyCon
, TyCon
zeroBitTypeTyCon
]
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)
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))
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
eqTyConName, eqDataConName, eqSCSelIdName :: Name
eqTyConName :: Name
eqTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"~") Unique
eqTyConKey TyCon
eqTyCon
eqDataConName :: Name
eqDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Eq#") Unique
eqDataConKey DataCon
eqDataCon
eqSCSelIdName :: Name
eqSCSelIdName = Module -> FastString -> Unique -> TyVar -> Name
mkWiredInIdName Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"eq_sel") Unique
eqSCSelIdKey TyVar
eqSCSelId
eqTyCon_RDR :: RdrName
eqTyCon_RDR :: RdrName
eqTyCon_RDR = Name -> RdrName
nameRdrName Name
eqTyConName
heqTyConName, heqDataConName, heqSCSelIdName :: Name
heqTyConName :: Name
heqTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"~~") Unique
heqTyConKey TyCon
heqTyCon
heqDataConName :: Name
heqDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"HEq#") Unique
heqDataConKey DataCon
heqDataCon
heqSCSelIdName :: Name
heqSCSelIdName = Module -> FastString -> Unique -> TyVar -> Name
mkWiredInIdName Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"heq_sel") Unique
heqSCSelIdKey TyVar
heqSCSelId
coercibleTyConName, coercibleDataConName, coercibleSCSelIdName :: Name
coercibleTyConName :: Name
coercibleTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Coercible") Unique
coercibleTyConKey TyCon
coercibleTyCon
coercibleDataConName :: Name
coercibleDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"MkCoercible") Unique
coercibleDataConKey DataCon
coercibleDataCon
coercibleSCSelIdName :: Name
coercibleSCSelIdName = Module -> FastString -> Unique -> TyVar -> Name
mkWiredInIdName Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"coercible_sel") Unique
coercibleSCSelIdKey TyVar
coercibleSCSelId
charTyConName, charDataConName, intTyConName, intDataConName, stringTyConName :: Name
charTyConName :: Name
charTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Char") Unique
charTyConKey TyCon
charTyCon
charDataConName :: Name
charDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"C#") Unique
charDataConKey DataCon
charDataCon
stringTyConName :: Name
stringTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_BASE ([Char] -> FastString
fsLit [Char]
"String") Unique
stringTyConKey TyCon
stringTyCon
intTyConName :: Name
intTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Int") Unique
intTyConKey TyCon
intTyCon
intDataConName :: Name
intDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"I#") Unique
intDataConKey DataCon
intDataCon
boolTyConName, falseDataConName, trueDataConName :: Name
boolTyConName :: Name
boolTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Bool") Unique
boolTyConKey TyCon
boolTyCon
falseDataConName :: Name
falseDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"False") Unique
falseDataConKey DataCon
falseDataCon
trueDataConName :: Name
trueDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"True") Unique
trueDataConKey DataCon
trueDataCon
listTyConName, nilDataConName, consDataConName :: Name
listTyConName :: Name
listTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"List") Unique
listTyConKey TyCon
listTyCon
nilDataConName :: Name
nilDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
BuiltInSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"[]") Unique
nilDataConKey DataCon
nilDataCon
consDataConName :: Name
consDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
BuiltInSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
":") Unique
consDataConKey DataCon
consDataCon
maybeTyConName, nothingDataConName, justDataConName :: Name
maybeTyConName :: Name
maybeTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_MAYBE ([Char] -> FastString
fsLit [Char]
"Maybe")
Unique
maybeTyConKey TyCon
maybeTyCon
nothingDataConName :: Name
nothingDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_MAYBE ([Char] -> FastString
fsLit [Char]
"Nothing")
Unique
nothingDataConKey DataCon
nothingDataCon
justDataConName :: Name
justDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_MAYBE ([Char] -> FastString
fsLit [Char]
"Just")
Unique
justDataConKey DataCon
justDataCon
wordTyConName, wordDataConName, word8DataConName :: Name
wordTyConName :: Name
wordTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Word") Unique
wordTyConKey TyCon
wordTyCon
wordDataConName :: Name
wordDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"W#") Unique
wordDataConKey DataCon
wordDataCon
word8DataConName :: Name
word8DataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_WORD ([Char] -> FastString
fsLit [Char]
"W8#") Unique
word8DataConKey DataCon
word8DataCon
floatTyConName, floatDataConName, doubleTyConName, doubleDataConName :: Name
floatTyConName :: Name
floatTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Float") Unique
floatTyConKey TyCon
floatTyCon
floatDataConName :: Name
floatDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"F#") Unique
floatDataConKey DataCon
floatDataCon
doubleTyConName :: Name
doubleTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Double") Unique
doubleTyConKey TyCon
doubleTyCon
doubleDataConName :: Name
doubleDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"D#") Unique
doubleDataConKey DataCon
doubleDataCon
anyTyConName :: Name
anyTyConName :: Name
anyTyConName =
BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Any") Unique
anyTyConKey TyCon
anyTyCon
anyTyCon :: TyCon
anyTyCon :: TyCon
anyTyCon = Name
-> [TyConBinder]
-> Type
-> Maybe Name
-> FamTyConFlav
-> Maybe Class
-> Injectivity
-> TyCon
mkFamilyTyCon Name
anyTyConName [TyConBinder]
binders Type
res_kind Maybe Name
forall a. Maybe a
Nothing
(Maybe (CoAxiom Branched) -> FamTyConFlav
ClosedSynFamilyTyCon Maybe (CoAxiom Branched)
forall a. Maybe a
Nothing)
Maybe Class
forall a. Maybe a
Nothing
Injectivity
NotInjective
where
binders :: [TyConBinder]
binders@[TyConBinder
kv] = [Type] -> [TyConBinder]
mkTemplateKindTyConBinders [Type
liftedTypeKind]
res_kind :: Type
res_kind = TyVar -> Type
mkTyVarTy (TyConBinder -> TyVar
forall tv argf. VarBndr tv argf -> tv
binderVar TyConBinder
kv)
anyTy :: Type
anyTy :: Type
anyTy = TyCon -> Type
mkTyConTy TyCon
anyTyCon
anyTypeOfKind :: Kind -> Type
anyTypeOfKind :: Type -> Type
anyTypeOfKind Type
kind = TyCon -> [Type] -> Type
mkTyConApp TyCon
anyTyCon [Type
kind]
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
TyConFlavour
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 -> ([ForAllTyFlag -> TyVar -> TyConBinder
mkNamedTyConBinder ForAllTyFlag
Inferred TyVar
kv], TyVar -> Type
mkTyVarTy TyVar
kv)
TyConFlavour
_ -> (TyCon -> [TyConBinder]
tyConBinders TyCon
tc, TyCon -> Type
tyConResKind TyCon
tc)
typeSymbolKindConName :: Name
typeSymbolKindConName :: Name
typeSymbolKindConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Symbol") Unique
typeSymbolKindConNameKey TyCon
typeSymbolKindCon
boolTyCon_RDR, false_RDR, true_RDR, intTyCon_RDR, charTyCon_RDR, stringTyCon_RDR,
intDataCon_RDR, listTyCon_RDR, consDataCon_RDR :: RdrName
boolTyCon_RDR :: RdrName
boolTyCon_RDR = Name -> RdrName
nameRdrName Name
boolTyConName
false_RDR :: RdrName
false_RDR = Name -> RdrName
nameRdrName Name
falseDataConName
true_RDR :: RdrName
true_RDR = Name -> RdrName
nameRdrName Name
trueDataConName
intTyCon_RDR :: RdrName
intTyCon_RDR = Name -> RdrName
nameRdrName Name
intTyConName
charTyCon_RDR :: RdrName
charTyCon_RDR = Name -> RdrName
nameRdrName Name
charTyConName
stringTyCon_RDR :: RdrName
stringTyCon_RDR = Name -> RdrName
nameRdrName Name
stringTyConName
intDataCon_RDR :: RdrName
intDataCon_RDR = Name -> RdrName
nameRdrName Name
intDataConName
listTyCon_RDR :: RdrName
listTyCon_RDR = Name -> RdrName
nameRdrName Name
listTyConName
consDataCon_RDR :: RdrName
consDataCon_RDR = Name -> RdrName
nameRdrName Name
consDataConName
pcTyCon :: Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon :: Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
name Maybe CType
cType [TyVar]
tyvars [DataCon]
cons
= Name
-> [TyConBinder]
-> Type
-> [Role]
-> Maybe CType
-> [Type]
-> AlgTyConRhs
-> AlgTyConFlav
-> Bool
-> TyCon
mkAlgTyCon Name
name
([TyVar] -> [TyConBinder]
mkAnonTyConBinders [TyVar]
tyvars)
Type
liftedTypeKind
((TyVar -> Role) -> [TyVar] -> [Role]
forall a b. (a -> b) -> [a] -> [b]
map (Role -> TyVar -> Role
forall a b. a -> b -> a
const Role
Representational) [TyVar]
tyvars)
Maybe CType
cType
[]
([DataCon] -> AlgTyConRhs
mkDataTyConRhs [DataCon]
cons)
(Name -> AlgTyConFlav
VanillaAlgTyCon (Name -> Name
mkPrelTyConRepName Name
name))
Bool
False
pcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
n [TyVar]
univs [Type]
tys
= Bool
-> Name
-> [TyVar]
-> [TyVar]
-> [TyVar]
-> [Type]
-> [Scaled Type]
-> TyCon
-> DataCon
pcDataConWithFixity Bool
False Name
n [TyVar]
univs
[]
[TyVar]
univs
[]
((Type -> Scaled Type) -> [Type] -> [Scaled Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Scaled Type
forall a. a -> Scaled a
linear [Type]
tys)
pcDataConConstraint :: Name -> [TyVar] -> ThetaType -> TyCon -> DataCon
pcDataConConstraint :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataConConstraint Name
n [TyVar]
univs [Type]
theta
= Bool
-> Name
-> [TyVar]
-> [TyVar]
-> [TyVar]
-> [Type]
-> [Scaled Type]
-> TyCon
-> DataCon
pcDataConWithFixity Bool
False Name
n [TyVar]
univs
[]
[TyVar]
univs
[Type]
theta
[]
pcSpecialDataCon :: Name -> [Type] -> TyCon -> PromDataConInfo -> DataCon
pcSpecialDataCon :: Name -> [Type] -> TyCon -> PromDataConInfo -> DataCon
pcSpecialDataCon Name
dc_name [Type]
arg_tys TyCon
tycon PromDataConInfo
rri
= Bool
-> Name
-> Unique
-> PromDataConInfo
-> [TyVar]
-> [TyVar]
-> [TyVar]
-> [Type]
-> [Scaled Type]
-> TyCon
-> DataCon
pcDataConWithFixity' Bool
False Name
dc_name
(Unique -> Unique
dataConWorkerUnique (Name -> Unique
nameUnique Name
dc_name)) PromDataConInfo
rri
[] [] [] [] ((Type -> Scaled Type) -> [Type] -> [Scaled Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Scaled Type
forall a. a -> Scaled a
linear [Type]
arg_tys) TyCon
tycon
pcDataConWithFixity :: Bool
-> Name
-> [TyVar]
-> [TyCoVar]
-> [TyCoVar]
-> ThetaType
-> [Scaled Type]
-> TyCon
-> DataCon
pcDataConWithFixity :: Bool
-> Name
-> [TyVar]
-> [TyVar]
-> [TyVar]
-> [Type]
-> [Scaled Type]
-> TyCon
-> DataCon
pcDataConWithFixity Bool
infx Name
n = Bool
-> Name
-> Unique
-> PromDataConInfo
-> [TyVar]
-> [TyVar]
-> [TyVar]
-> [Type]
-> [Scaled Type]
-> TyCon
-> DataCon
pcDataConWithFixity' Bool
infx Name
n
(Unique -> Unique
dataConWorkerUnique (Name -> Unique
nameUnique Name
n)) PromDataConInfo
NoPromInfo
pcDataConWithFixity' :: Bool -> Name -> Unique -> PromDataConInfo
-> [TyVar] -> [TyCoVar] -> [TyCoVar]
-> ThetaType -> [Scaled Type] -> TyCon -> DataCon
pcDataConWithFixity' :: Bool
-> Name
-> Unique
-> PromDataConInfo
-> [TyVar]
-> [TyVar]
-> [TyVar]
-> [Type]
-> [Scaled Type]
-> TyCon
-> DataCon
pcDataConWithFixity' Bool
declared_infix Name
dc_name Unique
wrk_key PromDataConInfo
rri
[TyVar]
tyvars [TyVar]
ex_tyvars [TyVar]
user_tyvars [Type]
theta [Scaled Type]
arg_tys TyCon
tycon
= DataCon
data_con
where
tag_map :: NameEnv Int
tag_map = TyCon -> NameEnv Int
mkTyConTagMap TyCon
tycon
data_con :: DataCon
data_con = Name
-> Bool
-> Name
-> [HsSrcBang]
-> [FieldLabel]
-> [TyVar]
-> [TyVar]
-> [InvisTVBinder]
-> [EqSpec]
-> [Type]
-> [Scaled Type]
-> Type
-> PromDataConInfo
-> TyCon
-> Int
-> [Type]
-> TyVar
-> DataConRep
-> DataCon
mkDataCon Name
dc_name Bool
declared_infix Name
prom_info
((Scaled Type -> HsSrcBang) -> [Scaled Type] -> [HsSrcBang]
forall a b. (a -> b) -> [a] -> [b]
map (HsSrcBang -> Scaled Type -> HsSrcBang
forall a b. a -> b -> a
const HsSrcBang
no_bang) [Scaled Type]
arg_tys)
[]
[TyVar]
tyvars [TyVar]
ex_tyvars
(Specificity -> [TyVar] -> [InvisTVBinder]
forall vis. vis -> [TyVar] -> [VarBndr TyVar vis]
mkTyVarBinders Specificity
SpecifiedSpec [TyVar]
user_tyvars)
[]
[Type]
theta
[Scaled Type]
arg_tys (TyCon -> [Type] -> Type
mkTyConApp TyCon
tycon ([TyVar] -> [Type]
mkTyVarTys [TyVar]
tyvars))
PromDataConInfo
rri
TyCon
tycon
(NameEnv Int -> Name -> Int
forall a. NameEnv a -> Name -> a
lookupNameEnv_NF NameEnv Int
tag_map Name
dc_name)
[]
(Name -> DataCon -> TyVar
mkDataConWorkId Name
wrk_name DataCon
data_con)
DataConRep
NoDataConRep
no_bang :: HsSrcBang
no_bang = SourceText -> SrcUnpackedness -> SrcStrictness -> HsSrcBang
HsSrcBang SourceText
NoSourceText SrcUnpackedness
NoSrcUnpack SrcStrictness
NoSrcStrict
wrk_name :: Name
wrk_name = DataCon -> Unique -> Name
mkDataConWorkerName DataCon
data_con Unique
wrk_key
prom_info :: Name
prom_info = Name -> Name
mkPrelTyConRepName Name
dc_name
mkDataConWorkerName :: DataCon -> Unique -> Name
mkDataConWorkerName :: DataCon -> Unique -> Name
mkDataConWorkerName DataCon
data_con Unique
wrk_key =
Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
mkWiredInName Module
modu OccName
wrk_occ Unique
wrk_key
(TyVar -> TyThing
AnId (DataCon -> TyVar
dataConWorkId DataCon
data_con)) BuiltInSyntax
UserSyntax
where
modu :: Module
modu = Bool -> Module -> Module
forall a. HasCallStack => Bool -> a -> a
assert (Name -> Bool
isExternalName Name
dc_name) (Module -> Module) -> Module -> Module
forall a b. (a -> b) -> a -> b
$
(() :: Constraint) => Name -> Module
Name -> Module
nameModule Name
dc_name
dc_name :: Name
dc_name = DataCon -> Name
dataConName DataCon
data_con
dc_occ :: OccName
dc_occ = Name -> OccName
nameOccName Name
dc_name
wrk_occ :: OccName
wrk_occ = OccName -> OccName
mkDataConWorkerOcc OccName
dc_occ
typeSymbolKindCon :: TyCon
typeSymbolKindCon :: TyCon
typeSymbolKindCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
typeSymbolKindConName Maybe CType
forall a. Maybe a
Nothing [] []
typeSymbolKind :: Kind
typeSymbolKind :: Type
typeSymbolKind = TyCon -> Type
mkTyConTy TyCon
typeSymbolKindCon
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
ByteString
"FUN" -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
fUNTyConName
ByteString
"->" -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
unrestrictedFunTyConName
ByteString
"()" -> Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ Boxity -> Int -> Name
tup_name Boxity
Boxed Int
0
ByteString
_ | Just ByteString
rest <- ByteString
"(" ByteString -> ByteString -> Maybe ByteString
`BS.stripPrefix` ByteString
name
, (ByteString
commas, ByteString
rest') <- (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
',') ByteString
rest
, ByteString
")" <- ByteString
rest'
-> Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ Boxity -> Int -> Name
tup_name Boxity
Boxed (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+ByteString -> Int
BS.length ByteString
commas)
ByteString
"(##)" -> Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ Boxity -> Int -> Name
tup_name Boxity
Unboxed Int
0
ByteString
"Solo#" -> Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ Boxity -> Int -> Name
tup_name Boxity
Unboxed Int
1
ByteString
_ | Just ByteString
rest <- ByteString
"(#" ByteString -> ByteString -> Maybe ByteString
`BS.stripPrefix` ByteString
name
, (ByteString
commas, ByteString
rest') <- (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
',') ByteString
rest
, ByteString
"#)" <- ByteString
rest'
-> Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ Boxity -> Int -> Name
tup_name Boxity
Unboxed (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+ByteString -> Int
BS.length ByteString
commas)
ByteString
_ | Just ByteString
rest <- ByteString
"(#" ByteString -> ByteString -> Maybe ByteString
`BS.stripPrefix` ByteString
name
, (Int
nb_pipes, ByteString
rest') <- ByteString -> (Int, ByteString)
span_pipes ByteString
rest
, ByteString
"#)" <- ByteString
rest'
-> Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ TyCon -> Name
tyConName (TyCon -> Name) -> TyCon -> Name
forall a b. (a -> b) -> a -> b
$ Int -> TyCon
sumTyCon (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
nb_pipes)
ByteString
_ | Just ByteString
rest <- ByteString
"(#" ByteString -> ByteString -> Maybe ByteString
`BS.stripPrefix` ByteString
name
, (Int
nb_pipes1, ByteString
rest') <- ByteString -> (Int, ByteString)
span_pipes ByteString
rest
, Just ByteString
rest'' <- ByteString
"_" ByteString -> ByteString -> Maybe ByteString
`BS.stripPrefix` ByteString
rest'
, (Int
nb_pipes2, ByteString
rest''') <- ByteString -> (Int, ByteString)
span_pipes ByteString
rest''
, ByteString
"#)" <- ByteString
rest'''
-> let arity :: Int
arity = Int
nb_pipes1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nb_pipes2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
alt :: Int
alt = Int
nb_pipes1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
in Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ DataCon -> Name
dataConName (DataCon -> Name) -> DataCon -> Name
forall a b. (a -> b) -> a -> b
$ Int -> Int -> DataCon
sumDataCon Int
alt Int
arity
ByteString
_ -> Maybe Name
forall a. Maybe a
Nothing
where
name :: ByteString
name = FastString -> ByteString
bytesFS (FastString -> ByteString) -> FastString -> ByteString
forall a b. (a -> b) -> a -> b
$ OccName -> FastString
occNameFS OccName
occ
span_pipes :: BS.ByteString -> (Int, BS.ByteString)
span_pipes :: ByteString -> (Int, ByteString)
span_pipes = Int -> ByteString -> (Int, ByteString)
forall {a}. Num a => a -> ByteString -> (a, ByteString)
go Int
0
where
go :: a -> ByteString -> (a, ByteString)
go a
nb_pipes ByteString
bs = case ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
bs of
Just (Char
'|',ByteString
rest) -> a -> ByteString -> (a, ByteString)
go (a
nb_pipes a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) ByteString
rest
Just (Char
' ',ByteString
rest) -> a -> ByteString -> (a, ByteString)
go a
nb_pipes ByteString
rest
Maybe (Char, ByteString)
_ -> (a
nb_pipes, ByteString
bs)
choose_ns :: Name -> Name -> Name
choose_ns :: Name -> Name -> Name
choose_ns Name
tc Name
dc
| NameSpace -> Bool
isTcClsNameSpace NameSpace
ns = Name
tc
| NameSpace -> Bool
isDataConNameSpace NameSpace
ns = Name
dc
| Bool
otherwise = [Char] -> SDoc -> Name
forall a. HasCallStack => [Char] -> SDoc -> a
pprPanic [Char]
"tup_name" (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ)
where ns :: NameSpace
ns = OccName -> NameSpace
occNameSpace OccName
occ
tup_name :: Boxity -> Int -> Name
tup_name Boxity
boxity Int
arity
= Name -> Name -> Name
choose_ns (TyCon -> Name
forall a. NamedThing a => a -> Name
getName (Boxity -> Int -> TyCon
tupleTyCon Boxity
boxity Int
arity))
(DataCon -> Name
forall a. NamedThing a => a -> Name
getName (Boxity -> Int -> DataCon
tupleDataCon Boxity
boxity Int
arity))
isPunOcc_maybe :: Module -> OccName -> Maybe Name
isPunOcc_maybe :: Module -> OccName -> Maybe Name
isPunOcc_maybe Module
mod OccName
occ
| Module
mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
gHC_TYPES, OccName
occ OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
listTyConName
= Name -> Maybe Name
forall a. a -> Maybe a
Just Name
listTyConName
isPunOcc_maybe Module
_ OccName
_ = Maybe Name
forall a. Maybe a
Nothing
mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
mkTupleOcc :: NameSpace -> Boxity -> Int -> OccName
mkTupleOcc NameSpace
ns Boxity
Boxed Int
ar = NameSpace -> [Char] -> OccName
mkOccName NameSpace
ns (NameSpace -> Int -> [Char]
mkBoxedTupleStr NameSpace
ns Int
ar)
mkTupleOcc NameSpace
ns Boxity
Unboxed Int
ar = NameSpace -> [Char] -> OccName
mkOccName NameSpace
ns (Int -> [Char]
mkUnboxedTupleStr Int
ar)
mkCTupleOcc :: NameSpace -> Arity -> OccName
mkCTupleOcc :: NameSpace -> Int -> OccName
mkCTupleOcc NameSpace
ns Int
ar = NameSpace -> [Char] -> OccName
mkOccName NameSpace
ns (Int -> [Char]
mkConstraintTupleStr Int
ar)
mkTupleStr :: Boxity -> NameSpace -> Arity -> String
mkTupleStr :: Boxity -> NameSpace -> Int -> [Char]
mkTupleStr Boxity
Boxed = NameSpace -> Int -> [Char]
mkBoxedTupleStr
mkTupleStr Boxity
Unboxed = (Int -> [Char]) -> NameSpace -> Int -> [Char]
forall a b. a -> b -> a
const Int -> [Char]
mkUnboxedTupleStr
mkBoxedTupleStr :: NameSpace -> Arity -> String
mkBoxedTupleStr :: NameSpace -> Int -> [Char]
mkBoxedTupleStr NameSpace
_ Int
0 = [Char]
"()"
mkBoxedTupleStr NameSpace
ns Int
1 | NameSpace -> Bool
isDataConNameSpace NameSpace
ns = [Char]
"MkSolo"
mkBoxedTupleStr NameSpace
_ Int
1 = [Char]
"Solo"
mkBoxedTupleStr NameSpace
_ Int
ar = Char
'(' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Int -> [Char]
commas Int
ar [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"
mkUnboxedTupleStr :: Arity -> String
mkUnboxedTupleStr :: Int -> [Char]
mkUnboxedTupleStr Int
0 = [Char]
"(##)"
mkUnboxedTupleStr Int
1 = [Char]
"Solo#"
mkUnboxedTupleStr Int
ar = [Char]
"(#" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
commas Int
ar [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"#)"
mkConstraintTupleStr :: Arity -> String
mkConstraintTupleStr :: Int -> [Char]
mkConstraintTupleStr Int
0 = [Char]
"(%%)"
mkConstraintTupleStr Int
1 = [Char]
"Solo%"
mkConstraintTupleStr Int
ar = [Char]
"(%" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
commas Int
ar [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"%)"
commas :: Arity -> String
commas :: Int -> [Char]
commas Int
ar = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take (Int
arInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Char -> [Char]
forall a. a -> [a]
repeat Char
',')
cTupleTyCon :: Arity -> TyCon
cTupleTyCon :: Int -> TyCon
cTupleTyCon Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mAX_CTUPLE_SIZE = (TyCon, DataCon, Array Int TyVar) -> TyCon
forall a b c. (a, b, c) -> a
fstOf3 (Int -> (TyCon, DataCon, Array Int TyVar)
mk_ctuple Int
i)
| Bool
otherwise = (TyCon, DataCon, Array Int TyVar) -> TyCon
forall a b c. (a, b, c) -> a
fstOf3 (Array Int (TyCon, DataCon, Array Int TyVar)
cTupleArr Array Int (TyCon, DataCon, Array Int TyVar)
-> Int -> (TyCon, DataCon, Array Int TyVar)
forall i e. Ix i => Array i e -> i -> e
! Int
i)
cTupleTyConName :: Arity -> Name
cTupleTyConName :: Int -> Name
cTupleTyConName Int
a = TyCon -> Name
tyConName (Int -> TyCon
cTupleTyCon Int
a)
cTupleTyConNames :: [Name]
cTupleTyConNames :: [Name]
cTupleTyConNames = (Int -> Name) -> [Int] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Name
cTupleTyConName (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int
2..Int
mAX_CTUPLE_SIZE])
cTupleTyConKeys :: UniqSet Unique
cTupleTyConKeys :: UniqSet Unique
cTupleTyConKeys = [Unique] -> UniqSet Unique
forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet ([Unique] -> UniqSet Unique) -> [Unique] -> UniqSet Unique
forall a b. (a -> b) -> a -> b
$ (Name -> Unique) -> [Name] -> [Unique]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Unique
forall a. Uniquable a => a -> Unique
getUnique [Name]
cTupleTyConNames
isCTupleTyConName :: Name -> Bool
isCTupleTyConName :: Name -> Bool
isCTupleTyConName Name
n
= Bool -> SDoc -> Bool -> Bool
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Name -> Bool
isExternalName Name
n) (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
Name -> Unique
forall a. Uniquable a => a -> Unique
getUnique Name
n Unique -> UniqSet Unique -> Bool
forall a. Uniquable a => a -> UniqSet a -> Bool
`elementOfUniqSet` UniqSet Unique
cTupleTyConKeys
cTupleTyConNameArity_maybe :: Name -> Maybe Arity
cTupleTyConNameArity_maybe :: Name -> Maybe Int
cTupleTyConNameArity_maybe Name
n
| Bool -> Bool
not (Name -> Bool
isCTupleTyConName Name
n) = Maybe Int
forall a. Maybe a
Nothing
| Bool
otherwise = (Int -> Int) -> Maybe Int -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Int
forall {a}. (Ord a, Num a) => a -> a
adjustArity (Name
n Name -> [Name] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` [Name]
cTupleTyConNames)
where
adjustArity :: a -> a
adjustArity a
a = if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 then a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
1 else a
a
cTupleDataCon :: Arity -> DataCon
cTupleDataCon :: Int -> DataCon
cTupleDataCon Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mAX_CTUPLE_SIZE = (TyCon, DataCon, Array Int TyVar) -> DataCon
forall a b c. (a, b, c) -> b
sndOf3 (Int -> (TyCon, DataCon, Array Int TyVar)
mk_ctuple Int
i)
| Bool
otherwise = (TyCon, DataCon, Array Int TyVar) -> DataCon
forall a b c. (a, b, c) -> b
sndOf3 (Array Int (TyCon, DataCon, Array Int TyVar)
cTupleArr Array Int (TyCon, DataCon, Array Int TyVar)
-> Int -> (TyCon, DataCon, Array Int TyVar)
forall i e. Ix i => Array i e -> i -> e
! Int
i)
cTupleDataConName :: Arity -> Name
cTupleDataConName :: Int -> Name
cTupleDataConName Int
i = DataCon -> Name
dataConName (Int -> DataCon
cTupleDataCon Int
i)
cTupleDataConNames :: [Name]
cTupleDataConNames :: [Name]
cTupleDataConNames = (Int -> Name) -> [Int] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Name
cTupleDataConName (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int
2..Int
mAX_CTUPLE_SIZE])
cTupleSelId :: ConTag
-> Arity
-> Id
cTupleSelId :: Int -> Int -> TyVar
cTupleSelId Int
sc_pos Int
arity
| Int
sc_pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
arity
= [Char] -> TyVar
forall a. HasCallStack => [Char] -> a
panic ([Char]
"cTupleSelId: index out of bounds: superclass position: "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
sc_pos [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" > arity " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
arity)
| Int
sc_pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
= [Char] -> TyVar
forall a. HasCallStack => [Char] -> a
panic ([Char]
"cTupleSelId: Superclass positions start from 1. "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"(superclass position: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
sc_pos
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", arity: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
arity [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")")
| Int
arity Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
= [Char] -> TyVar
forall a. HasCallStack => [Char] -> a
panic ([Char]
"cTupleSelId: Arity starts from 2. "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"(superclass position: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
sc_pos
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", arity: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
arity [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")")
| Int
arity Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mAX_CTUPLE_SIZE
= (TyCon, DataCon, Array Int TyVar) -> Array Int TyVar
forall a b c. (a, b, c) -> c
thdOf3 (Int -> (TyCon, DataCon, Array Int TyVar)
mk_ctuple Int
arity) Array Int TyVar -> Int -> TyVar
forall i e. Ix i => Array i e -> i -> e
! (Int
sc_pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
| Bool
otherwise
= (TyCon, DataCon, Array Int TyVar) -> Array Int TyVar
forall a b c. (a, b, c) -> c
thdOf3 (Array Int (TyCon, DataCon, Array Int TyVar)
cTupleArr Array Int (TyCon, DataCon, Array Int TyVar)
-> Int -> (TyCon, DataCon, Array Int TyVar)
forall i e. Ix i => Array i e -> i -> e
! Int
arity) Array Int TyVar -> Int -> TyVar
forall i e. Ix i => Array i e -> i -> e
! (Int
sc_pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
cTupleSelIdName :: ConTag
-> Arity
-> Name
cTupleSelIdName :: Int -> Int -> Name
cTupleSelIdName Int
sc_pos Int
arity = TyVar -> Name
idName (Int -> Int -> TyVar
cTupleSelId Int
sc_pos Int
arity)
tupleTyCon :: Boxity -> Arity -> TyCon
tupleTyCon :: Boxity -> Int -> TyCon
tupleTyCon Boxity
sort Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mAX_TUPLE_SIZE = (TyCon, DataCon) -> TyCon
forall a b. (a, b) -> a
fst (Boxity -> Int -> (TyCon, DataCon)
mk_tuple Boxity
sort Int
i)
tupleTyCon Boxity
Boxed Int
i = (TyCon, DataCon) -> TyCon
forall a b. (a, b) -> a
fst (Array Int (TyCon, DataCon)
boxedTupleArr Array Int (TyCon, DataCon) -> Int -> (TyCon, DataCon)
forall i e. Ix i => Array i e -> i -> e
! Int
i)
tupleTyCon Boxity
Unboxed Int
i = (TyCon, DataCon) -> TyCon
forall a b. (a, b) -> a
fst (Array Int (TyCon, DataCon)
unboxedTupleArr Array Int (TyCon, DataCon) -> Int -> (TyCon, DataCon)
forall i e. Ix i => Array i e -> i -> e
! Int
i)
tupleTyConName :: TupleSort -> Arity -> Name
tupleTyConName :: TupleSort -> Int -> Name
tupleTyConName TupleSort
ConstraintTuple Int
a = Int -> Name
cTupleTyConName Int
a
tupleTyConName TupleSort
BoxedTuple Int
a = TyCon -> Name
tyConName (Boxity -> Int -> TyCon
tupleTyCon Boxity
Boxed Int
a)
tupleTyConName TupleSort
UnboxedTuple Int
a = TyCon -> Name
tyConName (Boxity -> Int -> TyCon
tupleTyCon Boxity
Unboxed Int
a)
promotedTupleDataCon :: Boxity -> Arity -> TyCon
promotedTupleDataCon :: Boxity -> Int -> TyCon
promotedTupleDataCon Boxity
boxity Int
i = DataCon -> TyCon
promoteDataCon (Boxity -> Int -> DataCon
tupleDataCon Boxity
boxity Int
i)
tupleDataCon :: Boxity -> Arity -> DataCon
tupleDataCon :: Boxity -> Int -> DataCon
tupleDataCon Boxity
sort Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mAX_TUPLE_SIZE = (TyCon, DataCon) -> DataCon
forall a b. (a, b) -> b
snd (Boxity -> Int -> (TyCon, DataCon)
mk_tuple Boxity
sort Int
i)
tupleDataCon Boxity
Boxed Int
i = (TyCon, DataCon) -> DataCon
forall a b. (a, b) -> b
snd (Array Int (TyCon, DataCon)
boxedTupleArr Array Int (TyCon, DataCon) -> Int -> (TyCon, DataCon)
forall i e. Ix i => Array i e -> i -> e
! Int
i)
tupleDataCon Boxity
Unboxed Int
i = (TyCon, DataCon) -> DataCon
forall a b. (a, b) -> b
snd (Array Int (TyCon, DataCon)
unboxedTupleArr Array Int (TyCon, DataCon) -> Int -> (TyCon, DataCon)
forall i e. Ix i => Array i e -> i -> e
! Int
i)
tupleDataConName :: Boxity -> Arity -> Name
tupleDataConName :: Boxity -> Int -> Name
tupleDataConName Boxity
sort Int
i = DataCon -> Name
dataConName (Boxity -> Int -> DataCon
tupleDataCon Boxity
sort Int
i)
mkPromotedPairTy :: Kind -> Kind -> Type -> Type -> Type
mkPromotedPairTy :: Type -> Type -> Type -> Type -> Type
mkPromotedPairTy Type
k1 Type
k2 Type
t1 Type
t2 = TyCon -> [Type] -> Type
mkTyConApp (Boxity -> Int -> TyCon
promotedTupleDataCon Boxity
Boxed Int
2) [Type
k1,Type
k2,Type
t1,Type
t2]
isPromotedPairType :: Type -> Maybe (Type, Type)
isPromotedPairType :: Type -> Maybe (Type, Type)
isPromotedPairType Type
t
| Just (TyCon
tc, [Type
_,Type
_,Type
x,Type
y]) <- (() :: Constraint) => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
t
, TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== Boxity -> Int -> TyCon
promotedTupleDataCon Boxity
Boxed Int
2
= (Type, Type) -> Maybe (Type, Type)
forall a. a -> Maybe a
Just (Type
x, Type
y)
| Bool
otherwise = Maybe (Type, Type)
forall a. Maybe a
Nothing
boxedTupleArr, unboxedTupleArr :: Array Int (TyCon,DataCon)
boxedTupleArr :: Array Int (TyCon, DataCon)
boxedTupleArr = (Int, Int) -> [(TyCon, DataCon)] -> Array Int (TyCon, DataCon)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
mAX_TUPLE_SIZE) [Boxity -> Int -> (TyCon, DataCon)
mk_tuple Boxity
Boxed Int
i | Int
i <- [Int
0..Int
mAX_TUPLE_SIZE]]
unboxedTupleArr :: Array Int (TyCon, DataCon)
unboxedTupleArr = (Int, Int) -> [(TyCon, DataCon)] -> Array Int (TyCon, DataCon)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
mAX_TUPLE_SIZE) [Boxity -> Int -> (TyCon, DataCon)
mk_tuple Boxity
Unboxed Int
i | Int
i <- [Int
0..Int
mAX_TUPLE_SIZE]]
cTupleArr :: Array Int (TyCon, DataCon, Array Int Id)
cTupleArr :: Array Int (TyCon, DataCon, Array Int TyVar)
cTupleArr = (Int, Int)
-> [(TyCon, DataCon, Array Int TyVar)]
-> Array Int (TyCon, DataCon, Array Int TyVar)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
mAX_CTUPLE_SIZE) [Int -> (TyCon, DataCon, Array Int TyVar)
mk_ctuple Int
i | Int
i <- [Int
0..Int
mAX_CTUPLE_SIZE]]
unboxedTupleSumKind :: TyCon -> [Type] -> Kind
unboxedTupleSumKind :: TyCon -> [Type] -> Type
unboxedTupleSumKind TyCon
tc [Type]
rr_tys
= Type -> Type
mkTYPEapp (TyCon -> [Type] -> Type
mkTyConApp TyCon
tc [Type -> [Type] -> Type
mkPromotedListTy Type
runtimeRepTy [Type]
rr_tys])
unboxedTupleKind :: [Type] -> Kind
unboxedTupleKind :: [Type] -> Type
unboxedTupleKind = TyCon -> [Type] -> Type
unboxedTupleSumKind TyCon
tupleRepDataConTyCon
mk_tuple :: Boxity -> Int -> (TyCon,DataCon)
mk_tuple :: Boxity -> Int -> (TyCon, DataCon)
mk_tuple Boxity
Boxed Int
arity = (TyCon
tycon, DataCon
tuple_con)
where
tycon :: TyCon
tycon = Name
-> [TyConBinder]
-> Type
-> DataCon
-> TupleSort
-> AlgTyConFlav
-> TyCon
mkTupleTyCon Name
tc_name [TyConBinder]
tc_binders Type
tc_res_kind DataCon
tuple_con
TupleSort
BoxedTuple AlgTyConFlav
flavour
tc_binders :: [TyConBinder]
tc_binders = [Type] -> [TyConBinder]
mkTemplateAnonTyConBinders (Int -> Type -> [Type]
forall a. Int -> a -> [a]
replicate Int
arity Type
liftedTypeKind)
tc_res_kind :: Type
tc_res_kind = Type
liftedTypeKind
flavour :: AlgTyConFlav
flavour = Name -> AlgTyConFlav
VanillaAlgTyCon (Name -> Name
mkPrelTyConRepName Name
tc_name)
dc_tvs :: [TyVar]
dc_tvs = [TyConBinder] -> [TyVar]
forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
tc_binders
dc_arg_tys :: [Type]
dc_arg_tys = [TyVar] -> [Type]
mkTyVarTys [TyVar]
dc_tvs
tuple_con :: DataCon
tuple_con = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
dc_name [TyVar]
dc_tvs [Type]
dc_arg_tys TyCon
tycon
boxity :: Boxity
boxity = Boxity
Boxed
modu :: Module
modu = Module
gHC_TUPLE_PRIM
tc_name :: Name
tc_name = Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
mkWiredInName Module
modu (NameSpace -> Boxity -> Int -> OccName
mkTupleOcc NameSpace
tcName Boxity
boxity Int
arity) Unique
tc_uniq
(TyCon -> TyThing
ATyCon TyCon
tycon) BuiltInSyntax
BuiltInSyntax
dc_name :: Name
dc_name = Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
mkWiredInName Module
modu (NameSpace -> Boxity -> Int -> OccName
mkTupleOcc NameSpace
dataName Boxity
boxity Int
arity) Unique
dc_uniq
(ConLike -> TyThing
AConLike (DataCon -> ConLike
RealDataCon DataCon
tuple_con)) BuiltInSyntax
BuiltInSyntax
tc_uniq :: Unique
tc_uniq = Boxity -> Int -> Unique
mkTupleTyConUnique Boxity
boxity Int
arity
dc_uniq :: Unique
dc_uniq = Boxity -> Int -> Unique
mkTupleDataConUnique Boxity
boxity Int
arity
mk_tuple Boxity
Unboxed Int
arity = (TyCon
tycon, DataCon
tuple_con)
where
tycon :: TyCon
tycon = Name
-> [TyConBinder]
-> Type
-> DataCon
-> TupleSort
-> AlgTyConFlav
-> TyCon
mkTupleTyCon Name
tc_name [TyConBinder]
tc_binders Type
tc_res_kind DataCon
tuple_con
TupleSort
UnboxedTuple AlgTyConFlav
flavour
tc_binders :: [TyConBinder]
tc_binders = [Type] -> ([Type] -> [Type]) -> [TyConBinder]
mkTemplateTyConBinders (Int -> Type -> [Type]
forall a. Int -> a -> [a]
replicate Int
arity Type
runtimeRepTy)
(\[Type]
ks -> (Type -> Type) -> [Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Type
mkTYPEapp [Type]
ks)
tc_res_kind :: Type
tc_res_kind = [Type] -> Type
unboxedTupleKind [Type]
rr_tys
flavour :: AlgTyConFlav
flavour = Name -> AlgTyConFlav
VanillaAlgTyCon (Name -> Name
mkPrelTyConRepName Name
tc_name)
dc_tvs :: [TyVar]
dc_tvs = [TyConBinder] -> [TyVar]
forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
tc_binders
([Type]
rr_tys, [Type]
dc_arg_tys) = Int -> [Type] -> ([Type], [Type])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
arity ([TyVar] -> [Type]
mkTyVarTys [TyVar]
dc_tvs)
tuple_con :: DataCon
tuple_con = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
dc_name [TyVar]
dc_tvs [Type]
dc_arg_tys TyCon
tycon
boxity :: Boxity
boxity = Boxity
Unboxed
modu :: Module
modu = Module
gHC_PRIM
tc_name :: Name
tc_name = Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
mkWiredInName Module
modu (NameSpace -> Boxity -> Int -> OccName
mkTupleOcc NameSpace
tcName Boxity
boxity Int
arity) Unique
tc_uniq
(TyCon -> TyThing
ATyCon TyCon
tycon) BuiltInSyntax
BuiltInSyntax
dc_name :: Name
dc_name = Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
mkWiredInName Module
modu (NameSpace -> Boxity -> Int -> OccName
mkTupleOcc NameSpace
dataName Boxity
boxity Int
arity) Unique
dc_uniq
(ConLike -> TyThing
AConLike (DataCon -> ConLike
RealDataCon DataCon
tuple_con)) BuiltInSyntax
BuiltInSyntax
tc_uniq :: Unique
tc_uniq = Boxity -> Int -> Unique
mkTupleTyConUnique Boxity
boxity Int
arity
dc_uniq :: Unique
dc_uniq = Boxity -> Int -> Unique
mkTupleDataConUnique Boxity
boxity Int
arity
mk_ctuple :: Arity -> (TyCon, DataCon, Array ConTagZ Id)
mk_ctuple :: Int -> (TyCon, DataCon, Array Int TyVar)
mk_ctuple Int
arity = (TyCon
tycon, DataCon
tuple_con, Array Int TyVar
sc_sel_ids_arr)
where
tycon :: TyCon
tycon = Name
-> [TyConBinder] -> [Role] -> AlgTyConRhs -> Class -> Name -> TyCon
mkClassTyCon Name
tc_name [TyConBinder]
binders [Role]
roles
AlgTyConRhs
rhs Class
klass
(Name -> Name
mkPrelTyConRepName Name
tc_name)
klass :: Class
klass = TyCon -> [Type] -> [TyVar] -> Class
mk_ctuple_class TyCon
tycon [Type]
sc_theta [TyVar]
sc_sel_ids
tuple_con :: DataCon
tuple_con = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataConConstraint Name
dc_name [TyVar]
tvs [Type]
sc_theta TyCon
tycon
binders :: [TyConBinder]
binders = [Type] -> [TyConBinder]
mkTemplateAnonTyConBinders (Int -> Type -> [Type]
forall a. Int -> a -> [a]
replicate Int
arity Type
constraintKind)
roles :: [Role]
roles = Int -> Role -> [Role]
forall a. Int -> a -> [a]
replicate Int
arity Role
Nominal
rhs :: AlgTyConRhs
rhs = TupleTyCon{data_con :: DataCon
data_con = DataCon
tuple_con, tup_sort :: TupleSort
tup_sort = TupleSort
ConstraintTuple}
modu :: Module
modu = Module
gHC_CLASSES
tc_name :: Name
tc_name = Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
mkWiredInName Module
modu (NameSpace -> Int -> OccName
mkCTupleOcc NameSpace
tcName Int
arity) Unique
tc_uniq
(TyCon -> TyThing
ATyCon TyCon
tycon) BuiltInSyntax
BuiltInSyntax
dc_name :: Name
dc_name = Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
mkWiredInName Module
modu (NameSpace -> Int -> OccName
mkCTupleOcc NameSpace
dataName Int
arity) Unique
dc_uniq
(ConLike -> TyThing
AConLike (DataCon -> ConLike
RealDataCon DataCon
tuple_con)) BuiltInSyntax
BuiltInSyntax
tc_uniq :: Unique
tc_uniq = Int -> Unique
mkCTupleTyConUnique Int
arity
dc_uniq :: Unique
dc_uniq = Int -> Unique
mkCTupleDataConUnique Int
arity
tvs :: [TyVar]
tvs = [TyConBinder] -> [TyVar]
forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
binders
sc_theta :: [Type]
sc_theta = (TyVar -> Type) -> [TyVar] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map TyVar -> Type
mkTyVarTy [TyVar]
tvs
sc_sel_ids :: [TyVar]
sc_sel_ids = [Int -> TyVar
mk_sc_sel_id Int
sc_pos | Int
sc_pos <- [Int
0..Int
arityInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]
sc_sel_ids_arr :: Array Int TyVar
sc_sel_ids_arr = (Int, Int) -> [TyVar] -> Array Int TyVar
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
arityInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [TyVar]
sc_sel_ids
mk_sc_sel_id :: Int -> TyVar
mk_sc_sel_id Int
sc_pos =
let sc_sel_id_uniq :: Unique
sc_sel_id_uniq = Int -> Int -> Unique
mkCTupleSelIdUnique Int
sc_pos Int
arity
sc_sel_id_occ :: OccName
sc_sel_id_occ = NameSpace -> Int -> OccName
mkCTupleOcc NameSpace
tcName Int
arity
sc_sel_id_name :: Name
sc_sel_id_name = Module -> FastString -> Unique -> TyVar -> Name
mkWiredInIdName
Module
gHC_CLASSES
(OccName -> FastString
occNameFS (Int -> OccName -> OccName
mkSuperDictSelOcc Int
sc_pos OccName
sc_sel_id_occ))
Unique
sc_sel_id_uniq
TyVar
sc_sel_id
sc_sel_id :: TyVar
sc_sel_id = Name -> Class -> TyVar
mkDictSelId Name
sc_sel_id_name Class
klass
in TyVar
sc_sel_id
unitTyCon :: TyCon
unitTyCon :: TyCon
unitTyCon = Boxity -> Int -> TyCon
tupleTyCon Boxity
Boxed Int
0
unitTyConKey :: Unique
unitTyConKey :: Unique
unitTyConKey = TyCon -> Unique
forall a. Uniquable a => a -> Unique
getUnique TyCon
unitTyCon
unitDataCon :: DataCon
unitDataCon :: DataCon
unitDataCon = [DataCon] -> DataCon
forall a. HasCallStack => [a] -> a
head (TyCon -> [DataCon]
tyConDataCons TyCon
unitTyCon)
unitDataConId :: Id
unitDataConId :: TyVar
unitDataConId = DataCon -> TyVar
dataConWorkId DataCon
unitDataCon
soloTyCon :: TyCon
soloTyCon :: TyCon
soloTyCon = Boxity -> Int -> TyCon
tupleTyCon Boxity
Boxed Int
1
pairTyCon :: TyCon
pairTyCon :: TyCon
pairTyCon = Boxity -> Int -> TyCon
tupleTyCon Boxity
Boxed Int
2
unboxedUnitTy :: Type
unboxedUnitTy :: Type
unboxedUnitTy = TyCon -> Type
mkTyConTy TyCon
unboxedUnitTyCon
unboxedUnitTyCon :: TyCon
unboxedUnitTyCon :: TyCon
unboxedUnitTyCon = Boxity -> Int -> TyCon
tupleTyCon Boxity
Unboxed Int
0
unboxedUnitDataCon :: DataCon
unboxedUnitDataCon :: DataCon
unboxedUnitDataCon = Boxity -> Int -> DataCon
tupleDataCon Boxity
Unboxed Int
0
mkSumTyConOcc :: Arity -> OccName
mkSumTyConOcc :: Int -> OccName
mkSumTyConOcc Int
n = NameSpace -> [Char] -> OccName
mkOccName NameSpace
tcName [Char]
str
where
str :: [Char]
str = Char
'(' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'#' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
' ' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
bars [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" #)"
bars :: [Char]
bars = Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
intersperse Char
' ' ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Char
'|'
mkSumDataConOcc :: ConTag -> Arity -> OccName
mkSumDataConOcc :: Int -> Int -> OccName
mkSumDataConOcc Int
alt Int
n = NameSpace -> [Char] -> OccName
mkOccName NameSpace
dataName [Char]
str
where
str :: [Char]
str = Char
'(' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'#' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
' ' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Int -> [Char]
bars Int
alt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Char
'_' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Int -> [Char]
bars (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
alt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" #)"
bars :: Int -> [Char]
bars Int
i = Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
intersperse Char
' ' ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
i Char
'|'
sumTyCon :: Arity -> TyCon
sumTyCon :: Int -> TyCon
sumTyCon Int
arity
| Int
arity Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mAX_SUM_SIZE
= (TyCon, Array Int DataCon) -> TyCon
forall a b. (a, b) -> a
fst (Int -> (TyCon, Array Int DataCon)
mk_sum Int
arity)
| Int
arity Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
= [Char] -> TyCon
forall a. HasCallStack => [Char] -> a
panic ([Char]
"sumTyCon: Arity starts from 2. (arity: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
arity [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")")
| Bool
otherwise
= (TyCon, Array Int DataCon) -> TyCon
forall a b. (a, b) -> a
fst (Array Int (TyCon, Array Int DataCon)
unboxedSumArr Array Int (TyCon, Array Int DataCon)
-> Int -> (TyCon, Array Int DataCon)
forall i e. Ix i => Array i e -> i -> e
! Int
arity)
sumDataCon :: ConTag
-> Arity
-> DataCon
sumDataCon :: Int -> Int -> DataCon
sumDataCon Int
alt Int
arity
| Int
alt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
arity
= [Char] -> DataCon
forall a. HasCallStack => [Char] -> a
panic ([Char]
"sumDataCon: index out of bounds: alt: "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
alt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" > arity " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
arity)
| Int
alt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
= [Char] -> DataCon
forall a. HasCallStack => [Char] -> a
panic ([Char]
"sumDataCon: Alts start from 1. (alt: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
alt
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", arity: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
arity [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")")
| Int
arity Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
= [Char] -> DataCon
forall a. HasCallStack => [Char] -> a
panic ([Char]
"sumDataCon: Arity starts from 2. (alt: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
alt
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", arity: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
arity [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")")
| Int
arity Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mAX_SUM_SIZE
= (TyCon, Array Int DataCon) -> Array Int DataCon
forall a b. (a, b) -> b
snd (Int -> (TyCon, Array Int DataCon)
mk_sum Int
arity) Array Int DataCon -> Int -> DataCon
forall i e. Ix i => Array i e -> i -> e
! (Int
alt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
| Bool
otherwise
= (TyCon, Array Int DataCon) -> Array Int DataCon
forall a b. (a, b) -> b
snd (Array Int (TyCon, Array Int DataCon)
unboxedSumArr Array Int (TyCon, Array Int DataCon)
-> Int -> (TyCon, Array Int DataCon)
forall i e. Ix i => Array i e -> i -> e
! Int
arity) Array Int DataCon -> Int -> DataCon
forall i e. Ix i => Array i e -> i -> e
! (Int
alt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
unboxedSumArr :: Array Int (TyCon, Array Int DataCon)
unboxedSumArr :: Array Int (TyCon, Array Int DataCon)
unboxedSumArr = (Int, Int)
-> [(TyCon, Array Int DataCon)]
-> Array Int (TyCon, Array Int DataCon)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
2,Int
mAX_SUM_SIZE) [Int -> (TyCon, Array Int DataCon)
mk_sum Int
i | Int
i <- [Int
2..Int
mAX_SUM_SIZE]]
unboxedSumKind :: [Type] -> Kind
unboxedSumKind :: [Type] -> Type
unboxedSumKind = TyCon -> [Type] -> Type
unboxedTupleSumKind TyCon
sumRepDataConTyCon
mk_sum :: Arity -> (TyCon, Array ConTagZ DataCon)
mk_sum :: Int -> (TyCon, Array Int DataCon)
mk_sum Int
arity = (TyCon
tycon, Array Int DataCon
sum_cons)
where
tycon :: TyCon
tycon = Name -> [TyConBinder] -> Type -> [DataCon] -> AlgTyConFlav -> TyCon
mkSumTyCon Name
tc_name [TyConBinder]
tc_binders Type
tc_res_kind (Array Int DataCon -> [DataCon]
forall i e. Array i e -> [e]
elems Array Int DataCon
sum_cons)
AlgTyConFlav
UnboxedSumTyCon
tc_binders :: [TyConBinder]
tc_binders = [Type] -> ([Type] -> [Type]) -> [TyConBinder]
mkTemplateTyConBinders (Int -> Type -> [Type]
forall a. Int -> a -> [a]
replicate Int
arity Type
runtimeRepTy)
(\[Type]
ks -> (Type -> Type) -> [Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Type
mkTYPEapp [Type]
ks)
tyvars :: [TyVar]
tyvars = [TyConBinder] -> [TyVar]
forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
tc_binders
tc_res_kind :: Type
tc_res_kind = [Type] -> Type
unboxedSumKind [Type]
rr_tys
([Type]
rr_tys, [Type]
tyvar_tys) = Int -> [Type] -> ([Type], [Type])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
arity ([TyVar] -> [Type]
mkTyVarTys [TyVar]
tyvars)
tc_name :: Name
tc_name = Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
mkWiredInName Module
gHC_PRIM (Int -> OccName
mkSumTyConOcc Int
arity) Unique
tc_uniq
(TyCon -> TyThing
ATyCon TyCon
tycon) BuiltInSyntax
BuiltInSyntax
sum_cons :: Array Int DataCon
sum_cons = (Int, Int) -> [DataCon] -> Array Int DataCon
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
arityInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [Int -> DataCon
sum_con Int
i | Int
i <- [Int
0..Int
arityInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]
sum_con :: Int -> DataCon
sum_con Int
i = let dc :: DataCon
dc = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
dc_name
[TyVar]
tyvars
[[Type]
tyvar_tys [Type] -> Int -> Type
forall a. HasCallStack => [a] -> Int -> a
!! Int
i]
TyCon
tycon
dc_name :: Name
dc_name = Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
mkWiredInName Module
gHC_PRIM
(Int -> Int -> OccName
mkSumDataConOcc Int
i Int
arity)
(Int -> Unique
dc_uniq Int
i)
(ConLike -> TyThing
AConLike (DataCon -> ConLike
RealDataCon DataCon
dc))
BuiltInSyntax
BuiltInSyntax
in DataCon
dc
tc_uniq :: Unique
tc_uniq = Int -> Unique
mkSumTyConUnique Int
arity
dc_uniq :: Int -> Unique
dc_uniq Int
i = Int -> Int -> Unique
mkSumDataConUnique Int
i Int
arity
eqTyCon, heqTyCon, coercibleTyCon :: TyCon
eqClass, heqClass, coercibleClass :: Class
eqDataCon, heqDataCon, coercibleDataCon :: DataCon
eqSCSelId, heqSCSelId, coercibleSCSelId :: Id
(TyCon
eqTyCon, Class
eqClass, DataCon
eqDataCon, TyVar
eqSCSelId)
= (TyCon
tycon, Class
klass, DataCon
datacon, TyVar
sc_sel_id)
where
tycon :: TyCon
tycon = Name
-> [TyConBinder] -> [Role] -> AlgTyConRhs -> Class -> Name -> TyCon
mkClassTyCon Name
eqTyConName [TyConBinder]
binders [Role]
roles
AlgTyConRhs
rhs Class
klass
(Name -> Name
mkPrelTyConRepName Name
eqTyConName)
klass :: Class
klass = TyCon -> Type -> TyVar -> Class
mk_class TyCon
tycon Type
sc_pred TyVar
sc_sel_id
datacon :: DataCon
datacon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataConConstraint Name
eqDataConName [TyVar]
tvs [Type
sc_pred] TyCon
tycon
binders :: [TyConBinder]
binders = [Type] -> ([Type] -> [Type]) -> [TyConBinder]
mkTemplateTyConBinders [Type
liftedTypeKind] (\[Type
k] -> [Type
k,Type
k])
roles :: [Role]
roles = [Role
Nominal, Role
Nominal, Role
Nominal]
rhs :: AlgTyConRhs
rhs = [DataCon] -> AlgTyConRhs
mkDataTyConRhs [DataCon
datacon]
tvs :: [TyVar]
tvs@[TyVar
k,TyVar
a,TyVar
b] = [TyConBinder] -> [TyVar]
forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
binders
sc_pred :: Type
sc_pred = TyCon -> [Type] -> Type
mkTyConApp TyCon
eqPrimTyCon ([TyVar] -> [Type]
mkTyVarTys [TyVar
k,TyVar
k,TyVar
a,TyVar
b])
sc_sel_id :: TyVar
sc_sel_id = Name -> Class -> TyVar
mkDictSelId Name
eqSCSelIdName Class
klass
(TyCon
heqTyCon, Class
heqClass, DataCon
heqDataCon, TyVar
heqSCSelId)
= (TyCon
tycon, Class
klass, DataCon
datacon, TyVar
sc_sel_id)
where
tycon :: TyCon
tycon = Name
-> [TyConBinder] -> [Role] -> AlgTyConRhs -> Class -> Name -> TyCon
mkClassTyCon Name
heqTyConName [TyConBinder]
binders [Role]
roles
AlgTyConRhs
rhs Class
klass
(Name -> Name
mkPrelTyConRepName Name
heqTyConName)
klass :: Class
klass = TyCon -> Type -> TyVar -> Class
mk_class TyCon
tycon Type
sc_pred TyVar
sc_sel_id
datacon :: DataCon
datacon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataConConstraint Name
heqDataConName [TyVar]
tvs [Type
sc_pred] TyCon
tycon
binders :: [TyConBinder]
binders = [Type] -> ([Type] -> [Type]) -> [TyConBinder]
mkTemplateTyConBinders [Type
liftedTypeKind, Type
liftedTypeKind] [Type] -> [Type]
forall a. a -> a
id
roles :: [Role]
roles = [Role
Nominal, Role
Nominal, Role
Nominal, Role
Nominal]
rhs :: AlgTyConRhs
rhs = [DataCon] -> AlgTyConRhs
mkDataTyConRhs [DataCon
datacon]
tvs :: [TyVar]
tvs = [TyConBinder] -> [TyVar]
forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
binders
sc_pred :: Type
sc_pred = TyCon -> [Type] -> Type
mkTyConApp TyCon
eqPrimTyCon ([TyVar] -> [Type]
mkTyVarTys [TyVar]
tvs)
sc_sel_id :: TyVar
sc_sel_id = Name -> Class -> TyVar
mkDictSelId Name
heqSCSelIdName Class
klass
(TyCon
coercibleTyCon, Class
coercibleClass, DataCon
coercibleDataCon, TyVar
coercibleSCSelId)
= (TyCon
tycon, Class
klass, DataCon
datacon, TyVar
sc_sel_id)
where
tycon :: TyCon
tycon = Name
-> [TyConBinder] -> [Role] -> AlgTyConRhs -> Class -> Name -> TyCon
mkClassTyCon Name
coercibleTyConName [TyConBinder]
binders [Role]
roles
AlgTyConRhs
rhs Class
klass
(Name -> Name
mkPrelTyConRepName Name
coercibleTyConName)
klass :: Class
klass = TyCon -> Type -> TyVar -> Class
mk_class TyCon
tycon Type
sc_pred TyVar
sc_sel_id
datacon :: DataCon
datacon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataConConstraint Name
coercibleDataConName [TyVar]
tvs [Type
sc_pred] TyCon
tycon
binders :: [TyConBinder]
binders = [Type] -> ([Type] -> [Type]) -> [TyConBinder]
mkTemplateTyConBinders [Type
liftedTypeKind] (\[Type
k] -> [Type
k,Type
k])
roles :: [Role]
roles = [Role
Nominal, Role
Representational, Role
Representational]
rhs :: AlgTyConRhs
rhs = [DataCon] -> AlgTyConRhs
mkDataTyConRhs [DataCon
datacon]
tvs :: [TyVar]
tvs@[TyVar
k,TyVar
a,TyVar
b] = [TyConBinder] -> [TyVar]
forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
binders
sc_pred :: Type
sc_pred = TyCon -> [Type] -> Type
mkTyConApp TyCon
eqReprPrimTyCon ([TyVar] -> [Type]
mkTyVarTys [TyVar
k, TyVar
k, TyVar
a, TyVar
b])
sc_sel_id :: TyVar
sc_sel_id = Name -> Class -> TyVar
mkDictSelId Name
coercibleSCSelIdName Class
klass
mk_class :: TyCon -> PredType -> Id -> Class
mk_class :: TyCon -> Type -> TyVar -> Class
mk_class TyCon
tycon Type
sc_pred TyVar
sc_sel_id
= Name
-> [TyVar]
-> [FunDep TyVar]
-> [Type]
-> [TyVar]
-> [ClassATItem]
-> [ClassOpItem]
-> ClassMinimalDef
-> TyCon
-> Class
mkClass (TyCon -> Name
tyConName TyCon
tycon) (TyCon -> [TyVar]
tyConTyVars TyCon
tycon) [] [Type
sc_pred] [TyVar
sc_sel_id]
[] [] ([LBooleanFormula Name] -> ClassMinimalDef
forall a. Eq a => [LBooleanFormula a] -> BooleanFormula a
mkAnd []) TyCon
tycon
mk_ctuple_class :: TyCon -> ThetaType -> [Id] -> Class
mk_ctuple_class :: TyCon -> [Type] -> [TyVar] -> Class
mk_ctuple_class TyCon
tycon [Type]
sc_theta [TyVar]
sc_sel_ids
= Name
-> [TyVar]
-> [FunDep TyVar]
-> [Type]
-> [TyVar]
-> [ClassATItem]
-> [ClassOpItem]
-> ClassMinimalDef
-> TyCon
-> Class
mkClass (TyCon -> Name
tyConName TyCon
tycon) (TyCon -> [TyVar]
tyConTyVars TyCon
tycon) [] [Type]
sc_theta [TyVar]
sc_sel_ids
[] [] ([LBooleanFormula Name] -> ClassMinimalDef
forall a. Eq a => [LBooleanFormula a] -> BooleanFormula a
mkAnd []) TyCon
tycon
multiplicityTyConName :: Name
multiplicityTyConName :: Name
multiplicityTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Multiplicity")
Unique
multiplicityTyConKey TyCon
multiplicityTyCon
oneDataConName, manyDataConName :: Name
oneDataConName :: Name
oneDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"One") Unique
oneDataConKey DataCon
oneDataCon
manyDataConName :: Name
manyDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Many") Unique
manyDataConKey DataCon
manyDataCon
multiplicityTy :: Type
multiplicityTy :: Type
multiplicityTy = TyCon -> Type
mkTyConTy TyCon
multiplicityTyCon
multiplicityTyCon :: TyCon
multiplicityTyCon :: TyCon
multiplicityTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
multiplicityTyConName Maybe CType
forall a. Maybe a
Nothing []
[DataCon
oneDataCon, DataCon
manyDataCon]
oneDataCon, manyDataCon :: DataCon
oneDataCon :: DataCon
oneDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
oneDataConName [] [] TyCon
multiplicityTyCon
manyDataCon :: DataCon
manyDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
manyDataConName [] [] TyCon
multiplicityTyCon
oneDataConTy, manyDataConTy :: Type
oneDataConTy :: Type
oneDataConTy = TyCon -> Type
mkTyConTy TyCon
oneDataConTyCon
manyDataConTy :: Type
manyDataConTy = TyCon -> Type
mkTyConTy TyCon
manyDataConTyCon
oneDataConTyCon, manyDataConTyCon :: TyCon
oneDataConTyCon :: TyCon
oneDataConTyCon = DataCon -> TyCon
promoteDataCon DataCon
oneDataCon
manyDataConTyCon :: TyCon
manyDataConTyCon = DataCon -> TyCon
promoteDataCon DataCon
manyDataCon
multMulTyConName :: Name
multMulTyConName :: Name
multMulTyConName =
BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"MultMul") Unique
multMulTyConKey TyCon
multMulTyCon
multMulTyCon :: TyCon
multMulTyCon :: TyCon
multMulTyCon = Name
-> [TyConBinder]
-> Type
-> Maybe Name
-> FamTyConFlav
-> Maybe Class
-> Injectivity
-> TyCon
mkFamilyTyCon Name
multMulTyConName [TyConBinder]
binders Type
multiplicityTy Maybe Name
forall a. Maybe a
Nothing
(BuiltInSynFamily -> FamTyConFlav
BuiltInSynFamTyCon BuiltInSynFamily
trivialBuiltInFamily)
Maybe Class
forall a. Maybe a
Nothing
Injectivity
NotInjective
where
binders :: [TyConBinder]
binders = [Type] -> [TyConBinder]
mkTemplateAnonTyConBinders [Type
multiplicityTy, Type
multiplicityTy]
unrestrictedFunTyCon :: TyCon
unrestrictedFunTyCon :: TyCon
unrestrictedFunTyCon
= Name -> [TyConBinder] -> Type -> [Role] -> Type -> TyCon
buildSynTyCon Name
unrestrictedFunTyConName [] Type
arrowKind []
(TyCon -> [Type] -> Type
TyCoRep.TyConApp TyCon
fUNTyCon [Type
manyDataConTy])
where
arrowKind :: Type
arrowKind = [TyConBinder] -> Type -> Type
mkTyConKind [TyConBinder]
binders Type
liftedTypeKind
binders :: [TyConBinder]
binders = [ TyVar -> TyConBndrVis -> TyConBinder
forall var argf. var -> argf -> VarBndr var argf
Bndr TyVar
runtimeRep1TyVar (ForAllTyFlag -> TyConBndrVis
NamedTCB ForAllTyFlag
Inferred)
, TyVar -> TyConBndrVis -> TyConBinder
forall var argf. var -> argf -> VarBndr var argf
Bndr TyVar
runtimeRep2TyVar (ForAllTyFlag -> TyConBndrVis
NamedTCB ForAllTyFlag
Inferred) ]
[TyConBinder] -> [TyConBinder] -> [TyConBinder]
forall a. [a] -> [a] -> [a]
++ [Type] -> [TyConBinder]
mkTemplateAnonTyConBinders [ Type -> Type
mkTYPEapp Type
runtimeRep1Ty
, Type -> Type
mkTYPEapp Type
runtimeRep2Ty ]
unrestrictedFunTyConName :: Name
unrestrictedFunTyConName :: Name
unrestrictedFunTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
BuiltInSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"->")
Unique
unrestrictedFunTyConKey TyCon
unrestrictedFunTyCon
constraintKindTyCon :: TyCon
constraintKindTyCon :: TyCon
constraintKindTyCon
= Name -> [TyConBinder] -> Type -> [Role] -> Type -> TyCon
buildSynTyCon Name
constraintKindTyConName [] Type
liftedTypeKind [] Type
rhs
where
rhs :: Type
rhs = TyCon -> [Type] -> Type
TyCoRep.TyConApp TyCon
cONSTRAINTTyCon [Type
liftedRepTy]
constraintKindTyConName :: Name
constraintKindTyConName :: Name
constraintKindTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Constraint")
Unique
constraintKindTyConKey TyCon
constraintKindTyCon
constraintKind :: Kind
constraintKind :: Type
constraintKind = TyCon -> Type
mkTyConTy TyCon
constraintKindTyCon
liftedTypeKindTyCon :: TyCon
liftedTypeKindTyCon :: TyCon
liftedTypeKindTyCon
= Name -> [TyConBinder] -> Type -> [Role] -> Type -> TyCon
buildSynTyCon Name
liftedTypeKindTyConName [] Type
liftedTypeKind [] Type
rhs
where
rhs :: Type
rhs = TyCon -> [Type] -> Type
TyCoRep.TyConApp TyCon
tYPETyCon [Type
liftedRepTy]
liftedTypeKindTyConName :: Name
liftedTypeKindTyConName :: Name
liftedTypeKindTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Type")
Unique
liftedTypeKindTyConKey TyCon
liftedTypeKindTyCon
liftedTypeKind, typeToTypeKind :: Type
liftedTypeKind :: Type
liftedTypeKind = TyCon -> Type
mkTyConTy TyCon
liftedTypeKindTyCon
typeToTypeKind :: Type
typeToTypeKind = Type
liftedTypeKind (() :: Constraint) => Type -> Type -> Type
Type -> Type -> Type
`mkVisFunTyMany` Type
liftedTypeKind
unliftedTypeKindTyCon :: TyCon
unliftedTypeKindTyCon :: TyCon
unliftedTypeKindTyCon
= Name -> [TyConBinder] -> Type -> [Role] -> Type -> TyCon
buildSynTyCon Name
unliftedTypeKindTyConName [] Type
liftedTypeKind [] Type
rhs
where
rhs :: Type
rhs = TyCon -> [Type] -> Type
TyCoRep.TyConApp TyCon
tYPETyCon [Type
unliftedRepTy]
unliftedTypeKindTyConName :: Name
unliftedTypeKindTyConName :: Name
unliftedTypeKindTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"UnliftedType")
Unique
unliftedTypeKindTyConKey TyCon
unliftedTypeKindTyCon
unliftedTypeKind :: Type
unliftedTypeKind :: Type
unliftedTypeKind = TyCon -> Type
mkTyConTy TyCon
unliftedTypeKindTyCon
levityTyConName, liftedDataConName, unliftedDataConName :: Name
levityTyConName :: Name
levityTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Levity") Unique
levityTyConKey TyCon
levityTyCon
liftedDataConName :: Name
liftedDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Lifted") Unique
liftedDataConKey DataCon
liftedDataCon
unliftedDataConName :: Name
unliftedDataConName = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"Unlifted") Unique
unliftedDataConKey DataCon
unliftedDataCon
levityTyCon :: TyCon
levityTyCon :: TyCon
levityTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
levityTyConName Maybe CType
forall a. Maybe a
Nothing [] [DataCon
liftedDataCon,DataCon
unliftedDataCon]
levityTy :: Type
levityTy :: Type
levityTy = TyCon -> Type
mkTyConTy TyCon
levityTyCon
liftedDataCon, unliftedDataCon :: DataCon
liftedDataCon :: DataCon
liftedDataCon = Name -> [Type] -> TyCon -> PromDataConInfo -> DataCon
pcSpecialDataCon Name
liftedDataConName
[] TyCon
levityTyCon (Levity -> PromDataConInfo
Levity Levity
Lifted)
unliftedDataCon :: DataCon
unliftedDataCon = Name -> [Type] -> TyCon -> PromDataConInfo -> DataCon
pcSpecialDataCon Name
unliftedDataConName
[] TyCon
levityTyCon (Levity -> PromDataConInfo
Levity Levity
Unlifted)
liftedDataConTyCon :: TyCon
liftedDataConTyCon :: TyCon
liftedDataConTyCon = DataCon -> TyCon
promoteDataCon DataCon
liftedDataCon
unliftedDataConTyCon :: TyCon
unliftedDataConTyCon :: TyCon
unliftedDataConTyCon = DataCon -> TyCon
promoteDataCon DataCon
unliftedDataCon
liftedDataConTy :: Type
liftedDataConTy :: Type
liftedDataConTy = TyCon -> Type
mkTyConTy TyCon
liftedDataConTyCon
unliftedDataConTy :: Type
unliftedDataConTy :: Type
unliftedDataConTy = TyCon -> Type
mkTyConTy TyCon
unliftedDataConTyCon
runtimeRepTyCon :: TyCon
runtimeRepTyCon :: TyCon
runtimeRepTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
runtimeRepTyConName Maybe CType
forall a. Maybe a
Nothing []
(DataCon
vecRepDataCon DataCon -> [DataCon] -> [DataCon]
forall a. a -> [a] -> [a]
: DataCon
tupleRepDataCon DataCon -> [DataCon] -> [DataCon]
forall a. a -> [a] -> [a]
:
DataCon
sumRepDataCon DataCon -> [DataCon] -> [DataCon]
forall a. a -> [a] -> [a]
: DataCon
boxedRepDataCon DataCon -> [DataCon] -> [DataCon]
forall a. a -> [a] -> [a]
:
[DataCon]
runtimeRepSimpleDataCons)
runtimeRepTy :: Type
runtimeRepTy :: Type
runtimeRepTy = TyCon -> Type
mkTyConTy TyCon
runtimeRepTyCon
runtimeRepTyConName, vecRepDataConName, tupleRepDataConName, sumRepDataConName, boxedRepDataConName :: Name
runtimeRepTyConName :: Name
runtimeRepTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"RuntimeRep") Unique
runtimeRepTyConKey TyCon
runtimeRepTyCon
vecRepDataConName :: Name
vecRepDataConName = FastString -> Unique -> DataCon -> Name
mk_runtime_rep_dc_name ([Char] -> FastString
fsLit [Char]
"VecRep") Unique
vecRepDataConKey DataCon
vecRepDataCon
tupleRepDataConName :: Name
tupleRepDataConName = FastString -> Unique -> DataCon -> Name
mk_runtime_rep_dc_name ([Char] -> FastString
fsLit [Char]
"TupleRep") Unique
tupleRepDataConKey DataCon
tupleRepDataCon
sumRepDataConName :: Name
sumRepDataConName = FastString -> Unique -> DataCon -> Name
mk_runtime_rep_dc_name ([Char] -> FastString
fsLit [Char]
"SumRep") Unique
sumRepDataConKey DataCon
sumRepDataCon
boxedRepDataConName :: Name
boxedRepDataConName = FastString -> Unique -> DataCon -> Name
mk_runtime_rep_dc_name ([Char] -> FastString
fsLit [Char]
"BoxedRep") Unique
boxedRepDataConKey DataCon
boxedRepDataCon
mk_runtime_rep_dc_name :: FastString -> Unique -> DataCon -> Name
mk_runtime_rep_dc_name :: FastString -> Unique -> DataCon -> Name
mk_runtime_rep_dc_name FastString
fs Unique
u DataCon
dc = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES FastString
fs Unique
u DataCon
dc
boxedRepDataCon :: DataCon
boxedRepDataCon :: DataCon
boxedRepDataCon = Name -> [Type] -> TyCon -> PromDataConInfo -> DataCon
pcSpecialDataCon Name
boxedRepDataConName
[ Type
levityTy ] TyCon
runtimeRepTyCon (([Type] -> [PrimRep]) -> PromDataConInfo
RuntimeRep [Type] -> [PrimRep]
prim_rep_fun)
where
prim_rep_fun :: [Type] -> [PrimRep]
prim_rep_fun [Type
lev]
= case TyCon -> PromDataConInfo
tyConPromDataConInfo ((() :: Constraint) => Type -> TyCon
Type -> TyCon
tyConAppTyCon Type
lev) of
Levity Levity
Lifted -> [PrimRep
LiftedRep]
Levity Levity
Unlifted -> [PrimRep
UnliftedRep]
PromDataConInfo
_ -> [Char] -> SDoc -> [PrimRep]
forall a. HasCallStack => [Char] -> SDoc -> a
pprPanic [Char]
"boxedRepDataCon" (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
lev)
prim_rep_fun [Type]
args
= [Char] -> SDoc -> [PrimRep]
forall a. HasCallStack => [Char] -> SDoc -> a
pprPanic [Char]
"boxedRepDataCon" ([Type] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type]
args)
boxedRepDataConTyCon :: TyCon
boxedRepDataConTyCon :: TyCon
boxedRepDataConTyCon = DataCon -> TyCon
promoteDataCon DataCon
boxedRepDataCon
tupleRepDataCon :: DataCon
tupleRepDataCon :: DataCon
tupleRepDataCon = Name -> [Type] -> TyCon -> PromDataConInfo -> DataCon
pcSpecialDataCon Name
tupleRepDataConName [ Type -> Type
mkListTy Type
runtimeRepTy ]
TyCon
runtimeRepTyCon (([Type] -> [PrimRep]) -> PromDataConInfo
RuntimeRep [Type] -> [PrimRep]
prim_rep_fun)
where
prim_rep_fun :: [Type] -> [PrimRep]
prim_rep_fun [Type
rr_ty_list]
= (Type -> [PrimRep]) -> [Type] -> [PrimRep]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((() :: Constraint) => SDoc -> Type -> [PrimRep]
SDoc -> Type -> [PrimRep]
runtimeRepPrimRep SDoc
doc) [Type]
rr_tys
where
rr_tys :: [Type]
rr_tys = Type -> [Type]
extractPromotedList Type
rr_ty_list
doc :: SDoc
doc = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"tupleRepDataCon" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Type] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type]
rr_tys
prim_rep_fun [Type]
args
= [Char] -> SDoc -> [PrimRep]
forall a. HasCallStack => [Char] -> SDoc -> a
pprPanic [Char]
"tupleRepDataCon" ([Type] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type]
args)
tupleRepDataConTyCon :: TyCon
tupleRepDataConTyCon :: TyCon
tupleRepDataConTyCon = DataCon -> TyCon
promoteDataCon DataCon
tupleRepDataCon
sumRepDataCon :: DataCon
sumRepDataCon :: DataCon
sumRepDataCon = Name -> [Type] -> TyCon -> PromDataConInfo -> DataCon
pcSpecialDataCon Name
sumRepDataConName [ Type -> Type
mkListTy Type
runtimeRepTy ]
TyCon
runtimeRepTyCon (([Type] -> [PrimRep]) -> PromDataConInfo
RuntimeRep [Type] -> [PrimRep]
prim_rep_fun)
where
prim_rep_fun :: [Type] -> [PrimRep]
prim_rep_fun [Type
rr_ty_list]
= (SlotTy -> PrimRep) -> [SlotTy] -> [PrimRep]
forall a b. (a -> b) -> [a] -> [b]
map SlotTy -> PrimRep
slotPrimRep (NonEmpty SlotTy -> [SlotTy]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([[PrimRep]] -> NonEmpty SlotTy
ubxSumRepType [[PrimRep]]
prim_repss))
where
rr_tys :: [Type]
rr_tys = Type -> [Type]
extractPromotedList Type
rr_ty_list
doc :: SDoc
doc = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"sumRepDataCon" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Type] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type]
rr_tys
prim_repss :: [[PrimRep]]
prim_repss = (Type -> [PrimRep]) -> [Type] -> [[PrimRep]]
forall a b. (a -> b) -> [a] -> [b]
map ((() :: Constraint) => SDoc -> Type -> [PrimRep]
SDoc -> Type -> [PrimRep]
runtimeRepPrimRep SDoc
doc) [Type]
rr_tys
prim_rep_fun [Type]
args
= [Char] -> SDoc -> [PrimRep]
forall a. HasCallStack => [Char] -> SDoc -> a
pprPanic [Char]
"sumRepDataCon" ([Type] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type]
args)
sumRepDataConTyCon :: TyCon
sumRepDataConTyCon :: TyCon
sumRepDataConTyCon = DataCon -> TyCon
promoteDataCon DataCon
sumRepDataCon
runtimeRepSimpleDataCons :: [DataCon]
runtimeRepSimpleDataCons :: [DataCon]
runtimeRepSimpleDataCons
= (Unique -> (FastString, PrimRep) -> DataCon)
-> [Unique] -> [(FastString, PrimRep)] -> [DataCon]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Unique -> (FastString, PrimRep) -> DataCon
mk_runtime_rep_dc [Unique]
runtimeRepSimpleDataConKeys
[ ([Char] -> FastString
fsLit [Char]
"IntRep", PrimRep
IntRep)
, ([Char] -> FastString
fsLit [Char]
"Int8Rep", PrimRep
Int8Rep)
, ([Char] -> FastString
fsLit [Char]
"Int16Rep", PrimRep
Int16Rep)
, ([Char] -> FastString
fsLit [Char]
"Int32Rep", PrimRep
Int32Rep)
, ([Char] -> FastString
fsLit [Char]
"Int64Rep", PrimRep
Int64Rep)
, ([Char] -> FastString
fsLit [Char]
"WordRep", PrimRep
WordRep)
, ([Char] -> FastString
fsLit [Char]
"Word8Rep", PrimRep
Word8Rep)
, ([Char] -> FastString
fsLit [Char]
"Word16Rep", PrimRep
Word16Rep)
, ([Char] -> FastString
fsLit [Char]
"Word32Rep", PrimRep
Word32Rep)
, ([Char] -> FastString
fsLit [Char]
"Word64Rep", PrimRep
Word64Rep)
, ([Char] -> FastString
fsLit [Char]
"AddrRep", PrimRep
AddrRep)
, ([Char] -> FastString
fsLit [Char]
"FloatRep", PrimRep
FloatRep)
, ([Char] -> FastString
fsLit [Char]
"DoubleRep", PrimRep
DoubleRep) ]
where
mk_runtime_rep_dc :: Unique -> (FastString, PrimRep) -> DataCon
mk_runtime_rep_dc :: Unique -> (FastString, PrimRep) -> DataCon
mk_runtime_rep_dc Unique
uniq (FastString
fs, PrimRep
primrep)
= DataCon
data_con
where
data_con :: DataCon
data_con = Name -> [Type] -> TyCon -> PromDataConInfo -> DataCon
pcSpecialDataCon Name
dc_name [] TyCon
runtimeRepTyCon (([Type] -> [PrimRep]) -> PromDataConInfo
RuntimeRep (\[Type]
_ -> [PrimRep
primrep]))
dc_name :: Name
dc_name = FastString -> Unique -> DataCon -> Name
mk_runtime_rep_dc_name FastString
fs Unique
uniq DataCon
data_con
intRepDataConTy,
int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy,
wordRepDataConTy,
word8RepDataConTy, word16RepDataConTy, word32RepDataConTy, word64RepDataConTy,
addrRepDataConTy,
floatRepDataConTy, doubleRepDataConTy :: RuntimeRepType
[Type
intRepDataConTy,
Type
int8RepDataConTy, Type
int16RepDataConTy, Type
int32RepDataConTy, Type
int64RepDataConTy,
Type
wordRepDataConTy,
Type
word8RepDataConTy, Type
word16RepDataConTy, Type
word32RepDataConTy, Type
word64RepDataConTy,
Type
addrRepDataConTy,
Type
floatRepDataConTy, Type
doubleRepDataConTy
]
= (DataCon -> Type) -> [DataCon] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map (TyCon -> Type
mkTyConTy (TyCon -> Type) -> (DataCon -> TyCon) -> DataCon -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataCon -> TyCon
promoteDataCon) [DataCon]
runtimeRepSimpleDataCons
zeroBitRepTyCon :: TyCon
zeroBitRepTyCon :: TyCon
zeroBitRepTyCon
= Name -> [TyConBinder] -> Type -> [Role] -> Type -> TyCon
buildSynTyCon Name
zeroBitRepTyConName [] Type
runtimeRepTy [] Type
rhs
where
rhs :: Type
rhs = TyCon -> [Type] -> Type
TyCoRep.TyConApp TyCon
tupleRepDataConTyCon [Type -> [Type] -> Type
mkPromotedListTy Type
runtimeRepTy []]
zeroBitRepTyConName :: Name
zeroBitRepTyConName :: Name
zeroBitRepTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"ZeroBitRep")
Unique
zeroBitRepTyConKey TyCon
zeroBitRepTyCon
zeroBitRepTy :: RuntimeRepType
zeroBitRepTy :: Type
zeroBitRepTy = TyCon -> Type
mkTyConTy TyCon
zeroBitRepTyCon
zeroBitTypeTyCon :: TyCon
zeroBitTypeTyCon :: TyCon
zeroBitTypeTyCon
= Name -> [TyConBinder] -> Type -> [Role] -> Type -> TyCon
buildSynTyCon Name
zeroBitTypeTyConName [] Type
liftedTypeKind [] Type
rhs
where
rhs :: Type
rhs = TyCon -> [Type] -> Type
TyCoRep.TyConApp TyCon
tYPETyCon [Type
zeroBitRepTy]
zeroBitTypeTyConName :: Name
zeroBitTypeTyConName :: Name
zeroBitTypeTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"ZeroBitType")
Unique
zeroBitTypeTyConKey TyCon
zeroBitTypeTyCon
zeroBitTypeKind :: Type
zeroBitTypeKind :: Type
zeroBitTypeKind = TyCon -> Type
mkTyConTy TyCon
zeroBitTypeTyCon
liftedRepTyCon :: TyCon
liftedRepTyCon :: TyCon
liftedRepTyCon
= Name -> [TyConBinder] -> Type -> [Role] -> Type -> TyCon
buildSynTyCon Name
liftedRepTyConName [] Type
runtimeRepTy [] Type
rhs
where
rhs :: Type
rhs = TyCon -> [Type] -> Type
TyCoRep.TyConApp TyCon
boxedRepDataConTyCon [Type
liftedDataConTy]
liftedRepTyConName :: Name
liftedRepTyConName :: Name
liftedRepTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"LiftedRep")
Unique
liftedRepTyConKey TyCon
liftedRepTyCon
liftedRepTy :: RuntimeRepType
liftedRepTy :: Type
liftedRepTy = TyCon -> Type
mkTyConTy TyCon
liftedRepTyCon
unliftedRepTyCon :: TyCon
unliftedRepTyCon :: TyCon
unliftedRepTyCon
= Name -> [TyConBinder] -> Type -> [Role] -> Type -> TyCon
buildSynTyCon Name
unliftedRepTyConName [] Type
runtimeRepTy [] Type
rhs
where
rhs :: Type
rhs = TyCon -> [Type] -> Type
TyCoRep.TyConApp TyCon
boxedRepDataConTyCon [Type
unliftedDataConTy]
unliftedRepTyConName :: Name
unliftedRepTyConName :: Name
unliftedRepTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"UnliftedRep")
Unique
unliftedRepTyConKey TyCon
unliftedRepTyCon
unliftedRepTy :: RuntimeRepType
unliftedRepTy :: Type
unliftedRepTy = TyCon -> Type
mkTyConTy TyCon
unliftedRepTyCon
vecCountTyConName :: Name
vecCountTyConName :: Name
vecCountTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"VecCount") Unique
vecCountTyConKey TyCon
vecCountTyCon
vecElemTyConName :: Name
vecElemTyConName :: Name
vecElemTyConName = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES ([Char] -> FastString
fsLit [Char]
"VecElem") Unique
vecElemTyConKey TyCon
vecElemTyCon
vecRepDataCon :: DataCon
vecRepDataCon :: DataCon
vecRepDataCon = Name -> [Type] -> TyCon -> PromDataConInfo -> DataCon
pcSpecialDataCon Name
vecRepDataConName [ TyCon -> Type
mkTyConTy TyCon
vecCountTyCon
, TyCon -> Type
mkTyConTy TyCon
vecElemTyCon ]
TyCon
runtimeRepTyCon
(([Type] -> [PrimRep]) -> PromDataConInfo
RuntimeRep [Type] -> [PrimRep]
prim_rep_fun)
where
prim_rep_fun :: [Type] -> [PrimRep]
prim_rep_fun [Type
count, Type
elem]
| VecCount Int
n <- TyCon -> PromDataConInfo
tyConPromDataConInfo ((() :: Constraint) => Type -> TyCon
Type -> TyCon
tyConAppTyCon Type
count)
, VecElem PrimElemRep
e <- TyCon -> PromDataConInfo
tyConPromDataConInfo ((() :: Constraint) => Type -> TyCon
Type -> TyCon
tyConAppTyCon Type
elem)
= [Int -> PrimElemRep -> PrimRep
VecRep Int
n PrimElemRep
e]
prim_rep_fun [Type]
args
= [Char] -> SDoc -> [PrimRep]
forall a. HasCallStack => [Char] -> SDoc -> a
pprPanic [Char]
"vecRepDataCon" ([Type] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type]
args)
vecRepDataConTyCon :: TyCon
vecRepDataConTyCon :: TyCon
vecRepDataConTyCon = DataCon -> TyCon
promoteDataCon DataCon
vecRepDataCon
vecCountTyCon :: TyCon
vecCountTyCon :: TyCon
vecCountTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
vecCountTyConName Maybe CType
forall a. Maybe a
Nothing [] [DataCon]
vecCountDataCons
vecCountDataCons :: [DataCon]
vecCountDataCons :: [DataCon]
vecCountDataCons = (Int -> Unique -> DataCon) -> [Int] -> [Unique] -> [DataCon]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Unique -> DataCon
mk_vec_count_dc [Int
1..Int
6] [Unique]
vecCountDataConKeys
where
mk_vec_count_dc :: Int -> Unique -> DataCon
mk_vec_count_dc Int
logN Unique
key = DataCon
con
where
n :: Int
n = Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
logN :: Int)
name :: Name
name = FastString -> Unique -> DataCon -> Name
mk_runtime_rep_dc_name ([Char] -> FastString
fsLit ([Char]
"Vec" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n)) Unique
key DataCon
con
con :: DataCon
con = Name -> [Type] -> TyCon -> PromDataConInfo -> DataCon
pcSpecialDataCon Name
name [] TyCon
vecCountTyCon (Int -> PromDataConInfo
VecCount Int
n)
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
vecElemDataCons :: [DataCon]
vecElemDataCons :: [DataCon]
vecElemDataCons = (FastString -> PrimElemRep -> Unique -> DataCon)
-> [FastString] -> [PrimElemRep] -> [Unique] -> [DataCon]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 FastString -> PrimElemRep -> Unique -> DataCon
mk_vec_elem_dc
[ [Char] -> FastString
fsLit [Char]
"Int8ElemRep", [Char] -> FastString
fsLit [Char]
"Int16ElemRep", [Char] -> FastString
fsLit [Char]
"Int32ElemRep", [Char] -> FastString
fsLit [Char]
"Int64ElemRep"
, [Char] -> FastString
fsLit [Char]
"Word8ElemRep", [Char] -> FastString
fsLit [Char]
"Word16ElemRep", [Char] -> FastString
fsLit [Char]
"Word32ElemRep", [Char] -> FastString
fsLit [Char]
"Word64ElemRep"
, [Char] -> FastString
fsLit [Char]
"FloatElemRep", [Char] -> FastString
fsLit [Char]
"DoubleElemRep" ]
[ PrimElemRep
Int8ElemRep, PrimElemRep
Int16ElemRep, PrimElemRep
Int32ElemRep, PrimElemRep
Int64ElemRep
, PrimElemRep
Word8ElemRep, PrimElemRep
Word16ElemRep, PrimElemRep
Word32ElemRep, PrimElemRep
Word64ElemRep
, PrimElemRep
FloatElemRep, PrimElemRep
DoubleElemRep ]
[Unique]
vecElemDataConKeys
where
mk_vec_elem_dc :: FastString -> PrimElemRep -> Unique -> DataCon
mk_vec_elem_dc FastString
nameFs PrimElemRep
elemRep Unique
key = DataCon
con
where
name :: Name
name = FastString -> Unique -> DataCon -> Name
mk_runtime_rep_dc_name FastString
nameFs Unique
key DataCon
con
con :: DataCon
con = Name -> [Type] -> TyCon -> PromDataConInfo -> DataCon
pcSpecialDataCon Name
name [] TyCon
vecElemTyCon (PrimElemRep -> PromDataConInfo
VecElem PrimElemRep
elemRep)
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
charTy :: Type
charTy :: Type
charTy = TyCon -> Type
mkTyConTy TyCon
charTyCon
charTyCon :: TyCon
charTyCon :: TyCon
charTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
charTyConName
(CType -> Maybe CType
forall a. a -> Maybe a
Just (SourceText -> Maybe Header -> (SourceText, FastString) -> CType
CType SourceText
NoSourceText Maybe Header
forall a. Maybe a
Nothing
(SourceText
NoSourceText,[Char] -> FastString
fsLit [Char]
"HsChar")))
[] [DataCon
charDataCon]
charDataCon :: DataCon
charDataCon :: DataCon
charDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
charDataConName [] [Type
charPrimTy] TyCon
charTyCon
stringTy :: Type
stringTy :: Type
stringTy = TyCon -> Type
mkTyConTy TyCon
stringTyCon
stringTyCon :: TyCon
stringTyCon :: TyCon
stringTyCon = Name -> [TyConBinder] -> Type -> [Role] -> Type -> TyCon
buildSynTyCon Name
stringTyConName
[] Type
liftedTypeKind []
(Type -> Type
mkListTy Type
charTy)
intTy :: Type
intTy :: Type
intTy = TyCon -> Type
mkTyConTy TyCon
intTyCon
intTyCon :: TyCon
intTyCon :: TyCon
intTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
intTyConName
(CType -> Maybe CType
forall a. a -> Maybe a
Just (SourceText -> Maybe Header -> (SourceText, FastString) -> CType
CType SourceText
NoSourceText Maybe Header
forall a. Maybe a
Nothing (SourceText
NoSourceText,[Char] -> FastString
fsLit [Char]
"HsInt")))
[] [DataCon
intDataCon]
intDataCon :: DataCon
intDataCon :: DataCon
intDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
intDataConName [] [Type
intPrimTy] TyCon
intTyCon
wordTy :: Type
wordTy :: Type
wordTy = TyCon -> Type
mkTyConTy TyCon
wordTyCon
wordTyCon :: TyCon
wordTyCon :: TyCon
wordTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
wordTyConName
(CType -> Maybe CType
forall a. a -> Maybe a
Just (SourceText -> Maybe Header -> (SourceText, FastString) -> CType
CType SourceText
NoSourceText Maybe Header
forall a. Maybe a
Nothing (SourceText
NoSourceText, [Char] -> FastString
fsLit [Char]
"HsWord")))
[] [DataCon
wordDataCon]
wordDataCon :: DataCon
wordDataCon :: DataCon
wordDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
wordDataConName [] [Type
wordPrimTy] TyCon
wordTyCon
word8Ty :: Type
word8Ty :: Type
word8Ty = TyCon -> Type
mkTyConTy TyCon
word8TyCon
word8TyCon :: TyCon
word8TyCon :: TyCon
word8TyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
word8TyConName
(CType -> Maybe CType
forall a. a -> Maybe a
Just (SourceText -> Maybe Header -> (SourceText, FastString) -> CType
CType SourceText
NoSourceText Maybe Header
forall a. Maybe a
Nothing
(SourceText
NoSourceText, [Char] -> FastString
fsLit [Char]
"HsWord8"))) []
[DataCon
word8DataCon]
word8DataCon :: DataCon
word8DataCon :: DataCon
word8DataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
word8DataConName [] [Type
word8PrimTy] TyCon
word8TyCon
floatTy :: Type
floatTy :: Type
floatTy = TyCon -> Type
mkTyConTy TyCon
floatTyCon
floatTyCon :: TyCon
floatTyCon :: TyCon
floatTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
floatTyConName
(CType -> Maybe CType
forall a. a -> Maybe a
Just (SourceText -> Maybe Header -> (SourceText, FastString) -> CType
CType SourceText
NoSourceText Maybe Header
forall a. Maybe a
Nothing
(SourceText
NoSourceText, [Char] -> FastString
fsLit [Char]
"HsFloat"))) []
[DataCon
floatDataCon]
floatDataCon :: DataCon
floatDataCon :: DataCon
floatDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
floatDataConName [] [Type
floatPrimTy] TyCon
floatTyCon
doubleTy :: Type
doubleTy :: Type
doubleTy = TyCon -> Type
mkTyConTy TyCon
doubleTyCon
doubleTyCon :: TyCon
doubleTyCon :: TyCon
doubleTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
doubleTyConName
(CType -> Maybe CType
forall a. a -> Maybe a
Just (SourceText -> Maybe Header -> (SourceText, FastString) -> CType
CType SourceText
NoSourceText Maybe Header
forall a. Maybe a
Nothing
(SourceText
NoSourceText,[Char] -> FastString
fsLit [Char]
"HsDouble"))) []
[DataCon
doubleDataCon]
doubleDataCon :: DataCon
doubleDataCon :: DataCon
doubleDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
doubleDataConName [] [Type
doublePrimTy] TyCon
doubleTyCon
data BoxingInfo b
= BI_NoBoxNeeded
| BI_NoBoxAvailable
| BI_Box
{ forall b. BoxingInfo b -> DataCon
bi_data_con :: DataCon
, forall b. BoxingInfo b -> Expr b
bi_inst_con :: Expr b
, forall b. BoxingInfo b -> Type
bi_boxed_type :: Type }
boxingDataCon :: Type -> BoxingInfo b
boxingDataCon :: forall b. Type -> BoxingInfo b
boxingDataCon Type
ty
| Type -> Bool
tcIsLiftedTypeKind Type
kind
= BoxingInfo b
forall b. BoxingInfo b
BI_NoBoxNeeded
| Just DataCon
box_con <- Type -> Maybe DataCon
specialBoxingDataCon_maybe Type
ty
= BI_Box { bi_data_con :: DataCon
bi_data_con = DataCon
box_con, bi_inst_con :: Expr b
bi_inst_con = DataCon -> [Expr b] -> Expr b
forall b. DataCon -> [Arg b] -> Arg b
mkConApp DataCon
box_con []
, bi_boxed_type :: Type
bi_boxed_type = TyCon -> Type
tyConNullaryTy (DataCon -> TyCon
dataConTyCon DataCon
box_con) }
| Just DataCon
box_con <- TypeMap DataCon -> Type -> Maybe DataCon
forall a. TypeMap a -> Type -> Maybe a
lookupTypeMap TypeMap DataCon
boxingDataConMap Type
kind
= BI_Box { bi_data_con :: DataCon
bi_data_con = DataCon
box_con, bi_inst_con :: Expr b
bi_inst_con = DataCon -> [Expr b] -> Expr b
forall b. DataCon -> [Arg b] -> Arg b
mkConApp DataCon
box_con [Type -> Expr b
forall b. Type -> Expr b
Type Type
ty]
, bi_boxed_type :: Type
bi_boxed_type = TyCon -> [Type] -> Type
mkTyConApp (DataCon -> TyCon
dataConTyCon DataCon
box_con) [Type
ty] }
| Bool
otherwise
= BoxingInfo b
forall b. BoxingInfo b
BI_NoBoxAvailable
where
kind :: Type
kind = (() :: Constraint) => Type -> Type
Type -> Type
typeKind Type
ty
specialBoxingDataCon_maybe :: Type -> Maybe DataCon
specialBoxingDataCon_maybe :: Type -> Maybe DataCon
specialBoxingDataCon_maybe Type
ty
= case (() :: Constraint) => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
ty of
Just (TyCon
tc, [Type]
_) | TyCon
tc TyCon -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
intPrimTyConKey -> DataCon -> Maybe DataCon
forall a. a -> Maybe a
Just DataCon
intDataCon
| TyCon
tc TyCon -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
charPrimTyConKey -> DataCon -> Maybe DataCon
forall a. a -> Maybe a
Just DataCon
charDataCon
Maybe (TyCon, [Type])
_ -> Maybe DataCon
forall a. Maybe a
Nothing
boxingDataConMap :: TypeMap DataCon
boxingDataConMap :: TypeMap DataCon
boxingDataConMap = (TypeMap DataCon -> (Type, DataCon) -> TypeMap DataCon)
-> TypeMap DataCon -> [(Type, DataCon)] -> TypeMap DataCon
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl TypeMap DataCon -> (Type, DataCon) -> TypeMap DataCon
forall {a}. TypeMap a -> (Type, a) -> TypeMap a
add TypeMap DataCon
forall a. TypeMap a
emptyTypeMap [(Type, DataCon)]
boxingDataCons
where
add :: TypeMap a -> (Type, a) -> TypeMap a
add TypeMap a
bdcm (Type
kind, a
boxing_con) = TypeMap a -> Type -> a -> TypeMap a
forall a. TypeMap a -> Type -> a -> TypeMap a
extendTypeMap TypeMap a
bdcm Type
kind a
boxing_con
boxingDataCons :: [(Kind, DataCon)]
boxingDataCons :: [(Type, DataCon)]
boxingDataCons = (Unique -> (Type, FastString, FastString) -> (Type, DataCon))
-> [Unique]
-> [(Type, FastString, FastString)]
-> [(Type, DataCon)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Unique -> (Type, FastString, FastString) -> (Type, DataCon)
mkBoxingDataCon
((Int -> Unique) -> [Int] -> [Unique]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Unique
mkBoxingTyConUnique [Int
1..])
[ (Type -> Type
mkTYPEapp Type
wordRepDataConTy, [Char] -> FastString
fsLit [Char]
"WordBox", [Char] -> FastString
fsLit [Char]
"MkWordBox")
, (Type -> Type
mkTYPEapp Type
intRepDataConTy, [Char] -> FastString
fsLit [Char]
"IntBox", [Char] -> FastString
fsLit [Char]
"MkIntBox")
, (Type -> Type
mkTYPEapp Type
floatRepDataConTy, [Char] -> FastString
fsLit [Char]
"FloatBox", [Char] -> FastString
fsLit [Char]
"MkFloatBox")
, (Type -> Type
mkTYPEapp Type
doubleRepDataConTy, [Char] -> FastString
fsLit [Char]
"DoubleBox", [Char] -> FastString
fsLit [Char]
"MkDoubleBox")
, (Type -> Type
mkTYPEapp Type
int8RepDataConTy, [Char] -> FastString
fsLit [Char]
"Int8Box", [Char] -> FastString
fsLit [Char]
"MkInt8Box")
, (Type -> Type
mkTYPEapp Type
int16RepDataConTy, [Char] -> FastString
fsLit [Char]
"Int16Box", [Char] -> FastString
fsLit [Char]
"MkInt16Box")
, (Type -> Type
mkTYPEapp Type
int32RepDataConTy, [Char] -> FastString
fsLit [Char]
"Int32Box", [Char] -> FastString
fsLit [Char]
"MkInt32Box")
, (Type -> Type
mkTYPEapp Type
int64RepDataConTy, [Char] -> FastString
fsLit [Char]
"Int64Box", [Char] -> FastString
fsLit [Char]
"MkInt64Box")
, (Type -> Type
mkTYPEapp Type
word8RepDataConTy, [Char] -> FastString
fsLit [Char]
"Word8Box", [Char] -> FastString
fsLit [Char]
"MkWord8Box")
, (Type -> Type
mkTYPEapp Type
word16RepDataConTy, [Char] -> FastString
fsLit [Char]
"Word16Box", [Char] -> FastString
fsLit [Char]
"MkWord16Box")
, (Type -> Type
mkTYPEapp Type
word32RepDataConTy, [Char] -> FastString
fsLit [Char]
"Word32Box", [Char] -> FastString
fsLit [Char]
"MkWord32Box")
, (Type -> Type
mkTYPEapp Type
word64RepDataConTy, [Char] -> FastString
fsLit [Char]
"Word64Box", [Char] -> FastString
fsLit [Char]
"MkWord64Box")
, (Type
unliftedTypeKind, [Char] -> FastString
fsLit [Char]
"LiftBox", [Char] -> FastString
fsLit [Char]
"MkLiftBox")
, (Type
constraintKind, [Char] -> FastString
fsLit [Char]
"DictBox", [Char] -> FastString
fsLit [Char]
"MkDictBox") ]
mkBoxingDataCon :: Unique -> (Kind, FastString, FastString) -> (Kind, DataCon)
mkBoxingDataCon :: Unique -> (Type, FastString, FastString) -> (Type, DataCon)
mkBoxingDataCon Unique
uniq_tc (Type
kind, FastString
fs_tc, FastString
fs_dc)
= (Type
kind, DataCon
dc)
where
uniq_dc :: Unique
uniq_dc = Unique -> Unique
boxingDataConUnique Unique
uniq_tc
(TyVar
tv:[TyVar]
_) = [Type] -> [TyVar]
mkTemplateTyVars (Type -> [Type]
forall a. a -> [a]
repeat Type
kind)
tc :: TyCon
tc = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
tc_name Maybe CType
forall a. Maybe a
Nothing [TyVar
tv] [DataCon
dc]
tc_name :: Name
tc_name = BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName BuiltInSyntax
UserSyntax Module
gHC_TYPES FastString
fs_tc Unique
uniq_tc TyCon
tc
dc :: DataCon
dc | Type -> Bool
isConstraintKind Type
kind
= Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataConConstraint Name
dc_name [TyVar
tv] [TyVar -> Type
mkTyVarTy TyVar
tv] TyCon
tc
| Bool
otherwise
= Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
dc_name [TyVar
tv] [TyVar -> Type
mkTyVarTy TyVar
tv] TyCon
tc
dc_name :: Name
dc_name = BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName BuiltInSyntax
UserSyntax Module
gHC_TYPES FastString
fs_dc Unique
uniq_dc DataCon
dc
boolTy :: Type
boolTy :: Type
boolTy = TyCon -> Type
mkTyConTy TyCon
boolTyCon
boolTyCon :: TyCon
boolTyCon :: TyCon
boolTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
boolTyConName
(CType -> Maybe CType
forall a. a -> Maybe a
Just (SourceText -> Maybe Header -> (SourceText, FastString) -> CType
CType SourceText
NoSourceText Maybe Header
forall a. Maybe a
Nothing
(SourceText
NoSourceText, [Char] -> FastString
fsLit [Char]
"HsBool")))
[] [DataCon
falseDataCon, DataCon
trueDataCon]
falseDataCon, trueDataCon :: DataCon
falseDataCon :: DataCon
falseDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
falseDataConName [] [] TyCon
boolTyCon
trueDataCon :: DataCon
trueDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
trueDataConName [] [] TyCon
boolTyCon
falseDataConId, trueDataConId :: Id
falseDataConId :: TyVar
falseDataConId = DataCon -> TyVar
dataConWorkId DataCon
falseDataCon
trueDataConId :: TyVar
trueDataConId = DataCon -> TyVar
dataConWorkId DataCon
trueDataCon
orderingTyCon :: TyCon
orderingTyCon :: TyCon
orderingTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
orderingTyConName Maybe CType
forall a. Maybe a
Nothing
[] [DataCon
ordLTDataCon, DataCon
ordEQDataCon, DataCon
ordGTDataCon]
ordLTDataCon, ordEQDataCon, ordGTDataCon :: DataCon
ordLTDataCon :: DataCon
ordLTDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
ordLTDataConName [] [] TyCon
orderingTyCon
ordEQDataCon :: DataCon
ordEQDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
ordEQDataConName [] [] TyCon
orderingTyCon
ordGTDataCon :: DataCon
ordGTDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
ordGTDataConName [] [] TyCon
orderingTyCon
ordLTDataConId, ordEQDataConId, ordGTDataConId :: Id
ordLTDataConId :: TyVar
ordLTDataConId = DataCon -> TyVar
dataConWorkId DataCon
ordLTDataCon
ordEQDataConId :: TyVar
ordEQDataConId = DataCon -> TyVar
dataConWorkId DataCon
ordEQDataCon
ordGTDataConId :: TyVar
ordGTDataConId = DataCon -> TyVar
dataConWorkId DataCon
ordGTDataCon
mkListTy :: Type -> Type
mkListTy :: Type -> Type
mkListTy Type
ty = TyCon -> [Type] -> Type
mkTyConApp TyCon
listTyCon [Type
ty]
listTyCon :: TyCon
listTyCon :: TyCon
listTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
listTyConName Maybe CType
forall a. Maybe a
Nothing [TyVar
alphaTyVar] [DataCon
nilDataCon, DataCon
consDataCon]
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]
-> [Scaled Type]
-> TyCon
-> DataCon
pcDataConWithFixity Bool
True
Name
consDataConName
[TyVar]
alpha_tyvar [] [TyVar]
alpha_tyvar []
((Type -> Scaled Type) -> [Type] -> [Scaled Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Scaled Type
forall a. a -> Scaled a
linear [Type
alphaTy, TyCon -> [Type] -> Type
mkTyConApp TyCon
listTyCon [Type]
alpha_ty])
TyCon
listTyCon
maybeTyCon :: TyCon
maybeTyCon :: TyCon
maybeTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
maybeTyConName Maybe CType
forall a. Maybe a
Nothing [TyVar]
alpha_tyvar
[DataCon
nothingDataCon, DataCon
justDataCon]
nothingDataCon :: DataCon
nothingDataCon :: DataCon
nothingDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
nothingDataConName [TyVar]
alpha_tyvar [] TyCon
maybeTyCon
justDataCon :: DataCon
justDataCon :: DataCon
justDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
justDataConName [TyVar]
alpha_tyvar [Type
alphaTy] TyCon
maybeTyCon
mkPromotedMaybeTy :: Kind -> Maybe Type -> Type
mkPromotedMaybeTy :: Type -> Maybe Type -> Type
mkPromotedMaybeTy Type
k (Just Type
x) = TyCon -> [Type] -> Type
mkTyConApp TyCon
promotedJustDataCon [Type
k,Type
x]
mkPromotedMaybeTy Type
k Maybe Type
Nothing = TyCon -> [Type] -> Type
mkTyConApp TyCon
promotedNothingDataCon [Type
k]
mkMaybeTy :: Type -> Kind
mkMaybeTy :: Type -> Type
mkMaybeTy Type
t = TyCon -> [Type] -> Type
mkTyConApp TyCon
maybeTyCon [Type
t]
isPromotedMaybeTy :: Type -> Maybe (Maybe Type)
isPromotedMaybeTy :: Type -> Maybe (Maybe Type)
isPromotedMaybeTy Type
t
| Just (TyCon
tc,[Type
_,Type
x]) <- (() :: Constraint) => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
t, TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
promotedJustDataCon = Maybe Type -> Maybe (Maybe Type)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Type -> Maybe (Maybe Type))
-> Maybe Type -> Maybe (Maybe Type)
forall a b. (a -> b) -> a -> b
$ Type -> Maybe Type
forall a. a -> Maybe a
Just Type
x
| Just (TyCon
tc,[Type
_]) <- (() :: Constraint) => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
t, TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
promotedNothingDataCon = Maybe Type -> Maybe (Maybe Type)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Type -> Maybe (Maybe Type))
-> Maybe Type -> Maybe (Maybe Type)
forall a b. (a -> b) -> a -> b
$ Maybe Type
forall a. Maybe a
Nothing
| Bool
otherwise = Maybe (Maybe Type)
forall a. Maybe a
Nothing
mkTupleTy :: Boxity -> [Type] -> Type
mkTupleTy :: Boxity -> [Type] -> Type
mkTupleTy Boxity
Boxed [Type
ty] = Type
ty
mkTupleTy Boxity
boxity [Type]
tys = Boxity -> [Type] -> Type
mkTupleTy1 Boxity
boxity [Type]
tys
mkTupleTy1 :: Boxity -> [Type] -> Type
mkTupleTy1 :: Boxity -> [Type] -> Type
mkTupleTy1 Boxity
Boxed [Type]
tys = TyCon -> [Type] -> Type
mkTyConApp (Boxity -> Int -> TyCon
tupleTyCon Boxity
Boxed ([Type] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
tys)) [Type]
tys
mkTupleTy1 Boxity
Unboxed [Type]
tys = TyCon -> [Type] -> Type
mkTyConApp (Boxity -> Int -> TyCon
tupleTyCon Boxity
Unboxed ([Type] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
tys))
((Type -> Type) -> [Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map (() :: Constraint) => Type -> Type
Type -> Type
getRuntimeRep [Type]
tys [Type] -> [Type] -> [Type]
forall a. [a] -> [a] -> [a]
++ [Type]
tys)
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 []
mkConstraintTupleTy :: [Type] -> Type
mkConstraintTupleTy :: [Type] -> Type
mkConstraintTupleTy [Type
ty] = Type
ty
mkConstraintTupleTy [Type]
tys = TyCon -> [Type] -> Type
mkTyConApp (Int -> TyCon
cTupleTyCon ([Type] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
tys)) [Type]
tys
mkSumTy :: [Type] -> Type
mkSumTy :: [Type] -> Type
mkSumTy [Type]
tys = TyCon -> [Type] -> Type
mkTyConApp (Int -> TyCon
sumTyCon ([Type] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
tys))
((Type -> Type) -> [Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map (() :: Constraint) => Type -> Type
Type -> Type
getRuntimeRep [Type]
tys [Type] -> [Type] -> [Type]
forall a. [a] -> [a] -> [a]
++ [Type]
tys)
promotedFalseDataCon, promotedTrueDataCon :: TyCon
promotedTrueDataCon :: TyCon
promotedTrueDataCon = DataCon -> TyCon
promoteDataCon DataCon
trueDataCon
promotedFalseDataCon :: TyCon
promotedFalseDataCon = DataCon -> TyCon
promoteDataCon DataCon
falseDataCon
promotedNothingDataCon, promotedJustDataCon :: TyCon
promotedNothingDataCon :: TyCon
promotedNothingDataCon = DataCon -> TyCon
promoteDataCon DataCon
nothingDataCon
promotedJustDataCon :: TyCon
promotedJustDataCon = DataCon -> TyCon
promoteDataCon DataCon
justDataCon
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
promotedConsDataCon, promotedNilDataCon :: TyCon
promotedConsDataCon :: TyCon
promotedConsDataCon = DataCon -> TyCon
promoteDataCon DataCon
consDataCon
promotedNilDataCon :: TyCon
promotedNilDataCon = DataCon -> TyCon
promoteDataCon DataCon
nilDataCon
mkPromotedListTy :: Kind
-> [Type]
-> Type
mkPromotedListTy :: Type -> [Type] -> Type
mkPromotedListTy Type
k [Type]
tys
= (Type -> Type -> Type) -> Type -> [Type] -> Type
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Type -> Type -> Type
cons Type
nil [Type]
tys
where
cons :: Type
-> Type
-> 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]
extractPromotedList :: Type
-> [Type]
Type
tys = Type -> [Type]
go Type
tys
where
go :: Type -> [Type]
go Type
list_ty
| Just (TyCon
tc, [Type
_k, Type
t, Type
ts]) <- (() :: Constraint) => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
list_ty
= Bool -> [Type] -> [Type]
forall a. HasCallStack => Bool -> a -> a
assert (TyCon
tc TyCon -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
consDataConKey) ([Type] -> [Type]) -> [Type] -> [Type]
forall a b. (a -> b) -> a -> b
$
Type
t Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
: Type -> [Type]
go Type
ts
| Just (TyCon
tc, [Type
_k]) <- (() :: Constraint) => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
list_ty
= Bool -> [Type] -> [Type]
forall a. HasCallStack => Bool -> a -> a
assert (TyCon
tc TyCon -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
nilDataConKey)
[]
| Bool
otherwise
= [Char] -> SDoc -> [Type]
forall a. HasCallStack => [Char] -> SDoc -> a
pprPanic [Char]
"extractPromotedList" (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
tys)
integerTyConName
, integerISDataConName
, integerIPDataConName
, integerINDataConName
:: Name
integerTyConName :: Name
integerTyConName
= BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName
BuiltInSyntax
UserSyntax
Module
gHC_NUM_INTEGER
([Char] -> FastString
fsLit [Char]
"Integer")
Unique
integerTyConKey
TyCon
integerTyCon
integerISDataConName :: Name
integerISDataConName
= BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName
BuiltInSyntax
UserSyntax
Module
gHC_NUM_INTEGER
([Char] -> FastString
fsLit [Char]
"IS")
Unique
integerISDataConKey
DataCon
integerISDataCon
integerIPDataConName :: Name
integerIPDataConName
= BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName
BuiltInSyntax
UserSyntax
Module
gHC_NUM_INTEGER
([Char] -> FastString
fsLit [Char]
"IP")
Unique
integerIPDataConKey
DataCon
integerIPDataCon
integerINDataConName :: Name
integerINDataConName
= BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName
BuiltInSyntax
UserSyntax
Module
gHC_NUM_INTEGER
([Char] -> FastString
fsLit [Char]
"IN")
Unique
integerINDataConKey
DataCon
integerINDataCon
integerTy :: Type
integerTy :: Type
integerTy = TyCon -> Type
mkTyConTy TyCon
integerTyCon
integerTyCon :: TyCon
integerTyCon :: TyCon
integerTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
integerTyConName Maybe CType
forall a. Maybe a
Nothing []
[DataCon
integerISDataCon, DataCon
integerIPDataCon, DataCon
integerINDataCon]
integerISDataCon :: DataCon
integerISDataCon :: DataCon
integerISDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
integerISDataConName [] [Type
intPrimTy] TyCon
integerTyCon
integerIPDataCon :: DataCon
integerIPDataCon :: DataCon
integerIPDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
integerIPDataConName [] [Type
byteArrayPrimTy] TyCon
integerTyCon
integerINDataCon :: DataCon
integerINDataCon :: DataCon
integerINDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
integerINDataConName [] [Type
byteArrayPrimTy] TyCon
integerTyCon
naturalTyConName
, naturalNSDataConName
, naturalNBDataConName
:: Name
naturalTyConName :: Name
naturalTyConName
= BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName
BuiltInSyntax
UserSyntax
Module
gHC_NUM_NATURAL
([Char] -> FastString
fsLit [Char]
"Natural")
Unique
naturalTyConKey
TyCon
naturalTyCon
naturalNSDataConName :: Name
naturalNSDataConName
= BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName
BuiltInSyntax
UserSyntax
Module
gHC_NUM_NATURAL
([Char] -> FastString
fsLit [Char]
"NS")
Unique
naturalNSDataConKey
DataCon
naturalNSDataCon
naturalNBDataConName :: Name
naturalNBDataConName
= BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName
BuiltInSyntax
UserSyntax
Module
gHC_NUM_NATURAL
([Char] -> FastString
fsLit [Char]
"NB")
Unique
naturalNBDataConKey
DataCon
naturalNBDataCon
naturalTy :: Type
naturalTy :: Type
naturalTy = TyCon -> Type
mkTyConTy TyCon
naturalTyCon
naturalTyCon :: TyCon
naturalTyCon :: TyCon
naturalTyCon = Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon Name
naturalTyConName Maybe CType
forall a. Maybe a
Nothing []
[DataCon
naturalNSDataCon, DataCon
naturalNBDataCon]
naturalNSDataCon :: DataCon
naturalNSDataCon :: DataCon
naturalNSDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
naturalNSDataConName [] [Type
wordPrimTy] TyCon
naturalTyCon
naturalNBDataCon :: DataCon
naturalNBDataCon :: DataCon
naturalNBDataCon = Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon Name
naturalNBDataConName [] [Type
byteArrayPrimTy] TyCon
naturalTyCon
filterCTuple :: RdrName -> RdrName
filterCTuple :: RdrName -> RdrName
filterCTuple (Exact Name
n)
| Just Int
arity <- Name -> Maybe Int
cTupleTyConNameArity_maybe Name
n
= Name -> RdrName
Exact (Name -> RdrName) -> Name -> RdrName
forall a b. (a -> b) -> a -> b
$ TupleSort -> Int -> Name
tupleTyConName TupleSort
BoxedTuple Int
arity
filterCTuple RdrName
rdr = RdrName
rdr