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