a8df1926aa68784233817df16aef215d793acb10
[hsc2hs.git] / ATTParser.hs
1 -- A rather crude asm parser.
2 --
3 --
4 -- we only handle a subset of AT&T assembly
5 -- right now. This is what gcc and clang can
6 -- emit. For clang using llvm-ir might be
7 -- even better. For gcc gimple if that can
8 -- be consumed reliably somehow.
9 --
10 -- For now we'll rely on the at&t assembly
11 -- to be sufficient for constants.
12 --
13
14
15 module ATTParser where
16
17 import Data.Functor ((<$>))
18 import Control.Applicative ((<|>))
19 import Data.Word (Word)
20
21 type ASM = [(String, [(String, String)])]
22
23 parse :: FilePath -> IO ASM
24 parse f = do
25 lns <- lines <$> readFile f
26 return $ foldl parseLine [] lns
27
28 where parseLine :: ASM -> String -> ASM
29 parseLine [] ('\t':_) = []
30 parseLine ((ident,attr):xs) ('\t':line) = let (key, val) = span (`notElem` " \t") line
31 in (ident,(key,trim val):attr):xs
32 parseLine xs line = let ident = takeWhile (/= ':') line in (ident,[]):xs
33
34 trim :: String -> String
35 trim = reverse . dropWhile (`elem` " \t") . reverse . dropWhile (`elem` " \t")
36
37 -- | lookup a constant numeric value. Drop any comments indicated by ';', '#' or '@'.
38 -- We assume the value is either in the `.long` or `.quad` attribute.
39 lookupConst :: String -> ASM -> Maybe String
40 lookupConst key asm = lookup key asm >>= \x -> (trim . takeWhile (`notElem` ";#@") <$> (lookup ".long" x <|> lookup ".quad" x))
41 -- the compiler may emit something like `.space 4` to indicate 0000.
42 <|> (const "0" <$> lookup ".space" x)
43
44 -- | extract a C String in the most basic sense we can.
45 -- the .asciz directive doesn't contain the \0 terminator.
46 lookupASCII :: String -> ASM -> Maybe String
47 lookupASCII key asm = lookup key asm >>= \x -> read <$> lookup ".ascii" x <|> ((++ "\0") . read <$> lookup ".asciz" x)
48
49 lookupInt :: String -> ASM -> Maybe Int
50 lookupInt key = fmap read . lookupConst key
51
52 lookupInteger :: String -> ASM -> Maybe Integer
53 lookupInteger key = fmap read . lookupConst key
54
55 lookupUInteger :: String -> ASM -> Maybe Integer
56 lookupUInteger key = fmap (fromIntegral . (read :: String -> Word)) . lookupConst key
57
58 lookupCString :: String -> ASM -> Maybe String
59 lookupCString key asm = lookupConst key asm >>= flip lookupASCII asm