{-|
Module      : Foreign.Storable.Generic.Tools
Copyright   : (c) Mateusz Kłoczko, 2016
License     : MIT
Maintainer  : mateusz.p.kloczko@gmail.com
Stability   : experimental
Portability : portable


-}


{-#LANGUAGE FlexibleInstances #-}
{-#LANGUAGE FlexibleContexts #-}
{-#LANGUAGE TypeOperators #-}
{-#LANGUAGE ScopedTypeVariables #-}
{-#LANGUAGE UndecidableInstances #-}

module Foreign.Storable.Generic.Tools (
    Size,
    Alignment,
    Offset,
    Filling(..),
    calcOffsets,
    calcSize,
    calcAlignment,
    getFilling
) where

import Data.List


-- | The datatype representing the memory layout of a given struct.
data Filling = Size Int | Padding Int deriving(Int -> Filling -> ShowS
[Filling] -> ShowS
Filling -> String
(Int -> Filling -> ShowS)
-> (Filling -> String) -> ([Filling] -> ShowS) -> Show Filling
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Filling] -> ShowS
$cshowList :: [Filling] -> ShowS
show :: Filling -> String
$cshow :: Filling -> String
showsPrec :: Int -> Filling -> ShowS
$cshowsPrec :: Int -> Filling -> ShowS
Show, Filling -> Filling -> Bool
(Filling -> Filling -> Bool)
-> (Filling -> Filling -> Bool) -> Eq Filling
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Filling -> Filling -> Bool
$c/= :: Filling -> Filling -> Bool
== :: Filling -> Filling -> Bool
$c== :: Filling -> Filling -> Bool
Eq)

-- | Checks whether the size or padding are zero.
not_zero :: Filling -> Bool
not_zero :: Filling -> Bool
not_zero (Size    Int
0) = Bool
False
not_zero (Padding Int
0) = Bool
False
not_zero Filling
_           = Bool
True


type Size      = Int
type Alignment = Int
type Offset    = Int



-- | Get the memory layout of a given type/struct. Used mostly as debug information.
getFilling :: [(Size,Alignment)] -- ^ List of sizes and aligments of the type's/struct's fields. [(Int,Int)]
           -> [Filling]          -- ^ List representing the memory layout. [Filling]
getFilling :: [(Int, Int)] -> [Filling]
getFilling [(Int, Int)]
size_align = [Filling] -> [Filling]
forall a. [a] -> [a]
reverse ([Filling] -> [Filling]) -> [Filling] -> [Filling]
forall a b. (a -> b) -> a -> b
$ (Filling -> Bool) -> [Filling] -> [Filling]
forall a. (a -> Bool) -> [a] -> [a]
filter Filling -> Bool
not_zero ([Filling] -> [Filling]) -> [Filling] -> [Filling]
forall a b. (a -> b) -> a -> b
$ [(Int, Int)] -> Int -> Int -> [Filling] -> [Filling]
getFilling' ([(Int, Int)]
ordered [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ [(Int
gl_size,Int
0)]) Int
0 Int
0 []
    where offsets :: [Int]
offsets = [(Int, Int)] -> [Int]
calcOffsets [(Int, Int)]
size_align  :: [Offset]
          sizes :: [Int]
sizes   = ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> a
fst [(Int, Int)]
size_align      :: [Size]
          ordered :: [(Int, Int)]
ordered = ((Int, Int) -> (Int, Int) -> Ordering)
-> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Int
o1,Int
_) (Int
o2,Int
_) -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
o1 Int
o2) ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ -- Needs to be sorted in case the fields are rearranged. 
                        [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
offsets [Int]
sizes   :: [(Offset,Size)] 
          gl_size :: Int
gl_size  = [(Int, Int)] -> Int
calcSize [(Int, Int)]
size_align    :: Offset   -- This variable is used as offset

getFilling' :: [(Offset, Size)] -- ^ List of struct's fields' offsets and sizes  
            -> Size             -- ^ Size of the previous element
            -> Offset           -- ^ Offest of the previous element
            -> [Filling]        -- ^ Accumulator: List of filling
            -> [Filling]        -- ^ Returned list of fillings.
getFilling' :: [(Int, Int)] -> Int -> Int -> [Filling] -> [Filling]
getFilling' []           Int
_ Int
_ [Filling]
acc = [Filling]
acc
getFilling' ((Int
o2,Int
s2):[(Int, Int)]
rest) Int
s1 Int
o1 [Filling]
acc = [(Int, Int)] -> Int -> Int -> [Filling] -> [Filling]
getFilling' [(Int, Int)]
rest Int
s2 Int
o2 (Int -> Filling
Size Int
s2 Filling -> [Filling] -> [Filling]
forall a. a -> [a] -> [a]
: Int -> Filling
Padding ((Int
o2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
o1) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s1) Filling -> [Filling] -> [Filling]
forall a. a -> [a] -> [a]
: [Filling]
acc )

{-# NOINLINE calcOffsets #-}
-- | Calculates the memory offset of type's/struct's fields.
calcOffsets :: [(Size, Alignment)]  -- ^ List of sizes and aligments of the type's/struct's fields. [(Int,Int)]
            -> [Offset]             -- ^ List representing the offests of the type's/struct's fields. [Int]
calcOffsets :: [(Int, Int)] -> [Int]
calcOffsets []         = []
calcOffsets [(Int, Int)]
size_align = [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ ([Int], Int) -> [Int]
forall a b. (a, b) -> a
fst (([Int], Int) -> [Int]) -> ([Int], Int) -> [Int]
forall a b. (a -> b) -> a -> b
$ [(Int, Int)] -> Int -> [Int] -> ([Int], Int)
calcOffsets' [(Int, Int)]
size_align Int
0 []



{-# NOINLINE calcOffsets' #-}
calcOffsets' :: [(Size, Alignment)] -- ^ List of struct's fields' sizes and alignments
             -> Int                 -- ^ The intermediate variable between the current and previous iteration.
             -> [Offset]            -- ^ Accumulator
             -> ([Offset], Int)     -- ^ List of offsets and the last intermediate value.
calcOffsets' :: [(Int, Int)] -> Int -> [Int] -> ([Int], Int)
calcOffsets' []           Int
inter [Int]
acc = ([Int]
acc, Int
inter)  
calcOffsets' ((Int
s,Int
a):[(Int, Int)]
rest) Int
inter [Int]
acc = [(Int, Int)] -> Int -> [Int] -> ([Int], Int)
calcOffsets' [(Int, Int)]
rest (Int
last_off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s) (Int
last_offInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
acc)
    where p :: Int
p = (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
inter) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
a -- Padding
          last_off :: Int
last_off = Int
inter Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
p    :: Offset


{-# NOINLINE calcSize #-}
-- | Calculates the size of the type/struct.
calcSize :: [(Size, Alignment)] -- ^ List of sizes and aligments of the type's/struct's fields. [(Int,Int)].
         -> Size                -- ^ The returned size. Int
calcSize :: [(Int, Int)] -> Int
calcSize [(Int, Int)]
size_align = Int
inter Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ((Int
glob_align Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
inter) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
glob_align)
    where glob_align :: Int
glob_align = [Int] -> Int
calcAlignment ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> b
snd [(Int, Int)]
size_align
          inter :: Int
inter      = ([Int], Int) -> Int
forall a b. (a, b) -> b
snd (([Int], Int) -> Int) -> ([Int], Int) -> Int
forall a b. (a -> b) -> a -> b
$ [(Int, Int)] -> Int -> [Int] -> ([Int], Int)
calcOffsets' [(Int, Int)]
size_align Int
0 []

{-# NOINLINE calcAlignment #-}
-- | Calculate the alignment of a struct.
calcAlignment :: [Alignment] -- ^ List of struct's fields' alignments.
              -> Alignment   -- ^ The resulting alignment.
calcAlignment :: [Int] -> Int
calcAlignment [Int]
aligns = [Int] -> Int -> Int
calcAlignment' [Int]
aligns Int
1


calcAlignment' :: [Alignment] -- ^ List of alignments
               -> Alignment   -- ^ Accumulator
               -> Alignment   -- ^ The resulting alignment.
calcAlignment' :: [Int] -> Int -> Int
calcAlignment' []          Int
glob = Int
glob
calcAlignment' (Int
al:[Int]
aligns) Int
glob = [Int] -> Int -> Int
calcAlignment' [Int]
aligns (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
glob Int
al)