diff options
| author | krasimir <krasimir@chalmers.se> | 2008-10-20 09:40:09 +0000 |
|---|---|---|
| committer | krasimir <krasimir@chalmers.se> | 2008-10-20 09:40:09 +0000 |
| commit | 6f7d0ab08d5eaf1edae09ffaeda59e459d3d6266 (patch) | |
| tree | 9e48070cb5045b63f26933fea211c04fc2c289bf /examples/test/parser/Parse.hs | |
| parent | 072f19212f1946b56ead11cb5ae6cd4e34ae6017 (diff) | |
added parser test suite
Diffstat (limited to 'examples/test/parser/Parse.hs')
| -rw-r--r-- | examples/test/parser/Parse.hs | 34 |
1 files changed, 34 insertions, 0 deletions
diff --git a/examples/test/parser/Parse.hs b/examples/test/parser/Parse.hs new file mode 100644 index 000000000..4a828301d --- /dev/null +++ b/examples/test/parser/Parse.hs @@ -0,0 +1,34 @@ +import PGF
+import Data.Maybe
+import System.IO
+import System.CPUTime
+import Control.Monad
+
+main = do
+ pgf <- readPGF "grammar.pgf"
+ ts <- fmap (map (fromJust . readTree) . lines) $ readFile "trees.txt"
+ ss <- foldM (doTest pgf (mkCId "LangGer") (fromJust (readType "Phr"))) [] ts
+ mapM_ (hPutStrLn stderr . show) [(fromIntegral s / fromIntegral n)/1000000000 | (s,n) <- ss]
+ putStrLn "Done."
+
+doTest pgf lang cat ss t = do
+ let s = linearize pgf lang t
+ putStr (s ++ " ... ")
+ let st = initState pgf lang cat
+ t1 <- getCPUTime
+ res <- doParse st t1 [] (words s)
+ case res of
+ Just (st,ts) -> putStrLn "Ok" >> return (accum ts ss)
+ Nothing -> putStrLn "Fail" >> return ss
+
+
+doParse st t1 ts [] = return (Just (st,reverse ts))
+doParse st t1 ts (tk:tks) = do
+ case nextState st tk of
+ Nothing -> return Nothing
+ Just st -> do t2 <- getCPUTime
+ doParse st t1 ((t2-t1):ts) tks
+
+accum [] ss = ss
+accum (t:ts) [] = (t,1) : accum ts []
+accum (t:ts) ((s,n):ss) = (s+t,n+1) : accum ts ss
|