{-#Language QuasiQuotes#-}
module Text.Alex.AlexTemplate where
import AbsSyn
-- import Text.Alex.Verbatim


{-
alexTemplate GhcTarget = [verbatim|
-- -----------------------------------------------------------------------------
-- 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

{-# LINE 37 "templates\\GenericTemplate.hs" #-}

{-# LINE 47 "templates\\GenericTemplate.hs" #-}


data AlexAddr = AlexA# Addr#

-- Never happens
-- #if __GLASGOW_HASKELL__ < 503
-- uncheckedShiftL# = shiftL#
-- #endif

{-# INLINE alexIndexInt16OffAddr #-}
alexIndexInt16OffAddr (AlexA# arr) off = |] ++
#ifdef WORDS_BIGENDIAN
  [verbatim|
    narrow16Int# i
    where
        i    = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)
        high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))
        low  = int2Word# (ord# (indexCharOffAddr# arr off'))
        off' = off *# 2#
  |]
#else
  [verbatim|
    indexInt16OffAddr# arr off
  |]
#endif 
  ++ [verbatim|





{-# INLINE alexIndexInt32OffAddr #-}
alexIndexInt32OffAddr (AlexA# arr) off =  |] ++
#ifdef WORDS_BIGENDIAN
  [verbatim|
    narrow32Int# i
    where
       !i    = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#`
		     (b2 `uncheckedShiftL#` 16#) `or#`
		     (b1 `uncheckedShiftL#` 8#) `or#` b0)
       !b3   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#)))
       !b2   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#)))
       !b1   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))
       !b0   = int2Word# (ord# (indexCharOffAddr# arr off'))
       !off' = off *# 4#
  |]
#else
  [verbatim|
    indexInt32OffAddr# arr off
  |]
#endif
  ++ [verbatim|




-- Never happens
-- #if __GLASGOW_HASKELL__ < 503
-- quickIndex arr i = arr ! i
-- #else
-- GHC >= 503, unsafeAt is available from Data.Array.Base.
quickIndex = unsafeAt
-- #endif




-- -----------------------------------------------------------------------------
-- Main lexing routines

data AlexReturn a
  = AlexEOF
  | AlexError  !AlexInput
  | AlexSkip   !AlexInput !Int
  | AlexToken  !AlexInput !Int a

-- alexScan :: AlexInput -> StartCode -> AlexReturn a
alexScan input (I# (sc))
  = alexScanUser undefined input (I# (sc))

alexScanUser user input (I# (sc))
  = case alex_scan_tkn user input 0# input sc AlexNone of
	(AlexNone, input') ->
		case alexGetByte input of
			Nothing -> 



				   AlexEOF
			Just _ ->



				   AlexError input'

	(AlexLastSkip input'' len, _) ->



		AlexSkip input'' len

	(AlexLastAcc k input''' len, _) ->



		AlexToken input''' len 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` (I# (s))))
  in
  new_acc `seq`
  case alexGetByte input of
     Nothing -> (new_acc, input)
     Just (c, new_input) -> 



	let
		(base) = alexIndexInt32OffAddr alex_base s
		((I# (ord_c))) = fromIntegral c
		(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 [] = last_acc
	check_accs (AlexAcc a : _) = AlexLastAcc a input (I# (len))
	check_accs (AlexAccSkip : _)  = AlexLastSkip  input (I# (len))
	check_accs (AlexAccPred a predx : rest)
	   | predx user orig_input (I# (len)) input
	   = AlexLastAcc a input (I# (len))
	check_accs (AlexAccSkipPred predx : rest)
	   | predx user orig_input (I# (len)) input
	   = AlexLastSkip input (I# (len))
	check_accs (_ : rest) = check_accs rest

data AlexLastAcc a
  = AlexNone
  | AlexLastAcc a !AlexInput !Int
  | AlexLastSkip  !AlexInput !Int

instance Functor AlexLastAcc where
    fmap f AlexNone = AlexNone
    fmap f (AlexLastAcc x y z) = AlexLastAcc (f x) y z
    fmap f (AlexLastSkip x y) = AlexLastSkip x y

data AlexAcc a user
  = AlexAcc a
  | AlexAccSkip
  | AlexAccPred a (AlexAccPred user)
  | AlexAccSkipPred (AlexAccPred 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 (I# (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.

-- used by wrappers
iUnbox (I# (i)) = i
|]

-}






-- This code is in the PUBLIC DOMAIN; you may copy it freely and use
-- it for any purpose whatsoever.

alexTemplate _  = unlines[
  "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",
  "\t(AlexNone, input') ->",
  "\t\tcase alexGetByte input of",
  "\t\t\tNothing -> ",
  "",
  "",
  "",
  "\t\t\t\t   AlexEOF",
  "\t\t\tJust _ ->",
  "",
  "",
  "",
  "\t\t\t\t   AlexError input'",
  "",
  "\t(AlexLastSkip input'' len, _) ->",
  "",
  "",
  "",
  "\t\tAlexSkip input'' len",
  "",
  "\t(AlexLastAcc k input''' len, _) ->",
  "",
  "",
  "",
  "\t\tAlexToken input''' len 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 ",
  "\tnew_acc = (check_accs (alex_accept `quickIndex` (s)))",
  "  in",
  "  new_acc `seq`",
  "  case alexGetByte input of",
  "     Nothing -> (new_acc, input)",
  "     Just (c, new_input) -> ",
  "",
  "",
  "",
  "\tlet",
  "\t\t(base) = alexIndexInt32OffAddr alex_base s",
  "\t\t((ord_c)) = fromIntegral c",
  "\t\t(offset) = (base + ord_c)",
  "\t\t(check)  = alexIndexInt16OffAddr alex_check offset",
  "\t\t",
  "\t\t(new_s) = if (offset >= (0)) && (check == ord_c)",
  "\t\t\t  then alexIndexInt16OffAddr alex_table offset",
  "\t\t\t  else alexIndexInt16OffAddr alex_deflt s",
  "\tin",
  "\tcase new_s of ",
  "\t    (-1) -> (new_acc, input)",
  "\t\t-- on an error, we want to keep the input *before* the",
  "\t\t-- character that failed, not after.",
  "    \t    _ -> 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)",
  "\t\t\tnew_input new_s new_acc",
  "",
  "  where",
  "\tcheck_accs [] = last_acc",
  "\tcheck_accs (AlexAcc a : _) = AlexLastAcc a input (len)",
  "\tcheck_accs (AlexAccSkip : _)  = AlexLastSkip  input (len)",
  "\tcheck_accs (AlexAccPred a predx : rest)",
  "\t   | predx user orig_input (len) input",
  "\t   = AlexLastAcc a input (len)",
  "\tcheck_accs (AlexAccSkipPred predx : rest)",
  "\t   | predx user orig_input (len) input",
  "\t   = AlexLastSkip input (len)",
  "\tcheck_accs (_ : rest) = check_accs rest",
  "",
  "data AlexLastAcc a",
  "  = AlexNone",
  "  | AlexLastAcc a !AlexInput !Int",
  "  | AlexLastSkip  !AlexInput !Int",
  "",
  "instance Functor AlexLastAcc where",
  "    fmap f AlexNone = AlexNone",
  "    fmap f (AlexLastAcc x y z) = AlexLastAcc (f x) y z",
  "    fmap f (AlexLastSkip x y) = AlexLastSkip x y",
  "",
  "data AlexAcc a user",
  "  = AlexAcc a",
  "  | AlexAccSkip",
  "  | AlexAccPred a (AlexAccPred user)",
  "  | AlexAccSkipPred (AlexAccPred 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",
  "\t  (AlexNone, _) -> False",
  "\t  _ -> True",
  "\t-- TODO: there's no need to find the longest",
  "\t-- match when checking the right context, just",
  "\t-- the first match will do.",
  "",
  "-- used by wrappers",
  "iUnbox (i) = i"
  ]