X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprelude%2FTysWiredIn.lhs;h=eb8124f8f5769fe2b308d82a8f602d7f7ea62177;hb=bb88e732b7383c10496c0f60c3bdea2c22362cc6;hp=4d8de984e3a9a24bc14a07c29ef1e7b5280e99d5;hpb=98688c6e8fd33f31c51218cf93cbf03fe3a5e73d;p=ghc-hetmet.git diff --git a/ghc/compiler/prelude/TysWiredIn.lhs b/ghc/compiler/prelude/TysWiredIn.lhs index 4d8de98..eb8124f 100644 --- a/ghc/compiler/prelude/TysWiredIn.lhs +++ b/ghc/compiler/prelude/TysWiredIn.lhs @@ -60,20 +60,21 @@ import TysPrim import Constants ( mAX_TUPLE_SIZE ) import Module ( Module ) import RdrName ( nameRdrName ) -import Name ( Name, nameUnique, nameOccName, +import Name ( Name, BuiltInSyntax(..), nameUnique, nameOccName, nameModule, mkWiredInName ) import OccName ( mkOccFS, tcName, dataName, mkTupleOcc, mkDataConWorkerOcc ) import DataCon ( DataCon, mkDataCon, dataConWorkId, dataConSourceArity ) import Var ( TyVar, tyVarKind ) -import TyCon ( TyCon, AlgTyConFlavour(..), DataConDetails(..), tyConDataCons, +import TyCon ( TyCon, AlgTyConRhs(DataTyCon), tyConDataCons, mkTupleTyCon, mkAlgTyCon, tyConName ) -import BasicTypes ( Arity, RecFlag(..), Boxity(..), isBoxed, StrictnessMark(..) ) +import BasicTypes ( Arity, RecFlag(..), Boxity(..), isBoxed, StrictnessMark(..), + Fixity(..), FixityDirection(..), defaultFixity ) import Type ( Type, mkTyConTy, mkTyConApp, mkTyVarTy, mkTyVarTys, - mkArrowKinds, liftedTypeKind, unliftedTypeKind, ThetaType, TyThing(..) ) +import Kind ( mkArrowKinds, liftedTypeKind, ubxTupleKind ) import Unique ( incrUnique, mkTupleTyConUnique, mkTupleDataConUnique, mkPArrDataConUnique ) import PrelNames @@ -114,37 +115,39 @@ wiredInTyCons = [ unitTyCon -- Not treated like other tuples, because \end{code} \begin{code} -mkWiredInTyConName :: Module -> FastString -> Unique -> TyCon -> Name -mkWiredInTyConName mod fs uniq tycon +mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name +mkWiredInTyConName built_in mod fs uniq tycon = mkWiredInName mod (mkOccFS tcName fs) uniq Nothing -- No parent object (ATyCon tycon) -- Relevant TyCon + built_in -mkWiredInDataConName :: Module -> FastString -> Unique -> DataCon -> Name -> Name -mkWiredInDataConName mod fs uniq datacon parent +mkWiredInDataConName :: BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name -> Name +mkWiredInDataConName built_in mod fs uniq datacon parent = mkWiredInName mod (mkOccFS dataName fs) uniq (Just parent) -- Name of parent TyCon (ADataCon datacon) -- Relevant DataCon + built_in -charTyConName = mkWiredInTyConName pREL_BASE FSLIT("Char") charTyConKey charTyCon -charDataConName = mkWiredInDataConName pREL_BASE FSLIT("C#") charDataConKey charDataCon charTyConName -intTyConName = mkWiredInTyConName pREL_BASE FSLIT("Int") intTyConKey intTyCon -intDataConName = mkWiredInDataConName pREL_BASE FSLIT("I#") intDataConKey intDataCon intTyConName +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 pREL_BASE FSLIT("Bool") boolTyConKey boolTyCon -falseDataConName = mkWiredInDataConName pREL_BASE FSLIT("False") falseDataConKey falseDataCon boolTyConName -trueDataConName = mkWiredInDataConName pREL_BASE FSLIT("True") trueDataConKey trueDataCon boolTyConName -listTyConName = mkWiredInTyConName pREL_BASE FSLIT("[]") listTyConKey listTyCon -nilDataConName = mkWiredInDataConName pREL_BASE FSLIT("[]") nilDataConKey nilDataCon listTyConName -consDataConName = mkWiredInDataConName pREL_BASE FSLIT(":") consDataConKey consDataCon listTyConName +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 pREL_FLOAT FSLIT("Float") floatTyConKey floatTyCon -floatDataConName = mkWiredInDataConName pREL_FLOAT FSLIT("F#") floatDataConKey floatDataCon floatTyConName -doubleTyConName = mkWiredInTyConName pREL_FLOAT FSLIT("Double") doubleTyConKey doubleTyCon -doubleDataConName = mkWiredInDataConName pREL_FLOAT FSLIT("D#") doubleDataConKey doubleDataCon doubleTyConName +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 pREL_PARR FSLIT("[::]") parrTyConKey parrTyCon -parrDataConName = mkWiredInDataConName pREL_PARR FSLIT("PArr") parrDataConKey parrDataCon parrTyConName +parrTyConName = mkWiredInTyConName BuiltInSyntax pREL_PARR FSLIT("[::]") parrTyConKey parrTyCon +parrDataConName = mkWiredInDataConName UserSyntax pREL_PARR FSLIT("PArr") parrDataConKey parrDataCon parrTyConName boolTyCon_RDR = nameRdrName boolTyConName false_RDR = nameRdrName falseDataConName @@ -176,13 +179,15 @@ pcTyCon is_enum is_rec name tyvars argvrcs cons tyvars [] -- No context argvrcs - (DataCons cons) + (DataTyCon cons is_enum) [] -- No record selectors - (DataTyCon is_enum) is_rec True -- All the wired-in tycons have generics -pcDataCon :: Name -> [TyVar] -> ThetaType -> [Type] -> TyCon -> DataCon +pcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon +pcDataCon = pcDataConWithFixity False + +pcDataConWithFixity :: Bool -> Name -> [TyVar] -> [Type] -> TyCon -> DataCon -- The Name should be in the DataName name space; it's the name -- of the DataCon itself. -- @@ -190,13 +195,13 @@ pcDataCon :: Name -> [TyVar] -> ThetaType -> [Type] -> TyCon -> DataCon -- the first is used for the datacon itself, -- the second is used for the "worker name" -pcDataCon dc_name tyvars context arg_tys tycon +pcDataConWithFixity declared_infix dc_name tyvars arg_tys tycon = data_con where - data_con = mkDataCon dc_name + data_con = mkDataCon dc_name declared_infix (map (const NotMarkedStrict) arg_tys) [{- No labelled fields -}] - tyvars context [] [] arg_tys tycon + tyvars [] [] [] arg_tys tycon (mkDataConIds bogus_wrap_name wrk_name data_con) mod = nameModule dc_name @@ -204,7 +209,7 @@ pcDataCon dc_name tyvars context arg_tys tycon wrk_key = incrUnique (nameUnique dc_name) wrk_name = mkWiredInName mod wrk_occ wrk_key (Just (tyConName tycon)) - (AnId (dataConWorkId data_con)) + (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 \end{code} @@ -237,18 +242,18 @@ 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) + Nothing (ATyCon tycon) BuiltInSyntax tc_kind = mkArrowKinds (map tyVarKind tyvars) res_kind res_kind | isBoxed boxity = liftedTypeKind - | otherwise = unliftedTypeKind + | otherwise = ubxTupleKind tyvars | isBoxed boxity = take arity alphaTyVars | otherwise = take arity openAlphaTyVars - tuple_con = pcDataCon dc_name tyvars [] tyvar_tys tycon + 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) + (Just tc_name) (ADataCon tuple_con) BuiltInSyntax tc_uniq = mkTupleTyConUnique boxity arity dc_uniq = mkTupleDataConUnique boxity arity gen_info = True -- Tuples all have generics.. @@ -293,7 +298,7 @@ voidTy = unitTy charTy = mkTyConTy charTyCon charTyCon = pcNonRecDataTyCon charTyConName [] [] [charDataCon] -charDataCon = pcDataCon charDataConName [] [] [charPrimTy] charTyCon +charDataCon = pcDataCon charDataConName [] [charPrimTy] charTyCon stringTy = mkListTy charTy -- convenience only \end{code} @@ -302,21 +307,21 @@ stringTy = mkListTy charTy -- convenience only intTy = mkTyConTy intTyCon intTyCon = pcNonRecDataTyCon intTyConName [] [] [intDataCon] -intDataCon = pcDataCon intDataConName [] [] [intPrimTy] intTyCon +intDataCon = pcDataCon intDataConName [] [intPrimTy] intTyCon \end{code} \begin{code} floatTy = mkTyConTy floatTyCon floatTyCon = pcNonRecDataTyCon floatTyConName [] [] [floatDataCon] -floatDataCon = pcDataCon floatDataConName [] [] [floatPrimTy] floatTyCon +floatDataCon = pcDataCon floatDataConName [] [floatPrimTy] floatTyCon \end{code} \begin{code} doubleTy = mkTyConTy doubleTyCon doubleTyCon = pcNonRecDataTyCon doubleTyConName [] [] [doubleDataCon] -doubleDataCon = pcDataCon doubleDataConName [] [] [doublePrimTy] doubleTyCon +doubleDataCon = pcDataCon doubleDataConName [] [doublePrimTy] doubleTyCon \end{code} @@ -374,8 +379,8 @@ boolTy = mkTyConTy boolTyCon boolTyCon = pcTyCon True NonRecursive boolTyConName [] [] [falseDataCon, trueDataCon] -falseDataCon = pcDataCon falseDataConName [] [] [] boolTyCon -trueDataCon = pcDataCon trueDataConName [] [] [] boolTyCon +falseDataCon = pcDataCon falseDataConName [] [] boolTyCon +trueDataCon = pcDataCon trueDataConName [] [] boolTyCon falseDataConId = dataConWorkId falseDataCon trueDataConId = dataConWorkId trueDataCon @@ -403,9 +408,10 @@ mkListTy ty = mkTyConApp listTyCon [ty] listTyCon = pcRecDataTyCon listTyConName alpha_tyvar [(True,False)] [nilDataCon, consDataCon] -nilDataCon = pcDataCon nilDataConName alpha_tyvar [] [] listTyCon -consDataCon = pcDataCon consDataConName - alpha_tyvar [] [alphaTy, mkTyConApp listTyCon alpha_ty] listTyCon +nilDataCon = pcDataCon nilDataConName alpha_tyvar [] listTyCon +consDataCon = pcDataConWithFixity True {- Declared infix -} + consDataConName + alpha_tyvar [alphaTy, mkTyConApp listTyCon alpha_ty] listTyCon -- Interesting: polymorphic recursion would help here. -- We can't use (mkListTy alphaTy) in the defn of consDataCon, else mkListTy -- gets the over-specific type (Type -> Type) @@ -494,7 +500,6 @@ parrDataCon :: DataCon parrDataCon = pcDataCon parrDataConName alpha_tyvar -- forall'ed type variables - [] -- context [intPrimTy, -- 1st argument: Int# mkTyConApp -- 2nd argument: Array# a arrayPrimTyCon @@ -528,12 +533,12 @@ parrFakeConArr = array (0, mAX_TUPLE_SIZE) [(i, mkPArrFakeCon i) mkPArrFakeCon :: Int -> DataCon mkPArrFakeCon arity = data_con where - data_con = pcDataCon name [tyvar] [] tyvarTys parrTyCon + data_con = pcDataCon name [tyvar] tyvarTys parrTyCon tyvar = head alphaTyVars tyvarTys = replicate arity $ mkTyVarTy tyvar nameStr = mkFastString ("MkPArr" ++ show arity) name = mkWiredInName pREL_PARR (mkOccFS dataName nameStr) uniq - Nothing (ADataCon data_con) + Nothing (ADataCon data_con) UserSyntax uniq = mkPArrDataConUnique arity -- checks whether a data constructor is a fake constructor for parallel arrays