diff --git a/llvm-general-pure.cabal b/llvm-general-pure.cabal --- a/llvm-general-pure.cabal +++ b/llvm-general-pure.cabal @@ -1,5 +1,5 @@ name: llvm-general-pure -version: 3.2.7.1 +version: 3.2.7.2 license: BSD3 license-file: LICENSE author: Benjamin S.Scarlet @@ -15,7 +15,7 @@ It includes an ADT to represent LLVM IR (). The llvm-general package builds on this one with FFI bindings to LLVM, but llvm-general-pure does not require LLVM to be available. . - For haddock, see . + For haddock, see . source-repository head type: git @@ -25,15 +25,11 @@ ghc-options: -fwarn-unused-imports build-depends: base >= 4.5.0.0 && < 5, - text >= 0.11.2.1, - bytestring >= 0.9.1.10, transformers >= 0.3.0.0, mtl >= 2.0.1.0, template-haskell >= 2.5.0.0, containers >= 0.4.2.1, - parsec >= 3.1.3, - array >= 0.4.0.0, - setenv >= 0.1.0 + parsec >= 3.1.3 hs-source-dirs: src extensions: TupleSections @@ -62,6 +58,7 @@ LLVM.General.AST.RMWOperation LLVM.General.AST.Type LLVM.General.AST.Visibility + LLVM.General.DataLayout LLVM.General.PrettyPrint other-modules: @@ -76,7 +73,7 @@ HUnit >= 1.2.4.2, test-framework-quickcheck2 >= 0.3.0.1, QuickCheck >= 2.5.1.1, - llvm-general-pure == 3.2.7.1, + llvm-general-pure == 3.2.7.2, containers >= 0.4.2.1, mtl >= 2.0.1.0 hs-source-dirs: test @@ -86,4 +83,5 @@ FlexibleContexts main-is: Test.hs other-modules: + LLVM.General.Test.DataLayout LLVM.General.Test.PrettyPrint diff --git a/src/LLVM/General/DataLayout.hs b/src/LLVM/General/DataLayout.hs new file mode 100644 --- /dev/null +++ b/src/LLVM/General/DataLayout.hs @@ -0,0 +1,95 @@ +module LLVM.General.DataLayout ( + dataLayoutToString, + parseDataLayout + ) where + +import Control.Applicative + +import Data.Word + +import qualified Data.List as List +import qualified Data.Map as Map +import qualified Data.Set as Set + +import Text.ParserCombinators.Parsec hiding (many) + +import LLVM.General.AST.DataLayout +import LLVM.General.AST.AddrSpace + +dataLayoutToString :: DataLayout -> String +dataLayoutToString dl = + let sTriple :: (Word32, AlignmentInfo) -> String + sTriple (s, ai) = show s ++ ":" ++ show (abiAlignment ai) ++ (maybe "" (\p -> ":" ++ show p) (preferredAlignment ai)) + atChar at = case at of + IntegerAlign -> "i" + VectorAlign -> "v" + FloatAlign -> "f" + AggregateAlign -> "a" + StackAlign -> "s" + in + List.intercalate "-" ( + (case endianness dl of Just BigEndian -> ["E"]; Just LittleEndian -> ["e"]; _ -> []) + ++ + (maybe [] (\s -> ["S" ++ show s]) (stackAlignment dl)) + ++ + [ "p" ++ (if a == 0 then "" else show a) ++ ":" ++ sTriple t | (AddrSpace a, t) <- Map.toList . pointerLayouts $ dl] + ++ + [ atChar at ++ sTriple (s, ai) | ((at, s), ai) <- Map.toList . typeLayouts $ dl ] + ++ + (maybe [] (\ns -> ["n" ++ (List.intercalate ":" (map show . Set.toList $ ns))]) (nativeSizes dl)) + ) + +parseDataLayout :: String -> Maybe DataLayout +parseDataLayout "" = Nothing +parseDataLayout s = + let + num :: Parser Word32 + num = read <$> many digit + triple :: Parser (Word32, AlignmentInfo) + triple = do + s <- num + char ':' + abi <- num + pref <- optionMaybe $ do + char ':' + num + return (s, (AlignmentInfo abi pref)) + parseSpec :: Parser (DataLayout -> DataLayout) + parseSpec = choice [ + do + char 'e' + return $ \dl -> dl { endianness = Just LittleEndian }, + do + char 'E' + return $ \dl -> dl { endianness = Just BigEndian }, + do + char 'S' + n <- num + return $ \dl -> dl { stackAlignment = Just n }, + do + char 'p' + a <- AddrSpace <$> option 0 (read <$> many1 digit) + char ':' + t <- triple + return $ \dl -> dl { pointerLayouts = Map.insert a t (pointerLayouts dl) }, + do + at <- choice [ + char 'i' >> return IntegerAlign, + char 'v' >> return VectorAlign, + char 'f' >> return FloatAlign, + char 'a' >> return AggregateAlign, + char 's' >> return StackAlign + ] + (sz,ai) <- triple + return $ \dl -> dl { typeLayouts = Map.insert (at,sz) ai (typeLayouts dl) }, + do + char 'n' + ns <- num `sepBy` (char ':') + return $ \dl -> dl { nativeSizes = Just (Set.fromList ns) } + ] + in + case parse (parseSpec `sepBy` (char '-')) "" s of + Left _ -> error $ "ill formed data layout: " ++ show s + Right fs -> Just $ foldr ($) defaultDataLayout fs + + diff --git a/test/LLVM/General/Test/DataLayout.hs b/test/LLVM/General/Test/DataLayout.hs new file mode 100644 --- /dev/null +++ b/test/LLVM/General/Test/DataLayout.hs @@ -0,0 +1,80 @@ +module LLVM.General.Test.DataLayout where + +import Test.Framework +import Test.Framework.Providers.HUnit +import Test.HUnit + +import Data.Maybe +import qualified Data.Set as Set +import qualified Data.Map as Map + +import LLVM.General.AST +import LLVM.General.AST.DataLayout +import LLVM.General.AST.AddrSpace +import LLVM.General.DataLayout + +tests = testGroup "DataLayout" [ + testCase name $ do + (dataLayoutToString astDl, parseDataLayout strDl) @?= (strDl, Just astDl) + | (name, astDl, strDl) <- [ + ("little-endian", defaultDataLayout { endianness = Just LittleEndian }, "e"), + ("big-endian", defaultDataLayout { endianness = Just BigEndian }, "E"), + ("native", defaultDataLayout { nativeSizes = Just (Set.fromList [8,32]) }, "n8:32"), + ( + "no pref", + defaultDataLayout { + pointerLayouts = + Map.singleton + (AddrSpace 0) + ( + 8, + AlignmentInfo { + abiAlignment = 64, + preferredAlignment = Nothing + } + ) + }, + "p:8:64" + ), ( + "no pref", + defaultDataLayout { + pointerLayouts = + Map.singleton + (AddrSpace 1) + ( + 8, + AlignmentInfo { + abiAlignment = 32, + preferredAlignment = Just 64 + } + ) + }, + "p1:8:32:64" + ), ( + "big", + DataLayout { + endianness = Just LittleEndian, + stackAlignment = Just 128, + pointerLayouts = Map.fromList [ + (AddrSpace 0, (64, AlignmentInfo {abiAlignment = 64, preferredAlignment = Just 64})) + ], + typeLayouts = Map.fromList [ + ((IntegerAlign, 1), AlignmentInfo {abiAlignment = 8, preferredAlignment = Just 8}), + ((IntegerAlign, 8), AlignmentInfo {abiAlignment = 8, preferredAlignment = Just 8}), + ((IntegerAlign, 16), AlignmentInfo {abiAlignment = 16, preferredAlignment = Just 16}), + ((IntegerAlign, 32), AlignmentInfo {abiAlignment = 32, preferredAlignment = Just 32}), + ((IntegerAlign, 64), AlignmentInfo {abiAlignment = 64, preferredAlignment = Just 64}), + ((VectorAlign, 64), AlignmentInfo {abiAlignment = 64, preferredAlignment = Just 64}), + ((VectorAlign, 128), AlignmentInfo {abiAlignment = 128, preferredAlignment = Just 128}), + ((FloatAlign, 32), AlignmentInfo {abiAlignment = 32, preferredAlignment = Just 32}), + ((FloatAlign, 64), AlignmentInfo {abiAlignment = 64, preferredAlignment = Just 64}), + ((FloatAlign, 80), AlignmentInfo {abiAlignment = 128, preferredAlignment = Just 128}), + ((AggregateAlign, 0), AlignmentInfo {abiAlignment = 0, preferredAlignment = Just 64}), + ((StackAlign, 0), AlignmentInfo {abiAlignment = 64, preferredAlignment = Just 64}) + ], + nativeSizes = Just (Set.fromList [8,16,32,64]) + }, + "e-S128-p:64:64:64-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-v64:64:64-v128:128:128-f32:32:32-f64:64:64-f80:128:128-a0:0:64-s0:64:64-n8:16:32:64" + ) + ] + ]