module Main where
import System.Environment
import Control.Arrow
import Control.Monad
import Control.Applicative
import qualified Data.Map as Map
import Language.C import Language.C.Analysis import Language.C.System.GCC
main :: IO ()
main = do
let usage = error "Example Usage: ./ShowDef '((struct|union|enum) tagname|typename|objectname)' -I/usr/include my_file.c"
args <- getArgs
when (length args < 2) usage
let (searchterm:args') = args
let (opts,c_file) = (init &&& last) args'
ast <- parseCFile (newGCC "gcc") Nothing opts c_file
>>= checkResult "[parsing]"
(globals,_warnings) <- (runTrav_ >>> checkResult "[analysis]") $ analyseAST ast
let defId = searchDef globals searchterm
case defId of
Nothing -> print "Not found"
Just def_id -> printDecl def_id ast
where
checkResult :: (Show a) => String -> (Either a b) -> IO b
checkResult label = either (error . (label++) . show) return
printDecl :: NodeInfo -> CTranslUnit -> IO ()
printDecl def_id (CTranslUnit decls _) =
let decls' = filter (maybe False (posFile (posOfNode def_id) ==).fileOfNode) decls in
mapM_ (printIfMatch def_id) (zip decls' (map Just (tail decls') ++ [Nothing]))
printIfMatch def (decl,Just next_decl) | posOfNode def >= posOf decl &&
posOfNode def < posOf next_decl = (print . pretty) decl
| otherwise = return ()
printIfMatch def (decl, Nothing) | posOfNode def >= posOf decl = (print . pretty) decl
| otherwise = return ()
searchDef globs term =
case analyseSearchTerm term of
Left tag -> fmap nodeInfo (Map.lookup tag (gTags globs))
Right ident -> fmap nodeInfo (Map.lookup ident (gObjs globs))
<|> fmap nodeInfo (Map.lookup ident (gTypeDefs globs))
<|> fmap nodeInfo (Map.lookup (NamedRef ident) (gTags globs))
analyseSearchTerm term =
case words term of
[tag,name] | tag `elem` (words "struct union enum") -> Left $ NamedRef (internalIdent name)
[ident] -> Right (internalIdent ident)
_ -> error "bad search term"