diff options
| author | krasimir <krasimir@chalmers.se> | 2009-05-20 11:25:00 +0000 |
|---|---|---|
| committer | krasimir <krasimir@chalmers.se> | 2009-05-20 11:25:00 +0000 |
| commit | 352ac74b0ff4fb616a9f40332b4c60d6c8953564 (patch) | |
| tree | 3d0a8d373e29f34544d4b35e11e419b19c1a9688 /testsuite/parser/Parse.hs | |
| parent | b6ce113041d7dc26021591f050bc11a358091594 (diff) | |
examples/test is moved to testsuite
Diffstat (limited to 'testsuite/parser/Parse.hs')
| -rw-r--r-- | testsuite/parser/Parse.hs | 34 |
1 files changed, 34 insertions, 0 deletions
diff --git a/testsuite/parser/Parse.hs b/testsuite/parser/Parse.hs new file mode 100644 index 000000000..4a828301d --- /dev/null +++ b/testsuite/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
|