tools/protocolParser.hs
branchqmlfrontend
changeset 11413 ffff8a0d1a76
parent 11076 fcbdee9cdd74
child 11417 4815e406a760
--- a/tools/protocolParser.hs	Mon Nov 16 22:57:24 2015 +0300
+++ b/tools/protocolParser.hs	Wed Nov 18 22:18:39 2015 +0300
@@ -96,7 +96,12 @@
         , cmd "ROUND_FINISHED" []
     ]
 
-unknowncmd = PTPrefix "$" [PTCommand "$" $ Command "__UNKNOWN__" [Many [SS]]]
+hasMany = any isMany
+isMany (Many _) = True
+isMany _ = False
+
+unknown = Command "__UNKNOWN__" [Many [SS]]
+unknowncmd = PTPrefix "$" [PTCommand "$" $ unknown]
 
 fixName = map fixChar
 fixChar c | isLetter c = c
@@ -135,7 +140,7 @@
         zeroChar = text "#0: state:= pstDisconnected;"
         elsePart = text "else <unknown cmd> end;"
 
-renderArrays (letters, commands, handlers) = vcat $ punctuate (char '\n') [cmds, l, s, {-bodies, -}c, structs, realHandlers, realHandlersArray]
+renderArrays (letters, commands, handlers) = vcat $ punctuate (char '\n') [grr, cmds, l, s, c, bodies, structs, realHandlers, realHandlersArray]
     where
         maybeQuotes "$" = text "#0"
         maybeQuotes s = if null $ tail s then quotes $ text s else text s
@@ -145,28 +150,30 @@
             <> parens (hsep . punctuate comma $ map text commands) <> semi
         c = text "const handlers: array[0.." <> (int $ length fixedNames - 1) <> text "] of PHandler = "
             <> parens (hsep . punctuate comma $ map (text . (:) '@') handlerTypes) <> semi
-        handlerTypes = map cmdParams2handlerType sortedCmdDescriptions
-        sortedCmdDescriptions = reverse $ sort commandsDescription
+        grr = text "const net2cmd: array[0.." <> (int $ length fixedNames - 1) <> text "] of TCmdType = "
+            <> parens (hsep . punctuate comma $ map (text . (++) "cmd_") $ reverse fixedNames) <> semi
+        handlerTypes = map cmdParams2handlerType $ reverse sortedCmdDescriptions
+        sortedCmdDescriptions = sort commandsDescription
         fixedNames = map fixName handlers
-        bodies = vcat $ punctuate (char '\n') $ map handlerBody fixedNames
-        handlerBody n = text "procedure handler_" <> text n <> semi
+        bodies = vcat $ punctuate (char '\n') $ map handlerBody $ nub $ sort handlerTypes
+        handlerBody n = text "procedure " <> text n <> semi
             $+$ text "begin" 
             $+$ text "end" <> semi
-        cmds = text "type TCmdType = " <> parens (hsep $ punctuate comma $ map ((<>) (text "cmd_") . text) $ reverse fixedNames) <> semi
+        cmds = text "type TCmdType = " <> parens (hsep $ punctuate comma $ concatMap (rhentry "cmd_") $ sortedCmdDescriptions) <> semi
         structs = vcat (map text . Set.toList . Set.fromList $ map cmdParams2record commandsDescription)
-        realHandlers = vcat $ punctuate (char '\n') $ map rh sortedCmdDescriptions
+        realHandlers = vcat $ punctuate (char '\n') $ map rh $ sortedCmdDescriptions
         realHandlersArray = text "const handlers: array[TCmdType] of PHandler = "
-            <> parens (hsep . punctuate comma . (:) (text "@handler__UNKNOWN_") $ map (text . (++) "@handler_" . fixName . cmdName) sortedCmdDescriptions) <> semi
+            <> parens (hsep . punctuate comma . concatMap (rhentry "@handler_") $ sortedCmdDescriptions) <> semi
 
 rh cmd@(Command n p) = text "procedure handler_" <> text (fixName n) <> parens (text "var p: " <> text (cmdParams2str cmd)) <> semi
-    $+$ emptyBody $+$ if hasMany then vcat [space, text "procedure handler_" <> text (fixName n) <> text "_s" <> parens (text "var s: shortstring") <> semi
+    $+$ emptyBody $+$ if hasMany p then vcat [space, text "procedure handler_" <> text (fixName n) <> text "_s" <> parens (text "var s: TCmdParamS") <> semi
     , emptyBody] else empty
     where
-        hasMany = any isMany p
-        isMany (Many _) = True
-        isMany _ = False
         emptyBody = text "begin"  $+$ text "end" <> semi
 
+rhentry prefix cmd@(Command n p) = map ((<>) (text "PHandler") . parens) $ (text . (++) prefix . fixName . cmdName $ cmd)
+    : if hasMany p then [text . flip (++) "_s" . (++) prefix . fixName . cmdName $ cmd] else []
+
 pas = renderArrays $ buildTables $ buildParseTree commandsDescription
     where
         buildTables cmds = let (_, _, _, t1, t2, t3) = foldr walk (0, [0], -10, [], [], [[]]) cmds in (tail t1, tail t2, concat t3)