> {-#LANGUAGE FlexibleContexts#-}


> module ProduceCode (produceParser) where


-- > import Paths_happy		( version )
-- > import Data.Version		( showVersion )


> import Grammar
> import Target			( Target(..) )
> import GenUtils		( mapDollarDollar, str, char, nl, strspace,
>                                 interleave, interleave', maybestr, 
>                                 brack, brack' )


> import Data.Maybe 			( isJust, isNothing )
> import Data.Char
> import Data.List


> import Control.Monad.ST
> import Data.Array.ST      ( STUArray )
> import Data.Array.Unboxed ( UArray )
> import Data.Array.MArray
> import Data.Array.IArray 








> produceParser :: Grammar 			-- grammar info
>		-> ActionTable 			-- action table
>		-> GotoTable 			-- goto table
>		-> String			-- stuff to go at the top
>		-> Maybe String			-- module header
>		-> Maybe String			-- module trailer
>		-> Target			-- type of code required
>		-> Bool				-- use coercions
>		-> Bool				-- use ghc extensions
>		-> Bool				-- strict parser
>		-> String


> produceParser :: Grammar
-> ActionTable
-> GotoTable
-> String
-> Maybe String
-> Maybe String
-> Target
-> Bool
-> 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
>		, lexer :: Grammar -> Maybe (String, String)
lexer = Maybe (String, String)
lexer'
>		, imported_identity :: Grammar -> Bool
imported_identity = Bool
imported_identity'
>		, monad :: Grammar -> (Bool, String, String, String, String)
monad = (Bool
use_monad,String
monad_context,String
monad_tycon,String
monad_then,String
monad_return)
>		, token_specs :: Grammar -> [(Int, String)]
token_specs = [(Int, String)]
token_rep
>		, token_type :: Grammar -> String
token_type = String
token_type'
>		, starts :: Grammar -> [(String, Int, Int, Bool)]
starts = [(String, Int, Int, Bool)]
starts'
>		, error_handler :: Grammar -> Maybe String
error_handler = Maybe String
error_handler'
>               , attributetype :: Grammar -> String
attributetype = String
attributetype'
>               , attributes :: Grammar -> [(String, String)]
attributes = [(String, String)]
attributes'
>		})
>	 	ActionTable
action GotoTable
goto String
top_options Maybe String
module_header Maybe String
module_trailer 
>		Target
target Bool
coerce Bool
ghc Bool
strict
>     =	( String -> String
top_opts
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> String -> String
maybestr Maybe String
module_header forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
nl
>	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.
> 	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
produceAbsSynDecl forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
nl
>    	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
produceTypes
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. Target -> String -> String
produceActionTable Target
target
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
produceReductions
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
produceTokenConverter forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
nl
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
produceIdentityStuff
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
produceMonadStuff
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
produceEntries
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String -> String
produceStrict Bool
strict
>       forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> String -> String -> String
produceAttributes [(String, String)]
attributes' String
attributetype' forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
nl
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> String -> String
maybestr Maybe String
module_trailer forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
nl
>	) String
""
>  where
>    n_starts :: Int
n_starts = 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 -fno-warn-overlapping-patterns #-}" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
nl
>
>    top_opts :: String -> String
top_opts = String -> String
nowarn_opts forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>      case String
top_options of
>          String
"" -> String -> String -> String
str String
""
>          String
_  -> String -> String -> String
str ([String] -> String
unwords [ String
"{-# OPTIONS"
>                             , String
top_options
>                             , String
"#-}"
>                             ]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
nl




















>    produceAbsSynDecl :: String -> String
produceAbsSynDecl 
















	happyIn<n> :: ti -> HappyAbsSyn ti tj tk ...
	happyIn<n> x = unsafeCoerce# 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 " 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
>		= Int -> String -> String
mkHappyIn Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" :: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe String -> String -> String
type_param Int
n Maybe String
ty
>		forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" -> " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
bhappy_item forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String
char Char
'\n'
>		forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
mkHappyIn Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" x = Happy_GHC_Exts.unsafeCoerce# x\n"
>		forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"{-# INLINE " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
mkHappyIn Int
n 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" :: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
bhappy_item
>		forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" -> " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe String -> String -> String
type_param Int
n Maybe String
ty forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String
char Char
'\n'
>		forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
mkHappyOut Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" x = Happy_GHC_Exts.unsafeCoerce# x\n"
>		forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"{-# INLINE " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
mkHappyOut Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" #-}"
>	  in
>	    String -> String -> String
str String
"newtype " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
happy_item forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" = HappyAbsSyn HappyAny\n" -- see NOTE below
>         forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String -> String] -> String -> String
interleave String
"\n" (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" ])
>	  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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
nl 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) <- forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
assocs Array Int (Maybe String)
nt_types ]
>	  -- token injector
>	  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyInTok :: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
token forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" -> " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
bhappy_item
>	  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
>	  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyOutTok :: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
bhappy_item forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" -> " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
token
>	  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"


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




















-> ()) as the type here, but this led to bogus optimisations (see GHC
ticket #1616).
















>     | Bool
otherwise
>	= String -> String -> String
str String
"data HappyAbsSyn " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
str_tyvars
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"\n\t= HappyTerminal " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
token
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"\n\t| HappyErrorToken Int\n"
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String -> String] -> String -> String
interleave String
"\n" 
>         [ String -> String -> String
str String
"\t| " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
makeAbsSynCon Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
strspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe String -> String -> String
type_param Int
n Maybe String
ty
>         | (Int
n, Maybe String
ty) <- 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 forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
n) forall a. Eq a => a -> a -> Bool
== Int
n]


>     where all_tyvars :: [String]
all_tyvars = [ Char
't'forall a. a -> [a] -> [a]
:forall a. Show a => a -> String
show Int
n | (Int
n, Maybe String
Nothing) <- 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)








>    produceTypes :: String -> String
produceTypes 
>     | Target
target forall a. Eq a => a -> a -> Bool
== Target
TargetArrayBased = forall a. a -> a
id


>     | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall a. Maybe a -> Bool
isJust (forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems Array Int (Maybe String)
nt_types) =
>       String -> String
happyReductionDefinition forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"\n\n"
>     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String -> String] -> String -> String
interleave' String
",\n " 
>             [ Int -> String -> String
mkActionName Int
i | (Int
i,(Int, Array Int LRAction)
_action') <- forall a b. [a] -> [b] -> [(a, b)]
zip [ Int
0 :: Int .. ]
>                                                    (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
assocs ActionTable
action) ]
>     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" :: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
monad_context forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" => "
>     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
intMaybeHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" -> " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
happyReductionValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"\n\n"
>     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String -> String] -> String -> String
interleave' String
",\n " 
>             [ Int -> String -> String
mkReduceFun Int
i | 
>                     (Int
i,Production
_action) <- forall a b. [a] -> [b] -> [(a, b)]
zip [ Int
n_starts :: Int .. ]
>                                        (forall a. Int -> [a] -> [a]
drop Int
n_starts [Production]
prods) ]
>     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" :: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
monad_context forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" => "
>     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
happyReductionValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"\n\n"


>     | Bool
otherwise = forall a. a -> a
id


>	where intMaybeHash :: String -> String
intMaybeHash | Bool
ghc       = String -> String -> String
str String
"Happy_GHC_Exts.Int#"
>		           | Bool
otherwise = String -> String -> String
str String
"Int"
>	      tokens :: String -> String
tokens = 
>     		case Maybe (String, String)
lexer' of
>	  		Maybe (String, String)
Nothing -> Char -> String -> String
char Char
'[' forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
token forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"] -> "
>	  		Just (String, String)
_ -> forall a. a -> a
id
>	      happyReductionDefinition :: String -> String
happyReductionDefinition =
>		       String -> String -> String
str String
"{- to allow type-synonyms as our monads (likely\n"
>		     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" - with explicitly-specified bind and return)\n"
>		     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" - in Haskell98, it seems that with\n"
>		     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" - /type M a = .../, then /(HappyReduction M)/\n"
>		     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" - is not allowed.  But Happy is a\n"
>		     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" - code-generator that can just substitute it.\n"
>		     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"type HappyReduction m = "
>		     forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> String -> String
happyReduction (String -> String -> String
str String
"m")
>		     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"\n-}"
>	      happyReductionValue :: String -> String
happyReductionValue =
>		       String -> String -> String
str String
"({-"
>		     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"HappyReduction "
>		     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
brack String
monad_tycon
>		     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" = -}"
>		     forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> String -> String
happyReduction (String -> String -> String
brack String
monad_tycon)
>		     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
")"
>	      happyReduction :: (String -> String) -> String -> String
happyReduction String -> String
m =
>		       String -> String -> String
str String
"\n\t   "
>		     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
intMaybeHash
>		     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" \n\t-> " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
token
>		     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"\n\t-> HappyState "
>		     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
token
>		     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" (HappyStk HappyAbsSyn -> " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
tokens forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
result
>		     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
")\n\t"
>		     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"-> [HappyState "
>		     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
token
>		     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" (HappyStk HappyAbsSyn -> " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
tokens forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
result
>		     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
")] \n\t-> HappyStk HappyAbsSyn \n\t-> "
>		     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
tokens
>		     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
result
>		  where result :: String -> String
result = String -> String
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" HappyAbsSyn"






















		( <<user supplied string>> ) : happyRest












	happyReduce_275 = happyMonadReduce 0# 119# happyReduction_275


	 	=  happyThen (code) (\r -> happyReturn (HappyAbsSyn r))
















>    produceReductions :: String -> String
produceReductions =
> 	String -> [String -> String] -> String -> String
interleave String
"\n\n" 
>	   (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {t :: * -> *} {d}.
Foldable t =>
(Int, [Int], (String, t Int), d) -> Int -> String -> String
produceReduction (forall a. Int -> [a] -> [a]
drop Int
n_starts [Production]
prods) [ Int
n_starts .. ])


>    produceReduction :: (Int, [Int], (String, t Int), d) -> Int -> String -> String
produceReduction (Int
nt, [Int]
toks, (String
code,t Int
vars_used), d
_) Int
i


>     | Bool
is_monad_prod Bool -> Bool -> Bool
&& (Bool
use_monad Bool -> Bool -> Bool
|| Bool
imported_identity')
>	= (String -> String) -> String -> String -> String
mkReductionHdr (forall {a}. Show a => a -> String -> String
showInt Int
lt) String
monad_reduce
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String
char Char
'(' forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String -> String] -> String -> String
interleave String
" `HappyStk`\n\t" [String -> String]
tokPatterns
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyRest) tk\n\t = happyThen ("
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> String -> String
tokLets (Char -> String -> String
char Char
'(' forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
code' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String
char Char
')')
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
monad_pass_token then String -> String -> String
str String
" tk" else forall a. a -> a
id)
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"\n\t) (\\r -> happyReturn (" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
this_absSynCon 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 forall a. a -> a
id (String
"happySpecReduce_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
lt)
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String -> String] -> String -> String
interleave String
"\n\t" [String -> String]
tokPatterns
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" =  "
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> String -> String
tokLets (
>	    String -> String
this_absSynCon forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"\n\t\t " 
>	    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String
char Char
'(' forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
code' forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"\n\t)"
>	  )
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
coerce Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
toks Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null t Int
vars_used then
>		  forall a. a -> a
id
>	   else
>		  String -> String
nl forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
reductionFun forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
strspace
> 		forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String -> String] -> String -> String
interleave String
" " (forall a b. (a -> b) -> [a] -> [b]
map String -> String -> String
str (forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
toks) (forall a. a -> [a]
repeat 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 (forall {a}. Show a => a -> String -> String
showInt Int
lt) String
"happyReduce"
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String
char Char
'(' forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String -> String] -> String -> String
interleave String
" `HappyStk`\n\t" [String -> String]
tokPatterns
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyRest)\n\t = "
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> String -> String
tokLets
>	   ( String -> String
this_absSynCon forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"\n\t\t " 
>	   forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String
char Char
'(' forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
code'forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"\n\t) `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 | Target
target forall a. Eq a => a -> a -> Bool
== Target
TargetArrayBased = Int
nt forall a. Num a => a -> a -> a
- Int
first_nonterm'
>			    | Bool
otherwise 	 	 = Int
nt
>
>		mkReductionHdr :: (String -> String) -> String -> String -> String
mkReductionHdr String -> String
lt' String
s = 
>			Int -> String -> String
mkReduceFun Int
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" = "
>			forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
strspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
lt' forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
strspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> String -> String
showInt Int
adjusted_nt
>			forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
strspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
reductionFun forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
nl 
>			forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
reductionFun forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
strspace
> 
>		reductionFun :: String -> String
reductionFun = String -> String -> String
str String
"happyReduction_" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> String -> String
shows Int
i
>
>		tokPatterns :: [String -> String]
tokPatterns 
>		 | Bool
coerce = forall a. [a] -> [a]
reverse (forall a b. (a -> b) -> [a] -> [b]
map Int -> String -> String
mkDummyVar [Int
1 .. forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
toks])
>		 | Bool
otherwise = forall a. [a] -> [a]
reverse (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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` t Int
vars_used = Char -> String -> String
char Char
'_'
>             	tokPattern Int
n Int
t | Int
t forall a. Ord a => a -> a -> Bool
>= Int
firstStartTok Bool -> Bool -> Bool
&& Int
t forall a. Ord a => a -> a -> Bool
< Int
fst_term
>	      		= if Bool
coerce 
>				then Int -> String -> String
mkHappyVar Int
n
>			  	else (String -> String) -> String -> String
brack' (
>				     Int -> String -> String
makeAbsSynCon Int
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str 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 " 
>				   forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> String -> String
mkHappyTerminalVar Int
n Int
t
>				   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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String -> String]
cases) 
>			= String -> [String -> String] -> String -> String
interleave String
"\n\t" [String -> String]
cases
>			forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
code'' forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str (forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length [String -> String]
cases) (forall a. a -> [a]
repeat Char
'}'))
>		   | Bool
otherwise = String -> String
code''
>
>		cases :: [String -> String]
cases = [ String -> String -> String
str String
"case " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
extract Int
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
strspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
mkDummyVar Int
n
>			forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" of { " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> String -> String
tokPattern Int
n Int
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" -> "
>			| (Int
n,Int
t) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [Int]
toks,
>			  Int
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Int
vars_used ]
>
>		extract :: Int -> String -> String
extract Int
t | Int
t forall a. Ord a => a -> a -> Bool
>= Int
firstStartTok Bool -> Bool -> Bool
&& Int
t 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 = 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








>    produceTokenConverter :: String -> String
produceTokenConverter
>	= case Maybe (String, String)
lexer' of { 
> 
>	Maybe (String, String)
Nothing ->
>    	  String -> String -> String
str String
"happyNewToken action sts stk [] =\n\t"
>    	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
eofAction String
"notHappyAtAll"
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" []\n\n"
>       forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyNewToken action sts stk (tk:tks) =\n\t"
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"let cont i = " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
doAction forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" sts stk tks in\n\t"
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"case tk of {\n\t"
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String -> String] -> String -> String
interleave String
";\n\t" (forall a b. (a -> b) -> [a] -> [b]
map (Int, String) -> String -> String
doToken [(Int, String)]
token_rep)
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"_ -> happyError' (tk:tks)\n\t"
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"}\n\n"
>       forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyError_ tk tks = happyError' (tk:tks)\n";


>	Just (String
lexer'',String
eof') ->
>	  String -> String -> String
str String
"happyNewToken action sts stk\n\t= "
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
lexer''
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"(\\tk -> "
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"\n\tlet cont i = "
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
doAction
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" sts stk in\n\t"
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"case tk of {\n\t"
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str (String
eof' forall a. [a] -> [a] -> [a]
++ String
" -> ")
>    	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
eofAction String
"tk" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
";\n\t"
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String -> String] -> String -> String
interleave String
";\n\t" (forall a b. (a -> b) -> [a] -> [b]
map (Int, String) -> String -> String
doToken [(Int, String)]
token_rep)
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"_ -> happyError' tk\n\t"
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"})\n\n"
>       forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyError_ tk = happyError' tk\n";
>	}


>	where 


>	  eofAction :: String -> String -> String
eofAction String
tk =
>	    (case Target
target of
>	    	Target
TargetArrayBased ->
>	   	  String -> String -> String
str String
"happyDoAction " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
eofTok forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
strspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
tk forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" action"
>	    	Target
_ ->  String -> String -> String
str String
"action "	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
eofTok forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
strspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
eofTok
>		    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
strspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
tk forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" (HappyState action)")
>	     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" sts stk"
>	  eofTok :: String -> String
eofTok = forall {a}. Show a => a -> String -> String
showInt (Int -> Int
tokIndex Int
eof)
>	
>	  doAction :: String -> String
doAction = case Target
target of
>	    Target
TargetArrayBased -> String -> String -> String
str String
"happyDoAction i tk action"
>	    Target
_   -> String -> String -> String
str String
"action i i tk (HappyState action)"
> 
>	  doToken :: (Int, String) -> String -> String
doToken (Int
i,String
tok) 
>		= String -> String -> String
str (String -> String
removeDollarDollar String
tok)
>		forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" -> cont " 
>		forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> String -> String
showInt (Int -> Int
tokIndex Int
i)








>	  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 forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
t [(Int, String)]
token_rep of
>		      Maybe String
Nothing -> 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 
>	= case Target
target of
>		Target
TargetHaskell 	 -> forall a. a -> a
id
>		Target
TargetArrayBased -> \Int
i -> Int
i forall a. Num a => a -> a -> a
- Int
n_nonterminals forall a. Num a => a -> a -> a
- Int
n_starts forall a. Num a => a -> a -> a
- Int
2
>			-- tokens adjusted to start at zero, see ARRAY_NOTES








>    produceActionTable :: Target -> String -> String
produceActionTable Target
TargetHaskell 
>	= forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
id (forall a b. (a -> b) -> [a] -> [b]
map (forall {a} {a :: * -> * -> *} {a :: * -> * -> *}
       {a :: * -> * -> *}.
(Show a, IArray a Goto, Ix a, IArray a LRAction,
 IArray a (a a Goto)) =>
a Int (a a Goto) -> (Int, a Int LRAction) -> String -> String
produceStateFunction GotoTable
goto) (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
assocs ActionTable
action))
>	
>    produceActionTable Target
TargetArrayBased
> 	= String -> String
produceActionArray
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
produceReduceArray
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happy_n_terms = " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> String -> String
shows Int
n_terminals forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" :: Int\n"
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happy_n_nonterms = " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> String -> String
shows Int
n_nonterminals forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" :: Int\n\n"


>    produceStateFunction :: a Int (a a Goto) -> (Int, a Int LRAction) -> String -> String
produceStateFunction a Int (a a Goto)
goto' (Int
state, a Int LRAction
acts)
> 	= forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
id (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => (a, LRAction) -> String -> String
produceActions [(Int, LRAction)]
assocs_acts)
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
id (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => (a, Goto) -> String -> String
produceGotos   (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
assocs a a Goto
gotos))
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
mkActionName Int
state
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
ghc
>              then String -> String -> String
str String
" x = happyTcHack x "
>              else String -> String -> String
str String
" _ = ")
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. LRAction -> String -> String
mkAction LRAction
default_act
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"\n\n"
>
>	where gotos :: a a Goto
gotos = a Int (a a Goto)
goto' forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
state
>	
>	      produceActions :: (a, LRAction) -> String -> String
produceActions (a
_, LRAction
LR'Fail{-'-}) = forall a. a -> a
id
>	      produceActions (a
t, action' :: LRAction
action'@(LR'Reduce{-'-} Int
_ Priority
_))
>	      	 | LRAction
action' forall a. Eq a => a -> a -> Bool
== LRAction
default_act = forall a. a -> a
id
>		 | Bool
otherwise = forall {a}. Show a => a -> String -> String
actionFunction a
t
>			     forall b c a. (b -> c) -> (a -> b) -> a -> c
. LRAction -> String -> String
mkAction LRAction
action' forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"\n"
>	      produceActions (a
t, LRAction
action')
>	      	= forall {a}. Show a => a -> String -> String
actionFunction a
t
>		forall b c a. (b -> c) -> (a -> b) -> a -> c
. LRAction -> String -> String
mkAction LRAction
action' forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"\n"
>		
>	      produceGotos :: (a, Goto) -> String -> String
produceGotos (a
t, Goto Int
i)
>	        = forall {a}. Show a => a -> String -> String
actionFunction a
t
>		forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyGoto " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
mkActionName Int
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"\n"
>	      produceGotos (a
_, Goto
NoGoto) = forall a. a -> a
id
>	      
>	      actionFunction :: a -> String -> String
actionFunction a
t
>	      	= Int -> String -> String
mkActionName Int
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
strspace
>		forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'(' forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> String -> String
showInt a
t
>		forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
") = "
>		
> 	      default_act :: LRAction
default_act = [(Int, LRAction)] -> LRAction
getDefault [(Int, LRAction)]
assocs_acts
>
>	      assocs_acts :: [(Int, LRAction)]
assocs_acts = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
assocs a Int LRAction
acts




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


>	| Bool
otherwise
>	    = String -> String -> String
str String
"happyActOffsets :: Happy_Data_Array.Array Int Int\n"
>	    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyActOffsets = Happy_Data_Array.listArray (0,"
>		forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> String -> String
shows (Int
n_states) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
") (["
>	    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String -> String] -> String -> String
interleave' String
"," (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => a -> String -> String
shows [Int]
act_offs)
>	    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"\n\t])\n\n"
>	
>	    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyGotoOffsets :: Happy_Data_Array.Array Int Int\n"
>	    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyGotoOffsets = Happy_Data_Array.listArray (0,"
>		forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> String -> String
shows (Int
n_states) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
") (["
>	    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String -> String] -> String -> String
interleave' String
"," (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => a -> String -> String
shows [Int]
goto_offs)
>	    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"\n\t])\n\n"
>	
>	    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyDefActions :: Happy_Data_Array.Array Int Int\n"
>	    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyDefActions = Happy_Data_Array.listArray (0,"
>		forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> String -> String
shows (Int
n_states) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
") (["
>	    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String -> String] -> String -> String
interleave' String
"," (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => a -> String -> String
shows [Int]
defaults)
>	    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"\n\t])\n\n"
>	
>	    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyCheck :: Happy_Data_Array.Array Int Int\n"
>	    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyCheck = Happy_Data_Array.listArray (0,"
>		forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> String -> String
shows Int
table_size forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
") (["
>	    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String -> String] -> String -> String
interleave' String
"," (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => a -> String -> String
shows [Int]
check)
>	    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"\n\t])\n\n"
>	
>	    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyTable :: Happy_Data_Array.Array Int Int\n"
>	    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyTable = Happy_Data_Array.listArray (0,"
>		forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> String -> String
shows Int
table_size forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
") (["
>	    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String -> String] -> String -> String
interleave' String
"," (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => a -> String -> String
shows [Int]
table)
>	    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"\n\t])\n\n"
>	
>    (Int
_, Int
last_state) = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds ActionTable
action
>    n_states :: Int
n_states = Int
last_state forall a. Num a => a -> a -> a
+ Int
1
>    n_terminals :: Int
n_terminals = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
terms
>    n_nonterminals :: Int
n_nonterminals = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
nonterms forall a. Num a => a -> a -> a
- Int
n_starts -- lose %starts
>
>    ([Int]
act_offs,[Int]
goto_offs,[Int]
table,[Int]
defaults,[Int]
check) 
>	= ActionTable
-> GotoTable
-> 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
>
>    table_size :: Int
table_size = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
table forall a. Num a => a -> a -> a
- Int
1
>
>    produceReduceArray :: String -> String
produceReduceArray
>   	= {- str "happyReduceArr :: Array Int a\n" -}
>	  String -> String -> String
str String
"happyReduceArr = Happy_Data_Array.array ("
>		forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> String -> String
shows (Int
n_starts :: Int) -- omit the %start reductions
>		forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
", "
>		forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> String -> String
shows Int
n_rules
>		forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
") [\n"
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String -> String] -> String -> String
interleave' String
",\n" (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => a -> String -> String
reduceArrElem [Int
n_starts..Int
n_rules])
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"\n\t]\n\n"


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


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






>    nt_types_index :: Array Int Int
>    nt_types_index :: Array Int Int
nt_types_index = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
array (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) <- 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) = case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
a [(String, Int)]
assoc_list of
>			  Just Int
v -> Int
v
>			  Maybe Int
Nothing -> forall a. HasCallStack => String -> a
error (String
"cant find an item in list")
>	assoc_list :: [(String, Int)]
assoc_list = [ (String
b,Int
a) | (Int
a, Just String
b) <- 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 = forall a. a -> a
id
>     | Bool
imported_identity' =
>	     String -> String -> String
str String
"type HappyIdentity = Identity\n"
>	   forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyIdentity = Identity\n"
>	   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"
>	   forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyIdentity = HappyIdentity\n"
>	   forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyRunIdentity (HappyIdentity a) = a\n\n"
>	   forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"instance Monad HappyIdentity where\n"
>	   forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"    return = HappyIdentity\n"
>	   forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"    (HappyIdentity p) >>= q = q p\n\n"










	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






	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






	happyThen    :: CONTEXT => P a -> (a -> P b) -> P b
	happyReturn  :: CONTEXT => a -> P a








>    produceMonadStuff :: String -> String
produceMonadStuff =
>	     let pcont :: String -> String
pcont = String -> String -> String
str String
monad_context in
>	     let pty :: String -> String
pty = String -> String -> String
str String
monad_tycon in
>	     String -> String -> String
str String
"happyThen :: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
pcont forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" => " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
pty
>	   forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" a -> (a -> "	 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
pty
>	   forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" b) -> " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
pty forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" b\n"
>	   forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyThen = " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
brack String
monad_then forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
nl
>	   forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyReturn :: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
pcont forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" => a -> " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
pty forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" a\n"
>	   forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyReturn = " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
brack String
monad_return forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
nl
>	   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 = (" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
monad_then 
>		 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
") m (\\a -> k a tks)\n"
>		 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyReturn1 :: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
pcont forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" => a -> b -> " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
pty forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" a\n"
>		 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyReturn1 = \\a tks -> " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
brack String
monad_return
>		 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" a\n"
>		 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyError' :: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
monad_context forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" => ["
>		 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
token
>		 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"] -> "
>		 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
monad_tycon
>		 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" a\n"
>		 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyError' = "
>		 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str (if Bool
use_monad then String
"" else String
"HappyIdentity . ")
>		 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
errorHandler
>		 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"\n\n"
>		Maybe (String, String)
_ ->
>		   String -> String -> String
str String
"happyThen1 = happyThen\n"
>	     	 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyReturn1 :: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
pcont forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" => a -> " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
pty forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" a\n"
>	     	 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyReturn1 = happyReturn\n"
>	     	 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyError' :: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
monad_context forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" => "
>				         forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
token forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" -> " 
>	     	 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
monad_tycon
>	     	 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" a\n"
>	     	 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happyError' tk = "
>	     	 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str (if Bool
use_monad then String
"" else String
"HappyIdentity ")
>		 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
errorHandler forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" tk\n"
>	     	 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"\n"










>    errorHandler :: String -> String
errorHandler = 
>	case Maybe String
error_handler' of
>		Just String
h  -> String -> String -> String
str String
h
>		Maybe String
Nothing -> case Maybe (String, String)
lexer' of 
>				Maybe (String, String)
Nothing -> String -> String -> String
str String
"happyError"
>				Just (String, String)
_  -> String -> String -> String
str String
"(\\token -> happyError)"


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








>    produceEntries :: String -> String
produceEntries
>	= String -> [String -> String] -> String -> String
interleave String
"\n\n" (forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b} {d}.
Show a =>
((String, b, Int, d), a) -> String -> String
produceEntry (forall a b. [a] -> [b] -> [(a, b)]
zip [(String, Int, Int, Bool)]
starts' [Integer
0..]))
>       forall b c a. (b -> c) -> (a -> b) -> a -> c
. if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, String)]
attributes' then forall a. a -> a
id else forall {b} {c} {d}. [(String, b, c, d)] -> String -> String
produceAttrEntries [(String, Int, Int, Bool)]
starts'


>    produceEntry :: ((String, b, Int, d), a) -> String -> String
produceEntry ((String
name, b
_start_nonterm, Int
accept_nonterm, d
_partial), a
no)
>       = (if 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_" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
name)
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
maybe_tks
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" = "
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
unmonad
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"happySomeParser where\n"
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"  happySomeParser = happyThen (happyParse "
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. case Target
target of
>	     Target
TargetHaskell -> String -> String -> String
str String
"action_" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> String -> String
shows a
no
>	     Target
TargetArrayBased
>		 | Bool
ghc       -> forall {a}. Show a => a -> String -> String
shows a
no forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"#"
>		 | Bool
otherwise -> forall {a}. Show a => a -> String -> String
shows a
no			
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
maybe_tks
>	forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str 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 (happyOut" 
>			forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> String -> String
shows Int
accept_nonterm forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" x)"
>		     else String -> String -> String
str String
"\\x -> case x of {HappyAbsSyn" 
>		        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> String -> String
shows (Array Int Int
nt_types_index forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
accept_nonterm)
>		        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 | forall a. Maybe a -> Bool
isNothing Maybe (String, String)
lexer' = String -> String -> String
str String
" tks"
>		  | Bool
otherwise = 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" (forall a b. (a -> b) -> [a] -> [b]
map 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)
_) -> 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 = forall a b. (a, b) -> a
fst (forall a. [a] -> a
head [(String, String)]
attributes')
>
>       monadAndLexerAE :: String -> String -> String
monadAndLexerAE String
name
>         = String -> String -> String
str String
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" = " 
>         forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"do { "
>         forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"f <- do_" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"; "
>         forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"let { (conds,attrs) = f happyEmptyAttrs } in do { "
>         forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"sequence_ conds; "
>         forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"return ("forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
defaultAttr 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" toks = "
>         forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"do { "
>         forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"f <- do_" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" toks; "
>         forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"let { (conds,attrs) = f happyEmptyAttrs } in do { "
>         forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"sequence_ conds; "
>         forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"return ("forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
defaultAttr 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" toks = "
>         forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"let { "
>         forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"f = do_" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" toks; "
>         forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"(conds,attrs) = f happyEmptyAttrs; "
>         forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"x = foldr seq attrs conds; "
>         forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
"} in ("forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
defaultAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" x)"








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


>   where attributes' :: String -> String
attributes'  = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (\String -> String
x String -> String
y -> String -> String
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
", " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
y) forall a b. (a -> b) -> a -> b
$ 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" :: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
typ
>         attrsErrors :: String -> String
attrsErrors = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (\String -> String
x String -> String
y -> String -> String
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
", " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
y) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
" = error \"invalid reference to attribute '" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
str String
ident 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










> 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"










> actionVal :: LRAction -> Int
> actionVal :: LRAction -> Int
actionVal (LR'Shift  Int
state Priority
_)	= Int
state forall a. Num a => a -> a -> a
+ Int
1
> actionVal (LR'Reduce Int
rule Priority
_) 	= -(Int
rule 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


> mkAction :: LRAction -> String -> String
> mkAction :: LRAction -> String -> String
mkAction (LR'Shift Int
i Priority
_) 	= String -> String -> String
str String
"happyShift " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
mkActionName Int
i
> mkAction LRAction
LR'Accept	 	= String -> String -> String
str String
"happyAccept"
> mkAction LRAction
LR'Fail 	 	= String -> String -> String
str String
"happyFail"
> mkAction LRAction
LR'MustFail 	 	= String -> String -> String
str String
"happyFail"
> mkAction (LR'Reduce Int
i Priority
_) 	= String -> String -> String
str String
"happyReduce_" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> String -> String
shows Int
i
> mkAction (LR'Multiple [LRAction]
_ LRAction
a)	= LRAction -> String -> String
mkAction LRAction
a


> mkActionName :: Int -> String -> String
> mkActionName :: Int -> String -> String
mkActionName Int
i		= String -> String -> String
str String
"action_" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> String -> String
shows Int
i






> 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 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 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 ]
>   	    forall a. [a] -> [a] -> [a]
++ [ LRAction
act | (Int
_,(LR'Multiple [LRAction]
_ act :: LRAction
act@(LR'Reduce Int
_ Priority
_))) <- [(Int, LRAction)]
actions ]






> mkTables 
>	 :: ActionTable -> GotoTable -> Name -> Int -> Int -> Int -> Int ->
>	 ([Int]		-- happyActOffsets
>	 ,[Int]		-- happyGotoOffsets
>	 ,[Int]		-- happyTable
>	 ,[Int]		-- happyDefAction
>	 ,[Int]		-- happyCheck
>	 )
>
> mkTables :: ActionTable
-> GotoTable
-> 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
>  = ( forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems UArray Int Int
act_offs, 
>      forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems UArray Int Int
goto_offs, 
>      forall a. Int -> [a] -> [a]
take Int
max_off (forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems UArray Int Int
table),
>      [Int]
def_actions, 
>      forall a. Int -> [a] -> [a]
take Int
max_off (forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems UArray Int Int
check)
>   )
>  where 
>
>	 (UArray Int Int
table,UArray Int Int
check,UArray Int Int
act_offs,UArray Int Int
goto_offs,Int
max_off) 
>		 = forall a. (forall s. ST s a) -> a
runST (forall s.
Int
-> Int
-> [TableEntry]
-> ST
     s
     (UArray Int Int, UArray Int Int, UArray Int Int, UArray Int Int,
      Int)
genTables (forall (t :: * -> *) a. Foldable t => t a -> Int
length [TableEntry]
actions) Int
max_token [TableEntry]
sorted_actions)
>	 
>	 -- the maximum token number used in the parser
>	 max_token :: Int
max_token = forall a. Ord a => a -> a -> a
max Int
n_terminals (Int
n_startsforall a. Num a => a -> a -> a
+Int
n_nonterminals) forall a. Num a => a -> a -> a
- Int
1
>
>	 def_actions :: [Int]
def_actions = 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 forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
acts'' then Int
0 
>			 else forall a b. (a, b) -> a
fst (forall a. [a] -> a
last [(Int, Int)]
acts'') forall a. Num a => a -> a -> a
- forall a b. (a, b) -> a
fst (forall a. [a] -> a
head [(Int, Int)]
acts''),
>		    forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Int)]
acts'',
>		    [(Int, Int)]
acts'')
>		 | (Int
state, Array Int LRAction
acts) <- 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) = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
assocs Array Int LRAction
acts
>		       vec' :: [(Int, LRAction)]
vec' = forall a. Int -> [a] -> [a]
drop (Int
n_startsforall a. Num a => a -> a -> a
+Int
n_nonterminals) [(Int, LRAction)]
vec
>		       acts' :: [(Int, LRAction)]
acts' = forall a. (a -> Bool) -> [a] -> [a]
filter ((Int, LRAction) -> Bool
notFail) ((Int, LRAction)
errforall 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
>		 ]
>
>	 -- 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 forall a. Eq a => a -> a -> Bool
== Int
errorTok = Int
0
>		      | Bool
otherwise         = Int
token forall a. Num a => a -> a -> a
- Int
fst_term 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 forall a. Eq a => a -> a -> Bool
/= LRAction
default_act ]
>
>	 gotos :: [TableEntry]
>	 gotos :: [TableEntry]
gotos = [ (ActionOrGoto
GotoEntry,
>		    Int
state, Int
0, 
>		    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
goto_vals then Int
0 
>			 else forall a b. (a, b) -> a
fst (forall a. [a] -> a
last [(Int, Int)]
goto_vals) forall a. Num a => a -> a -> a
- forall a b. (a, b) -> a
fst (forall a. [a] -> a
head [(Int, Int)]
goto_vals),
>		    forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Int)]
goto_vals,
>		    [(Int, Int)]
goto_vals
>		   )
>		 | (Int
state, Array Int Goto
goto_arr) <- 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 (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 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 = forall a. [a] -> [a]
reverse (forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy 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]
actionsforall 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 forall a. Ord a => a -> a -> Bool
< a
width2  = Ordering
LT
>		 | a
width1 forall a. Eq a => a -> a -> Bool
== a
width2 = forall a. Ord a => a -> a -> Ordering
compare a
tally1 a
tally2
>		 | Bool
otherwise = Ordering
GT


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


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


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




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




















> -- 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 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 <- 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 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 <- 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 forall (m :: * -> *) a. Monad m => a -> m a
return Int
off
>  where
> 	try_next :: ST s Int
try_next = forall s.
Int
-> STUArray s Int Int
-> STUArray s Int Int
-> [(Int, Int)]
-> ST s Int
findFreeOffset (Int
offforall 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
_     = 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 <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Int
table (Int
offforall a. Num a => a -> a -> a
+Int
t)
>   if Int
i forall a. Eq a => a -> a -> Bool
/= -Int
1 then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
>	       else 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
_     [] = 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
>    forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Int
table (Int
offforall a. Num a => a -> a -> a
+Int
t) Int
val
>    forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Int
check (Int
offforall a. Num a => a -> a -> a
+Int
t) Int
t
>    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 <- 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 forall a. Eq a => a -> a -> Bool
== -Int
1 then forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
>		    else forall s. STUArray s Int Int -> Int -> ST s Int
findFstFreeSlot STUArray s Int Int
table (Int
nforall a. Num a => a -> a -> a
+Int
1)








> comment :: String
> comment :: String
comment = 
>	  String
"-- parser produced by Happy \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"   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> String -> String
shows (Array Int Int
fx 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_"    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> String -> String
shows Int
n
> mkReduceFun :: Int -> String -> String
mkReduceFun Int
n 	= String -> String -> String
str String
"happyReduce_"  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> String -> String
shows Int
n
> mkDummyVar :: Int -> String -> String
mkDummyVar Int
n		= String -> String -> String
str String
"happy_x_"      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> String -> String
shows Int
n


> mkHappyIn, mkHappyOut :: Int -> String -> String
> mkHappyIn :: Int -> String -> String
mkHappyIn Int
n           = String -> String -> String
str String
"happyIn"  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> String -> String
shows Int
n
> mkHappyOut :: Int -> String -> String
mkHappyOut Int
n          = String -> String -> String
str String
"happyOut" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> String -> String
shows Int
n


> type_param :: Int -> Maybe String -> ShowS
> type_param :: Int -> Maybe String -> String -> String
type_param Int
n Maybe String
Nothing   = Char -> String -> String
char Char
't' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> String -> String
shows Int
n
> type_param Int
_ (Just String
ty) = String -> String -> String
brack String
ty


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










> hexChars :: [Int] -> String
> hexChars :: [Int] -> String
hexChars [Int]
acts = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b. (a -> b) -> [a] -> [b]
map Int -> String
hexChar [Int]
acts)


> hexChar :: Int -> String
> hexChar :: Int -> String
hexChar Int
i | Int
i forall a. Ord a => a -> a -> Bool
< Int
0 = Int -> String
hexChar (Int
i forall a. Num a => a -> a -> a
+ Int
2forall a b. (Num a, Integral b) => a -> b -> a
^Integer
16)
> hexChar Int
i =  Int -> String
toHex (Int
i forall a. Integral a => a -> a -> a
`mod` Int
256) forall a. [a] -> [a] -> [a]
++ Int -> String
toHex (Int
i forall a. Integral a => a -> a -> a
`div` Int
256)


> toHex :: Int -> String
> toHex :: Int -> String
toHex Int
i = [Char
'\\',Char
'x', Int -> Char
hexDig (Int
i forall a. Integral a => a -> a -> a
`div` Int
16), Int -> Char
hexDig (Int
i forall a. Integral a => a -> a -> a
`mod` Int
16)]


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