diff --git a/app/ambiguous/Parser.hs b/app/ambiguous/Parser.hs --- a/app/ambiguous/Parser.hs +++ b/app/ambiguous/Parser.hs @@ -5,6 +5,7 @@ import Token import Expr +import ParserTime -- | Utility rule prodRule action = (prodRule, action, Nothing ) @@ -61,7 +62,11 @@ parserSpecFile = "mygrammar.grm", genparserexe = "yapb-exe", - synCompSpec = Nothing + synCompSpec = Nothing, + parserTime = ParserTime { + pa_startTime=startTime, + pa_finishTime=finishTime + } } diff --git a/app/error/Parser.hs b/app/error/Parser.hs --- a/app/error/Parser.hs +++ b/app/error/Parser.hs @@ -5,6 +5,8 @@ import Token import Expr +import ParserTime + import Control.Monad.Trans (lift) import qualified Control.Monad.Trans.State.Lazy as ST @@ -70,7 +72,11 @@ parserSpecFile = "mygrammar.grm", genparserexe = "yapb-exe", - synCompSpec = Nothing + synCompSpec = Nothing, + parserTime = ParserTime { + pa_startTime=startTime, + pa_finishTime=finishTime + } } diff --git a/app/parser/Parser.hs b/app/parser/Parser.hs --- a/app/parser/Parser.hs +++ b/app/parser/Parser.hs @@ -4,6 +4,8 @@ import Token import Expr +import ParserTime + -- | Utility rule prodRule action = (prodRule, action, Nothing ) ruleWithPrec prodRule action prec = (prodRule, action, Just prec) @@ -66,7 +68,11 @@ parserSpecFile = "mygrammar.grm", genparserexe = "yapb-exe", - synCompSpec = Nothing + synCompSpec = Nothing, + parserTime = ParserTime { + pa_startTime=startTime, + pa_finishTime=finishTime + } } diff --git a/app/syntaxcompletion/Parser.hs b/app/syntaxcompletion/Parser.hs --- a/app/syntaxcompletion/Parser.hs +++ b/app/syntaxcompletion/Parser.hs @@ -4,6 +4,8 @@ import Token import Expr +import ParserTime + -- | Utility rule prodRule action = (prodRule, action, Nothing ) ruleWithPrec prodRule action prec = (prodRule, action, Just prec) @@ -48,5 +50,9 @@ parserSpecFile = "mygrammar.grm", genparserexe = "yapb-exe", - synCompSpec = Nothing + synCompSpec = Nothing, + parserTime = ParserTime { + pa_startTime=startTime, + pa_finishTime=finishTime + } } diff --git a/src/parserlib/CommonParserUtil.hs b/src/parserlib/CommonParserUtil.hs --- a/src/parserlib/CommonParserUtil.hs +++ b/src/parserlib/CommonParserUtil.hs @@ -1,6 +1,6 @@ {-# LANGUAGE GADTs #-} module CommonParserUtil - ( LexerSpec(..), ParserSpec(..), AutomatonSpec(..) + ( LexerSpec(..), ParserSpec(..), AutomatonSpec(..),AutomatonTime(..) , LexerParserState, Line, Column , ProdRuleStr, ParseAction, ProdRulePrec , Stack, StkElem(..), push, pop, prStack @@ -16,7 +16,9 @@ , get, getText , LexError(..), ParseError(..), lpStateFrom , successfullyParsed, handleLexError, handleParseError - , SynCompSpec(..)) + , SynCompSpec(..) + , ParserTime(..) + ) where import Attrs @@ -136,9 +138,16 @@ grammarFile :: String, -- ex) grammar.txt parserSpecFile :: String, -- ex) mygrammar.grm genparserexe :: String, -- ex) genlrparse-exe - synCompSpec :: Maybe SynCompSpec + synCompSpec :: Maybe SynCompSpec, + parserTime :: ParserTime m a } +data ParserTime m a = + ParserTime { + pa_startTime :: ST.StateT (LexerParserState a) m Integer, + pa_finishTime :: Integer -> ST.StateT (LexerParserState a) m () + } + data SynCompSpec = SynCompSpec { isAbleToSearch :: String -> Bool -- terminasls or non-terminals } @@ -431,9 +440,17 @@ am_gotoTbl :: GotoTable, am_prodRules :: ProdRules, am_parseFuns :: ParseActionList token ast m a, - am_initState :: Int + am_initState :: Int, + am_time :: AutomatonTime m a } +data AutomatonTime m a = + AutomatonTime { + am_startTime :: ST.StateT (LexerParserState a) m Integer, + am_finishTime :: Integer -> ST.StateT (LexerParserState a) m (), + am_cputime :: Integer + } + initState = 0 type ParseActionList token ast m a = [ParseAction token ast m a] @@ -496,7 +513,11 @@ Nothing -> return flag Just config -> return $ config_DEBUG config - ST.evalStateT (runYapbAutomaton flag amSpec (lexer flag)) init_lp_state + ST.evalStateT runYA init_lp_state + where + runYA = + do start_cputime <- am_startTime (am_time amSpec) + runYapbAutomaton flag amSpec{am_time=(am_time amSpec){am_cputime=start_cputime}} (lexer flag) runYapbAutomaton :: (Monad m, @@ -515,7 +536,7 @@ -- AST ST.StateT (LexerParserState a) m ast -runYapbAutomaton flag (rm_spec@(AutomatonSpec { +runYapbAutomaton flag (am_spec@(AutomatonSpec { am_initState=initState, am_actionTbl=actionTbl, am_gotoTbl=gotoTbl, @@ -574,6 +595,7 @@ Nothing -> -- No more way to proceed now! do lp_state <- ST.get + (am_finishTime (am_time am_spec)) (am_cputime (am_time am_spec)) throw (NotFoundAction terminal state stack actionTbl gotoTbl prodRules lp_state maybeStatus) -- separated to support the haskell layout rule @@ -588,7 +610,9 @@ debug flag (terminalToString terminal) $ {- debug -} case stack !! 1 of - StkNonterminal (Just ast) _ -> return ast + StkNonterminal (Just ast) _ -> + do (am_finishTime (am_time am_spec)) (am_cputime (am_time am_spec)) + return ast StkNonterminal Nothing _ -> error "Empty ast in the stack nonterminal" _ -> error "Not Stknontermianl on Accept" @@ -619,6 +643,7 @@ case lookupGotoTable gotoTbl topState lhs of Just state -> return state Nothing -> do lp_state <- ST.get + (am_finishTime (am_time am_spec)) (am_cputime (am_time am_spec)) throw (NotFoundGoto topState lhs stack actionTbl gotoTbl prodRules lp_state maybeStatus) @@ -667,7 +692,13 @@ am_actionTbl=actionTbl, am_gotoTbl=gotoTbl, am_prodRules=prodRules, - am_parseFuns=pFunList}) + am_parseFuns=pFunList, + am_time=AutomatonTime { + am_startTime=pa_startTime (parserTime parserSpec), + am_finishTime=pa_finishTime (parserTime parserSpec), + am_cputime =0 + } + }) init_lp_state lexer -- putStrLn "done." -- for the interafce with Java-version RPC calculus interpreter. return ast @@ -928,24 +959,24 @@ multiDbg (map (debug (flag || True)) (map show colorListList_symbols)) $ debug (flag || True) "" $ - multiDbg (map (debug (flag || True)) (map show rawStrListList)) $ + multiDbg (map (debug (flag || True)) (map show rawStrListList)) $ - debug (flag || True) "" $ + debug (flag || True) "" $ -- debug (flag || True) $ showConcat $ map (\x -> (show x ++ "\n")) colorListList_symbols -- debug (flag || True) $ showConcat $ map (\x -> (show x ++ "\n")) rawStrListList -- mapM_ (putStrLn . show) rawStrListList - let formattedStrList = - case howtopresent of - 0 -> strList - 1 -> nub [ if null strList then "" else head strList | strList <- emacsColorListList ] - _ -> error ("Does not support prsentation method: " ++ show howtopresent) + let formattedStrList = + case howtopresent of + 0 -> strList + 1 -> nub [ if null strList then "" else head strList | strList <- emacsColorListList ] + _ -> error ("Does not support prsentation method: " ++ show howtopresent) - in - - if emacsDisplay - then return (map Candidate formattedStrList) - else return [] + in + + if emacsDisplay + then return (map Candidate formattedStrList) + else return [] where showConcat [] = "" diff --git a/src/util/ParserTime.hs b/src/util/ParserTime.hs new file mode 100644 --- /dev/null +++ b/src/util/ParserTime.hs @@ -0,0 +1,21 @@ +module ParserTime(startTime,finishTime,toSecond) where + +import CommonParserUtil + +import qualified Control.Monad.Trans.State.Lazy as ST +import Control.Monad.Trans(lift) +import System.CPUTime +import Text.Printf + +startTime :: ST.StateT (LexerParserState a) IO Integer +startTime = lift getCPUTime + +finishTime :: Integer -> ST.StateT (LexerParserState a) IO () +finishTime sTime = + do fTime <- lift getCPUTime + -- lift ( putStrLn $ "parse time: start time: " ++ show sTime ) + -- lift ( putStrLn $ "parse time: finish time: " ++ show fTime ) + lift ( printf "parse time: %6.2fs\n" (toSecond (fTime - sTime)) ) + +toSecond :: Integer -> Float +toSecond cpuTime = fromIntegral cpuTime * 1e-12 diff --git a/yapb.cabal b/yapb.cabal --- a/yapb.cabal +++ b/yapb.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 7c59cf87fbeef808a2e3de7bb410ef94f49b773ab3251ef42e0b5c384972346a +-- hash: d2745442916343e66c3feacbdb504a906f8fec85056a6470ff874f28d5e642ae name: yapb -version: 0.2.4 +version: 0.2.5 synopsis: Yet Another Parser Builder (YAPB) description: A programmable LALR(1) parser builder system. Please see the README on GitHub at category: parser builder @@ -55,6 +55,7 @@ SynCompAlgoUtil SynCompAlgorithm AVL + ParserTime other-modules: Paths_yapb hs-source-dirs: @@ -202,7 +203,7 @@ Paths_yapb hs-source-dirs: app/yapb - ghc-options: -threaded -rtsopts -with-rtsopts=-N + ghc-options: -threaded -rtsopts -with-rtsopts=-N -O2 build-depends: base >=4.7 && <5 , deepseq >=1.4.4.0 @@ -220,7 +221,7 @@ Paths_yapb hs-source-dirs: test - ghc-options: -threaded -rtsopts -with-rtsopts=-N + ghc-options: -threaded -rtsopts -with-rtsopts=-N -O2 build-depends: base >=4.7 && <5 , deepseq >=1.4.4.0