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