[project @ 2001-08-04 06:19:54 by ken]

[ghc-hetmet.git] / ghc / compiler / prelude / TysWiredIn.lhs

diff --git a/ghc/compiler/prelude/TysWiredIn.lhs b/ghc/compiler/prelude/TysWiredIn.lhs
index b0ebb94..ca4f950 100644 (file)
--- a/ghc/compiler/prelude/TysWiredIn.lhs
+++ b/ghc/compiler/prelude/TysWiredIn.lhs
@@ -30,24 +30,20 @@ module TysWiredIn (
        consDataCon,
        doubleDataCon,
        doubleTy,
-       isDoubleTy,
        doubleTyCon,
        falseDataCon, falseDataConId,
        floatDataCon,
        floatTy,
-       isFloatTy,
        floatTyCon,
 
        intDataCon,
        intTy,
        intTyCon,
-       isIntTy,
 
        integerTy,
        integerTyCon,
        smallIntegerDataCon,
        largeIntegerDataCon,
-       isIntegerTy,
 
        listTyCon,
 
@@ -75,16 +71,13 @@ module TysWiredIn (
        wordTy,
        wordTyCon,
 
-       isFFIArgumentTy,     -- :: DynFlags -> Bool -> Type -> Bool
+       isFFIArgumentTy,     -- :: DynFlags -> Safety -> Type -> Bool
        isFFIImportResultTy, -- :: DynFlags -> Type -> Bool
        isFFIExportResultTy, -- :: Type -> Bool
        isFFIExternalTy,     -- :: Type -> Bool
         isFFIDynArgumentTy,  -- :: Type -> Bool
        isFFIDynResultTy,    -- :: Type -> Bool
        isFFILabelTy,        -- :: Type -> Bool
-       isAddrTy,            -- :: Type -> Bool
-       isForeignPtrTy       -- :: Type -> Bool
-
     ) where
 
 #include "HsVersions.h"
@@ -97,23 +90,24 @@ import PrelNames
 import TysPrim
 
 -- others:
+import ForeignCall     ( Safety, playSafe )
 import Constants       ( mAX_TUPLE_SIZE )
 import Module          ( mkPrelModule )
 import Name            ( Name, nameRdrName, nameUnique, nameOccName, 
                          nameModule, mkWiredInName )
 import OccName         ( mkOccFS, tcName, dataName, mkWorkerOcc, mkGenOcc1, mkGenOcc2 )
 import RdrName         ( rdrNameOcc )
-import DataCon         ( DataCon, StrictnessMark(..),  mkDataCon, dataConId )
+import DataCon         ( DataCon, mkDataCon, dataConId )
 import Var             ( TyVar, tyVarKind )
 import TyCon           ( TyCon, AlgTyConFlavour(..), tyConDataCons,
                          mkTupleTyCon, isUnLiftedTyCon, mkAlgTyCon
                        )
 
-import BasicTypes      ( Arity, RecFlag(..), Boxity(..), isBoxed )
+import BasicTypes      ( Arity, RecFlag(..), Boxity(..), isBoxed, StrictnessMark(..) )
 
 import Type            ( Type, mkTyConTy, mkTyConApp, mkTyVarTys, 
                          mkArrowKinds, liftedTypeKind, unliftedTypeKind,
-                         splitTyConApp_maybe, repType,
+                         splitTyConApp_maybe,
                          TauType, ThetaType )
 import Unique          ( incrUnique, mkTupleTyConUnique, mkTupleDataConUnique )
 import PrelNames
@@ -154,8 +148,8 @@ genericTyCons :: [TyCon]
 genericTyCons = [ plusTyCon, crossTyCon, genUnitTyCon ]
 
 
-tuple_tycons = unitTyCon : [tupleTyCon Boxed i | i <- [2..37] ]
-unboxed_tuple_tycons = [tupleTyCon Unboxed i | i <- [1..37] ]
+tuple_tycons = unitTyCon : [tupleTyCon Boxed   i | i <- [2..mAX_TUPLE_SIZE] ]
+unboxed_tuple_tycons     = [tupleTyCon Unboxed i | i <- [1..mAX_TUPLE_SIZE] ]
 \end{code}
 
 
@@ -317,13 +311,9 @@ intTy = mkTyConTy intTyCon
 
 intTyCon = pcNonRecDataTyCon intTyConName [] [] [intDataCon]
 intDataCon = pcDataCon intDataConName [] [] [intPrimTy] intTyCon
-
-isIntTy :: Type -> Bool
-isIntTy = isTyCon intTyConKey
 \end{code}
 
 \begin{code}
-
 wordTy = mkTyConTy wordTyCon
 
 wordTyCon = pcNonRecDataTyCon wordTyConName [] [] [wordDataCon]
@@ -335,9 +325,6 @@ addrTy = mkTyConTy addrTyCon
 
 addrTyCon = pcNonRecDataTyCon addrTyConName [] [] [addrDataCon]
 addrDataCon = pcDataCon addrDataConName [] [] [addrPrimTy] addrTyCon
-
-isAddrTy :: Type -> Bool
-isAddrTy = isTyCon addrTyConKey
 \end{code}
 
 \begin{code}
@@ -359,17 +346,11 @@ floatTy   = mkTyConTy floatTyCon
 
 floatTyCon   = pcNonRecDataTyCon floatTyConName   [] [] [floatDataCon]
 floatDataCon = pcDataCon         floatDataConName [] [] [floatPrimTy] floatTyCon
-
-isFloatTy :: Type -> Bool
-isFloatTy = isTyCon floatTyConKey
 \end{code}
 
 \begin{code}
 doubleTy = mkTyConTy doubleTyCon
 
-isDoubleTy :: Type -> Bool
-isDoubleTy = isTyCon doubleTyConKey
-
 doubleTyCon   = pcNonRecDataTyCon doubleTyConName     [] [] [doubleDataCon]
 doubleDataCon = pcDataCon        doubleDataConName [] [] [doublePrimTy] doubleTyCon
 \end{code}
@@ -392,9 +373,6 @@ foreignObjTyCon
     foreignObjDataCon
       = pcDataCon foreignObjDataConName
            [] [] [foreignObjPrimTy] foreignObjTyCon
-
-isForeignObjTy :: Type -> Bool
-isForeignObjTy = isTyCon foreignObjTyConKey
 \end{code}
 
 \begin{code}
@@ -405,9 +383,6 @@ foreignPtrTyCon
     foreignPtrDataCon
       = pcDataCon foreignPtrDataConName
            alpha_tyvar [] [foreignObjPrimTy] foreignPtrTyCon
-
-isForeignPtrTy :: Type -> Bool
-isForeignPtrTy = isTyCon foreignPtrTyConKey
 \end{code}
 
 %************************************************************************
@@ -428,10 +403,6 @@ smallIntegerDataCon = pcDataCon smallIntegerDataConName
                [] [] [intPrimTy] integerTyCon
 largeIntegerDataCon = pcDataCon largeIntegerDataConName
                [] [] [intPrimTy, byteArrayPrimTy] integerTyCon
-
-
-isIntegerTy :: Type -> Bool
-isIntegerTy = isTyCon integerTyConKey
 \end{code}
 
 
@@ -446,10 +417,10 @@ restricted set of types as arguments and results (the restricting factor
 being the )
 
 \begin{code}
-isFFIArgumentTy :: DynFlags -> Bool -> Type -> Bool
+isFFIArgumentTy :: DynFlags -> Safety -> Type -> Bool
 -- Checks for valid argument type for a 'foreign import'
-isFFIArgumentTy dflags is_safe ty 
-   = checkRepTyCon (legalOutgoingTyCon dflags is_safe) ty
+isFFIArgumentTy dflags safety ty 
+   = checkRepTyCon (legalOutgoingTyCon dflags safety) ty
 
 isFFIExternalTy :: Type -> Bool
 -- Types that are allowed as arguments of a 'foreign export'
@@ -478,16 +449,10 @@ isFFILabelTy :: Type -> Bool
 isFFILabelTy = checkRepTyCon (\tc -> tc == ptrTyCon || tc == funPtrTyCon || tc == addrTyCon)
 
 checkRepTyCon :: (TyCon -> Bool) -> Type -> Bool
-       -- look through newtypes
-checkRepTyCon check_tc ty = checkTyCon check_tc (repType ty)
-
-checkTyCon :: (TyCon -> Bool) -> Type -> Bool
-checkTyCon check_tc ty = case splitTyConApp_maybe ty of
+       -- Look through newtypes
+checkRepTyCon check_tc ty = case splitTyConApp_maybe ty of
                                Just (tycon, _) -> check_tc tycon
                                Nothing         -> False
-
-isTyCon :: Unique -> Type -> Bool
-isTyCon uniq ty = checkTyCon (\tc -> uniq == getUnique tc) ty
 \end{code}
 
 ----------------------------------------------
@@ -524,12 +489,10 @@ legalFEResultTyCon tc
   | tc == unitTyCon = True
   | otherwise       = boxedMarshalableTyCon tc
 
-legalOutgoingTyCon :: DynFlags -> Bool -> TyCon -> Bool
+legalOutgoingTyCon :: DynFlags -> Safety -> TyCon -> Bool
 -- Checks validity of types going from Haskell -> external world
--- The boolean is true for a 'safe' call (when we don't want to
--- pass Haskell pointers to the world)
-legalOutgoingTyCon dflags be_safe tc
-  | be_safe && getUnique tc `elem` [byteArrayTyConKey, mutableByteArrayTyConKey]
+legalOutgoingTyCon dflags safety tc
+  | playSafe safety && getUnique tc `elem` [byteArrayTyConKey, mutableByteArrayTyConKey]
   = False
   | otherwise
   = marshalableTyCon dflags tc