128 consumePrefix "" = id |
128 consumePrefix "" = id |
129 consumePrefix str = (text "consume" <> (parens . quotes $ text str) <> semi $$) |
129 consumePrefix str = (text "consume" <> (parens . quotes $ text str) <> semi $$) |
130 zeroChar = text "#0: state:= pstDisconnected;" |
130 zeroChar = text "#0: state:= pstDisconnected;" |
131 elsePart = text "else <unknown cmd> end;" |
131 elsePart = text "else <unknown cmd> end;" |
132 |
132 |
133 renderArrays (letters, commands, handlers) = vcat $ punctuate (char '\n') [cmds, l, s, bodies, c, structs] |
133 renderArrays (letters, commands, handlers) = vcat $ punctuate (char '\n') [cmds, l, s, {-bodies, -}c, structs, realHandlers] |
134 where |
134 where |
135 maybeQuotes "$" = text "#0" |
135 maybeQuotes "$" = text "#0" |
136 maybeQuotes s = if null $ tail s then quotes $ text s else text s |
136 maybeQuotes s = if null $ tail s then quotes $ text s else text s |
137 l = text "const letters: array[0.." <> (int $ length letters - 1) <> text "] of char = " |
137 l = text "const letters: array[0.." <> (int $ length letters - 1) <> text "] of char = " |
138 <> parens (hsep . punctuate comma $ map maybeQuotes letters) <> semi |
138 <> parens (hsep . punctuate comma $ map maybeQuotes letters) <> semi |
139 s = text "const commands: array[0.." <> (int $ length commands - 1) <> text "] of integer = " |
139 s = text "const commands: array[0.." <> (int $ length commands - 1) <> text "] of integer = " |
140 <> parens (hsep . punctuate comma $ map text commands) <> semi |
140 <> parens (hsep . punctuate comma $ map text commands) <> semi |
141 c = text "const handlers: array[0.." <> (int $ length fixedNames - 1) <> text "] of PHandler = " |
141 c = text "const handlers: array[0.." <> (int $ length fixedNames - 1) <> text "] of PHandler = " |
142 <> parens (hsep . punctuate comma $ map (text . (:) '@') handlerTypes) <> semi |
142 <> parens (hsep . punctuate comma $ map (text . (:) '@') handlerTypes) <> semi |
143 handlerTypes = map cmdParams2handlerType . reverse $ sort commandsDescription |
143 handlerTypes = map cmdParams2handlerType sortedCmdDescriptions |
|
144 sortedCmdDescriptions = reverse $ sort commandsDescription |
144 fixedNames = map fixName handlers |
145 fixedNames = map fixName handlers |
145 fixName = map fixChar |
146 fixName = map fixChar |
146 fixChar c | isLetter c = c |
147 fixChar c | isLetter c = c |
147 | otherwise = '_' |
148 | otherwise = '_' |
148 bodies = vcat $ punctuate (char '\n') $ map handlerBody fixedNames |
149 bodies = vcat $ punctuate (char '\n') $ map handlerBody fixedNames |
149 handlerBody n = text "procedure handler_" <> text n <> semi |
150 handlerBody n = text "procedure handler_" <> text n <> semi |
150 $+$ text "begin" |
151 $+$ text "begin" |
151 $+$ text "end" <> semi |
152 $+$ text "end" <> semi |
152 cmds = text "type TCmdType = " <> parens (hsep $ punctuate comma $ map ((<>) (text "cmd_") . text) $ reverse fixedNames) <> semi |
153 cmds = text "type TCmdType = " <> parens (hsep $ punctuate comma $ map ((<>) (text "cmd_") . text) $ reverse fixedNames) <> semi |
153 structs = vcat (map text . Set.toList . Set.fromList $ map cmdParams2record commandsDescription) |
154 structs = vcat (map text . Set.toList . Set.fromList $ map cmdParams2record commandsDescription) |
|
155 realHandlers = vcat $ punctuate (char '\n') $ map rh sortedCmdDescriptions |
|
156 rh cmd@(Command n _) = text "procedure handler_" <> text (fixName n) <> parens (text "var p: " <> text (cmdParams2str cmd)) <> semi |
|
157 $+$ text "begin" |
|
158 $+$ text "end" <> semi |
154 |
159 |
155 pas = renderArrays $ buildTables $ buildParseTree commandsDescription |
160 pas = renderArrays $ buildTables $ buildParseTree commandsDescription |
156 where |
161 where |
157 buildTables cmds = let (_, _, _, t1, t2, t3) = foldr walk (0, [0], -10, [], [], [[]]) cmds in (tail t1, tail t2, concat t3) |
162 buildTables cmds = let (_, _, _, t1, t2, t3) = foldr walk (0, [0], -10, [], [], [[]]) cmds in (tail t1, tail t2, concat t3) |
158 walk (PTCommand _ (Command n params)) (lc, s:sh, pc, tbl1, tbl2, (t3:tbl3)) = |
163 walk (PTCommand _ (Command n params)) (lc, s:sh, pc, tbl1, tbl2, (t3:tbl3)) = |