    -----------------------------------------------------------------------------
    The code generator.

    (c) 1993-2001 Andy Gill, Simon Marlow
    -----------------------------------------------------------------------------

    > module Happy.Backend.LALR.ProduceCode (produceParser) where

    > import Happy.Paths  ( version )
    > import Data.Version              ( showVersion )
    > import Happy.Grammar
    > import Happy.Grammar.ExpressionWithHole ( substExpressionWithHole )
    > import Happy.Tabular.LALR

    > import Data.Maybe                ( isNothing, fromMaybe )
    > import Data.Char                 ( ord, chr )
    > import Data.List                 ( sortBy, nub )

    > import Control.Monad.ST          ( ST, runST )
    > import Data.Word
    > import Data.Int
    > import Data.Bits
    > import Data.Array.ST             ( STUArray )
    > import Data.Array.Unboxed        ( UArray )
    > import Data.Array.MArray         ( MArray(..), freeze, readArray, writeArray )
    > import Data.Array.IArray         ( Array, IArray(..), (!), array, assocs, elems )

    %-----------------------------------------------------------------------------
    Produce the complete output file.

    > produceParser :: Grammar String               -- grammar info
    >               -> Maybe AttributeGrammarExtras
    >               -> Directives                   -- directives supplied in the .y-file
    >               -> ActionTable                  -- action table
    >               -> GotoTable                    -- goto table
    >               -> [String]                     -- language extensions
    >               -> Maybe String                 -- module header
    >               -> Maybe String                 -- module trailer
    >               -> Bool                         -- use coercions
    >               -> Bool                         -- strict parser
    >               -> String

    > produceParser :: Grammar String
    -> Maybe AttributeGrammarExtras
    -> Directives
    -> ActionTable
    -> GotoTable
    -> [String]
    -> Maybe String
    -> Maybe String
    -> Bool
    -> Bool
    -> String
    produceParser (Grammar
    >               { productions :: forall eliminator. Grammar eliminator -> [Production eliminator]
    productions = [Production String]
    prods
    >               , non_terminals :: forall eliminator. Grammar eliminator -> [Name]
    non_terminals = [Name]
    nonterms
    >               , terminals :: forall eliminator. Grammar eliminator -> [Name]
    terminals = [Name]
    terms
    >               , types :: forall eliminator. Grammar eliminator -> Array Name (Maybe String)
    types = Array Name (Maybe String)
    nt_types
    >               , first_nonterm :: forall eliminator. Grammar eliminator -> Name
    first_nonterm = Name
    first_nonterm'
    >               , eof_term :: forall eliminator. Grammar eliminator -> Name
    eof_term = Name
    eof
    >               , first_term :: forall eliminator. Grammar eliminator -> Name
    first_term = Name
    fst_term
    >               , token_names :: forall eliminator. Grammar eliminator -> Array Name String
    token_names = Array Name String
    token_names'
    >               , token_specs :: forall eliminator. Grammar eliminator -> [(Name, TokenSpec)]
    token_specs = [(Name, TokenSpec)]
    token_rep
    >               , starts :: forall eliminator.
    Grammar eliminator -> [(String, Name, Name, Bool)]
    starts = [(String, Name, Name, Bool)]
    starts'
    >               })
    >               Maybe AttributeGrammarExtras
    mAg
    >               (Directives
    >               { lexer :: Directives -> Maybe (String, String)
    lexer = Maybe (String, String)
    lexer'
    >               , imported_identity :: Directives -> Bool
    imported_identity = Bool
    imported_identity'
    >               , monad :: Directives -> (Bool, String, String, String, String)
    monad = (Bool
    use_monad,String
    monad_context,String
    monad_tycon,String
    monad_then,String
    monad_return)
    >               , token_type :: Directives -> String
    token_type = String
    token_type'
    >               , error_handler :: Directives -> ErrorHandlerInfo
    error_handler = ErrorHandlerInfo
    error_handler'
    >               , error_expected :: Directives -> ErrorExpectedMode
    error_expected = ErrorExpectedMode
    error_expected'
    >               })
    >               ActionTable
    action GotoTable
    goto [String]
    lang_exts Maybe String
    module_header Maybe String
    module_trailer
    >               Bool
    coerce Bool
    strict
    >     = ( String -> String
    top_opts
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe String -> String -> String
    maybestr Maybe String
    module_header (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    nl
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    comment
    >               -- comment goes *after* the module header, so that we
    >               -- don't screw up any OPTIONS pragmas in the header.
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    produceAbsSynDecl (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    nl
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    produceTokToStringList
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    produceActionTable
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    produceReductions
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    produceTokenConverter (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    nl
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    produceIdentityStuff
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    produceMonadStuff
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    produceEntries
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> String -> String
    produceStrict Bool
    strict
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (case Maybe AttributeGrammarExtras
    mAg of
    >            Maybe AttributeGrammarExtras
    Nothing -> String -> String
    forall a. a -> a
    id
    >            Just AttributeGrammarExtras
    ag -> AttributeGrammarExtras -> String -> String
    produceAttributes AttributeGrammarExtras
    ag)
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    nl
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe String -> String -> String
    maybestr Maybe String
    module_trailer (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    nl
    >       ) String
    ""
    >  where
    >    n_starts :: Int
    n_starts = [(String, Name, Name, Bool)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(String, Name, Name, Bool)]
    starts'
    >    token :: String -> String
    token = String -> String -> String
    brack String
    token_type'
    >
    >    nowarn_opts :: String -> String
    nowarn_opts = String -> String -> String
    str String
    "{-# OPTIONS_GHC -w #-}" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    nl
    >       -- XXX Happy-generated code is full of warnings.  Some are easy to
    >       -- fix, others not so easy, and others would require GHC version
    >       -- #ifdefs.  For now I'm just disabling all of them.

    We used to emit tabs for indentation, but since 2.0.0.1 we use 8 spaces for back-compat (#303):

    >    indentStr :: String
    indentStr = String
    "        "
    >    indent :: String -> String
    indent = String -> String -> String
    str String
    indentStr

    >    intMaybeHash :: String -> String
    intMaybeHash    = String -> String -> String
    str String
    "Happy_GHC_Exts.Int#"

    >    -- Parsing monad and its constraints
    >    pty :: String -> String
    pty = String -> String -> String
    str String
    monad_tycon                     -- str "P"
    >    ptyAt :: (String -> String) -> String -> String
    ptyAt String -> String
    a = (String -> String) -> String -> String
    brack' (String -> String
    pty (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    a)      -- \(str "a") -> str "(P a)"
    >    pcont :: String -> String
    pcont = String -> String -> String
    str String
    monad_context                 -- str "Read a", some constraint for "P" to be a monad

    >    n_missing_types :: Int
    n_missing_types = [Maybe String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ((Maybe String -> Bool) -> [Maybe String] -> [Maybe String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Maybe String -> Bool
    forall a. Maybe a -> Bool
    isNothing (Array Name (Maybe String) -> [Maybe String]
    forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
    elems Array Name (Maybe String)
    nt_types))
    >    happyAbsSyn :: String -> String
    happyAbsSyn = String -> String -> String
    str String
    "(HappyAbsSyn " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    wild_tyvars (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    ")"
    >      where wild_tyvars :: String
    wild_tyvars = [String] -> String
    unwords (Int -> String -> [String]
    forall a. Int -> a -> [a]
    replicate Int
    n_missing_types String
    "_")
    >
    >    top_opts :: String -> String
    top_opts =
    >        String -> String
    nowarn_opts
    >      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String -> String
    str (String -> String -> String) -> String -> String -> String
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unlines
    >           [ [String] -> String
    unwords [ String
    "{-# LANGUAGE", String
    l, String
    "#-}" ] | String
    l <- [String]
    lang_exts ])

    %-----------------------------------------------------------------------------
    Make the abstract syntax type declaration, of the form:

    data HappyAbsSyn a t1 .. tn
            = HappyTerminal a
            | HappyAbsSyn1 t1
            ...
            | HappyAbsSynn tn

    >    produceAbsSynDecl :: String -> String
    produceAbsSynDecl

    If we're using coercions, we need to generate the injections etc.

            data HappyAbsSyn ti tj tk ... = HappyAbsSyn

    (where ti, tj, tk are type variables for the non-terminals which don't
     have type signatures).

            newtype HappyWrap<n> = HappyWrap<n> ti
            happyIn<n> :: ti -> HappyAbsSyn ti tj tk ...
            happyIn<n> x = unsafeCoerce# (HappyWrap<n> x)
            {-# INLINE happyIn<n> #-}

            happyOut<n> :: HappyAbsSyn ti tj tk ... -> tn
            happyOut<n> x = unsafeCoerce# x
            {-# INLINE happyOut<n> #-}

    >     | Bool
    coerce
    >       = let
    >             happy_item :: String -> String
    happy_item = String -> String -> String
    str String
    "HappyAbsSyn " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    str_tyvars
    >             bhappy_item :: String -> String
    bhappy_item = (String -> String) -> String -> String
    brack' String -> String
    happy_item
    >
    >             inject :: Name -> Maybe String -> String -> String
    inject Name
    n Maybe String
    ty
    >               = (case Maybe String
    ty of
    >                   Maybe String
    Nothing -> String -> String
    forall a. a -> a
    id
    >                   Just String
    tystr -> String -> String -> String
    str String
    "newtype " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String -> String
    mkHappyWrap Name
    n (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " = " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String -> String
    mkHappyWrap Name
    n (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    strspace (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    brack String
    tystr (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    nl)
    >               (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String -> String
    mkHappyIn Name
    n (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " :: " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Maybe String -> String -> String
    typeParam Name
    n Maybe String
    ty
    >               (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " -> " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    bhappy_item (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> String -> String
    char Char
    '\n'
    >               (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String -> String
    mkHappyIn Name
    n (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " x = Happy_GHC_Exts.unsafeCoerce#" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    strspace
    >               (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe String -> Name -> (String -> String) -> String -> String
    forall a. Maybe a -> Name -> (String -> String) -> String -> String
    mkHappyWrapCon Maybe String
    ty Name
    n (String -> String -> String
    str String
    "x")
    >               (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    nl
    >               (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "{-# INLINE " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String -> String
    mkHappyIn Name
    n (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " #-}"
    >
    >             extract :: Name -> Maybe String -> String -> String
    extract Name
    n Maybe String
    ty
    >               = Name -> String -> String
    mkHappyOut Name
    n (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " :: " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    bhappy_item
    >               (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " -> " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Maybe String -> String -> String
    typeParamOut Name
    n Maybe String
    ty (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> String -> String
    char Char
    '\n'
    >               (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String -> String
    mkHappyOut Name
    n (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " x = Happy_GHC_Exts.unsafeCoerce# x\n"
    >               (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "{-# INLINE " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String -> String
    mkHappyOut Name
    n (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " #-}"
    >         in
    >           String -> String -> String
    str String
    "newtype " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    happy_item (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " = HappyAbsSyn HappyAny\n" -- see NOTE below
    >         (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String -> String] -> String -> String
    interleave String
    "\n" ((String -> String -> String) -> [String] -> [String -> String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> String -> String
    str
    >           [ String
    "#if __GLASGOW_HASKELL__ >= 607",
    >             String
    "type HappyAny = Happy_GHC_Exts.Any",
    >             String
    "#else",
    >             String
    "type HappyAny = forall a . a",
    >             String
    "#endif" ])
    >         (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String -> String] -> String -> String
    interleave String
    "\n"
    >           [ Name -> Maybe String -> String -> String
    inject Name
    n Maybe String
    ty (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    nl (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Maybe String -> String -> String
    extract Name
    n Maybe String
    ty | (Name
    n,Maybe String
    ty) <- Array Name (Maybe String) -> [(Name, Maybe String)]
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> [(i, e)]
    assocs Array Name (Maybe String)
    nt_types ]
    >         -- token injector
    >         (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyInTok :: " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    token (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " -> " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    bhappy_item
    >         (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\nhappyInTok x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyInTok #-}\n"
    >         -- token extractor
    >         (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyOutTok :: " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    bhappy_item (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " -> " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    token
    >         (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\nhappyOutTok x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOutTok #-}\n"

    >         (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"

    NOTE: in the coerce case we always coerce all the semantic values to
    HappyAbsSyn which is declared to be a synonym for Any.  This is the
    type that GHC officially knows nothing about - it's the same type used
    to implement Dynamic.  (in GHC 6.6 and older, Any didn't exist, so we
    use the closest approximation namely forall a . a).

    It's vital that GHC doesn't know anything about this type, because it
    will use any knowledge it has to optimise, and if the knowledge is
    false then the optimisation may also be false.  Previously we used (()
    -> ()) as the type here, but this led to bogus optimisations (see GHC
    ticket #1616).

    Also, note that we must use a newtype instead of just a type synonym,
    because the otherwise the type arguments to the HappyAbsSyn type
    constructor will lose information.  See happy/tests/bug001 for an
    example where this matters.

    ... Otherwise, output the declaration in full...

    >     | Bool
    otherwise
    >       = String -> String -> String
    str String
    "data HappyAbsSyn " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    str_tyvars
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    indent (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "= HappyTerminal " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    token
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    indent (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "| HappyErrorToken Happy_Prelude.Int\n"
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String -> String] -> String -> String
    interleave String
    "\n"
    >         [ String -> String -> String
    str String
    "" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    indent (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "| " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String -> String
    makeAbsSynCon Name
    n (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    strspace (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Maybe String -> String -> String
    typeParam Name
    n Maybe String
    ty
    >         | (Name
    n, Maybe String
    ty) <- Array Name (Maybe String) -> [(Name, Maybe String)]
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> [(i, e)]
    assocs Array Name (Maybe String)
    nt_types,
    >           (Array Name Name
    nt_types_index Array Name Name -> Name -> Name
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> i -> e
    ! Name
    n) Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    n]

    >     where all_tyvars :: [String]
    all_tyvars = [ Char
    't' Char -> String -> String
    forall a. a -> [a] -> [a]
    : Int -> String
    forall a. Show a => a -> String
    show (Name -> Int
    getName Name
    n) | (Name
    n, Maybe String
    Nothing) <- Array Name (Maybe String) -> [(Name, Maybe String)]
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> [(i, e)]
    assocs Array Name (Maybe String)
    nt_types ]
    >           str_tyvars :: String -> String
    str_tyvars = String -> String -> String
    str ([String] -> String
    unwords [String]
    all_tyvars)

    %-----------------------------------------------------------------------------
    Next, the reduction functions.   Each one has the following form:

    happyReduce_n_m = happyReduce n m reduction where {
       reduction (
            (HappyAbsSynX  | HappyTerminal) happy_var_1 :
            ..
            (HappyAbsSynX  | HappyTerminal) happy_var_q :
            happyRest)
             = HappyAbsSynY
                    ( <<user supplied string>> ) : happyRest
            ; reduction _ _ = notHappyAtAll n m

    where n is the non-terminal number, and m is the rule number.

    NOTES on monad productions.  These look like

            happyReduce_275 = happyMonadReduce 0# 119# happyReduction_275
            happyReduction_275 (happyRest)
                    =  happyThen (code) (\r -> happyReturn (HappyAbsSyn r))

    why can't we pass the HappyAbsSyn constructor to happyMonadReduce and
    save duplicating the happyThen/happyReturn in each monad production?
    Because this would require happyMonadReduce to be polymorphic in the
    result type of the monadic action, and since in array-based parsers
    the whole thing is one recursive group, we'd need a type signature on
    happyMonadReduce to get polymorphic recursion.  Sigh.

    >    produceReductions :: String -> String
    produceReductions =
    >       String -> [String -> String] -> String -> String
    interleave String
    "\n\n"
    >          ((Production String -> Int -> String -> String)
    -> [Production String] -> [Int] -> [String -> String]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Production String -> Int -> String -> String
    produceReduction (Int -> [Production String] -> [Production String]
    forall a. Int -> [a] -> [a]
    drop Int
    n_starts [Production String]
    prods) [ Int
    n_starts .. ])

    >    produceReduction :: Production String -> Int -> String -> String
    produceReduction (Production Name
    nt [Name]
    toks (String
    code,[Int]
    vars_used) Priority
    _) Int
    i

    >     | Bool
    is_monad_prod Bool -> Bool -> Bool
    && (Bool
    use_monad Bool -> Bool -> Bool
    || Bool
    imported_identity')
    >       = (String -> String) -> String -> String -> String
    mkReductionHdr (Int -> String -> String
    forall {a}. Show a => a -> String -> String
    showInt Int
    lt) String
    monad_reduce
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> String -> String
    char Char
    '(' (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String -> String] -> String -> String
    interleave (String
    " `HappyStk`\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    indentStr) [String -> String]
    tokPatterns
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyRest) tk\n" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    indent (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " = happyThen ("
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "("
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> String -> String
    tokLets (Char -> String -> String
    char Char
    '(' (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    code' (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> String -> String
    char Char
    ')')
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    ")"
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (if Bool
    monad_pass_token then String -> String -> String
    str String
    " tk" else String -> String
    forall a. a -> a
    id)
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    indent (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    ") (\\r -> happyReturn (" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    this_absSynCon (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " r))"

    >     | Int -> Bool
    specReduceFun Int
    lt
    >       = (String -> String) -> String -> String -> String
    mkReductionHdr String -> String
    forall a. a -> a
    id (String
    "happySpecReduce_" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    lt)
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String -> String] -> String -> String
    interleave (String
    "\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    indentStr) [String -> String]
    tokPatterns
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " =  "
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> String -> String
    tokLets (
    >           String -> String
    this_absSynCon (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    indent (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    indent (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " "
    >           (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> String -> String
    char Char
    '(' (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    code' (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    indent (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    ")"
    >         )
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (if Bool
    coerce Bool -> Bool -> Bool
    || [Name] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Name]
    toks Bool -> Bool -> Bool
    || [Int] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Int]
    vars_used then
    >                 String -> String
    forall a. a -> a
    id
    >          else
    >                 String -> String
    nl (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    reductionFun (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    strspace
    >               (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String -> String] -> String -> String
    interleave String
    " " (Int -> (String -> String) -> [String -> String]
    forall a. Int -> a -> [a]
    replicate ([Name] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Name]
    toks) (String -> String -> String
    str String
    "_"))
    >               (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " = notHappyAtAll ")

    >     | Bool
    otherwise
    >       = (String -> String) -> String -> String -> String
    mkReductionHdr (Int -> String -> String
    forall {a}. Show a => a -> String -> String
    showInt Int
    lt) String
    "happyReduce"
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> String -> String
    char Char
    '(' (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String -> String] -> String -> String
    interleave (String
    " `HappyStk`\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    indentStr) [String -> String]
    tokPatterns
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyRest)\n" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    indent (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " = "
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> String -> String
    tokLets
    >          ( String -> String
    this_absSynCon (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    indent (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    indent (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " "
    >          (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> String -> String
    char Char
    '(' (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    code'(String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    indent (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    ") `HappyStk` happyRest"
    >          )

    >       where
    >               (String
    code', Bool
    is_monad_prod, Bool
    monad_pass_token, String
    monad_reduce)
    >                     = case String
    code of
    >                         Char
    '%':Char
    '%':String
    code1 -> (String
    code1, Bool
    True, Bool
    True, String
    "happyMonad2Reduce")
    >                         Char
    '%':Char
    '^':String
    code1 -> (String
    code1, Bool
    True, Bool
    True, String
    "happyMonadReduce")
    >                         Char
    '%':String
    code1     -> (String
    code1, Bool
    True, Bool
    False, String
    "happyMonadReduce")
    >                         String
    _ -> (String
    code, Bool
    False, Bool
    False, String
    "")

    >               -- adjust the nonterminal number for the array-based parser
    >               -- so that nonterminals start at zero.
    >               adjusted_nt :: Int
    adjusted_nt = Name -> Int
    getName Name
    nt Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Name -> Int
    getName Name
    first_nonterm'

    >               mkReductionHdr :: (String -> String) -> String -> String -> String
    mkReductionHdr String -> String
    lt' String
    s =
    >                       let tysig :: String -> String
    tysig = case Maybe (String, String)
    lexer' of
    >                             Maybe (String, String)
    Nothing -> String -> String
    forall a. a -> a
    id
    >                             Maybe (String, String)
    _       -> Int -> String -> String
    mkReduceFun Int
    i (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " :: " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    pcont
    >                                      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " => " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    intMaybeHash
    >                                      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " -> " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    token_type'
    >                                      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " -> " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    intMaybeHash
    >                                      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " -> Happy_IntList -> HappyStk "
    >                                      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    happyAbsSyn (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " -> "
    >                                      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    pty (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    happyAbsSyn (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"
    >                       in String -> String
    tysig (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> String
    mkReduceFun Int
    i (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " = "
    >                       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    s (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    strspace (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    lt' (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    strspace (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> String
    forall {a}. Show a => a -> String -> String
    showInt Int
    adjusted_nt
    >                       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    strspace (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    reductionFun (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    nl
    >                       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    reductionFun (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    strspace
    >
    >               reductionFun :: String -> String
    reductionFun = String -> String -> String
    str String
    "happyReduction_" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> String
    forall {a}. Show a => a -> String -> String
    shows Int
    i
    >
    >               tokPatterns :: [String -> String]
    tokPatterns
    >                | Bool
    coerce = [String -> String] -> [String -> String]
    forall a. [a] -> [a]
    reverse ((Int -> String -> String) -> [Int] -> [String -> String]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> String -> String
    mkDummyVar [Int
    1 .. [Name] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Name]
    toks])
    >                | Bool
    otherwise = [String -> String] -> [String -> String]
    forall a. [a] -> [a]
    reverse ((Int -> Name -> String -> String)
    -> [Int] -> [Name] -> [String -> String]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Int -> Name -> String -> String
    tokPattern [Int
    1..] [Name]
    toks)
    >
    >               tokPattern :: Int -> Name -> String -> String
    tokPattern Int
    n Name
    _ | Int
    n Int -> [Int] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [Int]
    vars_used = Char -> String -> String
    char Char
    '_'
    >               tokPattern Int
    n Name
    t | Name
    t Name -> Name -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Name
    firstStartTok Bool -> Bool -> Bool
    && Name
    t Name -> Name -> Bool
    forall a. Ord a => a -> a -> Bool
    < Name
    fst_term
    >                       = if Bool
    coerce
    >                               then Maybe String -> Name -> (String -> String) -> String -> String
    forall a. Maybe a -> Name -> (String -> String) -> String -> String
    mkHappyWrapCon (Array Name (Maybe String)
    nt_types Array Name (Maybe String) -> Name -> Maybe String
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> i -> e
    ! Name
    t) Name
    t (Int -> String -> String
    mkHappyVar Int
    n)
    >                               else (String -> String) -> String -> String
    brack' (
    >                                    Name -> String -> String
    makeAbsSynCon Name
    t (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "  " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> String
    mkHappyVar Int
    n
    >                                    )
    >               tokPattern Int
    n Name
    t
    >                       = if Bool
    coerce
    >                               then Int -> Name -> String -> String
    mkHappyTerminalVar Int
    n Name
    t
    >                               else String -> String -> String
    str String
    "(HappyTerminal "
    >                                  (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Name -> String -> String
    mkHappyTerminalVar Int
    n Name
    t
    >                                  (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> String -> String
    char Char
    ')'
    >
    >               tokLets :: (String -> String) -> String -> String
    tokLets String -> String
    code''
    >                  | Bool
    coerce Bool -> Bool -> Bool
    && Bool -> Bool
    not ([String -> String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String -> String]
    cases)
    >                       = String -> [String -> String] -> String -> String
    interleave (String
    "\n"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    indentStr) [String -> String]
    cases
    >                       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    code'' (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str (Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate ([String -> String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String -> String]
    cases) Char
    '}')
    >                  | Bool
    otherwise = String -> String
    code''
    >
    >               cases :: [String -> String]
    cases = [ String -> String -> String
    str String
    "case " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String -> String
    extract Name
    t (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    strspace (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> String
    mkDummyVar Int
    n
    >                       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " of { " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Name -> String -> String
    tokPattern Int
    n Name
    t (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " -> "
    >                       | (Int
    n,Name
    t) <- [Int] -> [Name] -> [(Int, Name)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    1..] [Name]
    toks,
    >                         Int
    n Int -> [Int] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Int]
    vars_used ]
    >
    >               extract :: Name -> String -> String
    extract Name
    t | Name
    t Name -> Name -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Name
    firstStartTok Bool -> Bool -> Bool
    && Name
    t Name -> Name -> Bool
    forall a. Ord a => a -> a -> Bool
    < Name
    fst_term = Name -> String -> String
    mkHappyOut Name
    t
    >                         | Bool
    otherwise                     = String -> String -> String
    str String
    "happyOutTok"
    >
    >               lt :: Int
    lt = [Name] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Name]
    toks

    >               this_absSynCon :: String -> String
    this_absSynCon | Bool
    coerce    = Name -> String -> String
    mkHappyIn Name
    nt
    >                              | Bool
    otherwise = Name -> String -> String
    makeAbsSynCon Name
    nt

    %-----------------------------------------------------------------------------
    The token conversion function.

    >    produceTokenConverter :: String -> String
    produceTokenConverter
    >       = String -> String -> String
    str String
    "happyTerminalToTok term = case term of {\n" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    indent
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (case Maybe (String, String)
    lexer' of Just (String
    _, String
    eof') -> String -> String -> String
    str String
    eof' (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " -> " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    eofTok (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    ";\n" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    indent; Maybe (String, String)
    _ -> String -> String
    forall a. a -> a
    id)
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String -> String] -> String -> String
    interleave (String
    ";\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    indentStr) (((Name, TokenSpec) -> String -> String)
    -> [(Name, TokenSpec)] -> [String -> String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name, TokenSpec) -> String -> String
    doToken [(Name, TokenSpec)]
    token_rep)
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "_ -> -1#;\n" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    indent (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "}\n" -- token number -1# (INVALID_TOK) signals an invalid token
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "{-# NOINLINE happyTerminalToTok #-}\n"
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
    >       (case Maybe (String, String)
    lexer' of {
    >       Maybe (String, String)
    Nothing ->
    >         String -> String -> String
    str String
    "happyLex kend  _kmore []       = kend notHappyAtAll []\n"
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyLex _kend kmore  (tk:tks) = kmore (happyTerminalToTok tk) tk tks\n"
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "{-# INLINE happyLex #-}\n"
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyNewToken action sts stk = happyLex (\\tk -> " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    eofAction String
    "notHappyAtAll" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    ") ("
    >             (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\\i tk -> " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    doAction (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " sts stk)\n"
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyReport " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    eofTok (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " tk explist resume tks = happyReport' tks explist resume\n"
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyReport _ tk explist resume tks = happyReport' (tk:tks) explist (\\tks -> resume (Happy_Prelude.tail tks))\n"
    >             -- when the token is EOF, tk == _|_ (notHappyAtAll)
    >             -- so we must not pass it to happyReport'
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n";

    >       Just (String
    lexer'',String
    eof') ->
    >         String -> String -> String
    str String
    "happyLex kend kmore = " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    lexer'' (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " (\\tk -> case tk of {\n" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    indent
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    eof' (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " -> kend tk;\n" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    indent
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "_ -> kmore (happyTerminalToTok tk) tk })\n"
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "{-# INLINE happyLex #-}\n"
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyNewToken action sts stk = happyLex (\\tk -> " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    eofAction String
    "tk" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    ") ("
    >             (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\\i tk -> " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    doAction (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " sts stk)\n"
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyReport " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    eofTok (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " = happyReport'\n"
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyReport _ = happyReport'\n"
    >             -- superfluous pattern match needed to force happyReport to
    >             -- have the correct type.
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n";
    >       })

    >       where

    >         eofAction :: String -> String -> String
    eofAction String
    tk = String -> String -> String
    str String
    "happyDoAction "
    >                      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    eofTok (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    strspace (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    tk
    >                      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " action sts stk"
    >         eofTok :: String -> String
    eofTok = Int -> String -> String
    forall {a}. Show a => a -> String -> String
    showInt (Name -> Int
    tokIndex Name
    eof)
    >         doAction :: String -> String
    doAction = String -> String -> String
    str String
    "happyDoAction i tk action"
    >         doToken :: (Name, TokenSpec) -> String -> String
    doToken (Name
    i,TokenSpec
    tok) = String -> String -> String
    str (TokenSpec -> String
    removeDollarDollar TokenSpec
    tok) (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " -> " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> String
    forall {a}. Show a => a -> String -> String
    showInt (Name -> Int
    tokIndex Name
    i)

    Use a variable rather than '_' to replace '$$', so we can use it on
    the left hand side of '@'.

    >         removeDollarDollar :: TokenSpec -> String
    removeDollarDollar TokenSpec
    tok = case TokenSpec
    tok of
    >              TokenFixed String
    t -> String
    t
    >              TokenWithValue ExpressionWithHole
    e -> ExpressionWithHole -> String -> String
    substExpressionWithHole ExpressionWithHole
    e String
    "happy_dollar_dollar"

    >    mkHappyTerminalVar :: Int -> Name -> String -> String
    >    mkHappyTerminalVar :: Int -> Name -> String -> String
    mkHappyTerminalVar Int
    i Name
    t =
    >     case Name -> [(Name, TokenSpec)] -> Maybe TokenSpec
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Name
    t [(Name, TokenSpec)]
    token_rep of
    >       Maybe TokenSpec
    Nothing -> String -> String
    pat
    >       Just (TokenFixed String
    _) -> String -> String
    pat
    >       Just (TokenWithValue ExpressionWithHole
    e) -> String -> String -> String
    brack (String -> String -> String) -> String -> String -> String
    forall a b. (a -> b) -> a -> b
    $ ExpressionWithHole -> String -> String
    substExpressionWithHole ExpressionWithHole
    e (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> String
    pat []
    >     where
    >         pat :: String -> String
    pat = Int -> String -> String
    mkHappyVar Int
    i
    >    tokIndex :: Name -> Int
    tokIndex Name
    i = Name -> Int
    getName Name
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Name -> Int
    getName Name
    fst_term Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2 -- +2: errorTok, catchTok

    %-----------------------------------------------------------------------------
    Action Tables.

    Here we do a bit of trickery and replace the normal default action
    (failure) for each state with at least one reduction action.  For each
    such state, we pick one reduction action to be the default action.
    This should make the code smaller without affecting the speed.
    It changes the sematics for errors, however; errors could be detected in a
    different state now (but they'll still be detected at the same point in the
    token stream).

    SG: For a data point, in issue93 the happyTable triples in size when we always
    pick failure as the default reduction.
    Presumably that is because there are quite a few reduction states, in which the
    only non-default transition is a reduction.
    Our scheme above ensures that these states don't occupy space in the main
    happyTable at all; they just get an entry in the happyDefActions.

    Further notes on default cases:

    Default reductions are important when error recovery is considered: we
    don't allow reductions whilst in error recovery, so we'd like the
    parser to automatically reduce down to a state where the error token
    can be shifted before entering error recovery.  This is achieved by
    using default reductions wherever possible.

    One case to consider is:

    State 345

            con -> conid .                                      (rule 186)
            qconid -> conid .                                   (rule 212)

            error          reduce using rule 212
            '{'            reduce using rule 186
            etc.

    we should make reduce_212 the default reduction here.  So the rules become:

       * if there is a production
            error -> reduce_n
         then make reduce_n the default action.
       * if there is a non-reduce action for the error token, the default action
         for this state must be "fail".
       * otherwise pick the most popular reduction in this state for the default.
       * if there are no reduce actions in this state, then the default
         action remains 'enter error recovery'.

    This gives us an invariant: there won't ever be a production of the
    type 'error -> reduce_n' explicitly in the grammar, which means that
    whenever an unexpected token occurs, either the parser will reduce
    straight back to a state where the error token can be shifted, or if
    none exists, we'll get a parse error.  In theory, we won't need the
    machinery to discard states in the parser...

    >    produceActionTable :: String -> String
    produceActionTable
    >       = String -> String
    produceActionArray
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    produceReduceArray
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    produceRuleArray
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    produceCatchStates
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happy_n_terms = " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> String
    forall {a}. Show a => a -> String -> String
    shows Int
    n_terminals (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " :: Happy_Prelude.Int\n"
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happy_n_nonterms = " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> String
    forall {a}. Show a => a -> String -> String
    shows Int
    n_nonterminals (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " :: Happy_Prelude.Int\n\n"
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happy_n_starts = " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> String
    forall {a}. Show a => a -> String -> String
    shows Int
    n_starts (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " :: Happy_Prelude.Int\n\n"
    >
    >    produceTokToStringList :: String -> String
    produceTokToStringList
    >       = String -> String -> String
    str String
    "{-# NOINLINE happyTokenStrings #-}\n"
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyTokenStrings = " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> String -> String
    forall {a}. Show a => a -> String -> String
    shows (Int -> [String] -> [String]
    forall a. Int -> [a] -> [a]
    drop (Name -> Int
    getName Name
    fst_term Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) (Array Name String -> [String]
    forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
    elems Array Name String
    token_names')) (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"
    >                                            -- fst_term - 1: fst_term includes eofToken, but that is last in the list.
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"

    action array indexed by (terminal * last_state) + state

    >    produceActionArray :: String -> String
    produceActionArray
    >           = String -> String -> String
    str String
    "happyActOffsets :: HappyAddr\n"
    >           (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyActOffsets = HappyA# \"" --"
    >           (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Int] -> String -> String
    hexChars [Int]
    act_offs
    >           (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\"#\n\n" --"
    >
    >           (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyGotoOffsets :: HappyAddr\n"
    >           (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyGotoOffsets = HappyA# \"" --"
    >           (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Int] -> String -> String
    hexChars [Int]
    goto_offs
    >           (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\"#\n\n"  --"
    >
    >           (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyDefActions :: HappyAddr\n"
    >           (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyDefActions = HappyA# \"" --"
    >           (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Int] -> String -> String
    hexChars [Int]
    defaults
    >           (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\"#\n\n" --"
    >
    >           (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyCheck :: HappyAddr\n"
    >           (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyCheck = HappyA# \"" --"
    >           (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Int] -> String -> String
    hexChars [Int]
    check
    >           (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\"#\n\n" --"
    >
    >           (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyTable :: HappyAddr\n"
    >           (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyTable = HappyA# \"" --"
    >           (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Int] -> String -> String
    hexChars [Int]
    table
    >           (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\"#\n\n" --"

    >    n_terminals :: Int
    n_terminals = [Name] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Name]
    terms
    >    n_nonterminals :: Int
    n_nonterminals = [Name] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Name]
    nonterms Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    n_starts -- lose %starts
    >
    >    ([Int]
    act_offs,[Int]
    goto_offs,[Int]
    table,[Int]
    defaults,[Int]
    check,[Int]
    catch_states)
    >       = ActionTable
    -> GotoTable
    -> Name
    -> Name
    -> Int
    -> Int
    -> Int
    -> ([Int], [Int], [Int], [Int], [Int], [Int])
    mkTables ActionTable
    action GotoTable
    goto Name
    first_nonterm' Name
    fst_term
    >               Int
    n_terminals Int
    n_nonterminals Int
    n_starts
    >
    >    produceReduceArray :: String -> String
    produceReduceArray
    >       = String -> String -> String
    str String
    "happyReduceArr = Happy_Data_Array.array ("
    >               (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> String
    forall {a}. Show a => a -> String -> String
    shows (Int
    n_starts :: Int) -- omit the %start reductions
    >               (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    ", "
    >               (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> String
    forall {a}. Show a => a -> String -> String
    shows Int
    n_rules
    >               (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    ") [\n"
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String -> String] -> String -> String
    interleave' String
    ",\n" ((Int -> String -> String) -> [Int] -> [String -> String]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> String -> String
    forall {a}. Show a => a -> String -> String
    reduceArrElem [Int
    n_starts..Int
    n_rules])
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    indent (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "]\n\n"
    >
    >    produceRuleArray :: String -> String
    produceRuleArray -- rule number to (non-terminal number, rule length)
    >       = String -> String -> String
    str String
    "happyRuleArr :: HappyAddr\n"
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyRuleArr = HappyA# \"" -- "
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Int] -> String -> String
    hexChars (((Int, Int) -> [Int]) -> [(Int, Int)] -> [Int]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (\(Int
    nt,Int
    len) -> [Int
    nt,Int
    len]) [(Int, Int)]
    ruleArrElems)
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\"#\n\n" --"
    >
    >    ruleArrElems :: [(Int, Int)]
    ruleArrElems = (Production String -> (Int, Int))
    -> [Production String] -> [(Int, Int)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Production Name
    nt [Name]
    toks (String, [Int])
    _code Priority
    _prio) -> (Name -> Int
    getName Name
    nt Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Name -> Int
    getName Name
    first_nonterm',[Name] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Name]
    toks)) (Int -> [Production String] -> [Production String]
    forall a. Int -> [a] -> [a]
    drop Int
    n_starts [Production String]
    prods)
    >
    >    n_rules :: Int
    n_rules = [Production String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Production String]
    prods Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1 :: Int
    >
    >    produceCatchStates :: String -> String
    produceCatchStates
    >       = String -> String -> String
    str String
    "happyCatchStates :: [Happy_Prelude.Int]\n"
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyCatchStates = " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Int] -> String -> String
    forall {a}. Show a => a -> String -> String
    shows [Int]
    catch_states (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n\n"

    >    showInt :: a -> String -> String
    showInt a
    i = a -> String -> String
    forall {a}. Show a => a -> String -> String
    shows a
    i (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> String -> String
    showChar Char
    '#'

    This lets examples like:

            data HappyAbsSyn t1
                    = HappyTerminal ( HaskToken )
                    | HappyAbsSyn1 (  HaskExp  )
                    | HappyAbsSyn2 (  HaskExp  )
                    | HappyAbsSyn3 t1

    *share* the definition for ( HaskExp )

            data HappyAbsSyn t1
                    = HappyTerminal ( HaskToken )
                    | HappyAbsSyn1 (  HaskExp  )
                    | HappyAbsSyn3 t1

    ... cutting down on the work that the type checker has to do.

    Note, this *could* introduce lack of polymophism,
    for types that have alphas in them. Maybe we should
    outlaw them inside { }

    >    nt_types_index :: Array Name Name
    >    nt_types_index :: Array Name Name
    nt_types_index = (Name, Name) -> [(Name, Name)] -> Array Name Name
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    (i, i) -> [(i, e)] -> a i e
    array (Array Name (Maybe String) -> (Name, Name)
    forall i. Ix i => Array i (Maybe String) -> (i, i)
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> (i, i)
    bounds Array Name (Maybe String)
    nt_types)
    >                       [ (Name
    a, Name -> Maybe String -> Name
    fn Name
    a Maybe String
    b) | (Name
    a, Maybe String
    b) <- Array Name (Maybe String) -> [(Name, Maybe String)]
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> [(i, e)]
    assocs Array Name (Maybe String)
    nt_types ]
    >     where
    >       fn :: Name -> Maybe String -> Name
    fn Name
    n Maybe String
    Nothing = Name
    n
    >       fn Name
    _ (Just String
    a) = Name -> Maybe Name -> Name
    forall a. a -> Maybe a -> a
    fromMaybe (String -> Name
    forall a. HasCallStack => String -> a
    error String
    "can't find an item in list") (String -> [(String, Name)] -> Maybe Name
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    a [(String, Name)]
    assoc_list)
    >       assoc_list :: [(String, Name)]
    assoc_list = [ (String
    b,Name
    a) | (Name
    a, Just String
    b) <- Array Name (Maybe String) -> [(Name, Maybe String)]
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> [(i, e)]
    assocs Array Name (Maybe String)
    nt_types ]

    >    makeAbsSynCon :: Name -> String -> String
    makeAbsSynCon = Array Name Name -> Name -> String -> String
    mkAbsSynCon Array Name Name
    nt_types_index

    >    produceIdentityStuff :: String -> String
    produceIdentityStuff | Bool
    use_monad = String -> String
    forall a. a -> a
    id
    >     | Bool
    imported_identity' =
    >            String -> String -> String
    str String
    "type HappyIdentity = Identity\n"
    >          (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyIdentity = Identity\n"
    >          (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyRunIdentity = runIdentity\n\n"
    >     | Bool
    otherwise =
    >            String -> String -> String
    str String
    "newtype HappyIdentity a = HappyIdentity a\n"
    >          (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyIdentity = HappyIdentity\n"
    >          (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyRunIdentity (HappyIdentity a) = a\n\n"
    >          (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "instance Happy_Prelude.Functor HappyIdentity where\n"
    >          (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "    fmap f (HappyIdentity a) = HappyIdentity (f a)\n\n"
    >          (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "instance Applicative HappyIdentity where\n"
    >          (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "    pure  = HappyIdentity\n"
    >          (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "    (<*>) = ap\n"
    >          (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "instance Happy_Prelude.Monad HappyIdentity where\n"
    >          (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "    return = pure\n"
    >          (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "    (HappyIdentity p) >>= q = q p\n\n"

    MonadStuff:

      - with no %monad or %lexer:

            happyThen    :: () => HappyIdentity a -> (a -> HappyIdentity b) -> HappyIdentity b
            happyReturn  :: () => a -> HappyIdentity a
            happyThen1   m k tks = happyThen m (\a -> k a tks)
            happyFmap1   f m tks = happyThen (m tks) (\a -> happyReturn (f a))
            happyReturn1 = \a tks -> happyReturn a

      - with %monad:

            happyThen    :: CONTEXT => P a -> (a -> P b) -> P b
            happyReturn  :: CONTEXT => a -> P a
            happyThen1   m k tks = happyThen m (\a -> k a tks)
            happyFmap1   f m tks = happyThen (m tks) (\a -> happyReturn (f a))
            happyReturn1 = \a tks -> happyReturn a

      - with %monad & %lexer:

            happyThen    :: CONTEXT => P a -> (a -> P b) -> P b
            happyReturn  :: CONTEXT => a -> P a
            happyThen1   = happyThen
            happyReturn1 = happyReturn
            happyFmap1 f m = happyThen m (\a -> happyReturn (f a))

    >    produceMonadStuff :: String -> String
    produceMonadStuff =
    >            String -> String -> String
    str String
    "happyThen :: " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    pcont (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " => " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> String -> String
    ptyAt (String -> String -> String
    str String
    "a")
    >          (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " -> (a -> " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> String -> String
    ptyAt (String -> String -> String
    str String
    "b")
    >          (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    ") -> " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> String -> String
    ptyAt (String -> String -> String
    str String
    "b") (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"
    >          (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyThen = " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    brack String
    monad_then (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    nl
    >          (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyReturn :: " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    pcont (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " => a -> " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> String -> String
    ptyAt (String -> String -> String
    str String
    "a") (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"
    >          (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyReturn = " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    brack String
    monad_return (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    nl
    >          (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . case Maybe (String, String)
    lexer' of
    >               Maybe (String, String)
    Nothing ->
    >                  String -> String -> String
    str String
    "happyThen1 m k tks = (" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    monad_then
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    ") m (\\a -> k a tks)\n"
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyFmap1 f m tks = happyThen (m tks) (\\a -> happyReturn (f a))\n"
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyReturn1 :: " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    pcont (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " => a -> b -> " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> String -> String
    ptyAt (String -> String -> String
    str String
    "a") (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyReturn1 = \\a tks -> " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    brack String
    monad_return
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " a\n"
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyReport' :: " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    pcont (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " => "
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "[" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    token (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "] -> "
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "[Happy_Prelude.String] -> ("
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "[" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    token (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "] -> "
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> String -> String
    ptyAt (String -> String -> String
    str String
    "a") (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    ") -> "
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> String -> String
    ptyAt (String -> String -> String
    str String
    "a")
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyReport' = " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    callReportError (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyAbort :: " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    pcont (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " => "
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "[" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    token (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "] -> "
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> String -> String
    ptyAt (String -> String -> String
    str String
    "a")
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyAbort = " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    abort_handler (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"
    >               Maybe (String, String)
    _ ->
    >                let
    >                  happyDoParseSig :: String -> String
    happyDoParseSig =
    >                        String -> String -> String
    str String
    "happyDoParse :: " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    pcont (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " => " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    intMaybeHash
    >                      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " -> " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    pty (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    happyAbsSyn (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"
    >                      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"
    >                  newTokenSig :: String -> String
    newTokenSig =
    >                        String -> String -> String
    str String
    "happyNewToken :: " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    pcont (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " => " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    intMaybeHash
    >                      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " -> Happy_IntList -> HappyStk " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    happyAbsSyn
    >                      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " -> " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> String -> String
    ptyAt String -> String
    happyAbsSyn (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    strString
    "\n"
    >                      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"
    >                  doActionSig :: String -> String
    doActionSig =
    >                        String -> String -> String
    str String
    "happyDoAction :: " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    pcont (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " => " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    intMaybeHash
    >                      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " -> " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    token_type' (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " -> " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    intMaybeHash
    >                      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " -> Happy_IntList -> HappyStk " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    happyAbsSyn
    >                      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " -> " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> String -> String
    ptyAt String -> String
    happyAbsSyn (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"
    >                      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"
    >                  reduceArrSig :: String -> String
    reduceArrSig =
    >                        String -> String -> String
    str String
    "happyReduceArr :: " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    pcont
    >                      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " => Happy_Data_Array.Array Happy_Prelude.Int (" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    intMaybeHash
    >                      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " -> " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    token_type' (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " -> " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    intMaybeHash
    >                      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " -> Happy_IntList -> HappyStk " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    happyAbsSyn
    >                      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " -> " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> String -> String
    ptyAt String -> String
    happyAbsSyn (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    ")\n"
    >                      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"
    >                  in String -> String
    happyDoParseSig (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    newTokenSig (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    doActionSig (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    reduceArrSig
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyThen1 :: " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    pcont (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " => " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    pty
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " a -> (a -> "  (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    pty
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " b) -> " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    pty (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " b\n"
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyThen1 = happyThen\n"
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyFmap1 f m = happyThen m (\\a -> happyReturn (f a))\n"
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyReturn1 :: " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    pcont (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " => a -> " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> String -> String
    ptyAt (String -> String -> String
    str String
    "a") (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyReturn1 = happyReturn\n"
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyReport' :: " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    pcont (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " => "
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    token (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " -> "
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "[Happy_Prelude.String] -> "
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> String -> String
    ptyAt (String -> String -> String
    str String
    "a") (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " -> "
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> String -> String
    ptyAt (String -> String -> String
    str String
    "a")
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyReport' = " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    callReportError (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyAbort :: " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    pcont (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " => "
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> String -> String
    ptyAt (String -> String -> String
    str String
    "a")
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyAbort = " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    abort_handler (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"
    >                (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "\n"

    The error handler takes up to three arguments.
    An error handler specified with %error is passed the current token
    when used with %lexer as the first argument, but happyError (the old way but kept for
    compatibility) is not passed the current token.
    Furthermore, the second argument is the list of expected tokens
    in the presence of the %error.expected directive.
    The last argument is the "resumption", a continuation that tries to find
    an item on the stack taking a @catch@ terminal where parsing may resume,
    in the presence of the two-argument form of the %error directive.
    In order to support the legacy %errorhandlertype directive, we retain
    have a special code path for `OldExpected`.

    >    callReportError :: String -> String
    callReportError = -- this one wraps around report_error_handler to expose a unified interface
    >       String -> String -> String
    str String
    "(\\tokens expected resume -> " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
    >       (if Bool
    use_monad then String -> String -> String
    str String
    ""
    >                     else String -> String -> String
    str String
    "HappyIdentity Happy_Prelude.$ ") (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
    >       String -> String
    report_error_handler (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
    >       (case ErrorExpectedMode
    error_expected' of
    >          ErrorExpectedMode
    OldExpected -> String -> String -> String
    str String
    " (tokens, expected)"  -- back-compat for %errorhandlertype
    >          ErrorExpectedMode
    _ ->
    >            (case (ErrorHandlerInfo
    error_handler', Maybe (String, String)
    lexer') of (ErrorHandlerInfo
    DefaultErrorHandler, Just (String, String)
    _) -> String -> String
    forall a. a -> a
    id
    >                                              (ErrorHandlerInfo, Maybe (String, String))
    _                             -> String -> String -> String
    str String
    " tokens") (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
    >            (case ErrorExpectedMode
    error_expected' of ErrorExpectedMode
    NewExpected -> String -> String -> String
    str String
    " expected"
    >                                     ErrorExpectedMode
    NoExpected  -> String -> String
    forall a. a -> a
    id)) (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
    >       (case ErrorHandlerInfo
    error_handler' of ResumptiveErrorHandler{} -> String -> String -> String
    str String
    " resume"
    >                               ErrorHandlerInfo
    _                        -> String -> String
    forall a. a -> a
    id) (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
    >       String -> String -> String
    str String
    ")"
    >    report_error_handler :: String -> String
    report_error_handler = case ErrorHandlerInfo
    error_handler' of
    >       ErrorHandlerInfo
    DefaultErrorHandler                  -> String -> String -> String
    str String
    "happyError"
    >       CustomErrorHandler String
    h                 -> String -> String -> String
    brack String
    h
    >       ResumptiveErrorHandler String
    _abort String
    report -> String -> String -> String
    brack String
    report
    >    abort_handler :: String
    abort_handler = case ErrorHandlerInfo
    error_handler' of
    >       ResumptiveErrorHandler String
    abort String
    _report -> String
    abort
    >       ErrorHandlerInfo
    _                                    -> String
    "Happy_Prelude.error \"Called abort handler in non-resumptive parser\""

    >    reduceArrElem :: a -> String -> String
    reduceArrElem a
    n
    >      = String -> String -> String
    str String
    "" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    indent (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "(" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> String -> String
    forall {a}. Show a => a -> String -> String
    shows a
    n (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " , "
    >      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyReduce_" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> String -> String
    forall {a}. Show a => a -> String -> String
    shows a
    n (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> String -> String
    char Char
    ')'

    -----------------------------------------------------------------------------
    -- Produce the parser entry and exit points

    >    produceEntries :: String -> String
    produceEntries
    >       = String -> [String -> String] -> String -> String
    interleave String
    "\n\n" ((((String, Name, Name, Bool), Int) -> String -> String)
    -> [((String, Name, Name, Bool), Int)] -> [String -> String]
    forall a b. (a -> b) -> [a] -> [b]
    map ((String, Name, Name, Bool), Int) -> String -> String
    forall t0 t1. ((String, t0, Name, t1), Int) -> String -> String
    produceEntry ([(String, Name, Name, Bool)]
    -> [Int] -> [((String, Name, Name, Bool), Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [(String, Name, Name, Bool)]
    starts' [Int
    0..]))
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . case Maybe AttributeGrammarExtras
    mAg of
    >           Maybe AttributeGrammarExtras
    Nothing -> String -> String
    forall a. a -> a
    id
    >           Just AttributeGrammarExtras
    ag -> AttributeGrammarExtras
    -> [(String, Name, Name, Bool)] -> String -> String
    forall {b} {c} {d}.
    AttributeGrammarExtras -> [(String, b, c, d)] -> String -> String
    produceAttrEntries AttributeGrammarExtras
    ag [(String, Name, Name, Bool)]
    starts'

    >    produceEntry :: ((String, t0, Name, t1), Int) -> String -> String
    >    produceEntry :: forall t0 t1. ((String, t0, Name, t1), Int) -> String -> String
    produceEntry ((String
    name, t0
    _start_nonterm, Name
    accept_nonterm, t1
    _partial), Int
    no)
    >       = (if Maybe AttributeGrammarExtras -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe AttributeGrammarExtras
    mAg then String -> String -> String
    str String
    name else String -> String -> String
    str String
    "do_" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    name)
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    maybe_tks
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " = "
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    unmonad
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happySomeParser where\n"
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " happySomeParser = happyThen (happyDoParse "
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> String
    forall {a}. Show a => a -> String -> String
    shows Int
    no (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "#"
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    maybe_tks
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    ") "
    >       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> String -> String
    brack' (if Bool
    coerce
    >                    then String -> String -> String
    str String
    "\\x -> happyReturn (let {" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe String -> Name -> (String -> String) -> String -> String
    forall a. Maybe a -> Name -> (String -> String) -> String -> String
    mkHappyWrapCon (Array Name (Maybe String)
    nt_types Array Name (Maybe String) -> Name -> Maybe String
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> i -> e
    ! Name
    accept_nonterm) Name
    accept_nonterm (String -> String -> String
    str String
    "x'")
    >                       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " = " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String -> String
    mkHappyOut Name
    accept_nonterm (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " x} in x')"
    >                    else String -> String -> String
    str String
    "\\x -> case x of {HappyAbsSyn"
    >                       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String -> String
    showsName (Array Name Name
    nt_types_index Array Name Name -> Name -> Name
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> i -> e
    ! Name
    accept_nonterm)
    >                       (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " z -> happyReturn z; _other -> notHappyAtAll }"
    >                )
    >     where
    >       maybe_tks :: String -> String
    maybe_tks | Maybe (String, String) -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe (String, String)
    lexer' = String -> String -> String
    str String
    " tks"
    >                 | Bool
    otherwise = String -> String
    forall a. a -> a
    id
    >       unmonad :: String
    unmonad | Bool
    use_monad = String
    ""
    >                 | Bool
    otherwise = String
    "happyRunIdentity "

    >    produceAttrEntries :: AttributeGrammarExtras -> [(String, b, c, d)] -> String -> String
    produceAttrEntries AttributeGrammarExtras
    ag [(String, b, c, d)]
    starts''
    >       = String -> [String -> String] -> String -> String
    interleave String
    "\n\n" (((String, b, c, d) -> String -> String)
    -> [(String, b, c, d)] -> [String -> String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, b, c, d) -> String -> String
    forall {b} {c} {d}. (String, b, c, d) -> String -> String
    f [(String, b, c, d)]
    starts'')
    >     where
    >       f :: (String, b, c, d) -> String -> String
    f = case (Bool
    use_monad,Maybe (String, String)
    lexer') of
    >             (Bool
    True,Just (String, String)
    _)  -> \(String
    name,b
    _,c
    _,d
    _) -> String -> String -> String
    monadAndLexerAE String
    name
    >             (Bool
    True,Maybe (String, String)
    Nothing) -> \(String
    name,b
    _,c
    _,d
    _) -> String -> String -> String
    monadAE String
    name
    >             (Bool
    False,Just (String, String)
    _) -> String -> (String, b, c, d) -> String -> String
    forall a. HasCallStack => String -> a
    error String
    "attribute grammars not supported for non-monadic parsers with %lexer"
    >             (Bool
    False,Maybe (String, String)
    Nothing)-> \(String
    name,b
    _,c
    _,d
    _) -> String -> String -> String
    regularAE String
    name
    >
    >       defaultAttr :: String
    defaultAttr = (String, String) -> String
    forall a b. (a, b) -> a
    fst ([(String, String)] -> (String, String)
    forall a. HasCallStack => [a] -> a
    head ([(String, String)] -> (String, String))
    -> [(String, String)] -> (String, String)
    forall a b. (a -> b) -> a -> b
    $ AttributeGrammarExtras -> [(String, String)]
    attributes AttributeGrammarExtras
    ag)
    >
    >       monadAndLexerAE :: String -> String -> String
    monadAndLexerAE String
    name
    >         = String -> String -> String
    str String
    name (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " = "
    >         (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "do { "
    >         (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "f <- do_" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    name (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "; "
    >         (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "let { (conds,attrs) = f happyEmptyAttrs } in do { "
    >         (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "Happy_Prelude.sequence_ conds; "
    >         (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "Happy_Prelude.return ("(String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    defaultAttr (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " attrs) }}"
    >       monadAE :: String -> String -> String
    monadAE String
    name
    >         = String -> String -> String
    str String
    name (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " toks = "
    >         (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "do { "
    >         (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "f <- do_" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    name (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " toks; "
    >         (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "let { (conds,attrs) = f happyEmptyAttrs } in do { "
    >         (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "Happy_Prelude.sequence_ conds; "
    >         (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "Happy_Prelude.return ("(String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    defaultAttr (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " attrs) }}"
    >       regularAE :: String -> String -> String
    regularAE String
    name
    >         = String -> String -> String
    str String
    name (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " toks = "
    >         (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "let { "
    >         (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "f = do_" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    name (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " toks; "
    >         (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "(conds,attrs) = f happyEmptyAttrs; "
    >         (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "x = Happy_Prelude.foldr Happy_GHC_Exts.seq attrs conds; "
    >         (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "} in ("(String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    defaultAttr (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " x)"

    ----------------------------------------------------------------------------
    -- Produce attributes declaration for attribute grammars

    > produceAttributes :: AttributeGrammarExtras -> String -> String
    > produceAttributes :: AttributeGrammarExtras -> String -> String
    produceAttributes AttributeGrammarExtras {
    >         attributes :: AttributeGrammarExtras -> [(String, String)]
    attributes = [(String, String)]
    attrs,
    >         attributetype :: AttributeGrammarExtras -> String
    attributetype = String
    attributeType
    >     }
    >     = String -> String -> String
    str String
    "data " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    attrHeader (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " = HappyAttributes {" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    attributes' (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "}" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    nl
    >     (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "happyEmptyAttrs = HappyAttributes {" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    attrsErrors (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "}" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    nl

    >   where attributes' :: String -> String
    attributes'  = ((String -> String) -> (String -> String) -> String -> String)
    -> [String -> String] -> String -> String
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldl1 (\String -> String
    x String -> String
    y -> String -> String
    x (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    ", " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    y) ([String -> String] -> String -> String)
    -> [String -> String] -> String -> String
    forall a b. (a -> b) -> a -> b
    $ ((String, String) -> String -> String)
    -> [(String, String)] -> [String -> String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, String) -> String -> String
    formatAttribute [(String, String)]
    attrs
    >         formatAttribute :: (String, String) -> String -> String
    formatAttribute (String
    ident,String
    typ) = String -> String -> String
    str String
    ident (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " :: " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    typ
    >         attrsErrors :: String -> String
    attrsErrors = ((String -> String) -> (String -> String) -> String -> String)
    -> [String -> String] -> String -> String
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldl1 (\String -> String
    x String -> String
    y -> String -> String
    x (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    ", " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    y) ([String -> String] -> String -> String)
    -> [String -> String] -> String -> String
    forall a b. (a -> b) -> a -> b
    $ ((String, String) -> String -> String)
    -> [(String, String)] -> [String -> String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, String) -> String -> String
    forall {b}. (String, b) -> String -> String
    attrError [(String, String)]
    attrs
    >         attrError :: (String, b) -> String -> String
    attrError (String
    ident,b
    _) = String -> String -> String
    str String
    ident (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    " = Happy_Prelude.error \"invalid reference to attribute '" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    ident (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    "'\""
    >         attrHeader :: String -> String
    attrHeader =
    >             case String
    attributeType of
    >             [] -> String -> String -> String
    str String
    "HappyAttributes"
    >             String
    _  -> String -> String -> String
    str String
    attributeType

    -----------------------------------------------------------------------------
    -- Strict or non-strict parser

    > produceStrict :: Bool -> String -> String
    > produceStrict :: Bool -> String -> String
    produceStrict Bool
    strict
    >       | Bool
    strict    = String -> String -> String
    str String
    "happySeq = happyDoSeq\n\n"
    >       | Bool
    otherwise = String -> String -> String
    str String
    "happySeq = happyDontSeq\n\n"

    -----------------------------------------------------------------------------
    Replace all the $n variables with happy_vars, and return a list of all the
    vars used in this piece of code.

    > actionVal :: LRAction -> Int
    > actionVal :: LRAction -> Int
    actionVal (LR'Shift  Int
    state Priority
    _) = Int
    state Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
    > actionVal (LR'Reduce Int
    rule Priority
    _)  = -(Int
    rule Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
    > actionVal LRAction
    LR'Accept           = -Int
    1
    > actionVal (LR'Multiple [LRAction]
    _ LRAction
    a)   = LRAction -> Int
    actionVal LRAction
    a
    > actionVal LRAction
    LR'Fail             = Int
    0
    > actionVal LRAction
    LR'MustFail         = Int
    0

    See notes under "Action Tables" above for some subtleties in this function.

    > getDefault :: [(Name, LRAction)] -> LRAction
    > getDefault :: [(Name, LRAction)] -> LRAction
    getDefault [(Name, LRAction)]
    actions
    >   -- pick out the action for the error token, if any
    >   | (LRAction
    act : [LRAction]
    _) <- [LRAction]
    error_acts, LRAction
    act LRAction -> LRAction -> Bool
    forall a. Eq a => a -> a -> Bool
    /= LRAction
    LR'Fail
    >   = case LRAction
    act of
    >
    >       -- use error reduction as the default action, if there is one.
    >       LR'Reduce Int
    _ Priority
    _                 -> LRAction
    act
    >       LR'Multiple [LRAction]
    _ (LR'Reduce Int
    _ Priority
    _) -> LRAction
    act
    >
    >       -- if the error token is shifted or otherwise, don't generate
    >       -- a default reduction action.  This is *important*!
    >       LRAction
    _ -> LRAction
    LR'Fail
    >
    >   -- do not reduce by default in a state that could shift the catch token.
    >   -- otherwise upon an error, we discard viable resumption points from the
    >   -- parsing stack.
    >   -- This makes a difference on GHC's parser for input such as
    >   --    f = foo data; x = + blah
    >   -- where we must detect `data` as a parse error early enough to parse
    >   -- `foo data` as an application
    >   | (LR'Shift{} : [LRAction]
    _) <- [LRAction]
    catch_acts
    >   = LRAction
    LR'Fail
    >   | (LR'Multiple [LRAction]
    _ LR'Shift{} : [LRAction]
    _) <- [LRAction]
    catch_acts
    >   = LRAction
    LR'Fail
    >
    >   | Bool
    otherwise
    >   -- no error or catch actions, pick a reduce to be the default.
    >   = case [LRAction]
    reduces of
    >       [LRAction]
    _ -> case [LRAction]
    reduces of
    >         [] -> LRAction
    LR'Fail
    >         (LRAction
    act:[LRAction]
    _) -> LRAction
    act    -- pick the first one we see for now
    >
    >   where
    >     error_acts :: [LRAction]
    error_acts = [ LRAction
    act | (Name
    e, LRAction
    act) <- [(Name, LRAction)]
    actions, Name
    e Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    errorTok ]
    >     catch_acts :: [LRAction]
    catch_acts = [ LRAction
    act | (Name
    e, LRAction
    act) <- [(Name, LRAction)]
    actions, Name
    e Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    catchTok ]
    >     reduces :: [LRAction]
    reduces
    >           =  [ LRAction
    act | (Name
    _, act :: LRAction
    act@(LR'Reduce Int
    _ Priority
    _)) <- [(Name, LRAction)]
    actions ]
    >           [LRAction] -> [LRAction] -> [LRAction]
    forall a. [a] -> [a] -> [a]
    ++ [ LRAction
    act | (Name
    _, LR'Multiple [LRAction]
    _ act :: LRAction
    act@(LR'Reduce Int
    _ Priority
    _)) <- [(Name, LRAction)]
    actions ]

    -----------------------------------------------------------------------------
    -- Generate packed parsing tables.

    -- happyActOff ! state
    --     Offset within happyTable of actions for state

    -- happyGotoOff ! state
    --     Offset within happyTable of gotos for state

    -- happyTable
    --      Combined action/goto table

    -- happyDefAction ! state
    --      Default action for state

    -- happyCheck
    --      Indicates whether we should use the default action for state

    -- the table is laid out such that the action for a given state & token
    -- can be found by:
    --
    --        off    = happyActOff ! state
    --        off_i  = off + token
    --        check  | off_i => 0 = (happyCheck ! off_i) == token
    --               | otherwise  = False
    --        action | check      = happyTable ! off_i
    --               | otherwise  = happyDefAaction ! off_i

    -- figure out the default action for each state.  This will leave some
    -- states with no *real* actions left.

    -- for each state with one or more real actions, sort states by
    -- width/spread of tokens with real actions, then by number of
    -- elements with actions, so we get the widest/densest states
    -- first. (I guess the rationale here is that we can use the
    -- thin/sparse states to fill in the holes later, and also we
    -- have to do less searching for the more complicated cases).

    -- try to pair up states with identical sets of real actions.

    -- try to fit the actions into the check table, using the ordering
    -- from above.

    SG: If you want to know more about similar compression schemes, consult
          Storing a Sparse Table (https://dl.acm.org/doi/10.1145/359168.359175)
    One can think of the mapping @\(state,token) -> (offs ! state)+token@ as a hash
    and @check@ as the way to detect "collisions" (i.e., default entries).

    > mkTables
    >        :: ActionTable -> GotoTable -> Name -> Name -> Int -> Int -> Int ->
    >        ( [Int]         -- happyActOffsets
    >        , [Int]         -- happyGotoOffsets
    >        , [Int]         -- happyTable
    >        , [Int]         -- happyDefAction
    >        , [Int]         -- happyCheck
    >        , [Int]         -- happyCatchStates
    >        )
    >
    > mkTables :: ActionTable
    -> GotoTable
    -> Name
    -> Name
    -> Int
    -> Int
    -> Int
    -> ([Int], [Int], [Int], [Int], [Int], [Int])
    mkTables ActionTable
    action GotoTable
    goto Name
    first_nonterm' Name
    fst_term
    >               Int
    n_terminals Int
    n_nonterminals Int
    n_starts
    >
    >  = ( UArray Int Int -> [Int]
    forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
    elems UArray Int Int
    act_offs
    >    , UArray Int Int -> [Int]
    forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
    elems UArray Int Int
    goto_offs
    >    , Int -> [Int] -> [Int]
    forall a. Int -> [a] -> [a]
    take Int
    max_off (UArray Int Int -> [Int]
    forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
    elems UArray Int Int
    table)
    >    , [Int]
    def_actions
    >    , Int -> [Int] -> [Int]
    forall a. Int -> [a] -> [a]
    take Int
    max_off (UArray Int Int -> [Int]
    forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
    elems UArray Int Int
    check)
    >    , [Int]
    shifted_catch_states
    >    )
    >  where
    >
    >        (UArray Int Int
    table,UArray Int Int
    check,UArray Int Int
    act_offs,UArray Int Int
    goto_offs,Int
    max_off)
    >                = (forall s.
     ST
       s
       (UArray Int Int, UArray Int Int, UArray Int Int, UArray Int Int,
        Int))
    -> (UArray Int Int, UArray Int Int, UArray Int Int, UArray Int Int,
        Int)
    forall a. (forall s. ST s a) -> a
    runST (Int
    -> Int
    -> [TableEntry]
    -> ST
         s
         (UArray Int Int, UArray Int Int, UArray Int Int, UArray Int Int,
          Int)
    forall s.
    Int
    -> Int
    -> [TableEntry]
    -> ST
         s
         (UArray Int Int, UArray Int Int, UArray Int Int, UArray Int Int,
          Int)
    genTables ([TableEntry] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [TableEntry]
    actions)
    >                         Int
    max_token
    >                         [TableEntry]
    sorted_actions)
    >
    >        -- the maximum token number used in the parser
    >        max_token :: Int
    max_token = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    n_terminals (Int
    n_startsInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    n_nonterminals) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
    >
    >        def_actions :: [Int]
    def_actions = (TableEntry -> Int) -> [TableEntry] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(ActionOrGoto
    _,Int
    _,Int
    def,Int
    _,Int
    _,[(Int, Int)]
    _) -> Int
    def) [TableEntry]
    actions
    >
    >        actions :: [TableEntry]
    >        actions :: [TableEntry]
    actions =
    >                [ (ActionOrGoto
    ActionEntry,
    >                   Int
    state,
    >                   LRAction -> Int
    actionVal LRAction
    default_act,
    >                   if [(Int, Int)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(Int, Int)]
    acts'' then Int
    0
    >                        else (Int, Int) -> Int
    forall a b. (a, b) -> a
    fst ([(Int, Int)] -> (Int, Int)
    forall a. HasCallStack => [a] -> a
    last [(Int, Int)]
    acts'') Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - (Int, Int) -> Int
    forall a b. (a, b) -> a
    fst ([(Int, Int)] -> (Int, Int)
    forall a. HasCallStack => [a] -> a
    head [(Int, Int)]
    acts''),
    >                   [(Int, Int)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(Int, Int)]
    acts'',
    >                   [(Int, Int)]
    acts'')
    >                | (Int
    state, Array Name LRAction
    acts) <- ActionTable -> [(Int, Array Name LRAction)]
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> [(i, e)]
    assocs ActionTable
    action,
    >                  let ((Name, LRAction)
    err:(Name, LRAction)
    catch:(Name, LRAction)
    _dummy:[(Name, LRAction)]
    vec) = Array Name LRAction -> [(Name, LRAction)]
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> [(i, e)]
    assocs Array Name LRAction
    acts
    >                      vec' :: [(Name, LRAction)]
    vec' = Int -> [(Name, LRAction)] -> [(Name, LRAction)]
    forall a. Int -> [a] -> [a]
    drop (Int
    n_startsInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    n_nonterminals) [(Name, LRAction)]
    vec
    >                      acts' :: [(Name, LRAction)]
    acts' = ((Name, LRAction) -> Bool)
    -> [(Name, LRAction)] -> [(Name, LRAction)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Name, LRAction) -> Bool
    notFail ((Name, LRAction)
    err(Name, LRAction) -> [(Name, LRAction)] -> [(Name, LRAction)]
    forall a. a -> [a] -> [a]
    :(Name, LRAction)
    catch(Name, LRAction) -> [(Name, LRAction)] -> [(Name, LRAction)]
    forall a. a -> [a] -> [a]
    :[(Name, LRAction)]
    vec')
    >                      default_act :: LRAction
    default_act = [(Name, LRAction)] -> LRAction
    getDefault [(Name, LRAction)]
    acts'
    >                      acts'' :: [(Int, Int)]
    acts'' = [(Name, LRAction)] -> LRAction -> [(Int, Int)]
    mkActVals [(Name, LRAction)]
    acts' LRAction
    default_act
    >                ]
    >
    >        shifted_catch_states :: [Int]
    >        shifted_catch_states :: [Int]
    shifted_catch_states = -- collect the states in which we have just shifted a catchTok
    >          [Int] -> [Int]
    forall a. Eq a => [a] -> [a]
    nub [ Int
    to_state | (Int
    _from_state, Array Name LRAction
    acts) <- ActionTable -> [(Int, Array Name LRAction)]
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> [(i, e)]
    assocs ActionTable
    action
    >                         , let ((Name, LRAction)
    _err:(Name, LRAction)
    catch:[(Name, LRAction)]
    _) = Array Name LRAction -> [(Name, LRAction)]
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> [(i, e)]
    assocs Array Name LRAction
    acts
    >                         , (Name
    _tok, LR'Shift Int
    to_state Priority
    _) <- (Name, LRAction) -> [(Name, LRAction)]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name, LRAction)
    catch ]
    >
    >        -- adjust terminals by -(fst_term+2), so they start at 2 (error is 0, catch is 1).
    >        --  (see ARRAY_NOTES)
    >        adjust :: Name -> Int
    >        adjust :: Name -> Int
    adjust Name
    token | Name
    token Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    errorTok = Int
    0
    >                     | Name
    token Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    catchTok = Int
    1
    >                     | Bool
    otherwise         = Name -> Int
    getName Name
    token Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Name -> Int
    getName Name
    fst_term Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2
    >
    >        mkActVals :: [(Name, LRAction)] -> LRAction -> [(Int, Int)]
    >        mkActVals :: [(Name, LRAction)] -> LRAction -> [(Int, Int)]
    mkActVals [(Name, LRAction)]
    assocs' LRAction
    default_act =
    >                [ (Name -> Int
    adjust Name
    token, LRAction -> Int
    actionVal LRAction
    act)
    >                | (Name
    token, LRAction
    act) <- [(Name, LRAction)]
    assocs'
    >                , LRAction
    act LRAction -> LRAction -> Bool
    forall a. Eq a => a -> a -> Bool
    /= LRAction
    default_act ]
    >
    >        gotos :: [TableEntry]
    >        gotos :: [TableEntry]
    gotos = [ (ActionOrGoto
    GotoEntry,
    >                   Int
    state, Int
    0,
    >                   if [(Int, Int)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(Int, Int)]
    goto_vals then Int
    0
    >                        else (Int, Int) -> Int
    forall a b. (a, b) -> a
    fst ([(Int, Int)] -> (Int, Int)
    forall a. HasCallStack => [a] -> a
    last [(Int, Int)]
    goto_vals) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - (Int, Int) -> Int
    forall a b. (a, b) -> a
    fst ([(Int, Int)] -> (Int, Int)
    forall a. HasCallStack => [a] -> a
    head [(Int, Int)]
    goto_vals),
    >                   [(Int, Int)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(Int, Int)]
    goto_vals,
    >                   [(Int, Int)]
    goto_vals
    >                  )
    >                | (Int
    state, Array Name Goto
    goto_arr) <- GotoTable -> [(Int, Array Name Goto)]
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> [(i, e)]
    assocs GotoTable
    goto,
    >                let goto_vals :: [(Int, Int)]
    goto_vals = [(Name, Goto)] -> [(Int, Int)]
    mkGotoVals (Array Name Goto -> [(Name, Goto)]
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> [(i, e)]
    assocs Array Name Goto
    goto_arr)
    >                ]
    >
    >        -- adjust nonterminals by -first_nonterm', so they start at zero
    >        --  (see ARRAY_NOTES)
    >        mkGotoVals :: [(Name, Goto)] -> [(Int, Int)]
    mkGotoVals [(Name, Goto)]
    assocs' =
    >                [ (Name -> Int
    getName Name
    token Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Name -> Int
    getName Name
    first_nonterm', Int
    i) | (Name
    token, Goto Int
    i) <- [(Name, Goto)]
    assocs' ]
    >
    >        sorted_actions :: [TableEntry]
    sorted_actions = (TableEntry -> TableEntry -> Ordering)
    -> [TableEntry] -> [TableEntry]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy ((TableEntry -> TableEntry -> Ordering)
    -> TableEntry -> TableEntry -> Ordering
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip TableEntry -> TableEntry -> Ordering
    forall {a} {a} {a} {b} {c} {f} {a} {b} {c} {f}.
    (Ord a, Ord a) =>
    (a, b, c, a, a, f) -> (a, b, c, a, a, f) -> Ordering
    cmp_state) ([TableEntry]
    actions [TableEntry] -> [TableEntry] -> [TableEntry]
    forall a. [a] -> [a] -> [a]
    ++ [TableEntry]
    gotos)
    >        cmp_state :: (a, b, c, a, a, f) -> (a, b, c, a, a, f) -> Ordering
    cmp_state (a
    _,b
    _,c
    _,a
    width1,a
    tally1,f
    _) (a
    _,b
    _,c
    _,a
    width2,a
    tally2,f
    _)
    >                | a
    width1 a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    < a
    width2  = Ordering
    LT
    >                | a
    width1 a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    width2 = a -> a -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare a
    tally1 a
    tally2
    >                | Bool
    otherwise = Ordering
    GT

    > data ActionOrGoto = ActionEntry | GotoEntry
    > type TableEntry = ( ActionOrGoto
    >                   , Int {-stateno-}
    >                   , Int {-default-}
    >                   , Int {-width-}
    >                   , Int {-tally-}
    >                   , [(Int,Int)]
    >                   )

    > genTables
    >        :: Int                         -- number of actions
    >        -> Int                         -- maximum token no.
    >        -> [TableEntry]                -- entries for the table
    >        -> ST s ( UArray Int Int       -- table
    >                , UArray Int Int       -- check
    >                , UArray Int Int       -- action offsets
    >                , UArray Int Int       -- goto offsets
    >                , Int                  -- highest offset in table
    >                )
    >
    > genTables :: forall s.
    Int
    -> Int
    -> [TableEntry]
    -> ST
         s
         (UArray Int Int, UArray Int Int, UArray Int Int, UArray Int Int,
          Int)
    genTables Int
    n_actions Int
    max_token [TableEntry]
    entries = do
    >
    >   table      <- (Int, Int) -> Int -> ST s (STUArray s Int Int)
    forall i. Ix i => (i, i) -> Int -> ST s (STUArray s i Int)
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    (i, i) -> e -> m (a i e)
    newArray (Int
    0, Int
    mAX_TABLE_SIZE) Int
    0
    >   check      <- newArray (0, mAX_TABLE_SIZE) (-1)
    >   act_offs   <- newArray (0, n_actions) 0
    >   goto_offs  <- newArray (0, n_actions) 0
    >   off_arr    <- newArray (-max_token, mAX_TABLE_SIZE) 0
    >
    >   max_off    <- genTables' table check act_offs goto_offs off_arr entries
    >                          max_token
    >
    >   table'     <- freeze table
    >   check'     <- freeze check
    >   act_offs'  <- freeze act_offs
    >   goto_offs' <- freeze goto_offs
    >   return (table',check',act_offs',goto_offs',max_off+1)

    >   where
    >        n_states :: Int
    n_states = Int
    n_actions Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
    >        mAX_TABLE_SIZE :: Int
    mAX_TABLE_SIZE = Int
    n_states Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * (Int
    max_token Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)

    > genTables'
    >        :: STUArray s Int Int          -- table
    >        -> STUArray s Int Int          -- check
    >        -> STUArray s Int Int          -- action offsets
    >        -> STUArray s Int Int          -- goto offsets
    >        -> STUArray s Int Int          -- offset array
    >        -> [TableEntry]                -- entries for the table
    >        -> Int                         -- maximum token no.
    >        -> ST s Int                    -- highest offsets in table
    >
    > genTables' :: forall s.
    STUArray s Int Int
    -> STUArray s Int Int
    -> STUArray s Int Int
    -> STUArray s Int Int
    -> STUArray s Int Int
    -> [TableEntry]
    -> Int
    -> ST s Int
    genTables' STUArray s Int Int
    table STUArray s Int Int
    check STUArray s Int Int
    act_offs STUArray s Int Int
    goto_offs STUArray s Int Int
    off_arr [TableEntry]
    entries
    >            Int
    max_token
    >       = [TableEntry] -> Int -> Int -> ST s Int
    forall {c} {d} {e}.
    [(ActionOrGoto, Int, c, d, e, [(Int, Int)])]
    -> Int -> Int -> ST s Int
    fit_all [TableEntry]
    entries Int
    0 Int
    1
    >   where
    >
    >        fit_all :: [(ActionOrGoto, Int, c, d, e, [(Int, Int)])]
    -> Int -> Int -> ST s Int
    fit_all [] Int
    max_off Int
    _ = Int -> ST s Int
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    max_off
    >        fit_all ((ActionOrGoto, Int, c, d, e, [(Int, Int)])
    s:[(ActionOrGoto, Int, c, d, e, [(Int, Int)])]
    ss) Int
    max_off Int
    fst_zero = do
    >          (off, new_max_off, new_fst_zero) <- (ActionOrGoto, Int, c, d, e, [(Int, Int)])
    -> Int -> Int -> ST s (Int, Int, Int)
    forall {c} {d} {e}.
    (ActionOrGoto, Int, c, d, e, [(Int, Int)])
    -> Int -> Int -> ST s (Int, Int, Int)
    fit (ActionOrGoto, Int, c, d, e, [(Int, Int)])
    s Int
    max_off Int
    fst_zero
    >          ss' <- same_states s ss off
    >          writeArray off_arr off 1
    >          fit_all ss' new_max_off new_fst_zero
    >
    >        -- try to merge identical states.  We only try the next state(s)
    >        -- in the list, but the list is kind-of sorted so we shouldn't
    >        -- miss too many.
    >        same_states :: (a, b, c, d, e, a)
    -> [(ActionOrGoto, Int, c, d, e, a)]
    -> Int
    -> m [(ActionOrGoto, Int, c, d, e, a)]
    same_states (a, b, c, d, e, a)
    _ [] Int
    _ = [(ActionOrGoto, Int, c, d, e, a)]
    -> m [(ActionOrGoto, Int, c, d, e, a)]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
    >        same_states s :: (a, b, c, d, e, a)
    s@(a
    _,b
    _,c
    _,d
    _,e
    _,a
    acts) ss :: [(ActionOrGoto, Int, c, d, e, a)]
    ss@((ActionOrGoto
    e,Int
    no,c
    _,d
    _,e
    _,a
    acts'):[(ActionOrGoto, Int, c, d, e, a)]
    ss') Int
    off
    >          | a
    acts a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    acts' = do STUArray s Int Int -> Int -> Int -> m ()
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> i -> e -> m ()
    writeArray (ActionOrGoto -> STUArray s Int Int
    which_off ActionOrGoto
    e) Int
    no Int
    off
    >                               (a, b, c, d, e, a)
    -> [(ActionOrGoto, Int, c, d, e, a)]
    -> Int
    -> m [(ActionOrGoto, Int, c, d, e, a)]
    same_states (a, b, c, d, e, a)
    s [(ActionOrGoto, Int, c, d, e, a)]
    ss' Int
    off
    >          | Bool
    otherwise = [(ActionOrGoto, Int, c, d, e, a)]
    -> m [(ActionOrGoto, Int, c, d, e, a)]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(ActionOrGoto, Int, c, d, e, a)]
    ss
    >
    >        which_off :: ActionOrGoto -> STUArray s Int Int
    which_off ActionOrGoto
    ActionEntry = STUArray s Int Int
    act_offs
    >        which_off ActionOrGoto
    GotoEntry   = STUArray s Int Int
    goto_offs
    >
    >        -- fit a vector into the table.  Return the offset of the vector,
    >        -- the maximum offset used in the table, and the offset of the first
    >        -- entry in the table (used to speed up the lookups a bit).
    >        fit :: (ActionOrGoto, Int, c, d, e, [(Int, Int)])
    -> Int -> Int -> ST s (Int, Int, Int)
    fit (ActionOrGoto
    _,Int
    _,c
    _,d
    _,e
    _,[]) Int
    max_off Int
    fst_zero = (Int, Int, Int) -> ST s (Int, Int, Int)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int
    0,Int
    max_off,Int
    fst_zero)
    >
    >        fit (ActionOrGoto
    act_or_goto, Int
    state_no, c
    _deflt, d
    _, e
    _, state :: [(Int, Int)]
    state@((Int
    t,Int
    _):[(Int, Int)]
    _))
    >           Int
    max_off Int
    fst_zero = do
    >                -- start at offset 1 in the table: all the empty states
    >                -- (states with just a default reduction) are mapped to
    >                -- offset zero.
    >          off <- Int
    -> STUArray s Int Int
    -> STUArray s Int Int
    -> [(Int, Int)]
    -> ST s Int
    forall s.
    Int
    -> STUArray s Int Int
    -> STUArray s Int Int
    -> [(Int, Int)]
    -> ST s Int
    findFreeOffset (-Int
    tInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    fst_zero) STUArray s Int Int
    check STUArray s Int Int
    off_arr [(Int, Int)]
    state
    >          let new_max_off | Int
    furthest_right Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    max_off = Int
    furthest_right
    >                          | Bool
    otherwise                = Int
    max_off
    >              furthest_right = Int
    off Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    max_token
    >
    >          -- trace ("fit: state " ++ show state_no ++ ", off " ++ show off ++ ", elems " ++ show state) $ do
    >
    >          writeArray (which_off act_or_goto) state_no off
    >          addState off table check state
    >          new_fst_zero <- findFstFreeSlot check fst_zero
    >          return (off, new_max_off, new_fst_zero)

    When looking for a free offset in the table, we use the 'check' table
    rather than the main table.  The check table starts off with (-1) in
    every slot, because that's the only thing that doesn't overlap with
    any tokens (non-terminals start at 0, terminals start at 1).

    Because we use 0 for LR'MustFail as well as LR'Fail, we can't check
    for free offsets in the main table because we can't tell whether a
    slot is free or not.

    > -- Find a valid offset in the table for this state.
    > findFreeOffset :: Int -> STUArray s Int Int -> STUArray s Int Int -> [(Int, Int)] -> ST s Int
    > findFreeOffset :: forall s.
    Int
    -> STUArray s Int Int
    -> STUArray s Int Int
    -> [(Int, Int)]
    -> ST s Int
    findFreeOffset Int
    off STUArray s Int Int
    table STUArray s Int Int
    off_arr [(Int, Int)]
    state = do
    >     -- offset 0 isn't allowed
    >   if Int
    off Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 then ST s Int
    try_next else do
    >
    >     -- don't use an offset we've used before
    >   b <- STUArray s Int Int -> Int -> ST s Int
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> i -> m e
    readArray STUArray s Int Int
    off_arr Int
    off
    >   if b /= 0 then try_next else do
    >
    >     -- check whether the actions for this state fit in the table
    >   ok <- fits off state table
    >   if not ok then try_next else return off
    >  where
    >       try_next :: ST s Int
    try_next = Int
    -> STUArray s Int Int
    -> STUArray s Int Int
    -> [(Int, Int)]
    -> ST s Int
    forall s.
    Int
    -> STUArray s Int Int
    -> STUArray s Int Int
    -> [(Int, Int)]
    -> ST s Int
    findFreeOffset (Int
    offInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) STUArray s Int Int
    table STUArray s Int Int
    off_arr [(Int, Int)]
    state

    > fits :: Int -> [(Int,Int)] -> STUArray s Int Int -> ST s Bool
    > fits :: forall s. Int -> [(Int, Int)] -> STUArray s Int Int -> ST s Bool
    fits Int
    _   []           STUArray s Int Int
    _     = Bool -> ST s Bool
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
    > fits Int
    off ((Int
    t,Int
    _):[(Int, Int)]
    rest) STUArray s Int Int
    table = do
    >   i <- STUArray s Int Int -> Int -> ST s Int
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> i -> m e
    readArray STUArray s Int Int
    table (Int
    offInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    t)
    >   if i /= -1 then return False
    >              else fits off rest table

    > addState :: Int -> STUArray s Int Int -> STUArray s Int Int -> [(Int, Int)]
    >          -> ST s ()
    > addState :: forall s.
    Int
    -> STUArray s Int Int
    -> STUArray s Int Int
    -> [(Int, Int)]
    -> ST s ()
    addState Int
    _   STUArray s Int Int
    _     STUArray s Int Int
    _     [] = () -> ST s ()
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    > addState Int
    off STUArray s Int Int
    table STUArray s Int Int
    check ((Int
    t,Int
    val):[(Int, Int)]
    state) = do
    >    STUArray s Int Int -> Int -> Int -> ST s ()
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> i -> e -> m ()
    writeArray STUArray s Int Int
    table (Int
    offInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    t) Int
    val
    >    STUArray s Int Int -> Int -> Int -> ST s ()
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> i -> e -> m ()
    writeArray STUArray s Int Int
    check (Int
    offInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    t) Int
    t
    >    Int
    -> STUArray s Int Int
    -> STUArray s Int Int
    -> [(Int, Int)]
    -> ST s ()
    forall s.
    Int
    -> STUArray s Int Int
    -> STUArray s Int Int
    -> [(Int, Int)]
    -> ST s ()
    addState Int
    off STUArray s Int Int
    table STUArray s Int Int
    check [(Int, Int)]
    state

    > notFail :: (Name, LRAction) -> Bool
    > notFail :: (Name, LRAction) -> Bool
    notFail (Name
    _, LRAction
    LR'Fail) = Bool
    False
    > notFail (Name, LRAction)
    _           = Bool
    True

    > findFstFreeSlot :: STUArray s Int Int -> Int -> ST s Int
    > findFstFreeSlot :: forall s. STUArray s Int Int -> Int -> ST s Int
    findFstFreeSlot STUArray s Int Int
    table Int
    n = do
    >        i <- STUArray s Int Int -> Int -> ST s Int
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> i -> m e
    readArray STUArray s Int Int
    table Int
    n
    >        if i == -1 then return n
    >                   else findFstFreeSlot table (n+1)

    -----------------------------------------------------------------------------
    -- Misc.

    > showsName :: Name -> ShowS
    > showsName :: Name -> String -> String
    showsName = Int -> String -> String
    forall {a}. Show a => a -> String -> String
    shows (Int -> String -> String)
    -> (Name -> Int) -> Name -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Int
    getName

    > comment :: String
    > comment :: String
    comment =
    >         String
    "-- parser produced by Happy Version " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Version -> String
    showVersion Version
    version String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n\n"

    > mkAbsSynCon :: Array Name Name -> Name -> String -> String
    > mkAbsSynCon :: Array Name Name -> Name -> String -> String
    mkAbsSynCon Array Name Name
    fx Name
    t      = String -> String -> String
    str String
    "HappyAbsSyn"   (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String -> String
    showsName (Array Name Name
    fx Array Name Name -> Name -> Name
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> i -> e
    ! Name
    t)

    > mkHappyVar, mkReduceFun, mkDummyVar :: Int -> String -> String
    > mkHappyVar :: Int -> String -> String
    mkHappyVar Int
    n          = String -> String -> String
    str String
    "happy_var_"    (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> String
    forall {a}. Show a => a -> String -> String
    shows Int
    n
    > mkReduceFun :: Int -> String -> String
    mkReduceFun Int
    n         = String -> String -> String
    str String
    "happyReduce_"  (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> String
    forall {a}. Show a => a -> String -> String
    shows Int
    n
    > mkDummyVar :: Int -> String -> String
    mkDummyVar Int
    n          = String -> String -> String
    str String
    "happy_x_"      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> String
    forall {a}. Show a => a -> String -> String
    shows Int
    n

    > mkHappyWrap :: Name -> String -> String
    > mkHappyWrap :: Name -> String -> String
    mkHappyWrap Name
    n = String -> String -> String
    str String
    "HappyWrap" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String -> String
    showsName Name
    n

    > mkHappyWrapCon :: Maybe a -> Name -> (String -> String) -> String -> String
    > mkHappyWrapCon :: forall a. Maybe a -> Name -> (String -> String) -> String -> String
    mkHappyWrapCon Maybe a
    Nothing  Name
    _ String -> String
    s = String -> String
    s
    > mkHappyWrapCon (Just a
    _) Name
    n String -> String
    s = (String -> String) -> String -> String
    brack' (Name -> String -> String
    mkHappyWrap Name
    n (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    strspace (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    s)

    > mkHappyIn, mkHappyOut :: Name -> String -> String
    > mkHappyIn :: Name -> String -> String
    mkHappyIn Name
    n           = String -> String -> String
    str String
    "happyIn"  (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String -> String
    showsName Name
    n
    > mkHappyOut :: Name -> String -> String
    mkHappyOut Name
    n          = String -> String -> String
    str String
    "happyOut" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String -> String
    showsName Name
    n

    > typeParam, typeParamOut :: Name -> Maybe String -> ShowS
    > typeParam :: Name -> Maybe String -> String -> String
    typeParam Name
    n Maybe String
    Nothing   = Char -> String -> String
    char Char
    't' (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String -> String
    showsName Name
    n
    > typeParam Name
    _ (Just String
    ty) = String -> String -> String
    brack String
    ty
    > typeParamOut :: Name -> Maybe String -> String -> String
    typeParamOut Name
    n Maybe String
    Nothing  = Char -> String -> String
    char Char
    't' (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String -> String
    showsName Name
    n
    > typeParamOut Name
    n (Just String
    _) = Name -> String -> String
    mkHappyWrap Name
    n

    > specReduceFun :: Int -> Bool
    > specReduceFun :: Int -> Bool
    specReduceFun = (Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    3)

    -------------------------------------------------------------------------------
    -- Fast string-building functions.

    > str :: String -> String -> String
    > str :: String -> String -> String
    str = String -> String -> String
    showString
    > char :: Char -> String -> String
    > char :: Char -> String -> String
    char Char
    c = (Char
    c Char -> String -> String
    forall a. a -> [a] -> [a]
    :)
    > interleave :: String -> [String -> String] -> String -> String
    > interleave :: String -> [String -> String] -> String -> String
    interleave String
    s = ((String -> String) -> (String -> String) -> String -> String)
    -> (String -> String) -> [String -> String] -> String -> String
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\String -> String
    a String -> String
    b -> String -> String
    a (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    s (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    b) String -> String
    forall a. a -> a
    id
    > interleave' :: String -> [String -> String] -> String -> String
    > interleave' :: String -> [String -> String] -> String -> String
    interleave' String
    s = ((String -> String) -> (String -> String) -> String -> String)
    -> [String -> String] -> String -> String
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 (\String -> String
    a String -> String
    b -> String -> String
    a (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    str String
    s (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    b)

    > strspace :: String -> String
    > strspace :: String -> String
    strspace = Char -> String -> String
    char Char
    ' '
    > nl :: String -> String
    > nl :: String -> String
    nl = Char -> String -> String
    char Char
    '\n'

    > maybestr :: Maybe String -> String -> String
    > maybestr :: Maybe String -> String -> String
    maybestr (Just String
    s)     = String -> String -> String
    str String
    s
    > maybestr Maybe String
    _            = String -> String
    forall a. a -> a
    id

    > brack :: String -> String -> String
    > brack :: String -> String -> String
    brack String
    s = String -> String -> String
    str (Char
    '(' Char -> String -> String
    forall a. a -> [a] -> [a]
    : String
    s) (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> String -> String
    char Char
    ')'
    > brack' :: (String -> String) -> String -> String
    > brack' :: (String -> String) -> String -> String
    brack' String -> String
    s = Char -> String -> String
    char Char
    '(' (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    s (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> String -> String
    char Char
    ')'

    -----------------------------------------------------------------------------
    -- Convert an integer to a 32-bit number encoded in little-endian
    -- \xNN\xNN\xNN\xNN format suitable for placing in a string.

    > hexChars :: [Int] -> String -> String
    > hexChars :: [Int] -> String -> String
    hexChars [Int]
    is String
    s = (Int -> String -> String) -> String -> [Int] -> String
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (Int32 -> String -> String
    hexChar (Int32 -> String -> String)
    -> (Int -> Int32) -> Int -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Int32
    toInt32) String
    s [Int]
    is

    The following definition of @hexChar@ chooses a little endian encoding for `Int32` .
    Ergo, the compiled parser must use the same endianness when decoding array entries.
    On big endian architectures, this means users will have to compile with `WORDS_BIGENDIAN`,
    which is defined in the GHC provided C header `MachDeps.h`.

    > hexChar :: Int32 -> String -> String
    > hexChar :: Int32 -> String -> String
    hexChar Int32
    i String
    s = (Int -> String -> String) -> String -> [Int] -> String
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (Word8 -> String -> String
    toHex (Word8 -> String -> String)
    -> (Int -> Word8) -> Int -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int32 -> Int -> Word8
    byte Int32
    i) String
    s [Int
    0,Int
    1,Int
    2,Int
    3]

    > byte :: Int32 -> Int -> Word8
    > byte :: Int32 -> Int -> Word8
    byte Int32
    n Int
    i = Int32 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int32
    0xFF Int32 -> Int32 -> Int32
    forall a. Bits a => a -> a -> a
    .&. Int32 -> Int -> Int32
    forall a. Bits a => a -> Int -> a
    shiftR Int32
    n (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    8))

    > toHex :: Word8 -> String -> String
    > toHex :: Word8 -> String -> String
    toHex Word8
    i String
    s = Char
    '\\'Char -> String -> String
    forall a. a -> [a] -> [a]
    :Char
    'x'Char -> String -> String
    forall a. a -> [a] -> [a]
    :Word8 -> Char
    hexDig (Word8
    0xF Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    shiftR Word8
    i Int
    4)Char -> String -> String
    forall a. a -> [a] -> [a]
    :Word8 -> Char
    hexDig (Word8
    0xF Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    i)Char -> String -> String
    forall a. a -> [a] -> [a]
    :String
    s

    > hexDig :: Word8 -> Char
    > hexDig :: Word8 -> Char
    hexDig Word8
    i | Word8
    i Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word8
    9    = Int -> Char
    chr (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Char -> Int
    ord Char
    '0')
    >          | Bool
    otherwise = Int -> Char
    chr (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    10 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Char -> Int
    ord Char
    'a')

    > toInt32 :: Int -> Int32
    > toInt32 :: Int -> Int32
    toInt32 Int
    i
    >   | Int
    i Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int32
    i32 = Int32
    i32
    >   | Bool
    otherwise = String -> Int32
    forall a. HasCallStack => String -> a
    error (String
    "offset was too large for Int32: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    i)
    >   where i32 :: Int32
    i32 = Int -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    i