X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Foreign%2FC%2FTypes.hs;h=f6bdec1b6bd1be3ef23fa1e696bab6464db2e9c3;hb=24617fc54416bdb7ec77c63d868a9de7a9ae313b;hp=5def8b9db3d834bf434158cbcd5bc03608baf8f2;hpb=9fa9bc17072a58c0bae2cce4764d38677e96ac29;p=ghc-base.git diff --git a/Foreign/C/Types.hs b/Foreign/C/Types.hs index 5def8b9..f6bdec1 100644 --- a/Foreign/C/Types.hs +++ b/Foreign/C/Types.hs @@ -1,37 +1,100 @@ -{-# OPTIONS -fno-implicit-prelude #-} +{-# LANGUAGE CPP + , NoImplicitPrelude + , MagicHash + , GeneralizedNewtypeDeriving + #-} +{-# OPTIONS_GHC -fno-warn-unused-binds #-} +#ifdef __GLASGOW_HASKELL__ +{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} +#endif +-- XXX -fno-warn-unused-binds stops us warning about unused constructors, +-- but really we should just remove them if we don't want them + ----------------------------------------------------------------------------- -- | -- Module : Foreign.C.Types -- Copyright : (c) The FFI task force 2001 --- License : BSD-style (see the file libraries/core/LICENSE) +-- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : ffi@haskell.org -- Stability : provisional -- Portability : portable -- --- $Id: Types.hs,v 1.4 2002/04/24 16:31:44 simonmar Exp $ --- --- Mapping of C types to corresponding Haskell types. A cool hack... +-- Mapping of C types to corresponding Haskell types. -- ----------------------------------------------------------------------------- module Foreign.C.Types - ( -- Integral types, instances of: Eq, Ord, Num, Read, Show, Enum, - -- Typeable, Storable, Bounded, Real, Integral, Bits - CChar(..), CSChar(..), CUChar(..) - , CShort(..), CUShort(..), CInt(..), CUInt(..) - , CLong(..), CULong(..), CLLong(..), CULLong(..) - - -- Floating types, instances of: Eq, Ord, Num, Read, Show, Enum, - -- Typeable, Storable, Real, Fractional, Floating, RealFrac, - -- RealFloat - , CFloat(..), CDouble(..), CLDouble(..) - ) where - -import Data.Bits ( Bits(..) ) -import Data.Int ( Int8, Int16, Int32, Int64 ) -import Data.Word ( Word8, Word16, Word32, Word64 ) -import Data.Dynamic + ( -- * Representations of C types +#ifndef __NHC__ + -- $ctypes + + -- ** Integral types + -- | These types are are represented as @newtype@s of + -- types in "Data.Int" and "Data.Word", and are instances of + -- 'Prelude.Eq', 'Prelude.Ord', 'Prelude.Num', 'Prelude.Read', + -- 'Prelude.Show', 'Prelude.Enum', 'Typeable', 'Storable', + -- 'Prelude.Bounded', 'Prelude.Real', 'Prelude.Integral' and + -- 'Bits'. + CChar, CSChar, CUChar + , CShort, CUShort, CInt, CUInt + , CLong, CULong + , CPtrdiff, CSize, CWchar, CSigAtomic + , CLLong, CULLong + , CIntPtr, CUIntPtr + , CIntMax, CUIntMax + + -- ** Numeric types + -- | These types are are represented as @newtype@s of basic + -- foreign types, and are instances of + -- 'Prelude.Eq', 'Prelude.Ord', 'Prelude.Num', 'Prelude.Read', + -- 'Prelude.Show', 'Prelude.Enum', 'Typeable' and 'Storable'. + , CClock, CTime, CUSeconds, CSUSeconds + + -- extracted from CTime, because we don't want this comment in + -- the Haskell 2010 report: + + -- | To convert 'CTime' to 'Data.Time.UTCTime', use the following formula: + -- + -- > posixSecondsToUTCTime (realToFrac :: POSIXTime) + -- + + -- ** Floating types + -- | These types are are represented as @newtype@s of + -- 'Prelude.Float' and 'Prelude.Double', and are instances of + -- 'Prelude.Eq', 'Prelude.Ord', 'Prelude.Num', 'Prelude.Read', + -- 'Prelude.Show', 'Prelude.Enum', 'Typeable', 'Storable', + -- 'Prelude.Real', 'Prelude.Fractional', 'Prelude.Floating', + -- 'Prelude.RealFrac' and 'Prelude.RealFloat'. + , CFloat, CDouble +-- GHC doesn't support CLDouble yet +#ifndef __GLASGOW_HASKELL__ + , CLDouble +#endif +#else + -- Exported non-abstractly in nhc98 to fix an interface file problem. + CChar(..), CSChar(..), CUChar(..) + , CShort(..), CUShort(..), CInt(..), CUInt(..) + , CLong(..), CULong(..) + , CPtrdiff(..), CSize(..), CWchar(..), CSigAtomic(..) + , CLLong(..), CULLong(..) + , CClock(..), CTime(..), CUSeconds(..), CSUSeconds(..) + , CFloat(..), CDouble(..), CLDouble(..) + , CIntPtr(..), CUIntPtr(..), CIntMax(..), CUIntMax(..) +#endif + -- ** Other types + + -- Instances of: Eq and Storable + , CFile, CFpos, CJmpBuf + ) where + +#ifndef __NHC__ + +import Foreign.Storable +import Data.Bits ( Bits(..) ) +import Data.Int ( Int8, Int16, Int32, Int64 ) +import Data.Word ( Word8, Word16, Word32, Word64 ) +import {-# SOURCE #-} Data.Typeable #ifdef __GLASGOW_HASKELL__ import GHC.Base @@ -41,24 +104,42 @@ import GHC.Real import GHC.Show import GHC.Read import GHC.Num +#else +import Control.Monad ( liftM ) +#endif + +#ifdef __HUGS__ +import Hugs.Ptr ( castPtr ) #endif +#include "HsBaseConfig.h" #include "CTypes.h" +-- | Haskell type representing the C @char@ type. INTEGRAL_TYPE(CChar,tyConCChar,"CChar",HTYPE_CHAR) +-- | Haskell type representing the C @signed char@ type. INTEGRAL_TYPE(CSChar,tyConCSChar,"CSChar",HTYPE_SIGNED_CHAR) +-- | Haskell type representing the C @unsigned char@ type. INTEGRAL_TYPE(CUChar,tyConCUChar,"CUChar",HTYPE_UNSIGNED_CHAR) +-- | Haskell type representing the C @short@ type. INTEGRAL_TYPE(CShort,tyConCShort,"CShort",HTYPE_SHORT) +-- | Haskell type representing the C @unsigned short@ type. INTEGRAL_TYPE(CUShort,tyConCUShort,"CUShort",HTYPE_UNSIGNED_SHORT) +-- | Haskell type representing the C @int@ type. INTEGRAL_TYPE(CInt,tyConCInt,"CInt",HTYPE_INT) +-- | Haskell type representing the C @unsigned int@ type. INTEGRAL_TYPE(CUInt,tyConCUInt,"CUInt",HTYPE_UNSIGNED_INT) +-- | Haskell type representing the C @long@ type. INTEGRAL_TYPE(CLong,tyConCLong,"CLong",HTYPE_LONG) +-- | Haskell type representing the C @unsigned long@ type. INTEGRAL_TYPE(CULong,tyConCULong,"CULong",HTYPE_UNSIGNED_LONG) +-- | Haskell type representing the C @long long@ type. INTEGRAL_TYPE(CLLong,tyConCLLong,"CLLong",HTYPE_LONG_LONG) +-- | Haskell type representing the C @unsigned long long@ type. INTEGRAL_TYPE(CULLong,tyConCULLong,"CULLong",HTYPE_UNSIGNED_LONG_LONG) {-# RULES @@ -87,29 +168,176 @@ INTEGRAL_TYPE(CULLong,tyConCULLong,"CULLong",HTYPE_UNSIGNED_LONG_LONG) "fromIntegral/CULLong->a" fromIntegral = \(CULLong x) -> fromIntegral x #-} +-- | Haskell type representing the C @float@ type. FLOATING_TYPE(CFloat,tyConCFloat,"CFloat",HTYPE_FLOAT) +-- | Haskell type representing the C @double@ type. FLOATING_TYPE(CDouble,tyConCDouble,"CDouble",HTYPE_DOUBLE) +-- GHC doesn't support CLDouble yet +#ifndef __GLASGOW_HASKELL__ -- HACK: Currently no long double in the FFI, so we simply re-use double +-- | Haskell type representing the C @long double@ type. FLOATING_TYPE(CLDouble,tyConCLDouble,"CLDouble",HTYPE_DOUBLE) +#endif +{-# RULES +"realToFrac/a->CFloat" realToFrac = \x -> CFloat (realToFrac x) +"realToFrac/a->CDouble" realToFrac = \x -> CDouble (realToFrac x) -#include "Dynamic.h" -INSTANCE_TYPEABLE0(CChar,cCharTc,"CChar") -INSTANCE_TYPEABLE0(CSChar,cSCharTc,"CSChar") -INSTANCE_TYPEABLE0(CUChar,cUCharTc,"CUChar") +"realToFrac/CFloat->a" realToFrac = \(CFloat x) -> realToFrac x +"realToFrac/CDouble->a" realToFrac = \(CDouble x) -> realToFrac x + #-} -INSTANCE_TYPEABLE0(CShort,cShortTc,"CShort") -INSTANCE_TYPEABLE0(CUShort,cUShortTc,"CUShort") +-- GHC doesn't support CLDouble yet +-- "realToFrac/a->CLDouble" realToFrac = \x -> CLDouble (realToFrac x) +-- "realToFrac/CLDouble->a" realToFrac = \(CLDouble x) -> realToFrac x -INSTANCE_TYPEABLE0(CInt,cIntTc,"CInt") -INSTANCE_TYPEABLE0(CUInt,cUIntTc,"CUInt") +-- | Haskell type representing the C @ptrdiff_t@ type. +INTEGRAL_TYPE(CPtrdiff,tyConCPtrdiff,"CPtrdiff",HTYPE_PTRDIFF_T) +-- | Haskell type representing the C @size_t@ type. +INTEGRAL_TYPE(CSize,tyConCSize,"CSize",HTYPE_SIZE_T) +-- | Haskell type representing the C @wchar_t@ type. +INTEGRAL_TYPE(CWchar,tyConCWchar,"CWchar",HTYPE_WCHAR_T) +-- | Haskell type representing the C @sig_atomic_t@ type. +INTEGRAL_TYPE(CSigAtomic,tyConCSigAtomic,"CSigAtomic",HTYPE_SIG_ATOMIC_T) -INSTANCE_TYPEABLE0(CLong,cLongTc,"CLong") -INSTANCE_TYPEABLE0(CULong,cULongTc,"CULong") +{-# RULES +"fromIntegral/a->CPtrdiff" fromIntegral = \x -> CPtrdiff (fromIntegral x) +"fromIntegral/a->CSize" fromIntegral = \x -> CSize (fromIntegral x) +"fromIntegral/a->CWchar" fromIntegral = \x -> CWchar (fromIntegral x) +"fromIntegral/a->CSigAtomic" fromIntegral = \x -> CSigAtomic (fromIntegral x) -INSTANCE_TYPEABLE0(CLLong,cLLongTc,"CLLong") -INSTANCE_TYPEABLE0(CULLong,cULLongTc,"CULLong") +"fromIntegral/CPtrdiff->a" fromIntegral = \(CPtrdiff x) -> fromIntegral x +"fromIntegral/CSize->a" fromIntegral = \(CSize x) -> fromIntegral x +"fromIntegral/CWchar->a" fromIntegral = \(CWchar x) -> fromIntegral x +"fromIntegral/CSigAtomic->a" fromIntegral = \(CSigAtomic x) -> fromIntegral x + #-} + +-- | Haskell type representing the C @clock_t@ type. +ARITHMETIC_TYPE(CClock,tyConCClock,"CClock",HTYPE_CLOCK_T) +-- | Haskell type representing the C @time_t@ type. +-- +ARITHMETIC_TYPE(CTime,tyConCTime,"CTime",HTYPE_TIME_T) +-- | Haskell type representing the C @useconds_t@ type. +ARITHMETIC_TYPE(CUSeconds,tyConCUSeconds,"CUSeconds",HTYPE_USECONDS_T) +-- | Haskell type representing the C @suseconds_t@ type. +ARITHMETIC_TYPE(CSUSeconds,tyConCSUSeconds,"CSUSeconds",HTYPE_SUSECONDS_T) -INSTANCE_TYPEABLE0(CFloat,cFloatTc,"CFloat") -INSTANCE_TYPEABLE0(CDouble,cDoubleTc,"CDouble") -INSTANCE_TYPEABLE0(CLDouble,cLDoubleTc,"CLDouble") +-- FIXME: Implement and provide instances for Eq and Storable +-- | Haskell type representing the C @FILE@ type. +data CFile = CFile +-- | Haskell type representing the C @fpos_t@ type. +data CFpos = CFpos +-- | Haskell type representing the C @jmp_buf@ type. +data CJmpBuf = CJmpBuf + +INTEGRAL_TYPE(CIntPtr,tyConCIntPtr,"CIntPtr",HTYPE_INTPTR_T) +INTEGRAL_TYPE(CUIntPtr,tyConCUIntPtr,"CUIntPtr",HTYPE_UINTPTR_T) +INTEGRAL_TYPE(CIntMax,tyConCIntMax,"CIntMax",HTYPE_INTMAX_T) +INTEGRAL_TYPE(CUIntMax,tyConCUIntMax,"CUIntMax",HTYPE_UINTMAX_T) + +{-# RULES +"fromIntegral/a->CIntPtr" fromIntegral = \x -> CIntPtr (fromIntegral x) +"fromIntegral/a->CUIntPtr" fromIntegral = \x -> CUIntPtr (fromIntegral x) +"fromIntegral/a->CIntMax" fromIntegral = \x -> CIntMax (fromIntegral x) +"fromIntegral/a->CUIntMax" fromIntegral = \x -> CUIntMax (fromIntegral x) + #-} + +-- C99 types which are still missing include: +-- wint_t, wctrans_t, wctype_t + +{- $ctypes + +These types are needed to accurately represent C function prototypes, +in order to access C library interfaces in Haskell. The Haskell system +is not required to represent those types exactly as C does, but the +following guarantees are provided concerning a Haskell type @CT@ +representing a C type @t@: + +* If a C function prototype has @t@ as an argument or result type, the + use of @CT@ in the corresponding position in a foreign declaration + permits the Haskell program to access the full range of values encoded + by the C type; and conversely, any Haskell value for @CT@ has a valid + representation in C. + +* @'sizeOf' ('Prelude.undefined' :: CT)@ will yield the same value as + @sizeof (t)@ in C. + +* @'alignment' ('Prelude.undefined' :: CT)@ matches the alignment + constraint enforced by the C implementation for @t@. + +* The members 'peek' and 'poke' of the 'Storable' class map all values + of @CT@ to the corresponding value of @t@ and vice versa. + +* When an instance of 'Prelude.Bounded' is defined for @CT@, the values + of 'Prelude.minBound' and 'Prelude.maxBound' coincide with @t_MIN@ + and @t_MAX@ in C. + +* When an instance of 'Prelude.Eq' or 'Prelude.Ord' is defined for @CT@, + the predicates defined by the type class implement the same relation + as the corresponding predicate in C on @t@. + +* When an instance of 'Prelude.Num', 'Prelude.Read', 'Prelude.Integral', + 'Prelude.Fractional', 'Prelude.Floating', 'Prelude.RealFrac', or + 'Prelude.RealFloat' is defined for @CT@, the arithmetic operations + defined by the type class implement the same function as the + corresponding arithmetic operations (if available) in C on @t@. + +* When an instance of 'Bits' is defined for @CT@, the bitwise operation + defined by the type class implement the same function as the + corresponding bitwise operation in C on @t@. + +-} + +#else /* __NHC__ */ + +import NHC.FFI + ( CChar(..), CSChar(..), CUChar(..) + , CShort(..), CUShort(..), CInt(..), CUInt(..) + , CLong(..), CULong(..), CLLong(..), CULLong(..) + , CPtrdiff(..), CSize(..), CWchar(..), CSigAtomic(..) + , CClock(..), CTime(..), CUSeconds(..), CSUSeconds(..) + , CFloat(..), CDouble(..), CLDouble(..) + , CIntPtr(..), CUIntPtr(..),CIntMax(..), CUIntMax(..) + , CFile, CFpos, CJmpBuf + , Storable(..) + ) +import Data.Bits +import NHC.SizedTypes + +#define INSTANCE_BITS(T) \ +instance Bits T where { \ + (T x) .&. (T y) = T (x .&. y) ; \ + (T x) .|. (T y) = T (x .|. y) ; \ + (T x) `xor` (T y) = T (x `xor` y) ; \ + complement (T x) = T (complement x) ; \ + shift (T x) n = T (shift x n) ; \ + rotate (T x) n = T (rotate x n) ; \ + bit n = T (bit n) ; \ + setBit (T x) n = T (setBit x n) ; \ + clearBit (T x) n = T (clearBit x n) ; \ + complementBit (T x) n = T (complementBit x n) ; \ + testBit (T x) n = testBit x n ; \ + bitSize (T x) = bitSize x ; \ + isSigned (T x) = isSigned x } + +INSTANCE_BITS(CChar) +INSTANCE_BITS(CSChar) +INSTANCE_BITS(CUChar) +INSTANCE_BITS(CShort) +INSTANCE_BITS(CUShort) +INSTANCE_BITS(CInt) +INSTANCE_BITS(CUInt) +INSTANCE_BITS(CLong) +INSTANCE_BITS(CULong) +INSTANCE_BITS(CLLong) +INSTANCE_BITS(CULLong) +INSTANCE_BITS(CPtrdiff) +INSTANCE_BITS(CWchar) +INSTANCE_BITS(CSigAtomic) +INSTANCE_BITS(CSize) +INSTANCE_BITS(CIntPtr) +INSTANCE_BITS(CUIntPtr) +INSTANCE_BITS(CIntMax) +INSTANCE_BITS(CUIntMax) + +#endif