1-- -----------------------------------------------------------------------------
2-- ALEX TEMPLATE
3--
4-- This code is in the PUBLIC DOMAIN; you may copy it freely and use
5-- it for any purpose whatsoever.
6
7-- -----------------------------------------------------------------------------
8-- INTERNALS and main scanner engine
9
10#ifdef ALEX_GHC
11#undef __GLASGOW_HASKELL__
12#define ALEX_IF_GHC_GT_500 #if __GLASGOW_HASKELL__ > 500
13#define ALEX_IF_GHC_LT_503 #if __GLASGOW_HASKELL__ < 503
14#define ALEX_IF_GHC_GT_706 #if __GLASGOW_HASKELL__ > 706
15#define ALEX_IF_GHC_GE_901 #if __GLASGOW_HASKELL__ >= 901
16#define ALEX_ELIF_GHC_500 #elif __GLASGOW_HASKELL__ == 500
17#define ALEX_IF_BIGENDIAN #ifdef WORDS_BIGENDIAN
18#define ALEX_ELSE #else
19#define ALEX_ENDIF #endif
20#define ALEX_DEFINE #define
21#endif
22
23#ifdef ALEX_GHC
24#define ILIT(n) n#
25#define IBOX(n) (I# (n))
26#define FAST_INT Int#
27-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.
28ALEX_IF_GHC_GT_706
29ALEX_DEFINE GTE(n,m) (tagToEnum# (n >=# m))
30ALEX_DEFINE EQ(n,m) (tagToEnum# (n ==# m))
31ALEX_ELSE
32ALEX_DEFINE GTE(n,m) (n >=# m)
33ALEX_DEFINE EQ(n,m) (n ==# m)
34ALEX_ENDIF
35#define PLUS(n,m) (n +# m)
36#define MINUS(n,m) (n -# m)
37#define TIMES(n,m) (n *# m)
38#define NEGATE(n) (negateInt# (n))
39#define IF_GHC(x) (x)
40#else
41#define ILIT(n) (n)
42#define IBOX(n) (n)
43#define FAST_INT Int
44#define GTE(n,m) (n >= m)
45#define EQ(n,m) (n == m)
46#define PLUS(n,m) (n + m)
47#define MINUS(n,m) (n - m)
48#define TIMES(n,m) (n * m)
49#define NEGATE(n) (negate (n))
50#define IF_GHC(x)
51#endif
52
53#ifdef ALEX_GHC
54data AlexAddr = AlexA# Addr#
55-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.
56ALEX_IF_GHC_LT_503
57uncheckedShiftL# = shiftL#
58ALEX_ENDIF
59
60{-# INLINE alexIndexInt16OffAddr #-}
61alexIndexInt16OffAddr :: AlexAddr -> Int# -> Int#
62alexIndexInt16OffAddr (AlexA# arr) off =
63ALEX_IF_BIGENDIAN
64  narrow16Int# i
65  where
66        i    = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)
67        high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))
68        low  = int2Word# (ord# (indexCharOffAddr# arr off'))
69        off' = off *# 2#
70ALEX_ELSE
71ALEX_IF_GHC_GE_901
72  int16ToInt#
73ALEX_ENDIF
74    (indexInt16OffAddr# arr off)
75ALEX_ENDIF
76#else
77alexIndexInt16OffAddr arr off = arr ! off
78#endif
79
80#ifdef ALEX_GHC
81{-# INLINE alexIndexInt32OffAddr #-}
82alexIndexInt32OffAddr :: AlexAddr -> Int# -> Int#
83alexIndexInt32OffAddr (AlexA# arr) off =
84ALEX_IF_BIGENDIAN
85  narrow32Int# i
86  where
87   i    = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#`
88                     (b2 `uncheckedShiftL#` 16#) `or#`
89                     (b1 `uncheckedShiftL#` 8#) `or#` b0)
90   b3   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#)))
91   b2   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#)))
92   b1   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))
93   b0   = int2Word# (ord# (indexCharOffAddr# arr off'))
94   off' = off *# 4#
95ALEX_ELSE
96ALEX_IF_GHC_GE_901
97  int32ToInt#
98ALEX_ENDIF
99    (indexInt32OffAddr# arr off)
100ALEX_ENDIF
101#else
102alexIndexInt32OffAddr arr off = arr ! off
103#endif
104
105#ifdef ALEX_GHC
106
107ALEX_IF_GHC_LT_503
108quickIndex arr i = arr ! i
109ALEX_ELSE
110-- GHC >= 503, unsafeAt is available from Data.Array.Base.
111quickIndex = unsafeAt
112ALEX_ENDIF
113#else
114quickIndex arr i = arr ! i
115#endif
116
117-- -----------------------------------------------------------------------------
118-- Main lexing routines
119
120data AlexReturn a
121  = AlexEOF
122  | AlexError  !AlexInput
123  | AlexSkip   !AlexInput !Int
124  | AlexToken  !AlexInput !Int a
125
126-- alexScan :: AlexInput -> StartCode -> AlexReturn a
127alexScan input__ IBOX(sc)
128  = alexScanUser undefined input__ IBOX(sc)
129
130alexScanUser user__ input__ IBOX(sc)
131  = case alex_scan_tkn user__ input__ ILIT(0) input__ sc AlexNone of
132  (AlexNone, input__') ->
133    case alexGetByte input__ of
134      Nothing ->
135#ifdef ALEX_DEBUG
136                                   trace ("End of input.") $
137#endif
138                                   AlexEOF
139      Just _ ->
140#ifdef ALEX_DEBUG
141                                   trace ("Error.") $
142#endif
143                                   AlexError input__'
144
145  (AlexLastSkip input__'' len, _) ->
146#ifdef ALEX_DEBUG
147    trace ("Skipping.") $
148#endif
149    AlexSkip input__'' len
150
151  (AlexLastAcc k input__''' len, _) ->
152#ifdef ALEX_DEBUG
153    trace ("Accept.") $
154#endif
155    AlexToken input__''' len (alex_actions ! k)
156
157
158-- Push the input through the DFA, remembering the most recent accepting
159-- state it encountered.
160
161alex_scan_tkn user__ orig_input len input__ s last_acc =
162  input__ `seq` -- strict in the input
163  let
164  new_acc = (check_accs (alex_accept `quickIndex` IBOX(s)))
165  in
166  new_acc `seq`
167  case alexGetByte input__ of
168     Nothing -> (new_acc, input__)
169     Just (c, new_input) ->
170#ifdef ALEX_DEBUG
171      trace ("State: " ++ show IBOX(s) ++ ", char: " ++ show c) $
172#endif
173      case fromIntegral c of { IBOX(ord_c) ->
174        let
175                base   = alexIndexInt32OffAddr alex_base s
176                offset = PLUS(base,ord_c)
177                check  = alexIndexInt16OffAddr alex_check offset
178
179                new_s = if GTE(offset,ILIT(0)) && EQ(check,ord_c)
180                          then alexIndexInt16OffAddr alex_table offset
181                          else alexIndexInt16OffAddr alex_deflt s
182        in
183        case new_s of
184            ILIT(-1) -> (new_acc, input__)
185                -- on an error, we want to keep the input *before* the
186                -- character that failed, not after.
187            _ -> alex_scan_tkn user__ orig_input (if c < 0x80 || c >= 0xC0 then PLUS(len,ILIT(1)) else len)
188                                                -- note that the length is increased ONLY if this is the 1st byte in a char encoding)
189                        new_input new_s new_acc
190      }
191  where
192        check_accs (AlexAccNone) = last_acc
193        check_accs (AlexAcc a  ) = AlexLastAcc a input__ IBOX(len)
194        check_accs (AlexAccSkip) = AlexLastSkip  input__ IBOX(len)
195#ifndef ALEX_NOPRED
196        check_accs (AlexAccPred a predx rest)
197           | predx user__ orig_input IBOX(len) input__
198           = AlexLastAcc a input__ IBOX(len)
199           | otherwise
200           = check_accs rest
201        check_accs (AlexAccSkipPred predx rest)
202           | predx user__ orig_input IBOX(len) input__
203           = AlexLastSkip input__ IBOX(len)
204           | otherwise
205           = check_accs rest
206#endif
207
208data AlexLastAcc
209  = AlexNone
210  | AlexLastAcc !Int !AlexInput !Int
211  | AlexLastSkip     !AlexInput !Int
212
213data AlexAcc user
214  = AlexAccNone
215  | AlexAcc Int
216  | AlexAccSkip
217#ifndef ALEX_NOPRED
218  | AlexAccPred Int (AlexAccPred user) (AlexAcc user)
219  | AlexAccSkipPred (AlexAccPred user) (AlexAcc user)
220
221type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool
222
223-- -----------------------------------------------------------------------------
224-- Predicates on a rule
225
226alexAndPred p1 p2 user__ in1 len in2
227  = p1 user__ in1 len in2 && p2 user__ in1 len in2
228
229--alexPrevCharIsPred :: Char -> AlexAccPred _
230alexPrevCharIs c _ input__ _ _ = c == alexInputPrevChar input__
231
232alexPrevCharMatches f _ input__ _ _ = f (alexInputPrevChar input__)
233
234--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _
235alexPrevCharIsOneOf arr _ input__ _ _ = arr ! alexInputPrevChar input__
236
237--alexRightContext :: Int -> AlexAccPred _
238alexRightContext IBOX(sc) user__ _ _ input__ =
239     case alex_scan_tkn user__ input__ ILIT(0) input__ sc AlexNone of
240          (AlexNone, _) -> False
241          _ -> True
242        -- TODO: there's no need to find the longest
243        -- match when checking the right context, just
244        -- the first match will do.
245#endif
246