module Text.Alex.AlexTemplate where import AbsSyn alexTemplate GhcTarget = "{-# LINE 1 \"templates\\GenericTemplate.hs\" #-}\n" ++ "{-# LINE 1 \"templates\\\\GenericTemplate.hs\" #-}\n" ++ "{-# LINE 1 \"\" #-}\n" ++ "{-# LINE 1 \"\" #-}\n" ++ "{-# LINE 1 \"templates\\\\GenericTemplate.hs\" #-}\n" ++ "-- -----------------------------------------------------------------------------\n" ++ "-- ALEX TEMPLATE\n" ++ "--\n" ++ "-- This code is in the PUBLIC DOMAIN; you may copy it freely and use\n" ++ "-- it for any purpose whatsoever.\n" ++ "\n" ++ "-- -----------------------------------------------------------------------------\n" ++ "-- INTERNALS and main scanner engine\n" ++ "\n" ++ "{-# LINE 37 \"templates\\\\GenericTemplate.hs\" #-}\n" ++ "\n" ++ "{-# LINE 47 \"templates\\\\GenericTemplate.hs\" #-}\n" ++ "\n" ++ "\n" ++ "data AlexAddr = AlexA# Addr#\n" ++ "\n" ++ "#if __GLASGOW_HASKELL__ < 503\n" ++ "uncheckedShiftL# = shiftL#\n" ++ "#endif\n" ++ "\n" ++ "{-# INLINE alexIndexInt16OffAddr #-}\n" ++ "alexIndexInt16OffAddr (AlexA# arr) off =\n" ++ "#ifdef WORDS_BIGENDIAN\n" ++ " narrow16Int# i\n" ++ " where\n" ++ "\ti = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)\n" ++ "\thigh = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))\n" ++ "\tlow = int2Word# (ord# (indexCharOffAddr# arr off'))\n" ++ "\toff' = off *# 2#\n" ++ "#else\n" ++ " indexInt16OffAddr# arr off\n" ++ "#endif\n" ++ "\n" ++ "\n" ++ "\n" ++ "\n" ++ "\n" ++ "{-# INLINE alexIndexInt32OffAddr #-}\n" ++ "alexIndexInt32OffAddr (AlexA# arr) off = \n" ++ "#ifdef WORDS_BIGENDIAN\n" ++ " narrow32Int# i\n" ++ " where\n" ++ " i = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#`\n" ++ "\t\t (b2 `uncheckedShiftL#` 16#) `or#`\n" ++ "\t\t (b1 `uncheckedShiftL#` 8#) `or#` b0)\n" ++ " b3 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#)))\n" ++ " b2 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#)))\n" ++ " b1 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))\n" ++ " b0 = int2Word# (ord# (indexCharOffAddr# arr off'))\n" ++ " off' = off *# 4#\n" ++ "#else\n" ++ " indexInt32OffAddr# arr off\n" ++ "#endif\n" ++ "\n" ++ "\n" ++ "\n" ++ "\n" ++ "\n" ++ "#if __GLASGOW_HASKELL__ < 503\n" ++ "quickIndex arr i = arr ! i\n" ++ "#else\n" ++ "-- GHC >= 503, unsafeAt is available from Data.Array.Base.\n" ++ "quickIndex = unsafeAt\n" ++ "#endif\n" ++ "\n" ++ "\n" ++ "\n" ++ "\n" ++ "-- -----------------------------------------------------------------------------\n" ++ "-- Main lexing routines\n" ++ "\n" ++ "data AlexReturn a\n" ++ " = AlexEOF\n" ++ " | AlexError !AlexInput\n" ++ " | AlexSkip !AlexInput !Int\n" ++ " | AlexToken !AlexInput !Int a\n" ++ "\n" ++ "-- alexScan :: AlexInput -> StartCode -> AlexReturn a\n" ++ "alexScan input (I# (sc))\n" ++ " = alexScanUser undefined input (I# (sc))\n" ++ "\n" ++ "alexScanUser user input (I# (sc))\n" ++ " = case alex_scan_tkn user input 0# input sc AlexNone of\n" ++ "\t(AlexNone, input') ->\n" ++ "\t\tcase alexGetChar input of\n" ++ "\t\t\tNothing -> \n" ++ "\n" ++ "\n" ++ "\n" ++ "\t\t\t\t AlexEOF\n" ++ "\t\t\tJust _ ->\n" ++ "\n" ++ "\n" ++ "\n" ++ "\t\t\t\t AlexError input'\n" ++ "\n" ++ "\t(AlexLastSkip input'' len, _) ->\n" ++ "\n" ++ "\n" ++ "\n" ++ "\t\tAlexSkip input'' len\n" ++ "\n" ++ "\t(AlexLastAcc k input''' len, _) ->\n" ++ "\n" ++ "\n" ++ "\n" ++ "\t\tAlexToken input''' len k\n" ++ "\n" ++ "\n" ++ "-- Push the input through the DFA, remembering the most recent accepting\n" ++ "-- state it encountered.\n" ++ "\n" ++ "alex_scan_tkn user orig_input len input s last_acc =\n" ++ " input `seq` -- strict in the input\n" ++ " let \n" ++ "\tnew_acc = check_accs (alex_accept `quickIndex` (I# (s)))\n" ++ " in\n" ++ " new_acc `seq`\n" ++ " case alexGetChar input of\n" ++ " Nothing -> (new_acc, input)\n" ++ " Just (c, new_input) -> \n" ++ "\n" ++ "\n" ++ "\n" ++ "\tlet\n" ++ "\t\t!(base) = alexIndexInt32OffAddr alex_base s\n" ++ "\t\t!((I# (ord_c))) = ord c\n" ++ "\t\t!(offset) = (base +# ord_c)\n" ++ "\t\t!(check) = alexIndexInt16OffAddr alex_check offset\n" ++ "\t\t\n" ++ "\t\t!(new_s) = if (offset >=# 0#) && (check ==# ord_c)\n" ++ "\t\t\t then alexIndexInt16OffAddr alex_table offset\n" ++ "\t\t\t else alexIndexInt16OffAddr alex_deflt s\n" ++ "\tin\n" ++ "\tcase new_s of \n" ++ "\t -1# -> (new_acc, input)\n" ++ "\t\t-- on an error, we want to keep the input *before* the\n" ++ "\t\t-- character that failed, not after.\n" ++ " \t _ -> alex_scan_tkn user orig_input (len +# 1#) \n" ++ "\t\t\tnew_input new_s new_acc\n" ++ "\n" ++ " where\n" ++ "\tcheck_accs [] = last_acc\n" ++ "\tcheck_accs (AlexAcc a : _) = AlexLastAcc a input (I# (len))\n" ++ "\tcheck_accs (AlexAccSkip : _) = AlexLastSkip input (I# (len))\n" ++ "\tcheck_accs (AlexAccPred a predx : rest)\n" ++ "\t | predx user orig_input (I# (len)) input\n" ++ "\t = AlexLastAcc a input (I# (len))\n" ++ "\tcheck_accs (AlexAccSkipPred predx : rest)\n" ++ "\t | predx user orig_input (I# (len)) input\n" ++ "\t = AlexLastSkip input (I# (len))\n" ++ "\tcheck_accs (_ : rest) = check_accs rest\n" ++ "\n" ++ "data AlexLastAcc a\n" ++ " = AlexNone\n" ++ " | AlexLastAcc a !AlexInput !Int\n" ++ " | AlexLastSkip !AlexInput !Int\n" ++ "\n" ++ "data AlexAcc a user\n" ++ " = AlexAcc a\n" ++ " | AlexAccSkip\n" ++ " | AlexAccPred a (AlexAccPred user)\n" ++ " | AlexAccSkipPred (AlexAccPred user)\n" ++ "\n" ++ "type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool\n" ++ "\n" ++ "-- -----------------------------------------------------------------------------\n" ++ "-- Predicates on a rule\n" ++ "\n" ++ "alexAndPred p1 p2 user in1 len in2\n" ++ " = p1 user in1 len in2 && p2 user in1 len in2\n" ++ "\n" ++ "--alexPrevCharIsPred :: Char -> AlexAccPred _ \n" ++ "alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input\n" ++ "\n" ++ "--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ \n" ++ "alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input\n" ++ "\n" ++ "--alexRightContext :: Int -> AlexAccPred _\n" ++ "alexRightContext (I# (sc)) user _ _ input = \n" ++ " case alex_scan_tkn user input 0# input sc AlexNone of\n" ++ "\t (AlexNone, _) -> False\n" ++ "\t _ -> True\n" ++ "\t-- TODO: there's no need to find the longest\n" ++ "\t-- match when checking the right context, just\n" ++ "\t-- the first match will do.\n" ++ "\n" ++ "-- used by wrappers\n" ++ "iUnbox (I# (i)) = i" alexTemplate _ = "{-# LINE 1 \"templates\\GenericTemplate.hs\" #-}\n" ++ "{-# LINE 1 \"templates\\\\GenericTemplate.hs\" #-}\n" ++ "{-# LINE 1 \"\" #-}\n" ++ "{-# LINE 1 \"\" #-}\n" ++ "{-# LINE 1 \"templates\\\\GenericTemplate.hs\" #-}\n" ++ "-- -----------------------------------------------------------------------------\n" ++ "-- ALEX TEMPLATE\n" ++ "--\n" ++ "-- This code is in the PUBLIC DOMAIN; you may copy it freely and use\n" ++ "-- it for any purpose whatsoever.\n" ++ "\n" ++ "-- -----------------------------------------------------------------------------\n" ++ "-- INTERNALS and main scanner engine\n" ++ "\n" ++ "{-# LINE 37 \"templates\\\\GenericTemplate.hs\" #-}\n" ++ "\n" ++ "{-# LINE 47 \"templates\\\\GenericTemplate.hs\" #-}\n" ++ "\n" ++ "{-# LINE 68 \"templates\\\\GenericTemplate.hs\" #-}\n" ++ "alexIndexInt16OffAddr arr off = arr ! off\n" ++ "\n" ++ "\n" ++ "{-# LINE 89 \"templates\\\\GenericTemplate.hs\" #-}\n" ++ "alexIndexInt32OffAddr arr off = arr ! off\n" ++ "\n" ++ "\n" ++ "{-# LINE 100 \"templates\\\\GenericTemplate.hs\" #-}\n" ++ "quickIndex arr i = arr ! i\n" ++ "\n" ++ "\n" ++ "-- -----------------------------------------------------------------------------\n" ++ "-- Main lexing routines\n" ++ "\n" ++ "data AlexReturn a\n" ++ " = AlexEOF\n" ++ " | AlexError !AlexInput\n" ++ " | AlexSkip !AlexInput !Int\n" ++ " | AlexToken !AlexInput !Int a\n" ++ "\n" ++ "-- alexScan :: AlexInput -> StartCode -> AlexReturn a\n" ++ "alexScan input (sc)\n" ++ " = alexScanUser undefined input (sc)\n" ++ "\n" ++ "alexScanUser user input (sc)\n" ++ " = case alex_scan_tkn user input (0) input sc AlexNone of\n" ++ "\t(AlexNone, input') ->\n" ++ "\t\tcase alexGetChar input of\n" ++ "\t\t\tNothing -> \n" ++ "\n" ++ "\n" ++ "\n" ++ "\t\t\t\t AlexEOF\n" ++ "\t\t\tJust _ ->\n" ++ "\n" ++ "\n" ++ "\n" ++ "\t\t\t\t AlexError input'\n" ++ "\n" ++ "\t(AlexLastSkip input'' len, _) ->\n" ++ "\n" ++ "\n" ++ "\n" ++ "\t\tAlexSkip input'' len\n" ++ "\n" ++ "\t(AlexLastAcc k input''' len, _) ->\n" ++ "\n" ++ "\n" ++ "\n" ++ "\t\tAlexToken input''' len k\n" ++ "\n" ++ "\n" ++ "-- Push the input through the DFA, remembering the most recent accepting\n" ++ "-- state it encountered.\n" ++ "\n" ++ "alex_scan_tkn user orig_input len input s last_acc =\n" ++ " input `seq` -- strict in the input\n" ++ " let \n" ++ "\tnew_acc = check_accs (alex_accept `quickIndex` (s))\n" ++ " in\n" ++ " new_acc `seq`\n" ++ " case alexGetChar input of\n" ++ " Nothing -> (new_acc, input)\n" ++ " Just (c, new_input) -> \n" ++ "\n" ++ "\n" ++ "\n" ++ "\tlet\n" ++ "\t\t(base) = alexIndexInt32OffAddr alex_base s\n" ++ "\t\t((ord_c)) = ord c\n" ++ "\t\t(offset) = (base + ord_c)\n" ++ "\t\t(check) = alexIndexInt16OffAddr alex_check offset\n" ++ "\t\t\n" ++ "\t\t(new_s) = if (offset >= (0)) && (check == ord_c)\n" ++ "\t\t\t then alexIndexInt16OffAddr alex_table offset\n" ++ "\t\t\t else alexIndexInt16OffAddr alex_deflt s\n" ++ "\tin\n" ++ "\tcase new_s + 1 of \n" ++ "\t (0) -> (new_acc, input)\n" ++ "\t\t-- on an error, we want to keep the input *before* the\n" ++ "\t\t-- character that failed, not after.\n" ++ " \t _ -> alex_scan_tkn user orig_input (len + (1)) \n" ++ "\t\t\tnew_input new_s new_acc\n" ++ "\n" ++ " where\n" ++ "\tcheck_accs [] = last_acc\n" ++ "\tcheck_accs (AlexAcc a : _) = AlexLastAcc a input (len)\n" ++ "\tcheck_accs (AlexAccSkip : _) = AlexLastSkip input (len)\n" ++ "\tcheck_accs (AlexAccPred a predx : rest)\n" ++ "\t | predx user orig_input (len) input\n" ++ "\t = AlexLastAcc a input (len)\n" ++ "\tcheck_accs (AlexAccSkipPred predx : rest)\n" ++ "\t | predx user orig_input (len) input\n" ++ "\t = AlexLastSkip input (len)\n" ++ "\tcheck_accs (_ : rest) = check_accs rest\n" ++ "\n" ++ "data AlexLastAcc a\n" ++ " = AlexNone\n" ++ " | AlexLastAcc a !AlexInput !Int\n" ++ " | AlexLastSkip !AlexInput !Int\n" ++ "\n" ++ "data AlexAcc a user\n" ++ " = AlexAcc a\n" ++ " | AlexAccSkip\n" ++ " | AlexAccPred a (AlexAccPred user)\n" ++ " | AlexAccSkipPred (AlexAccPred user)\n" ++ "\n" ++ "type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool\n" ++ "\n" ++ "-- -----------------------------------------------------------------------------\n" ++ "-- Predicates on a rule\n" ++ "\n" ++ "alexAndPred p1 p2 user in1 len in2\n" ++ " = p1 user in1 len in2 && p2 user in1 len in2\n" ++ "\n" ++ "--alexPrevCharIsPred :: Char -> AlexAccPred _ \n" ++ "alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input\n" ++ "\n" ++ "--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ \n" ++ "alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input\n" ++ "\n" ++ "--alexRightContext :: Int -> AlexAccPred _\n" ++ "alexRightContext (sc) user _ _ input = \n" ++ " case alex_scan_tkn user input (0) input sc AlexNone of\n" ++ "\t (AlexNone, _) -> False\n" ++ "\t _ -> True\n" ++ "\t-- TODO: there's no need to find the longest\n" ++ "\t-- match when checking the right context, just\n" ++ "\t-- the first match will do.\n" ++ "\n" ++ "-- used by wrappers\n" ++ "iUnbox (i) = i"