Skip to content

Commit c6c8870

Browse files
simonmarsimonmar
authored
Merge pull request #134 from josephcsible/mergemonads
Merge common code between ALEX_MONAD and ALEX_MONAD_BYTESTRING
2 parents a4f43f8 + 4de7cd8 commit c6c8870

File tree

1 file changed

+47
-112
lines changed

1 file changed

+47
-112
lines changed

‎templates/wrappers.hs

Lines changed: 47 additions & 112 deletions
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,6 @@
66

77
#if defined(ALEX_MONAD) || defined(ALEX_MONAD_BYTESTRING)
88
import Control.Applicative as App (Applicative (..))
9-
import qualified Control.Monad (ap)
109
#endif
1110

1211
import Data.Word (Word8)
@@ -160,14 +159,20 @@ alexMove (AlexPn a l c) _ = AlexPn (a+1) l (c+1)
160159
#endif
161160

162161
-- -----------------------------------------------------------------------------
163-
-- Default monad
162+
-- Monad (default and with ByteString input)
164163

165-
#ifdef ALEX_MONAD
164+
#if defined(ALEX_MONAD) || defined(ALEX_MONAD_BYTESTRING)
166165
data AlexState = AlexState {
167166
alex_pos :: !AlexPosn, -- position at current input location
167+
#ifndef ALEX_MONAD_BYTESTRING
168168
alex_inp :: String, -- the current input
169169
alex_chr :: !Char, -- the character before the input
170170
alex_bytes :: [Byte],
171+
#else /* ALEX_MONAD_BYTESTRING */
172+
alex_bpos:: !Int64, -- bytes consumed so far
173+
alex_inp :: ByteString.ByteString, -- the current input
174+
alex_chr :: !Char, -- the character before the input
175+
#endif /* ALEX_MONAD_BYTESTRING */
171176
alex_scd :: !Int -- the current startcode
172177
#ifdef ALEX_MONAD_USER_STATE
173178
, alex_ust :: AlexUserState -- AlexUserState will be defined in the user program
@@ -176,12 +181,18 @@ data AlexState = AlexState {
176181

177182
-- Compile with -funbox-strict-fields for best results!
178183

184+
#ifndef ALEX_MONAD_BYTESTRING
179185
runAlex :: String -> Alex a -> Either String a
180186
runAlex input__ (Alex f)
181-
= case f (AlexState {alex_pos = alexStartPos,
187+
= case f (AlexState {alex_bytes = [],
188+
#else /* ALEX_MONAD_BYTESTRING */
189+
runAlex :: ByteString.ByteString -> Alex a -> Either String a
190+
runAlex input__ (Alex f)
191+
= case f (AlexState {alex_bpos = 0,
192+
#endif /* ALEX_MONAD_BYTESTRING */
193+
alex_pos = alexStartPos,
182194
alex_inp = input__,
183195
alex_chr = '\n',
184-
alex_bytes = [],
185196
#ifdef ALEX_MONAD_USER_STATE
186197
alex_ust = alexInitUserState,
187198
#endif
@@ -211,12 +222,25 @@ instance Monad Alex where
211222

212223
alexGetInput :: Alex AlexInput
213224
alexGetInput
225+
#ifndef ALEX_MONAD_BYTESTRING
214226
= Alex $ \s@AlexState{alex_pos=pos,alex_chr=c,alex_bytes=bs,alex_inp=inp__} ->
215227
Right (s, (pos,c,bs,inp__))
228+
#else /* ALEX_MONAD_BYTESTRING */
229+
= Alex $ \s@AlexState{alex_pos=pos,alex_bpos=bpos,alex_chr=c,alex_inp=inp__} ->
230+
Right (s, (pos,c,inp__,bpos))
231+
#endif /* ALEX_MONAD_BYTESTRING */
216232

217233
alexSetInput :: AlexInput -> Alex ()
234+
#ifndef ALEX_MONAD_BYTESTRING
218235
alexSetInput (pos,c,bs,inp__)
219236
= Alex $ \s -> case s{alex_pos=pos,alex_chr=c,alex_bytes=bs,alex_inp=inp__} of
237+
#else /* ALEX_MONAD_BYTESTRING */
238+
alexSetInput (pos,c,inp__,bpos)
239+
= Alex $ \s -> case s{alex_pos=pos,
240+
alex_bpos=bpos,
241+
alex_chr=c,
242+
alex_inp=inp__} of
243+
#endif /* ALEX_MONAD_BYTESTRING */
220244
state__@(AlexState{}) -> Right (state__, ())
221245

222246
alexError :: String -> Alex a
@@ -228,136 +252,43 @@ alexGetStartCode = Alex $ \s@AlexState{alex_scd=sc} -> Right (s, sc)
228252
alexSetStartCode :: Int -> Alex ()
229253
alexSetStartCode sc = Alex $ \s -> Right (s{alex_scd=sc}, ())
230254

231-
#ifdef ALEX_MONAD_USER_STATE
255+
#if !defined(ALEX_MONAD_BYTESTRING) && defined(ALEX_MONAD_USER_STATE)
232256
alexGetUserState :: Alex AlexUserState
233257
alexGetUserState = Alex $ \s@AlexState{alex_ust=ust} -> Right (s,ust)
234258

235259
alexSetUserState :: AlexUserState -> Alex ()
236260
alexSetUserState ss = Alex $ \s -> Right (s{alex_ust=ss}, ())
237-
#endif
261+
#endif /* !defined(ALEX_MONAD_BYTESTRING) && defined(ALEX_MONAD_USER_STATE) */
238262

239263
alexMonadScan = do
264+
#ifndef ALEX_MONAD_BYTESTRING
240265
inp__ <- alexGetInput
266+
#else /* ALEX_MONAD_BYTESTRING */
267+
inp__@(_,_,_,n) <- alexGetInput
268+
#endif /* ALEX_MONAD_BYTESTRING */
241269
sc <- alexGetStartCode
242270
case alexScan inp__ sc of
243271
AlexEOF -> alexEOF
244272
AlexError ((AlexPn _ line column),_,_,_) -> alexError $ "lexical error at line " ++ (show line) ++ ", column " ++ (show column)
245273
AlexSkip inp__' _len -> do
246274
alexSetInput inp__'
247275
alexMonadScan
276+
#ifndef ALEX_MONAD_BYTESTRING
248277
AlexToken inp__' len action -> do
278+
#else /* ALEX_MONAD_BYTESTRING */
279+
AlexToken inp__'@(_,_,_,n') _ action -> let len = n'-n in do
280+
#endif /* ALEX_MONAD_BYTESTRING */
249281
alexSetInput inp__'
250282
action (ignorePendingBytes inp__) len
251283

252284
-- -----------------------------------------------------------------------------
253285
-- Useful token actions
254286

287+
#ifndef ALEX_MONAD_BYTESTRING
255288
type AlexAction result = AlexInput -> Int -> Alex result
256-
257-
-- just ignore this token and scan another one
258-
-- skip :: AlexAction result
259-
skip _input _len = alexMonadScan
260-
261-
-- ignore this token, but set the start code to a new value
262-
-- begin :: Int -> AlexAction result
263-
begin code _input _len = do alexSetStartCode code; alexMonadScan
264-
265-
-- perform an action for this token, and set the start code to a new value
266-
andBegin :: AlexAction result -> Int -> AlexAction result
267-
(action `andBegin` code) input__ len = do
268-
alexSetStartCode code
269-
action input__ len
270-
271-
token :: (AlexInput -> Int -> token) -> AlexAction token
272-
token t input__ len = return (t input__ len)
273-
#endif /* ALEX_MONAD */
274-
275-
276-
-- -----------------------------------------------------------------------------
277-
-- Monad (with ByteString input)
278-
279-
#ifdef ALEX_MONAD_BYTESTRING
280-
data AlexState = AlexState {
281-
alex_pos :: !AlexPosn, -- position at current input location
282-
alex_bpos:: !Int64, -- bytes consumed so far
283-
alex_inp :: ByteString.ByteString, -- the current input
284-
alex_chr :: !Char, -- the character before the input
285-
alex_scd :: !Int -- the current startcode
286-
#ifdef ALEX_MONAD_USER_STATE
287-
, alex_ust :: AlexUserState -- AlexUserState will be defined in the user program
288-
#endif
289-
}
290-
291-
-- Compile with -funbox-strict-fields for best results!
292-
293-
runAlex :: ByteString.ByteString -> Alex a -> Either String a
294-
runAlex input__ (Alex f)
295-
= case f (AlexState {alex_pos = alexStartPos,
296-
alex_bpos = 0,
297-
alex_inp = input__,
298-
alex_chr = '\n',
299-
#ifdef ALEX_MONAD_USER_STATE
300-
alex_ust = alexInitUserState,
301-
#endif
302-
alex_scd = 0}) of Left msg -> Left msg
303-
Right ( _, a ) -> Right a
304-
305-
newtype Alex a = Alex { unAlex :: AlexState -> Either String (AlexState, a) }
306-
307-
instance Functor Alex where
308-
fmap f m = do x <- m; return (f x)
309-
310-
instance Applicative Alex where
311-
pure a = Alex $ \s -> Right (s,a)
312-
(<*>) = Control.Monad.ap
313-
314-
instance Monad Alex where
315-
m >>= k = Alex $ \s -> case unAlex m s of
316-
Left msg -> Left msg
317-
Right (s',a) -> unAlex (k a) s'
318-
return = App.pure
319-
320-
alexGetInput :: Alex AlexInput
321-
alexGetInput
322-
= Alex $ \s@AlexState{alex_pos=pos,alex_bpos=bpos,alex_chr=c,alex_inp=inp__} ->
323-
Right (s, (pos,c,inp__,bpos))
324-
325-
alexSetInput :: AlexInput -> Alex ()
326-
alexSetInput (pos,c,inp__,bpos)
327-
= Alex $ \s -> case s{alex_pos=pos,
328-
alex_bpos=bpos,
329-
alex_chr=c,
330-
alex_inp=inp__} of
331-
state__@(AlexState{}) -> Right (state__, ())
332-
333-
alexError :: String -> Alex a
334-
alexError message = Alex $ const $ Left message
335-
336-
alexGetStartCode :: Alex Int
337-
alexGetStartCode = Alex $ \s@AlexState{alex_scd=sc} -> Right (s, sc)
338-
339-
alexSetStartCode :: Int -> Alex ()
340-
alexSetStartCode sc = Alex $ \s -> Right (s{alex_scd=sc}, ())
341-
342-
alexMonadScan = do
343-
inp__@(_,_,_,n) <- alexGetInput
344-
sc <- alexGetStartCode
345-
case alexScan inp__ sc of
346-
AlexEOF -> alexEOF
347-
AlexError ((AlexPn _ line column),_,_,_) -> alexError $ "lexical error at line " ++ (show line) ++ ", column " ++ (show column)
348-
AlexSkip inp__' _len -> do
349-
alexSetInput inp__'
350-
alexMonadScan
351-
AlexToken inp__'@(_,_,_,n') _ action -> do
352-
alexSetInput inp__'
353-
action (ignorePendingBytes inp__) len
354-
where
355-
len = n'-n
356-
357-
-- -----------------------------------------------------------------------------
358-
-- Useful token actions
359-
289+
#else /* ALEX_MONAD_BYTESTRING */
360290
type AlexAction result = AlexInput -> Int64 -> Alex result
291+
#endif /* ALEX_MONAD_BYTESTRING */
361292

362293
-- just ignore this token and scan another one
363294
-- skip :: AlexAction result
@@ -373,9 +304,13 @@ andBegin :: AlexAction result -> Int -> AlexAction result
373304
alexSetStartCode code
374305
action input__ len
375306

307+
#ifndef ALEX_MONAD_BYTESTRING
308+
token :: (AlexInput -> Int -> token) -> AlexAction token
309+
#else /* ALEX_MONAD_BYTESTRING */
376310
token :: (AlexInput -> Int64 -> token) -> AlexAction token
377-
token t input__ len = return (t input__ len)
378311
#endif /* ALEX_MONAD_BYTESTRING */
312+
token t input__ len = return (t input__ len)
313+
#endif /* defined(ALEX_MONAD) || defined(ALEX_MONAD_BYTESTRING) */
379314

380315

381316
-- -----------------------------------------------------------------------------

0 commit comments

Comments
 (0)