    --  C->Haskell Compiler: information about the C implementation
    --
    --  Author : Manuel M T Chakravarty
    --  Created: 5 February 01
    --
    --  Version $Revision: 1.2 $ from $Date: 2005/01/16 21:31:21 $
    --
    --  Copyright (c) 2001 Manuel M T Chakravarty
    --
    --  This file is free software; you can redistribute it and/or modify
    --  it under the terms of the GNU General Public License as published by
    --  the Free Software Foundation; either version 2 of the License, or
    --  (at your option) any later version.
    --
    --  This file 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 General Public License for more details.
    --
    --- DESCRIPTION ---------------------------------------------------------------
    --
    --  This module provide some information about the specific implementation of
    --  C that we are dealing with.
    --
    --- DOCU ----------------------------------------------------------------------
    --
    --  language: Haskell 98
    --
    --  Bit fields
    --  ~~~~~~~~~~
    --  Bit fields in C can be signed and unsigned.  According to K&R A8.3, they
    --  can only be formed from `int', `signed int', and `unsigned int', where for
    --  `int' it is implementation dependent whether the field is signed or
    --  unsigned.  Moreover, the following parameters are implementation
    --  dependent:
    --
    --  * the direction of packing bits into storage units,
    --  * the size of storage units, and
    --  * whether when a field that doesn't fit a partially filled storage unit
    --    is split across units or the partially filled unit is padded.
    --
    --  Generally, unnamed fields (those without an identifier) with a width of 0
    --  are guaranteed to forces the above padding.  Note that in `CPrimType' we
    --  only represent 0 width fields *if* they imply padding.  In other words,
    --  whenever they are unnamed, they are represented by a `CPrimType', and if
    --  they are named, they are represented by a `CPrimType' only if that
    --  targeted C compiler chooses to let them introduce padding.  If a field
    --  does not have any effect, it is dropped during the conversion of a C type
    --  into a `CPrimType'-based representation.
    --
    --  In the code, we assume that the alignment of a bitfield (as determined by
    --  `bitfieldAlignment') is independent of the size of the bitfield.
    --
    --- TODO ----------------------------------------------------------------------
    --

    module CInfo (
      CPrimType(..), size, alignment,
      bitfieldDirection, bitfieldPadding, bitfieldIntSigned, bitfieldAlignment
    ) where

    import Foreign.C

    -- we can't rely on the compiler used to compile c2hs already having the new
    -- FFI, so this is system dependent
    --
    import C2HSConfig (Ptr, FunPtr,
                       bitfieldDirection, bitfieldPadding, bitfieldIntSigned,
                       bitfieldAlignment)
    import qualified
           C2HSConfig as Storable
                      (Storable(sizeOf, alignment))

    -- calibration of C's primitive types
    -- ----------------------------------

    -- C's primitive types (EXPORTED)
    --
    --  * `CFunPtrPT' doesn't occur in Haskell representations of C types, but we
    --   need to know their size, which may be different from `CPtrPT'
    --
    data CPrimType = CPtrPT         -- void *
                   | CFunPtrPT      -- void *()
                   | CCharPT        -- char
                   | CUCharPT       -- unsigned char
                   | CSCharPT       -- signed char
                   | CIntPT         -- int
                   | CShortPT       -- short int
                   | CLongPT        -- long int
                   | CLLongPT       -- long long int
                   | CUIntPT        -- unsigned int
                   | CUShortPT      -- unsigned short int
                   | CULongPT       -- unsigned long int
                   | CULLongPT      -- unsigned long long int
                   | CFloatPT       -- float
                   | CDoublePT      -- double
                   | CLDoublePT     -- long double
                   | CSFieldPT  Int -- signed bit field
                   | CUFieldPT  Int -- unsigned bit field
                   deriving (CPrimType -> CPrimType -> Bool
    (CPrimType -> CPrimType -> Bool)
    -> (CPrimType -> CPrimType -> Bool) -> Eq CPrimType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: CPrimType -> CPrimType -> Bool
    == :: CPrimType -> CPrimType -> Bool
    $c/= :: CPrimType -> CPrimType -> Bool
    /= :: CPrimType -> CPrimType -> Bool
    Eq)

    -- size of primitive type of C (EXPORTED)
    --
    --  * negative size implies that it is a bit, not an octet size
    --
    size                :: CPrimType -> Int
    size :: CPrimType -> Int
    size CPrimType
    CPtrPT          = Ptr () -> Int
    forall a. Storable a => a -> Int
    Storable.sizeOf (Ptr ()
    forall a. HasCallStack => a
    undefined :: Ptr ())
    size CPrimType
    CFunPtrPT       = FunPtr () -> Int
    forall a. Storable a => a -> Int
    Storable.sizeOf (FunPtr ()
    forall a. HasCallStack => a
    undefined :: FunPtr ())
    size CPrimType
    CCharPT         = Int
    1
    size CPrimType
    CUCharPT        = Int
    1
    size CPrimType
    CSCharPT        = Int
    1
    size CPrimType
    CIntPT          = CInt -> Int
    forall a. Storable a => a -> Int
    Storable.sizeOf (CInt
    forall a. HasCallStack => a
    undefined :: CInt)
    size CPrimType
    CShortPT        = CShort -> Int
    forall a. Storable a => a -> Int
    Storable.sizeOf (CShort
    forall a. HasCallStack => a
    undefined :: CShort)
    size CPrimType
    CLongPT         = CLong -> Int
    forall a. Storable a => a -> Int
    Storable.sizeOf (CLong
    forall a. HasCallStack => a
    undefined :: CLong)
    size CPrimType
    CLLongPT        = CLLong -> Int
    forall a. Storable a => a -> Int
    Storable.sizeOf (CLLong
    forall a. HasCallStack => a
    undefined :: CLLong)
    size CPrimType
    CUIntPT         = CUInt -> Int
    forall a. Storable a => a -> Int
    Storable.sizeOf (CUInt
    forall a. HasCallStack => a
    undefined :: CUInt)
    size CPrimType
    CUShortPT       = CUShort -> Int
    forall a. Storable a => a -> Int
    Storable.sizeOf (CUShort
    forall a. HasCallStack => a
    undefined :: CUShort)
    size CPrimType
    CULongPT        = CULong -> Int
    forall a. Storable a => a -> Int
    Storable.sizeOf (CULong
    forall a. HasCallStack => a
    undefined :: CULong)
    size CPrimType
    CULLongPT       = CLLong -> Int
    forall a. Storable a => a -> Int
    Storable.sizeOf (CLLong
    forall a. HasCallStack => a
    undefined :: CLLong)
    size CPrimType
    CFloatPT        = CFloat -> Int
    forall a. Storable a => a -> Int
    Storable.sizeOf (CFloat
    forall a. HasCallStack => a
    undefined :: CFloat)
    size CPrimType
    CDoublePT       = CDouble -> Int
    forall a. Storable a => a -> Int
    Storable.sizeOf (CDouble
    forall a. HasCallStack => a
    undefined :: CDouble)
    --size CLDoublePT      = Storable.sizeOf (undefined :: CLDouble)
    size (CSFieldPT Int
    bs)  = -Int
    bs
    size (CUFieldPT Int
    bs)  = -Int
    bs

    -- alignment of C's primitive types (EXPORTED)
    --
    --  * more precisely, the padding put before the type's member starts when the
    --   preceding component is a char
    --
    alignment                :: CPrimType -> Int
    alignment :: CPrimType -> Int
    alignment CPrimType
    CPtrPT          = Ptr () -> Int
    forall a. Storable a => a -> Int
    Storable.alignment (Ptr ()
    forall a. HasCallStack => a
    undefined :: Ptr ())
    alignment CPrimType
    CFunPtrPT       = FunPtr () -> Int
    forall a. Storable a => a -> Int
    Storable.alignment (FunPtr ()
    forall a. HasCallStack => a
    undefined :: FunPtr ())
    alignment CPrimType
    CCharPT         = Int
    1
    alignment CPrimType
    CUCharPT        = Int
    1
    alignment CPrimType
    CSCharPT        = Int
    1
    alignment CPrimType
    CIntPT          = CInt -> Int
    forall a. Storable a => a -> Int
    Storable.alignment (CInt
    forall a. HasCallStack => a
    undefined :: CInt)
    alignment CPrimType
    CShortPT        = CShort -> Int
    forall a. Storable a => a -> Int
    Storable.alignment (CShort
    forall a. HasCallStack => a
    undefined :: CShort)
    alignment CPrimType
    CLongPT         = CLong -> Int
    forall a. Storable a => a -> Int
    Storable.alignment (CLong
    forall a. HasCallStack => a
    undefined :: CLong)
    alignment CPrimType
    CLLongPT        = CLLong -> Int
    forall a. Storable a => a -> Int
    Storable.alignment (CLLong
    forall a. HasCallStack => a
    undefined :: CLLong)
    alignment CPrimType
    CUIntPT         = CUInt -> Int
    forall a. Storable a => a -> Int
    Storable.alignment (CUInt
    forall a. HasCallStack => a
    undefined :: CUInt)
    alignment CPrimType
    CUShortPT       = CUShort -> Int
    forall a. Storable a => a -> Int
    Storable.alignment (CUShort
    forall a. HasCallStack => a
    undefined :: CUShort)
    alignment CPrimType
    CULongPT        = CULong -> Int
    forall a. Storable a => a -> Int
    Storable.alignment (CULong
    forall a. HasCallStack => a
    undefined :: CULong)
    alignment CPrimType
    CULLongPT       = CULLong -> Int
    forall a. Storable a => a -> Int
    Storable.alignment (CULLong
    forall a. HasCallStack => a
    undefined :: CULLong)
    alignment CPrimType
    CFloatPT        = CFloat -> Int
    forall a. Storable a => a -> Int
    Storable.alignment (CFloat
    forall a. HasCallStack => a
    undefined :: CFloat)
    alignment CPrimType
    CDoublePT       = CDouble -> Int
    forall a. Storable a => a -> Int
    Storable.alignment (CDouble
    forall a. HasCallStack => a
    undefined :: CDouble)
    --alignment CLDoublePT      = Storable.alignment (undefined :: CLDouble)
    alignment (CSFieldPT Int
    bs)  = Int -> Int
    fieldAlignment Int
    bs
    alignment (CUFieldPT Int
    bs)  = Int -> Int
    fieldAlignment Int
    bs

    -- alignment constraint for a C bitfield
    --
    --  * gets the bitfield size (in bits) as an argument
    --
    --  * alignments constraints smaller or equal to zero are reserved for bitfield
    --   alignments
    --
    --  * bitfields of size 0 always trigger padding; thus, they get the maximal
    --   size
    --
    --  * if bitfields whose size exceeds the space that is still available in a
    --   partially filled storage unit trigger padding, the size of a storage unit
    --   is provided as the alignment constraint; otherwise, it is 0 (meaning it
    --   definitely starts at the current position)
    --
    --  * here, alignment constraint /= 0 are somewhat subtle; they mean that is
    --   the given number of bits doesn't fit in what's left in the current
    --   storage unit, alignment to the start of the next storage unit has to be
    --   triggered
    --
    fieldAlignment                      :: Int -> Int
    fieldAlignment :: Int -> Int
    fieldAlignment Int
    0                     = - (CPrimType -> Int
    size CPrimType
    CIntPT Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)
    fieldAlignment Int
    bs | Bool
    bitfieldPadding  = - Int
    bs
                      | Bool
    otherwise        = Int
    0