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