module LLVM.General.DataLayout (
dataLayoutToString,
parseDataLayout
) where
import LLVM.General.Prelude
import Control.Monad.Trans.Except
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 sAlignmentInfo :: AlignmentInfo -> String
sAlignmentInfo (AlignmentInfo abi pref) =
show abi ++ case pref of
Just pref | pref /= abi -> ":" ++ show pref
_ -> ""
sTriple :: (Word32, AlignmentInfo) -> String
sTriple (s, ai) = show s ++ ":" ++ sAlignmentInfo ai
atChar at = case at of
IntegerAlign -> "i"
VectorAlign -> "v"
FloatAlign -> "f"
manglingChar m = case m of
ELFMangling -> "e"
MIPSMangling -> "m"
MachOMangling -> "o"
WindowsCOFFMangling -> "w"
oneOpt f accessor = maybe [] ((:[]) . f) (accessor dl)
defDl = defaultDataLayout BigEndian
nonDef :: Eq a => (DataLayout -> [a]) -> [a]
nonDef f = (f dl) List.\\ (f defDl)
in
List.intercalate "-" (
[case endianness dl of BigEndian -> "E"; LittleEndian -> "e"]
++
(oneOpt (("m:" ++) . manglingChar) mangling)
++
[
"p" ++ (if a == 0 then "" else show a) ++ ":" ++ sTriple t
| (AddrSpace a, t) <- nonDef (Map.toList . pointerLayouts)
] ++ [
atChar at ++ sTriple (s, ai)
| ((at, s), ai) <- nonDef (Map.toList . typeLayouts)
] ++ [
"a:" ++ sAlignmentInfo ai | ai <- nonDef (return . aggregateLayout)
] ++
(oneOpt (("n"++) . (List.intercalate ":") . (map show) . Set.toList) nativeSizes)
++
(oneOpt (("S"++) . show) stackAlignment)
)
parseDataLayout :: Endianness -> String -> Except String (Maybe DataLayout)
parseDataLayout _ "" = return Nothing
parseDataLayout defaultEndianness s =
let
num :: Parser Word32
num = read <$> many1 digit
alignmentInfo :: Parser AlignmentInfo
alignmentInfo = do
abi <- num
pref <- optionMaybe $ do
char ':'
num
return $ AlignmentInfo abi pref
triple :: Parser (Word32, AlignmentInfo)
triple = do
s <- num
char ':'
ai <- alignmentInfo
return (s, ai)
parseSpec :: Parser (DataLayout -> DataLayout)
parseSpec = choice [
do
char 'e'
return $ \dl -> dl { endianness = LittleEndian },
do
char 'E'
return $ \dl -> dl { endianness = BigEndian },
do
char 'm'
char ':'
m <- choice [
char 'e' >> return ELFMangling,
char 'm' >> return MIPSMangling,
char 'o' >> return MachOMangling,
char 'w' >> return WindowsCOFFMangling
]
return $ \dl -> dl { mangling = Just m },
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
char 's'
triple
return id,
do
at <- choice [
char 'i' >> return IntegerAlign,
char 'v' >> return VectorAlign,
char 'f' >> return FloatAlign
]
(sz, ai) <- triple
return $ \dl -> dl { typeLayouts = Map.insert (at, sz) ai (typeLayouts dl) },
do
char 'a'
char ':'
ai <- alignmentInfo
return $ \dl -> dl { aggregateLayout = ai },
do
char 'n'
ns <- num `sepBy` (char ':')
return $ \dl -> dl { nativeSizes = Just (Set.fromList ns) }
]
in
case parse (parseSpec `sepBy` (char '-')) "" s of
Left _ -> throwE $ "ill formed data layout: " ++ show s
Right fs -> return . Just $ foldr ($) (defaultDataLayout defaultEndianness) fs