------------------------------------------------------------------------
-- |
-- Module           : Lang.Crucible.LLVM.DataLayout
-- Description      : Basic datatypes for describing memory layout and alignment
-- Copyright        : (c) Galois, Inc 2011-2016
-- License          : BSD3
-- Maintainer       : Rob Dockins <rdockins@galois.com>
-- Stability        : provisional
------------------------------------------------------------------------

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}

module Lang.Crucible.LLVM.DataLayout
  ( -- * Alignments
    Alignment
  , noAlignment
  , padToAlignment
  , toAlignment
  , fromAlignment
  , exponentToAlignment
  , alignmentToExponent
    -- * Data layout declarations.
  , DataLayout
  , EndianForm(..)
  , intLayout
  , maxAlignment
  , ptrSize
  , ptrAlign
  , ptrBitwidth
  , defaultDataLayout
  , parseDataLayout
  , integerAlignment
  , vectorAlignment
  , floatAlignment
  , aggregateAlignment
  , intWidthSize
  ) where

import Control.Lens
import Control.Monad.State.Strict
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Data.Word (Word32)
import qualified Text.LLVM as L
import Numeric.Natural

import What4.Utils.Arithmetic
import Lang.Crucible.LLVM.Bytes


------------------------------------------------------------------------
-- Data layout

-- | An @Alignment@ represents a number of bytes that must be a power of two.
newtype Alignment = Alignment Word32
  deriving (Alignment -> Alignment -> Bool
(Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool) -> Eq Alignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Alignment -> Alignment -> Bool
== :: Alignment -> Alignment -> Bool
$c/= :: Alignment -> Alignment -> Bool
/= :: Alignment -> Alignment -> Bool
Eq, Eq Alignment
Eq Alignment =>
(Alignment -> Alignment -> Ordering)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Alignment)
-> (Alignment -> Alignment -> Alignment)
-> Ord Alignment
Alignment -> Alignment -> Bool
Alignment -> Alignment -> Ordering
Alignment -> Alignment -> Alignment
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Alignment -> Alignment -> Ordering
compare :: Alignment -> Alignment -> Ordering
$c< :: Alignment -> Alignment -> Bool
< :: Alignment -> Alignment -> Bool
$c<= :: Alignment -> Alignment -> Bool
<= :: Alignment -> Alignment -> Bool
$c> :: Alignment -> Alignment -> Bool
> :: Alignment -> Alignment -> Bool
$c>= :: Alignment -> Alignment -> Bool
>= :: Alignment -> Alignment -> Bool
$cmax :: Alignment -> Alignment -> Alignment
max :: Alignment -> Alignment -> Alignment
$cmin :: Alignment -> Alignment -> Alignment
min :: Alignment -> Alignment -> Alignment
Ord, Int -> Alignment -> ShowS
[Alignment] -> ShowS
Alignment -> String
(Int -> Alignment -> ShowS)
-> (Alignment -> String)
-> ([Alignment] -> ShowS)
-> Show Alignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Alignment -> ShowS
showsPrec :: Int -> Alignment -> ShowS
$cshow :: Alignment -> String
show :: Alignment -> String
$cshowList :: [Alignment] -> ShowS
showList :: [Alignment] -> ShowS
Show)
-- The representation just stores the exponent. E.g., @Alignment 3@
-- indicates alignment to a 2^3-byte boundary.

-- | 1-byte alignment, which is the minimum possible.
noAlignment :: Alignment
noAlignment :: Alignment
noAlignment = Word32 -> Alignment
Alignment Word32
0

-- | @padToAlignment x a@ returns the smallest value greater than or
-- equal to @x@ that is aligned to @a@.
padToAlignment :: Bytes -> Alignment -> Bytes
padToAlignment :: Bytes -> Alignment -> Bytes
padToAlignment Bytes
x (Alignment Word32
n) = Natural -> Bytes
forall a. Integral a => a -> Bytes
toBytes (Natural -> Int -> Natural
forall a. (Bits a, Integral a) => a -> Int -> a
nextPow2Multiple (Bytes -> Natural
bytesToNatural Bytes
x) (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
n))

-- | Convert a number of bytes into an alignment, if it is a power of 2.
toAlignment :: Bytes -> Maybe Alignment
toAlignment :: Bytes -> Maybe Alignment
toAlignment (Bytes Integer
x)
  | Integer -> Bool
forall a. (Bits a, Num a) => a -> Bool
isPow2 Integer
x = Alignment -> Maybe Alignment
forall a. a -> Maybe a
Just (Word32 -> Alignment
Alignment (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int
forall a. (Bits a, Num a, Ord a) => a -> Int
lg Integer
x)))
  | Bool
otherwise = Maybe Alignment
forall a. Maybe a
Nothing

-- | Convert an alignment to a number of bytes.
fromAlignment :: Alignment -> Bytes
fromAlignment :: Alignment -> Bytes
fromAlignment (Alignment Word32
n) = Integer -> Bytes
Bytes (Integer
2 Integer -> Word32 -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Word32
n)

-- | Convert an exponent @n@ to an alignment of @2^n@ bytes.
exponentToAlignment :: Natural -> Alignment
exponentToAlignment :: Natural -> Alignment
exponentToAlignment Natural
n = Word32 -> Alignment
Alignment (Natural -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n)

alignmentToExponent :: Alignment -> Natural
alignmentToExponent :: Alignment -> Natural
alignmentToExponent (Alignment Word32
n) = Word32 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
n

newtype AlignInfo = AT (Map Natural Alignment)
  deriving (AlignInfo -> AlignInfo -> Bool
(AlignInfo -> AlignInfo -> Bool)
-> (AlignInfo -> AlignInfo -> Bool) -> Eq AlignInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AlignInfo -> AlignInfo -> Bool
== :: AlignInfo -> AlignInfo -> Bool
$c/= :: AlignInfo -> AlignInfo -> Bool
/= :: AlignInfo -> AlignInfo -> Bool
Eq, Eq AlignInfo
Eq AlignInfo =>
(AlignInfo -> AlignInfo -> Ordering)
-> (AlignInfo -> AlignInfo -> Bool)
-> (AlignInfo -> AlignInfo -> Bool)
-> (AlignInfo -> AlignInfo -> Bool)
-> (AlignInfo -> AlignInfo -> Bool)
-> (AlignInfo -> AlignInfo -> AlignInfo)
-> (AlignInfo -> AlignInfo -> AlignInfo)
-> Ord AlignInfo
AlignInfo -> AlignInfo -> Bool
AlignInfo -> AlignInfo -> Ordering
AlignInfo -> AlignInfo -> AlignInfo
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AlignInfo -> AlignInfo -> Ordering
compare :: AlignInfo -> AlignInfo -> Ordering
$c< :: AlignInfo -> AlignInfo -> Bool
< :: AlignInfo -> AlignInfo -> Bool
$c<= :: AlignInfo -> AlignInfo -> Bool
<= :: AlignInfo -> AlignInfo -> Bool
$c> :: AlignInfo -> AlignInfo -> Bool
> :: AlignInfo -> AlignInfo -> Bool
$c>= :: AlignInfo -> AlignInfo -> Bool
>= :: AlignInfo -> AlignInfo -> Bool
$cmax :: AlignInfo -> AlignInfo -> AlignInfo
max :: AlignInfo -> AlignInfo -> AlignInfo
$cmin :: AlignInfo -> AlignInfo -> AlignInfo
min :: AlignInfo -> AlignInfo -> AlignInfo
Ord)

-- | Make alignment info containing no alignments.
emptyAlignInfo :: AlignInfo
emptyAlignInfo :: AlignInfo
emptyAlignInfo = Map Natural Alignment -> AlignInfo
AT Map Natural Alignment
forall k a. Map k a
Map.empty

-- | Return alignment exactly at point if any.
findExact :: Natural -> AlignInfo -> Maybe Alignment
findExact :: Natural -> AlignInfo -> Maybe Alignment
findExact Natural
w (AT Map Natural Alignment
t) = Natural -> Map Natural Alignment -> Maybe Alignment
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Natural
w Map Natural Alignment
t

-- | Get alignment for the integer type of the specified bitwidth,
-- using LLVM's rules for integer types: "If no match is found, and
-- the type sought is an integer type, then the smallest integer type
-- that is larger than the bitwidth of the sought type is used. If
-- none of the specifications are larger than the bitwidth then the
-- largest integer type is used."
-- <http://llvm.org/docs/LangRef.html#langref-datalayout>
integerAlignment :: DataLayout -> Natural -> Alignment
integerAlignment :: DataLayout -> Natural -> Alignment
integerAlignment DataLayout
dl Natural
w =
  case Natural -> Map Natural Alignment -> Maybe (Natural, Alignment)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupGE Natural
w Map Natural Alignment
t of
    Just (Natural
_, Alignment
a) -> Alignment
a
    Maybe (Natural, Alignment)
Nothing ->
      case Map Natural Alignment -> [(Natural, Alignment)]
forall k a. Map k a -> [(k, a)]
Map.toDescList Map Natural Alignment
t of
        ((Natural
_, Alignment
a) : [(Natural, Alignment)]
_) -> Alignment
a
        [(Natural, Alignment)]
_ -> Alignment
noAlignment
  where AT Map Natural Alignment
t = DataLayout
dlDataLayout -> Getting AlignInfo DataLayout AlignInfo -> AlignInfo
forall s a. s -> Getting a s a -> a
^.Getting AlignInfo DataLayout AlignInfo
Lens' DataLayout AlignInfo
integerInfo

-- | Get alignment for a vector type of the specified bitwidth, using
-- LLVM's rules for vector types: "If no match is found, and the type
-- sought is a vector type, then the largest vector type that is
-- smaller than the sought vector type will be used as a fall back."
-- <http://llvm.org/docs/LangRef.html#langref-datalayout>
vectorAlignment :: DataLayout -> Natural -> Alignment
vectorAlignment :: DataLayout -> Natural -> Alignment
vectorAlignment DataLayout
dl Natural
w =
  case Natural -> Map Natural Alignment -> Maybe (Natural, Alignment)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupLE Natural
w Map Natural Alignment
t of
    Just (Natural
_, Alignment
a) -> Alignment
a
    Maybe (Natural, Alignment)
Nothing -> Alignment
noAlignment
  where AT Map Natural Alignment
t = DataLayout
dlDataLayout -> Getting AlignInfo DataLayout AlignInfo -> AlignInfo
forall s a. s -> Getting a s a -> a
^.Getting AlignInfo DataLayout AlignInfo
Lens' DataLayout AlignInfo
vectorInfo

-- | Get alignment for a float type of the specified bitwidth.
floatAlignment :: DataLayout -> Natural -> Maybe Alignment
floatAlignment :: DataLayout -> Natural -> Maybe Alignment
floatAlignment DataLayout
dl Natural
w = Natural -> Map Natural Alignment -> Maybe Alignment
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Natural
w Map Natural Alignment
t
  where AT Map Natural Alignment
t = DataLayout
dlDataLayout -> Getting AlignInfo DataLayout AlignInfo -> AlignInfo
forall s a. s -> Getting a s a -> a
^.Getting AlignInfo DataLayout AlignInfo
Lens' DataLayout AlignInfo
floatInfo

-- | Get the basic alignment for aggregate types.
aggregateAlignment :: DataLayout -> Alignment
aggregateAlignment :: DataLayout -> Alignment
aggregateAlignment DataLayout
dl =
  Alignment -> Maybe Alignment -> Alignment
forall a. a -> Maybe a -> a
fromMaybe Alignment
noAlignment (Natural -> AlignInfo -> Maybe Alignment
findExact Natural
0 (DataLayout
dlDataLayout -> Getting AlignInfo DataLayout AlignInfo -> AlignInfo
forall s a. s -> Getting a s a -> a
^.Getting AlignInfo DataLayout AlignInfo
Lens' DataLayout AlignInfo
aggInfo))

-- | Return maximum alignment constraint stored in tree.
maxAlignmentInTree :: AlignInfo -> Alignment
maxAlignmentInTree :: AlignInfo -> Alignment
maxAlignmentInTree (AT Map Natural Alignment
t) = Getting (Endo Alignment) (Map Natural Alignment) Alignment
-> (Alignment -> Alignment -> Alignment)
-> Alignment
-> Map Natural Alignment
-> Alignment
forall r s a. Getting (Endo r) s a -> (a -> r -> r) -> r -> s -> r
foldrOf Getting (Endo Alignment) (Map Natural Alignment) Alignment
forall (f :: Type -> Type) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int (Map Natural Alignment) Alignment
folded Alignment -> Alignment -> Alignment
forall a. Ord a => a -> a -> a
max Alignment
noAlignment Map Natural Alignment
t

-- | Update alignment tree
updateAlign :: Natural
            -> AlignInfo
            -> Maybe Alignment
            -> AlignInfo
updateAlign :: Natural -> AlignInfo -> Maybe Alignment -> AlignInfo
updateAlign Natural
w (AT Map Natural Alignment
t) Maybe Alignment
ma = Map Natural Alignment -> AlignInfo
AT ((Maybe Alignment -> Maybe Alignment)
-> Natural -> Map Natural Alignment -> Map Natural Alignment
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (Maybe Alignment -> Maybe Alignment -> Maybe Alignment
forall a b. a -> b -> a
const Maybe Alignment
ma) Natural
w Map Natural Alignment
t)

type instance Index AlignInfo = Natural
type instance IxValue AlignInfo = Alignment

instance Ixed AlignInfo where
  ix :: Index AlignInfo -> Traversal' AlignInfo (IxValue AlignInfo)
ix Index AlignInfo
k = Index AlignInfo -> Lens' AlignInfo (Maybe (IxValue AlignInfo))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index AlignInfo
k ((Maybe Alignment -> f (Maybe Alignment))
 -> AlignInfo -> f AlignInfo)
-> ((Alignment -> f Alignment)
    -> Maybe Alignment -> f (Maybe Alignment))
-> (Alignment -> f Alignment)
-> AlignInfo
-> f AlignInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Alignment -> f Alignment)
-> Maybe Alignment -> f (Maybe Alignment)
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse

instance At AlignInfo where
  at :: Index AlignInfo -> Lens' AlignInfo (Maybe (IxValue AlignInfo))
at Index AlignInfo
k Maybe (IxValue AlignInfo) -> f (Maybe (IxValue AlignInfo))
f AlignInfo
m = Natural -> AlignInfo -> Maybe Alignment -> AlignInfo
updateAlign Natural
Index AlignInfo
k AlignInfo
m (Maybe Alignment -> AlignInfo)
-> f (Maybe Alignment) -> f AlignInfo
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe Alignment -> f (Maybe Alignment))
-> Natural -> Maybe Alignment -> f (Maybe Alignment)
forall a b. (a -> b) -> Natural -> a -> b
forall i (p :: Type -> Type -> Type) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed Maybe (IxValue AlignInfo) -> f (Maybe (IxValue AlignInfo))
Maybe Alignment -> f (Maybe Alignment)
f Natural
Index AlignInfo
k (Natural -> AlignInfo -> Maybe Alignment
findExact Natural
Index AlignInfo
k AlignInfo
m)

-- | Flags byte orientation of target machine.
data EndianForm = BigEndian | LittleEndian
  deriving (EndianForm -> EndianForm -> Bool
(EndianForm -> EndianForm -> Bool)
-> (EndianForm -> EndianForm -> Bool) -> Eq EndianForm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EndianForm -> EndianForm -> Bool
== :: EndianForm -> EndianForm -> Bool
$c/= :: EndianForm -> EndianForm -> Bool
/= :: EndianForm -> EndianForm -> Bool
Eq, Eq EndianForm
Eq EndianForm =>
(EndianForm -> EndianForm -> Ordering)
-> (EndianForm -> EndianForm -> Bool)
-> (EndianForm -> EndianForm -> Bool)
-> (EndianForm -> EndianForm -> Bool)
-> (EndianForm -> EndianForm -> Bool)
-> (EndianForm -> EndianForm -> EndianForm)
-> (EndianForm -> EndianForm -> EndianForm)
-> Ord EndianForm
EndianForm -> EndianForm -> Bool
EndianForm -> EndianForm -> Ordering
EndianForm -> EndianForm -> EndianForm
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EndianForm -> EndianForm -> Ordering
compare :: EndianForm -> EndianForm -> Ordering
$c< :: EndianForm -> EndianForm -> Bool
< :: EndianForm -> EndianForm -> Bool
$c<= :: EndianForm -> EndianForm -> Bool
<= :: EndianForm -> EndianForm -> Bool
$c> :: EndianForm -> EndianForm -> Bool
> :: EndianForm -> EndianForm -> Bool
$c>= :: EndianForm -> EndianForm -> Bool
>= :: EndianForm -> EndianForm -> Bool
$cmax :: EndianForm -> EndianForm -> EndianForm
max :: EndianForm -> EndianForm -> EndianForm
$cmin :: EndianForm -> EndianForm -> EndianForm
min :: EndianForm -> EndianForm -> EndianForm
Ord, Int -> EndianForm -> ShowS
[EndianForm] -> ShowS
EndianForm -> String
(Int -> EndianForm -> ShowS)
-> (EndianForm -> String)
-> ([EndianForm] -> ShowS)
-> Show EndianForm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EndianForm -> ShowS
showsPrec :: Int -> EndianForm -> ShowS
$cshow :: EndianForm -> String
show :: EndianForm -> String
$cshowList :: [EndianForm] -> ShowS
showList :: [EndianForm] -> ShowS
Show)

-- | Parsed data layout
data DataLayout
   = DL { DataLayout -> EndianForm
_intLayout :: EndianForm
        , DataLayout -> Alignment
_stackAlignment :: !Alignment
        , DataLayout -> Bytes
_ptrSize     :: !Bytes
        , DataLayout -> Alignment
_ptrAlign    :: !Alignment
        , DataLayout -> AlignInfo
_integerInfo :: !AlignInfo
        , DataLayout -> AlignInfo
_vectorInfo  :: !AlignInfo
        , DataLayout -> AlignInfo
_floatInfo   :: !AlignInfo
        , DataLayout -> AlignInfo
_aggInfo     :: !AlignInfo
        , DataLayout -> AlignInfo
_stackInfo   :: !AlignInfo
        , DataLayout -> [LayoutSpec]
_layoutWarnings :: [L.LayoutSpec]
        }
  deriving (DataLayout -> DataLayout -> Bool
(DataLayout -> DataLayout -> Bool)
-> (DataLayout -> DataLayout -> Bool) -> Eq DataLayout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DataLayout -> DataLayout -> Bool
== :: DataLayout -> DataLayout -> Bool
$c/= :: DataLayout -> DataLayout -> Bool
/= :: DataLayout -> DataLayout -> Bool
Eq, Eq DataLayout
Eq DataLayout =>
(DataLayout -> DataLayout -> Ordering)
-> (DataLayout -> DataLayout -> Bool)
-> (DataLayout -> DataLayout -> Bool)
-> (DataLayout -> DataLayout -> Bool)
-> (DataLayout -> DataLayout -> Bool)
-> (DataLayout -> DataLayout -> DataLayout)
-> (DataLayout -> DataLayout -> DataLayout)
-> Ord DataLayout
DataLayout -> DataLayout -> Bool
DataLayout -> DataLayout -> Ordering
DataLayout -> DataLayout -> DataLayout
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DataLayout -> DataLayout -> Ordering
compare :: DataLayout -> DataLayout -> Ordering
$c< :: DataLayout -> DataLayout -> Bool
< :: DataLayout -> DataLayout -> Bool
$c<= :: DataLayout -> DataLayout -> Bool
<= :: DataLayout -> DataLayout -> Bool
$c> :: DataLayout -> DataLayout -> Bool
> :: DataLayout -> DataLayout -> Bool
$c>= :: DataLayout -> DataLayout -> Bool
>= :: DataLayout -> DataLayout -> Bool
$cmax :: DataLayout -> DataLayout -> DataLayout
max :: DataLayout -> DataLayout -> DataLayout
$cmin :: DataLayout -> DataLayout -> DataLayout
min :: DataLayout -> DataLayout -> DataLayout
Ord)

instance Show DataLayout where
   show :: DataLayout -> String
show DataLayout
_ = String
"<<DataLayout>>"

intLayout :: Lens' DataLayout EndianForm
intLayout :: Lens' DataLayout EndianForm
intLayout = (DataLayout -> EndianForm)
-> (DataLayout -> EndianForm -> DataLayout)
-> Lens' DataLayout EndianForm
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DataLayout -> EndianForm
_intLayout (\DataLayout
s EndianForm
v -> DataLayout
s { _intLayout = v})

stackAlignment :: Lens' DataLayout Alignment
stackAlignment :: Lens' DataLayout Alignment
stackAlignment = (DataLayout -> Alignment)
-> (DataLayout -> Alignment -> DataLayout)
-> Lens' DataLayout Alignment
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DataLayout -> Alignment
_stackAlignment (\DataLayout
s Alignment
v -> DataLayout
s { _stackAlignment = v})

-- | Size of pointers in bytes.
ptrSize :: Lens' DataLayout Bytes
ptrSize :: Lens' DataLayout Bytes
ptrSize = (DataLayout -> Bytes)
-> (DataLayout -> Bytes -> DataLayout) -> Lens' DataLayout Bytes
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DataLayout -> Bytes
_ptrSize (\DataLayout
s Bytes
v -> DataLayout
s { _ptrSize = v})

-- | ABI pointer alignment in bytes.
ptrAlign :: Lens' DataLayout Alignment
ptrAlign :: Lens' DataLayout Alignment
ptrAlign = (DataLayout -> Alignment)
-> (DataLayout -> Alignment -> DataLayout)
-> Lens' DataLayout Alignment
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DataLayout -> Alignment
_ptrAlign (\DataLayout
s Alignment
v -> DataLayout
s { _ptrAlign = v})

integerInfo :: Lens' DataLayout AlignInfo
integerInfo :: Lens' DataLayout AlignInfo
integerInfo = (DataLayout -> AlignInfo)
-> (DataLayout -> AlignInfo -> DataLayout)
-> Lens' DataLayout AlignInfo
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DataLayout -> AlignInfo
_integerInfo (\DataLayout
s AlignInfo
v -> DataLayout
s { _integerInfo = v})

vectorInfo :: Lens' DataLayout AlignInfo
vectorInfo :: Lens' DataLayout AlignInfo
vectorInfo = (DataLayout -> AlignInfo)
-> (DataLayout -> AlignInfo -> DataLayout)
-> Lens' DataLayout AlignInfo
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DataLayout -> AlignInfo
_vectorInfo (\DataLayout
s AlignInfo
v -> DataLayout
s { _vectorInfo = v})

floatInfo :: Lens' DataLayout AlignInfo
floatInfo :: Lens' DataLayout AlignInfo
floatInfo = (DataLayout -> AlignInfo)
-> (DataLayout -> AlignInfo -> DataLayout)
-> Lens' DataLayout AlignInfo
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DataLayout -> AlignInfo
_floatInfo (\DataLayout
s AlignInfo
v -> DataLayout
s { _floatInfo = v})

-- | Information about aggregate size.
aggInfo :: Lens' DataLayout AlignInfo
aggInfo :: Lens' DataLayout AlignInfo
aggInfo = (DataLayout -> AlignInfo)
-> (DataLayout -> AlignInfo -> DataLayout)
-> Lens' DataLayout AlignInfo
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DataLayout -> AlignInfo
_aggInfo (\DataLayout
s AlignInfo
v -> DataLayout
s { _aggInfo = v})

-- | Layout constraints on a stack object with the given size.
stackInfo :: Lens' DataLayout AlignInfo
stackInfo :: Lens' DataLayout AlignInfo
stackInfo = (DataLayout -> AlignInfo)
-> (DataLayout -> AlignInfo -> DataLayout)
-> Lens' DataLayout AlignInfo
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DataLayout -> AlignInfo
_stackInfo (\DataLayout
s AlignInfo
v -> DataLayout
s { _stackInfo = v})

-- | Layout specs that could not be parsed.
layoutWarnings :: Lens' DataLayout [L.LayoutSpec]
layoutWarnings :: Lens' DataLayout [LayoutSpec]
layoutWarnings = (DataLayout -> [LayoutSpec])
-> (DataLayout -> [LayoutSpec] -> DataLayout)
-> Lens' DataLayout [LayoutSpec]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DataLayout -> [LayoutSpec]
_layoutWarnings (\DataLayout
s [LayoutSpec]
v -> DataLayout
s { _layoutWarnings = v})

ptrBitwidth :: DataLayout -> Natural
ptrBitwidth :: DataLayout -> Natural
ptrBitwidth DataLayout
dl = Bytes -> Natural
bytesToBits (DataLayout
dlDataLayout -> Getting Bytes DataLayout Bytes -> Bytes
forall s a. s -> Getting a s a -> a
^.Getting Bytes DataLayout Bytes
Lens' DataLayout Bytes
ptrSize)

-- | Reduce the bit level alignment to a byte value, and error if it is not
-- a multiple of 8.
fromBits :: Int -> Either String Alignment
fromBits :: Int -> Either String Alignment
fromBits Int
a | Integer
w Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 = String -> Either String Alignment
forall a b. a -> Either a b
Left (String -> Either String Alignment)
-> String -> Either String Alignment
forall a b. (a -> b) -> a -> b
$ String
"Alignment must be a positive number."
           | Integer
r Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 = String -> Either String Alignment
forall a b. a -> Either a b
Left (String -> Either String Alignment)
-> String -> Either String Alignment
forall a b. (a -> b) -> a -> b
$ String
"Alignment specification must occupy a byte boundary."
           | Bool -> Bool
not (Integer -> Bool
forall a. (Bits a, Num a) => a -> Bool
isPow2 Integer
w) = String -> Either String Alignment
forall a b. a -> Either a b
Left (String -> Either String Alignment)
-> String -> Either String Alignment
forall a b. (a -> b) -> a -> b
$ String
"Alignment must be a power of two."
           | Bool
otherwise = Alignment -> Either String Alignment
forall a b. b -> Either a b
Right (Alignment -> Either String Alignment)
-> Alignment -> Either String Alignment
forall a b. (a -> b) -> a -> b
$ Word32 -> Alignment
Alignment (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int
forall a. (Bits a, Num a, Ord a) => a -> Int
lg Integer
w))
  where (Integer
w,Integer
r) = Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
a Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
8

-- | Insert alignment into spec.
setAt :: Lens' DataLayout AlignInfo -> Natural -> Alignment -> State DataLayout ()
setAt :: Lens' DataLayout AlignInfo
-> Natural -> Alignment -> State DataLayout ()
setAt Lens' DataLayout AlignInfo
f Natural
sz Alignment
a = (AlignInfo -> Identity AlignInfo)
-> DataLayout -> Identity DataLayout
Lens' DataLayout AlignInfo
f ((AlignInfo -> Identity AlignInfo)
 -> DataLayout -> Identity DataLayout)
-> ((Maybe Alignment -> Identity (Maybe Alignment))
    -> AlignInfo -> Identity AlignInfo)
-> (Maybe Alignment -> Identity (Maybe Alignment))
-> DataLayout
-> Identity DataLayout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index AlignInfo -> Lens' AlignInfo (Maybe (IxValue AlignInfo))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Natural
Index AlignInfo
sz ((Maybe Alignment -> Identity (Maybe Alignment))
 -> DataLayout -> Identity DataLayout)
-> Alignment -> State DataLayout ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= Alignment
a

-- | The default data layout if no spec is defined. From the LLVM
-- Language Reference: "When constructing the data layout for a given
-- target, LLVM starts with a default set of specifications which are
-- then (possibly) overridden by the specifications in the datalayout
-- keyword." <http://llvm.org/docs/LangRef.html#langref-datalayout>
defaultDataLayout :: DataLayout
defaultDataLayout :: DataLayout
defaultDataLayout = State DataLayout () -> DataLayout -> DataLayout
forall s a. State s a -> s -> s
execState State DataLayout ()
defaults DataLayout
dl
  where dl :: DataLayout
dl = DL { _intLayout :: EndianForm
_intLayout = EndianForm
BigEndian
                , _stackAlignment :: Alignment
_stackAlignment = Alignment
noAlignment
                , _ptrSize :: Bytes
_ptrSize  = Bytes
8 -- 64 bit pointers = 8 bytes
                , _ptrAlign :: Alignment
_ptrAlign = Word32 -> Alignment
Alignment Word32
3 -- 64 bit alignment: 2^3=8 byte boundaries
                , _integerInfo :: AlignInfo
_integerInfo = AlignInfo
emptyAlignInfo
                , _floatInfo :: AlignInfo
_floatInfo   = AlignInfo
emptyAlignInfo
                , _vectorInfo :: AlignInfo
_vectorInfo  = AlignInfo
emptyAlignInfo
                , _aggInfo :: AlignInfo
_aggInfo     = AlignInfo
emptyAlignInfo
                , _stackInfo :: AlignInfo
_stackInfo   = AlignInfo
emptyAlignInfo
                , _layoutWarnings :: [LayoutSpec]
_layoutWarnings = []
                }
        defaults :: State DataLayout ()
defaults = do
          -- Default integer alignments
          Lens' DataLayout AlignInfo
-> Natural -> Alignment -> State DataLayout ()
setAt (AlignInfo -> f AlignInfo) -> DataLayout -> f DataLayout
Lens' DataLayout AlignInfo
integerInfo  Natural
1 Alignment
noAlignment -- 1-bit values aligned on byte addresses.
          Lens' DataLayout AlignInfo
-> Natural -> Alignment -> State DataLayout ()
setAt (AlignInfo -> f AlignInfo) -> DataLayout -> f DataLayout
Lens' DataLayout AlignInfo
integerInfo  Natural
8 Alignment
noAlignment -- 8-bit values aligned on byte addresses.
          Lens' DataLayout AlignInfo
-> Natural -> Alignment -> State DataLayout ()
setAt (AlignInfo -> f AlignInfo) -> DataLayout -> f DataLayout
Lens' DataLayout AlignInfo
integerInfo Natural
16 (Word32 -> Alignment
Alignment Word32
1) -- 16-bit values aligned on 2 byte addresses.
          Lens' DataLayout AlignInfo
-> Natural -> Alignment -> State DataLayout ()
setAt (AlignInfo -> f AlignInfo) -> DataLayout -> f DataLayout
Lens' DataLayout AlignInfo
integerInfo Natural
32 (Word32 -> Alignment
Alignment Word32
2) -- 32-bit values aligned on 4 byte addresses.
          Lens' DataLayout AlignInfo
-> Natural -> Alignment -> State DataLayout ()
setAt (AlignInfo -> f AlignInfo) -> DataLayout -> f DataLayout
Lens' DataLayout AlignInfo
integerInfo Natural
64 (Word32 -> Alignment
Alignment Word32
3) -- 64-bit values aligned on 8 byte addresses.
          -- Default float alignments
          Lens' DataLayout AlignInfo
-> Natural -> Alignment -> State DataLayout ()
setAt (AlignInfo -> f AlignInfo) -> DataLayout -> f DataLayout
Lens' DataLayout AlignInfo
floatInfo  Natural
16 (Word32 -> Alignment
Alignment Word32
1) -- Half is aligned on 2 byte addresses.
          Lens' DataLayout AlignInfo
-> Natural -> Alignment -> State DataLayout ()
setAt (AlignInfo -> f AlignInfo) -> DataLayout -> f DataLayout
Lens' DataLayout AlignInfo
floatInfo  Natural
32 (Word32 -> Alignment
Alignment Word32
2) -- Float is aligned on 4 byte addresses.
          Lens' DataLayout AlignInfo
-> Natural -> Alignment -> State DataLayout ()
setAt (AlignInfo -> f AlignInfo) -> DataLayout -> f DataLayout
Lens' DataLayout AlignInfo
floatInfo  Natural
64 (Word32 -> Alignment
Alignment Word32
3) -- Double is aligned on 8 byte addresses.
          Lens' DataLayout AlignInfo
-> Natural -> Alignment -> State DataLayout ()
setAt (AlignInfo -> f AlignInfo) -> DataLayout -> f DataLayout
Lens' DataLayout AlignInfo
floatInfo Natural
128 (Word32 -> Alignment
Alignment Word32
4) -- Quad is aligned on 16 byte addresses.
          -- Default vector alignments.
          Lens' DataLayout AlignInfo
-> Natural -> Alignment -> State DataLayout ()
setAt (AlignInfo -> f AlignInfo) -> DataLayout -> f DataLayout
Lens' DataLayout AlignInfo
vectorInfo  Natural
64 (Word32 -> Alignment
Alignment Word32
3) -- 64-bit vector is 8 byte aligned.
          Lens' DataLayout AlignInfo
-> Natural -> Alignment -> State DataLayout ()
setAt (AlignInfo -> f AlignInfo) -> DataLayout -> f DataLayout
Lens' DataLayout AlignInfo
vectorInfo Natural
128 (Word32 -> Alignment
Alignment Word32
4) -- 128-bit vector is 16 byte aligned.
          -- Default aggregate alignments.
          Lens' DataLayout AlignInfo
-> Natural -> Alignment -> State DataLayout ()
setAt (AlignInfo -> f AlignInfo) -> DataLayout -> f DataLayout
Lens' DataLayout AlignInfo
aggInfo  Natural
0 Alignment
noAlignment  -- Aggregates are 1-byte aligned.

-- | Maximum alignment for any type (used by malloc).
maxAlignment :: DataLayout -> Alignment
maxAlignment :: DataLayout -> Alignment
maxAlignment DataLayout
dl =
  [Alignment] -> Alignment
forall a. Ord a => [a] -> a
forall (t :: Type -> Type) a. (Foldable t, Ord a) => t a -> a
maximum [ DataLayout
dlDataLayout -> Getting Alignment DataLayout Alignment -> Alignment
forall s a. s -> Getting a s a -> a
^.Getting Alignment DataLayout Alignment
Lens' DataLayout Alignment
stackAlignment
          , DataLayout
dlDataLayout -> Getting Alignment DataLayout Alignment -> Alignment
forall s a. s -> Getting a s a -> a
^.Getting Alignment DataLayout Alignment
Lens' DataLayout Alignment
ptrAlign
          , AlignInfo -> Alignment
maxAlignmentInTree (DataLayout
dlDataLayout -> Getting AlignInfo DataLayout AlignInfo -> AlignInfo
forall s a. s -> Getting a s a -> a
^.Getting AlignInfo DataLayout AlignInfo
Lens' DataLayout AlignInfo
integerInfo)
          , AlignInfo -> Alignment
maxAlignmentInTree (DataLayout
dlDataLayout -> Getting AlignInfo DataLayout AlignInfo -> AlignInfo
forall s a. s -> Getting a s a -> a
^.Getting AlignInfo DataLayout AlignInfo
Lens' DataLayout AlignInfo
vectorInfo)
          , AlignInfo -> Alignment
maxAlignmentInTree (DataLayout
dlDataLayout -> Getting AlignInfo DataLayout AlignInfo -> AlignInfo
forall s a. s -> Getting a s a -> a
^.Getting AlignInfo DataLayout AlignInfo
Lens' DataLayout AlignInfo
floatInfo)
          , AlignInfo -> Alignment
maxAlignmentInTree (DataLayout
dlDataLayout -> Getting AlignInfo DataLayout AlignInfo -> AlignInfo
forall s a. s -> Getting a s a -> a
^.Getting AlignInfo DataLayout AlignInfo
Lens' DataLayout AlignInfo
aggInfo)
          , AlignInfo -> Alignment
maxAlignmentInTree (DataLayout
dlDataLayout -> Getting AlignInfo DataLayout AlignInfo -> AlignInfo
forall s a. s -> Getting a s a -> a
^.Getting AlignInfo DataLayout AlignInfo
Lens' DataLayout AlignInfo
stackInfo)
          ]

fromSize :: Int -> Natural
fromSize :: Int -> Natural
fromSize Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> Natural
forall a. HasCallStack => String -> a
error (String -> Natural) -> String -> Natural
forall a b. (a -> b) -> a -> b
$ String
"Negative size given in data layout."
           | Bool
otherwise = Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i

-- | Insert alignment into spec.
setAtBits :: Lens' DataLayout AlignInfo -> L.LayoutSpec -> Int -> Int -> State DataLayout ()
setAtBits :: Lens' DataLayout AlignInfo
-> LayoutSpec -> Int -> Int -> State DataLayout ()
setAtBits Lens' DataLayout AlignInfo
f LayoutSpec
spec Int
sz Int
a =
  case Int -> Either String Alignment
fromBits Int
a of
    Left{} -> ([LayoutSpec] -> Identity [LayoutSpec])
-> DataLayout -> Identity DataLayout
Lens' DataLayout [LayoutSpec]
layoutWarnings (([LayoutSpec] -> Identity [LayoutSpec])
 -> DataLayout -> Identity DataLayout)
-> ([LayoutSpec] -> [LayoutSpec]) -> State DataLayout ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (LayoutSpec
specLayoutSpec -> [LayoutSpec] -> [LayoutSpec]
forall a. a -> [a] -> [a]
:)
    Right Alignment
w -> (AlignInfo -> Identity AlignInfo)
-> DataLayout -> Identity DataLayout
Lens' DataLayout AlignInfo
f ((AlignInfo -> Identity AlignInfo)
 -> DataLayout -> Identity DataLayout)
-> ((Maybe Alignment -> Identity (Maybe Alignment))
    -> AlignInfo -> Identity AlignInfo)
-> (Maybe Alignment -> Identity (Maybe Alignment))
-> DataLayout
-> Identity DataLayout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index AlignInfo -> Lens' AlignInfo (Maybe (IxValue AlignInfo))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (Int -> Natural
fromSize Int
sz) ((Maybe Alignment -> Identity (Maybe Alignment))
 -> DataLayout -> Identity DataLayout)
-> Maybe Alignment -> State DataLayout ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Alignment -> Maybe Alignment
forall a. a -> Maybe a
Just Alignment
w

-- | Insert alignment into spec.
setBits :: Lens' DataLayout Alignment -> L.LayoutSpec -> Int -> State DataLayout ()
setBits :: Lens' DataLayout Alignment
-> LayoutSpec -> Int -> State DataLayout ()
setBits Lens' DataLayout Alignment
f LayoutSpec
spec Int
a =
  case Int -> Either String Alignment
fromBits Int
a of
    Left{} -> ([LayoutSpec] -> Identity [LayoutSpec])
-> DataLayout -> Identity DataLayout
Lens' DataLayout [LayoutSpec]
layoutWarnings (([LayoutSpec] -> Identity [LayoutSpec])
 -> DataLayout -> Identity DataLayout)
-> ([LayoutSpec] -> [LayoutSpec]) -> State DataLayout ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (LayoutSpec
specLayoutSpec -> [LayoutSpec] -> [LayoutSpec]
forall a. a -> [a] -> [a]
:)
    Right Alignment
w -> (Alignment -> Identity Alignment)
-> DataLayout -> Identity DataLayout
Lens' DataLayout Alignment
f ((Alignment -> Identity Alignment)
 -> DataLayout -> Identity DataLayout)
-> Alignment -> State DataLayout ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Alignment
w

-- | Add information from layout spec into parsed data layout.
addLayoutSpec :: L.LayoutSpec -> State DataLayout ()
addLayoutSpec :: LayoutSpec -> State DataLayout ()
addLayoutSpec LayoutSpec
ls =
  -- TODO: Check that sizes and alignment is using bits versus bytes consistently.
    case LayoutSpec
ls of
      LayoutSpec
L.BigEndian    -> (EndianForm -> Identity EndianForm)
-> DataLayout -> Identity DataLayout
Lens' DataLayout EndianForm
intLayout ((EndianForm -> Identity EndianForm)
 -> DataLayout -> Identity DataLayout)
-> EndianForm -> State DataLayout ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= EndianForm
BigEndian
      LayoutSpec
L.LittleEndian -> (EndianForm -> Identity EndianForm)
-> DataLayout -> Identity DataLayout
Lens' DataLayout EndianForm
intLayout ((EndianForm -> Identity EndianForm)
 -> DataLayout -> Identity DataLayout)
-> EndianForm -> State DataLayout ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= EndianForm
LittleEndian
      L.PointerSize Int
n Int
sz Int
a Maybe Int
_
           -- Currently, we assume that only default address space (0) is used.
           -- We use that address space as the sole arbiter of what pointer
           -- size to use, and we ignore all other PointerSize layout specs.
           -- See doc/limitations.md for more discussion.
        |  Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        -> case Int -> Either String Alignment
fromBits Int
a of
             Right Alignment
a' | Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> do (Bytes -> Identity Bytes) -> DataLayout -> Identity DataLayout
Lens' DataLayout Bytes
ptrSize ((Bytes -> Identity Bytes) -> DataLayout -> Identity DataLayout)
-> Bytes -> State DataLayout ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int -> Bytes
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w
                                     (Alignment -> Identity Alignment)
-> DataLayout -> Identity DataLayout
Lens' DataLayout Alignment
ptrAlign ((Alignment -> Identity Alignment)
 -> DataLayout -> Identity DataLayout)
-> Alignment -> State DataLayout ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Alignment
a'
             Either String Alignment
_ -> ([LayoutSpec] -> Identity [LayoutSpec])
-> DataLayout -> Identity DataLayout
Lens' DataLayout [LayoutSpec]
layoutWarnings (([LayoutSpec] -> Identity [LayoutSpec])
 -> DataLayout -> Identity DataLayout)
-> ([LayoutSpec] -> [LayoutSpec]) -> State DataLayout ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (LayoutSpec
lsLayoutSpec -> [LayoutSpec] -> [LayoutSpec]
forall a. a -> [a] -> [a]
:)
        |  Bool
otherwise
        -> () -> State DataLayout ()
forall a. a -> StateT DataLayout Identity a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
       where (Int
w,Int
r) = Int
sz Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
8
      L.IntegerSize    Int
sz Int
a Maybe Int
_ -> Lens' DataLayout AlignInfo
-> LayoutSpec -> Int -> Int -> State DataLayout ()
setAtBits (AlignInfo -> f AlignInfo) -> DataLayout -> f DataLayout
Lens' DataLayout AlignInfo
integerInfo LayoutSpec
ls Int
sz Int
a
      L.VectorSize     Int
sz Int
a Maybe Int
_ -> Lens' DataLayout AlignInfo
-> LayoutSpec -> Int -> Int -> State DataLayout ()
setAtBits (AlignInfo -> f AlignInfo) -> DataLayout -> f DataLayout
Lens' DataLayout AlignInfo
vectorInfo  LayoutSpec
ls Int
sz Int
a
      L.FloatSize      Int
sz Int
a Maybe Int
_ -> Lens' DataLayout AlignInfo
-> LayoutSpec -> Int -> Int -> State DataLayout ()
setAtBits (AlignInfo -> f AlignInfo) -> DataLayout -> f DataLayout
Lens' DataLayout AlignInfo
floatInfo   LayoutSpec
ls Int
sz Int
a
      L.AggregateSize  Int
sz Int
a Maybe Int
_ -> Lens' DataLayout AlignInfo
-> LayoutSpec -> Int -> Int -> State DataLayout ()
setAtBits (AlignInfo -> f AlignInfo) -> DataLayout -> f DataLayout
Lens' DataLayout AlignInfo
aggInfo     LayoutSpec
ls Int
sz Int
a
      L.StackObjSize   Int
sz Int
a Maybe Int
_ -> Lens' DataLayout AlignInfo
-> LayoutSpec -> Int -> Int -> State DataLayout ()
setAtBits (AlignInfo -> f AlignInfo) -> DataLayout -> f DataLayout
Lens' DataLayout AlignInfo
stackInfo   LayoutSpec
ls Int
sz Int
a
      L.NativeIntSize [Int]
_ -> () -> State DataLayout ()
forall a. a -> StateT DataLayout Identity a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
      L.StackAlign Int
a    -> Lens' DataLayout Alignment
-> LayoutSpec -> Int -> State DataLayout ()
setBits (Alignment -> f Alignment) -> DataLayout -> f DataLayout
Lens' DataLayout Alignment
stackAlignment LayoutSpec
ls Int
a
      L.Mangling Mangling
_      -> () -> State DataLayout ()
forall a. a -> StateT DataLayout Identity a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()

-- | Create parsed data layout from layout spec AST.
parseDataLayout :: L.DataLayout -> DataLayout
parseDataLayout :: [LayoutSpec] -> DataLayout
parseDataLayout [LayoutSpec]
dl = State DataLayout () -> DataLayout -> DataLayout
forall s a. State s a -> s -> s
execState ((LayoutSpec -> State DataLayout ())
-> [LayoutSpec] -> State DataLayout ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LayoutSpec -> State DataLayout ()
addLayoutSpec [LayoutSpec]
dl) DataLayout
defaultDataLayout

-- | The size of an integer of the given bitwidth, in bytes.
intWidthSize :: Natural -> Bytes
intWidthSize :: Natural -> Bytes
intWidthSize Natural
w = Natural -> Bytes
forall a. Integral a => a -> Bytes
bitsToBytes Natural
w