yapb 0.2.4 → 0.2.5
raw patch · 7 files changed
+104/−28 lines, 7 files
Files
- app/ambiguous/Parser.hs +6/−1
- app/error/Parser.hs +7/−1
- app/parser/Parser.hs +7/−1
- app/syntaxcompletion/Parser.hs +7/−1
- src/parserlib/CommonParserUtil.hs +51/−20
- src/util/ParserTime.hs +21/−0
- yapb.cabal +5/−4
app/ambiguous/Parser.hs view
@@ -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+ } }
app/error/Parser.hs view
@@ -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+ } }
app/parser/Parser.hs view
@@ -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+ } }
app/syntaxcompletion/Parser.hs view
@@ -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+ } }
src/parserlib/CommonParserUtil.hs view
@@ -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 [] = ""
+ src/util/ParserTime.hs view
@@ -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
yapb.cabal view
@@ -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 <https://github.com/kwanghoon/yapb#readme> 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