{-# LANGUAGE OverloadedStrings #-}
module LLVM.DataLayout (
 dataLayoutToString,
 parseDataLayout
 ) where

import LLVM.Prelude

import Control.Monad.Trans.Except

import Data.Attoparsec.ByteString
import Data.Attoparsec.ByteString.Char8
import Data.ByteString.Char8 as ByteString hiding (map, foldr)
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Set as Set

import LLVM.AST.DataLayout
import LLVM.AST.AddrSpace

dataLayoutToString :: DataLayout -> ByteString
dataLayoutToString :: DataLayout -> ByteString
dataLayoutToString dl :: DataLayout
dl =
  let sAlignmentInfo :: AlignmentInfo -> ByteString
      sAlignmentInfo :: AlignmentInfo -> ByteString
sAlignmentInfo (AlignmentInfo abi :: Word32
abi pref :: Word32
pref) =
        String -> ByteString
pack (Word32 -> String
forall a. Show a => a -> String
show Word32
abi) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
        if Word32
pref Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
abi
          then ":" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
pack (Word32 -> String
forall a. Show a => a -> String
show Word32
pref)
          else ""
      sTriple :: (Word32, AlignmentInfo) -> ByteString
      sTriple :: (Word32, AlignmentInfo) -> ByteString
sTriple (s :: Word32
s, ai :: AlignmentInfo
ai) = String -> ByteString
pack (Word32 -> String
forall a. Show a => a -> String
show Word32
s) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ":" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> AlignmentInfo -> ByteString
sAlignmentInfo AlignmentInfo
ai
      atChar :: AlignType -> p
atChar at :: AlignType
at = case AlignType
at of
        IntegerAlign -> "i"
        VectorAlign -> "v"
        FloatAlign -> "f"
      manglingChar :: Mangling -> p
manglingChar m :: Mangling
m = case Mangling
m of
        ELFMangling -> "e"
        MIPSMangling -> "m"
        MachOMangling -> "o"
        WindowsCOFFMangling -> "w"
      oneOpt :: (a -> a) -> (DataLayout -> Maybe a) -> [a]
oneOpt f :: a -> a
f accessor :: DataLayout -> Maybe a
accessor = [a] -> (a -> [a]) -> Maybe a -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[]) (a -> [a]) -> (a -> a) -> a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f) (DataLayout -> Maybe a
accessor DataLayout
dl)
      defDl :: DataLayout
defDl = Endianness -> DataLayout
defaultDataLayout Endianness
BigEndian
      nonDef :: Eq a => (DataLayout -> [a]) -> [a]
      nonDef :: (DataLayout -> [a]) -> [a]
nonDef f :: DataLayout -> [a]
f = (DataLayout -> [a]
f DataLayout
dl) [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
List.\\ (DataLayout -> [a]
f DataLayout
defDl)
  in
  ByteString -> [ByteString] -> ByteString
ByteString.intercalate "-" (
    [case DataLayout -> Endianness
endianness DataLayout
dl of BigEndian -> "E"; LittleEndian -> "e"]
    [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++
    ((Mangling -> ByteString)
-> (DataLayout -> Maybe Mangling) -> [ByteString]
forall a a. (a -> a) -> (DataLayout -> Maybe a) -> [a]
oneOpt (("m:" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) (ByteString -> ByteString)
-> (Mangling -> ByteString) -> Mangling -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mangling -> ByteString
forall p. IsString p => Mangling -> p
manglingChar) DataLayout -> Maybe Mangling
mangling)
    [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++
    [
      "p" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (if Word32
a Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then "" else String -> ByteString
pack (Word32 -> String
forall a. Show a => a -> String
show Word32
a)) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ":" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (Word32, AlignmentInfo) -> ByteString
sTriple (Word32, AlignmentInfo)
t
      | (AddrSpace a :: Word32
a, t :: (Word32, AlignmentInfo)
t) <- (DataLayout -> [(AddrSpace, (Word32, AlignmentInfo))])
-> [(AddrSpace, (Word32, AlignmentInfo))]
forall a. Eq a => (DataLayout -> [a]) -> [a]
nonDef (Map AddrSpace (Word32, AlignmentInfo)
-> [(AddrSpace, (Word32, AlignmentInfo))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map AddrSpace (Word32, AlignmentInfo)
 -> [(AddrSpace, (Word32, AlignmentInfo))])
-> (DataLayout -> Map AddrSpace (Word32, AlignmentInfo))
-> DataLayout
-> [(AddrSpace, (Word32, AlignmentInfo))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataLayout -> Map AddrSpace (Word32, AlignmentInfo)
pointerLayouts)
    ] [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [
      AlignType -> ByteString
forall p. IsString p => AlignType -> p
atChar AlignType
at ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (Word32, AlignmentInfo) -> ByteString
sTriple (Word32
s, AlignmentInfo
ai)
      | ((at :: AlignType
at, s :: Word32
s), ai :: AlignmentInfo
ai) <- (DataLayout -> [((AlignType, Word32), AlignmentInfo)])
-> [((AlignType, Word32), AlignmentInfo)]
forall a. Eq a => (DataLayout -> [a]) -> [a]
nonDef (Map (AlignType, Word32) AlignmentInfo
-> [((AlignType, Word32), AlignmentInfo)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map (AlignType, Word32) AlignmentInfo
 -> [((AlignType, Word32), AlignmentInfo)])
-> (DataLayout -> Map (AlignType, Word32) AlignmentInfo)
-> DataLayout
-> [((AlignType, Word32), AlignmentInfo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataLayout -> Map (AlignType, Word32) AlignmentInfo
typeLayouts)
    ] [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [
      "a:" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> AlignmentInfo -> ByteString
sAlignmentInfo AlignmentInfo
ai | AlignmentInfo
ai <- (DataLayout -> [AlignmentInfo]) -> [AlignmentInfo]
forall a. Eq a => (DataLayout -> [a]) -> [a]
nonDef (AlignmentInfo -> [AlignmentInfo]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AlignmentInfo -> [AlignmentInfo])
-> (DataLayout -> AlignmentInfo) -> DataLayout -> [AlignmentInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataLayout -> AlignmentInfo
aggregateLayout)
    ] [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++
    ((Set Word32 -> ByteString)
-> (DataLayout -> Maybe (Set Word32)) -> [ByteString]
forall a a. (a -> a) -> (DataLayout -> Maybe a) -> [a]
oneOpt (("n"ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) (ByteString -> ByteString)
-> (Set Word32 -> ByteString) -> Set Word32 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString] -> ByteString
ByteString.intercalate ":") ([ByteString] -> ByteString)
-> (Set Word32 -> [ByteString]) -> Set Word32 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> ByteString) -> [Word32] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (String -> ByteString
pack (String -> ByteString)
-> (Word32 -> String) -> Word32 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> String
forall a. Show a => a -> String
show) ([Word32] -> [ByteString])
-> (Set Word32 -> [Word32]) -> Set Word32 -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Word32 -> [Word32]
forall a. Set a -> [a]
Set.toList) DataLayout -> Maybe (Set Word32)
nativeSizes)
    [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++
    ((Word32 -> ByteString)
-> (DataLayout -> Maybe Word32) -> [ByteString]
forall a a. (a -> a) -> (DataLayout -> Maybe a) -> [a]
oneOpt (("S"ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) (ByteString -> ByteString)
-> (Word32 -> ByteString) -> Word32 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
pack (String -> ByteString)
-> (Word32 -> String) -> Word32 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> String
forall a. Show a => a -> String
show) DataLayout -> Maybe Word32
stackAlignment)
  )

-- | Parse a 'DataLayout', given a default Endianness should one not be specified in the
-- string to be parsed. LLVM itself uses BigEndian as the default: thus pass BigEndian to
-- be conformant or LittleEndian to be righteously defiant.
parseDataLayout :: Endianness -> ByteString -> Except String (Maybe DataLayout)
parseDataLayout :: Endianness -> ByteString -> Except String (Maybe DataLayout)
parseDataLayout _ "" = Maybe DataLayout -> Except String (Maybe DataLayout)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe DataLayout
forall a. Maybe a
Nothing
parseDataLayout defaultEndianness :: Endianness
defaultEndianness str :: ByteString
str =
  let
    num :: Parser Word32
    num :: Parser Word32
num = String -> Word32
forall a. Read a => String -> a
read (String -> Word32) -> Parser ByteString String -> Parser Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Char -> Parser ByteString String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser ByteString Char
digit
    alignmentInfo :: Parser AlignmentInfo
    alignmentInfo :: Parser AlignmentInfo
alignmentInfo = do
      Word32
abi <- Parser Word32
num
      Maybe Word32
pref <- Parser Word32 -> Parser ByteString (Maybe Word32)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Word32 -> Parser ByteString (Maybe Word32))
-> Parser Word32 -> Parser ByteString (Maybe Word32)
forall a b. (a -> b) -> a -> b
$ Char -> Parser ByteString Char
char ':' Parser ByteString Char -> Parser Word32 -> Parser Word32
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Word32
num
      let pref' :: Word32
pref' = Word32 -> Maybe Word32 -> Word32
forall a. a -> Maybe a -> a
fromMaybe Word32
abi Maybe Word32
pref
      AlignmentInfo -> Parser AlignmentInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AlignmentInfo -> Parser AlignmentInfo)
-> AlignmentInfo -> Parser AlignmentInfo
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> AlignmentInfo
AlignmentInfo Word32
abi Word32
pref'
    triple :: Parser (Word32, AlignmentInfo)
    triple :: Parser (Word32, AlignmentInfo)
triple = do
      Word32
s <- Parser Word32
num
      AlignmentInfo
ai <- Char -> Parser ByteString Char
char ':' Parser ByteString Char
-> Parser AlignmentInfo -> Parser AlignmentInfo
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser AlignmentInfo
alignmentInfo
      (Word32, AlignmentInfo) -> Parser (Word32, AlignmentInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32
s, AlignmentInfo
ai)
    parseSpec :: Parser (DataLayout -> DataLayout)
    parseSpec :: Parser (DataLayout -> DataLayout)
parseSpec = [Parser (DataLayout -> DataLayout)]
-> Parser (DataLayout -> DataLayout)
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [
      Char -> Parser ByteString Char
char 'e' Parser ByteString Char
-> Parser (DataLayout -> DataLayout)
-> Parser (DataLayout -> DataLayout)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (DataLayout -> DataLayout) -> Parser (DataLayout -> DataLayout)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\dl :: DataLayout
dl -> DataLayout
dl { endianness :: Endianness
endianness = Endianness
LittleEndian }),
      Char -> Parser ByteString Char
char 'E' Parser ByteString Char
-> Parser (DataLayout -> DataLayout)
-> Parser (DataLayout -> DataLayout)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (DataLayout -> DataLayout) -> Parser (DataLayout -> DataLayout)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\dl :: DataLayout
dl -> DataLayout
dl { endianness :: Endianness
endianness = Endianness
BigEndian }),
      do
        Mangling
m <- Char -> Parser ByteString Char
char 'm' Parser ByteString Char
-> Parser ByteString Char -> Parser ByteString Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString Char
char ':' Parser ByteString Char
-> Parser ByteString Mangling -> Parser ByteString Mangling
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Parser ByteString Mangling] -> Parser ByteString Mangling
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [
              Char -> Parser ByteString Char
char 'e' Parser ByteString Char
-> Parser ByteString Mangling -> Parser ByteString Mangling
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Mangling -> Parser ByteString Mangling
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mangling
ELFMangling,
              Char -> Parser ByteString Char
char 'm' Parser ByteString Char
-> Parser ByteString Mangling -> Parser ByteString Mangling
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Mangling -> Parser ByteString Mangling
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mangling
MIPSMangling,
              Char -> Parser ByteString Char
char 'o' Parser ByteString Char
-> Parser ByteString Mangling -> Parser ByteString Mangling
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Mangling -> Parser ByteString Mangling
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mangling
MachOMangling,
              Char -> Parser ByteString Char
char 'w' Parser ByteString Char
-> Parser ByteString Mangling -> Parser ByteString Mangling
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Mangling -> Parser ByteString Mangling
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mangling
WindowsCOFFMangling
             ]
        (DataLayout -> DataLayout) -> Parser (DataLayout -> DataLayout)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((DataLayout -> DataLayout) -> Parser (DataLayout -> DataLayout))
-> (DataLayout -> DataLayout) -> Parser (DataLayout -> DataLayout)
forall a b. (a -> b) -> a -> b
$ \dl :: DataLayout
dl -> DataLayout
dl { mangling :: Maybe Mangling
mangling = Mangling -> Maybe Mangling
forall a. a -> Maybe a
Just Mangling
m },
      do
        Word32
n <- Char -> Parser ByteString Char
char 'S' Parser ByteString Char -> Parser Word32 -> Parser Word32
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Word32
num
        (DataLayout -> DataLayout) -> Parser (DataLayout -> DataLayout)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((DataLayout -> DataLayout) -> Parser (DataLayout -> DataLayout))
-> (DataLayout -> DataLayout) -> Parser (DataLayout -> DataLayout)
forall a b. (a -> b) -> a -> b
$ \dl :: DataLayout
dl -> DataLayout
dl { stackAlignment :: Maybe Word32
stackAlignment = Word32 -> Maybe Word32
forall a. a -> Maybe a
Just Word32
n },
      do
        AddrSpace
a <- Char -> Parser ByteString Char
char 'p' Parser ByteString Char
-> Parser ByteString AddrSpace -> Parser ByteString AddrSpace
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Word32 -> AddrSpace
AddrSpace (Word32 -> AddrSpace)
-> Parser Word32 -> Parser ByteString AddrSpace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word32 -> Parser Word32 -> Parser Word32
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option 0 (String -> Word32
forall a. Read a => String -> a
read (String -> Word32) -> Parser ByteString String -> Parser Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Char -> Parser ByteString String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser ByteString Char
digit))
        (Word32, AlignmentInfo)
t <- Char -> Parser ByteString Char
char ':' Parser ByteString Char
-> Parser (Word32, AlignmentInfo) -> Parser (Word32, AlignmentInfo)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Word32, AlignmentInfo)
triple
        (DataLayout -> DataLayout) -> Parser (DataLayout -> DataLayout)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((DataLayout -> DataLayout) -> Parser (DataLayout -> DataLayout))
-> (DataLayout -> DataLayout) -> Parser (DataLayout -> DataLayout)
forall a b. (a -> b) -> a -> b
$ \dl :: DataLayout
dl -> DataLayout
dl { pointerLayouts :: Map AddrSpace (Word32, AlignmentInfo)
pointerLayouts = AddrSpace
-> (Word32, AlignmentInfo)
-> Map AddrSpace (Word32, AlignmentInfo)
-> Map AddrSpace (Word32, AlignmentInfo)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AddrSpace
a (Word32, AlignmentInfo)
t (DataLayout -> Map AddrSpace (Word32, AlignmentInfo)
pointerLayouts DataLayout
dl) },
      do
        -- Ignore this obsolete approach to stack alignment.  After the 3.4 release,
        -- this is never generated, still parsed but ignored.  Comments suggest
        -- it will no longer be parsed after 4.0.
        Parser (Word32, AlignmentInfo) -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser (Word32, AlignmentInfo) -> Parser ByteString ())
-> Parser (Word32, AlignmentInfo) -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser ByteString Char
char 's' Parser ByteString Char
-> Parser (Word32, AlignmentInfo) -> Parser (Word32, AlignmentInfo)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Word32, AlignmentInfo)
triple
        (DataLayout -> DataLayout) -> Parser (DataLayout -> DataLayout)
forall (f :: * -> *) a. Applicative f => a -> f a
pure DataLayout -> DataLayout
forall a. a -> a
id,
      do
        AlignType
at <- [Parser ByteString AlignType] -> Parser ByteString AlignType
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [
               Char -> Parser ByteString Char
char 'i' Parser ByteString Char
-> Parser ByteString AlignType -> Parser ByteString AlignType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AlignType -> Parser ByteString AlignType
forall (f :: * -> *) a. Applicative f => a -> f a
pure AlignType
IntegerAlign,
               Char -> Parser ByteString Char
char 'v' Parser ByteString Char
-> Parser ByteString AlignType -> Parser ByteString AlignType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AlignType -> Parser ByteString AlignType
forall (f :: * -> *) a. Applicative f => a -> f a
pure AlignType
VectorAlign,
               Char -> Parser ByteString Char
char 'f' Parser ByteString Char
-> Parser ByteString AlignType -> Parser ByteString AlignType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AlignType -> Parser ByteString AlignType
forall (f :: * -> *) a. Applicative f => a -> f a
pure AlignType
FloatAlign
              ]
        (sz :: Word32
sz, ai :: AlignmentInfo
ai) <- Parser (Word32, AlignmentInfo)
triple
        (DataLayout -> DataLayout) -> Parser (DataLayout -> DataLayout)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((DataLayout -> DataLayout) -> Parser (DataLayout -> DataLayout))
-> (DataLayout -> DataLayout) -> Parser (DataLayout -> DataLayout)
forall a b. (a -> b) -> a -> b
$ \dl :: DataLayout
dl -> DataLayout
dl { typeLayouts :: Map (AlignType, Word32) AlignmentInfo
typeLayouts = (AlignType, Word32)
-> AlignmentInfo
-> Map (AlignType, Word32) AlignmentInfo
-> Map (AlignType, Word32) AlignmentInfo
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (AlignType
at, Word32
sz) AlignmentInfo
ai (DataLayout -> Map (AlignType, Word32) AlignmentInfo
typeLayouts DataLayout
dl) },
      do
        AlignmentInfo
ai <- Char -> Parser ByteString Char
char 'a' Parser ByteString Char
-> Parser ByteString Char -> Parser ByteString Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString Char
char ':' Parser ByteString Char
-> Parser AlignmentInfo -> Parser AlignmentInfo
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser AlignmentInfo
alignmentInfo
        (DataLayout -> DataLayout) -> Parser (DataLayout -> DataLayout)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((DataLayout -> DataLayout) -> Parser (DataLayout -> DataLayout))
-> (DataLayout -> DataLayout) -> Parser (DataLayout -> DataLayout)
forall a b. (a -> b) -> a -> b
$ \dl :: DataLayout
dl -> DataLayout
dl { aggregateLayout :: AlignmentInfo
aggregateLayout = AlignmentInfo
ai },
      do
        [Word32]
ns <- Char -> Parser ByteString Char
char 'n' Parser ByteString Char
-> Parser ByteString [Word32] -> Parser ByteString [Word32]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Word32
num Parser Word32
-> Parser ByteString Char -> Parser ByteString [Word32]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy` (Char -> Parser ByteString Char
char ':')
        (DataLayout -> DataLayout) -> Parser (DataLayout -> DataLayout)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((DataLayout -> DataLayout) -> Parser (DataLayout -> DataLayout))
-> (DataLayout -> DataLayout) -> Parser (DataLayout -> DataLayout)
forall a b. (a -> b) -> a -> b
$ \dl :: DataLayout
dl -> DataLayout
dl { nativeSizes :: Maybe (Set Word32)
nativeSizes = Set Word32 -> Maybe (Set Word32)
forall a. a -> Maybe a
Just ([Word32] -> Set Word32
forall a. Ord a => [a] -> Set a
Set.fromList [Word32]
ns) }
     ]
  in
    case Parser [DataLayout -> DataLayout]
-> ByteString -> Either String [DataLayout -> DataLayout]
forall a. Parser a -> ByteString -> Either String a
parseOnly (Parser (DataLayout -> DataLayout)
parseSpec Parser (DataLayout -> DataLayout)
-> Parser ByteString Char -> Parser [DataLayout -> DataLayout]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy` (Char -> Parser ByteString Char
char '-')) ByteString
str of
      Left _ -> String -> Except String (Maybe DataLayout)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (String -> Except String (Maybe DataLayout))
-> String -> Except String (Maybe DataLayout)
forall a b. (a -> b) -> a -> b
$ "ill formed data layout: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
str
      Right fs :: [DataLayout -> DataLayout]
fs -> Maybe DataLayout -> Except String (Maybe DataLayout)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe DataLayout -> Except String (Maybe DataLayout))
-> (DataLayout -> Maybe DataLayout)
-> DataLayout
-> Except String (Maybe DataLayout)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataLayout -> Maybe DataLayout
forall a. a -> Maybe a
Just (DataLayout -> Except String (Maybe DataLayout))
-> DataLayout -> Except String (Maybe DataLayout)
forall a b. (a -> b) -> a -> b
$ ((DataLayout -> DataLayout) -> DataLayout -> DataLayout)
-> DataLayout -> [DataLayout -> DataLayout] -> DataLayout
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (DataLayout -> DataLayout) -> DataLayout -> DataLayout
forall a b. (a -> b) -> a -> b
($) (Endianness -> DataLayout
defaultDataLayout Endianness
defaultEndianness) [DataLayout -> DataLayout]
fs