-----------------------------------------------------------------------------
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.Tabular.LALR

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

> import Control.Monad             ( forM_ )
> 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                      -- grammar info
>               -> Pragmas                      -- pragmas 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
-> Pragmas
-> ActionTable
-> GotoTable
-> [String]
-> Maybe String
-> Maybe String
-> Bool
-> Bool
-> String
produceParser (Grammar
>               { productions :: Grammar -> [Production]
productions = [Production]
prods
>               , non_terminals :: Grammar -> [Int]
non_terminals = [Int]
nonterms
>               , terminals :: Grammar -> [Int]
terminals = [Int]
terms
>               , types :: Grammar -> Array Int (Maybe String)
types = Array Int (Maybe String)
nt_types
>               , first_nonterm :: Grammar -> Int
first_nonterm = Int
first_nonterm'
>               , eof_term :: Grammar -> Int
eof_term = Int
eof
>               , first_term :: Grammar -> Int
first_term = Int
fst_term
>               , token_names :: Grammar -> Array Int String
token_names = Array Int String
token_names'
>               , token_specs :: Grammar -> [(Int, String)]
token_specs = [(Int, String)]
token_rep
>               , starts :: Grammar -> [(String, Int, Int, Bool)]
starts = [(String, Int, Int, Bool)]
starts'
>               , attributetype :: Grammar -> String
attributetype = String
attributetype'
>               , attributes :: Grammar -> [(String, String)]
attributes = [(String, String)]
attributes'
>               })
>               (Pragmas
>               { lexer :: Pragmas -> Maybe (String, String)
lexer = Maybe (String, String)
lexer'
>               , imported_identity :: Pragmas -> Bool
imported_identity = Bool
imported_identity'
>               , monad :: Pragmas -> (Bool, String, String, String, String)
monad = (Bool
use_monad,String
monad_context,String
monad_tycon,String
monad_then,String
monad_return)
>               , token_type :: Pragmas -> String
token_type = String
token_type'
>               , error_handler :: Pragmas -> Maybe String
error_handler = Maybe String
error_handler'
>               , error_sig :: Pragmas -> ErrorHandlerType
error_sig = ErrorHandlerType
error_sig'
>               })
>               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
produceExpListPerState
>       (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
. [(String, String)] -> String -> String -> String
produceAttributes [(String, String)]
attributes' String
attributetype' (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, Int, Int, Bool)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Int, Int, 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
>    pcont :: String -> String
pcont = String -> String -> String
str String
monad_context
>
>    -- 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 Int (Maybe String) -> [Maybe String]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems Array Int (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 :: Int -> Maybe String -> String -> String
inject Int
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
. Int -> String -> String
mkHappyWrap Int
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
. Int -> String -> String
mkHappyWrap Int
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
. Int -> String -> String
mkHappyIn Int
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
. Int -> Maybe String -> String -> String
typeParam Int
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
. Int -> String -> String
mkHappyIn Int
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 -> Int -> (String -> String) -> String -> String
forall a. Maybe a -> Int -> (String -> String) -> String -> String
mkHappyWrapCon Maybe String
ty Int
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
. Int -> String -> String
mkHappyIn Int
n (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" #-}"
>
>             extract :: Int -> Maybe String -> String -> String
extract Int
n Maybe String
ty
>               = Int -> String -> String
mkHappyOut Int
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
. Int -> Maybe String -> String -> String
typeParamOut Int
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
. Int -> String -> String
mkHappyOut Int
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
. Int -> String -> String
mkHappyOut Int
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"
>           [ Int -> Maybe String -> String -> String
inject Int
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
. Int -> Maybe String -> String -> String
extract Int
n Maybe String
ty | (Int
n,Maybe String
ty) <- Array Int (Maybe String) -> [(Int, Maybe String)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
assocs Array Int (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 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
. Int -> String -> String
makeAbsSynCon Int
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
. Int -> Maybe String -> String -> String
typeParam Int
n Maybe String
ty
>         | (Int
n, Maybe String
ty) <- Array Int (Maybe String) -> [(Int, Maybe String)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
assocs Array Int (Maybe String)
nt_types,
>           (Array Int Int
nt_types_index Array Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
n) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
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 Int
n | (Int
n, Maybe String
Nothing) <- Array Int (Maybe String) -> [(Int, Maybe String)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
assocs Array Int (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 -> Int -> String -> String)
-> [Production] -> [Int] -> [String -> String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Production -> Int -> String -> String
produceReduction (Int -> [Production] -> [Production]
forall a. Int -> [a] -> [a]
drop Int
n_starts [Production]
prods) [ Int
n_starts .. ])

>    produceReduction :: Production -> Int -> String -> String
produceReduction (Production Int
nt [Int]
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
|| [Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
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 ([Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
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 = Int
nt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
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 .. [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
toks])
>                | Bool
otherwise = [String -> String] -> [String -> String]
forall a. [a] -> [a]
reverse ((Int -> Int -> String -> String)
-> [Int] -> [Int] -> [String -> String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> String -> String
tokPattern [Int
1..] [Int]
toks)
>
>               tokPattern :: Int -> Int -> String -> String
tokPattern Int
n Int
_ | 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 Int
t | Int
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
firstStartTok Bool -> Bool -> Bool
&& Int
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
fst_term
>                       = if Bool
coerce
>                               then Maybe String -> Int -> (String -> String) -> String -> String
forall a. Maybe a -> Int -> (String -> String) -> String -> String
mkHappyWrapCon (Array Int (Maybe String)
nt_types Array Int (Maybe String) -> Int -> Maybe String
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
t) Int
t (Int -> String -> String
mkHappyVar Int
n)
>                               else (String -> String) -> String -> String
brack' (
>                                    Int -> String -> String
makeAbsSynCon Int
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 Int
t
>                       = if Bool
coerce
>                               then Int -> Int -> String -> String
mkHappyTerminalVar Int
n Int
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 -> Int -> String -> String
mkHappyTerminalVar Int
n Int
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
. Int -> String -> String
extract Int
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 -> Int -> String -> String
tokPattern Int
n Int
t (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" -> "
>                       | (Int
n,Int
t) <- [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [Int]
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 :: Int -> String -> String
extract Int
t | Int
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
firstStartTok Bool -> Bool -> Bool
&& Int
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
fst_term = Int -> String -> String
mkHappyOut Int
t
>                         | Bool
otherwise                     = String -> String -> String
str String
"happyOutTok"
>
>               lt :: Int
lt = [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
toks

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

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

>    produceTokenConverter :: String -> String
produceTokenConverter
>       = case Maybe (String, String)
lexer' of {
>
>       Maybe (String, String)
Nothing ->
>         String -> String -> String
str String
"happyNewToken action sts stk [] =\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
eofAction String
"notHappyAtAll"
>       (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
"happyNewToken action sts stk (tk:tks) =\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
"let cont i = " (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 tks in\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
"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] -> String -> String
interleave (String
";\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
indentStr) (((Int, String) -> String -> String)
-> [(Int, String)] -> [String -> String]
forall a b. (a -> b) -> [a] -> [b]
map (Int, String) -> String -> String
doToken [(Int, String)]
token_rep)
>       (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"_ -> happyError' ((tk:tks), [])\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"
>       (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyError_ explist " (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 tks = happyError' (tks, explist)\n"
>       (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyError_ explist _ tk tks = happyError' ((tk:tks), explist)\n";
>             -- when the token is EOF, tk == _|_ (notHappyAtAll)
>             -- so we must not pass it to happyError'

>       Just (String
lexer'',String
eof') ->
>         String -> String -> String
str String
"happyNewToken action sts stk\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
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 -> "
>       (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"\n\tlet cont i = "
>       (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 in\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
"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
forall a. [a] -> [a] -> [a]
++ String
" -> ")
>       (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
";\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] -> String -> String
interleave (String
";\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
indentStr) (((Int, String) -> String -> String)
-> [(Int, String)] -> [String -> String]
forall a b. (a -> b) -> [a] -> [b]
map (Int, String) -> String -> String
doToken [(Int, String)]
token_rep)
>       (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"_ -> happyError' (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
"})\n\n"
>       (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyError_ explist " (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 = happyError' (tk, explist)\n"
>       (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyError_ explist _ tk = happyError' (tk, explist)\n";
>             -- superfluous pattern match needed to force happyError_ to
>             -- have the correct type.
>       }

>       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" (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" sts stk"
>         eofTok :: String -> String
eofTok = Int -> String -> String
forall {a}. Show a => a -> String -> String
showInt (Int -> Int
tokIndex Int
eof)

>         doAction :: String -> String
doAction = String -> String -> String
str String
"happyDoAction i tk action"

>         doToken :: (Int, String) -> String -> String
doToken (Int
i,String
tok)
>               = String -> String -> String
str (String -> String
removeDollarDollar String
tok)
>               (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" -> cont "
>               (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 -> Int
tokIndex Int
i)

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

>         removeDollarDollar :: String -> String
removeDollarDollar String
xs = case String -> Maybe (String -> String)
mapDollarDollar String
xs of
>                                  Maybe (String -> String)
Nothing -> String
xs
>                                  Just String -> String
fn -> String -> String
fn String
"happy_dollar_dollar"

>    mkHappyTerminalVar :: Int -> Int -> String -> String
>    mkHappyTerminalVar :: Int -> Int -> String -> String
mkHappyTerminalVar Int
i Int
t =
>     case Maybe (String -> String)
tok_str_fn of
>       Maybe (String -> String)
Nothing -> String -> String
pat
>       Just String -> String
fn -> String -> String -> String
brack (String -> String
fn (String -> String
pat []))
>     where
>         tok_str_fn :: Maybe (String -> String)
tok_str_fn = case Int -> [(Int, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
t [(Int, String)]
token_rep of
>                     Maybe String
Nothing -> Maybe (String -> String)
forall a. Maybe a
Nothing
>                     Just String
str' -> String -> Maybe (String -> String)
mapDollarDollar String
str'
>         pat :: String -> String
pat = Int -> String -> String
mkHappyVar Int
i

>    tokIndex :: Int -> Int
tokIndex Int
i = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n_nonterminals Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n_starts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
>                       -- tokens adjusted to start at zero, see ARRAY_NOTES

%-----------------------------------------------------------------------------
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).

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 -> 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
" :: 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
" :: Prelude.Int\n\n"

>    produceExpListPerState :: String -> String
produceExpListPerState
>       = String -> String
produceExpListArray
>       (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"{-# NOINLINE happyExpListPerState #-}\n"
>       (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyExpListPerState st =\n"
>       (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"    token_strs_expected\n"
>       (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"  where token_strs = " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str ([String] -> String
forall a. Show a => a -> String
show ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Array Int String -> [String]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems Array Int 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"
>       (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"        bit_start = st               Prelude.* " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str (Int -> String
forall a. Show a => a -> String
show Int
nr_tokens) (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
"        bit_end   = (st Prelude.+ 1) Prelude.* " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str (Int -> String
forall a. Show a => a -> String
show Int
nr_tokens) (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
"        read_bit = readArrayBit happyExpList\n"
>       (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"        bits = Prelude.map read_bit [bit_start..bit_end Prelude.- 1]\n"
>       (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"        bits_indexed = Prelude.zip bits [0.."
>                                        (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str (Int -> String
forall a. Show a => a -> String
show (Int
nr_tokens Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) (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
"        token_strs_expected = Prelude.concatMap f bits_indexed\n"
>       (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"        f (Prelude.False, _) = []\n"
>       (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"        f (Prelude.True, nr) = [token_strs Prelude.!! nr]\n"
>       (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"\n"
>       where (Int
first_token, Int
last_token) = Array Int String -> (Int, Int)
forall i. Ix i => Array i String -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds Array Int String
token_names'
>             nr_tokens :: Int
nr_tokens = Int
last_token Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
first_token Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

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
"happyAdjustOffset :: Happy_GHC_Exts.Int# -> Happy_GHC_Exts.Int#\n"
>           (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyAdjustOffset off = "
>           (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
table Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
32768
>                then String -> String -> String
str String
"off"
>                else String -> String -> String
str String
"if happyLt off (" (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
min_off (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"# :: Happy_GHC_Exts.Int#)"
>                   (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" then off Happy_GHC_Exts.+# 65536#"
>                   (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" else off")
>           (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" --"


>    produceExpListArray :: String -> String
produceExpListArray
>           = String -> String -> String
str String
"happyExpList :: HappyAddr\n"
>           (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyExpList = HappyA# \"" --"
>           (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> String -> String
hexCharsForBits [Int]
explist
>           (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 = [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
terms
>    n_nonterminals :: Int
n_nonterminals = [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
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]
explist,Int
min_off)
>       = ActionTable
-> GotoTable
-> Int
-> Int
-> Int
-> Int
-> Int
-> (Int, Int)
-> ([Int], [Int], [Int], [Int], [Int], [Int], Int)
mkTables ActionTable
action GotoTable
goto Int
first_nonterm' Int
fst_term
>               Int
n_terminals Int
n_nonterminals Int
n_starts (Array Int String -> (Int, Int)
forall i. Ix i => Array i String -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds Array Int String
token_names')
>
>    produceReduceArray :: String -> String
produceReduceArray
>       = {- str "happyReduceArr :: Array Int a\n" -}
>         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"

>    n_rules :: Int
n_rules = [Production] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Production]
prods Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 :: Int

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

>    makeAbsSynCon :: Int -> String -> String
makeAbsSynCon = Array Int Int -> Int -> String -> String
mkAbsSynCon Array Int Int
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 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 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)
        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)
        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


>    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
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
"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
pty (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
"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
"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
pty (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
"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
"happyError' :: " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
monad_context (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
"], [Prelude.String]) -> "
>                (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
monad_tycon
>                (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
"happyError' = "
>                (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str (if Bool
use_monad then String
"" else String
"HappyIdentity Prelude.. ")
>                (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
errorHandler (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
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
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
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"
>                  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 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
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"
>                  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
"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
pty (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
"happyReturn1 = happyReturn\n"
>                (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyError' :: " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
monad_context (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
", [Prelude.String]) -> "
>                (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
monad_tycon
>                (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
"happyError' tk = "
>                (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str (if Bool
use_monad then String
"" else String
"HappyIdentity ")
>                (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
errorHandler (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" tk\n"

An error handler specified with %error is passed the current token
when used with %lexer, but happyError (the old way but kept for
compatibility) is not passed the current token. Also, the %errorhandlertype
directive determines the API of the provided function.

>    errorHandler :: String -> String
errorHandler =
>       case Maybe String
error_handler' of
>               Just String
h  -> case ErrorHandlerType
error_sig' of
>                              ErrorHandlerType
ErrorHandlerTypeExpList -> String -> String -> String
str String
h
>                              ErrorHandlerType
ErrorHandlerTypeDefault -> String -> String -> String
str String
"(\\(tokens, _) -> " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
h (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" tokens)"
>               Maybe String
Nothing -> case Maybe (String, String)
lexer' of
>                               Maybe (String, String)
Nothing -> String -> String -> String
str String
"(\\(tokens, _) -> happyError tokens)"
>                               Just (String, String)
_  -> String -> String -> String
str String
"(\\(tokens, explist) -> happyError)"

>    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, Int, Int, Bool), Int) -> String -> String)
-> [((String, Int, Int, Bool), Int)] -> [String -> String]
forall a b. (a -> b) -> [a] -> [b]
map ((String, Int, Int, Bool), Int) -> String -> String
forall t0 t1. ((String, t0, Int, t1), Int) -> String -> String
produceEntry ([(String, Int, Int, Bool)]
-> [Int] -> [((String, Int, Int, Bool), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(String, Int, Int, Bool)]
starts' [Int
0..]))
>       (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. if [(String, String)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, String)]
attributes' then String -> String
forall a. a -> a
id else [(String, Int, Int, Bool)] -> String -> String
forall {b} {c} {d}. [(String, b, c, d)] -> String -> String
produceAttrEntries [(String, Int, Int, Bool)]
starts'

>    produceEntry :: ((String, t0, Int, t1), Int) -> String -> String
>    produceEntry :: forall t0 t1. ((String, t0, Int, t1), Int) -> String -> String
produceEntry ((String
name, t0
_start_nonterm, Int
accept_nonterm, t1
_partial), Int
no)
>       = (if [(String, String)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, String)]
attributes' 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 -> Int -> (String -> String) -> String -> String
forall a. Maybe a -> Int -> (String -> String) -> String -> String
mkHappyWrapCon (Array Int (Maybe String)
nt_types Array Int (Maybe String) -> Int -> Maybe String
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
accept_nonterm) Int
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
. Int -> String -> String
mkHappyOut Int
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
. Int -> String -> String
forall {a}. Show a => a -> String -> String
shows (Array Int Int
nt_types_index Array Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
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 :: [(String, b, c, d)] -> String -> String
produceAttrEntries [(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)]
attributes')
>
>       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
"Prelude.sequence_ conds; "
>         (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"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
"Prelude.sequence_ conds; "
>         (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"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 = Prelude.foldr Prelude.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 :: [(String, String)] -> String -> String -> String
> produceAttributes :: [(String, String)] -> String -> String -> String
produceAttributes [] String
_ = String -> String
forall a. a -> a
id
> produceAttributes [(String, String)]
attrs 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
" = 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 :: [(Int, LRAction)] -> LRAction
getDefault [(Int, LRAction)]
actions =
>   -- pick out the action for the error token, if any
>   case [ LRAction
act | (Int
e, LRAction
act) <- [(Int, LRAction)]
actions, Int
e Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
errorTok ] of
>
>       -- use error reduction as the default action, if there is one.
>       act :: LRAction
act@(LR'Reduce Int
_ Priority
_) : [LRAction]
_                 -> LRAction
act
>       act :: LRAction
act@(LR'Multiple [LRAction]
_ (LR'Reduce Int
_ Priority
_)) : [LRAction]
_ -> LRAction
act
>
>       -- if the error token is shifted or otherwise, don't generate
>       --  a default action.  This is *important*!
>       (LRAction
act : [LRAction]
_) | LRAction
act LRAction -> LRAction -> Bool
forall a. Eq a => a -> a -> Bool
/= LRAction
LR'Fail -> LRAction
LR'Fail
>
>       -- no error actions, pick a reduce to be the default.
>       [LRAction]
_      -> case [LRAction]
reduces of
>                     [] -> LRAction
LR'Fail
>                     (LRAction
act:[LRAction]
_) -> LRAction
act    -- pick the first one we see for now
>
>   where reduces :: [LRAction]
reduces
>           =  [ LRAction
act | (Int
_, act :: LRAction
act@(LR'Reduce Int
_ Priority
_)) <- [(Int, LRAction)]
actions ]
>           [LRAction] -> [LRAction] -> [LRAction]
forall a. [a] -> [a] -> [a]
++ [ LRAction
act | (Int
_, LR'Multiple [LRAction]
_ act :: LRAction
act@(LR'Reduce Int
_ Priority
_)) <- [(Int, 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.


> mkTables
>        :: ActionTable -> GotoTable -> Name -> Int -> Int -> Int -> Int -> (Int, Int) ->
>        ( [Int]         -- happyActOffsets
>        , [Int]         -- happyGotoOffsets
>        , [Int]         -- happyTable
>        , [Int]         -- happyDefAction
>        , [Int]         -- happyCheck
>        , [Int]         -- happyExpList
>        , Int           -- happyMinOffset
>        )
>
> mkTables :: ActionTable
-> GotoTable
-> Int
-> Int
-> Int
-> Int
-> Int
-> (Int, Int)
-> ([Int], [Int], [Int], [Int], [Int], [Int], Int)
mkTables ActionTable
action GotoTable
goto Int
first_nonterm' Int
fst_term
>               Int
n_terminals Int
n_nonterminals Int
n_starts
>               (Int, Int)
token_names_bound
>
>  = ( 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)
>    , UArray Int Int -> [Int]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems UArray Int Int
explist
>    , Int
min_off
>    )
>  where
>
>        (UArray Int Int
table,UArray Int Int
check,UArray Int Int
act_offs,UArray Int Int
goto_offs,UArray Int Int
explist,Int
min_off,Int
max_off)
>                = (forall s.
 ST
   s
   (UArray Int Int, UArray Int Int, UArray Int Int, UArray Int Int,
    UArray Int Int, Int, Int))
-> (UArray Int Int, UArray Int Int, UArray Int Int, UArray Int Int,
    UArray Int Int, Int, Int)
forall a. (forall s. ST s a) -> a
runST (Int
-> Int
-> (Int, Int)
-> [TableEntry]
-> [(Int, [Int])]
-> ST
     s
     (UArray Int Int, UArray Int Int, UArray Int Int, UArray Int Int,
      UArray Int Int, Int, Int)
forall s.
Int
-> Int
-> (Int, Int)
-> [TableEntry]
-> [(Int, [Int])]
-> ST
     s
     (UArray Int Int, UArray Int Int, UArray Int Int, UArray Int Int,
      UArray Int Int, Int, Int)
genTables ([TableEntry] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TableEntry]
actions)
>                         Int
max_token (Int, Int)
token_names_bound
>                         [TableEntry]
sorted_actions [(Int, [Int])]
explist_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 Int LRAction
acts) <- ActionTable -> [(Int, Array Int LRAction)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
assocs ActionTable
action,
>                  let ((Int, LRAction)
err:(Int, LRAction)
_dummy:[(Int, LRAction)]
vec) = Array Int LRAction -> [(Int, LRAction)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
assocs Array Int LRAction
acts
>                      vec' :: [(Int, LRAction)]
vec' = Int -> [(Int, LRAction)] -> [(Int, LRAction)]
forall a. Int -> [a] -> [a]
drop (Int
n_startsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n_nonterminals) [(Int, LRAction)]
vec
>                      acts' :: [(Int, LRAction)]
acts' = ((Int, LRAction) -> Bool) -> [(Int, LRAction)] -> [(Int, LRAction)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int, LRAction) -> Bool
notFail ((Int, LRAction)
err(Int, LRAction) -> [(Int, LRAction)] -> [(Int, LRAction)]
forall a. a -> [a] -> [a]
:[(Int, LRAction)]
vec')
>                      default_act :: LRAction
default_act = [(Int, LRAction)] -> LRAction
getDefault [(Int, LRAction)]
acts'
>                      acts'' :: [(Int, Int)]
acts'' = [(Int, LRAction)] -> LRAction -> [(Int, Int)]
mkActVals [(Int, LRAction)]
acts' LRAction
default_act
>                ]
>
>        explist_actions :: [(Int, [Int])]
>        explist_actions :: [(Int, [Int])]
explist_actions = [ (Int
state, ((Int, LRAction) -> [Int]) -> [(Int, LRAction)] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, LRAction) -> [Int]
f ([(Int, LRAction)] -> [Int]) -> [(Int, LRAction)] -> [Int]
forall a b. (a -> b) -> a -> b
$ Array Int LRAction -> [(Int, LRAction)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
assocs Array Int LRAction
acts)
>                          | (Int
state, Array Int LRAction
acts) <- ActionTable -> [(Int, Array Int LRAction)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
assocs ActionTable
action ]
>                          where
>                            f :: (Int, LRAction) -> [Int]
f (Int
t, LR'Shift Int
_ Priority
_ ) = [Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
token_names_bound]
>                            f (Int
_, LRAction
_) = []
>
>        -- adjust terminals by -(fst_term+1), so they start at 1 (error is 0).
>        --  (see ARRAY_NOTES)
>        adjust :: Int -> Int
adjust Int
token | Int
token Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
errorTok = Int
0
>                     | Bool
otherwise         = Int
token Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
fst_term Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
>
>        mkActVals :: [(Int, LRAction)] -> LRAction -> [(Int, Int)]
mkActVals [(Int, LRAction)]
assocs' LRAction
default_act =
>                [ (Int -> Int
adjust Int
token, LRAction -> Int
actionVal LRAction
act)
>                | (Int
token, LRAction
act) <- [(Int, 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 Int Goto
goto_arr) <- GotoTable -> [(Int, Array Int 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 = [(Int, Goto)] -> [(Int, Int)]
mkGotoVals (Array Int Goto -> [(Int, Goto)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
assocs Array Int Goto
goto_arr)
>                ]
>
>        -- adjust nonterminals by -first_nonterm', so they start at zero
>        --  (see ARRAY_NOTES)
>        mkGotoVals :: [(Int, Goto)] -> [(Int, Int)]
mkGotoVals [(Int, Goto)]
assocs' =
>                [ (Int
token Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
first_nonterm', Int
i) | (Int
token, Goto Int
i) <- [(Int, 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.
>        -> (Int, Int)                  -- token names bounds
>        -> [TableEntry]                -- entries for the table
>        -> [(Int, [Int])]              -- expected tokens lists
>        -> ST s ( UArray Int Int       -- table
>                , UArray Int Int       -- check
>                , UArray Int Int       -- action offsets
>                , UArray Int Int       -- goto offsets
>                , UArray Int Int       -- expected tokens list
>                , Int                  -- lowest offset in table
>                , Int                  -- highest offset in table
>                )
>
> genTables :: forall s.
Int
-> Int
-> (Int, Int)
-> [TableEntry]
-> [(Int, [Int])]
-> ST
     s
     (UArray Int Int, UArray Int Int, UArray Int Int, UArray Int Int,
      UArray Int Int, Int, Int)
genTables Int
n_actions Int
max_token (Int, Int)
token_names_bound [TableEntry]
entries [(Int, [Int])]
explist = 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
>   STUArray s Int Int
exp_array  <- (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 -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n_token_names Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
31) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
32) Int
0 -- 32 bits per entry
>
>   (Int
min_off,Int
max_off) <- STUArray s Int Int
-> STUArray s Int Int
-> STUArray s Int Int
-> STUArray s Int Int
-> STUArray s Int Int
-> STUArray s Int Int
-> [TableEntry]
-> [(Int, [Int])]
-> Int
-> Int
-> ST s (Int, Int)
forall s.
STUArray s Int Int
-> STUArray s Int Int
-> STUArray s Int Int
-> STUArray s Int Int
-> STUArray s Int Int
-> STUArray s Int Int
-> [TableEntry]
-> [(Int, [Int])]
-> Int
-> Int
-> ST s (Int, 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 STUArray s Int Int
exp_array [TableEntry]
entries
>                          [(Int, [Int])]
explist Int
max_token Int
n_token_names
>
>   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
exp_array' <- 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
exp_array
>   (UArray Int Int, UArray Int Int, UArray Int Int, UArray Int Int,
 UArray Int Int, Int, Int)
-> ST
     s
     (UArray Int Int, UArray Int Int, UArray Int Int, UArray Int Int,
      UArray Int 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',UArray Int Int
exp_array',Int
min_off,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)
>        (Int
first_token, Int
last') = (Int, Int)
token_names_bound
>        n_token_names :: Int
n_token_names = Int
last' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
first_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
>        -> STUArray s Int Int          -- expected token list
>        -> [TableEntry]                -- entries for the table
>        -> [(Int, [Int])]              -- expected tokens lists
>        -> Int                         -- maximum token no.
>        -> Int                         -- number of token names
>        -> ST s (Int,Int)              -- lowest and 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
-> STUArray s Int Int
-> [TableEntry]
-> [(Int, [Int])]
-> Int
-> Int
-> ST s (Int, 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 STUArray s Int Int
exp_array [TableEntry]
entries
>            [(Int, [Int])]
explist Int
max_token Int
n_token_names
>       = ST s ()
fill_exp_array ST s () -> ST s (Int, Int) -> ST s (Int, Int)
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [TableEntry] -> Int -> Int -> Int -> ST s (Int, Int)
forall {c} {d} {e}.
[(ActionOrGoto, Int, c, d, e, [(Int, Int)])]
-> Int -> Int -> Int -> ST s (Int, Int)
fit_all [TableEntry]
entries Int
0 Int
0 Int
1
>   where
>
>        fit_all :: [(ActionOrGoto, Int, c, d, e, [(Int, Int)])]
-> Int -> Int -> Int -> ST s (Int, Int)
fit_all [] Int
min_off Int
max_off Int
_ = (Int, Int) -> ST s (Int, Int)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
min_off, Int
max_off)
>        fit_all ((ActionOrGoto, Int, c, d, e, [(Int, Int)])
s:[(ActionOrGoto, Int, c, d, e, [(Int, Int)])]
ss) Int
min_off Int
max_off Int
fst_zero = do
>          (Int
off, Int
new_min_off, Int
new_max_off, Int
new_fst_zero) <- (ActionOrGoto, Int, c, d, e, [(Int, Int)])
-> Int -> Int -> Int -> ST s (Int, Int, Int, Int)
forall {c} {d} {e}.
(ActionOrGoto, Int, c, d, e, [(Int, Int)])
-> Int -> Int -> Int -> ST s (Int, Int, Int, Int)
fit (ActionOrGoto, Int, c, d, e, [(Int, Int)])
s Int
min_off 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 -> Int -> ST s (Int, Int)
fit_all [(ActionOrGoto, Int, c, d, e, [(Int, Int)])]
ss' Int
new_min_off Int
new_max_off Int
new_fst_zero
>
>        fill_exp_array :: ST s ()
fill_exp_array =
>          [(Int, [Int])] -> ((Int, [Int]) -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Int, [Int])]
explist (((Int, [Int]) -> ST s ()) -> ST s ())
-> ((Int, [Int]) -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Int
state, [Int]
tokens) ->
>            [Int] -> (Int -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int]
tokens ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
token -> do
>              let bit_nr :: Int
bit_nr = Int
state Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n_token_names Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
token
>              let word_nr :: Int
word_nr = Int
bit_nr Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
32
>              let word_offset :: Int
word_offset = Int
bit_nr Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
32
>              Int
x <- 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
exp_array Int
word_nr
>              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
exp_array Int
word_nr (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
setBit Int
x Int
word_offset)
>
>        -- 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 -> Int -> ST s (Int, Int, Int, Int)
fit (ActionOrGoto
_,Int
_,c
_,d
_,e
_,[]) Int
min_off Int
max_off Int
fst_zero = (Int, Int, Int, Int) -> ST s (Int, Int, Int, Int)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
0,Int
min_off,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
min_off 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_min_off :: Int
new_min_off | Int
furthest_left  Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
min_off = Int
furthest_left
>                          | Bool
otherwise                = Int
min_off
>              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_left :: Int
furthest_left  = Int
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, Int) -> ST s (Int, Int, Int, Int)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
off, Int
new_min_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 :: (Int, LRAction) -> Bool
> notFail :: (Int, LRAction) -> Bool
notFail (Int
_, LRAction
LR'Fail) = Bool
False
> notFail (Int, 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.

> 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 Int Int -> Int -> String -> String
> mkAbsSynCon :: Array Int Int -> Int -> String -> String
mkAbsSynCon Array Int Int
fx Int
t      = String -> String -> String
str String
"HappyAbsSyn"   (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 (Array Int Int
fx Array Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
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 :: Int -> String -> String
> mkHappyWrap :: Int -> String -> String
mkHappyWrap Int
n = String -> String -> String
str String
"HappyWrap" (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

> mkHappyWrapCon :: Maybe a -> Int -> (String -> String) -> String -> String
> mkHappyWrapCon :: forall a. Maybe a -> Int -> (String -> String) -> String -> String
mkHappyWrapCon Maybe a
Nothing  Int
_ String -> String
s = String -> String
s
> mkHappyWrapCon (Just a
_) Int
n String -> String
s = (String -> String) -> String -> String
brack' (Int -> String -> String
mkHappyWrap Int
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 :: Int -> String -> String
> mkHappyIn :: Int -> String -> String
mkHappyIn Int
n           = String -> String -> String
str String
"happyIn"  (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
> mkHappyOut :: Int -> String -> String
mkHappyOut Int
n          = String -> String -> String
str String
"happyOut" (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

> typeParam, typeParamOut :: Int -> Maybe String -> ShowS
> typeParam :: Int -> Maybe String -> String -> String
typeParam Int
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
. Int -> String -> String
forall {a}. Show a => a -> String -> String
shows Int
n
> typeParam Int
_ (Just String
ty) = String -> String -> String
brack String
ty
> typeParamOut :: Int -> Maybe String -> String -> String
typeParamOut Int
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
. Int -> String -> String
forall {a}. Show a => a -> String -> String
shows Int
n
> typeParamOut Int
n (Just String
_) = Int -> String -> String
mkHappyWrap Int
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 function is used for generating happyExpList, which is an array of
bits encoded as [Int] for legacy reasons; we don't want to check for overflow
here.

> hexCharsForBits :: [Int] -> String -> String
> hexCharsForBits :: [Int] -> String -> String
hexCharsForBits [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
forall a b. (Integral a, Num b) => a -> b
fromIntegral) 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