X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprelude%2FTysWiredIn.lhs;h=ceb4df550aaec8e0651aa43cb63604a130e0782f;hb=9d7da331989abcd1844e9d03b8d1e4163796fa85;hp=4d8de984e3a9a24bc14a07c29ef1e7b5280e99d5;hpb=98688c6e8fd33f31c51218cf93cbf03fe3a5e73d;p=ghc-hetmet.git diff --git a/ghc/compiler/prelude/TysWiredIn.lhs b/ghc/compiler/prelude/TysWiredIn.lhs index 4d8de98..ceb4df5 100644 --- a/ghc/compiler/prelude/TysWiredIn.lhs +++ b/ghc/compiler/prelude/TysWiredIn.lhs @@ -21,9 +21,9 @@ module TysWiredIn ( charTy, stringTy, charTyConName, - doubleTyCon, doubleDataCon, doubleTy, + doubleTyCon, doubleDataCon, doubleTy, doubleTyConName, - floatTyCon, floatDataCon, floatTy, + floatTyCon, floatDataCon, floatTy, floatTyConName, intTyCon, intDataCon, intTyCon_RDR, intDataCon_RDR, intTyConName, intTy, @@ -60,23 +60,23 @@ 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 OccName ( mkOccNameFS, tcName, dataName, mkTupleOcc, + mkDataConWorkerOcc ) import DataCon ( DataCon, mkDataCon, dataConWorkId, dataConSourceArity ) import Var ( TyVar, tyVarKind ) -import TyCon ( TyCon, AlgTyConFlavour(..), DataConDetails(..), tyConDataCons, - mkTupleTyCon, mkAlgTyCon, tyConName - ) +import TyCon ( TyCon, AlgTyConRhs(DataTyCon), tyConDataCons, + mkTupleTyCon, mkAlgTyCon, tyConName ) -import BasicTypes ( Arity, RecFlag(..), Boxity(..), isBoxed, StrictnessMark(..) ) +import BasicTypes ( Arity, RecFlag(..), Boxity(..), isBoxed, + StrictnessMark(..) ) -import Type ( Type, mkTyConTy, mkTyConApp, mkTyVarTy, mkTyVarTys, - mkArrowKinds, liftedTypeKind, unliftedTypeKind, - ThetaType, TyThing(..) ) +import Type ( Type, mkTyConTy, mkTyConApp, mkTyVarTy, mkTyVarTys, + TyThing(..) ) +import Kind ( mkArrowKinds, liftedTypeKind, ubxTupleKind ) import Unique ( incrUnique, mkTupleTyConUnique, mkTupleDataConUnique, mkPArrDataConUnique ) -import PrelNames import Array import FastString import Outputable @@ -114,37 +114,39 @@ wiredInTyCons = [ unitTyCon -- Not treated like other tuples, because \end{code} \begin{code} -mkWiredInTyConName :: Module -> FastString -> Unique -> TyCon -> Name -mkWiredInTyConName mod fs uniq tycon - = mkWiredInName mod (mkOccFS tcName fs) uniq +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 :: Module -> FastString -> Unique -> DataCon -> Name -> Name -mkWiredInDataConName mod fs uniq datacon parent - = mkWiredInName mod (mkOccFS dataName fs) uniq +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 (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 @@ -174,15 +176,17 @@ pcTyCon is_enum is_rec name tyvars argvrcs cons tycon = mkAlgTyCon name (mkArrowKinds (map tyVarKind tyvars) liftedTypeKind) tyvars - [] -- No context argvrcs - (DataCons cons) - [] -- No record selectors - (DataTyCon is_enum) + [] -- No stupid theta + (DataTyCon cons is_enum) + [] -- No record selectors 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,21 +194,22 @@ 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 True {- Vanilla -} (map (const NotMarkedStrict) arg_tys) [{- No labelled fields -}] - tyvars context [] [] arg_tys tycon + tyvars [] [] arg_tys tycon (mkTyVarTys tyvars) (mkDataConIds bogus_wrap_name wrk_name data_con) + mod = 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)) - (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) @@ -481,7 +487,7 @@ mkPArrTy ty = mkTyConApp parrTyCon [ty] -- represents the type constructor of parallel arrays -- --- * this must match the definition in `PrelPArr' +-- * this must match the definition in `PrelPArr' -- -- NB: Although the constructor is given here, it will not be accessible in -- user code as it is not in the environment of any compiled module except @@ -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 @@ -508,7 +513,7 @@ isPArrTyCon tc = tyConName tc == parrTyConName -- fake array constructors -- --- * these constructors are never really used to represent array values; +-- * these constructors are never really used to represent array values; -- however, they are very convenient during desugaring (and, in particular, -- in the pattern matching compiler) to treat array pattern just like -- yet another constructor pattern @@ -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) + name = mkWiredInName pREL_PARR (mkOccNameFS dataName nameStr) uniq + Nothing (ADataCon data_con) UserSyntax uniq = mkPArrDataConUnique arity -- checks whether a data constructor is a fake constructor for parallel arrays