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