GHC's Addr module is meant to be used in conjunction with the FFI (at
least this is what the docs told me :-), but its plethora of similar
functions is not very nice and some often needed functionality is
missing. Attached is my proposed new version of Addr, being very
similar to the things in the "Staying alive" thread. Some changes:
* marshal.../unmarshal... are normal functions now and not methods
of Marshalable anymore.
* marshalList now returns the length of the list, too.
* Some convenience functions for in/inout/out parameters are added.
* After playing around with this module, I think that it is a
Good Thing (tm) that ...OffAddr use element offsets and not byte
offsets. It makes instance declarations of the following
form much easier:
instance Marshalable a => Marshalable (Foo a) where ...
Apart from that, it is much more consistent with the old
definitions.
Alas, almost nobody mailed his/her wishes for a marshaling library, so
this proposal is obviously biased towards HOpenGL's (and I think
Manuel's) needs.
Comments/suggestions?
Cheers,
Sven
--
Sven Panne Tel.: +49/89/2178-2235
LMU, Institut fuer Informatik FAX : +49/89/2178-2211
LFE Programmier- und Modellierungssprachen Oettingenstr. 67
mailto:[EMAIL PROTECTED] D-80538 Muenchen
http://www.informatik.uni-muenchen.de/~Sven.Panne
{- Hey Emacs, this is -*- haskell -*- !
@configure_input@
This file was part of HOpenGL - a binding of OpenGL and GLUT for Haskell.
Copyright (C) 1999 Sven Panne <[EMAIL PROTECTED]>
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library (COPYING.LIB); if not, write to the Free
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-}
module Addr (
Addr,
nullAddr, -- Addr
plusAddr, -- Addr -> Int -> Addr
Marshalable(
sizeOf, -- a -> Int
alignment, -- a -> Int
indexOffAddr, -- Addr -> Int -> a
readOffAddr, -- Addr -> Int -> IO a
writeOffAddr), -- Addr -> Int -> a -> IO ()
marshal, -- Marshalable a => a -> IO Addr
marshalList, -- Marshalable a => [a] -> IO (Int, Addr),
marshalListZero, -- Marshalable a => a -> [a] -> IO Addr
unmarshal, -- Marshalable a => Addr -> IO a
unmarshalList, -- Marshalable a => Int -> Addr -> IO [a]
unmarshalListZero, -- (Marshalable a, Eq a) => a -> Addr -> IO [a]
inParamWith, -- (a -> IO Addr) -> (Addr -> IO b) -> a -> IO
b
inParam, -- Marshalable a => (Addr -> IO b) -> a -> IO
b
inOutParamWith, -- (a -> IO Addr) -> (Addr -> IO a) -> (Addr -> IO b) -> a -> IO
a
inOutParam, -- Marshalable a => (Addr -> IO b) -> a -> IO
a
outParamWith, -- (a -> Int) -> (Addr -> IO a) -> (Addr -> IO b) -> IO
a
outParam, -- Marshalable a => (Addr -> IO b) -> IO
a
malloc, -- Int -> IO Addr
free -- Addr -> IO ()
) where
import Monad(when, zipWithM_)
import Addr
import Int
import Word
----------------------------------------------------------------------
-- Haskell equivalent of raw pointers
{- We get these from Addr
data Addr = ...
instance Eq Addr where ...
instance Ord Addr where ...
instance Show Addr where ...
nullAddr :: Addr
plusAddr :: Addr -> Int -> Addr
-}
-- replacement for intToAddr/addrToInt
instance Enum Addr where
toEnum = intToAddr
fromEnum = addrToInt
----------------------------------------------------------------------
-- primitive marshaling
class Marshalable a where
sizeOf :: a -> Int
alignment :: a -> Int
-- replacement for index-/read-/write???OffAddr
indexOffAddr :: Addr -> Int -> a
readOffAddr :: Addr -> Int -> IO a
writeOffAddr :: Addr -> Int -> a -> IO ()
-- system-dependent, but rather obvious instances
instance Marshalable Char where
sizeOf = const @SIZEOF_CHAR@
alignment = const @ALIGNOF_CHAR@
indexOffAddr = indexCharOffAddr
readOffAddr = readCharOffAddr
writeOffAddr = writeCharOffAddr
instance Marshalable Int where
sizeOf = const @SIZEOF_INT@
alignment = const @ALIGNOF_INT@
indexOffAddr = indexIntOffAddr
readOffAddr = readIntOffAddr
writeOffAddr = writeIntOffAddr
instance Marshalable Addr where
sizeOf = const @SIZEOF_VOID_P@
alignment = const @ALIGNOF_VOID_P@
indexOffAddr = indexAddrOffAddr
readOffAddr = readAddrOffAddr
writeOffAddr = writeAddrOffAddr
instance Marshalable Float where
sizeOf = const @SIZEOF_FLOAT@
alignment = const @ALIGNOF_FLOAT@
indexOffAddr = indexFloatOffAddr
readOffAddr = readFloatOffAddr
writeOffAddr = writeFloatOffAddr
instance Marshalable Double where
sizeOf = const @SIZEOF_DOUBLE@
alignment = const @ALIGNOF_DOUBLE@
indexOffAddr = indexDoubleOffAddr
readOffAddr = readDoubleOffAddr
writeOffAddr = writeDoubleOffAddr
instance Marshalable Word8 where
sizeOf = const 1
alignment = sizeOf -- not sure about this
indexOffAddr = indexWord8OffAddr
readOffAddr = readWord8OffAddr
writeOffAddr = writeWord8OffAddr
instance Marshalable Word16 where
sizeOf = const 2
alignment = sizeOf -- not sure about this
indexOffAddr = indexWord16OffAddr
readOffAddr = readWord16OffAddr
writeOffAddr = writeWord16OffAddr
instance Marshalable Word32 where
sizeOf = const 4
alignment = sizeOf -- not sure about this
indexOffAddr = indexWord32OffAddr
readOffAddr = readWord32OffAddr
writeOffAddr = writeWord32OffAddr
instance Marshalable Word64 where
sizeOf = const 8
alignment = sizeOf -- not sure about this
indexOffAddr = indexWord64OffAddr
readOffAddr = readWord64OffAddr
writeOffAddr = writeWord64OffAddr
instance Marshalable Int8 where
sizeOf = const 1
alignment = sizeOf -- not sure about this
indexOffAddr = indexInt8OffAddr
readOffAddr = readInt8OffAddr
writeOffAddr = writeInt8OffAddr
instance Marshalable Int16 where
sizeOf = const 2
alignment = sizeOf -- not sure about this
indexOffAddr = indexInt16OffAddr
readOffAddr = readInt16OffAddr
writeOffAddr = writeInt16OffAddr
instance Marshalable Int32 where
sizeOf = const 4
alignment = sizeOf -- not sure about this
indexOffAddr = indexInt32OffAddr
readOffAddr = readInt32OffAddr
writeOffAddr = writeInt32OffAddr
instance Marshalable Int64 where
sizeOf = const 8
alignment = sizeOf -- not sure about this
indexOffAddr = indexInt64OffAddr
readOffAddr = readInt64OffAddr
writeOffAddr = writeInt64OffAddr
----------------------------------------------------------------------
-- convenience functions for (un-)marshaling
-- Performance paranoia, one could use:
-- marshal x = marshalList [x]
marshal :: Marshalable a => a -> IO Addr
marshal x = do
buf <- malloc (sizeOf x)
writeOffAddr buf 0 x
return buf
marshalList :: Marshalable a => [a] -> IO (Int, Addr)
marshalList xs = do
let numElements = length xs
buf <- malloc (numElements * sizeOf (head xs))
zipWithM_ (writeOffAddr buf) [ 0 .. ] xs
return (numElements, buf)
-- Performance paranoia, one could use:
-- marshalListZero zeroElem xs = marshalList (xs ++ [zeroElem])
marshalListZero :: Marshalable a => a -> [a] -> IO Addr
marshalListZero zeroElem xs = do
let numElements = length xs
buf <- malloc ((numElements+1) * sizeOf (head xs))
zipWithM_ (writeOffAddr buf) [ 0 .. ] xs
writeOffAddr buf numElements zeroElem
return buf
-- Performance paranoia, one could use:
-- unmarshal buf = liftM head $ unmarshalList 1 buf
unmarshal :: Marshalable a => Addr -> IO a
unmarshal buf = readOffAddr buf 0
unmarshalList :: Marshalable a => Int -> Addr -> IO [a]
unmarshalList numElements buf =
mapM (readOffAddr buf) [ 0 .. numElements-1 ]
unmarshalListZero :: (Marshalable a, Eq a) => a -> Addr -> IO [a]
unmarshalListZero zeroElem buf = loop 0 []
where loop idx accu = do x <- readOffAddr buf idx
if x == zeroElem
then return $ reverse accu
else loop (idx+1) (x:accu)
----------------------------------------------------------------------
inParamWith :: (a -> IO Addr) -> (Addr -> IO b) -> a -> IO b
inParamWith marshal_ act x = do
buf <- marshal_ x
val <- act buf
free buf
return val
inParam :: Marshalable a => (Addr -> IO b) -> a -> IO b
inParam = inParamWith marshal
inOutParamWith :: (a -> IO Addr) -> (Addr -> IO a) -> (Addr -> IO b) -> a -> IO a
inOutParamWith marshal_ unmarshal_ act x = do
buf <- marshal_ x
act buf
val <- unmarshal_ buf
free buf
return val
inOutParam :: Marshalable a => (Addr -> IO b) -> a -> IO a
inOutParam = inOutParamWith marshal unmarshal
outParamWith :: (a -> Int) -> (Addr -> IO a) -> (Addr -> IO b) -> IO a
outParamWith sizeOf_ unmarshal_ act = do
buf <- malloc (sizeOf_ undefined)
act buf
m <- unmarshal_ buf
free buf
return m
outParam :: Marshalable a => (Addr -> IO b) -> IO a
outParam = outParamWith sizeOf unmarshal
----------------------------------------------------------------------
-- (de-)allocation of raw bytes
malloc :: Int -> IO Addr
malloc numBytes = do
buf <- mallocAux numBytes
when (buf == nullAddr)
(ioError (userError ("malloc(" ++ show numBytes ++ ") failed")))
return buf
-- Hmmm, Int is a little bit strange here, C uses size_t
foreign import ccall "malloc" unsafe mallocAux :: Int -> IO Addr
foreign import ccall "free" unsafe free :: Addr -> IO ()
