{-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- -- ALEX TEMPLATE -- -- This code is in the PUBLIC DOMAIN; you may copy it freely and use -- it for any purpose whatsoever. -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine alexIndexInt16OffAddr arr off = arr ! off alexIndexInt32OffAddr arr off = arr ! off quickIndex arr i = arr ! i -- ----------------------------------------------------------------------------- -- Main lexing routines data AlexReturn a = AlexEOF | AlexError !AlexInput | AlexSkip !AlexInput !Int | AlexToken !AlexInput !Int a -- alexScan :: AlexInput -> StartCode -> AlexReturn a alexScan input__ (sc) = alexScanUser undefined input__ (sc) alexScanUser user__ input__ (sc) = case alex_scan_tkn user__ input__ (0) input__ sc AlexNone of (AlexNone, input__') -> case alexGetByte input__ of Nothing -> trace ("End of input.") $ AlexEOF Just _ -> trace ("Error.") $ AlexError input__' (AlexLastSkip input__'' len, _) -> trace ("Skipping.") $ AlexSkip input__'' len (AlexLastAcc k input__''' len, _) -> trace ("Accept.") $ AlexToken input__''' len (alex_actions ! k) -- Push the input through the DFA, remembering the most recent accepting -- state it encountered. alex_scan_tkn user__ orig_input len input__ s last_acc = input__ `seq` -- strict in the input let new_acc = (check_accs (alex_accept `quickIndex` (s))) in new_acc `seq` case alexGetByte input__ of Nothing -> (new_acc, input__) Just (c, new_input) -> trace ("State: " ++ show (s) ++ ", char: " ++ show c) $ case fromIntegral c of { (ord_c) -> let base = alexIndexInt32OffAddr alex_base s offset = (base + ord_c) check = alexIndexInt16OffAddr alex_check offset new_s = if (offset >= (0)) && (check == ord_c) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s in case new_s of (-1) -> (new_acc, input__) -- on an error, we want to keep the input *before* the -- character that failed, not after. _ -> alex_scan_tkn user__ orig_input (if c < 0x80 || c >= 0xC0 then (len + (1)) else len) -- note that the length is increased ONLY if this is the 1st byte in a char encoding) new_input new_s new_acc } where check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input__ (len) check_accs (AlexAccSkip) = AlexLastSkip input__ (len) check_accs (AlexAccPred a predx rest) | predx user__ orig_input (len) input__ = AlexLastAcc a input__ (len) | otherwise = check_accs rest check_accs (AlexAccSkipPred predx rest) | predx user__ orig_input (len) input__ = AlexLastSkip input__ (len) | otherwise = check_accs rest data AlexLastAcc = AlexNone | AlexLastAcc !Int !AlexInput !Int | AlexLastSkip !AlexInput !Int data AlexAcc user = AlexAccNone | AlexAcc Int | AlexAccSkip | AlexAccPred Int (AlexAccPred user) (AlexAcc user) | AlexAccSkipPred (AlexAccPred user) (AlexAcc user) type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool -- ----------------------------------------------------------------------------- -- Predicates on a rule alexAndPred p1 p2 user__ in1 len in2 = p1 user__ in1 len in2 && p2 user__ in1 len in2 --alexPrevCharIsPred :: Char -> AlexAccPred _ alexPrevCharIs c _ input__ _ _ = c == alexInputPrevChar input__ alexPrevCharMatches f _ input__ _ _ = f (alexInputPrevChar input__) --alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ alexPrevCharIsOneOf arr _ input__ _ _ = arr ! alexInputPrevChar input__ --alexRightContext :: Int -> AlexAccPred _ alexRightContext (sc) user__ _ _ input__ = case alex_scan_tkn user__ input__ (0) input__ sc AlexNone of (AlexNone, _) -> False _ -> True -- TODO: there's no need to find the longest -- match when checking the right context, just -- the first match will do.