content: 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)
    )
  
  -- | 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 -> 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' -- 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.
          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
  
  
  