1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
|
-- Generated by re2hs
{-# LANGUAGE RecordWildCards #-}
-- re2hs $INPUT -o $OUTPUT -fi
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
{-# LANGUAGE OverloadedStrings #-}
import Control.Concurrent.Chan
import Control.Monad
import Data.ByteString as BS
import Text.Printf
debug :: IO () -> IO ()
debug = when False
data State = State {
_pipe :: !(Chan BS.ByteString),
_yyinput :: !BS.ByteString,
_yycursor :: !Int,
_yymarker :: !Int,
_yylimit :: !Int,
_token :: !Int,
_eof :: !Bool,
_yystate :: !Int,
_recv :: !Int
}
data Status = End | Ready | Waiting | BadPacket deriving (Eq)
yy0 :: State -> IO (State, Status)
yy0 !State{..} = do
yych <- return $ BS.index _yyinput _yycursor
case yych of
_c | 0x61 <= _c && _c <= 0x7A -> do
_yycursor <- return $ _yycursor + 1
yy3 State{..}
_c | True -> do
if _yycursor >= _yylimit then do
let _yystate = 0
return (State{..}, Waiting)
else do
_yycursor <- return $ _yycursor + 1
yy1 State{..}
yy1 :: State -> IO (State, Status)
yy1 !State{..} = do
yy2 State{..}
yy2 :: State -> IO (State, Status)
yy2 !State{..} = do
let _yystate = -1
return (State{..}, BadPacket)
yy3 :: State -> IO (State, Status)
yy3 !State{..} = do
let _yymarker = _yycursor
yych <- return $ BS.index _yyinput _yycursor
case yych of
_c | 0x3B == _c -> do
_yycursor <- return $ _yycursor + 1
yy4 State{..}
_c | 0x61 <= _c && _c <= 0x7A -> do
_yycursor <- return $ _yycursor + 1
yy5 State{..}
_c | True -> do
if _yycursor >= _yylimit then do
let _yystate = 1
return (State{..}, Waiting)
else do
yy2 State{..}
yy4 :: State -> IO (State, Status)
yy4 !State{..} = do
let _yystate = -1
lexer State{_token = _yycursor, _recv = _recv + 1, ..}
yy5 :: State -> IO (State, Status)
yy5 !State{..} = do
yych <- return $ BS.index _yyinput _yycursor
case yych of
_c | 0x3B == _c -> do
_yycursor <- return $ _yycursor + 1
yy4 State{..}
_c | 0x61 <= _c && _c <= 0x7A -> do
_yycursor <- return $ _yycursor + 1
yy5 State{..}
_c | True -> do
if _yycursor >= _yylimit then do
let _yystate = 2
return (State{..}, Waiting)
else do
yy6 State{..}
yy6 :: State -> IO (State, Status)
yy6 !State{..} = do
let _yycursor = _yymarker
yy2 State{..}
yy7 :: State -> IO (State, Status)
yy7 !State{..} = do
let _yystate = -1
return (State{..}, End)
lexer :: State -> IO (State, Status)
lexer !State{..} = do
case _yystate of
_c | -1 == _c -> do
yy0 State{..}
_c | 0 == _c -> do
if _yycursor >= _yylimit then yy7 State{..}
else yy0 State{..}
_c | 1 == _c -> do
if _yycursor >= _yylimit then yy2 State{..}
else yy3 State{..}
_c | 2 == _c -> do
if _yycursor >= _yylimit then yy6 State{..}
else yy5 State{..}
_c | True -> do
error "internal lexer error"
fill :: State -> IO (State, Status)
fill st@State{..} = do
case _eof of
True -> return (st, End)
False -> do
-- Discard everything up to the current token, cut off terminating null,
-- read new chunk from file and reappend terminating null at the end.
chunk <- readChan _pipe
return (State {
_yyinput = BS.concat [(BS.init . BS.drop _token) _yyinput, chunk, "\0"],
_yycursor = _yycursor - _token,
_yymarker = _yymarker - _token,
_yylimit = _yylimit - _token + BS.length chunk, -- exclude terminating null
_token = 0,
_eof = BS.null chunk, -- end of file?
..}, Ready)
loop :: State -> [BS.ByteString] -> IO Status
loop State{..} packets = do
(State{..}, status) <- lexer State{..}
case status of
End -> do
debug $ printf "done: got %d packets\n" _recv
return End
Waiting -> do
debug $ printf "waiting...\n"
packets' <- case packets of
[] -> do
writeChan _pipe BS.empty
return []
p:ps -> do
debug $ printf "sent packet '%s'\n" (show p)
writeChan _pipe p
return ps
(State{..}, status') <- fill State{..}
case status' of
Ready -> loop State{..} packets'
_ -> error "unexpected status after fill"
BadPacket -> do
debug $ printf "error: ill-formed packet\n"
return BadPacket
_ -> error "unexpected status"
test :: [BS.ByteString] -> Status -> IO ()
test packets expect = do
pipe <- newChan -- emulate pipe using a chan of bytestrings
let st = State {
_pipe = pipe,
_yyinput = BS.singleton 0, -- null sentinel triggers YYFILL
_yycursor = 0,
_yymarker = 0,
_token = 0,
_yylimit = 0,
_eof = False,
_yystate = -1,
_recv = 0
}
status <- loop st packets
when (status /= expect) $ error "failed"
return ()
main :: IO ()
main = do
test [] End
test ["ze", "ro;o", "ne", ";t", "wo;thr", "e", "e", ";", "four;"] End
test ["zer0;"] BadPacket
|
