tools/protocolParser.hs
branchqmlfrontend
changeset 10908 1bd7a3a28b18
parent 10906 13fde38281fc
child 10925 be9ce3dc3739
--- a/tools/protocolParser.hs	Wed Apr 29 23:52:18 2015 +0300
+++ b/tools/protocolParser.hs	Mon May 04 17:48:57 2015 +0300
@@ -44,7 +44,7 @@
         , cmd2 "CHAT" SS LS
         , cmd2 "SERVER_VARS" SS LS
         , cmd2 "BYE" SS LS
-        , cmd "INFO" [SS, SS, SS, SS]
+        , cmd1 "INFO" $ Many [SS]
         , cmd "KICKED" []
     ]
 
@@ -66,7 +66,7 @@
     dt (PTPrefix s st) = text s $$ (nest 1 $ vcat $ map dt st)
     dt _ = empty
 
-pas = buildSwitch $ buildParseTree commands
+pas2 = buildSwitch $ buildParseTree commands
     where
         buildSwitch cmds = text "case getNextChar of" $$ (nest 4 . vcat $ map buildCase cmds) $$ elsePart
         buildCase (PTCommand _ ) = text "#10: <call cmd handler>;"
@@ -76,4 +76,11 @@
         zeroChar = text "#0: state:= pstDisconnected;"
         elsePart = text "else <unknown cmd> end;"
 
+pas = text $ show $ buildTables $ buildParseTree commands
+    where
+        buildTables cmds = let (_, _, t1, t2) = foldl walk (0, 0, [], []) cmds in (reverse t1, reverse t2)
+        walk (lc, cc, tbl1, tbl2) (PTCommand _ ) = (lc, cc + 1, ("#10"):tbl1, (show $ -10 - cc):(tbl2))
+        walk lct (PTPrefix prefix cmds) = foldl walk (foldl fpf lct prefix) cmds
+        fpf (lc, cc, tbl1, tbl2) c = (lc + 1, cc, [c]:tbl1, (show lc):tbl2)
+
 main = putStrLn $ render pas