module Language.CSPM.Utils
(eitherToExc
,handleLexError
,handleParseError
,handleRenameError
,parseFile,testFrontend)
where
import Language.CSPM.Parser (ParseError(..),parse)
import Language.CSPM.Rename (RenameError(..),getRenaming,applyRenaming)
import Language.CSPM.PatternCompiler (compilePattern)
import Language.CSPM.Token (Token,LexError(..))
import Language.CSPM.AST (Labeled(..),LModule,Module(..),Bindings)
import Language.CSPM.AstUtils
(removeSourceLocations,removeModuleTokens,removeParens,relabelAst
,unUniqueIdent,showAst,computeFreeNames)
import qualified Language.CSPM.LexHelper as Lexer
(lexInclude,lexPlain,filterIgnoredToken)
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 LModule
parseFile fileName = do
src <- readFile fileName
tokenList <- Lexer.lexInclude src >>= eitherToExc
eitherToExc $ parse fileName tokenList
testFrontend :: FilePath -> IO (LModule,LModule)
testFrontend 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
renaming <- eitherToExc $ getRenaming ast
let astNew = applyRenaming renaming 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"