/-----------------------------------------------------------------------------
Special processing for attribute grammars for the Mangler. We re-parse
the body of the code block and output the nasty-looking record
manipulation and let binding goop

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

> {-# LANGUAGE ScopedTypeVariables #-}
> module Happy.Frontend.AttrGrammar.Mangler (rewriteAttributeGrammar) where

> import Happy.Grammar
> import Happy.Frontend.ParseMonad.Class
> import Happy.Frontend.AttrGrammar
> import Happy.Frontend.AttrGrammar.Parser
> import Happy.Frontend.Mangler.Monad
> import Data.List     ( findIndices, groupBy, intersperse, nub )

> import Data.List  ( sortBy )
> import Data.Maybe ( fromMaybe )

> import Control.Monad

> rewriteAttributeGrammar :: [Name] -> [Name] -> String -> AttributeGrammarExtras -> M (String,[Index])
> rewriteAttributeGrammar :: [Name]
-> [Name] -> ErrMsg -> AttributeGrammarExtras -> M (ErrMsg, [Int])
rewriteAttributeGrammar [Name]
lhs [Name]
nonterm_names ErrMsg
code AttributeGrammarExtras
ag =

   first we need to parse the body of the code block

>     case ReaderT (ErrMsg, Int) ParseResult [AgRule]
-> ErrMsg -> Int -> ParseResult [AgRule]
forall a.
ReaderT (ErrMsg, Int) ParseResult a
-> ErrMsg -> Int -> ParseResult a
forall (p :: * -> *) a.
ParseMonad p =>
p a -> ErrMsg -> Int -> ParseResult a
runFromStartP ReaderT (ErrMsg, Int) ParseResult [AgRule]
agParser ErrMsg
code Int
0 of
>        Left ErrMsg
msg  -> do ErrMsg -> M ()
addErr (ErrMsg
"error in attribute grammar rules: "ErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++ErrMsg
msg)
>                        (ErrMsg, [Int]) -> M (ErrMsg, [Int])
forall a. a -> WriterT [ErrMsg] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ErrMsg
"",[])
>        Right [AgRule]
rules  ->

   now we break the rules into three lists, one for synthesized attributes,
   one for inherited attributes, and one for conditionals

>            let ( [AgSelfAssign]
selfRules :: [AgSelfAssign]
>                  , [AgSubAssign]
subRules :: [AgSubAssign]
>                  , [AgConditional]
conditions :: [AgConditional]
>                  ) = [AgSelfAssign]
-> [AgSubAssign]
-> [AgConditional]
-> [AgRule]
-> ([AgSelfAssign], [AgSubAssign], [AgConditional])
partitionRules [] [] [] [AgRule]
rules
>                attrNames :: [ErrMsg]
attrNames = ((ErrMsg, ErrMsg) -> ErrMsg) -> [(ErrMsg, ErrMsg)] -> [ErrMsg]
forall a b. (a -> b) -> [a] -> [b]
map (ErrMsg, ErrMsg) -> ErrMsg
forall a b. (a, b) -> a
fst ([(ErrMsg, ErrMsg)] -> [ErrMsg]) -> [(ErrMsg, ErrMsg)] -> [ErrMsg]
forall a b. (a -> b) -> a -> b
$ AttributeGrammarExtras -> [(ErrMsg, ErrMsg)]
attributes AttributeGrammarExtras
ag
>                defaultAttr :: ErrMsg
defaultAttr = [ErrMsg] -> ErrMsg
forall a. HasCallStack => [a] -> a
head [ErrMsg]
attrNames

   now check that $i references are in range

>            in do let prods :: [Index]
>                      prods :: [Int]
prods = [AgRule] -> [Int]
mentionedProductions [AgRule]
rules
>                  (Int -> M ()) -> [Int] -> M ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Int -> M ()
checkArity [Int]
prods

   and output the rules

>                  ErrMsg
rulesStr <- Int
-> [ErrMsg]
-> ErrMsg
-> [Int]
-> [AgSelfAssign]
-> [AgSubAssign]
-> [AgConditional]
-> M ErrMsg
formatRules Int
arity [ErrMsg]
attrNames ErrMsg
defaultAttr
>                               [Int]
allSubProductions [AgSelfAssign]
selfRules
>                               [AgSubAssign]
subRules [AgConditional]
conditions

   return the munged code body and all sub-productions mentioned

>                  (ErrMsg, [Int]) -> M (ErrMsg, [Int])
forall a. a -> WriterT [ErrMsg] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ErrMsg
rulesStr,[Int] -> [Int]
forall a. Eq a => [a] -> [a]
nub ([Int]
allSubProductions[Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++[Int]
prods))


>    where arity :: Index 
>          arity :: Int
arity = [Name] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
lhs

>          partitionRules :: [AgSelfAssign]
-> [AgSubAssign]
-> [AgConditional]
-> [AgRule]
-> ([AgSelfAssign], [AgSubAssign], [AgConditional])
partitionRules [AgSelfAssign]
a [AgSubAssign]
b [AgConditional]
c [] = ([AgSelfAssign]
a,[AgSubAssign]
b,[AgConditional]
c)
>          partitionRules [AgSelfAssign]
a [AgSubAssign]
b [AgConditional]
c (RightmostAssign ErrMsg
attr [AgToken]
toks : [AgRule]
xs) = [AgSelfAssign]
-> [AgSubAssign]
-> [AgConditional]
-> [AgRule]
-> ([AgSelfAssign], [AgSubAssign], [AgConditional])
partitionRules [AgSelfAssign]
a (AgSubAssign
xAgSubAssign -> [AgSubAssign] -> [AgSubAssign]
forall a. a -> [a] -> [a]
:[AgSubAssign]
b) [AgConditional]
c [AgRule]
xs
>             where x :: AgSubAssign
x = (Int, ErrMsg) -> [AgToken] -> AgSubAssign
MkAgSubAssign (Int
arity,ErrMsg
attr) [AgToken]
toks
>          partitionRules [AgSelfAssign]
a [AgSubAssign]
b [AgConditional]
c (SelfAssign AgSelfAssign
x  : [AgRule]
xs) = [AgSelfAssign]
-> [AgSubAssign]
-> [AgConditional]
-> [AgRule]
-> ([AgSelfAssign], [AgSubAssign], [AgConditional])
partitionRules (AgSelfAssign
xAgSelfAssign -> [AgSelfAssign] -> [AgSelfAssign]
forall a. a -> [a] -> [a]
:[AgSelfAssign]
a) [AgSubAssign]
b [AgConditional]
c [AgRule]
xs
>          partitionRules [AgSelfAssign]
a [AgSubAssign]
b [AgConditional]
c (SubAssign AgSubAssign
x   : [AgRule]
xs) = [AgSelfAssign]
-> [AgSubAssign]
-> [AgConditional]
-> [AgRule]
-> ([AgSelfAssign], [AgSubAssign], [AgConditional])
partitionRules [AgSelfAssign]
a (AgSubAssign
xAgSubAssign -> [AgSubAssign] -> [AgSubAssign]
forall a. a -> [a] -> [a]
:[AgSubAssign]
b) [AgConditional]
c [AgRule]
xs
>          partitionRules [AgSelfAssign]
a [AgSubAssign]
b [AgConditional]
c (Conditional AgConditional
x : [AgRule]
xs) = [AgSelfAssign]
-> [AgSubAssign]
-> [AgConditional]
-> [AgRule]
-> ([AgSelfAssign], [AgSubAssign], [AgConditional])
partitionRules [AgSelfAssign]
a [AgSubAssign]
b (AgConditional
xAgConditional -> [AgConditional] -> [AgConditional]
forall a. a -> [a] -> [a]
:[AgConditional]
c) [AgRule]
xs

>          allSubProductions :: [Int]
allSubProductions             = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ((Name -> Bool) -> [Name] -> [Int]
forall a. (a -> Bool) -> [a] -> [Int]
findIndices (Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
nonterm_names) [Name]
lhs)

>          mentionedProductions :: [AgRule] -> [Int]
mentionedProductions [AgRule]
rules    = [ Int
i | (AgTok_SubRef (Int
i,ErrMsg
_)) <- [[AgToken]] -> [AgToken]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((AgRule -> [AgToken]) -> [AgRule] -> [[AgToken]]
forall a b. (a -> b) -> [a] -> [b]
map AgRule -> [AgToken]
getTokens [AgRule]
rules) ]

>          getTokens :: AgRule -> [AgToken]
getTokens (SelfAssign (MkAgSelfAssign ErrMsg
_ [AgToken]
toks))  = [AgToken]
toks
>          getTokens (SubAssign (MkAgSubAssign (Int, ErrMsg)
_ [AgToken]
toks))    = [AgToken]
toks
>          getTokens (Conditional (MkAgConditional [AgToken]
toks))  = [AgToken]
toks
>          getTokens (RightmostAssign ErrMsg
_ [AgToken]
toks)           = [AgToken]
toks
>
>          checkArity :: Int -> M ()
checkArity Int
x = Bool -> M () -> M ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
arity) (M () -> M ()) -> M () -> M ()
forall a b. (a -> b) -> a -> b
$ ErrMsg -> M ()
addErr (Int -> ErrMsg
forall a. Show a => a -> ErrMsg
show Int
xErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++ErrMsg
" out of range")


------------------------------------------------------------------------------------
-- Actually emit the code for the record bindings and conditionals
--

> formatRules :: Index -> [String] -> String -> [Index]
>             -> [AgSelfAssign] -> [AgSubAssign] -> [AgConditional]
>             -> M String

> formatRules :: Int
-> [ErrMsg]
-> ErrMsg
-> [Int]
-> [AgSelfAssign]
-> [AgSubAssign]
-> [AgConditional]
-> M ErrMsg
formatRules Int
arity [ErrMsg]
_attrNames ErrMsg
defaultAttr [Int]
prods [AgSelfAssign]
selfRules [AgSubAssign]
subRules [AgConditional]
conditions = ErrMsg -> M ErrMsg
forall a. a -> WriterT [ErrMsg] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ErrMsg -> M ErrMsg) -> ErrMsg -> M ErrMsg
forall a b. (a -> b) -> a -> b
$
>     [ErrMsg] -> ErrMsg
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ ErrMsg
"\\happyInhAttrs -> let { "
>            , ErrMsg
"happySelfAttrs = happyInhAttrs",ErrMsg
formattedSelfRules
>            , ErrMsg
subProductionRules
>            , ErrMsg
"; happyConditions = ", ErrMsg
formattedConditions
>            , ErrMsg
" } in (happyConditions,happySelfAttrs)"
>            ]
>
>  where formattedSelfRules :: ErrMsg
formattedSelfRules = case [AgSelfAssign]
selfRules of [] -> []; [AgSelfAssign]
_ -> ErrMsg
"{ "ErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++ErrMsg
formattedSelfRules'ErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++ErrMsg
" }"
>        formattedSelfRules' :: ErrMsg
formattedSelfRules' = [ErrMsg] -> ErrMsg
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([ErrMsg] -> ErrMsg) -> [ErrMsg] -> ErrMsg
forall a b. (a -> b) -> a -> b
$ ErrMsg -> [ErrMsg] -> [ErrMsg]
forall a. a -> [a] -> [a]
intersperse ErrMsg
", " ([ErrMsg] -> [ErrMsg]) -> [ErrMsg] -> [ErrMsg]
forall a b. (a -> b) -> a -> b
$ (AgSelfAssign -> ErrMsg) -> [AgSelfAssign] -> [ErrMsg]
forall a b. (a -> b) -> [a] -> [b]
map AgSelfAssign -> ErrMsg
formatSelfRule [AgSelfAssign]
selfRules
>        formatSelfRule :: AgSelfAssign -> ErrMsg
formatSelfRule (MkAgSelfAssign [] [AgToken]
toks)   = ErrMsg
defaultAttrErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++ErrMsg
" = "ErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++([AgToken] -> ErrMsg
formatTokens [AgToken]
toks)
>        formatSelfRule (MkAgSelfAssign ErrMsg
attr [AgToken]
toks) = ErrMsg
attrErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++ErrMsg
" = "ErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++([AgToken] -> ErrMsg
formatTokens [AgToken]
toks)

>        subRulesMap :: [(Int,[(String,[AgToken])])]
>        subRulesMap :: [(Int, [(ErrMsg, [AgToken])])]
subRulesMap = ([(Int, (ErrMsg, [AgToken]))] -> (Int, [(ErrMsg, [AgToken])]))
-> [[(Int, (ErrMsg, [AgToken]))]] -> [(Int, [(ErrMsg, [AgToken])])]
forall a b. (a -> b) -> [a] -> [b]
map     (\[(Int, (ErrMsg, [AgToken]))]
l   -> ((Int, (ErrMsg, [AgToken]))
 -> (Int, [(ErrMsg, [AgToken])]) -> (Int, [(ErrMsg, [AgToken])]))
-> (Int, [(ErrMsg, [AgToken])])
-> [(Int, (ErrMsg, [AgToken]))]
-> (Int, [(ErrMsg, [AgToken])])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ (Int
_,(ErrMsg, [AgToken])
x) (Int
i,[(ErrMsg, [AgToken])]
xs) -> (Int
i,(ErrMsg, [AgToken])
x(ErrMsg, [AgToken])
-> [(ErrMsg, [AgToken])] -> [(ErrMsg, [AgToken])]
forall a. a -> [a] -> [a]
:[(ErrMsg, [AgToken])]
xs))
>                                             ((Int, (ErrMsg, [AgToken])) -> Int
forall a b. (a, b) -> a
fst ((Int, (ErrMsg, [AgToken])) -> Int)
-> (Int, (ErrMsg, [AgToken])) -> Int
forall a b. (a -> b) -> a -> b
$ [(Int, (ErrMsg, [AgToken]))] -> (Int, (ErrMsg, [AgToken]))
forall a. HasCallStack => [a] -> a
head [(Int, (ErrMsg, [AgToken]))]
l,[(Int, (ErrMsg, [AgToken])) -> (ErrMsg, [AgToken])
forall a b. (a, b) -> b
snd ((Int, (ErrMsg, [AgToken])) -> (ErrMsg, [AgToken]))
-> (Int, (ErrMsg, [AgToken])) -> (ErrMsg, [AgToken])
forall a b. (a -> b) -> a -> b
$ [(Int, (ErrMsg, [AgToken]))] -> (Int, (ErrMsg, [AgToken]))
forall a. HasCallStack => [a] -> a
head [(Int, (ErrMsg, [AgToken]))]
l])
>                                             ([(Int, (ErrMsg, [AgToken]))] -> [(Int, (ErrMsg, [AgToken]))]
forall a. HasCallStack => [a] -> [a]
tail [(Int, (ErrMsg, [AgToken]))]
l) ) ([[(Int, (ErrMsg, [AgToken]))]] -> [(Int, [(ErrMsg, [AgToken])])])
-> ([AgSubAssign] -> [[(Int, (ErrMsg, [AgToken]))]])
-> [AgSubAssign]
-> [(Int, [(ErrMsg, [AgToken])])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                      ((Int, (ErrMsg, [AgToken])) -> (Int, (ErrMsg, [AgToken])) -> Bool)
-> [(Int, (ErrMsg, [AgToken]))] -> [[(Int, (ErrMsg, [AgToken]))]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\(Int, (ErrMsg, [AgToken]))
x (Int, (ErrMsg, [AgToken]))
y -> ((Int, (ErrMsg, [AgToken])) -> Int
forall a b. (a, b) -> a
fst (Int, (ErrMsg, [AgToken]))
x) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ((Int, (ErrMsg, [AgToken])) -> Int
forall a b. (a, b) -> a
fst (Int, (ErrMsg, [AgToken]))
y)) ([(Int, (ErrMsg, [AgToken]))] -> [[(Int, (ErrMsg, [AgToken]))]])
-> ([AgSubAssign] -> [(Int, (ErrMsg, [AgToken]))])
-> [AgSubAssign]
-> [[(Int, (ErrMsg, [AgToken]))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                      ((Int, (ErrMsg, [AgToken]))
 -> (Int, (ErrMsg, [AgToken])) -> Ordering)
-> [(Int, (ErrMsg, [AgToken]))] -> [(Int, (ErrMsg, [AgToken]))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy  (\(Int, (ErrMsg, [AgToken]))
x (Int, (ErrMsg, [AgToken]))
y -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((Int, (ErrMsg, [AgToken])) -> Int
forall a b. (a, b) -> a
fst (Int, (ErrMsg, [AgToken]))
x) ((Int, (ErrMsg, [AgToken])) -> Int
forall a b. (a, b) -> a
fst (Int, (ErrMsg, [AgToken]))
y)) ([(Int, (ErrMsg, [AgToken]))] -> [(Int, (ErrMsg, [AgToken]))])
-> ([AgSubAssign] -> [(Int, (ErrMsg, [AgToken]))])
-> [AgSubAssign]
-> [(Int, (ErrMsg, [AgToken]))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                      (AgSubAssign -> (Int, (ErrMsg, [AgToken])))
-> [AgSubAssign] -> [(Int, (ErrMsg, [AgToken]))]
forall a b. (a -> b) -> [a] -> [b]
map     (\(MkAgSubAssign (Int
i,ErrMsg
ident) [AgToken]
toks) -> (Int
i,(ErrMsg
ident,[AgToken]
toks))) ([AgSubAssign] -> [(Int, [(ErrMsg, [AgToken])])])
-> [AgSubAssign] -> [(Int, [(ErrMsg, [AgToken])])]
forall a b. (a -> b) -> a -> b
$ [AgSubAssign]
subRules

>        subProductionRules :: ErrMsg
subProductionRules = [ErrMsg] -> ErrMsg
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([ErrMsg] -> ErrMsg) -> [ErrMsg] -> ErrMsg
forall a b. (a -> b) -> a -> b
$ (Int -> ErrMsg) -> [Int] -> [ErrMsg]
forall a b. (a -> b) -> [a] -> [b]
map Int -> ErrMsg
formatSubRules [Int]
prods

>        formatSubRules :: Int -> ErrMsg
formatSubRules Int
i =
>           let attrs :: [(ErrMsg, [AgToken])]
attrs = [(ErrMsg, [AgToken])]
-> Maybe [(ErrMsg, [AgToken])] -> [(ErrMsg, [AgToken])]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [(ErrMsg, [AgToken])] -> [(ErrMsg, [AgToken])])
-> ([(Int, [(ErrMsg, [AgToken])])] -> Maybe [(ErrMsg, [AgToken])])
-> [(Int, [(ErrMsg, [AgToken])])]
-> [(ErrMsg, [AgToken])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> [(Int, [(ErrMsg, [AgToken])])] -> Maybe [(ErrMsg, [AgToken])]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
i ([(Int, [(ErrMsg, [AgToken])])] -> [(ErrMsg, [AgToken])])
-> [(Int, [(ErrMsg, [AgToken])])] -> [(ErrMsg, [AgToken])]
forall a b. (a -> b) -> a -> b
$ [(Int, [(ErrMsg, [AgToken])])]
subRulesMap
>               attrUpdates' :: ErrMsg
attrUpdates' = [ErrMsg] -> ErrMsg
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([ErrMsg] -> ErrMsg) -> [ErrMsg] -> ErrMsg
forall a b. (a -> b) -> a -> b
$ ErrMsg -> [ErrMsg] -> [ErrMsg]
forall a. a -> [a] -> [a]
intersperse ErrMsg
", " ([ErrMsg] -> [ErrMsg]) -> [ErrMsg] -> [ErrMsg]
forall a b. (a -> b) -> a -> b
$ ((ErrMsg, [AgToken]) -> ErrMsg)
-> [(ErrMsg, [AgToken])] -> [ErrMsg]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> (ErrMsg, [AgToken]) -> ErrMsg
forall {p}. p -> (ErrMsg, [AgToken]) -> ErrMsg
formatSubRule Int
i) [(ErrMsg, [AgToken])]
attrs
>               attrUpdates :: ErrMsg
attrUpdates  = case ErrMsg
attrUpdates' of [] -> []; ErrMsg
x -> ErrMsg
"{ "ErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++ErrMsg
xErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++ErrMsg
" }"
>           in [ErrMsg] -> ErrMsg
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ErrMsg
"; (happyConditions_",Int -> ErrMsg
forall a. Show a => a -> ErrMsg
show Int
i,ErrMsg
",happySubAttrs_",Int -> ErrMsg
forall a. Show a => a -> ErrMsg
show Int
i,ErrMsg
") = ",Int -> ErrMsg
mkHappyVar Int
i
>                     ,ErrMsg
" happyEmptyAttrs"
>                     , ErrMsg
attrUpdates
>                     ]
>
>        formattedConditions :: ErrMsg
formattedConditions = [ErrMsg] -> ErrMsg
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([ErrMsg] -> ErrMsg) -> [ErrMsg] -> ErrMsg
forall a b. (a -> b) -> a -> b
$ ErrMsg -> [ErrMsg] -> [ErrMsg]
forall a. a -> [a] -> [a]
intersperse ErrMsg
" Prelude.++ " ([ErrMsg] -> [ErrMsg]) -> [ErrMsg] -> [ErrMsg]
forall a b. (a -> b) -> a -> b
$ ErrMsg
localConditions ErrMsg -> [ErrMsg] -> [ErrMsg]
forall a. a -> [a] -> [a]
: ((Int -> ErrMsg) -> [Int] -> [ErrMsg]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> ErrMsg
"happyConditions_"ErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++(Int -> ErrMsg
forall a. Show a => a -> ErrMsg
show Int
i)) [Int]
prods)
>        localConditions :: ErrMsg
localConditions = ErrMsg
"["ErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++([ErrMsg] -> ErrMsg
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([ErrMsg] -> ErrMsg) -> [ErrMsg] -> ErrMsg
forall a b. (a -> b) -> a -> b
$ ErrMsg -> [ErrMsg] -> [ErrMsg]
forall a. a -> [a] -> [a]
intersperse ErrMsg
", " ([ErrMsg] -> [ErrMsg]) -> [ErrMsg] -> [ErrMsg]
forall a b. (a -> b) -> a -> b
$ (AgConditional -> ErrMsg) -> [AgConditional] -> [ErrMsg]
forall a b. (a -> b) -> [a] -> [b]
map AgConditional -> ErrMsg
formatCondition [AgConditional]
conditions)ErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++ErrMsg
"]"
>        formatCondition :: AgConditional -> ErrMsg
formatCondition (MkAgConditional [AgToken]
toks) = [AgToken] -> ErrMsg
formatTokens [AgToken]
toks

>        formatSubRule :: p -> (ErrMsg, [AgToken]) -> ErrMsg
formatSubRule p
_ ([],[AgToken]
toks)   = ErrMsg
defaultAttrErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++ErrMsg
" = "ErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++([AgToken] -> ErrMsg
formatTokens [AgToken]
toks)
>        formatSubRule p
_ (ErrMsg
attr,[AgToken]
toks) = ErrMsg
attrErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++ErrMsg
" = "ErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++([AgToken] -> ErrMsg
formatTokens [AgToken]
toks)

>        formatTokens :: [AgToken] -> ErrMsg
formatTokens [AgToken]
tokens = [ErrMsg] -> ErrMsg
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((AgToken -> ErrMsg) -> [AgToken] -> [ErrMsg]
forall a b. (a -> b) -> [a] -> [b]
map AgToken -> ErrMsg
formatToken [AgToken]
tokens)

>        formatToken :: AgToken -> ErrMsg
formatToken AgToken
AgTok_LBrace           =  ErrMsg
"{ "
>        formatToken AgToken
AgTok_RBrace           = ErrMsg
"} "
>        formatToken AgToken
AgTok_Where            = ErrMsg
"where "
>        formatToken AgToken
AgTok_Semicolon        = ErrMsg
"; "
>        formatToken AgToken
AgTok_Eq               = ErrMsg
"="
>        formatToken (AgTok_SelfRef [])     = ErrMsg
"("ErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++ErrMsg
defaultAttrErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++ErrMsg
" happySelfAttrs) "
>        formatToken (AgTok_SelfRef ErrMsg
x)      = ErrMsg
"("ErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++ErrMsg
xErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++ErrMsg
" happySelfAttrs) "
>        formatToken (AgTok_RightmostRef ErrMsg
x) = AgToken -> ErrMsg
formatToken ((Int, ErrMsg) -> AgToken
AgTok_SubRef (Int
arity,ErrMsg
x))
>        formatToken (AgTok_SubRef (Int
i,[]))
>            | Int
i Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
prods = ErrMsg
"("ErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++ErrMsg
defaultAttrErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++ErrMsg
" happySubAttrs_"ErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++(Int -> ErrMsg
forall a. Show a => a -> ErrMsg
show Int
i)ErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++ErrMsg
") "
>            | Bool
otherwise      = Int -> ErrMsg
mkHappyVar Int
i ErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++ ErrMsg
" "
>        formatToken (AgTok_SubRef (Int
i,ErrMsg
x))
>            | Int
i Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
prods = ErrMsg
"("ErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++ErrMsg
xErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++ErrMsg
" happySubAttrs_"ErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++(Int -> ErrMsg
forall a. Show a => a -> ErrMsg
show Int
i)ErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++ErrMsg
") "
>            | Bool
otherwise      = ErrMsg -> ErrMsg
forall a. HasCallStack => ErrMsg -> a
error (ErrMsg
"lhs "ErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++(Int -> ErrMsg
forall a. Show a => a -> ErrMsg
show Int
i)ErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++ErrMsg
" is not a non-terminal")
>        formatToken (AgTok_Unknown ErrMsg
x)     = ErrMsg
xErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++ErrMsg
" "
>        formatToken AgToken
AgTok_EOF = ErrMsg -> ErrMsg
forall a. HasCallStack => ErrMsg -> a
error ErrMsg
"formatToken AgTok_EOF"

> mkHappyVar :: Int -> String
> mkHappyVar :: Int -> ErrMsg
mkHappyVar Int
n  = ErrMsg
"happy_var_" ErrMsg -> ErrMsg -> ErrMsg
forall a. [a] -> [a] -> [a]
++ Int -> ErrMsg
forall a. Show a => a -> ErrMsg
show Int
n