Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 7f65e37055
Fetching contributors…

Cannot retrieve contributors at this time

217 lines (169 sloc) 8.868 kb
-- C->Haskell Compiler: Marshalling library
--
-- Copyright (c) [1999...2005] Manuel M T Chakravarty
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are met:
--
-- 1. Redistributions of source code must retain the above copyright notice,
-- this list of conditions and the following disclaimer.
-- 2. Redistributions in binary form must reproduce the above copyright
-- notice, this list of conditions and the following disclaimer in the
-- documentation and/or other materials provided with the distribution.
-- 3. The name of the author may not be used to endorse or promote products
-- derived from this software without specific prior written permission.
--
-- THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
-- OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN
-- NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
-- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
--
--- Description ---------------------------------------------------------------
--
-- Language: Haskell 98
--
-- This module provides the marshaling routines for Haskell files produced by
-- C->Haskell for binding to C library interfaces. It exports all of the
-- low-level FFI (language-independent plus the C-specific parts) together
-- with the C->HS-specific higher-level marshalling routines.
--
module C2HS (
-- * Re-export the language-independent component of the FFI
module Foreign,
-- * Re-export the C language component of the FFI
module Foreign.C,
-- * Composite marshalling functions
withCStringLenIntConv, peekCStringLenIntConv, withIntConv, withFloatConv,
peekIntConv, peekFloatConv, withBool, peekBool, withEnum, peekEnum,
-- * Conditional results using 'Maybe'
nothingIf, nothingIfNull,
-- * Bit masks
combineBitMasks, containsBitMask, extractBitMasks,
-- * Conversion between C and Haskell types
cIntConv, cFloatConv, cToBool, cFromBool, cToEnum, cFromEnum
) where
import Foreign
import Foreign.C
import Control.Monad (liftM)
-- Composite marshalling functions
-- -------------------------------
-- Strings with explicit length
--
withCStringLenIntConv :: Num n => String -> ((CString, n) -> IO a) -> IO a
withCStringLenIntConv s f = withCStringLen s $ \(p, n) -> f (p, fromIntegral n)
peekCStringLenIntConv :: Integral n => (CString, n) -> IO String
peekCStringLenIntConv (s, n) = peekCStringLen (s, fromIntegral n)
-- Marshalling of numerals
--
withIntConv :: (Storable b, Integral a, Integral b)
=> a -> (Ptr b -> IO c) -> IO c
withIntConv = with . fromIntegral
withFloatConv :: (Storable b, RealFloat a, RealFloat b)
=> a -> (Ptr b -> IO c) -> IO c
withFloatConv = with . realToFrac
peekIntConv :: (Storable a, Integral a, Integral b)
=> Ptr a -> IO b
peekIntConv = liftM fromIntegral . peek
peekFloatConv :: (Storable a, RealFloat a, RealFloat b)
=> Ptr a -> IO b
peekFloatConv = liftM realToFrac . peek
-- Everything else below is deprecated.
-- These functions are not used by code generated by c2hs.
{-# DEPRECATED withBool "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
{-# DEPRECATED peekBool "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
{-# DEPRECATED withEnum "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
{-# DEPRECATED peekEnum "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
{-# DEPRECATED nothingIf "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
{-# DEPRECATED nothingIfNull "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
{-# DEPRECATED combineBitMasks "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
{-# DEPRECATED containsBitMask "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
{-# DEPRECATED extractBitMasks "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
{-# DEPRECATED cIntConv "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
{-# DEPRECATED cFloatConv "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
{-# DEPRECATED cFromBool "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
{-# DEPRECATED cToBool "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
{-# DEPRECATED cToEnum "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
{-# DEPRECATED cFromEnum "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}
-- Passing Booleans by reference
--
withBool :: (Integral a, Storable a) => Bool -> (Ptr a -> IO b) -> IO b
withBool = with . fromBool
peekBool :: (Integral a, Storable a) => Ptr a -> IO Bool
peekBool = liftM toBool . peek
-- Passing enums by reference
--
withEnum :: (Enum a, Integral b, Storable b) => a -> (Ptr b -> IO c) -> IO c
withEnum = with . cFromEnum
peekEnum :: (Enum a, Integral b, Storable b) => Ptr b -> IO a
peekEnum = liftM cToEnum . peek
-- Conditional results using 'Maybe'
-- ---------------------------------
-- Wrap the result into a 'Maybe' type.
--
-- * the predicate determines when the result is considered to be non-existing,
-- ie, it is represented by `Nothing'
--
-- * the second argument allows to map a result wrapped into `Just' to some
-- other domain
--
nothingIf :: (a -> Bool) -> (a -> b) -> a -> Maybe b
nothingIf p f x = if p x then Nothing else Just $ f x
-- |Instance for special casing null pointers.
--
nothingIfNull :: (Ptr a -> b) -> Ptr a -> Maybe b
nothingIfNull = nothingIf (== nullPtr)
-- Support for bit masks
-- ---------------------
-- Given a list of enumeration values that represent bit masks, combine these
-- masks using bitwise disjunction.
--
combineBitMasks :: (Enum a, Bits b) => [a] -> b
combineBitMasks = foldl (.|.) 0 . map (fromIntegral . fromEnum)
-- Tests whether the given bit mask is contained in the given bit pattern
-- (i.e., all bits set in the mask are also set in the pattern).
--
containsBitMask :: (Bits a, Enum b) => a -> b -> Bool
bits `containsBitMask` bm = let bm' = fromIntegral . fromEnum $ bm
in
bm' .&. bits == bm'
-- |Given a bit pattern, yield all bit masks that it contains.
--
-- * This does *not* attempt to compute a minimal set of bit masks that when
-- combined yield the bit pattern, instead all contained bit masks are
-- produced.
--
extractBitMasks :: (Bits a, Enum b, Bounded b) => a -> [b]
extractBitMasks bits =
[bm | bm <- [minBound..maxBound], bits `containsBitMask` bm]
-- Conversion routines
-- -------------------
-- |Integral conversion
--
cIntConv :: (Integral a, Integral b) => a -> b
cIntConv = fromIntegral
-- |Floating conversion
--
cFloatConv :: (RealFloat a, RealFloat b) => a -> b
cFloatConv = realToFrac
-- |Obtain C value from Haskell 'Bool'.
--
cFromBool :: Num a => Bool -> a
cFromBool = fromBool
-- |Obtain Haskell 'Bool' from C value.
--
cToBool :: (Eq a, Num a) => a -> Bool
cToBool = toBool
-- |Convert a C enumeration to Haskell.
--
cToEnum :: (Integral i, Enum e) => i -> e
cToEnum = toEnum . fromIntegral
-- |Convert a Haskell enumeration to C.
--
cFromEnum :: (Enum e, Integral i) => e -> i
cFromEnum = fromIntegral . fromEnum
Jump to Line
Something went wrong with that request. Please try again.