> {-#LANGUAGE FlexibleContexts#-}
> module ProduceCode (produceParser) where
> 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
> -> ActionTable
> -> GotoTable
> -> String
> -> Maybe String
> -> Maybe String
> -> Target
> -> Bool
> -> Bool
> -> Bool
> -> 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
>
>
> 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"
> 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 ]
>
> 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"
>
> 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
"")
>
>
> 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
>
> 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
>
> ([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
> =
> 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)
> 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 =
>
> case [ LRAction
act | (Int
e, LRAction
act) <- [(Int, LRAction)]
actions, Int
e forall a. Eq a => a -> a -> Bool
== Int
errorTok ] of
>
>
> act :: LRAction
act@(LR'Reduce Int
_ Priority
_) : [LRAction]
_ -> LRAction
act
> act :: LRAction
act@(LR'Multiple [LRAction]
_ (LR'Reduce Int
_ Priority
_)) : [LRAction]
_ -> LRAction
act
>
>
>
> (LRAction
act : [LRAction]
_) | LRAction
act forall a. Eq a => a -> a -> Bool
/= LRAction
LR'Fail -> LRAction
LR'Fail
>
>
> [LRAction]
_ -> case [LRAction]
reduces of
> [] -> LRAction
LR'Fail
> (LRAction
act:[LRAction]
_) -> LRAction
act
>
> 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]
> ,[Int]
> ,[Int]
> ,[Int]
> ,[Int]
> )
>
> 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)
>
>
> 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 :: 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)
> ]
>
>
>
> 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,
> Int,
> Int,
> Int,
> [(Int,Int)])
> genTables
> :: Int
> -> Int
> -> [TableEntry]
> -> ST s (UArray Int Int,
> UArray Int Int,
> UArray Int Int,
> UArray Int Int,
> Int
> )
>
> 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
> -> STUArray s Int Int
> -> STUArray s Int Int
> -> STUArray s Int Int
> -> STUArray s Int Int
> -> [TableEntry]
> -> Int
> -> ST s Int
>
> 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
>
>
>
>
> 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 :: (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
>
>
>
> 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
>
>
>
> 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)
>
> 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
>
> if Int
off forall a. Eq a => a -> a -> Bool
== Int
0 then ST s Int
try_next else do
>
>
> 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
>
>
> 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
> =
> 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')