module MyForeign(module MyForeign,(<$>),(<*>),F.Int32,F.CSize(..)) where
import Control.Applicative
import qualified Foreign as F
import qualified Foreign.C as F
import Foreign.C.String(castCCharToChar,castCharToCChar)
--import CCall
import Control.Exception(bracket)
--import Ap
-- Emulate GHC 4.08 libraries on top of GHC 5.00 libraries...

newtype Addr = Addr (F.Ptr F.Word8) deriving (Addr -> Addr -> Bool
(Addr -> Addr -> Bool) -> (Addr -> Addr -> Bool) -> Eq Addr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Addr -> Addr -> Bool
$c/= :: Addr -> Addr -> Bool
== :: Addr -> Addr -> Bool
$c== :: Addr -> Addr -> Bool
Eq,Int -> Addr -> ShowS
[Addr] -> ShowS
Addr -> String
(Int -> Addr -> ShowS)
-> (Addr -> String) -> ([Addr] -> ShowS) -> Show Addr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Addr] -> ShowS
$cshowList :: [Addr] -> ShowS
show :: Addr -> String
$cshow :: Addr -> String
showsPrec :: Int -> Addr -> ShowS
$cshowsPrec :: Int -> Addr -> ShowS
Show)
type AddrOff = Int

--instance CCallable Addr
--instance CReturnable Addr

class Storable a where
  sizeOf      :: a -> Int
  alignment   :: a -> Int

  peekElemOff :: Addr -> Int          -> IO a
  pokeElemOff :: Addr -> Int     -> a -> IO ()

  peekByteOff :: Addr -> AddrOff      -> IO a
  pokeByteOff :: Addr -> AddrOff -> a -> IO ()

  peek        :: Addr                 -> IO a
  poke        :: Addr            -> a -> IO ()

  peek Addr
a = Addr -> Int -> IO a
forall a. Storable a => Addr -> Int -> IO a
peekByteOff Addr
a Int
0
  poke Addr
a = Addr -> Int -> a -> IO ()
forall a. Storable a => Addr -> Int -> a -> IO ()
pokeByteOff Addr
a Int
0

  peekElemOff Addr
a Int
i =
    let iox :: IO a
iox = Addr -> Int -> IO a
forall a. Storable a => Addr -> Int -> IO a
peekByteOff Addr
a (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*a -> Int
forall a. Storable a => a -> Int
sizeOf (IO a -> a
forall a. IO a -> a
u IO a
iox))
	u :: IO a -> a
	u :: IO a -> a
u = IO a -> a
forall a. HasCallStack => a
undefined
    in IO a
iox
  pokeElemOff Addr
a Int
i a
x = Addr -> Int -> a -> IO ()
forall a. Storable a => Addr -> Int -> a -> IO ()
pokeByteOff Addr
a (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*a -> Int
forall a. Storable a => a -> Int
sizeOf a
x) a
x

  peekByteOff Addr
a Int
i = Addr -> IO a
forall a. Storable a => Addr -> IO a
peek (Addr
a Addr -> Int -> Addr
`plusAddr` Int
i)
  pokeByteOff Addr
a Int
i = Addr -> a -> IO ()
forall a. Storable a => Addr -> a -> IO ()
poke (Addr
a Addr -> Int -> Addr
`plusAddr` Int
i)

malloc :: Int -> IO Addr
malloc Int
n = Ptr Word8 -> Addr
Addr (Ptr Word8 -> Addr) -> IO (Ptr Word8) -> IO Addr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO (Ptr Word8)
forall a. Int -> IO (Ptr a)
F.mallocBytes Int
n
mallocElem :: a -> IO Addr
mallocElem a
x = Int -> IO Addr
malloc (a -> Int
forall a. Storable a => a -> Int
sizeOf a
x)
mallocElems :: a -> Int -> IO Addr
mallocElems a
x Int
n = Int -> IO Addr
malloc (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*a -> Int
forall a. Storable a => a -> Int
sizeOf a
x)
free :: Addr -> IO ()
free (Addr Ptr Word8
p) = Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
F.free Ptr Word8
p
alloca :: Int -> (Addr -> IO c) -> IO c
alloca Int
n = IO Addr -> (Addr -> IO ()) -> (Addr -> IO c) -> IO c
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO Addr
malloc Int
n) Addr -> IO ()
free
allocaElem :: a -> (Addr -> IO c) -> IO c
allocaElem a
x = IO Addr -> (Addr -> IO ()) -> (Addr -> IO c) -> IO c
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (a -> IO Addr
forall a. Storable a => a -> IO Addr
mallocElem a
x) Addr -> IO ()
free
allocaElems :: a -> Int -> (Addr -> IO c) -> IO c
allocaElems a
x Int
n = IO Addr -> (Addr -> IO ()) -> (Addr -> IO c) -> IO c
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (a -> Int -> IO Addr
forall a. Storable a => a -> Int -> IO Addr
mallocElems a
x Int
n) Addr -> IO ()
free

nullAddr :: Addr
nullAddr = Ptr Word8 -> Addr
Addr Ptr Word8
forall a. Ptr a
F.nullPtr
plusAddr :: Addr -> Int -> Addr
plusAddr (Addr Ptr Word8
p) Int
n = Ptr Word8 -> Addr
Addr (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
F.plusPtr Ptr Word8
p Int
n)
minusAddr :: Addr -> Addr -> Int
minusAddr (Addr Ptr Word8
p1) (Addr Ptr Word8
p2) = Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
F.minusPtr Ptr Word8
p1 Ptr Word8
p2

instance Storable Addr where
  sizeOf :: Addr -> Int
sizeOf (Addr Ptr Word8
a) = Ptr Word8 -> Int
forall a. Storable a => a -> Int
F.sizeOf Ptr Word8
a
  alignment :: Addr -> Int
alignment (Addr Ptr Word8
a) = Ptr Word8 -> Int
forall a. Storable a => a -> Int
F.alignment Ptr Word8
a

  peek :: Addr -> IO Addr
peek Addr
a = Ptr Word8 -> Addr
Addr (Ptr Word8 -> Addr) -> IO (Ptr Word8) -> IO Addr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Addr -> IO (Ptr Word8)
forall a. Storable a => Addr -> IO a
fpeek Addr
a
  poke :: Addr -> Addr -> IO ()
poke Addr
a (Addr Ptr Word8
x) = Addr -> Ptr Word8 -> IO ()
forall a. Storable a => Addr -> a -> IO ()
fpoke Addr
a Ptr Word8
x

instance Storable Char where
  sizeOf :: Char -> Int
sizeOf Char
_ = Int
1
  alignment :: Char -> Int
alignment Char
_ = Int
1

  peek :: Addr -> IO Char
peek Addr
a = CChar -> Char
castCCharToChar (CChar -> Char) -> IO CChar -> IO Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Addr -> IO CChar
forall a. Storable a => Addr -> IO a
fpeek Addr
a
  poke :: Addr -> Char -> IO ()
poke Addr
a Char
c = Addr -> CChar -> IO ()
forall a. Storable a => Addr -> a -> IO ()
fpoke Addr
a (Char -> CChar
castCharToCChar Char
c)

fpeek :: Addr -> IO a
fpeek (Addr Ptr Word8
p) = Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
F.peek (Ptr Word8 -> Ptr a
forall a b. Ptr a -> Ptr b
F.castPtr Ptr Word8
p)
fpoke :: Addr -> a -> IO ()
fpoke (Addr Ptr Word8
p) = Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
F.poke (Ptr Word8 -> Ptr a
forall a b. Ptr a -> Ptr b
F.castPtr Ptr Word8
p)

instance Storable Int where
  sizeOf :: Int -> Int
sizeOf Int
x = Int -> Int
forall a. Storable a => a -> Int
F.sizeOf Int
x
  alignment :: Int -> Int
alignment Int
x = Int -> Int
forall a. Storable a => a -> Int
F.alignment Int
x

  peek :: Addr -> IO Int
peek = Addr -> IO Int
forall a. Storable a => Addr -> IO a
fpeek
  poke :: Addr -> Int -> IO ()
poke = Addr -> Int -> IO ()
forall a. Storable a => Addr -> a -> IO ()
fpoke


instance Storable F.Int32 where
  sizeOf :: Int32 -> Int
sizeOf Int32
x = Int32 -> Int
forall a. Storable a => a -> Int
F.sizeOf Int32
x
  alignment :: Int32 -> Int
alignment Int32
x = Int32 -> Int
forall a. Storable a => a -> Int
F.alignment Int32
x

  peek :: Addr -> IO Int32
peek = Addr -> IO Int32
forall a. Storable a => Addr -> IO a
fpeek
  poke :: Addr -> Int32 -> IO ()
poke = Addr -> Int32 -> IO ()
forall a. Storable a => Addr -> a -> IO ()
fpoke


instance Storable F.Word32 where
  sizeOf :: Word32 -> Int
sizeOf Word32
x = Word32 -> Int
forall a. Storable a => a -> Int
F.sizeOf Word32
x
  alignment :: Word32 -> Int
alignment Word32
x = Word32 -> Int
forall a. Storable a => a -> Int
F.alignment Word32
x

  peek :: Addr -> IO Word32
peek = Addr -> IO Word32
forall a. Storable a => Addr -> IO a
fpeek
  poke :: Addr -> Word32 -> IO ()
poke = Addr -> Word32 -> IO ()
forall a. Storable a => Addr -> a -> IO ()
fpoke