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

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

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

> import Paths_happy_lib  ( 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.
>
>    partTySigs_opts :: String -> String
partTySigs_opts = (String -> String) -> String -> String
ifGeGhc710 (String -> String -> String
str String
"{-# LANGUAGE PartialTypeSignatures #-}" (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
nl)

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
>
>    -- If GHC is enabled, wrap the content in a CPP ifdef that includes the
>    -- content and tests whether the GHC version is >= 7.10.3
>    ifGeGhc710 :: (String -> String) -> String -> String
>    ifGeGhc710 :: (String -> String) -> String -> String
ifGeGhc710 String -> String
content  = String -> String -> String
str String
"#if __GLASGOW_HASKELL__ >= 710" (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
content
>                        (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"#endif" (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
nl

>    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
"_")
>
>    -- This decides how to include (if at all) a type signature
>    -- See <https://github.com/haskell/happy/issues/94>
>    filterTypeSig :: (String -> String) -> String -> String
>    filterTypeSig :: (String -> String) -> String -> String
filterTypeSig String -> String
content | Int
n_missing_types Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = String -> String
content
>                          | Bool
otherwise = (String -> String) -> String -> String
ifGeGhc710 String -> String
content
>
>    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 ])
>      (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
partTySigs_opts

%-----------------------------------------------------------------------------
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) -> String -> String
filterTypeSig 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
>                  happyParseSig :: String -> String
happyParseSig =
>                        String -> String -> String
str String
"happyParse :: " (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) -> String -> String
filterTypeSig (String -> String
happyParseSig (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 (happyParse "
>       (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
>
>   STUArray s Int Int
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
>   STUArray s Int Int
check      <- (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
1)
>   STUArray s Int Int
act_offs   <- (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
n_actions) Int
0
>   STUArray s Int Int
goto_offs  <- (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
n_actions) Int
0
>   STUArray s Int Int
off_arr    <- (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
max_token, Int
mAX_TABLE_SIZE) Int
0
>
>   Int
max_off    <- 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
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
>
>   UArray Int Int
table'     <- STUArray s Int Int -> ST s (UArray Int Int)
forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
freeze STUArray s Int Int
table
>   UArray Int Int
check'     <- STUArray s Int Int -> ST s (UArray Int Int)
forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
freeze STUArray s Int Int
check
>   UArray Int Int
act_offs'  <- STUArray s Int Int -> ST s (UArray Int Int)
forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
freeze STUArray s Int Int
act_offs
>   UArray Int Int
goto_offs' <- STUArray s Int Int -> ST s (UArray Int Int)
forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
freeze STUArray s Int Int
goto_offs
>   (UArray Int Int, UArray Int Int, UArray Int Int, UArray Int Int,
 Int)
-> ST
     s
     (UArray Int Int, UArray Int Int, UArray Int Int, UArray Int Int,
      Int)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (UArray Int Int
table',UArray Int Int
check',UArray Int Int
act_offs',UArray Int Int
goto_offs',Int
max_offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
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
>          (Int
off, Int
new_max_off, Int
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
>          [(ActionOrGoto, Int, c, d, e, [(Int, Int)])]
ss' <- (ActionOrGoto, Int, c, d, e, [(Int, Int)])
-> [(ActionOrGoto, Int, c, d, e, [(Int, Int)])]
-> Int
-> ST s [(ActionOrGoto, Int, c, d, e, [(Int, Int)])]
forall {m :: * -> *} {a} {a} {b} {c} {d} {e} {c} {d} {e}.
(Eq a, MArray (STUArray s) Int m) =>
(a, b, c, d, e, a)
-> [(ActionOrGoto, Int, c, d, e, a)]
-> Int
-> m [(ActionOrGoto, Int, c, d, e, a)]
same_states (ActionOrGoto, Int, c, d, e, [(Int, Int)])
s [(ActionOrGoto, Int, c, d, e, [(Int, Int)])]
ss Int
off
>          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
off_arr Int
off Int
1
>          [(ActionOrGoto, Int, c, d, e, [(Int, Int)])]
-> Int -> Int -> ST s Int
fit_all [(ActionOrGoto, Int, c, d, e, [(Int, Int)])]
ss' Int
new_max_off Int
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.
>          Int
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
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
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
>
>          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 (ActionOrGoto -> STUArray s Int Int
which_off ActionOrGoto
act_or_goto) Int
state_no Int
off
>          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
>          Int
new_fst_zero <- STUArray s Int Int -> Int -> ST s Int
forall s. STUArray s Int Int -> Int -> ST s Int
findFstFreeSlot STUArray s Int Int
check 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
off, Int
new_max_off, Int
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
>   Int
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 Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 then ST s Int
try_next else do
>
>     -- check whether the actions for this state fit in the table
>   Bool
ok <- Int -> [(Int, Int)] -> STUArray s Int Int -> ST s Bool
forall s. Int -> [(Int, Int)] -> STUArray s Int Int -> ST s Bool
fits Int
off [(Int, Int)]
state STUArray s Int Int
table
>   if Bool -> Bool
not Bool
ok then ST s Int
try_next else Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
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
>   Int
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 Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= -Int
1 then Bool -> ST s Bool
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
>              else Int -> [(Int, Int)] -> STUArray s Int Int -> ST s Bool
forall s. Int -> [(Int, Int)] -> STUArray s Int Int -> ST s Bool
fits Int
off [(Int, Int)]
rest STUArray s Int Int
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
>        Int
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 Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1 then Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
>                   else STUArray s Int Int -> Int -> ST s Int
forall s. STUArray s Int Int -> Int -> ST s Int
findFstFreeSlot STUArray s Int Int
table (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
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