module Language.CSPM.Utils
(eitherToExc
,handleLexError
,handleParseError
,handleRenameError
,parseFile, benchmarkFrontend, parseString)
where
import Language.CSPM.Parser (ParseError(..), parse)
import Language.CSPM.Rename (RenameError(..), renameModule, ModuleFromRenaming)
import Language.CSPM.Token (LexError(..))
import Language.CSPM.AST (ModuleFromParser)
import qualified Language.CSPM.LexHelper as Lexer (lexInclude)
import Control.Exception as Exception
import System.CPUTime
eitherToExc :: Exception a => Either a b -> IO b
eitherToExc (Right r) = return r
eitherToExc (Left e) = throw e
handleLexError :: (LexError -> IO a) -> IO a -> IO a
handleLexError handler proc = Exception.catch proc handler
handleParseError :: (ParseError -> IO a) -> IO a -> IO a
handleParseError handler proc = Exception.catch proc handler
handleRenameError :: (RenameError -> IO a) -> IO a -> IO a
handleRenameError handler proc = Exception.catch proc handler
parseFile :: FilePath -> IO ModuleFromParser
parseFile fileName = do
src <- readFile fileName
parseNamedString fileName src
parseString :: String -> IO ModuleFromParser
parseString = parseNamedString "no-file-name"
parseNamedString :: FilePath -> String -> IO ModuleFromParser
parseNamedString name str = do
tokenList <- Lexer.lexInclude str >>= eitherToExc
eitherToExc $ parse name tokenList
benchmarkFrontend :: FilePath -> IO (ModuleFromParser, ModuleFromRenaming)
benchmarkFrontend fileName = do
src <- readFile fileName
putStrLn $ "Reading File " ++ fileName
startTime <- (return $ length src) >> getCPUTime
tokenList <- Lexer.lexInclude src >>= eitherToExc
time_have_tokens <- getCPUTime
ast <- eitherToExc $ parse fileName tokenList
time_have_ast <- getCPUTime
(astNew, _renaming) <- eitherToExc $ renameModule ast
time_have_renaming <- getCPUTime
putStrLn $ "Parsing OK"
putStrLn $ "lextime : " ++ showTime (time_have_tokens startTime)
putStrLn $ "parsetime : " ++ showTime(time_have_ast time_have_tokens)
putStrLn $ "renamingtime : " ++ showTime (time_have_renaming time_have_ast)
putStrLn $ "total : " ++ showTime(time_have_ast startTime)
return (ast,astNew)
where
showTime :: Integer -> String
showTime a = show (div a 1000000000) ++ "ms"