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