unitTyCon, unitDataCon, unitDataConId, pairTyCon,
unboxedSingletonTyCon, unboxedSingletonDataCon,
unboxedPairTyCon, unboxedPairDataCon,
+
+ boxedTupleArr, unboxedTupleArr,
unitTy,
- voidTy,
-- parallel arrays
mkPArrTy,
parrTyCon_RDR, parrTyConName
) where
-#include "HsVersions.h"
-
import {-# SOURCE #-} MkId( mkDataConIds )
-- friends:
-- others:
import Constants ( mAX_TUPLE_SIZE )
import Module ( Module )
-import RdrName ( nameRdrName )
+import RdrName
import Name ( Name, BuiltInSyntax(..), nameUnique, nameOccName,
nameModule, mkWiredInName )
import OccName ( mkOccNameFS, tcName, dataName, mkTupleOcc,
mkDataConWorkerOcc )
import DataCon ( DataCon, mkDataCon, dataConWorkId, dataConSourceArity )
-import Var ( TyVar, tyVarKind )
+import Var
import TyCon ( TyCon, AlgTyConRhs(DataTyCon), tyConDataCons,
- mkTupleTyCon, mkAlgTyCon, tyConName )
+ mkTupleTyCon, mkAlgTyCon, tyConName,
+ TyConParent(NoParentTyCon) )
import BasicTypes ( Arity, RecFlag(..), Boxity(..), isBoxed,
StrictnessMark(..) )
import Type ( Type, mkTyConTy, mkTyConApp, mkTyVarTy, mkTyVarTys,
TyThing(..) )
-import Kind ( mkArrowKinds, liftedTypeKind, ubxTupleKind )
+import Coercion ( unsafeCoercionTyCon, symCoercionTyCon,
+ transCoercionTyCon, leftCoercionTyCon,
+ rightCoercionTyCon, instCoercionTyCon )
+import TypeRep ( mkArrowKinds, liftedTypeKind, ubxTupleKind )
import Unique ( incrUnique, mkTupleTyConUnique,
mkTupleDataConUnique, mkPArrDataConUnique )
import Array
import FastString
import Outputable
+alpha_tyvar :: [TyVar]
alpha_tyvar = [alphaTyVar]
-alpha_ty = [alphaTy]
+
+alpha_ty :: [Type]
+alpha_ty = [alphaTy]
\end{code}
\begin{code}
wiredInTyCons :: [TyCon] -- Excludes tuples
+-- This list is used only to define PrelInfo.wiredInThings
+
+-- It does not need to include kind constructors, because
+-- all that wiredInThings does is to initialise the Name table,
+-- and kind constructors don't appear in source code.
+
wiredInTyCons = [ unitTyCon -- Not treated like other tuples, because
-- it's defined in GHC.Base, and there's only
-- one of it. We put it in wiredInTyCons so
, intTyCon
, listTyCon
, parrTyCon
+ , unsafeCoercionTyCon
+ , symCoercionTyCon
+ , transCoercionTyCon
+ , leftCoercionTyCon
+ , rightCoercionTyCon
+ , instCoercionTyCon
]
\end{code}
\begin{code}
mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
-mkWiredInTyConName built_in mod fs uniq tycon
- = mkWiredInName mod (mkOccNameFS tcName fs) uniq
- Nothing -- No parent object
+mkWiredInTyConName built_in modu fs unique tycon
+ = mkWiredInName modu (mkOccNameFS tcName fs) unique
(ATyCon tycon) -- Relevant TyCon
built_in
-mkWiredInDataConName :: BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name -> Name
-mkWiredInDataConName built_in mod fs uniq datacon parent
- = mkWiredInName mod (mkOccNameFS dataName fs) uniq
- (Just parent) -- Name of parent TyCon
+mkWiredInDataConName :: BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
+mkWiredInDataConName built_in modu fs unique datacon
+ = mkWiredInName modu (mkOccNameFS dataName fs) unique
(ADataCon datacon) -- Relevant DataCon
built_in
-charTyConName = mkWiredInTyConName UserSyntax pREL_BASE FSLIT("Char") charTyConKey charTyCon
-charDataConName = mkWiredInDataConName UserSyntax pREL_BASE FSLIT("C#") charDataConKey charDataCon charTyConName
-intTyConName = mkWiredInTyConName UserSyntax pREL_BASE FSLIT("Int") intTyConKey intTyCon
-intDataConName = mkWiredInDataConName UserSyntax pREL_BASE FSLIT("I#") intDataConKey intDataCon intTyConName
-
-boolTyConName = mkWiredInTyConName UserSyntax pREL_BASE FSLIT("Bool") boolTyConKey boolTyCon
-falseDataConName = mkWiredInDataConName UserSyntax pREL_BASE FSLIT("False") falseDataConKey falseDataCon boolTyConName
-trueDataConName = mkWiredInDataConName UserSyntax pREL_BASE FSLIT("True") trueDataConKey trueDataCon boolTyConName
-listTyConName = mkWiredInTyConName BuiltInSyntax pREL_BASE FSLIT("[]") listTyConKey listTyCon
-nilDataConName = mkWiredInDataConName BuiltInSyntax pREL_BASE FSLIT("[]") nilDataConKey nilDataCon listTyConName
-consDataConName = mkWiredInDataConName BuiltInSyntax pREL_BASE FSLIT(":") consDataConKey consDataCon listTyConName
-
-floatTyConName = mkWiredInTyConName UserSyntax pREL_FLOAT FSLIT("Float") floatTyConKey floatTyCon
-floatDataConName = mkWiredInDataConName UserSyntax pREL_FLOAT FSLIT("F#") floatDataConKey floatDataCon floatTyConName
-doubleTyConName = mkWiredInTyConName UserSyntax pREL_FLOAT FSLIT("Double") doubleTyConKey doubleTyCon
-doubleDataConName = mkWiredInDataConName UserSyntax pREL_FLOAT FSLIT("D#") doubleDataConKey doubleDataCon doubleTyConName
-
-parrTyConName = mkWiredInTyConName BuiltInSyntax pREL_PARR FSLIT("[::]") parrTyConKey parrTyCon
-parrDataConName = mkWiredInDataConName UserSyntax pREL_PARR FSLIT("PArr") parrDataConKey parrDataCon parrTyConName
-
+charTyConName, charDataConName, intTyConName, intDataConName :: Name
+charTyConName = mkWiredInTyConName UserSyntax gHC_BASE (fsLit "Char") charTyConKey charTyCon
+charDataConName = mkWiredInDataConName UserSyntax gHC_BASE (fsLit "C#") charDataConKey charDataCon
+intTyConName = mkWiredInTyConName UserSyntax gHC_BASE (fsLit "Int") intTyConKey intTyCon
+intDataConName = mkWiredInDataConName UserSyntax gHC_BASE (fsLit "I#") intDataConKey intDataCon
+
+boolTyConName, falseDataConName, trueDataConName :: Name
+boolTyConName = mkWiredInTyConName UserSyntax gHC_BOOL (fsLit "Bool") boolTyConKey boolTyCon
+falseDataConName = mkWiredInDataConName UserSyntax gHC_BOOL (fsLit "False") falseDataConKey falseDataCon
+trueDataConName = mkWiredInDataConName UserSyntax gHC_BOOL (fsLit "True") trueDataConKey trueDataCon
+
+listTyConName, nilDataConName, consDataConName :: Name
+listTyConName = mkWiredInTyConName BuiltInSyntax gHC_BASE (fsLit "[]") listTyConKey listTyCon
+nilDataConName = mkWiredInDataConName BuiltInSyntax gHC_BASE (fsLit "[]") nilDataConKey nilDataCon
+consDataConName = mkWiredInDataConName BuiltInSyntax gHC_BASE (fsLit ":") consDataConKey consDataCon
+
+floatTyConName, floatDataConName, doubleTyConName, doubleDataConName :: Name
+floatTyConName = mkWiredInTyConName UserSyntax gHC_FLOAT (fsLit "Float") floatTyConKey floatTyCon
+floatDataConName = mkWiredInDataConName UserSyntax gHC_FLOAT (fsLit "F#") floatDataConKey floatDataCon
+doubleTyConName = mkWiredInTyConName UserSyntax gHC_FLOAT (fsLit "Double") doubleTyConKey doubleTyCon
+doubleDataConName = mkWiredInDataConName UserSyntax gHC_FLOAT (fsLit "D#") doubleDataConKey doubleDataCon
+
+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
listTyCon_RDR = nameRdrName listTyConName
consDataCon_RDR = nameRdrName consDataConName
parrTyCon_RDR = nameRdrName parrTyConName
+{-
+tySuperKindTyCon_RDR = nameRdrName tySuperKindTyConName
+coSuperKindTyCon_RDR = nameRdrName coSuperKindTyConName
+liftedTypeKindTyCon_RDR = nameRdrName liftedTypeKindTyConName
+openTypeKindTyCon_RDR = nameRdrName openTypeKindTyConName
+unliftedTypeKindTyCon_RDR = nameRdrName unliftedTypeKindTyConName
+ubxTupleKindTyCon_RDR = nameRdrName ubxTupleKindTyConName
+argTypeKindTyCon_RDR = nameRdrName argTypeKindTyConName
+funKindTyCon_RDR = nameRdrName funKindTyConName
+-}
\end{code}
%************************************************************************
\begin{code}
+pcNonRecDataTyCon :: Name -> [TyVar] -> [DataCon] -> TyCon
pcNonRecDataTyCon = pcTyCon False NonRecursive
+pcRecDataTyCon :: Name -> [TyVar] -> [DataCon] -> TyCon
pcRecDataTyCon = pcTyCon False Recursive
-pcTyCon is_enum is_rec name tyvars argvrcs cons
+pcTyCon :: Bool -> RecFlag -> Name -> [TyVar] -> [DataCon] -> TyCon
+pcTyCon is_enum is_rec name tyvars cons
= tycon
where
tycon = mkAlgTyCon name
(mkArrowKinds (map tyVarKind tyvars) liftedTypeKind)
tyvars
- argvrcs
[] -- No stupid theta
(DataTyCon cons is_enum)
[] -- No record selectors
+ NoParentTyCon
is_rec
True -- All the wired-in tycons have generics
+ False -- Not in GADT syntax
pcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon = pcDataConWithFixity False
pcDataConWithFixity declared_infix dc_name tyvars arg_tys tycon
= data_con
where
- data_con = mkDataCon dc_name declared_infix True {- Vanilla -}
+ data_con = mkDataCon dc_name declared_infix
(map (const NotMarkedStrict) arg_tys)
- [{- No labelled fields -}]
- tyvars [] [] arg_tys tycon (mkTyVarTys tyvars)
+ [] -- No labelled fields
+ tyvars
+ [] -- No existential type variables
+ [] -- No equality spec
+ [] -- No theta
+ arg_tys tycon
+ [] -- No stupid theta
(mkDataConIds bogus_wrap_name wrk_name data_con)
- mod = nameModule dc_name
+ modu = nameModule dc_name
wrk_occ = mkDataConWorkerOcc (nameOccName dc_name)
wrk_key = incrUnique (nameUnique dc_name)
- wrk_name = mkWiredInName mod wrk_occ wrk_key
- (Just (tyConName tycon))
+ wrk_name = mkWiredInName modu wrk_occ wrk_key
(AnId (dataConWorkId data_con)) UserSyntax
bogus_wrap_name = pprPanic "Wired-in data wrapper id" (ppr dc_name)
-- Wired-in types are too simple to need wrappers
mk_tuple boxity arity = (tycon, tuple_con)
where
tycon = mkTupleTyCon tc_name tc_kind arity tyvars tuple_con boxity gen_info
- mod = mkTupleModule boxity arity
- tc_name = mkWiredInName mod (mkTupleOcc tcName boxity arity) tc_uniq
- Nothing (ATyCon tycon) BuiltInSyntax
+ modu = mkTupleModule boxity arity
+ tc_name = mkWiredInName modu (mkTupleOcc tcName boxity arity) tc_uniq
+ (ATyCon tycon) BuiltInSyntax
tc_kind = mkArrowKinds (map tyVarKind tyvars) res_kind
res_kind | isBoxed boxity = liftedTypeKind
| otherwise = ubxTupleKind
tuple_con = pcDataCon dc_name tyvars tyvar_tys tycon
tyvar_tys = mkTyVarTys tyvars
- dc_name = mkWiredInName mod (mkTupleOcc dataName boxity arity) dc_uniq
- (Just tc_name) (ADataCon tuple_con) BuiltInSyntax
+ dc_name = mkWiredInName modu (mkTupleOcc dataName boxity arity) dc_uniq
+ (ADataCon tuple_con) BuiltInSyntax
tc_uniq = mkTupleTyConUnique boxity arity
dc_uniq = mkTupleDataConUnique boxity arity
gen_info = True -- Tuples all have generics..
-- hmm: that's a *lot* of code
+unitTyCon :: TyCon
unitTyCon = tupleTyCon Boxed 0
+unitDataCon :: DataCon
unitDataCon = head (tyConDataCons unitTyCon)
+unitDataConId :: Id
unitDataConId = dataConWorkId unitDataCon
+pairTyCon :: TyCon
pairTyCon = tupleTyCon Boxed 2
+unboxedSingletonTyCon :: TyCon
unboxedSingletonTyCon = tupleTyCon Unboxed 1
+unboxedSingletonDataCon :: DataCon
unboxedSingletonDataCon = tupleCon Unboxed 1
+unboxedPairTyCon :: TyCon
unboxedPairTyCon = tupleTyCon Unboxed 2
+unboxedPairDataCon :: DataCon
unboxedPairDataCon = tupleCon Unboxed 2
\end{code}
%************************************************************************
\begin{code}
--- The Void type is represented as a data type with no constructors
--- It's a built in type (i.e. there's no way to define it in Haskell;
--- the nearest would be
---
--- data Void = -- No constructors!
---
--- ) It's lifted; there is only one value of this
--- type, namely "void", whose semantics is just bottom.
---
--- Haskell 98 drops the definition of a Void type, so we just 'simulate'
--- voidTy using ().
-voidTy = unitTy
-\end{code}
-
-
-\begin{code}
+charTy :: Type
charTy = mkTyConTy charTyCon
-charTyCon = pcNonRecDataTyCon charTyConName [] [] [charDataCon]
+charTyCon :: TyCon
+charTyCon = pcNonRecDataTyCon charTyConName [] [charDataCon]
+charDataCon :: DataCon
charDataCon = pcDataCon charDataConName [] [charPrimTy] charTyCon
+stringTy :: Type
stringTy = mkListTy charTy -- convenience only
\end{code}
\begin{code}
+intTy :: Type
intTy = mkTyConTy intTyCon
-intTyCon = pcNonRecDataTyCon intTyConName [] [] [intDataCon]
+intTyCon :: TyCon
+intTyCon = pcNonRecDataTyCon intTyConName [] [intDataCon]
+intDataCon :: DataCon
intDataCon = pcDataCon intDataConName [] [intPrimTy] intTyCon
\end{code}
\begin{code}
+floatTy :: Type
floatTy = mkTyConTy floatTyCon
-floatTyCon = pcNonRecDataTyCon floatTyConName [] [] [floatDataCon]
+floatTyCon :: TyCon
+floatTyCon = pcNonRecDataTyCon floatTyConName [] [floatDataCon]
+floatDataCon :: DataCon
floatDataCon = pcDataCon floatDataConName [] [floatPrimTy] floatTyCon
\end{code}
\begin{code}
+doubleTy :: Type
doubleTy = mkTyConTy doubleTyCon
-doubleTyCon = pcNonRecDataTyCon doubleTyConName [] [] [doubleDataCon]
-doubleDataCon = pcDataCon doubleDataConName [] [doublePrimTy] doubleTyCon
+doubleTyCon :: TyCon
+doubleTyCon = pcNonRecDataTyCon doubleTyConName [] [doubleDataCon]
+
+doubleDataCon :: DataCon
+doubleDataCon = pcDataCon doubleDataConName [] [doublePrimTy] doubleTyCon
\end{code}
{\em END IDLE SPECULATION BY SIMON}
\begin{code}
+boolTy :: Type
boolTy = mkTyConTy boolTyCon
+boolTyCon :: TyCon
boolTyCon = pcTyCon True NonRecursive boolTyConName
- [] [] [falseDataCon, trueDataCon]
+ [] [falseDataCon, trueDataCon]
+falseDataCon, trueDataCon :: DataCon
falseDataCon = pcDataCon falseDataConName [] [] boolTyCon
trueDataCon = pcDataCon trueDataConName [] [] boolTyCon
+falseDataConId, trueDataConId :: Id
falseDataConId = dataConWorkId falseDataCon
trueDataConId = dataConWorkId trueDataCon
\end{code}
mkListTy :: Type -> Type
mkListTy ty = mkTyConApp listTyCon [ty]
-listTyCon = pcRecDataTyCon listTyConName
- alpha_tyvar [(True,False)] [nilDataCon, consDataCon]
+listTyCon :: TyCon
+listTyCon = pcRecDataTyCon listTyConName alpha_tyvar [nilDataCon, consDataCon]
+nilDataCon :: DataCon
nilDataCon = pcDataCon nilDataConName alpha_tyvar [] listTyCon
+consDataCon :: DataCon
consDataCon = pcDataConWithFixity True {- Declared infix -}
consDataConName
alpha_tyvar [alphaTy, mkTyConApp listTyCon alpha_ty] listTyCon
mkTupleTy :: Boxity -> Int -> [Type] -> Type
mkTupleTy boxity arity tys = mkTyConApp (tupleTyCon boxity arity) tys
-unitTy = mkTupleTy Boxed 0 []
+unitTy :: Type
+unitTy = mkTupleTy Boxed 0 []
\end{code}
%************************************************************************
-- `PrelPArr'.
--
parrTyCon :: TyCon
-parrTyCon = pcNonRecDataTyCon parrTyConName alpha_tyvar [(True, False)] [parrDataCon]
+parrTyCon = pcNonRecDataTyCon parrTyConName alpha_tyvar [parrDataCon]
parrDataCon :: DataCon
parrDataCon = pcDataCon
tyvar = head alphaTyVars
tyvarTys = replicate arity $ mkTyVarTy tyvar
nameStr = mkFastString ("MkPArr" ++ show arity)
- name = mkWiredInName pREL_PARR (mkOccNameFS dataName nameStr) uniq
- Nothing (ADataCon data_con) UserSyntax
- uniq = mkPArrDataConUnique arity
+ name = mkWiredInName gHC_PARR (mkOccNameFS dataName nameStr) unique
+ (ADataCon data_con) UserSyntax
+ unique = mkPArrDataConUnique arity
-- checks whether a data constructor is a fake constructor for parallel arrays
--
isPArrFakeCon dcon = dcon == parrFakeCon (dataConSourceArity dcon)
\end{code}
+
projects / ghc-hetmet.git / blobdiff