Foreign/Ptr.hs (original) (raw)

#ifdef GLASGOW_HASKELL

#endif

module Foreign.Ptr (

Ptr,      
nullPtr,      
castPtr,      
plusPtr,      
alignPtr,     
minusPtr,     


FunPtr,      
nullFunPtr,      
castFunPtr,      
castFunPtrToPtr, 
castPtrToFunPtr, 

freeHaskellFunPtr, 

#ifndef NHC

IntPtr,
ptrToIntPtr,
intPtrToPtr,
WordPtr,
ptrToWordPtr,
wordPtrToPtr

#endif ) where

#ifdef GLASGOW_HASKELL import GHC.Ptr import GHC.Base import GHC.Num import GHC.Read import GHC.Real import GHC.Show import GHC.Enum #else import Control.Monad ( liftM ) import Foreign.C.Types #endif

import Data.Bits import Data.Typeable import Foreign.Storable ( Storable(..) )

#ifdef NHC import NHC.FFI ( Ptr , nullPtr , castPtr , plusPtr , alignPtr , minusPtr , FunPtr , nullFunPtr , castFunPtr , castFunPtrToPtr , castPtrToFunPtr , freeHaskellFunPtr ) #endif

#ifdef HUGS import Hugs.Ptr #endif

#ifdef GLASGOW_HASKELL

foreign import ccall unsafe "freeHaskellFunctionPtr" freeHaskellFunPtr :: FunPtr a -> IO () #endif

#ifndef NHC

include "HsBaseConfig.h"

include "CTypes.h"

ifdef GLASGOW_HASKELL

INTEGRAL_TYPE(WordPtr,tyConWordPtr,"WordPtr",Word)

INTEGRAL_TYPE(IntPtr,tyConIntPtr,"IntPtr",Int)

ptrToWordPtr :: Ptr a -> WordPtr ptrToWordPtr (Ptr a#) = WordPtr (W# (int2Word# (addr2Int# a#)))

wordPtrToPtr :: WordPtr -> Ptr a wordPtrToPtr (WordPtr (W# w#)) = Ptr (int2Addr# (word2Int# w#))

ptrToIntPtr :: Ptr a -> IntPtr ptrToIntPtr (Ptr a#) = IntPtr (I# (addr2Int# a#))

intPtrToPtr :: IntPtr -> Ptr a intPtrToPtr (IntPtr (I# i#)) = Ptr (int2Addr# i#)

else /* !GLASGOW_HASKELL */

INTEGRAL_TYPE(WordPtr,tyConWordPtr,"WordPtr",CUIntPtr) INTEGRAL_TYPE(IntPtr,tyConIntPtr,"IntPtr",CIntPtr)

foreign import ccall unsafe "__hscore_to_uintptr" ptrToWordPtr :: Ptr a -> WordPtr

foreign import ccall unsafe "__hscore_from_uintptr" wordPtrToPtr :: WordPtr -> Ptr a

foreign import ccall unsafe "__hscore_to_intptr" ptrToIntPtr :: Ptr a -> IntPtr

foreign import ccall unsafe "__hscore_from_intptr" intPtrToPtr :: IntPtr -> Ptr a

endif /* !GLASGOW_HASKELL */

#endif /* !_NHC */