module TysWiredIn (
wiredInTyCons, isBuiltInOcc_maybe,
boolTy, boolTyCon, boolTyCon_RDR, boolTyConName,
trueDataCon, trueDataConId, true_RDR,
falseDataCon, falseDataConId, false_RDR,
promotedFalseDataCon, promotedTrueDataCon,
orderingTyCon,
ltDataCon, ltDataConId,
eqDataCon, eqDataConId,
gtDataCon, gtDataConId,
promotedLTDataCon, promotedEQDataCon, promotedGTDataCon,
charTyCon, charDataCon, charTyCon_RDR,
charTy, stringTy, charTyConName,
doubleTyCon, doubleDataCon, doubleTy, doubleTyConName,
floatTyCon, floatDataCon, floatTy, floatTyConName,
intTyCon, intDataCon, intTyCon_RDR, intDataCon_RDR, intTyConName,
intTy,
wordTyCon, wordDataCon, wordTyConName, wordTy,
word8TyCon, word8DataCon, word8TyConName, word8Ty,
listTyCon, listTyCon_RDR, listTyConName, listTyConKey,
nilDataCon, nilDataConName, nilDataConKey,
consDataCon_RDR, consDataCon, consDataConName,
promotedNilDataCon, promotedConsDataCon,
mkListTy,
maybeTyCon, maybeTyConName,
nothingDataCon, nothingDataConName, promotedNothingDataCon,
justDataCon, justDataConName, promotedJustDataCon,
mkTupleTy, mkBoxedTupleTy,
tupleTyCon, tupleDataCon, tupleTyConName,
promotedTupleDataCon,
unitTyCon, unitDataCon, unitDataConId, unitTy, unitTyConKey,
pairTyCon,
unboxedUnitTyCon, unboxedUnitDataCon,
cTupleTyConName, cTupleTyConNames, isCTupleTyConName,
typeNatKindCon, typeNatKind, typeSymbolKindCon, typeSymbolKind,
isLiftedTypeKindTyConName, liftedTypeKind, constraintKind,
starKindTyCon, starKindTyConName,
unicodeStarKindTyCon, unicodeStarKindTyConName,
liftedTypeKindTyCon, constraintKindTyCon,
mkPArrTy,
parrTyCon, parrFakeCon, isPArrTyCon, isPArrFakeCon,
parrTyCon_RDR, parrTyConName,
heqTyCon, heqClass, heqDataCon,
coercibleTyCon, coercibleDataCon, coercibleClass,
mkWiredInTyConName,
mkWiredInIdName,
trModuleTyCon, trModuleDataCon,
trNameTyCon, trNameSDataCon, trNameDDataCon,
trTyConTyCon, trTyConDataCon,
levityTy, levityTyCon, liftedDataCon, unliftedDataCon,
liftedPromDataCon, unliftedPromDataCon,
liftedDataConTy, unliftedDataConTy,
liftedDataConName, unliftedDataConName,
) where
#include "HsVersions.h"
#include "MachDeps.h"
import MkId( mkDataConWorkId, mkDictSelId )
import PrelNames
import TysPrim
import CoAxiom
import Id
import Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE )
import Module ( Module )
import Type
import DataCon
import ConLike
import TyCon
import Class ( Class, mkClass )
import RdrName
import Name
import NameSet ( NameSet, mkNameSet, elemNameSet )
import BasicTypes ( Arity, RecFlag(..), Boxity(..),
TupleSort(..) )
import ForeignCall
import SrcLoc ( noSrcSpan )
import Unique
import Data.Array
import FastString
import Outputable
import Util
import BooleanFormula ( mkAnd )
alpha_tyvar :: [TyVar]
alpha_tyvar = [alphaTyVar]
alpha_ty :: [Type]
alpha_ty = [alphaTy]
wiredInTyCons :: [TyCon]
wiredInTyCons = [ unitTyCon
, boolTyCon
, charTyCon
, doubleTyCon
, floatTyCon
, intTyCon
, wordTyCon
, word8TyCon
, listTyCon
, maybeTyCon
, parrTyCon
, heqTyCon
, coercibleTyCon
, typeNatKindCon
, typeSymbolKindCon
, levityTyCon
, constraintKindTyCon
, liftedTypeKindTyCon
, starKindTyCon
, unicodeStarKindTyCon
, trModuleTyCon
, trTyConTyCon
, trNameTyCon
]
mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
mkWiredInTyConName built_in modu fs unique tycon
= mkWiredInName modu (mkTcOccFS fs) unique
(ATyCon tycon)
built_in
mkWiredInDataConName :: BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
mkWiredInDataConName built_in modu fs unique datacon
= mkWiredInName modu (mkDataOccFS fs) unique
(AConLike (RealDataCon datacon))
built_in
mkWiredInIdName :: Module -> FastString -> Unique -> Id -> Name
mkWiredInIdName mod fs uniq id
= mkWiredInName mod (mkOccNameFS Name.varName fs) uniq (AnId id) UserSyntax
heqTyConName, heqDataConName, heqSCSelIdName :: Name
heqTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "~~") heqTyConKey heqTyCon
heqDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "Eq#") heqDataConKey heqDataCon
heqSCSelIdName = mkWiredInIdName gHC_TYPES (fsLit "HEq_sc") heqSCSelIdKey heqSCSelId
coercibleTyConName, coercibleDataConName, coercibleSCSelIdName :: Name
coercibleTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Coercible") coercibleTyConKey coercibleTyCon
coercibleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "MkCoercible") coercibleDataConKey coercibleDataCon
coercibleSCSelIdName = mkWiredInIdName gHC_TYPES (fsLit "Coercible_sc") coercibleSCSelIdKey coercibleSCSelId
charTyConName, charDataConName, intTyConName, intDataConName :: Name
charTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Char") charTyConKey charTyCon
charDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "C#") charDataConKey charDataCon
intTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Int") intTyConKey intTyCon
intDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "I#") intDataConKey intDataCon
boolTyConName, falseDataConName, trueDataConName :: Name
boolTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Bool") boolTyConKey boolTyCon
falseDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "False") falseDataConKey falseDataCon
trueDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "True") trueDataConKey trueDataCon
listTyConName, nilDataConName, consDataConName :: Name
listTyConName = mkWiredInTyConName BuiltInSyntax gHC_TYPES (fsLit "[]") listTyConKey listTyCon
nilDataConName = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit "[]") nilDataConKey nilDataCon
consDataConName = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit ":") consDataConKey consDataCon
maybeTyConName, nothingDataConName, justDataConName :: Name
maybeTyConName = mkWiredInTyConName UserSyntax gHC_BASE (fsLit "Maybe")
maybeTyConKey maybeTyCon
nothingDataConName = mkWiredInDataConName UserSyntax gHC_BASE (fsLit "Nothing")
nothingDataConKey nothingDataCon
justDataConName = mkWiredInDataConName UserSyntax gHC_BASE (fsLit "Just")
justDataConKey justDataCon
wordTyConName, wordDataConName, word8TyConName, word8DataConName :: Name
wordTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Word") wordTyConKey wordTyCon
wordDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "W#") wordDataConKey wordDataCon
word8TyConName = mkWiredInTyConName UserSyntax gHC_WORD (fsLit "Word8") word8TyConKey word8TyCon
word8DataConName = mkWiredInDataConName UserSyntax gHC_WORD (fsLit "W8#") word8DataConKey word8DataCon
floatTyConName, floatDataConName, doubleTyConName, doubleDataConName :: Name
floatTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Float") floatTyConKey floatTyCon
floatDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "F#") floatDataConKey floatDataCon
doubleTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Double") doubleTyConKey doubleTyCon
doubleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "D#") doubleDataConKey doubleDataCon
typeNatKindConName, typeSymbolKindConName :: Name
typeNatKindConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Nat") typeNatKindConNameKey typeNatKindCon
typeSymbolKindConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Symbol") typeSymbolKindConNameKey typeSymbolKindCon
constraintKindTyConName :: Name
constraintKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Constraint") constraintKindTyConKey constraintKindTyCon
liftedTypeKindTyConName, starKindTyConName, unicodeStarKindTyConName
:: Name
liftedTypeKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Type") liftedTypeKindTyConKey liftedTypeKindTyCon
starKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "*") starKindTyConKey starKindTyCon
unicodeStarKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "★") unicodeStarKindTyConKey unicodeStarKindTyCon
levityTyConName, liftedDataConName, unliftedDataConName :: Name
levityTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Levity") levityTyConKey levityTyCon
liftedDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "Lifted") liftedDataConKey liftedDataCon
unliftedDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "Unlifted") unliftedDataConKey unliftedDataCon
parrTyConName, parrDataConName :: Name
parrTyConName = mkWiredInTyConName BuiltInSyntax
gHC_PARR' (fsLit "[::]") parrTyConKey parrTyCon
parrDataConName = mkWiredInDataConName UserSyntax
gHC_PARR' (fsLit "PArr") parrDataConKey parrDataCon
boolTyCon_RDR, false_RDR, true_RDR, intTyCon_RDR, charTyCon_RDR,
intDataCon_RDR, listTyCon_RDR, consDataCon_RDR, parrTyCon_RDR :: RdrName
boolTyCon_RDR = nameRdrName boolTyConName
false_RDR = nameRdrName falseDataConName
true_RDR = nameRdrName trueDataConName
intTyCon_RDR = nameRdrName intTyConName
charTyCon_RDR = nameRdrName charTyConName
intDataCon_RDR = nameRdrName intDataConName
listTyCon_RDR = nameRdrName listTyConName
consDataCon_RDR = nameRdrName consDataConName
parrTyCon_RDR = nameRdrName parrTyConName
pcNonRecDataTyCon :: Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcNonRecDataTyCon = pcTyCon False NonRecursive
pcTyCon :: Bool -> RecFlag -> Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon is_enum is_rec name cType tyvars cons
= mkAlgTyCon name
(mkFunTys (map tyVarKind tyvars) liftedTypeKind)
tyvars
(map (const Representational) tyvars)
cType
[]
(DataTyCon cons is_enum)
(VanillaAlgTyCon (mkPrelTyConRepName name))
is_rec
False
pcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon n univs = pcDataConWithFixity False n univs []
pcDataConWithFixity :: Bool
-> Name
-> [TyVar]
-> [TyVar]
-> [Type]
-> TyCon
-> DataCon
pcDataConWithFixity infx n = pcDataConWithFixity' infx n (incrUnique (nameUnique n))
pcDataConWithFixity' :: Bool -> Name -> Unique -> [TyVar] -> [TyVar]
-> [Type] -> TyCon -> DataCon
pcDataConWithFixity' declared_infix dc_name wrk_key tyvars ex_tyvars arg_tys tycon
= data_con
where
data_con = mkDataCon dc_name declared_infix prom_info
(map (const no_bang) arg_tys)
[]
tyvars
ex_tyvars
[]
[]
arg_tys (mkTyConApp tycon (mkTyVarTys tyvars))
tycon
[]
(mkDataConWorkId wrk_name data_con)
NoDataConRep
no_bang = HsSrcBang Nothing NoSrcUnpack NoSrcStrict
modu = ASSERT( isExternalName dc_name )
nameModule dc_name
dc_occ = nameOccName dc_name
wrk_occ = mkDataConWorkerOcc dc_occ
wrk_name = mkWiredInName modu wrk_occ wrk_key
(AnId (dataConWorkId data_con)) UserSyntax
prom_info = mkPrelTyConRepName dc_name
typeNatKindCon, typeSymbolKindCon :: TyCon
typeNatKindCon = pcTyCon False NonRecursive typeNatKindConName Nothing [] []
typeSymbolKindCon = pcTyCon False NonRecursive typeSymbolKindConName Nothing [] []
typeNatKind, typeSymbolKind :: Kind
typeNatKind = mkTyConTy typeNatKindCon
typeSymbolKind = mkTyConTy typeSymbolKindCon
constraintKindTyCon :: TyCon
constraintKindTyCon = pcTyCon False NonRecursive constraintKindTyConName
Nothing [] []
liftedTypeKind, constraintKind :: Kind
liftedTypeKind = tYPE liftedDataConTy
constraintKind = mkTyConApp constraintKindTyCon []
isBuiltInOcc_maybe :: OccName -> Maybe Name
isBuiltInOcc_maybe occ
= case occNameString occ of
"[]" -> choose_ns listTyConName nilDataConName
":" -> Just consDataConName
"[::]" -> Just parrTyConName
"()" -> tup_name Boxed 0
"(##)" -> tup_name Unboxed 0
'(':',':rest -> parse_tuple Boxed 2 rest
'(':'#':',':rest -> parse_tuple Unboxed 2 rest
_other -> Nothing
where
ns = occNameSpace occ
parse_tuple sort n rest
| (',' : rest2) <- rest = parse_tuple sort (n+1) rest2
| tail_matches sort rest = tup_name sort n
| otherwise = Nothing
tail_matches Boxed ")" = True
tail_matches Unboxed "#)" = True
tail_matches _ _ = False
tup_name boxity arity
= choose_ns (getName (tupleTyCon boxity arity))
(getName (tupleDataCon boxity arity))
choose_ns tc dc
| isTcClsNameSpace ns = Just tc
| isDataConNameSpace ns = Just dc
| otherwise = pprPanic "tup_name" (ppr occ)
mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
mkTupleOcc ns sort ar = mkOccName ns str
where
str = case sort of
Unboxed -> '(' : '#' : commas ++ "#)"
Boxed -> '(' : commas ++ ")"
commas = take (ar1) (repeat ',')
mkCTupleOcc :: NameSpace -> Arity -> OccName
mkCTupleOcc ns ar = mkOccName ns str
where
str = "(%" ++ commas ++ "%)"
commas = take (ar1) (repeat ',')
cTupleTyConName :: Arity -> Name
cTupleTyConName arity
= mkExternalName (mkCTupleTyConUnique arity) gHC_CLASSES
(mkCTupleOcc tcName arity) noSrcSpan
cTupleTyConNames :: [Name]
cTupleTyConNames = map cTupleTyConName (0 : [2..mAX_CTUPLE_SIZE])
cTupleTyConNameSet :: NameSet
cTupleTyConNameSet = mkNameSet cTupleTyConNames
isCTupleTyConName :: Name -> Bool
isCTupleTyConName n
= ASSERT2( isExternalName n, ppr n )
nameModule n == gHC_CLASSES
&& n `elemNameSet` cTupleTyConNameSet
tupleTyCon :: Boxity -> Arity -> TyCon
tupleTyCon sort i | i > mAX_TUPLE_SIZE = fst (mk_tuple sort i)
tupleTyCon Boxed i = fst (boxedTupleArr ! i)
tupleTyCon Unboxed i = fst (unboxedTupleArr ! i)
tupleTyConName :: TupleSort -> Arity -> Name
tupleTyConName ConstraintTuple a = cTupleTyConName a
tupleTyConName BoxedTuple a = tyConName (tupleTyCon Boxed a)
tupleTyConName UnboxedTuple a = tyConName (tupleTyCon Unboxed a)
promotedTupleDataCon :: Boxity -> Arity -> TyCon
promotedTupleDataCon boxity i = promoteDataCon (tupleDataCon boxity i)
tupleDataCon :: Boxity -> Arity -> DataCon
tupleDataCon sort i | i > mAX_TUPLE_SIZE = snd (mk_tuple sort i)
tupleDataCon Boxed i = snd (boxedTupleArr ! i)
tupleDataCon Unboxed i = snd (unboxedTupleArr ! i)
boxedTupleArr, unboxedTupleArr :: Array Int (TyCon,DataCon)
boxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Boxed i | i <- [0..mAX_TUPLE_SIZE]]
unboxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Unboxed i | i <- [0..mAX_TUPLE_SIZE]]
mk_tuple :: Boxity -> Int -> (TyCon,DataCon)
mk_tuple boxity arity = (tycon, tuple_con)
where
tycon = mkTupleTyCon tc_name tc_kind tc_arity tyvars tuple_con
tup_sort flavour
(tup_sort, modu, tc_kind, tc_arity, tyvars, tyvar_tys, flavour)
= case boxity of
Boxed ->
let boxed_tyvars = take arity alphaTyVars in
( BoxedTuple
, gHC_TUPLE
, mkFunTys (nOfThem arity liftedTypeKind) liftedTypeKind
, arity
, boxed_tyvars
, mkTyVarTys boxed_tyvars
, VanillaAlgTyCon (mkPrelTyConRepName tc_name)
)
Unboxed ->
let all_tvs = mkTemplateTyVars (replicate arity levityTy ++
map (tYPE . mkTyVarTy) (take arity all_tvs))
(lev_tvs, open_tvs) = splitAt arity all_tvs
in
( UnboxedTuple
, gHC_PRIM
, mkSpecForAllTys lev_tvs $
mkFunTys (map tyVarKind open_tvs) $
unliftedTypeKind
, arity * 2
, all_tvs
, mkTyVarTys open_tvs
, UnboxedAlgTyCon
)
tc_name = mkWiredInName modu (mkTupleOcc tcName boxity arity) tc_uniq
(ATyCon tycon) BuiltInSyntax
tuple_con = pcDataCon dc_name tyvars tyvar_tys tycon
dc_name = mkWiredInName modu (mkTupleOcc dataName boxity arity) dc_uniq
(AConLike (RealDataCon tuple_con)) BuiltInSyntax
tc_uniq = mkTupleTyConUnique boxity arity
dc_uniq = mkTupleDataConUnique boxity arity
unitTyCon :: TyCon
unitTyCon = tupleTyCon Boxed 0
unitTyConKey :: Unique
unitTyConKey = getUnique unitTyCon
unitDataCon :: DataCon
unitDataCon = head (tyConDataCons unitTyCon)
unitDataConId :: Id
unitDataConId = dataConWorkId unitDataCon
pairTyCon :: TyCon
pairTyCon = tupleTyCon Boxed 2
unboxedUnitTyCon :: TyCon
unboxedUnitTyCon = tupleTyCon Unboxed 0
unboxedUnitDataCon :: DataCon
unboxedUnitDataCon = tupleDataCon Unboxed 0
heqTyCon, coercibleTyCon :: TyCon
heqClass, coercibleClass :: Class
heqDataCon, coercibleDataCon :: DataCon
heqSCSelId, coercibleSCSelId :: Id
(heqTyCon, heqClass, heqDataCon, heqSCSelId)
= (tycon, klass, datacon, sc_sel_id)
where
tycon = mkClassTyCon heqTyConName kind tvs roles
rhs klass NonRecursive
(mkPrelTyConRepName heqTyConName)
klass = mkClass tvs [] [sc_pred] [sc_sel_id] [] [] (mkAnd []) tycon
datacon = pcDataCon heqDataConName tvs [sc_pred] tycon
kind = mkSpecForAllTys [kv1, kv2] $ mkFunTys [k1, k2] constraintKind
kv1:kv2:_ = drop 9 alphaTyVars
k1 = mkTyVarTy kv1
k2 = mkTyVarTy kv2
[av,bv] = mkTemplateTyVars [k1, k2]
tvs = [kv1, kv2, av, bv]
roles = [Nominal, Nominal, Nominal, Nominal]
rhs = DataTyCon { data_cons = [datacon], is_enum = False }
sc_pred = mkTyConApp eqPrimTyCon (mkTyVarTys tvs)
sc_sel_id = mkDictSelId heqSCSelIdName klass
(coercibleTyCon, coercibleClass, coercibleDataCon, coercibleSCSelId)
= (tycon, klass, datacon, sc_sel_id)
where
tycon = mkClassTyCon coercibleTyConName kind tvs roles
rhs klass NonRecursive
(mkPrelTyConRepName coercibleTyConName)
klass = mkClass tvs [] [sc_pred] [sc_sel_id] [] [] (mkAnd []) tycon
datacon = pcDataCon coercibleDataConName tvs [sc_pred] tycon
kind = mkSpecForAllTys [kKiVar] $ mkFunTys [k, k] constraintKind
k = mkTyVarTy kKiVar
[av,bv] = mkTemplateTyVars [k, k]
tvs = [kKiVar, av, bv]
roles = [Nominal, Representational, Representational]
rhs = DataTyCon { data_cons = [datacon], is_enum = False }
sc_pred = mkTyConApp eqReprPrimTyCon [k, k, mkTyVarTy av, mkTyVarTy bv]
sc_sel_id = mkDictSelId coercibleSCSelIdName klass
levityTy :: Type
levityTy = mkTyConTy levityTyCon
levityTyCon :: TyCon
levityTyCon = pcTyCon True NonRecursive levityTyConName
Nothing [] [liftedDataCon, unliftedDataCon]
liftedDataCon, unliftedDataCon :: DataCon
liftedDataCon = pcDataCon liftedDataConName [] [] levityTyCon
unliftedDataCon = pcDataCon unliftedDataConName [] [] levityTyCon
liftedPromDataCon, unliftedPromDataCon :: TyCon
liftedPromDataCon = promoteDataCon liftedDataCon
unliftedPromDataCon = promoteDataCon unliftedDataCon
liftedDataConTy, unliftedDataConTy :: Type
liftedDataConTy = mkTyConTy liftedPromDataCon
unliftedDataConTy = mkTyConTy unliftedPromDataCon
liftedTypeKindTyCon, starKindTyCon, unicodeStarKindTyCon :: TyCon
liftedTypeKindTyCon = mkSynonymTyCon liftedTypeKindTyConName
liftedTypeKind
[] []
(tYPE liftedDataConTy)
starKindTyCon = mkSynonymTyCon starKindTyConName
liftedTypeKind
[] []
(tYPE liftedDataConTy)
unicodeStarKindTyCon = mkSynonymTyCon unicodeStarKindTyConName
liftedTypeKind
[] []
(tYPE liftedDataConTy)
charTy :: Type
charTy = mkTyConTy charTyCon
charTyCon :: TyCon
charTyCon = pcNonRecDataTyCon charTyConName
(Just (CType "" Nothing ("HsChar",fsLit "HsChar")))
[] [charDataCon]
charDataCon :: DataCon
charDataCon = pcDataCon charDataConName [] [charPrimTy] charTyCon
stringTy :: Type
stringTy = mkListTy charTy
intTy :: Type
intTy = mkTyConTy intTyCon
intTyCon :: TyCon
intTyCon = pcNonRecDataTyCon intTyConName
(Just (CType "" Nothing ("HsInt",fsLit "HsInt"))) []
[intDataCon]
intDataCon :: DataCon
intDataCon = pcDataCon intDataConName [] [intPrimTy] intTyCon
wordTy :: Type
wordTy = mkTyConTy wordTyCon
wordTyCon :: TyCon
wordTyCon = pcNonRecDataTyCon wordTyConName
(Just (CType "" Nothing ("HsWord", fsLit "HsWord"))) []
[wordDataCon]
wordDataCon :: DataCon
wordDataCon = pcDataCon wordDataConName [] [wordPrimTy] wordTyCon
word8Ty :: Type
word8Ty = mkTyConTy word8TyCon
word8TyCon :: TyCon
word8TyCon = pcNonRecDataTyCon word8TyConName
(Just (CType "" Nothing ("HsWord8", fsLit "HsWord8"))) []
[word8DataCon]
word8DataCon :: DataCon
word8DataCon = pcDataCon word8DataConName [] [wordPrimTy] word8TyCon
floatTy :: Type
floatTy = mkTyConTy floatTyCon
floatTyCon :: TyCon
floatTyCon = pcNonRecDataTyCon floatTyConName
(Just (CType "" Nothing ("HsFloat", fsLit "HsFloat"))) []
[floatDataCon]
floatDataCon :: DataCon
floatDataCon = pcDataCon floatDataConName [] [floatPrimTy] floatTyCon
doubleTy :: Type
doubleTy = mkTyConTy doubleTyCon
doubleTyCon :: TyCon
doubleTyCon = pcNonRecDataTyCon doubleTyConName
(Just (CType "" Nothing ("HsDouble",fsLit "HsDouble"))) []
[doubleDataCon]
doubleDataCon :: DataCon
doubleDataCon = pcDataCon doubleDataConName [] [doublePrimTy] doubleTyCon
boolTy :: Type
boolTy = mkTyConTy boolTyCon
boolTyCon :: TyCon
boolTyCon = pcTyCon True NonRecursive boolTyConName
(Just (CType "" Nothing ("HsBool", fsLit "HsBool")))
[] [falseDataCon, trueDataCon]
falseDataCon, trueDataCon :: DataCon
falseDataCon = pcDataCon falseDataConName [] [] boolTyCon
trueDataCon = pcDataCon trueDataConName [] [] boolTyCon
falseDataConId, trueDataConId :: Id
falseDataConId = dataConWorkId falseDataCon
trueDataConId = dataConWorkId trueDataCon
orderingTyCon :: TyCon
orderingTyCon = pcTyCon True NonRecursive orderingTyConName Nothing
[] [ltDataCon, eqDataCon, gtDataCon]
ltDataCon, eqDataCon, gtDataCon :: DataCon
ltDataCon = pcDataCon ltDataConName [] [] orderingTyCon
eqDataCon = pcDataCon eqDataConName [] [] orderingTyCon
gtDataCon = pcDataCon gtDataConName [] [] orderingTyCon
ltDataConId, eqDataConId, gtDataConId :: Id
ltDataConId = dataConWorkId ltDataCon
eqDataConId = dataConWorkId eqDataCon
gtDataConId = dataConWorkId gtDataCon
mkListTy :: Type -> Type
mkListTy ty = mkTyConApp listTyCon [ty]
listTyCon :: TyCon
listTyCon = buildAlgTyCon listTyConName alpha_tyvar [Representational]
Nothing []
(DataTyCon [nilDataCon, consDataCon] False )
Recursive False
(VanillaAlgTyCon $ mkPrelTyConRepName listTyConName)
nilDataCon :: DataCon
nilDataCon = pcDataCon nilDataConName alpha_tyvar [] listTyCon
consDataCon :: DataCon
consDataCon = pcDataConWithFixity True
consDataConName
alpha_tyvar [] [alphaTy, mkTyConApp listTyCon alpha_ty] listTyCon
maybeTyCon :: TyCon
maybeTyCon = pcTyCon False NonRecursive maybeTyConName Nothing alpha_tyvar
[nothingDataCon, justDataCon]
nothingDataCon :: DataCon
nothingDataCon = pcDataCon nothingDataConName alpha_tyvar [] maybeTyCon
justDataCon :: DataCon
justDataCon = pcDataCon justDataConName alpha_tyvar [alphaTy] maybeTyCon
mkTupleTy :: Boxity -> [Type] -> Type
mkTupleTy Boxed [ty] = ty
mkTupleTy Boxed tys = mkTyConApp (tupleTyCon Boxed (length tys)) tys
mkTupleTy Unboxed tys = mkTyConApp (tupleTyCon Unboxed (length tys))
(map (getLevity "mkTupleTy") tys ++ tys)
mkBoxedTupleTy :: [Type] -> Type
mkBoxedTupleTy tys = mkTupleTy Boxed tys
unitTy :: Type
unitTy = mkTupleTy Boxed []
mkPArrTy :: Type -> Type
mkPArrTy ty = mkTyConApp parrTyCon [ty]
parrTyCon :: TyCon
parrTyCon = pcNonRecDataTyCon parrTyConName Nothing alpha_tyvar [parrDataCon]
parrDataCon :: DataCon
parrDataCon = pcDataCon
parrDataConName
alpha_tyvar
[intTy,
mkTyConApp
arrayPrimTyCon
alpha_ty]
parrTyCon
isPArrTyCon :: TyCon -> Bool
isPArrTyCon tc = tyConName tc == parrTyConName
parrFakeCon :: Arity -> DataCon
parrFakeCon i | i > mAX_TUPLE_SIZE = mkPArrFakeCon i
parrFakeCon i = parrFakeConArr!i
parrFakeConArr :: Array Int DataCon
parrFakeConArr = array (0, mAX_TUPLE_SIZE) [(i, mkPArrFakeCon i)
| i <- [0..mAX_TUPLE_SIZE]]
mkPArrFakeCon :: Int -> DataCon
mkPArrFakeCon arity = data_con
where
data_con = pcDataCon name [tyvar] tyvarTys parrTyCon
tyvar = head alphaTyVars
tyvarTys = replicate arity $ mkTyVarTy tyvar
nameStr = mkFastString ("MkPArr" ++ show arity)
name = mkWiredInName gHC_PARR' (mkDataOccFS nameStr) unique
(AConLike (RealDataCon data_con)) UserSyntax
unique = mkPArrDataConUnique arity
isPArrFakeCon :: DataCon -> Bool
isPArrFakeCon dcon = dcon == parrFakeCon (dataConSourceArity dcon)
promotedFalseDataCon, promotedTrueDataCon :: TyCon
promotedTrueDataCon = promoteDataCon trueDataCon
promotedFalseDataCon = promoteDataCon falseDataCon
promotedNothingDataCon, promotedJustDataCon :: TyCon
promotedNothingDataCon = promoteDataCon nothingDataCon
promotedJustDataCon = promoteDataCon justDataCon
promotedLTDataCon
, promotedEQDataCon
, promotedGTDataCon
:: TyCon
promotedLTDataCon = promoteDataCon ltDataCon
promotedEQDataCon = promoteDataCon eqDataCon
promotedGTDataCon = promoteDataCon gtDataCon
promotedConsDataCon, promotedNilDataCon :: TyCon
promotedConsDataCon = promoteDataCon consDataCon
promotedNilDataCon = promoteDataCon nilDataCon
trModuleTyConName, trNameTyConName, trTyConTyConName :: Name
trModuleTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Module")
trModuleTyConKey trModuleTyCon
trNameTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "TrName")
trNameTyConKey trNameTyCon
trTyConTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "TyCon")
trTyConTyConKey trTyConTyCon
trModuleDataConName, trTyConDataConName,
trNameSDataConName, trNameDDataConName :: Name
trModuleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "Module")
trModuleDataConKey trModuleDataCon
trTyConDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "TyCon")
trTyConDataConKey trTyConDataCon
trNameSDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "TrNameS")
trNameSDataConKey trNameSDataCon
trNameDDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "TrNameD")
trNameDDataConKey trNameDDataCon
trModuleTyCon :: TyCon
trModuleTyCon = pcNonRecDataTyCon trModuleTyConName Nothing [] [trModuleDataCon]
trModuleDataCon :: DataCon
trModuleDataCon = pcDataCon trModuleDataConName [] [trNameTy, trNameTy] trModuleTyCon
trModuleTy :: Type
trModuleTy = mkTyConTy trModuleTyCon
trNameTyCon :: TyCon
trNameTyCon = pcNonRecDataTyCon trNameTyConName Nothing [] [trNameSDataCon, trNameDDataCon]
trNameSDataCon, trNameDDataCon :: DataCon
trNameSDataCon = pcDataCon trNameSDataConName [] [addrPrimTy] trNameTyCon
trNameDDataCon = pcDataCon trNameDDataConName [] [stringTy] trNameTyCon
trNameTy :: Type
trNameTy = mkTyConTy trNameTyCon
trTyConTyCon :: TyCon
trTyConTyCon = pcNonRecDataTyCon trTyConTyConName Nothing [] [trTyConDataCon]
trTyConDataCon :: DataCon
trTyConDataCon = pcDataCon trTyConDataConName [] [fprint, fprint, trModuleTy, trNameTy] trTyConTyCon
where
#if WORD_SIZE_IN_BITS < 64
fprint = word64PrimTy
#else
fprint = wordPrimTy
#endif