X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprelude%2FTysWiredIn.lhs;h=c8ffc3b9a090790eb338bc8a865f7171dfa4662d;hb=f714e6b642fd614a9971717045ae47c3d871275e;hp=3d234338500b4314aa8f3609436bcff8ae93a466;hpb=7e602b0a11e567fcb035d1afd34015aebcf9a577;p=ghc-hetmet.git diff --git a/ghc/compiler/prelude/TysWiredIn.lhs b/ghc/compiler/prelude/TysWiredIn.lhs index 3d23433..c8ffc3b 100644 --- a/ghc/compiler/prelude/TysWiredIn.lhs +++ b/ghc/compiler/prelude/TysWiredIn.lhs @@ -11,249 +11,260 @@ types and operations.'' \begin{code} module TysWiredIn ( - addrDataCon, - addrTy, - addrTyCon, - boolTy, - boolTyCon, - charDataCon, - charTy, - charTyCon, - consDataCon, - doubleDataCon, - doubleTy, - isDoubleTy, - doubleTyCon, - falseDataCon, - floatDataCon, - floatTy, - isFloatTy, - floatTyCon, - - voidTyCon, voidTy, - - intDataCon, - intTy, - intTyCon, - isIntTy, - inIntRange, + wiredInTyCons, - int8TyCon, - int16TyCon, - int32TyCon, + boolTy, boolTyCon, boolTyCon_RDR, boolTyConName, + trueDataCon, trueDataConId, true_RDR, + falseDataCon, falseDataConId, false_RDR, - int64TyCon, - int64DataCon, --- int64Ty, + charTyCon, charDataCon, charTyCon_RDR, + charTy, stringTy, charTyConName, - integerTy, - integerTyCon, - integerDataCon, - isIntegerTy, + + doubleTyCon, doubleDataCon, doubleTy, + + floatTyCon, floatDataCon, floatTy, - listTyCon, + intTyCon, intDataCon, intTyCon_RDR, intDataCon_RDR, intTyConName, + intTy, + listTyCon, nilDataCon, consDataCon, + listTyCon_RDR, consDataCon_RDR, listTyConName, mkListTy, - nilDataCon, -- tuples mkTupleTy, - tupleTyCon, tupleCon, unitTyCon, unitDataCon, pairTyCon, pairDataCon, - - -- unboxed tuples - mkUnboxedTupleTy, - unboxedTupleTyCon, unboxedTupleCon, + tupleTyCon, tupleCon, + unitTyCon, unitDataCon, unitDataConId, pairTyCon, + unboxedSingletonTyCon, unboxedSingletonDataCon, unboxedPairTyCon, unboxedPairDataCon, - stateDataCon, - stateTyCon, - realWorldStateTy, - - stablePtrTyCon, - stringTy, - trueDataCon, unitTy, - wordDataCon, - wordTy, - wordTyCon, - - word8TyCon, - word16TyCon, - word32TyCon, - - word64DataCon, --- word64Ty, - word64TyCon, - - isFFIArgumentTy, -- :: Type -> Bool - isFFIResultTy, -- :: Type -> Bool - isFFIExternalTy, -- :: Type -> Bool - isAddrTy, -- :: Type -> Bool + voidTy, + -- parallel arrays + mkPArrTy, + parrTyCon, parrFakeCon, isPArrTyCon, isPArrFakeCon, + parrTyCon_RDR, parrTyConName ) where #include "HsVersions.h" -import {-# SOURCE #-} MkId( mkDataConId ) +import {-# SOURCE #-} MkId( mkDataConIds ) -- friends: -import PrelMods +import PrelNames import TysPrim -- others: import Constants ( mAX_TUPLE_SIZE ) -import Name ( Module, varOcc, mkWiredInTyConName, mkWiredInIdName ) -import DataCon ( DataCon, mkDataCon ) +import Module ( Module ) +import RdrName ( nameRdrName ) +import Name ( Name, nameUnique, nameOccName, + nameModule, mkWiredInName ) +import OccName ( mkOccFS, tcName, dataName, mkTupleOcc, mkDataConWorkerOcc ) +import DataCon ( DataCon, mkDataCon, dataConWorkId, dataConSourceArity ) import Var ( TyVar, tyVarKind ) -import TyCon ( TyCon, mkAlgTyCon, mkSynTyCon, mkTupleTyCon ) -import BasicTypes ( Arity, NewOrData(..), - RecFlag(..), StrictnessMark(..) ) -import Type ( Type, mkTyConTy, mkTyConApp, mkSigmaTy, mkTyVarTys, - mkArrowKinds, boxedTypeKind, unboxedTypeKind, - mkFunTy, mkFunTys, isUnLiftedType, - splitTyConApp_maybe, splitAlgTyConApp_maybe, - ThetaType, TauType ) -import PrimRep ( PrimRep(..) ) -import Unique -import CmdLineOpts ( opt_GlasgowExts ) -import Util ( assoc ) -import Panic ( panic ) +import TyCon ( TyCon, AlgTyConFlavour(..), DataConDetails(..), tyConDataCons, + mkTupleTyCon, mkAlgTyCon, tyConName + ) + +import BasicTypes ( Arity, RecFlag(..), Boxity(..), isBoxed, StrictnessMark(..) ) + +import Type ( Type, mkTyConTy, mkTyConApp, mkTyVarTy, mkTyVarTys, + ThetaType, TyThing(..) ) +import Kind ( mkArrowKinds, liftedTypeKind, ubxTupleKind ) +import Unique ( incrUnique, mkTupleTyConUnique, + mkTupleDataConUnique, mkPArrDataConUnique ) +import PrelNames import Array +import FastString +import Outputable -alpha_tyvar = [alphaTyVar] -alpha_ty = [alphaTy] -alpha_beta_tyvars = [alphaTyVar, betaTyVar] - -pcRecDataTyCon, pcNonRecDataTyCon, pcNonRecNewTyCon - :: Unique{-TyConKey-} -> Module -> FAST_STRING - -> [TyVar] -> [DataCon] -> TyCon - -pcRecDataTyCon = pcTyCon DataType Recursive -pcNonRecDataTyCon = pcTyCon DataType NonRecursive -pcNonRecNewTyCon = pcTyCon NewType NonRecursive - -pcTyCon new_or_data is_rec key mod str tyvars cons - = tycon - where - tycon = mkAlgTyCon name kind - tyvars - [] -- No context - cons - [] -- No derivings - Nothing -- Not a dictionary - new_or_data - is_rec - - name = mkWiredInTyConName key mod str tycon - kind = mkArrowKinds (map tyVarKind tyvars) boxedTypeKind - -pcSynTyCon key mod str kind arity tyvars expansion - = tycon - where - tycon = mkSynTyCon name kind arity tyvars expansion - name = mkWiredInTyConName key mod str tycon - -pcDataCon :: Unique{-DataConKey-} -> Module -> FAST_STRING - -> [TyVar] -> ThetaType -> [TauType] -> TyCon -> DataCon -pcDataCon key mod str tyvars context arg_tys tycon - = data_con - where - data_con = mkDataCon name - [ NotMarkedStrict | a <- arg_tys ] - [ {- no labelled fields -} ] - tyvars context [] [] arg_tys tycon id - name = mkWiredInIdName key mod (varOcc str) id - id = mkDataConId data_con +alpha_tyvar = [alphaTyVar] +alpha_ty = [alphaTy] \end{code} + %************************************************************************ %* * -\subsection[TysWiredIn-tuples]{The tuple types} +\subsection{Wired in type constructors} %* * %************************************************************************ -\begin{code} -tupleTyCon :: Arity -> TyCon -tupleTyCon i | i > mAX_TUPLE_SIZE = fst (mk_tuple i) -- Build one specially - | otherwise = tupleTyConArr!i +If you change which things are wired in, make sure you change their +names in PrelNames, so they use wTcQual, wDataQual, etc -tupleCon :: Arity -> DataCon -tupleCon i | i > mAX_TUPLE_SIZE = snd (mk_tuple i) -- Build one specially - | otherwise = tupleConArr!i +\begin{code} +wiredInTyCons :: [TyCon] -- Excludes tuples +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 + -- that it'll pre-populate the name cache, so + -- the special case in lookupOrigNameCache + -- doesn't need to look out for it + , boolTyCon + , charTyCon + , doubleTyCon + , floatTyCon + , intTyCon + , listTyCon + , parrTyCon + ] +\end{code} -tupleTyCons :: [TyCon] -tupleTyCons = elems tupleTyConArr +\begin{code} +mkWiredInTyConName :: Module -> FastString -> Unique -> TyCon -> Name +mkWiredInTyConName mod fs uniq tycon + = mkWiredInName mod (mkOccFS tcName fs) uniq + Nothing -- No parent object + (ATyCon tycon) -- Relevant TyCon + +mkWiredInDataConName :: Module -> FastString -> Unique -> DataCon -> Name -> Name +mkWiredInDataConName mod fs uniq datacon parent + = mkWiredInName mod (mkOccFS dataName fs) uniq + (Just parent) -- Name of parent TyCon + (ADataCon datacon) -- Relevant DataCon + +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 + +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 + +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 + +parrTyConName = mkWiredInTyConName pREL_PARR FSLIT("[::]") parrTyConKey parrTyCon +parrDataConName = mkWiredInDataConName pREL_PARR FSLIT("PArr") parrDataConKey parrDataCon parrTyConName + +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 +\end{code} -tupleTyConArr :: Array Int TyCon -tupleTyConArr = array (0,mAX_TUPLE_SIZE) ([0..] `zip` map fst tuples) -tupleConArr :: Array Int DataCon -tupleConArr = array (0,mAX_TUPLE_SIZE) ([0..] `zip` map snd tuples) +%************************************************************************ +%* * +\subsection{mkWiredInTyCon} +%* * +%************************************************************************ -tuples :: [(TyCon,DataCon)] -tuples = [mk_tuple i | i <- [0..mAX_TUPLE_SIZE]] +\begin{code} +pcNonRecDataTyCon = pcTyCon False NonRecursive +pcRecDataTyCon = pcTyCon False Recursive -mk_tuple :: Int -> (TyCon,DataCon) -mk_tuple arity = (tycon, tuple_con) +pcTyCon is_enum is_rec name tyvars argvrcs cons + = tycon where - tycon = mkTupleTyCon tc_name tc_kind arity tyvars tuple_con True - tc_name = mkWiredInTyConName tc_uniq mod_name name_str tycon - tc_kind = mkArrowKinds (map tyVarKind tyvars) boxedTypeKind - - tuple_con = pcDataCon dc_uniq mod_name name_str tyvars [] tyvar_tys tycon - tyvars = take arity alphaTyVars - tyvar_tys = mkTyVarTys tyvars - (mod_name, name_str) = mkTupNameStr arity - tc_uniq = mkTupleTyConUnique arity - dc_uniq = mkTupleDataConUnique arity - -unitTyCon = tupleTyCon 0 -pairTyCon = tupleTyCon 2 + tycon = mkAlgTyCon name + (mkArrowKinds (map tyVarKind tyvars) liftedTypeKind) + tyvars + [] -- No context + argvrcs + (DataCons cons) + [] -- No record selectors + (DataTyCon is_enum) + is_rec + True -- All the wired-in tycons have generics + +pcDataCon :: Name -> [TyVar] -> ThetaType -> [Type] -> TyCon -> DataCon +-- The Name should be in the DataName name space; it's the name +-- of the DataCon itself. +-- +-- The unique is the first of two free uniques; +-- the first is used for the datacon itself, +-- the second is used for the "worker name" -unitDataCon = tupleCon 0 -pairDataCon = tupleCon 2 +pcDataCon dc_name tyvars context arg_tys tycon + = data_con + where + data_con = mkDataCon dc_name + (map (const NotMarkedStrict) arg_tys) + [{- No labelled fields -}] + tyvars context [] [] arg_tys tycon + (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)) + bogus_wrap_name = pprPanic "Wired-in data wrapper id" (ppr dc_name) + -- Wired-in types are too simple to need wrappers \end{code} + %************************************************************************ %* * -\subsection[TysWiredIn-ubx-tuples]{Unboxed Tuple Types} +\subsection[TysWiredIn-tuples]{The tuple types} %* * %************************************************************************ \begin{code} -unboxedTupleTyCon :: Arity -> TyCon -unboxedTupleTyCon i | i > mAX_TUPLE_SIZE = fst (mk_unboxed_tuple i) - | otherwise = unboxedTupleTyConArr!i - -unboxedTupleCon :: Arity -> DataCon -unboxedTupleCon i | i > mAX_TUPLE_SIZE = snd (mk_unboxed_tuple i) - | otherwise = unboxedTupleConArr!i - -unboxedTupleTyConArr :: Array Int TyCon -unboxedTupleTyConArr = array (0,mAX_TUPLE_SIZE) ([0..] `zip` map fst ubx_tuples) - -unboxedTupleConArr :: Array Int DataCon -unboxedTupleConArr = array (0,mAX_TUPLE_SIZE) ([0..] `zip` map snd ubx_tuples) +tupleTyCon :: Boxity -> Arity -> TyCon +tupleTyCon boxity i | i > mAX_TUPLE_SIZE = fst (mk_tuple boxity i) -- Build one specially +tupleTyCon Boxed i = fst (boxedTupleArr ! i) +tupleTyCon Unboxed i = fst (unboxedTupleArr ! i) + +tupleCon :: Boxity -> Arity -> DataCon +tupleCon boxity i | i > mAX_TUPLE_SIZE = snd (mk_tuple boxity i) -- Build one specially +tupleCon Boxed i = snd (boxedTupleArr ! i) +tupleCon 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 arity tyvars tuple_con boxity gen_info + mod = mkTupleModule boxity arity + tc_name = mkWiredInName mod (mkTupleOcc tcName boxity arity) tc_uniq + Nothing (ATyCon tycon) + tc_kind = mkArrowKinds (map tyVarKind tyvars) res_kind + res_kind | isBoxed boxity = liftedTypeKind + | otherwise = ubxTupleKind + + tyvars | isBoxed boxity = take arity alphaTyVars + | otherwise = take arity openAlphaTyVars + + 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) + tc_uniq = mkTupleTyConUnique boxity arity + dc_uniq = mkTupleDataConUnique boxity arity + gen_info = True -- Tuples all have generics.. + -- hmm: that's a *lot* of code -ubx_tuples :: [(TyCon,DataCon)] -ubx_tuples = [mk_unboxed_tuple i | i <- [0..mAX_TUPLE_SIZE]] +unitTyCon = tupleTyCon Boxed 0 +unitDataCon = head (tyConDataCons unitTyCon) +unitDataConId = dataConWorkId unitDataCon -mk_unboxed_tuple :: Int -> (TyCon,DataCon) -mk_unboxed_tuple arity = (tycon, tuple_con) - where - tycon = mkTupleTyCon tc_name tc_kind arity tyvars tuple_con False - tc_name = mkWiredInTyConName tc_uniq mod_name name_str tycon - tc_kind = mkArrowKinds (map tyVarKind tyvars) unboxedTypeKind +pairTyCon = tupleTyCon Boxed 2 - tuple_con = pcDataCon dc_uniq mod_name name_str tyvars [] tyvar_tys tycon - tyvars = take arity openAlphaTyVars - tyvar_tys = mkTyVarTys tyvars - (mod_name, name_str) = mkUbxTupNameStr arity - tc_uniq = mkUbxTupleTyConUnique arity - dc_uniq = mkUbxTupleDataConUnique arity +unboxedSingletonTyCon = tupleTyCon Unboxed 1 +unboxedSingletonDataCon = tupleCon Unboxed 1 -unboxedPairTyCon = unboxedTupleTyCon 2 -unboxedPairDataCon = unboxedTupleCon 2 +unboxedPairTyCon = tupleTyCon Unboxed 2 +unboxedPairDataCon = tupleCon Unboxed 2 \end{code} %************************************************************************ @@ -269,19 +280,20 @@ unboxedPairDataCon = unboxedTupleCon 2 -- -- data Void = -- No constructors! -- --- ) It's boxed; there is only one value of this +-- ) It's lifted; there is only one value of this -- type, namely "void", whose semantics is just bottom. - -voidTy = mkTyConTy voidTyCon -voidTyCon = pcNonRecDataTyCon voidTyConKey pREL_GHC SLIT("Void") [] [{-No data cons-}] - +-- +-- Haskell 98 drops the definition of a Void type, so we just 'simulate' +-- voidTy using (). +voidTy = unitTy \end{code} + \begin{code} charTy = mkTyConTy charTyCon -charTyCon = pcNonRecDataTyCon charTyConKey pREL_BASE SLIT("Char") [] [charDataCon] -charDataCon = pcDataCon charDataConKey pREL_BASE SLIT("C#") [] [] [charPrimTy] charTyCon +charTyCon = pcNonRecDataTyCon charTyConName [] [] [charDataCon] +charDataCon = pcDataCon charDataConName [] [] [charPrimTy] charTyCon stringTy = mkListTy charTy -- convenience only \end{code} @@ -289,225 +301,27 @@ stringTy = mkListTy charTy -- convenience only \begin{code} intTy = mkTyConTy intTyCon -intTyCon = pcNonRecDataTyCon intTyConKey pREL_BASE SLIT("Int") [] [intDataCon] -intDataCon = pcDataCon intDataConKey pREL_BASE SLIT("I#") [] [] [intPrimTy] intTyCon - -isIntTy :: Type -> Bool -isIntTy ty - = case (splitAlgTyConApp_maybe ty) of - Just (tycon, [], _) -> getUnique tycon == intTyConKey - _ -> False - -inIntRange :: Integer -> Bool -- Tells if an integer lies in the legal range of Ints -inIntRange i = (min_int <= i) && (i <= max_int) - -max_int, min_int :: Integer -max_int = toInteger maxInt -min_int = toInteger minInt - -int8TyCon = pcNonRecDataTyCon int8TyConKey iNT SLIT("Int8") [] [int8DataCon] - where - int8DataCon = pcDataCon int8DataConKey iNT SLIT("I8#") [] [] [intPrimTy] int8TyCon - -int16TyCon = pcNonRecDataTyCon int16TyConKey iNT SLIT("Int16") [] [int16DataCon] - where - int16DataCon = pcDataCon int16DataConKey iNT SLIT("I16#") [] [] [intPrimTy] int16TyCon - -int32TyCon = pcNonRecDataTyCon int32TyConKey iNT SLIT("Int32") [] [int32DataCon] - where - int32DataCon = pcDataCon int32DataConKey iNT SLIT("I32#") [] [] [intPrimTy] int32TyCon - -int64Ty = mkTyConTy int64TyCon - -int64TyCon = pcNonRecDataTyCon int64TyConKey pREL_ADDR SLIT("Int64") [] [int64DataCon] -int64DataCon = pcDataCon int64DataConKey pREL_ADDR SLIT("I64#") [] [] [int64PrimTy] int64TyCon -\end{code} - -\begin{code} - -wordTy = mkTyConTy wordTyCon - -wordTyCon = pcNonRecDataTyCon wordTyConKey pREL_ADDR SLIT("Word") [] [wordDataCon] -wordDataCon = pcDataCon wordDataConKey pREL_ADDR SLIT("W#") [] [] [wordPrimTy] wordTyCon - -word8TyCon = pcNonRecDataTyCon word8TyConKey wORD SLIT("Word8") [] [word8DataCon] - where - word8DataCon = pcDataCon word8DataConKey wORD SLIT("W8#") [] [] [wordPrimTy] word8TyCon - -word16TyCon = pcNonRecDataTyCon word16TyConKey wORD SLIT("Word16") [] [word16DataCon] - where - word16DataCon = pcDataCon word16DataConKey wORD SLIT("W16#") [] [] [wordPrimTy] word16TyCon - -word32TyCon = pcNonRecDataTyCon word32TyConKey wORD SLIT("Word32") [] [word32DataCon] - where - word32DataCon = pcDataCon word32DataConKey wORD SLIT("W32#") [] [] [wordPrimTy] word32TyCon - -word64Ty = mkTyConTy word64TyCon - -word64TyCon = pcNonRecDataTyCon word64TyConKey pREL_ADDR SLIT("Word64") [] [word64DataCon] -word64DataCon = pcDataCon word64DataConKey pREL_ADDR SLIT("W64#") [] [] [word64PrimTy] word64TyCon -\end{code} - -\begin{code} -addrTy = mkTyConTy addrTyCon - -addrTyCon = pcNonRecDataTyCon addrTyConKey pREL_ADDR SLIT("Addr") [] [addrDataCon] -addrDataCon = pcDataCon addrDataConKey pREL_ADDR SLIT("A#") [] [] [addrPrimTy] addrTyCon - -isAddrTy :: Type -> Bool -isAddrTy ty - = case (splitAlgTyConApp_maybe ty) of - Just (tycon, [], _) -> getUnique tycon == addrTyConKey - _ -> False - +intTyCon = pcNonRecDataTyCon intTyConName [] [] [intDataCon] +intDataCon = pcDataCon intDataConName [] [] [intPrimTy] intTyCon \end{code} \begin{code} floatTy = mkTyConTy floatTyCon -floatTyCon = pcNonRecDataTyCon floatTyConKey pREL_BASE SLIT("Float") [] [floatDataCon] -floatDataCon = pcDataCon floatDataConKey pREL_BASE SLIT("F#") [] [] [floatPrimTy] floatTyCon - -isFloatTy :: Type -> Bool -isFloatTy ty - = case (splitAlgTyConApp_maybe ty) of - Just (tycon, [], _) -> getUnique tycon == floatTyConKey - _ -> False - +floatTyCon = pcNonRecDataTyCon floatTyConName [] [] [floatDataCon] +floatDataCon = pcDataCon floatDataConName [] [] [floatPrimTy] floatTyCon \end{code} \begin{code} doubleTy = mkTyConTy doubleTyCon -isDoubleTy :: Type -> Bool -isDoubleTy ty - = case (splitAlgTyConApp_maybe ty) of - Just (tycon, [], _) -> getUnique tycon == doubleTyConKey - _ -> False - -doubleTyCon = pcNonRecDataTyCon doubleTyConKey pREL_BASE SLIT("Double") [] [doubleDataCon] -doubleDataCon = pcDataCon doubleDataConKey pREL_BASE SLIT("D#") [] [] [doublePrimTy] doubleTyCon -\end{code} - -\begin{code} -mkStateTy ty = mkTyConApp stateTyCon [ty] -realWorldStateTy = mkStateTy realWorldTy -- a common use - -stateTyCon = pcNonRecDataTyCon stateTyConKey pREL_ST SLIT("State") alpha_tyvar [stateDataCon] -stateDataCon - = pcDataCon stateDataConKey pREL_ST SLIT("S#") - alpha_tyvar [] [mkStatePrimTy alphaTy] stateTyCon -\end{code} - -\begin{code} -stablePtrTyCon - = pcNonRecDataTyCon stablePtrTyConKey pREL_FOREIGN SLIT("StablePtr") - alpha_tyvar [stablePtrDataCon] - where - stablePtrDataCon - = pcDataCon stablePtrDataConKey pREL_FOREIGN SLIT("StablePtr") - alpha_tyvar [] [mkStablePtrPrimTy alphaTy] stablePtrTyCon -\end{code} - -\begin{code} -foreignObjTyCon - = pcNonRecDataTyCon foreignObjTyConKey pREL_IO_BASE SLIT("ForeignObj") - [] [foreignObjDataCon] - where - foreignObjDataCon - = pcDataCon foreignObjDataConKey pREL_IO_BASE SLIT("ForeignObj") - [] [] [foreignObjPrimTy] foreignObjTyCon -\end{code} - -%************************************************************************ -%* * -\subsection[TysWiredIn-Integer]{@Integer@ and its related ``pairing'' types} -%* * -%************************************************************************ - -@Integer@ and its pals are not really primitive. @Integer@ itself, first: -\begin{code} -integerTy :: Type -integerTy = mkTyConTy integerTyCon - -integerTyCon = pcNonRecDataTyCon integerTyConKey pREL_BASE SLIT("Integer") [] [integerDataCon] - -integerDataCon = pcDataCon integerDataConKey pREL_BASE SLIT("J#") - [] [] [intPrimTy, intPrimTy, byteArrayPrimTy] integerTyCon - -isIntegerTy :: Type -> Bool -isIntegerTy ty - = case (splitAlgTyConApp_maybe ty) of - Just (tycon, [], _) -> getUnique tycon == integerTyConKey - _ -> False +doubleTyCon = pcNonRecDataTyCon doubleTyConName [] [] [doubleDataCon] +doubleDataCon = pcDataCon doubleDataConName [] [] [doublePrimTy] doubleTyCon \end{code} %************************************************************************ %* * -\subsection[TysWiredIn-ext-type]{External types} -%* * -%************************************************************************ - -The compiler's foreign function interface supports the passing of a -restricted set of types as arguments and results (the restricting factor -being the ) - -\begin{code} -isFFIArgumentTy :: Type -> Bool -isFFIArgumentTy ty = - (opt_GlasgowExts && isUnLiftedType ty) || --leave out for now: maybeToBool (maybeBoxedPrimType ty))) || - case (splitAlgTyConApp_maybe ty) of - Just (tycon, _, _) -> (getUnique tycon) `elem` primArgTyConKeys - _ -> False - --- types that can be passed as arguments to "foreign" functions -primArgTyConKeys - = [ intTyConKey, int8TyConKey, int16TyConKey, int32TyConKey, int64TyConKey - , wordTyConKey, word8TyConKey, word16TyConKey, word32TyConKey, word64TyConKey - , floatTyConKey, doubleTyConKey - , addrTyConKey, charTyConKey, foreignObjTyConKey - , stablePtrTyConKey, byteArrayTyConKey, mutableByteArrayTyConKey - ] - --- types that can be passed from the outside world into Haskell. --- excludes (mutable) byteArrays. -isFFIExternalTy :: Type -> Bool -isFFIExternalTy ty = - (opt_GlasgowExts && isUnLiftedType ty) || --leave out for now: maybeToBool (maybeBoxedPrimType ty))) || - case (splitAlgTyConApp_maybe ty) of - Just (tycon, _, _) -> - let - u_tycon = getUnique tycon - in - (u_tycon `elem` primArgTyConKeys) && - not (u_tycon `elem` notLegalExternalTyCons) - _ -> False - - -isFFIResultTy :: Type -> Bool -isFFIResultTy ty = - not (isUnLiftedType ty) && - case (splitAlgTyConApp_maybe ty) of - Just (tycon, _, _) -> - let - u_tycon = getUnique tycon - in - (u_tycon == getUnique unitTyCon) || - ((u_tycon `elem` primArgTyConKeys) && - not (u_tycon `elem` notLegalExternalTyCons)) - _ -> False - --- it's illegal to return foreign objects and (mutable) --- bytearrays from a _ccall_ / foreign declaration --- (or be passed them as arguments in foreign exported functions). -notLegalExternalTyCons = - [ foreignObjTyConKey, byteArrayTyConKey, mutableByteArrayTyConKey ] - -\end{code} - -%************************************************************************ -%* * \subsection[TysWiredIn-Bool]{The @Bool@ type} %* * %************************************************************************ @@ -557,11 +371,14 @@ primitive counterpart. \begin{code} boolTy = mkTyConTy boolTyCon -boolTyCon = pcTyCon EnumType NonRecursive boolTyConKey - pREL_BASE SLIT("Bool") [] [falseDataCon, trueDataCon] +boolTyCon = pcTyCon True NonRecursive boolTyConName + [] [] [falseDataCon, trueDataCon] -falseDataCon = pcDataCon falseDataConKey pREL_BASE SLIT("False") [] [] [] boolTyCon -trueDataCon = pcDataCon trueDataConKey pREL_BASE SLIT("True") [] [] [] boolTyCon +falseDataCon = pcDataCon falseDataConName [] [] [] boolTyCon +trueDataCon = pcDataCon trueDataConName [] [] [] boolTyCon + +falseDataConId = dataConWorkId falseDataCon +trueDataConId = dataConWorkId trueDataCon \end{code} %************************************************************************ @@ -583,14 +400,12 @@ data (,) a b = (,,) a b mkListTy :: Type -> Type mkListTy ty = mkTyConApp listTyCon [ty] -alphaListTy = mkSigmaTy alpha_tyvar [] (mkTyConApp listTyCon alpha_ty) - -listTyCon = pcRecDataTyCon listTyConKey pREL_BASE SLIT("[]") - alpha_tyvar [nilDataCon, consDataCon] +listTyCon = pcRecDataTyCon listTyConName + alpha_tyvar [(True,False)] [nilDataCon, consDataCon] -nilDataCon = pcDataCon nilDataConKey pREL_BASE SLIT("[]") alpha_tyvar [] [] listTyCon -consDataCon = pcDataCon consDataConKey pREL_BASE SLIT(":") - alpha_tyvar [] [alphaTy, mkTyConApp listTyCon alpha_ty] listTyCon +nilDataCon = pcDataCon nilDataConName alpha_tyvar [] [] listTyCon +consDataCon = pcDataCon 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) @@ -643,11 +458,87 @@ done by enumeration\srcloc{lib/prelude/InTup?.hs}. \end{itemize} \begin{code} -mkTupleTy :: Int -> [Type] -> Type -mkTupleTy arity tys = mkTyConApp (tupleTyCon arity) tys +mkTupleTy :: Boxity -> Int -> [Type] -> Type +mkTupleTy boxity arity tys = mkTyConApp (tupleTyCon boxity arity) tys + +unitTy = mkTupleTy Boxed 0 [] +\end{code} + +%************************************************************************ +%* * +\subsection[TysWiredIn-PArr]{The @[::]@ type} +%* * +%************************************************************************ -mkUnboxedTupleTy :: Int -> [Type] -> Type -mkUnboxedTupleTy arity tys = mkTyConApp (unboxedTupleTyCon arity) tys +Special syntax for parallel arrays needs some wired in definitions. -unitTy = mkTupleTy 0 [] +\begin{code} +-- construct a type representing the application of the parallel array +-- constructor +-- +mkPArrTy :: Type -> Type +mkPArrTy ty = mkTyConApp parrTyCon [ty] + +-- represents the type constructor of parallel arrays +-- +-- * 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 +-- `PrelPArr'. +-- +parrTyCon :: TyCon +parrTyCon = pcNonRecDataTyCon parrTyConName alpha_tyvar [(True, False)] [parrDataCon] + +parrDataCon :: DataCon +parrDataCon = pcDataCon + parrDataConName + alpha_tyvar -- forall'ed type variables + [] -- context + [intPrimTy, -- 1st argument: Int# + mkTyConApp -- 2nd argument: Array# a + arrayPrimTyCon + alpha_ty] + parrTyCon + +-- check whether a type constructor is the constructor for parallel arrays +-- +isPArrTyCon :: TyCon -> Bool +isPArrTyCon tc = tyConName tc == parrTyConName + +-- fake array constructors +-- +-- * 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 +-- +parrFakeCon :: Arity -> DataCon +parrFakeCon i | i > mAX_TUPLE_SIZE = mkPArrFakeCon i -- build one specially +parrFakeCon i = parrFakeConArr!i + +-- pre-defined set of constructors +-- +parrFakeConArr :: Array Int DataCon +parrFakeConArr = array (0, mAX_TUPLE_SIZE) [(i, mkPArrFakeCon i) + | i <- [0..mAX_TUPLE_SIZE]] + +-- build a fake parallel array constructor for the given arity +-- +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 pREL_PARR (mkOccFS dataName nameStr) uniq + Nothing (ADataCon data_con) + uniq = mkPArrDataConUnique arity + +-- checks whether a data constructor is a fake constructor for parallel arrays +-- +isPArrFakeCon :: DataCon -> Bool +isPArrFakeCon dcon = dcon == parrFakeCon (dataConSourceArity dcon) \end{code} +