tools/protocolParser.hs
branchqmlfrontend
changeset 11419 8a5cc31483c6
parent 11417 4815e406a760
child 11425 2947f06e8533
--- a/tools/protocolParser.hs	Fri Nov 20 23:56:13 2015 +0300
+++ b/tools/protocolParser.hs	Sat Nov 21 00:42:11 2015 +0300
@@ -120,10 +120,14 @@
         emptyNamed = partition (\(_, (PTCommand n _:_)) -> null n) assocs
         assocs = groupByFirstChar cmds
         subtree = map buildsub assocs
+        buildsub :: (Char, [ParseTree]) -> ParseTree
         buildsub (c, cmds) = let st = bpt cmds in if null $ drop 1 st then maybeMerge c st else PTPrefix [c] st
         maybeMerge c cmd@[PTCommand {}] = PTPrefix [c] cmd
         maybeMerge c cmd@[PTPrefix s ss] = PTPrefix (c:s) ss
-        cmdLeaf ([(c, (hwc:assocs1))], assocs2) = (PTPrefix [c] [hwc]) : (bpt assocs1 ++ map buildsub assocs2)
+        maybeMerge c [] = PTPrefix [c] []
+        cmdLeaf ([(c, hwc:assocs1)], assocs2)
+            | null assocs1 = PTPrefix [c] [hwc] : map buildsub assocs2
+            | otherwise = [buildsub (c, assocs1)] ++ [PTPrefix [] [hwc]] ++ map buildsub assocs2
 
 dumpTree = vcat . map dt
     where