    {-# OPTIONS_HADDOCK hide #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Language.Haskell.Exts.Annotated.InternalLexer
    -- Copyright   :  (c) The GHC Team, 1997-2000
    --                (c) Niklas Broberg, 2004-2009
    -- License     :  BSD-style (see the file LICENSE.txt)
    --
    -- Maintainer  :  Niklas Broberg, d00nibro@chalmers.se
    -- Stability   :  stable
    -- Portability :  portable
    --
    -- Lexer for Haskell, with some extensions.
    --
    -----------------------------------------------------------------------------

    -- ToDo: Introduce different tokens for decimal, octal and hexadecimal (?)
    -- ToDo: FloatTok should have three parts (integer part, fraction, exponent) (?)
    -- ToDo: Use a lexical analyser generator (lx?)

    module Language.Haskell.Exts.InternalLexer (Token(..), showToken, lexer, topLexer) where

    import Language.Haskell.Exts.ParseMonad
    import Language.Haskell.Exts.SrcLoc hiding (loc)
    import Language.Haskell.Exts.Comments
    import Language.Haskell.Exts.Extension
    import Language.Haskell.Exts.ExtScheme

    import Prelude hiding (id, exponent)
    import Data.Char
    import Data.Ratio
    import Data.List (intercalate, isPrefixOf)
    import Control.Monad (when)

    -- import Debug.Trace (trace)

    data Token
            = VarId String
            | LabelVarId String
            | QVarId (String,String)
            | IDupVarId (String)        -- duplicable implicit parameter
            | ILinVarId (String)        -- linear implicit parameter
            | ConId String
            | QConId (String,String)
            | DVarId [String]       -- to enable varid's with '-' in them
            | VarSym String
            | ConSym String
            | QVarSym (String,String)
            | QConSym (String,String)
            | IntTok (Integer, String)
            | FloatTok (Rational, String)
            | Character (Char, String)
            | StringTok (String, String)
            | IntTokHash (Integer, String)        -- 1#
            | WordTokHash (Integer, String)       -- 1##
            | FloatTokHash (Rational, String)     -- 1.0#
            | DoubleTokHash (Rational, String)    -- 1.0##
            | CharacterHash (Char, String)        -- c#
            | StringHash (String, String)         -- "Hello world!"#

    -- Symbols

            | LeftParen
            | RightParen
            | LeftHashParen
            | RightHashParen
            | SemiColon
            | LeftCurly
            | RightCurly
            | VRightCurly           -- a virtual close brace
            | LeftSquare
            | RightSquare
            | ParArrayLeftSquare -- [:
            | ParArrayRightSquare -- :]
            | Comma
            | Underscore
            | BackQuote

    -- Reserved operators

            | Dot           -- reserved for use with 'forall x . x'
            | DotDot
            | Colon
            | QuoteColon
            | DoubleColon
            | Equals
            | Backslash
            | Bar
            | LeftArrow
            | RightArrow
            | At
            | TApp -- '@' but have to check for preceeding whitespace
            | Tilde
            | DoubleArrow
            | Minus
            | Exclamation
            | Star
            | LeftArrowTail         -- -<
            | RightArrowTail        -- >-
            | LeftDblArrowTail      -- -<<
            | RightDblArrowTail     -- >>-
            | OpenArrowBracket      -- (|
            | CloseArrowBracket     -- |)

    -- Template Haskell
            | THExpQuote            -- [| or [e|
            | THTExpQuote           -- [|| or [e||
            | THPatQuote            -- [p|
            | THDecQuote            -- [d|
            | THTypQuote            -- [t|
            | THCloseQuote          -- |]
            | THTCloseQuote         -- ||]
            | THIdEscape (String)   -- dollar x
            | THParenEscape         -- dollar (
            | THTIdEscape String    -- dollar dollar x
            | THTParenEscape        -- double dollar (
            | THVarQuote            -- 'x (but without the x)
            | THTyQuote             -- ''T (but without the T)
            | THQuasiQuote (String,String)  -- [$...|...]

    -- HaRP
            | RPGuardOpen       -- (|
            | RPGuardClose      -- |)
            | RPCAt             -- @:

    -- Hsx
            | XCodeTagOpen      -- <%
            | XCodeTagClose     -- %>
            | XStdTagOpen       -- <
            | XStdTagClose      -- >
            | XCloseTagOpen     -- </
            | XEmptyTagClose    -- />
            | XChildTagOpen     -- <%> (note that close doesn't exist, it's XCloseTagOpen followed by XCodeTagClose)
            | XPCDATA String
            | XRPatOpen             -- <[
            | XRPatClose            -- ]>

    -- Pragmas

            | PragmaEnd                     -- #-}
            | RULES
            | INLINE Bool
            | INLINE_CONLIKE
            | SPECIALISE
            | SPECIALISE_INLINE Bool
            | SOURCE
            | DEPRECATED
            | WARNING
            | SCC
            | GENERATED
            | CORE
            | UNPACK
            | NOUNPACK
            | OPTIONS (Maybe String,String)
    --        | CFILES  String
    --        | INCLUDE String
            | LANGUAGE
            | ANN
            | MINIMAL
            | NO_OVERLAP
            | OVERLAP
            | OVERLAPPING
            | OVERLAPPABLE
            | OVERLAPS
            | INCOHERENT
            | COMPLETE

    -- Reserved Ids

            | KW_As
            | KW_By         -- transform list comprehensions
            | KW_Case
            | KW_Class
            | KW_Data
            | KW_Default
            | KW_Deriving
            | KW_Do
            | KW_MDo
            | KW_Else
            | KW_Family     -- indexed type families
            | KW_Forall     -- universal/existential types
            | KW_Group      -- transform list comprehensions
            | KW_Hiding
            | KW_If
            | KW_Import
            | KW_In
            | KW_Infix
            | KW_InfixL
            | KW_InfixR
            | KW_Instance
            | KW_Let
            | KW_Module
            | KW_NewType
            | KW_Of
            | KW_Proc       -- arrows
            | KW_Rec        -- arrows
            | KW_Role
            | KW_Then
            | KW_Type
            | KW_Using      -- transform list comprehensions
            | KW_Where
            | KW_Qualified
            | KW_Pattern
            | KW_Stock
            | KW_Anyclass
            | KW_Via

                    -- FFI
            | KW_Foreign
            | KW_Export
            | KW_Safe
            | KW_Unsafe
            | KW_Threadsafe
            | KW_Interruptible
            | KW_StdCall
            | KW_CCall
            | KW_CPlusPlus
            | KW_DotNet
            | KW_Jvm
            | KW_Js
            | KW_JavaScript
            | KW_CApi

            | EOF
            deriving (Token -> Token -> Bool
    (Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Token -> Token -> Bool
    == :: Token -> Token -> Bool
    $c/= :: Token -> Token -> Bool
    /= :: Token -> Token -> Bool
    Eq,Int -> Token -> ShowS
    [Token] -> ShowS
    Token -> String
    (Int -> Token -> ShowS)
    -> (Token -> String) -> ([Token] -> ShowS) -> Show Token
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Token -> ShowS
    showsPrec :: Int -> Token -> ShowS
    $cshow :: Token -> String
    show :: Token -> String
    $cshowList :: [Token] -> ShowS
    showList :: [Token] -> ShowS
    Show)

    reserved_ops :: [(String,(Token, Maybe ExtScheme))]
    reserved_ops :: [(String, (Token, Maybe ExtScheme))]
    reserved_ops = [
     ( String
    "..", (Token
    DotDot,       Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    ":",  (Token
    Colon,        Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "::", (Token
    DoubleColon,  Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "=",  (Token
    Equals,       Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "\\", (Token
    Backslash,    Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "|",  (Token
    Bar,          Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "<-", (Token
    LeftArrow,    Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "->", (Token
    RightArrow,   Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "@",  (Token
    At,           Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "@:", (Token
    RPCAt,        ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    RegularPatterns])) ),
     ( String
    "~",  (Token
    Tilde,        Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "=>", (Token
    DoubleArrow,  Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "*",  (Token
    Star,         ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    KindSignatures])) ),
     -- Parallel arrays
     ( String
    "[:", (Token
    ParArrayLeftSquare,   ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    ParallelArrays])) ),
     ( String
    ":]", (Token
    ParArrayRightSquare,  ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    ParallelArrays])) ),
     -- Arrows notation
     ( String
    "-<",  (Token
    LeftArrowTail,       ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    Arrows])) ),
     ( String
    ">-",  (Token
    RightArrowTail,      ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    Arrows])) ),
     ( String
    "-<<", (Token
    LeftDblArrowTail,    ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    Arrows])) ),
     ( String
    ">>-", (Token
    RightDblArrowTail,   ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    Arrows])) ),
     -- Unicode notation
     ( String
    "\x2190",    (Token
    LeftArrow,     ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any  [KnownExtension
    UnicodeSyntax])) ),
     ( String
    "\x2192",    (Token
    RightArrow,    ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any  [KnownExtension
    UnicodeSyntax])) ),
     ( String
    "\x21d2",    (Token
    DoubleArrow,   ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any  [KnownExtension
    UnicodeSyntax])) ),
     ( String
    "\x2237",    (Token
    DoubleColon,   ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any  [KnownExtension
    UnicodeSyntax])) ),
     ( String
    "\x2919",    (Token
    LeftArrowTail,     ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    All [KnownExtension
    UnicodeSyntax, KnownExtension
    Arrows])) ),
     ( String
    "\x291a",    (Token
    RightArrowTail,    ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    All [KnownExtension
    UnicodeSyntax, KnownExtension
    Arrows])) ),
     ( String
    "\x291b",    (Token
    LeftDblArrowTail,  ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    All [KnownExtension
    UnicodeSyntax, KnownExtension
    Arrows])) ),
     ( String
    "\x291c",    (Token
    RightDblArrowTail, ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    All [KnownExtension
    UnicodeSyntax, KnownExtension
    Arrows])) ),
     ( String
    "\x2605",    (Token
    Star,              ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    All [KnownExtension
    UnicodeSyntax, KnownExtension
    KindSignatures])) ),
     ( String
    "\x2200",    (Token
    KW_Forall,         ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    All [KnownExtension
    UnicodeSyntax, KnownExtension
    ExplicitForAll])) )
     ]

    special_varops :: [(String,(Token, Maybe ExtScheme))]
    special_varops :: [(String, (Token, Maybe ExtScheme))]
    special_varops = [
     -- the dot is only a special symbol together with forall, but can still be used as function composition
     ( String
    ".",  (Token
    Dot,          ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    ExplicitForAll, KnownExtension
    ExistentialQuantification])) ),
     ( String
    "-",  (Token
    Minus,        Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "!",  (Token
    Exclamation,  Maybe ExtScheme
    forall a. Maybe a
    Nothing) )
     ]

    reserved_ids :: [(String,(Token, Maybe ExtScheme))]
    reserved_ids :: [(String, (Token, Maybe ExtScheme))]
    reserved_ids = [
     ( String
    "_",         (Token
    Underscore,    Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "by",        (Token
    KW_By,         ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    TransformListComp])) ),
     ( String
    "case",      (Token
    KW_Case,       Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "class",     (Token
    KW_Class,      Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "data",      (Token
    KW_Data,       Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "default",   (Token
    KW_Default,    Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "deriving",  (Token
    KW_Deriving,   Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "do",        (Token
    KW_Do,         Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "else",      (Token
    KW_Else,       Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "family",    (Token
    KW_Family,     ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    TypeFamilies])) ),        -- indexed type families
     ( String
    "forall",    (Token
    KW_Forall,     ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    ExplicitForAll, KnownExtension
    ExistentialQuantification])) ),    -- universal/existential quantification
     ( String
    "group",     (Token
    KW_Group,      ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    TransformListComp])) ),
     ( String
    "if",        (Token
    KW_If,         Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "import",    (Token
    KW_Import,     Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "in",        (Token
    KW_In,         Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "infix",     (Token
    KW_Infix,      Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "infixl",    (Token
    KW_InfixL,     Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "infixr",    (Token
    KW_InfixR,     Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "instance",  (Token
    KW_Instance,   Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "let",       (Token
    KW_Let,        Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "mdo",       (Token
    KW_MDo,        ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    RecursiveDo])) ),
     ( String
    "module",    (Token
    KW_Module,     Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "newtype",   (Token
    KW_NewType,    Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "of",        (Token
    KW_Of,         Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "proc",      (Token
    KW_Proc,       ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    Arrows])) ),
     ( String
    "rec",       (Token
    KW_Rec,        ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    Arrows, KnownExtension
    RecursiveDo, KnownExtension
    DoRec])) ),
     ( String
    "then",      (Token
    KW_Then,       Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "type",      (Token
    KW_Type,       Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "using",     (Token
    KW_Using,      ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    TransformListComp])) ),
     ( String
    "where",     (Token
    KW_Where,      Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "role",      (Token
    KW_Role,       ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    RoleAnnotations]))),
     ( String
    "pattern",   (Token
    KW_Pattern,    ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    PatternSynonyms]))),
     ( String
    "stock",     (Token
    KW_Stock,      ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    DerivingStrategies]))),
     ( String
    "anyclass",  (Token
    KW_Anyclass,   ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    DerivingStrategies]))),
     ( String
    "via",       (Token
    KW_Via,        ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    DerivingVia]))),

    -- FFI
     ( String
    "foreign",   (Token
    KW_Foreign,    ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    ForeignFunctionInterface])) )
     ]

    special_varids :: [(String,(Token, Maybe ExtScheme))]
    special_varids :: [(String, (Token, Maybe ExtScheme))]
    special_varids = [
     ( String
    "as",        (Token
    KW_As,         Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "qualified", (Token
    KW_Qualified,  Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),
     ( String
    "hiding",    (Token
    KW_Hiding,     Maybe ExtScheme
    forall a. Maybe a
    Nothing) ),

    -- FFI
     ( String
    "export",        (Token
    KW_Export,        ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    ForeignFunctionInterface])) ),
     ( String
    "safe",          (Token
    KW_Safe,          ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    ForeignFunctionInterface, KnownExtension
    SafeImports, KnownExtension
    Safe, KnownExtension
    Trustworthy])) ),
     ( String
    "unsafe",        (Token
    KW_Unsafe,        ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    ForeignFunctionInterface])) ),
     ( String
    "threadsafe",    (Token
    KW_Threadsafe,    ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    ForeignFunctionInterface])) ),
     ( String
    "interruptible", (Token
    KW_Interruptible, ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    InterruptibleFFI])) ),
     ( String
    "stdcall",       (Token
    KW_StdCall,       ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    ForeignFunctionInterface])) ),
     ( String
    "ccall",         (Token
    KW_CCall,         ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    ForeignFunctionInterface])) ),
     ( String
    "cplusplus",     (Token
    KW_CPlusPlus,     ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    ForeignFunctionInterface])) ),
     ( String
    "dotnet",        (Token
    KW_DotNet,        ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    ForeignFunctionInterface])) ),
     ( String
    "jvm",           (Token
    KW_Jvm,           ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    ForeignFunctionInterface])) ),
     ( String
    "js",            (Token
    KW_Js,            ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    ForeignFunctionInterface])) ),
     ( String
    "javascript",    (Token
    KW_JavaScript,    ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    ForeignFunctionInterface])) ),
     ( String
    "capi",          (Token
    KW_CApi,          ExtScheme -> Maybe ExtScheme
    forall a. a -> Maybe a
    Just ([KnownExtension] -> ExtScheme
    Any [KnownExtension
    CApiFFI])) )
     ]

    pragmas :: [(String,Token)]
    pragmas :: [(String, Token)]
    pragmas = [
     ( String
    "rules",             Token
    RULES           ),
     ( String
    "inline",            Bool -> Token
    INLINE Bool
    True     ),
     ( String
    "noinline",          Bool -> Token
    INLINE Bool
    False    ),
     ( String
    "notinline",         Bool -> Token
    INLINE Bool
    False    ),
     ( String
    "specialise",        Token
    SPECIALISE      ),
     ( String
    "specialize",        Token
    SPECIALISE      ),
     ( String
    "source",            Token
    SOURCE          ),
     ( String
    "deprecated",        Token
    DEPRECATED      ),
     ( String
    "warning",           Token
    WARNING         ),
     ( String
    "ann",               Token
    ANN             ),
     ( String
    "scc",               Token
    SCC             ),
     ( String
    "generated",         Token
    GENERATED       ),
     ( String
    "core",              Token
    CORE            ),
     ( String
    "unpack",            Token
    UNPACK          ),
     ( String
    "nounpack",          Token
    NOUNPACK        ),
     ( String
    "language",          Token
    LANGUAGE        ),
     ( String
    "minimal",           Token
    MINIMAL         ),
     ( String
    "no_overlap",        Token
    NO_OVERLAP      ),
     ( String
    "overlap",           Token
    OVERLAP         ),
     ( String
    "overlaps",          Token
    OVERLAPS        ),
     ( String
    "overlapping",       Token
    OVERLAPPING     ),
     ( String
    "overlappable",      Token
    OVERLAPPABLE    ),
     ( String
    "incoherent",        Token
    INCOHERENT      ),
     ( String
    "complete",          Token
    COMPLETE      ),
     ( String
    "options",           (Maybe String, String) -> Token
    OPTIONS (Maybe String, String)
    forall a. HasCallStack => a
    undefined ) -- we'll tweak it before use - promise!
    -- ( "cfiles",            CFILES  undefined ), -- same here...
    -- ( "include",           INCLUDE undefined )  -- ...and here!
     ]

    isIdent, isHSymbol, isPragmaChar :: Char -> Bool
    isIdent :: Char -> Bool
    isIdent   Char
    c = Char -> Bool
    isAlphaNum Char
    c Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\'' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '_'

    isHSymbol :: Char -> Bool
    isHSymbol Char
    c = Char
    c Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    ":!#%&*./?@\\-" Bool -> Bool -> Bool
    || ((Char -> Bool
    isSymbol Char
    c Bool -> Bool -> Bool
    || Char -> Bool
    isPunctuation Char
    c) Bool -> Bool -> Bool
    && Bool -> Bool
    not (Char
    c Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    "(),;[]`{}_\"'"))

    isPragmaChar :: Char -> Bool
    isPragmaChar Char
    c = Char -> Bool
    isAlphaNum Char
    c Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '_'

    isIdentStart :: Char -> Bool
    isIdentStart :: Char -> Bool
    isIdentStart Char
    c = Char -> Bool
    isAlpha Char
    c Bool -> Bool -> Bool
    && Bool -> Bool
    not (Char -> Bool
    isUpper Char
    c) Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '_'

    -- Used in the lexing of type applications
    -- Why is it like this? I don't know exactly but this is how it is in
    -- GHC's parser.
    isOpSymbol :: Char -> Bool
    isOpSymbol :: Char -> Bool
    isOpSymbol Char
    c = Char
    c Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    "!#$%&*+./<=>?@\\^|-~"

    -- | Checks whether the character would be legal in some position of a qvar.
    --   Means that '..' and "AAA" will pass the test.
    isPossiblyQvar :: Char -> Bool
    isPossiblyQvar :: Char -> Bool
    isPossiblyQvar Char
    c = Char -> Bool
    isIdent (Char -> Char
    toLower Char
    c) Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '.'

    matchChar :: Char -> String -> Lex a ()
    matchChar :: forall a. Char -> String -> Lex a ()
    matchChar Char
    c String
    msg = do
        s <- Lex a String
    forall r. Lex r String
    getInput
        if null s || head s /= c then fail msg else discard 1

    -- The top-level lexer.
    -- We need to know whether we are at the beginning of the line to decide
    -- whether to insert layout tokens.

    lexer :: (Loc Token -> P a) -> P a
    lexer :: forall a. (Loc Token -> P a) -> P a
    lexer = Lex a (Loc Token) -> (Loc Token -> P a) -> P a
    forall r a. Lex r a -> (a -> P r) -> P r
    runL Lex a (Loc Token)
    forall a. Lex a (Loc Token)
    topLexer

    topLexer :: Lex a (Loc Token)
    topLexer :: forall a. Lex a (Loc Token)
    topLexer = do
        b <- Lex a Bool
    forall a. Lex a Bool
    pullCtxtFlag
        if b then -- trace (show cf ++ ": " ++ show VRightCurly) $
                  -- the lex context state flags that we must do an empty {} - UGLY
                  setBOL >> getSrcLocL >>= \SrcLoc
    l -> Loc Token -> Lex a (Loc Token)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpan -> Token -> Loc Token
    forall a. SrcSpan -> a -> Loc a
    Loc (SrcLoc -> SrcLoc -> SrcSpan
    mkSrcSpan SrcLoc
    l SrcLoc
    l) Token
    VRightCurly)
         else do
            bol <- checkBOL
            (bol', ws) <- lexWhiteSpace bol
            -- take care of whitespace in PCDATA
            ec <- getExtContext
            case ec of
             -- if there was no linebreak, and we are lexing PCDATA,
             -- then we want to care about the whitespace.
             -- We don't bother to test for XmlSyntax, since we
             -- couldn't end up in ChildCtxt otherwise.
             Just ExtContext
    ChildCtxt | Bool -> Bool
    not Bool
    bol' Bool -> Bool -> Bool
    && Bool
    ws -> Lex a SrcLoc
    forall a. Lex a SrcLoc
    getSrcLocL Lex a SrcLoc -> (SrcLoc -> Lex a (Loc Token)) -> Lex a (Loc Token)
    forall a b. Lex a a -> (a -> Lex a b) -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \SrcLoc
    l -> Loc Token -> Lex a (Loc Token)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Loc Token -> Lex a (Loc Token)) -> Loc Token -> Lex a (Loc Token)
    forall a b. (a -> b) -> a -> b
    $ SrcSpan -> Token -> Loc Token
    forall a. SrcSpan -> a -> Loc a
    Loc (SrcLoc -> SrcLoc -> SrcSpan
    mkSrcSpan SrcLoc
    l SrcLoc
    l) (Token -> Loc Token) -> Token -> Loc Token
    forall a b. (a -> b) -> a -> b
    $ String -> Token
    XPCDATA String
    " "
             Maybe ExtContext
    _ -> do Lex a ()
    forall a. Lex a ()
    startToken
                     sl <- Lex a SrcLoc
    forall a. Lex a SrcLoc
    getSrcLocL
                     t <- if bol' then lexBOL    -- >>= \t -> trace ("BOL: " ++ show t) (return t)
                                  else lexToken  -- >>= \t -> trace (show t) (return t)
                     el <- getSrcLocL
                     return $ Loc (mkSrcSpan sl el) t

    lexWhiteSpace :: Bool -> Lex a (Bool, Bool)
    lexWhiteSpace :: forall a. Bool -> Lex a (Bool, Bool)
    lexWhiteSpace Bool
    bol = do
        s <- Lex a String
    forall r. Lex r String
    getInput
        ignL <- ignoreLinePragmasL
        case s of
            -- If we find a recognised pragma, we don't want to treat it as a comment.
            Char
    '{':Char
    '-':Char
    '#':String
    rest | String -> Bool
    isRecognisedPragma String
    rest -> (Bool, Bool) -> Lex a (Bool, Bool)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    bol, Bool
    False)
                             | String -> Bool
    isLinePragma String
    rest Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    ignL -> do
                                (l, fn) <- Lex a (Int, String)
    forall a. Lex a (Int, String)
    lexLinePragma
                                setSrcLineL l
                                setLineFilenameL fn
                                lexWhiteSpace True
            Char
    '{':Char
    '-':String
    _ -> do
                loc <- Lex a SrcLoc
    forall a. Lex a SrcLoc
    getSrcLocL
                discard 2
                (bol1, c) <- lexNestedComment bol ""
                loc2 <- getSrcLocL
                pushComment $ Comment True (mkSrcSpan loc loc2) (reverse c)
                (bol2, _) <- lexWhiteSpace bol1
                return (bol2, True)
            Char
    '-':Char
    '-':String
    s1 | (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '-') ((Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile Char -> Bool
    isHSymbol String
    s1) -> do
                loc    <- Lex a SrcLoc
    forall a. Lex a SrcLoc
    getSrcLocL
                discard 2
                dashes <- lexWhile (== '-')
                rest   <- lexWhile (/= '\n')
                s' <- getInput
                loc2 <- getSrcLocL
                let com = Bool -> SrcSpan -> String -> Comment
    Comment Bool
    False (SrcLoc -> SrcLoc -> SrcSpan
    mkSrcSpan SrcLoc
    loc SrcLoc
    loc2) (String -> Comment) -> String -> Comment
    forall a b. (a -> b) -> a -> b
    $ String
    dashes String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    rest
                case s' of
                    [] -> Comment -> Lex a ()
    forall a. Comment -> Lex a ()
    pushComment Comment
    com Lex a () -> Lex a (Bool, Bool) -> Lex a (Bool, Bool)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Bool, Bool) -> Lex a (Bool, Bool)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    False, Bool
    True)
                    String
    _ -> do
                        Comment -> Lex a ()
    forall a. Comment -> Lex a ()
    pushComment Comment
    com
                        Lex a ()
    forall a. Lex a ()
    lexNewline
                        Bool -> Lex a ()
    forall a. Bool -> Lex a ()
    lexWhiteSpace_ Bool
    True
                        (Bool, Bool) -> Lex a (Bool, Bool)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True, Bool
    True)
            Char
    '\n':String
    _ -> do
                Lex a ()
    forall a. Lex a ()
    lexNewline
                Bool -> Lex a ()
    forall a. Bool -> Lex a ()
    lexWhiteSpace_ Bool
    True
                (Bool, Bool) -> Lex a (Bool, Bool)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True, Bool
    True)
            Char
    '\t':String
    _ -> do
                Lex a ()
    forall a. Lex a ()
    lexTab
                (bol', _) <- Bool -> Lex a (Bool, Bool)
    forall a. Bool -> Lex a (Bool, Bool)
    lexWhiteSpace Bool
    bol
                return (bol', True)
            Char
    c:String
    _ | Char -> Bool
    isSpace Char
    c -> do
                Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1
                (bol', _) <- Bool -> Lex a (Bool, Bool)
    forall a. Bool -> Lex a (Bool, Bool)
    lexWhiteSpace Bool
    bol
                return (bol', True)
            String
    _ -> (Bool, Bool) -> Lex a (Bool, Bool)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    bol, Bool
    False)

    -- | lexWhiteSpace without the return value.
    lexWhiteSpace_ :: Bool -> Lex a ()
    lexWhiteSpace_ :: forall a. Bool -> Lex a ()
    lexWhiteSpace_ Bool
    bol =  do _ <- Bool -> Lex a (Bool, Bool)
    forall a. Bool -> Lex a (Bool, Bool)
    lexWhiteSpace Bool
    bol
                             return ()

    isRecognisedPragma, isLinePragma :: String -> Bool
    isRecognisedPragma :: String -> Bool
    isRecognisedPragma String
    str = let pragma :: String
    pragma = (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile Char -> Bool
    isPragmaChar ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isSpace ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ String
    str
                              in case String -> Maybe Token
    lookupKnownPragma String
    pragma of
                                  Maybe Token
    Nothing -> Bool
    False
                                  Maybe Token
    _       -> Bool
    True

    isLinePragma :: String -> Bool
    isLinePragma String
    str = let pragma :: String
    pragma = (Char -> Char) -> ShowS
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile Char -> Bool
    isAlphaNum ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isSpace ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ String
    str
                        in case String
    pragma of
                            String
    "line"  -> Bool
    True
                            String
    _       -> Bool
    False

    lexLinePragma :: Lex a (Int, String)
    lexLinePragma :: forall a. Lex a (Int, String)
    lexLinePragma = do
        Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3   -- {-#
        (Char -> Bool) -> Lex a ()
    forall a. (Char -> Bool) -> Lex a ()
    lexWhile_ Char -> Bool
    isSpace
        Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    4   -- LINE
        (Char -> Bool) -> Lex a ()
    forall a. (Char -> Bool) -> Lex a ()
    lexWhile_ Char -> Bool
    isSpace
        i <- (Char -> Bool) -> Lex a String
    forall a. (Char -> Bool) -> Lex a String
    lexWhile Char -> Bool
    isDigit
        when (null i) $ fail "Improperly formatted LINE pragma"
        lexWhile_ isSpace
        matchChar '"' "Improperly formatted LINE pragma"
        fn <- lexWhile (/= '"')
        matchChar '"' "Impossible - lexLinePragma"
        lexWhile_ isSpace
        mapM_ (flip matchChar "Improperly formatted LINE pragma") "#-}"
        lexNewline
        return (read i, fn)

    lexNestedComment :: Bool -> String -> Lex a (Bool, String)
    lexNestedComment :: forall a. Bool -> String -> Lex a (Bool, String)
    lexNestedComment Bool
    bol String
    str = do
        s <- Lex a String
    forall r. Lex r String
    getInput
        case s of
            Char
    '-':Char
    '}':String
    _ -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2 Lex a () -> Lex a (Bool, String) -> Lex a (Bool, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Bool, String) -> Lex a (Bool, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    bol, String
    str)
            Char
    '{':Char
    '-':String
    _ -> do
                Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2
                (bol', c) <- Bool -> String -> Lex a (Bool, String)
    forall a. Bool -> String -> Lex a (Bool, String)
    lexNestedComment Bool
    bol (String
    "-{" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    str) -- rest of the subcomment
                lexNestedComment bol' ("}-" ++ c  ) -- rest of this comment
            Char
    '\t':String
    _    -> Lex a ()
    forall a. Lex a ()
    lexTab Lex a () -> Lex a (Bool, String) -> Lex a (Bool, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> String -> Lex a (Bool, String)
    forall a. Bool -> String -> Lex a (Bool, String)
    lexNestedComment Bool
    bol (Char
    '\t'Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    str)
            Char
    '\n':String
    _    -> Lex a ()
    forall a. Lex a ()
    lexNewline Lex a () -> Lex a (Bool, String) -> Lex a (Bool, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> String -> Lex a (Bool, String)
    forall a. Bool -> String -> Lex a (Bool, String)
    lexNestedComment Bool
    True (Char
    '\n'Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    str)
            Char
    c:String
    _       -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1 Lex a () -> Lex a (Bool, String) -> Lex a (Bool, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> String -> Lex a (Bool, String)
    forall a. Bool -> String -> Lex a (Bool, String)
    lexNestedComment Bool
    bol (Char
    cChar -> ShowS
    forall a. a -> [a] -> [a]
    :String
    str)
            []        -> String -> Lex a (Bool, String)
    forall a. String -> Lex a a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Unterminated nested comment"

    -- When we are lexing the first token of a line, check whether we need to
    -- insert virtual semicolons or close braces due to layout.

    lexBOL :: Lex a Token
    lexBOL :: forall a. Lex a Token
    lexBOL = do
        pos <- Lex a Ordering
    forall a. Lex a Ordering
    getOffside
        -- trace ("Off: " ++ (show pos)) $ do
        case pos of
            Ordering
    LT -> do
                    -- trace "layout: inserting '}'\n" $
                -- Set col to 0, indicating that we're still at the
                -- beginning of the line, in case we need a semi-colon too.
                -- Also pop the context here, so that we don't insert
                -- another close brace before the parser can pop it.
                Lex a ()
    forall a. Lex a ()
    setBOL
                String -> Lex a ()
    forall a. String -> Lex a ()
    popContextL String
    "lexBOL"
                Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    VRightCurly
            Ordering
    EQ ->
                -- trace "layout: inserting ';'\n" $
                Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    SemiColon
            Ordering
    GT -> Lex a Token
    forall a. Lex a Token
    lexToken

    lexToken :: Lex a Token
    lexToken :: forall a. Lex a Token
    lexToken = do
        ec <- Lex a (Maybe ExtContext)
    forall a. Lex a (Maybe ExtContext)
    getExtContext
        -- we don't bother to check XmlSyntax since we couldn't
        -- have ended up in a non-Nothing context if it wasn't
        -- enabled.
        case ec of
         Just ExtContext
    HarpCtxt     -> Lex a Token
    forall a. Lex a Token
    lexHarpToken
         Just ExtContext
    TagCtxt      -> Lex a Token
    forall a. Lex a Token
    lexTagCtxt
         Just ExtContext
    CloseTagCtxt -> Lex a Token
    forall a. Lex a Token
    lexCloseTagCtxt
         Just ExtContext
    ChildCtxt    -> Lex a Token
    forall a. Lex a Token
    lexChildCtxt
         Just ExtContext
    CodeTagCtxt  -> Lex a Token
    forall a. Lex a Token
    lexCodeTagCtxt
         Maybe ExtContext
    _         -> Lex a Token
    forall a. Lex a Token
    lexStdToken

    lexChildCtxt :: Lex a Token
    lexChildCtxt :: forall a. Lex a Token
    lexChildCtxt = do
        -- if we ever end up here, then XmlSyntax must be on.
        s <- Lex a String
    forall r. Lex r String
    getInput
        case s of
            Char
    '<':Char
    '%':Char
    '>':String
    _ -> do Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3
                                ExtContext -> Lex a ()
    forall a. ExtContext -> Lex a ()
    pushExtContextL ExtContext
    ChildCtxt
                                Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    XChildTagOpen
            Char
    '<':Char
    '%':String
    _ -> do Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2
                            ExtContext -> Lex a ()
    forall a. ExtContext -> Lex a ()
    pushExtContextL ExtContext
    CodeTagCtxt
                            Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    XCodeTagOpen
            Char
    '<':Char
    '/':String
    _ -> do Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2
                            String -> Lex a ()
    forall a. String -> Lex a ()
    popExtContextL String
    "lexChildCtxt"
                            ExtContext -> Lex a ()
    forall a. ExtContext -> Lex a ()
    pushExtContextL ExtContext
    CloseTagCtxt
                            Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    XCloseTagOpen
            Char
    '<':Char
    '[':String
    _ -> do Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2
                            ExtContext -> Lex a ()
    forall a. ExtContext -> Lex a ()
    pushExtContextL ExtContext
    HarpCtxt
                            Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    XRPatOpen
            Char
    '<':String
    _     -> do Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1
                            ExtContext -> Lex a ()
    forall a. ExtContext -> Lex a ()
    pushExtContextL ExtContext
    TagCtxt
                            Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    XStdTagOpen
            String
    _     -> Lex a Token
    forall a. Lex a Token
    lexPCDATA

    lexPCDATA :: Lex a Token
    lexPCDATA :: forall a. Lex a Token
    lexPCDATA = do
        -- if we ever end up here, then XmlSyntax must be on.
        s <- Lex a String
    forall r. Lex r String
    getInput
        case s of
            [] -> Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    EOF
            String
    _  -> case String
    s of
                Char
    '\n':String
    _ -> do
                    x <- Lex a ()
    forall a. Lex a ()
    lexNewline Lex a () -> Lex a Token -> Lex a Token
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Lex a Token
    forall a. Lex a Token
    lexPCDATA
                    case x of
                     XPCDATA String
    p -> Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Token -> Lex a Token) -> Token -> Lex a Token
    forall a b. (a -> b) -> a -> b
    $ String -> Token
    XPCDATA (String -> Token) -> String -> Token
    forall a b. (a -> b) -> a -> b
    $ Char
    '\n'Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    p
                     Token
    EOF -> Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    EOF
                     Token
    _ -> String -> Lex a Token
    forall a. String -> Lex a a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> Lex a Token) -> String -> Lex a Token
    forall a b. (a -> b) -> a -> b
    $ String
    "lexPCDATA: unexpected token: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Token -> String
    forall a. Show a => a -> String
    show Token
    x
                Char
    '<':String
    _ -> Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Token -> Lex a Token) -> Token -> Lex a Token
    forall a b. (a -> b) -> a -> b
    $ String -> Token
    XPCDATA String
    ""
                String
    _ -> do let pcd :: String
    pcd = (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (\Char
    c -> Char
    c Char -> String -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` String
    "<\n") String
    s
                            l :: Int
    l = String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    pcd
                        Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    l
                        x <- Lex a Token
    forall a. Lex a Token
    lexPCDATA
                        case x of
                         XPCDATA String
    pcd' -> Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Token -> Lex a Token) -> Token -> Lex a Token
    forall a b. (a -> b) -> a -> b
    $ String -> Token
    XPCDATA (String -> Token) -> String -> Token
    forall a b. (a -> b) -> a -> b
    $ String
    pcd String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    pcd'
                         Token
    EOF -> Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    EOF
                         Token
    _ -> String -> Lex a Token
    forall a. String -> Lex a a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> Lex a Token) -> String -> Lex a Token
    forall a b. (a -> b) -> a -> b
    $ String
    "lexPCDATA: unexpected token: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Token -> String
    forall a. Show a => a -> String
    show Token
    x

    lexCodeTagCtxt :: Lex a Token
    lexCodeTagCtxt :: forall a. Lex a Token
    lexCodeTagCtxt = do
        -- if we ever end up here, then XmlSyntax must be on.
        s <- Lex a String
    forall r. Lex r String
    getInput
        case s of
            Char
    '%':Char
    '>':String
    _ -> do Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2
                            String -> Lex a ()
    forall a. String -> Lex a ()
    popExtContextL String
    "lexCodeTagContext"
                            Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    XCodeTagClose
            String
    _     -> Lex a Token
    forall a. Lex a Token
    lexStdToken

    lexCloseTagCtxt :: Lex a Token
    lexCloseTagCtxt :: forall a. Lex a Token
    lexCloseTagCtxt = do
        -- if we ever end up here, then XmlSyntax must be on.
        s <- Lex a String
    forall r. Lex r String
    getInput
        case s of
            Char
    '%':Char
    '>':String
    _ -> do Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2
                            String -> Lex a ()
    forall a. String -> Lex a ()
    popExtContextL String
    "lexCloseTagCtxt"
                            Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    XCodeTagClose
            Char
    '>':String
    _     -> do Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1
                            String -> Lex a ()
    forall a. String -> Lex a ()
    popExtContextL String
    "lexCloseTagCtxt"
                            Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    XStdTagClose
            String
    _     -> Lex a Token
    forall a. Lex a Token
    lexStdToken

    lexTagCtxt :: Lex a Token
    lexTagCtxt :: forall a. Lex a Token
    lexTagCtxt = do
        -- if we ever end up here, then XmlSyntax must be on.
        s <- Lex a String
    forall r. Lex r String
    getInput
        case s of
            Char
    '/':Char
    '>':String
    _ -> do Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2
                            String -> Lex a ()
    forall a. String -> Lex a ()
    popExtContextL String
    "lexTagCtxt: Empty tag"
                            Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    XEmptyTagClose
            Char
    '>':String
    _     -> do Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1
                            String -> Lex a ()
    forall a. String -> Lex a ()
    popExtContextL String
    "lexTagCtxt: Standard tag"
                            ExtContext -> Lex a ()
    forall a. ExtContext -> Lex a ()
    pushExtContextL ExtContext
    ChildCtxt
                            Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    XStdTagClose
            String
    _     -> Lex a Token
    forall a. Lex a Token
    lexStdToken

    lexHarpToken :: Lex a Token
    lexHarpToken :: forall a. Lex a Token
    lexHarpToken = do
        -- if we ever end up here, then RegularPatterns must be on.
        s <- Lex a String
    forall r. Lex r String
    getInput
        case s of
            Char
    ']':Char
    '>':String
    _ -> do Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2
                            String -> Lex a ()
    forall a. String -> Lex a ()
    popExtContextL String
    "lexHarpToken"
                            Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    XRPatClose
            String
    _     -> Lex a Token
    forall a. Lex a Token
    lexStdToken

    lexStdToken :: Lex a Token
    lexStdToken :: forall a. Lex a Token
    lexStdToken = do
        s <- Lex a String
    forall r. Lex r String
    getInput
        exts <- getExtensionsL
        let intHash = ((Integer, String) -> Token)
    -> ((Integer, String) -> Token)
    -> Either String ((Integer, String) -> Token)
    -> Lex a ((Integer, String) -> Token)
    forall b a.
    (b -> Token)
    -> (b -> Token) -> Either String (b -> Token) -> Lex a (b -> Token)
    lexHash (Integer, String) -> Token
    IntTok (Integer, String) -> Token
    IntTokHash (((Integer, String) -> Token)
    -> Either String ((Integer, String) -> Token)
    forall a b. b -> Either a b
    Right (Integer, String) -> Token
    WordTokHash)
        case s of
            [] -> Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    EOF

            Char
    '0':Char
    c:Char
    d:String
    _ | Char -> Char
    toLower Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'o' Bool -> Bool -> Bool
    && Char -> Bool
    isOctDigit Char
    d -> do
                            Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2
                            (n, str) <- Lex a (Integer, String)
    forall a. Lex a (Integer, String)
    lexOctal
                            con <- intHash
                            return (con (n, '0':c:str))
                      | Char -> Char
    toLower Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'b' Bool -> Bool -> Bool
    && Char -> Bool
    isBinDigit Char
    d Bool -> Bool -> Bool
    && KnownExtension
    BinaryLiterals KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts -> do
                            Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2
                            (n, str) <- Lex a (Integer, String)
    forall a. Lex a (Integer, String)
    lexBinary
                            con <- intHash
                            return (con (n, '0':c:str))
                      | Char -> Char
    toLower Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'x' Bool -> Bool -> Bool
    && Char -> Bool
    isHexDigit Char
    d -> do
                            Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2
                            (n, str) <- Lex a (Integer, String)
    forall a. Lex a (Integer, String)
    lexHexadecimal
                            con <- intHash
                            return (con (n, '0':c:str))

            -- implicit parameters
            Char
    '?':Char
    c:String
    _ | Char -> Bool
    isIdentStart Char
    c Bool -> Bool -> Bool
    && KnownExtension
    ImplicitParams KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts -> do
                            Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1
                            id <- (Char -> Bool) -> Lex a String
    forall a. (Char -> Bool) -> Lex a String
    lexWhile Char -> Bool
    isIdent
                            return $ IDupVarId id

            Char
    '%':Char
    c:String
    _ | Char -> Bool
    isIdentStart Char
    c Bool -> Bool -> Bool
    && KnownExtension
    ImplicitParams KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts -> do
                            Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1
                            id <- (Char -> Bool) -> Lex a String
    forall a. (Char -> Bool) -> Lex a String
    lexWhile Char -> Bool
    isIdent
                            return $ ILinVarId id
            -- end implicit parameters

            -- harp
            Char
    '(':Char
    '|':Char
    c:String
    _ | KnownExtension
    RegularPatterns KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts Bool -> Bool -> Bool
    && Bool -> Bool
    not (Char -> Bool
    isHSymbol Char
    c) ->
                            Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2 Lex a () -> Lex a Token -> Lex a Token
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    RPGuardOpen
                        | KnownExtension
    Arrows KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts Bool -> Bool -> Bool
    && Bool -> Bool
    not (Char -> Bool
    isHSymbol Char
    c) ->
                            Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2 Lex a () -> Lex a Token -> Lex a Token
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    OpenArrowBracket
            Char
    '|':Char
    ')':String
    _ | KnownExtension
    RegularPatterns KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2 Lex a () -> Lex a Token -> Lex a Token
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    RPGuardClose
                      | KnownExtension
    Arrows KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2 Lex a () -> Lex a Token -> Lex a Token
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    CloseArrowBracket
            {- This is handled by the reserved_ops above.
            '@':':':_ | RegularPatterns `elem` exts ->
                         do discard 2
                            return RPCAt -}

            -- template haskell
            Char
    '[':Char
    '|':Char
    '|':String
    _ | KnownExtension
    TemplateHaskell KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts -> do
                    Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3
                    Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    THTExpQuote

            Char
    '[':Char
    'e':Char
    '|':Char
    '|':String
    _ | KnownExtension
    TemplateHaskell KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts -> do
                    Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    4
                    Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    THTExpQuote

            Char
    '[':Char
    '|':String
    _ | KnownExtension
    TemplateHaskell KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts -> do
                    Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2
                    Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    THExpQuote

            Char
    '[':Char
    c:Char
    '|':String
    _ | Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'e' Bool -> Bool -> Bool
    && KnownExtension
    TemplateHaskell KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts -> do
                            Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3
                            Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    THExpQuote
                        | Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'p' Bool -> Bool -> Bool
    && KnownExtension
    TemplateHaskell KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts -> do
                            Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3
                            Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    THPatQuote
                        | Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'd' Bool -> Bool -> Bool
    && KnownExtension
    TemplateHaskell KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts -> do
                            Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3
                            Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    THDecQuote
                        | Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    't' Bool -> Bool -> Bool
    && KnownExtension
    TemplateHaskell KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts -> do
                            Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3
                            Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    THTypQuote
            Char
    '[':Char
    '$':Char
    c:String
    _ | Char -> Bool
    isIdentStart Char
    c Bool -> Bool -> Bool
    && KnownExtension
    QuasiQuotes KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts ->
                            Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2 Lex a () -> Lex a Token -> Lex a Token
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Char -> Lex a Token
    forall a. Char -> Lex a Token
    lexQuasiQuote Char
    c

            Char
    '[':Char
    c:String
    s' | Char -> Bool
    isIdentStart Char
    c Bool -> Bool -> Bool
    && KnownExtension
    QuasiQuotes KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts Bool -> Bool -> Bool
    && case (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isIdent String
    s' of { Char
    '|':String
    _ -> Bool
    True;String
    _->Bool
    False} ->
                            Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1 Lex a () -> Lex a Token -> Lex a Token
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Char -> Lex a Token
    forall a. Char -> Lex a Token
    lexQuasiQuote Char
    c
                     | Char -> Bool
    isUpper Char
    c Bool -> Bool -> Bool
    && KnownExtension
    QuasiQuotes KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts Bool -> Bool -> Bool
    && case (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isPossiblyQvar String
    s' of { Char
    '|':String
    _ -> Bool
    True;String
    _->Bool
    False} ->
                            Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1 Lex a () -> Lex a Token -> Lex a Token
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Char -> Lex a Token
    forall a. Char -> Lex a Token
    lexQuasiQuote Char
    c

            Char
    '|':Char
    '|':Char
    ']':String
    _ | KnownExtension
    TemplateHaskell KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts -> do
                            Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3
                            Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    THTCloseQuote
            Char
    '|':Char
    ']':String
    _ | KnownExtension
    TemplateHaskell KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts -> do
                            Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2
                            Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    THCloseQuote

            Char
    '$':Char
    c1:Char
    c2:String
    _ | Char -> Bool
    isIdentStart Char
    c1 Bool -> Bool -> Bool
    && KnownExtension
    TemplateHaskell KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts -> do
                            Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1
                            id <- (Char -> Bool) -> Lex a String
    forall a. (Char -> Bool) -> Lex a String
    lexWhile Char -> Bool
    isIdent
                            return $ THIdEscape id
                        | Char
    c1 Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '(' Bool -> Bool -> Bool
    && KnownExtension
    TemplateHaskell KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts -> do
                            Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2
                            Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    THParenEscape
                        | Char
    c1 Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '$' Bool -> Bool -> Bool
    && Char -> Bool
    isIdentStart Char
    c2 Bool -> Bool -> Bool
    && KnownExtension
    TemplateHaskell KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts -> do
                            Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2
                            id <- (Char -> Bool) -> Lex a String
    forall a. (Char -> Bool) -> Lex a String
    lexWhile Char -> Bool
    isIdent
                            return $ THTIdEscape id
                        | Char
    c1 Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '$' Bool -> Bool -> Bool
    && Char
    c2 Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '(' Bool -> Bool -> Bool
    && KnownExtension
    TemplateHaskell KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts -> do
                            Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3
                            Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    THTParenEscape
            -- end template haskell

            -- hsx
            Char
    '<':Char
    '%':Char
    c:String
    _ | KnownExtension
    XmlSyntax KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts ->
                            case Char
    c of
                             Char
    '>' -> do Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3
                                       ExtContext -> Lex a ()
    forall a. ExtContext -> Lex a ()
    pushExtContextL ExtContext
    ChildCtxt
                                       Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    XChildTagOpen
                             Char
    _   -> do Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2
                                       ExtContext -> Lex a ()
    forall a. ExtContext -> Lex a ()
    pushExtContextL ExtContext
    CodeTagCtxt
                                       Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    XCodeTagOpen
            Char
    '<':Char
    c:String
    _ | Char -> Bool
    isAlpha Char
    c Bool -> Bool -> Bool
    && KnownExtension
    XmlSyntax KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts -> do
                            Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1
                            ExtContext -> Lex a ()
    forall a. ExtContext -> Lex a ()
    pushExtContextL ExtContext
    TagCtxt
                            Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    XStdTagOpen
            -- end hsx

            Char
    '(':Char
    '#':Char
    c:String
    _ | [KnownExtension] -> Bool
    unboxed [KnownExtension]
    exts Bool -> Bool -> Bool
    && Bool -> Bool
    not (Char -> Bool
    isHSymbol Char
    c) -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2 Lex a () -> Lex a Token -> Lex a Token
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    LeftHashParen

            Char
    '#':Char
    ')':String
    _   | [KnownExtension] -> Bool
    unboxed [KnownExtension]
    exts -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2 Lex a () -> Lex a Token -> Lex a Token
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    RightHashParen

            -- pragmas

            Char
    '{':Char
    '-':Char
    '#':String
    _ -> Lex a ()
    forall a. Lex a ()
    saveExtensionsL Lex a () -> Lex a () -> Lex a ()
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3 Lex a () -> Lex a Token -> Lex a Token
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Lex a Token
    forall a. Lex a Token
    lexPragmaStart

            Char
    '#':Char
    '-':Char
    '}':String
    _ -> Lex a ()
    forall a. Lex a ()
    restoreExtensionsL Lex a () -> Lex a () -> Lex a ()
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3 Lex a () -> Lex a Token -> Lex a Token
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    PragmaEnd

            -- Parallel arrays

            Char
    '[':Char
    ':':String
    _ | KnownExtension
    ParallelArrays KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2 Lex a () -> Lex a Token -> Lex a Token
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    ParArrayLeftSquare

            Char
    ':':Char
    ']':String
    _ | KnownExtension
    ParallelArrays KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2 Lex a () -> Lex a Token -> Lex a Token
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    ParArrayRightSquare

            -- Lexed seperately to deal with visible type applciation

            Char
    '@':Char
    c:String
    _ | KnownExtension
    TypeApplications KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts
                       -- Operator starting with an '@'
                       Bool -> Bool -> Bool
    && Bool -> Bool
    not (Char -> Bool
    isOpSymbol Char
    c) -> do
                                                    lc <- Lex a Char
    forall r. Lex r Char
    getLastChar
                                                    if isIdent lc
                                                      then discard 1 >> return At
                                                      else discard 1 >> return TApp

            Char
    '#':Char
    c:String
    _ | KnownExtension
    OverloadedLabels KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts
                       Bool -> Bool -> Bool
    && Char -> Bool
    isIdentStart Char
    c -> do
                                                      Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1
                                                      [ident] <- Lex a [String]
    forall a. Lex a [String]
    lexIdents
                                                      return $ LabelVarId ident

            Char
    c:String
    _ | Char -> Bool
    isDigit Char
    c -> Lex a Token
    forall a. Lex a Token
    lexDecimalOrFloat

                | Char -> Bool
    isUpper Char
    c -> String -> Lex a Token
    forall a. String -> Lex a Token
    lexConIdOrQual String
    ""

                | Char -> Bool
    isIdentStart Char
    c -> do
                        idents <- Lex a [String]
    forall a. Lex a [String]
    lexIdents
                        case idents of
                         [String
    ident] -> case String
    -> [(String, (Token, Maybe ExtScheme))]
    -> Maybe (Token, Maybe ExtScheme)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    ident ([(String, (Token, Maybe ExtScheme))]
    reserved_ids [(String, (Token, Maybe ExtScheme))]
    -> [(String, (Token, Maybe ExtScheme))]
    -> [(String, (Token, Maybe ExtScheme))]
    forall a. [a] -> [a] -> [a]
    ++ [(String, (Token, Maybe ExtScheme))]
    special_varids) of
                                     Just (Token
    keyword, Maybe ExtScheme
    scheme) ->
                                        -- check if an extension keyword is enabled
                                        if Maybe ExtScheme -> [KnownExtension] -> Bool
    forall a. Enabled a => a -> [KnownExtension] -> Bool
    isEnabled Maybe ExtScheme
    scheme [KnownExtension]
    exts
                                         then Token -> Lex a ()
    forall a. Token -> Lex a ()
    flagKW Token
    keyword Lex a () -> Lex a Token -> Lex a Token
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    keyword
                                         else Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Token -> Lex a Token) -> Token -> Lex a Token
    forall a b. (a -> b) -> a -> b
    $ String -> Token
    VarId String
    ident
                                     Maybe (Token, Maybe ExtScheme)
    Nothing -> Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Token -> Lex a Token) -> Token -> Lex a Token
    forall a b. (a -> b) -> a -> b
    $ String -> Token
    VarId String
    ident
                         [String]
    _ -> Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Token -> Lex a Token) -> Token -> Lex a Token
    forall a b. (a -> b) -> a -> b
    $ [String] -> Token
    DVarId [String]
    idents

                | Char -> Bool
    isHSymbol Char
    c -> do
                        sym <- (Char -> Bool) -> Lex a String
    forall a. (Char -> Bool) -> Lex a String
    lexWhile Char -> Bool
    isHSymbol
                        return $ case lookup sym (reserved_ops ++ special_varops) of
                                  Just (Token
    t , Maybe ExtScheme
    scheme) ->
                                    -- check if an extension op is enabled
                                    if Maybe ExtScheme -> [KnownExtension] -> Bool
    forall a. Enabled a => a -> [KnownExtension] -> Bool
    isEnabled Maybe ExtScheme
    scheme [KnownExtension]
    exts
                                     then Token
    t
                                     else case Char
    c of
                                            Char
    ':' -> String -> Token
    ConSym String
    sym
                                            Char
    _   -> String -> Token
    VarSym String
    sym
                                  Maybe (Token, Maybe ExtScheme)
    Nothing -> case Char
    c of
                                              Char
    ':' -> String -> Token
    ConSym String
    sym
                                              Char
    _   -> String -> Token
    VarSym String
    sym

                | Bool
    otherwise -> do
                        Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1
                        case Char
    c of

                            -- First the special symbols
                            Char
    '(' ->  Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    LeftParen
                            Char
    ')' ->  Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    RightParen
                            Char
    ',' ->  Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    Comma
                            Char
    ';' ->  Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    SemiColon
                            Char
    '[' ->  Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    LeftSquare
                            Char
    ']' ->  Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    RightSquare
                            Char
    '`' ->  Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    BackQuote
                            Char
    '{' -> do
                                LexContext -> Lex a ()
    forall a. LexContext -> Lex a ()
    pushContextL LexContext
    NoLayout
                                Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    LeftCurly
                            Char
    '}' -> do
                                String -> Lex a ()
    forall a. String -> Lex a ()
    popContextL String
    "lexStdToken"
                                Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    RightCurly

                            Char
    '\'' -> Lex a Token
    forall a. Lex a Token
    lexCharacter
                            Char
    '"' ->  Lex a Token
    forall a. Lex a Token
    lexString

                            Char
    _ ->    String -> Lex a Token
    forall a. String -> Lex a a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String
    "Illegal character \'" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Char -> String
    forall a. Show a => a -> String
    show Char
    c String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\'\n")

          where lexIdents :: Lex a [String]
                lexIdents :: forall a. Lex a [String]
    lexIdents = do
                    ident <- (Char -> Bool) -> Lex a String
    forall a. (Char -> Bool) -> Lex a String
    lexWhile Char -> Bool
    isIdent
                    s <- getInput
                    exts <- getExtensionsL
                    case s of
                     -- This is the only way we can get more than one ident in the list
                     -- and it requires XmlSyntax to be on.
                     Char
    '-':Char
    c:String
    _ | KnownExtension
    XmlSyntax KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts Bool -> Bool -> Bool
    && Char -> Bool
    isAlpha Char
    c -> do
                            Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1
                            idents <- Lex a [String]
    forall a. Lex a [String]
    lexIdents
                            return $ ident : idents
                     Char
    '#':String
    _ | KnownExtension
    MagicHash KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts -> do
                            hashes <- (Char -> Bool) -> Lex a String
    forall a. (Char -> Bool) -> Lex a String
    lexWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '#')
                            return [ident ++ hashes]
                     String
    _ -> [String] -> Lex a [String]
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [String
    ident]

                lexQuasiQuote :: Char -> Lex a Token
                lexQuasiQuote :: forall a. Char -> Lex a Token
    lexQuasiQuote Char
    c = do
                    -- We've seen and dropped [$ already
                    ident <- Lex a String
    forall r. Lex r String
    lexQuoter
                    matchChar '|' "Malformed quasi-quote quoter"
                    body <- lexQQBody
                    return $ THQuasiQuote (ident, body)
                      where lexQuoter :: Lex a String
    lexQuoter
                             | Char -> Bool
    isIdentStart Char
    c = (Char -> Bool) -> Lex a String
    forall a. (Char -> Bool) -> Lex a String
    lexWhile Char -> Bool
    isIdent
                             | Bool
    otherwise = do
                                qualThing <- String -> Lex a Token
    forall a. String -> Lex a Token
    lexConIdOrQual String
    ""
                                case qualThing of
                                    QVarId (String
    s1,String
    s2) -> String -> Lex a String
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Lex a String) -> String -> Lex a String
    forall a b. (a -> b) -> a -> b
    $ String
    s1 String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Char
    '.'Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    s2
                                    QVarSym (String
    s1, String
    s2) -> String -> Lex a String
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Lex a String) -> String -> Lex a String
    forall a b. (a -> b) -> a -> b
    $ String
    s1 String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Char
    '.'Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    s2
                                    Token
    _                -> String -> Lex a String
    forall a. String -> Lex a a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Malformed quasi-quote quoter"

                lexQQBody :: Lex a String
                lexQQBody :: forall r. Lex r String
    lexQQBody = do
                    s <- Lex a String
    forall r. Lex r String
    getInput
                    case s of
                      Char
    '\\':Char
    ']':String
    _ -> do Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2
                                       str <- Lex a String
    forall r. Lex r String
    lexQQBody
                                       return (']':str)
                      Char
    '\\':Char
    '|':String
    _ -> do Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2
                                       str <- Lex a String
    forall r. Lex r String
    lexQQBody
                                       return ('|':str)
                      Char
    '|':Char
    ']':String
    _  -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2 Lex a () -> Lex a String -> Lex a String
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> String -> Lex a String
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    ""
                      Char
    '|':String
    _ -> do Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1
                                  str <- Lex a String
    forall r. Lex r String
    lexQQBody
                                  return ('|':str)
                      Char
    ']':String
    _ -> do Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1
                                  str <- Lex a String
    forall r. Lex r String
    lexQQBody
                                  return (']':str)
                      Char
    '\\':String
    _ -> do Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1
                                   str <- Lex a String
    forall r. Lex r String
    lexQQBody
                                   return ('\\':str)
                      Char
    '\n':String
    _ -> do Lex a ()
    forall a. Lex a ()
    lexNewline
                                   str <- Lex a String
    forall r. Lex r String
    lexQQBody
                                   return ('\n':str)
                      []     -> String -> Lex a String
    forall a. String -> Lex a a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Unexpected end of input while lexing quasi-quoter"
                      String
    _ -> do str <- (Char -> Bool) -> Lex a String
    forall a. (Char -> Bool) -> Lex a String
    lexWhile (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    "\\|\n"))
                              rest <- lexQQBody
                              return (str++rest)

    unboxed :: [KnownExtension] -> Bool
    unboxed :: [KnownExtension] -> Bool
    unboxed [KnownExtension]
    exts = KnownExtension
    UnboxedSums KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts Bool -> Bool -> Bool
    || KnownExtension
    UnboxedTuples KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts

    -- Underscores are used in some pragmas. Options pragmas are a special case
    -- with our representation: the thing after the underscore is a parameter.
    -- Strip off the parameters to option pragmas by hand here, everything else
    -- sits in the pragmas map.
    lookupKnownPragma :: String -> Maybe Token
    lookupKnownPragma :: String -> Maybe Token
    lookupKnownPragma String
    s =
        case (Char -> Char) -> ShowS
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower String
    s of
          String
    x | String
    "options_" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    x -> Token -> Maybe Token
    forall a. a -> Maybe a
    Just (Token -> Maybe Token) -> Token -> Maybe Token
    forall a b. (a -> b) -> a -> b
    $ (Maybe String, String) -> Token
    OPTIONS (String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ Int -> ShowS
    forall a. Int -> [a] -> [a]
    drop Int
    8 String
    s, String
    forall a. HasCallStack => a
    undefined)
            | String
    "options" String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    x            -> Token -> Maybe Token
    forall a. a -> Maybe a
    Just (Token -> Maybe Token) -> Token -> Maybe Token
    forall a b. (a -> b) -> a -> b
    $ (Maybe String, String) -> Token
    OPTIONS (Maybe String
    forall a. Maybe a
    Nothing, String
    forall a. HasCallStack => a
    undefined)
            | Bool
    otherwise                 -> String -> [(String, Token)] -> Maybe Token
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    x [(String, Token)]
    pragmas

    lexPragmaStart :: Lex a Token
    lexPragmaStart :: forall a. Lex a Token
    lexPragmaStart = do
        (Char -> Bool) -> Lex a ()
    forall a. (Char -> Bool) -> Lex a ()
    lexWhile_ Char -> Bool
    isSpace
        pr <- (Char -> Bool) -> Lex a String
    forall a. (Char -> Bool) -> Lex a String
    lexWhile Char -> Bool
    isPragmaChar
        case lookupKnownPragma pr of
         Just (INLINE Bool
    True) -> do
                s <- Lex a String
    forall r. Lex r String
    getInput
                case map toLower s of
                 Char
    ' ':Char
    'c':Char
    'o':Char
    'n':Char
    'l':Char
    'i':Char
    'k':Char
    'e':String
    _  -> do
                          Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    8
                          Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    INLINE_CONLIKE
                 String
    _ -> Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Token -> Lex a Token) -> Token -> Lex a Token
    forall a b. (a -> b) -> a -> b
    $ Bool -> Token
    INLINE Bool
    True
         Just Token
    SPECIALISE -> do
                s <- Lex a String
    forall r. Lex r String
    getInput
                case dropWhile isSpace $ map toLower s of
                 Char
    'i':Char
    'n':Char
    'l':Char
    'i':Char
    'n':Char
    'e':String
    _ -> do
                          (Char -> Bool) -> Lex a ()
    forall a. (Char -> Bool) -> Lex a ()
    lexWhile_ Char -> Bool
    isSpace
                          Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    6
                          Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Token -> Lex a Token) -> Token -> Lex a Token
    forall a b. (a -> b) -> a -> b
    $ Bool -> Token
    SPECIALISE_INLINE Bool
    True
                 Char
    'n':Char
    'o':Char
    'i':Char
    'n':Char
    'l':Char
    'i':Char
    'n':Char
    'e':String
    _ -> do
                            (Char -> Bool) -> Lex a ()
    forall a. (Char -> Bool) -> Lex a ()
    lexWhile_ Char -> Bool
    isSpace
                            Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    8
                            Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Token -> Lex a Token) -> Token -> Lex a Token
    forall a b. (a -> b) -> a -> b
    $ Bool -> Token
    SPECIALISE_INLINE Bool
    False
                 Char
    'n':Char
    'o':Char
    't':Char
    'i':Char
    'n':Char
    'l':Char
    'i':Char
    'n':Char
    'e':String
    _ -> do
                            (Char -> Bool) -> Lex a ()
    forall a. (Char -> Bool) -> Lex a ()
    lexWhile_ Char -> Bool
    isSpace
                            Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    9
                            Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Token -> Lex a Token) -> Token -> Lex a Token
    forall a b. (a -> b) -> a -> b
    $ Bool -> Token
    SPECIALISE_INLINE Bool
    False
                 String
    _ -> Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    SPECIALISE

         Just (OPTIONS (Maybe String, String)
    opt) ->     -- see, I promised we'd mask out the 'undefined'
                -- We do not want to store necessary whitespace in the datatype
                -- but if the pragma starts with a newline then we must keep
                -- it to differentiate the two cases.
                let dropIfSpace :: ShowS
    dropIfSpace (Char
    ' ':String
    xs) = String
    xs
                    dropIfSpace String
    xs       = String
    xs
                 in
                  case (Maybe String, String) -> Maybe String
    forall a b. (a, b) -> a
    fst (Maybe String, String)
    opt of
                    Just String
    opt' -> do
                      rest <- Lex a String
    forall r. Lex r String
    lexRawPragma
                      return $ OPTIONS (Just opt', dropIfSpace rest)
                    Maybe String
    Nothing -> do
                      s <- Lex a String
    forall r. Lex r String
    getInput
                      case s of
                        Char
    x:String
    _ | Char -> Bool
    isSpace Char
    x -> do
                          rest <- Lex a String
    forall r. Lex r String
    lexRawPragma
                          return $ OPTIONS (Nothing, dropIfSpace rest)
                        String
    _  -> String -> Lex a Token
    forall a. String -> Lex a a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Malformed Options pragma"
         Just Token
    RULES -> do -- Rules enable ScopedTypeVariables locally.
                KnownExtension -> Lex a ()
    forall a. KnownExtension -> Lex a ()
    addExtensionL KnownExtension
    ScopedTypeVariables
                Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    RULES
    {-     Just (CFILES _) -> do
                rest <- lexRawPragma
                return $ CFILES rest
         Just (INCLUDE _) -> do
                rest <- lexRawPragma
                return $ INCLUDE rest -}
         Just Token
    p ->  Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    p

         Maybe Token
    _      -> String -> Lex a Token
    forall a. String -> Lex a a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Internal error: Unrecognised recognised pragma"
                      -- do rawStr <- lexRawPragma
                      -- return $ PragmaUnknown (pr, rawStr) -- no support for unrecognized pragmas, treat as comment
                      -- discard 3 -- #-}
                      -- topLexer -- we just discard it as a comment for now and restart -}

    lexRawPragma :: Lex a String
    lexRawPragma :: forall r. Lex r String
    lexRawPragma = Lex a String
    forall r. Lex r String
    lexRawPragmaAux
     where lexRawPragmaAux :: Lex a String
    lexRawPragmaAux = do
            rpr <- (Char -> Bool) -> Lex a String
    forall a. (Char -> Bool) -> Lex a String
    lexWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /=Char
    '#')
            s <- getInput
            case s of
             Char
    '#':Char
    '-':Char
    '}':String
    _  -> String -> Lex a String
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    rpr
             String
    "" -> String -> Lex a String
    forall a. String -> Lex a a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "End-of-file inside pragma"
             String
    _ -> do
                Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1
                rpr' <- Lex a String
    forall r. Lex r String
    lexRawPragma
                return $ rpr ++ '#':rpr'

    lexDecimalOrFloat :: Lex a Token
    lexDecimalOrFloat :: forall a. Lex a Token
    lexDecimalOrFloat = do
        ds <- (Char -> Bool) -> Lex a String
    forall a. (Char -> Bool) -> Lex a String
    lexWhile Char -> Bool
    isDigit
        rest <- getInput
        exts <- getExtensionsL
        case rest of
            (Char
    '.':Char
    d:String
    _) | Char -> Bool
    isDigit Char
    d -> do
                    Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1
                    frac <- (Char -> Bool) -> Lex a String
    forall a. (Char -> Bool) -> Lex a String
    lexWhile Char -> Bool
    isDigit
                    let num = Integer -> String -> Integer
    parseInteger Integer
    10 (String
    ds String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    frac)
                        decimals = Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    frac)
                    (exponent, estr) <- do
                        rest2 <- getInput
                        case rest2 of
                            Char
    'e':String
    _ -> Lex a (Integer, String)
    forall a. Lex a (Integer, String)
    lexExponent
                            Char
    'E':String
    _ -> Lex a (Integer, String)
    forall a. Lex a (Integer, String)
    lexExponent
                            String
    _     -> (Integer, String) -> Lex a (Integer, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer
    0,String
    "")
                    con <- lexHash FloatTok FloatTokHash (Right DoubleTokHash)
                    return $ con ((num%1) * 10^^(exponent - decimals), ds ++ '.':frac ++ estr)
            Char
    e:String
    _ | Char -> Char
    toLower Char
    e Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'e' -> do
                    (exponent, estr) <- Lex a (Integer, String)
    forall a. Lex a (Integer, String)
    lexExponent
                    con <- lexHash FloatTok FloatTokHash (Right DoubleTokHash)
                    return $ con ((parseInteger 10 ds%1) * 10^^exponent, ds ++ estr)
            Char
    '#':Char
    '#':String
    _ | KnownExtension
    MagicHash KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2 Lex a () -> Lex a Token -> Lex a Token
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Integer, String) -> Token
    WordTokHash (Integer -> String -> Integer
    parseInteger Integer
    10 String
    ds, String
    ds))
            Char
    '#':String
    _     | KnownExtension
    MagicHash KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1 Lex a () -> Lex a Token -> Lex a Token
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Integer, String) -> Token
    IntTokHash  (Integer -> String -> Integer
    parseInteger Integer
    10 String
    ds, String
    ds))
            String
    _         ->              Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Integer, String) -> Token
    IntTok      (Integer -> String -> Integer
    parseInteger Integer
    10 String
    ds, String
    ds))

        where
        lexExponent :: Lex a (Integer, String)
        lexExponent :: forall a. Lex a (Integer, String)
    lexExponent = do
            (e:r) <- Lex a String
    forall r. Lex r String
    getInput
            discard 1   -- 'e' or 'E'
            case r of
             Char
    '+':Char
    d:String
    _ | Char -> Bool
    isDigit Char
    d -> do
                Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1
                (n, str) <- Lex a (Integer, String)
    forall a. Lex a (Integer, String)
    lexDecimal
                return (n, e:'+':str)
             Char
    '-':Char
    d:String
    _ | Char -> Bool
    isDigit Char
    d -> do
                Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1
                (n, str) <- Lex a (Integer, String)
    forall a. Lex a (Integer, String)
    lexDecimal
                return (negate n, e:'-':str)
             Char
    d:String
    _ | Char -> Bool
    isDigit Char
    d -> Lex a (Integer, String)
    forall a. Lex a (Integer, String)
    lexDecimal Lex a (Integer, String)
    -> ((Integer, String) -> Lex a (Integer, String))
    -> Lex a (Integer, String)
    forall a b. Lex a a -> (a -> Lex a b) -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \(Integer
    n,String
    str) -> (Integer, String) -> Lex a (Integer, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer
    n, Char
    eChar -> ShowS
    forall a. a -> [a] -> [a]
    :String
    str)
             String
    _ -> String -> Lex a (Integer, String)
    forall a. String -> Lex a a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Float with missing exponent"

    lexHash :: (b -> Token) -> (b -> Token) -> Either String (b -> Token) -> Lex a (b -> Token)
    lexHash :: forall b a.
    (b -> Token)
    -> (b -> Token) -> Either String (b -> Token) -> Lex a (b -> Token)
    lexHash b -> Token
    a b -> Token
    b Either String (b -> Token)
    c = do
        exts <- Lex a [KnownExtension]
    forall a. Lex a [KnownExtension]
    getExtensionsL
        if MagicHash `elem` exts
         then do
            r <- getInput
            case r of
             Char
    '#':Char
    '#':String
    _ -> case Either String (b -> Token)
    c of
                           Right b -> Token
    c' -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2 Lex a () -> Lex a (b -> Token) -> Lex a (b -> Token)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (b -> Token) -> Lex a (b -> Token)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return b -> Token
    c'
                           Left String
    s  -> String -> Lex a (b -> Token)
    forall a. String -> Lex a a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    s
             Char
    '#':String
    _     -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1 Lex a () -> Lex a (b -> Token) -> Lex a (b -> Token)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (b -> Token) -> Lex a (b -> Token)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return b -> Token
    b
             String
    _         ->              (b -> Token) -> Lex a (b -> Token)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return b -> Token
    a
         else return a

    lexConIdOrQual :: String -> Lex a Token
    lexConIdOrQual :: forall a. String -> Lex a Token
    lexConIdOrQual String
    qual = do
            con <- (Char -> Bool) -> Lex a String
    forall a. (Char -> Bool) -> Lex a String
    lexWhile Char -> Bool
    isIdent
            let conid | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    qual = String -> Token
    ConId String
    con
                      | Bool
    otherwise = (String, String) -> Token
    QConId (String
    qual,String
    con)
                qual' | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    qual = String
    con
                      | Bool
    otherwise = String
    qual String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Char
    '.'Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    con
            just_a_conid <- alternative (return conid)
            rest <- getInput
            exts <- getExtensionsL
            case rest of
              Char
    '.':Char
    c:String
    _
                 | Char -> Bool
    isIdentStart Char
    c -> do  -- qualified varid?
                        Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1
                        ident <- (Char -> Bool) -> Lex a String
    forall a. (Char -> Bool) -> Lex a String
    lexWhile Char -> Bool
    isIdent
                        s <- getInput
                        exts' <- getExtensionsL
                        ident' <- case s of
                                   Char
    '#':String
    _ | KnownExtension
    MagicHash KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts' -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1 Lex a () -> Lex a String -> Lex a String
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> String -> Lex a String
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    ident String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "#")
                                   String
    _ -> String -> Lex a String
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    ident
                        case lookup ident' reserved_ids of
                           -- cannot qualify a reserved word
                           Just (Token
    _,Maybe ExtScheme
    scheme) | Maybe ExtScheme -> [KnownExtension] -> Bool
    forall a. Enabled a => a -> [KnownExtension] -> Bool
    isEnabled Maybe ExtScheme
    scheme [KnownExtension]
    exts'  -> Lex a Token
    just_a_conid
                           Maybe (Token, Maybe ExtScheme)
    _ -> Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((String, String) -> Token
    QVarId (String
    qual', String
    ident'))

                 | Char -> Bool
    isUpper Char
    c -> do      -- qualified conid?
                        Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1
                        String -> Lex a Token
    forall a. String -> Lex a Token
    lexConIdOrQual String
    qual'

                 | Char -> Bool
    isHSymbol Char
    c -> do    -- qualified symbol?
                        Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1
                        sym <- (Char -> Bool) -> Lex a String
    forall a. (Char -> Bool) -> Lex a String
    lexWhile Char -> Bool
    isHSymbol
                        exts' <- getExtensionsL
                        case lookup sym reserved_ops of
                            -- cannot qualify a reserved operator
                            Just (Token
    _,Maybe ExtScheme
    scheme) | Maybe ExtScheme -> [KnownExtension] -> Bool
    forall a. Enabled a => a -> [KnownExtension] -> Bool
    isEnabled Maybe ExtScheme
    scheme [KnownExtension]
    exts' -> Lex a Token
    just_a_conid
                            Maybe (Token, Maybe ExtScheme)
    _        -> Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Token -> Lex a Token) -> Token -> Lex a Token
    forall a b. (a -> b) -> a -> b
    $ case Char
    c of
                                                  Char
    ':' -> (String, String) -> Token
    QConSym (String
    qual', String
    sym)
                                                  Char
    _   -> (String, String) -> Token
    QVarSym (String
    qual', String
    sym)

              Char
    '#':String
    cs
                | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    cs Bool -> Bool -> Bool
    ||
                  Bool -> Bool
    not (Char -> Bool
    isHSymbol (Char -> Bool) -> Char -> Bool
    forall a b. (a -> b) -> a -> b
    $ String -> Char
    forall a. HasCallStack => [a] -> a
    head String
    cs) Bool -> Bool -> Bool
    &&
                  Bool -> Bool
    not (Char -> Bool
    isIdent (Char -> Bool) -> Char -> Bool
    forall a b. (a -> b) -> a -> b
    $ String -> Char
    forall a. HasCallStack => [a] -> a
    head String
    cs) Bool -> Bool -> Bool
    && KnownExtension
    MagicHash KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts -> do
                    Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1
                    case Token
    conid of
                     ConId String
    con' -> Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Token -> Lex a Token) -> Token -> Lex a Token
    forall a b. (a -> b) -> a -> b
    $ String -> Token
    ConId (String -> Token) -> String -> Token
    forall a b. (a -> b) -> a -> b
    $ String
    con' String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "#"
                     QConId (String
    q,String
    con') -> Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Token -> Lex a Token) -> Token -> Lex a Token
    forall a b. (a -> b) -> a -> b
    $ (String, String) -> Token
    QConId (String
    q,String
    con' String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "#")
                     Token
    _ -> String -> Lex a Token
    forall a. String -> Lex a a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> Lex a Token) -> String -> Lex a Token
    forall a b. (a -> b) -> a -> b
    $ String
    "lexConIdOrQual: unexpected token: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Token -> String
    forall a. Show a => a -> String
    show Token
    conid
              String
    _ ->  Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    conid -- not a qualified thing

    lexCharacter :: Lex a Token
    lexCharacter :: forall a. Lex a Token
    lexCharacter = do   -- We need to keep track of not only character constants but also TH 'x and ''T
            -- We've seen ' so far
            s <- Lex a String
    forall r. Lex r String
    getInput
            exts <- getExtensionsL
            case s of
             Char
    '\'':String
    _ | KnownExtension
    TemplateHaskell KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1 Lex a () -> Lex a Token -> Lex a Token
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    THTyQuote
             Char
    '\\':String
    _ -> do
                        (c,raw) <- Lex a (Char, String)
    forall a. Lex a (Char, String)
    lexEscape
                        matchQuote
                        con <- lexHash Character CharacterHash
                                (Left "Double hash not available for character literals")
                        return (con (c, '\\':raw))
             Char
    c:Char
    '\'':String
    _ -> do
                        Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2
                        con <- ((Char, String) -> Token)
    -> ((Char, String) -> Token)
    -> Either String ((Char, String) -> Token)
    -> Lex a ((Char, String) -> Token)
    forall b a.
    (b -> Token)
    -> (b -> Token) -> Either String (b -> Token) -> Lex a (b -> Token)
    lexHash (Char, String) -> Token
    Character (Char, String) -> Token
    CharacterHash
                                (String -> Either String ((Char, String) -> Token)
    forall a b. a -> Either a b
    Left String
    "Double hash not available for character literals")
                        return (con (c, [c]))
             String
    _ | (KnownExtension -> Bool) -> [KnownExtension] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts) [KnownExtension
    TemplateHaskell, KnownExtension
    DataKinds] -> Token -> Lex a Token
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Token
    THVarQuote
             String
    _ -> String -> Lex a Token
    forall a. String -> Lex a a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Improper character constant or misplaced \'"

        where matchQuote :: Lex a ()
    matchQuote = Char -> String -> Lex a ()
    forall a. Char -> String -> Lex a ()
    matchChar Char
    '\'' String
    "Improperly terminated character constant"

    lexString :: Lex a Token
    lexString :: forall a. Lex a Token
    lexString = (String, String) -> Lex a Token
    forall {r}. (String, String) -> Lex r Token
    loop (String
    "",String
    "")
        where
        loop :: (String, String) -> Lex r Token
    loop (String
    s,String
    raw) = do
            r <- Lex r String
    forall r. Lex r String
    getInput
            exts <- getExtensionsL
            case r of
                Char
    '\\':Char
    '&':String
    _ -> do
                        Int -> Lex r ()
    forall r. Int -> Lex r ()
    discard Int
    2
                        (String, String) -> Lex r Token
    loop (String
    s, Char
    '&'Char -> ShowS
    forall a. a -> [a] -> [a]
    :Char
    '\\'Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    raw)
                Char
    '\\':Char
    c:String
    _ | Char -> Bool
    isSpace Char
    c -> do
                            Int -> Lex r ()
    forall r. Int -> Lex r ()
    discard Int
    1
                            wcs <- Lex r String
    forall r. Lex r String
    lexWhiteChars
                            matchChar '\\' "Illegal character in string gap"
                            loop (s, '\\':reverse wcs ++ '\\':raw)
                         | Bool
    otherwise -> do
                            (ce, str) <- Lex r (Char, String)
    forall a. Lex a (Char, String)
    lexEscape
                            loop (ce:s, reverse str ++ '\\':raw)
                Char
    '"':Char
    '#':String
    _ | KnownExtension
    MagicHash KnownExtension -> [KnownExtension] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KnownExtension]
    exts -> do
                            Int -> Lex r ()
    forall r. Int -> Lex r ()
    discard Int
    2
                            Token -> Lex r Token
    forall a. a -> Lex r a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((String, String) -> Token
    StringHash (ShowS
    forall a. [a] -> [a]
    reverse String
    s, ShowS
    forall a. [a] -> [a]
    reverse String
    raw))
                Char
    '"':String
    _ -> do
                    Int -> Lex r ()
    forall r. Int -> Lex r ()
    discard Int
    1
                    Token -> Lex r Token
    forall a. a -> Lex r a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((String, String) -> Token
    StringTok (ShowS
    forall a. [a] -> [a]
    reverse String
    s, ShowS
    forall a. [a] -> [a]
    reverse String
    raw))
                Char
    c:String
    _ | Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\n' -> do
                    Int -> Lex r ()
    forall r. Int -> Lex r ()
    discard Int
    1
                    (String, String) -> Lex r Token
    loop (Char
    cChar -> ShowS
    forall a. a -> [a] -> [a]
    :String
    s, Char
    cChar -> ShowS
    forall a. a -> [a] -> [a]
    :String
    raw)
                String
    _ ->   String -> Lex r Token
    forall a. String -> Lex r a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Improperly terminated string"

        lexWhiteChars :: Lex a String
        lexWhiteChars :: forall r. Lex r String
    lexWhiteChars = do
            s <- Lex a String
    forall r. Lex r String
    getInput
            case s of
                Char
    '\n':String
    _ -> do
                        Lex a ()
    forall a. Lex a ()
    lexNewline
                        wcs <- Lex a String
    forall r. Lex r String
    lexWhiteChars
                        return $ '\n':wcs
                Char
    '\t':String
    _ -> do
                        Lex a ()
    forall a. Lex a ()
    lexTab
                        wcs <- Lex a String
    forall r. Lex r String
    lexWhiteChars
                        return $ '\t':wcs
                Char
    c:String
    _ | Char -> Bool
    isSpace Char
    c -> do
                        Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1
                        wcs <- Lex a String
    forall r. Lex r String
    lexWhiteChars
                        return $ c:wcs
                String
    _ -> String -> Lex a String
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    ""

    lexEscape :: Lex a (Char, String)
    lexEscape :: forall a. Lex a (Char, String)
    lexEscape = do
        Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1
        r <- Lex a String
    forall r. Lex r String
    getInput
        case r of

    -- Production charesc from section B.2 (Note: \& is handled by caller)

            Char
    'a':String
    _           -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\a', String
    "a")
            Char
    'b':String
    _           -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\b', String
    "b")
            Char
    'f':String
    _           -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\f', String
    "f")
            Char
    'n':String
    _           -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\n', String
    "n")
            Char
    'r':String
    _           -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\r', String
    "r")
            Char
    't':String
    _           -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\t', String
    "t")
            Char
    'v':String
    _           -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\v', String
    "v")
            Char
    '\\':String
    _          -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\\', String
    "\\")
            Char
    '"':String
    _           -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\"', String
    "\"")
            Char
    '\'':String
    _          -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\'', String
    "\'")

    -- Production ascii from section B.2

            Char
    '^':Char
    c:String
    _         -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Char -> Lex a (Char, String)
    forall a. Char -> Lex a (Char, String)
    cntrl Char
    c
            Char
    'N':Char
    'U':Char
    'L':String
    _   -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\NUL', String
    "NUL")
            Char
    'S':Char
    'O':Char
    'H':String
    _   -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\SOH', String
    "SOH")
            Char
    'S':Char
    'T':Char
    'X':String
    _   -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\STX', String
    "STX")
            Char
    'E':Char
    'T':Char
    'X':String
    _   -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\ETX', String
    "ETX")
            Char
    'E':Char
    'O':Char
    'T':String
    _   -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\EOT', String
    "EOT")
            Char
    'E':Char
    'N':Char
    'Q':String
    _   -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\ENQ', String
    "ENQ")
            Char
    'A':Char
    'C':Char
    'K':String
    _   -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\ACK', String
    "ACK")
            Char
    'B':Char
    'E':Char
    'L':String
    _   -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\BEL', String
    "BEL")
            Char
    'B':Char
    'S':String
    _       -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\BS',  String
    "BS")
            Char
    'H':Char
    'T':String
    _       -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\HT',  String
    "HT")
            Char
    'L':Char
    'F':String
    _       -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\LF',  String
    "LF")
            Char
    'V':Char
    'T':String
    _       -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\VT',  String
    "VT")
            Char
    'F':Char
    'F':String
    _       -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\FF',  String
    "FF")
            Char
    'C':Char
    'R':String
    _       -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\CR',  String
    "CR")
            Char
    'S':Char
    'O':String
    _       -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\SO',  String
    "SO")
            Char
    'S':Char
    'I':String
    _       -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\SI',  String
    "SI")
            Char
    'D':Char
    'L':Char
    'E':String
    _   -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\DLE', String
    "DLE")
            Char
    'D':Char
    'C':Char
    '1':String
    _   -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\DC1', String
    "DC1")
            Char
    'D':Char
    'C':Char
    '2':String
    _   -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\DC2', String
    "DC2")
            Char
    'D':Char
    'C':Char
    '3':String
    _   -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\DC3', String
    "DC3")
            Char
    'D':Char
    'C':Char
    '4':String
    _   -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\DC4', String
    "DC4")
            Char
    'N':Char
    'A':Char
    'K':String
    _   -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\NAK', String
    "NAK")
            Char
    'S':Char
    'Y':Char
    'N':String
    _   -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\SYN', String
    "SYN")
            Char
    'E':Char
    'T':Char
    'B':String
    _   -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\ETB', String
    "ETB")
            Char
    'C':Char
    'A':Char
    'N':String
    _   -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\CAN', String
    "CAN")
            Char
    'E':Char
    'M':String
    _       -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\EM',  String
    "EM")
            Char
    'S':Char
    'U':Char
    'B':String
    _   -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\SUB', String
    "SUB")
            Char
    'E':Char
    'S':Char
    'C':String
    _   -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\ESC', String
    "ESC")
            Char
    'F':Char
    'S':String
    _       -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\FS',  String
    "FS")
            Char
    'G':Char
    'S':String
    _       -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\GS',  String
    "GS")
            Char
    'R':Char
    'S':String
    _       -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\RS',  String
    "RS")
            Char
    'U':Char
    'S':String
    _       -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\US',  String
    "US")
            Char
    'S':Char
    'P':String
    _       -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    2 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\SP',  String
    "SP")
            Char
    'D':Char
    'E':Char
    'L':String
    _   -> Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    3 Lex a () -> Lex a (Char, String) -> Lex a (Char, String)
    forall a b. Lex a a -> Lex a b -> Lex a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    '\DEL', String
    "DEL")

    -- Escaped numbers

            Char
    'o':Char
    c:String
    _ | Char -> Bool
    isOctDigit Char
    c -> do
                        Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1
                        (n, raw) <- Lex a (Integer, String)
    forall a. Lex a (Integer, String)
    lexOctal
                        n' <- checkChar n
                        return (n', 'o':raw)
            Char
    'x':Char
    c:String
    _ | Char -> Bool
    isHexDigit Char
    c -> do
                        Int -> Lex a ()
    forall r. Int -> Lex r ()
    discard Int
    1
                        (n, raw) <- Lex a (Integer, String)
    forall a. Lex a (Integer, String)
    lexHexadecimal
                        n' <- checkChar n
                        return (n', 'x':raw)
            Char
    c:String
    _ | Char -> Bool
    isDigit Char
    c -> do
                        (n, raw) <- Lex a (Integer, String)
    forall a. Lex a (Integer, String)
    lexDecimal
                        n' <- checkChar n
                        return (n', raw)

            String
    _       -> String -> Lex a (Char, String)
    forall a. String -> Lex a a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Illegal escape sequence"

        where
        checkChar :: Integer -> m Char
    checkChar Integer
    n | Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    0x10FFFF = Char -> m Char
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> Char
    chr (Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    n))
        checkChar Integer
    _                 = String -> m Char
    forall a. String -> m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Character constant out of range"

    -- Production cntrl from section B.2

        cntrl :: Char -> Lex a (Char, String)
        cntrl :: forall a. Char -> Lex a (Char, String)
    cntrl Char
    c | Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Char
    '@' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char
    '_' = (Char, String) -> Lex a (Char, String)
    forall a. a -> Lex a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> Char
    chr (Char -> Int
    ord Char
    c Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Char -> Int
    ord Char
    '@'), Char
    '^'Char -> ShowS
    forall a. a -> [a] -> [a]
    :Char
    cChar -> ShowS
    forall a. a -> [a] -> [a]
    :[])
        cntrl Char
    _                        = String -> Lex a (Char, String)
    forall a. String -> Lex a a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Illegal control character"

    -- assumes at least one octal digit
    lexOctal :: Lex a (Integer, String)
    lexOctal :: forall a. Lex a (Integer, String)
    lexOctal = do
        ds <- (Char -> Bool) -> Lex a String
    forall a. (Char -> Bool) -> Lex a String
    lexWhile Char -> Bool
    isOctDigit
        return (parseInteger 8 ds, ds)

    -- assumes at least one binary digit
    lexBinary :: Lex a (Integer, String)
    lexBinary :: forall a. Lex a (Integer, String)
    lexBinary = do
        ds <- (Char -> Bool) -> Lex a String
    forall a. (Char -> Bool) -> Lex a String
    lexWhile Char -> Bool
    isBinDigit
        return (parseInteger 2 ds, ds)

    -- assumes at least one hexadecimal digit
    lexHexadecimal :: Lex a (Integer, String)
    lexHexadecimal :: forall a. Lex a (Integer, String)
    lexHexadecimal = do
        ds <- (Char -> Bool) -> Lex a String
    forall a. (Char -> Bool) -> Lex a String
    lexWhile Char -> Bool
    isHexDigit
        return (parseInteger 16 ds, ds)

    -- assumes at least one decimal digit
    lexDecimal :: Lex a (Integer, String)
    lexDecimal :: forall a. Lex a (Integer, String)
    lexDecimal = do
        ds <- (Char -> Bool) -> Lex a String
    forall a. (Char -> Bool) -> Lex a String
    lexWhile Char -> Bool
    isDigit
        return (parseInteger 10 ds, ds)

    -- Stolen from Hugs's Prelude
    parseInteger :: Integer -> String -> Integer
    parseInteger :: Integer -> String -> Integer
    parseInteger Integer
    radix String
    ds =
        (Integer -> Integer -> Integer) -> [Integer] -> Integer
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldl1 (\Integer
    n Integer
    d -> Integer
    n Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    radix Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    d) ((Char -> Integer) -> String -> [Integer]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int -> Integer) -> (Char -> Int) -> Char -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Int
    digitToInt) String
    ds)

    flagKW :: Token -> Lex a ()
    flagKW :: forall a. Token -> Lex a ()
    flagKW Token
    t =
      Bool -> Lex a () -> Lex a ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Token
    t Token -> [Token] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Token
    KW_Do, Token
    KW_MDo]) (Lex a () -> Lex a ()) -> Lex a () -> Lex a ()
    forall a b. (a -> b) -> a -> b
    $ do
           exts <- Lex a [KnownExtension]
    forall a. Lex a [KnownExtension]
    getExtensionsL
           when (NondecreasingIndentation `elem` exts) flagDo

    -- | Selects ASCII binary digits, i.e. @\'0\'@..@\'1\'@.
    isBinDigit :: Char -> Bool
    isBinDigit :: Char -> Bool
    isBinDigit Char
    c =  Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Char
    '0' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char
    '1'
    ------------------------------------------------------------------
    -- "Pretty" printing for tokens

    showToken :: Token -> String
    showToken :: Token -> String
    showToken Token
    t = case Token
    t of
      VarId String
    s           -> String
    s
      LabelVarId String
    s      -> Char
    '#'Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    s
      QVarId (String
    q,String
    s)      -> String
    q String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Char
    '.'Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    s
      IDupVarId String
    s       -> Char
    '?'Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    s
      ILinVarId String
    s       -> Char
    '%'Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    s
      ConId String
    s           -> String
    s
      QConId (String
    q,String
    s)      -> String
    q String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Char
    '.'Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    s
      DVarId [String]
    ss         -> String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "-" [String]
    ss
      VarSym String
    s          -> String
    s
      ConSym String
    s          -> String
    s
      QVarSym (String
    q,String
    s)     -> String
    q String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Char
    '.'Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    s
      QConSym (String
    q,String
    s)     -> String
    q String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Char
    '.'Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    s
      IntTok (Integer
    _, String
    s)         -> String
    s
      FloatTok (Rational
    _, String
    s)       -> String
    s
      Character (Char
    _, String
    s)      -> Char
    '\''Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    s String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "'"
      StringTok (String
    _, String
    s)      -> Char
    '"'Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    s String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\""
      IntTokHash (Integer
    _, String
    s)     -> String
    s String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "#"
      WordTokHash (Integer
    _, String
    s)    -> String
    s String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "##"
      FloatTokHash (Rational
    _, String
    s)   -> String
    s String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "#"
      DoubleTokHash (Rational
    _, String
    s)  -> String
    s String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "##"
      CharacterHash (Char
    _, String
    s)  -> Char
    '\''Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    s String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "'#"
      StringHash (String
    _, String
    s)     -> Char
    '"'Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    s String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\"#"
      Token
    LeftParen         -> String
    "("
      Token
    RightParen        -> String
    ")"
      Token
    LeftHashParen     -> String
    "(#"
      Token
    RightHashParen    -> String
    "#)"
      Token
    SemiColon         -> String
    ";"
      Token
    LeftCurly         -> String
    "{"
      Token
    RightCurly        -> String
    "}"
      Token
    VRightCurly       -> String
    "virtual }"
      Token
    LeftSquare        -> String
    "["
      Token
    RightSquare       -> String
    "]"
      Token
    ParArrayLeftSquare -> String
    "[:"
      Token
    ParArrayRightSquare -> String
    ":]"
      Token
    Comma             -> String
    ","
      Token
    Underscore        -> String
    "_"
      Token
    BackQuote         -> String
    "`"
      Token
    QuoteColon        -> String
    "':"
      Token
    Dot               -> String
    "."
      Token
    DotDot            -> String
    ".."
      Token
    Colon             -> String
    ":"
      Token
    DoubleColon       -> String
    "::"
      Token
    Equals            -> String
    "="
      Token
    Backslash         -> String
    "\\"
      Token
    Bar               -> String
    "|"
      Token
    LeftArrow         -> String
    "<-"
      Token
    RightArrow        -> String
    "->"
      Token
    At                -> String
    "@"
      Token
    TApp              -> String
    "@"
      Token
    Tilde             -> String
    "~"
      Token
    DoubleArrow       -> String
    "=>"
      Token
    Minus             -> String
    "-"
      Token
    Exclamation       -> String
    "!"
      Token
    Star              -> String
    "*"
      Token
    LeftArrowTail     -> String
    "-<"
      Token
    RightArrowTail    -> String
    ">-"
      Token
    LeftDblArrowTail  -> String
    "-<<"
      Token
    RightDblArrowTail -> String
    ">>-"
      Token
    OpenArrowBracket  -> String
    "(|"
      Token
    CloseArrowBracket -> String
    "|)"
      Token
    THExpQuote        -> String
    "[|"
      Token
    THTExpQuote       -> String
    "[||"
      Token
    THPatQuote        -> String
    "[p|"
      Token
    THDecQuote        -> String
    "[d|"
      Token
    THTypQuote        -> String
    "[t|"
      Token
    THCloseQuote      -> String
    "|]"
      Token
    THTCloseQuote     -> String
    "||]"
      THIdEscape String
    s      -> Char
    '$'Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    s
      Token
    THParenEscape     -> String
    "$("
      THTIdEscape String
    s     -> String
    "$$" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    s
      Token
    THTParenEscape    -> String
    "$$("
      Token
    THVarQuote        -> String
    "'"
      Token
    THTyQuote         -> String
    "''"
      THQuasiQuote (String
    n,String
    q) -> String
    "[$" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    n String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "|" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    q String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "]"
      Token
    RPGuardOpen       -> String
    "(|"
      Token
    RPGuardClose      -> String
    "|)"
      Token
    RPCAt             -> String
    "@:"
      Token
    XCodeTagOpen      -> String
    "<%"
      Token
    XCodeTagClose     -> String
    "%>"
      Token
    XStdTagOpen       -> String
    "<"
      Token
    XStdTagClose      -> String
    ">"
      Token
    XCloseTagOpen     -> String
    "</"
      Token
    XEmptyTagClose    -> String
    "/>"
      XPCDATA String
    s         -> String
    "PCDATA " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    s
      Token
    XRPatOpen         -> String
    "<["
      Token
    XRPatClose        -> String
    "]>"
      Token
    PragmaEnd         -> String
    "#-}"
      Token
    RULES             -> String
    "{-# RULES"
      INLINE Bool
    b          -> String
    "{-# " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ if Bool
    b then String
    "INLINE" else String
    "NOINLINE"
      Token
    INLINE_CONLIKE    -> String
    "{-# " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "INLINE CONLIKE"
      Token
    SPECIALISE        -> String
    "{-# SPECIALISE"
      SPECIALISE_INLINE Bool
    b -> String
    "{-# SPECIALISE " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ if Bool
    b then String
    "INLINE" else String
    "NOINLINE"
      Token
    SOURCE            -> String
    "{-# SOURCE"
      Token
    DEPRECATED        -> String
    "{-# DEPRECATED"
      Token
    WARNING           -> String
    "{-# WARNING"
      Token
    SCC               -> String
    "{-# SCC"
      Token
    GENERATED         -> String
    "{-# GENERATED"
      Token
    CORE              -> String
    "{-# CORE"
      Token
    UNPACK            -> String
    "{-# UNPACK"
      Token
    NOUNPACK          -> String
    "{-# NOUNPACK"
      OPTIONS (Maybe String
    mt,String
    _)    -> String
    "{-# OPTIONS" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String -> ShowS -> Maybe String -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe String
    "" (Char
    ':'Char -> ShowS
    forall a. a -> [a] -> [a]
    :) Maybe String
    mt String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " ..."
    --  CFILES  s         -> "{-# CFILES ..."
    --  INCLUDE s         -> "{-# INCLUDE ..."
      Token
    LANGUAGE          -> String
    "{-# LANGUAGE"
      Token
    ANN               -> String
    "{-# ANN"
      Token
    MINIMAL           -> String
    "{-# MINIMAL"
      Token
    NO_OVERLAP        -> String
    "{-# NO_OVERLAP"
      Token
    OVERLAP           -> String
    "{-# OVERLAP"
      Token
    OVERLAPPING       -> String
    "{-# OVERLAPPING"
      Token
    OVERLAPPABLE      -> String
    "{-# OVERLAPPABLE"
      Token
    OVERLAPS          -> String
    "{-# OVERLAPS"
      Token
    INCOHERENT        -> String
    "{-# INCOHERENT"
      Token
    COMPLETE          -> String
    "{-# COMPLETE"
      Token
    KW_As         -> String
    "as"
      Token
    KW_By         -> String
    "by"
      Token
    KW_Case       -> String
    "case"
      Token
    KW_Class      -> String
    "class"
      Token
    KW_Data       -> String
    "data"
      Token
    KW_Default    -> String
    "default"
      Token
    KW_Deriving   -> String
    "deriving"
      Token
    KW_Do         -> String
    "do"
      Token
    KW_MDo        -> String
    "mdo"
      Token
    KW_Else       -> String
    "else"
      Token
    KW_Family     -> String
    "family"
      Token
    KW_Forall     -> String
    "forall"
      Token
    KW_Group      -> String
    "group"
      Token
    KW_Hiding     -> String
    "hiding"
      Token
    KW_If         -> String
    "if"
      Token
    KW_Import     -> String
    "import"
      Token
    KW_In         -> String
    "in"
      Token
    KW_Infix      -> String
    "infix"
      Token
    KW_InfixL     -> String
    "infixl"
      Token
    KW_InfixR     -> String
    "infixr"
      Token
    KW_Instance   -> String
    "instance"
      Token
    KW_Let        -> String
    "let"
      Token
    KW_Module     -> String
    "module"
      Token
    KW_NewType    -> String
    "newtype"
      Token
    KW_Of         -> String
    "of"
      Token
    KW_Proc       -> String
    "proc"
      Token
    KW_Rec        -> String
    "rec"
      Token
    KW_Then       -> String
    "then"
      Token
    KW_Type       -> String
    "type"
      Token
    KW_Using      -> String
    "using"
      Token
    KW_Where      -> String
    "where"
      Token
    KW_Qualified  -> String
    "qualified"
      Token
    KW_Foreign    -> String
    "foreign"
      Token
    KW_Export     -> String
    "export"
      Token
    KW_Safe       -> String
    "safe"
      Token
    KW_Unsafe     -> String
    "unsafe"
      Token
    KW_Threadsafe -> String
    "threadsafe"
      Token
    KW_Interruptible -> String
    "interruptible"
      Token
    KW_StdCall    -> String
    "stdcall"
      Token
    KW_CCall      -> String
    "ccall"
      Token
    XChildTagOpen -> String
    "<%>"
      Token
    KW_CPlusPlus  -> String
    "cplusplus"
      Token
    KW_DotNet     -> String
    "dotnet"
      Token
    KW_Jvm        -> String
    "jvm"
      Token
    KW_Js         -> String
    "js"
      Token
    KW_JavaScript -> String
    "javascript"
      Token
    KW_CApi       -> String
    "capi"
      Token
    KW_Role       -> String
    "role"
      Token
    KW_Pattern    -> String
    "pattern"
      Token
    KW_Stock      -> String
    "stock"
      Token
    KW_Anyclass   -> String
    "anyclass"
      Token
    KW_Via        -> String
    "via"

      Token
    EOF           -> String
    "EOF"