X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fprelude%2FTysWiredIn.lhs;h=436b121adcf2862129cd4d86814f92d3710462d4;hp=ceb4df550aaec8e0651aa43cb63604a130e0782f;hb=b00b5bc04ff36a551552470060064f0b7d84ca30;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1 diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs index ceb4df5..436b121 100644 --- a/compiler/prelude/TysWiredIn.lhs +++ b/compiler/prelude/TysWiredIn.lhs @@ -67,14 +67,18 @@ import OccName ( mkOccNameFS, tcName, dataName, mkTupleOcc, import DataCon ( DataCon, mkDataCon, dataConWorkId, dataConSourceArity ) import Var ( TyVar, tyVarKind ) import TyCon ( TyCon, AlgTyConRhs(DataTyCon), tyConDataCons, - mkTupleTyCon, mkAlgTyCon, tyConName ) + mkTupleTyCon, mkAlgTyCon, tyConName, + AlgTyConParent(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 @@ -97,6 +101,12 @@ names in PrelNames, so they use wTcQual, wDataQual, etc \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 @@ -110,6 +120,12 @@ wiredInTyCons = [ unitTyCon -- Not treated like other tuples, because , intTyCon , listTyCon , parrTyCon + , unsafeCoercionTyCon + , symCoercionTyCon + , transCoercionTyCon + , leftCoercionTyCon + , rightCoercionTyCon + , instCoercionTyCon ] \end{code} @@ -117,36 +133,34 @@ wiredInTyCons = [ unitTyCon -- Not treated like other tuples, because mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name mkWiredInTyConName built_in mod fs uniq tycon = mkWiredInName mod (mkOccNameFS tcName fs) uniq - Nothing -- No parent object (ATyCon tycon) -- Relevant TyCon built_in -mkWiredInDataConName :: BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name -> Name -mkWiredInDataConName built_in mod fs uniq datacon parent +mkWiredInDataConName :: BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name +mkWiredInDataConName built_in mod fs uniq datacon = mkWiredInName mod (mkOccNameFS dataName fs) uniq - (Just parent) -- Name of parent TyCon (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 +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 = 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 +boolTyConName = mkWiredInTyConName UserSyntax gHC_BASE FSLIT("Bool") boolTyConKey boolTyCon +falseDataConName = mkWiredInDataConName UserSyntax gHC_BASE FSLIT("False") falseDataConKey falseDataCon +trueDataConName = mkWiredInDataConName UserSyntax gHC_BASE FSLIT("True") trueDataConKey trueDataCon +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 = 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 +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 = mkWiredInTyConName BuiltInSyntax pREL_PARR FSLIT("[::]") parrTyConKey parrTyCon -parrDataConName = mkWiredInDataConName UserSyntax pREL_PARR FSLIT("PArr") parrDataConKey parrDataCon parrTyConName +parrTyConName = mkWiredInTyConName BuiltInSyntax gHC_PARR FSLIT("[::]") parrTyConKey parrTyCon +parrDataConName = mkWiredInDataConName UserSyntax gHC_PARR FSLIT("PArr") parrDataConKey parrDataCon boolTyCon_RDR = nameRdrName boolTyConName false_RDR = nameRdrName falseDataConName @@ -157,6 +171,16 @@ intDataCon_RDR = nameRdrName intDataConName 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} @@ -170,18 +194,19 @@ parrTyCon_RDR = nameRdrName parrTyConName pcNonRecDataTyCon = pcTyCon False NonRecursive pcRecDataTyCon = pcTyCon False Recursive -pcTyCon is_enum is_rec name tyvars argvrcs cons +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 @@ -197,10 +222,15 @@ pcDataConWithFixity :: Bool -> Name -> [TyVar] -> [Type] -> TyCon -> DataCon 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) @@ -208,7 +238,6 @@ pcDataConWithFixity declared_infix dc_name tyvars arg_tys tycon wrk_occ = mkDataConWorkerOcc (nameOccName dc_name) wrk_key = incrUnique (nameUnique dc_name) wrk_name = mkWiredInName mod wrk_occ wrk_key - (Just (tyConName tycon)) (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 @@ -242,7 +271,7 @@ mk_tuple boxity arity = (tycon, tuple_con) 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 + (ATyCon tycon) BuiltInSyntax tc_kind = mkArrowKinds (map tyVarKind tyvars) res_kind res_kind | isBoxed boxity = liftedTypeKind | otherwise = ubxTupleKind @@ -253,7 +282,7 @@ mk_tuple boxity arity = (tycon, tuple_con) 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 + (ADataCon tuple_con) BuiltInSyntax tc_uniq = mkTupleTyConUnique boxity arity dc_uniq = mkTupleDataConUnique boxity arity gen_info = True -- Tuples all have generics.. @@ -297,7 +326,7 @@ voidTy = unitTy \begin{code} charTy = mkTyConTy charTyCon -charTyCon = pcNonRecDataTyCon charTyConName [] [] [charDataCon] +charTyCon = pcNonRecDataTyCon charTyConName [] [charDataCon] charDataCon = pcDataCon charDataConName [] [charPrimTy] charTyCon stringTy = mkListTy charTy -- convenience only @@ -306,21 +335,21 @@ stringTy = mkListTy charTy -- convenience only \begin{code} intTy = mkTyConTy intTyCon -intTyCon = pcNonRecDataTyCon intTyConName [] [] [intDataCon] +intTyCon = pcNonRecDataTyCon intTyConName [] [intDataCon] intDataCon = pcDataCon intDataConName [] [intPrimTy] intTyCon \end{code} \begin{code} floatTy = mkTyConTy floatTyCon -floatTyCon = pcNonRecDataTyCon floatTyConName [] [] [floatDataCon] +floatTyCon = pcNonRecDataTyCon floatTyConName [] [floatDataCon] floatDataCon = pcDataCon floatDataConName [] [floatPrimTy] floatTyCon \end{code} \begin{code} doubleTy = mkTyConTy doubleTyCon -doubleTyCon = pcNonRecDataTyCon doubleTyConName [] [] [doubleDataCon] +doubleTyCon = pcNonRecDataTyCon doubleTyConName [] [doubleDataCon] doubleDataCon = pcDataCon doubleDataConName [] [doublePrimTy] doubleTyCon \end{code} @@ -377,7 +406,7 @@ primitive counterpart. boolTy = mkTyConTy boolTyCon boolTyCon = pcTyCon True NonRecursive boolTyConName - [] [] [falseDataCon, trueDataCon] + [] [falseDataCon, trueDataCon] falseDataCon = pcDataCon falseDataConName [] [] boolTyCon trueDataCon = pcDataCon trueDataConName [] [] boolTyCon @@ -405,8 +434,7 @@ data (,) a b = (,,) a b mkListTy :: Type -> Type mkListTy ty = mkTyConApp listTyCon [ty] -listTyCon = pcRecDataTyCon listTyConName - alpha_tyvar [(True,False)] [nilDataCon, consDataCon] +listTyCon = pcRecDataTyCon listTyConName alpha_tyvar [nilDataCon, consDataCon] nilDataCon = pcDataCon nilDataConName alpha_tyvar [] listTyCon consDataCon = pcDataConWithFixity True {- Declared infix -} @@ -494,7 +522,7 @@ mkPArrTy ty = mkTyConApp parrTyCon [ty] -- `PrelPArr'. -- parrTyCon :: TyCon -parrTyCon = pcNonRecDataTyCon parrTyConName alpha_tyvar [(True, False)] [parrDataCon] +parrTyCon = pcNonRecDataTyCon parrTyConName alpha_tyvar [parrDataCon] parrDataCon :: DataCon parrDataCon = pcDataCon @@ -537,8 +565,8 @@ mkPArrFakeCon arity = data_con 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 + name = mkWiredInName gHC_PARR (mkOccNameFS dataName nameStr) uniq + (ADataCon data_con) UserSyntax uniq = mkPArrDataConUnique arity -- checks whether a data constructor is a fake constructor for parallel arrays @@ -547,3 +575,4 @@ isPArrFakeCon :: DataCon -> Bool isPArrFakeCon dcon = dcon == parrFakeCon (dataConSourceArity dcon) \end{code} +