module AG2AspectAG where
import CommonTypes
import UU.Scanner.Position(Pos)
import UU.Scanner.Position(Pos)
import HsToken
import UU.Scanner.Position(Pos)
import CommonTypes (ConstructorIdent,Identifier)
import Data.Set(Set)
import Data.Map(Map)
import Patterns (Pattern(..),Patterns)
import Expression (Expression(..))
import Macro --marcos
import CommonTypes
import ErrorMessages
import Options
import Data.Char
import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Maybe
import Pretty
import PPUtil
import UU.Scanner.Position
import AbstractSyntax
import TokenDef
import CommonTypes
import Control.Monad.Identity (Identity)
import qualified Control.Monad.Identity
pragmaAspectAG = pp "{-# LANGUAGE EmptyDataDecls, NoMonomorphismRestriction , TypeSynonymInstances, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-}"
ppName l = ppListSep "" "" "_" l
type FieldMap = [(Identifier, Type)]
type DataTypes = Map.Map NontermIdent (Map.Map ConstructorIdent FieldMap)
filterAtts newAtts = filter (\att -> Map.member (identifier att) newAtts)
filterNotAtts newAtts = filter (\att -> not (Map.member (identifier att) newAtts))
defAtt att = "data " >|< attTName att >|< "; " >|< attName att >|< " = proxy :: Proxy " >|< attTName att
attName att = pp $ "att_" ++ att
attTName att = pp $ "Att_" ++ att
defAttRec recPref ppNt atts noGroup =
let recName = ppName [recPref, ppNt]
fields = ppCommas (map (\(a,t) -> ppName [pp a, recName ] >|< " ::" >|< ppShow t) (groupAtts atts noGroup))
in
"data " >|< recName >|< " = " >|< recName >|< " { " >|< fields >|< " }"
groupAtts atts noGroup = (Map.toAscList . Map.difference atts) noGroup
defLocalAtts prodName total actual (l:ls) = ppName [pp l, prodName] >|<
ppListSep "(" ")" "," (replicate (actual1) "_" ++ "x" : replicate (totalactual) "_") >|<
pp " = x" >-<
defLocalAtts prodName total (actual+1) ls
defLocalAtts _ _ _ [] = empty
ntsList att ppNtL = "nts_" ++ att ++ " = " >|< ppListSep "" "" " .*. " ((map fst ppNtL) ++ [pp "hNil"])
filterNts att = filter ( Map.member (identifier att) . snd )
data PPRule = PPRule Identifier Identifier Bool ([(Identifier,Type)] -> [Identifier] -> PP_Doc)
ppRule (field,attr) owrt def = PPRule field attr owrt def
ruleField (PPRule field _ _ _ ) = field
ruleAttr (PPRule _ attr _ _ ) = attr
ruleOwrt (PPRule _ _ owrt _ ) = owrt
ruleDef (PPRule _ _ _ def) = def
defInhGRule ppNt prodName newNT newProd ch rules inhNoGroup synNoGroup chids locals =
let ppAtt = ppName [pp "inh", prodName]
ppR = ppAtt >|< pp " = inhdefM att_inh nts_group $" >-<
indent 4 "do " >-<
indent 5 "loc <- at loc" >-<
indent 5 "lhs <- at lhs" >-<
indent 5 ch >-<
indent 5 "return $" >-<
indent 6 (foldr (>-<) (pp "emptyRecord") (map (chGRule ppNt prodName rules inhNoGroup synNoGroup chids locals) chids))
in if (newNT || (not newNT && newProd))
then (ppR, [ ppAtt ])
else (empty, [])
chGRule ppNt prodName rules inhNoGroup synNoGroup chids locals (idCh,tp) =
let chName = ppName [pp "ch", pp idCh, prodName]
ppTp = ppShow tp
chRules = ppCommas $ mapGRuleDefs (== idCh) rules inhNoGroup synNoGroup chids locals
in if (isNonterminal tp)
then chName >|< ".=." >-<
indent 1 "InhG_" >|< ppShow tp >|< pp " {" >-<
indent 2 chRules >-<
indent 1 "} .*. "
else empty
defSynGRule ppNt prod newNT newProd ch rules inhNoGroup synNoGroup chids locals =
let ppAtt = ppName [pp "syn", ppNt, pp prod]
ppTAtt = "SynG_" >|< ppNt
ppR = ppAtt >|< pp " = syndefM att_syn $" >-<
indent 4 "do " >-<
indent 5 "loc <- at loc" >-<
indent 5 "lhs <- at lhs" >-<
indent 5 ch >-<
indent 5 "return $" >-<
indent 6 ppTAtt >|< pp " {" >-<
indent 7 (ppCommas $ mapGRuleDefs ((== "lhs") . show) rules inhNoGroup synNoGroup chids locals) >-<
indent 6 "}"
in if (newNT || (not newNT && newProd))
then (ppR, [ ppAtt ])
else (empty, [])
defLocRule ppNt prod newNT newProd ch rules inhNoGroup synNoGroup chids locals =
let ppAtt = ppName [pp "loc", ppNt, pp prod]
ppTAtt = ppName [pp "Loc", ppNt, pp prod]
ppR = ppAtt >|< pp " = locdefM att_loc $" >-<
indent 4 "do " >-<
indent 5 "loc <- at loc" >-<
indent 5 "lhs <- at lhs" >-<
indent 5 ch >-<
indent 5 "return $" >-<
indent 6 (ppListSep "(" ")" "," $ mapLRuleDefs rules inhNoGroup synNoGroup chids locals)
in (ppR, [ ppAtt ])
defInstRules ppNt prod newNT newProd ch rules chids locals
= let ppAsp = ppName [pp "inst", ppNt, pp prod]
instRules = filter ((=="inst") . show . ruleField) rules
ppAtt att = ppListSep "`ext` " "" "_" [pp "inst_ch", pp att, ppNt, pp prod]
in ( ppAsp >|< pp " = emptyRule " >|< (map (ppAtt . ruleAttr) instRules) >-<
(vlist $ map (defInstRule ppNt prod ch chids locals) instRules)
, [ ppAsp ])
defInstRule ppNt prod ch chids locals rule =
let ppAtt = ppName [pp "ch", pp (ruleAttr rule), ppNt, pp prod]
in pp "inst_" >|< ppAtt >|< pp " = instdefM " >|< ppAtt >|< pp " $" >-<
indent 4 "do " >-<
indent 5 "loc <- at loc" >-<
indent 5 "lhs <- at lhs" >-<
indent 5 ch >-<
indent 5 "return $" >-<
indent 6 ((ruleDef rule) chids locals)
defSynRules ppNt prod newNT newProd newAtts ch rules inhNoGroup synNoGroup chids locals
= let synRules = filter ( (=="lhs") . show . ruleField) rules
ngRules = filter ((flip elem synNoGroup) . getName . ruleAttr) synRules
(ppR, ppRA) = unzip $ map (defSynRule True ppNt prod newNT newProd newAtts ch chids locals) ngRules
in (vlist ppR, concat ppRA )
modSynRules ppNt prod newNT newProd newAtts ch rules inhNoGroup synNoGroup chids locals
= let synRules = filter ( (=="lhs") . show . ruleField) rules
ngRules = filter ((flip elem synNoGroup) . getName . ruleAttr) synRules
(ppR, ppRA) = unzip $ map (defSynRule False ppNt prod newNT newProd newAtts ch chids locals) ngRules
in (vlist ppR, concat ppRA )
defSynRule new ppNt prod newNT newProd newAtts ch chids locals rule =
let att = ruleAttr rule
newAtt = Map.member att newAtts
owrt = ruleOwrt rule
ppAtt = ppName [pp att, pp (if new then "syn" else "synM"), ppNt, pp prod]
ppR def = ppAtt >|< pp (" = " ++ def ++ " ") >|< attName (show att) >|< pp " $" >-<
indent 4 "do " >-<
indent 5 "loc <- at loc" >-<
indent 5 "lhs <- at lhs" >-<
indent 5 ch >-<
indent 5 "return $" >-<
indent 6 ((ruleDef rule) chids locals)
in
if new
then if (not owrt && (newNT || (not newNT && newProd) || newAtt))
then (ppR "syndefM", [ ppAtt ])
else (empty, [])
else if owrt
then (ppR "synmodM", [ ppAtt ])
else (empty, [])
defInhRules ppNt prodName newNT newProd newAtts ch rules inhNoGroup synNoGroup chids locals
= let ngRules = filter ((flip elem inhNoGroup) . getName . ruleAttr) rules
(ppR, ppRA) = unzip $ map (defInhRule True ppNt prodName newNT newProd newAtts ch ngRules inhNoGroup synNoGroup chids locals) inhNoGroup
in (vlist ppR, concat ppRA)
modInhRules ppNt prodName newNT newProd newAtts ch rules inhNoGroup synNoGroup chids locals
= let ngRules = filter ((flip elem inhNoGroup) . getName . ruleAttr) rules
(ppR, ppRA) = unzip $ map (defInhRule False ppNt prodName newNT newProd newAtts ch ngRules inhNoGroup synNoGroup chids locals) inhNoGroup
in (vlist ppR, concat ppRA)
defInhRule new ppNt prodName newNT newProd newAtts ch rules inhNoGroup synNoGroup chids locals att =
let ppAtt = ppName [pp att, pp (if new then "inh" else "inhM"),prodName]
newAtt = Map.member (identifier att) newAtts
chRMaybe = map (chRule new ppNt prodName att rules inhNoGroup synNoGroup chids locals) chids
chR = [ x | (Just x) <- chRMaybe ]
ppR def = ppAtt >|< pp (" = " ++ def ++ " ") >|< attName att >|< " nts_" >|< att >|< " $" >-<
indent 4 "do " >-<
indent 5 "loc <- at loc" >-<
indent 5 "lhs <- at lhs" >-<
indent 5 ch >-<
indent 5 "return $" >-<
indent 6 (foldr (>-<) (pp "emptyRecord") chR)
in
if new
then if (newNT || (not newNT && newProd) || newAtt)
then (ppR "inhdefM", [ ppAtt ])
else (empty, [])
else if (not . null) chR
then (ppR "inhmodM", [ ppAtt ])
else (empty, [])
chRule new ppNt prodName att rules inhNoGroup synNoGroup chids locals (idCh,tp) =
let chName = ppName [pp "ch", pp idCh, prodName]
ppTp = ppShow tp
chRule = inhRuleDef new (== idCh) (== att) rules inhNoGroup synNoGroup chids locals
in if (isNonterminal tp && (not . null) chRule)
then Just $ chName >|< ".=. (" >|< chRule >|< ") .*. "
else Nothing
mapLRuleDefs rules inhNoGroup synNoGroup chids locals
= map appSnd $ sortBy cmpField $ filter ((== "loc") . show . ruleField) rules
where cmpField r1 r2 = compare (ruleField r1) (ruleField r2)
appSnd rule = (ruleDef rule) chids locals
mapGRuleDefs filt rules inhNoGroup synNoGroup chids locals
= map appSnd $ sortBy cmpField $ filter (not . (flip elem inhNoGroup) . getName . ruleAttr)
$ filter (not . (flip elem synNoGroup) . getName . ruleAttr)
$ filter ( filt . ruleField) rules
where cmpField r1 r2 = compare (ruleField r1) (ruleField r2)
appSnd rule = (ruleDef rule) chids locals
inhRuleDef new filt1 filt2 rules inhNoGroup synNoGroup chids locals
= map appSnd $ sortBy cmpField $ filter ( (== not new) . ruleOwrt)
$ filter ((flip elem inhNoGroup) . getName . ruleAttr)
$ filter ( filt2 . getName . ruleAttr)
$ filter ( filt1 . ruleField) rules
where cmpField r1 r2 = compare (ruleField r1) (ruleField r2)
appSnd rule = (ruleDef rule) chids locals
defRule ppNt (field,att) noGroup rhs = \chids locals ->
let ppAtt = if (elem (getName att) noGroup)
then empty
else case (show field) of
"lhs" -> att >|< "_" >|< pp "SynG" >|< pp "_" >|< ppNt >|< " = "
"loc" -> empty
"inst" -> empty
otherwise -> att >|< "_" >|< pp "InhG" >|< pp "_" >|<
(maybe (error $ "lhs field " ++ show field ++" is not a child")
ppShow (lookup field chids))
>|< " = "
in ppAtt >|< (rhs noGroup field chids locals)
rhsRule ppNt ppProd tks noGroup field chids locals = vlist . lines2PP . (map (token2PP ppNt ppProd field chids locals noGroup )) $ tks
lines2PP [] = []
lines2PP xs = map line2PP . shiftLeft . getLines $ xs
token2PP ppNt ppProd field chids locals noGroup tk
= case tk of
AGLocal var pos _ -> (pos, if (elem var locals)
then (ppListSep "(" "" "_" [pp var, ppNt, ppProd]) >|< pp " (loc # att_loc)) "
else pp var)
AGField field attr pos _ -> let ppChT = maybe (error $ "rhs field " ++ show field ++ " is not a child") ppShow (lookup field chids)
ppAtt = case (show field) of
"lhs" -> attName "inh"
"loc" -> attName "loc"
otherwise -> attName "syn"
ppSubAtt = case (show field) of
"lhs" -> ppName [pp (getName attr), pp "InhG", ppNt]
"loc" -> ppName [pp (getName attr), ppNt, ppProd]
otherwise -> ppName [pp (getName attr), pp "SynG", ppChT]
in (pos, if ((elem (getName attr) noGroup) && ((show field) /= "loc"))
then pp "(" >|< pp (getName field) >|< " # " >|< attName (getName attr) >|< pp ")"
else pp "(" >|< ppSubAtt >|< " (" >|< pp (getName field) >|< " # " >|< ppAtt >|< ")) ")
HsToken value pos -> (pos, pp value)
CharToken value pos -> (pos, pp (show value))
StrToken value pos -> (pos, pp (show value))
Err mesg pos -> (pos, pp $ " ***" ++ mesg ++ "*** ")
line2PP ts = let f (p,t) r = let ct = column p
in \c -> pp (spaces (ctc)) >|< t >|< r (length (show t) +ct)
spaces x | x < 0 = ""
| otherwise = replicate x ' '
in foldr f (pp . const "") ts 1
ppMacro (Macro con children) = "( atts_" >|< show con >|< ", " >|< ppListSep "" "" " <.> " ppChildren >|<")"
where ppChildren = map ppChild children
ppChild (RuleChild ch n) = chName ch >|< " ==> " >|< ppMacro n
ppChild (ChildChild ch n) = chName ch >|< " --> " >|< n
ppChild (ValueChild ch n) = chName ch >|< " ~~> " >|< n
chName ch = ppName [pp "ch", pp ch, pp con]
ppNoGroupAtts syn noGroup = let synatts = Map.keys $ Map.filterWithKey (\att _ -> elem (getName att) noGroup) syn
in map (flip (>|<) "_inh") noGroup ++ map (flip (>|<) "_syn") synatts
ruleName att prodName = ppName [att,prodName]
elemNT a b = False
attTypes atts = map (\(a,t) -> "(HCons (LVPair (Proxy Att_" >|< a >|< ") " >|< ppShow t >|< ") ") $ Map.toAscList atts
attVars atts = map (\(a,_) -> "_" >|< a >|< " ") $ Map.toAscList atts
attFields atts noGroup ppNt =
let ng = map (\(a,_) -> attName (getName a) >|< " .=. _" >|< a >|< " .*. ") $ Map.toAscList noGroup
g = ppCommas $ map (\(a,_) -> ppName [pp a, pp "InhG",ppNt] >|< "= _" >|< a) $ Map.toAscList $ Map.difference atts noGroup
in "(" >|< ng >|< "att_inh .=. " >|< ppName [pp "InhG", ppNt] >|< " { " >|< g >|< " } .*. emptyRecord)"
data Inh_Child = Inh_Child { ext_Inh_Child :: (Maybe String), inhMap_Inh_Child :: (Map Identifier Attributes), inhNoGroup_Inh_Child :: ([String]), newAtts_Inh_Child :: ( Attributes ), o_noGroup_Inh_Child :: ([String]), o_rename_Inh_Child :: (Bool), ppNt_Inh_Child :: (PP_Doc), ppProd_Inh_Child :: (PP_Doc), synMap_Inh_Child :: (Map Identifier Attributes), synNoGroup_Inh_Child :: ([String]) }
data Syn_Child = Syn_Child { idCL_Syn_Child :: ([(Identifier,Type)]), ppCSF_Syn_Child :: ([(Identifier,(PP_Doc,PP_Doc))]), ppDL_Syn_Child :: ([PP_Doc]), ppL_Syn_Child :: (PP_Doc), ppLI_Syn_Child :: ([PP_Doc]), ppR_Syn_Child :: (PP_Doc), prdInh_Syn_Child :: (Attributes) }
wrap_Child :: T_Child -> Inh_Child -> (Syn_Child )
wrap_Child (T_Child act) (Inh_Child _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg1 = T_Child_vIn1 _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup
(T_Child_vOut1 _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh) <- return (inv_Child_s2 sem arg1)
return (Syn_Child _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh)
)
sem_Child :: Child -> T_Child
sem_Child ( Child name_ tp_ kind_ ) = sem_Child_Child name_ tp_ kind_
newtype T_Child = T_Child {
attach_T_Child :: Identity (T_Child_s2 )
}
newtype T_Child_s2 = C_Child_s2 {
inv_Child_s2 :: (T_Child_v1 )
}
data T_Child_s3 = C_Child_s3
type T_Child_v1 = (T_Child_vIn1 ) -> (T_Child_vOut1 )
data T_Child_vIn1 = T_Child_vIn1 (Maybe String) (Map Identifier Attributes) ([String]) ( Attributes ) ([String]) (Bool) (PP_Doc) (PP_Doc) (Map Identifier Attributes) ([String])
data T_Child_vOut1 = T_Child_vOut1 ([(Identifier,Type)]) ([(Identifier,(PP_Doc,PP_Doc))]) ([PP_Doc]) (PP_Doc) ([PP_Doc]) (PP_Doc) (Attributes)
sem_Child_Child :: (Identifier) -> (Type) -> (ChildKind) -> T_Child
sem_Child_Child arg_name_ arg_tp_ arg_kind_ = T_Child (return st2) where
st2 = let
v1 :: T_Child_v1
v1 = \ (T_Child_vIn1 _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup) -> ( let
_chnt = rule0 arg_name_ arg_tp_
_inh = rule1 _chnt _lhsIinhMap
_syn = rule2 _chnt _lhsIsynMap
_lhsOprdInh :: Attributes
_lhsOprdInh = rule3 _inh
_ppCh = rule4 arg_name_
_ppTCh = rule5 arg_tp_
_chName = rule6 _lhsIppNt _lhsIppProd _ppCh
_lhsOppDL :: [PP_Doc]
_lhsOppDL = rule7 _chName _ppTCh arg_kind_
_chLabel = rule8 _chName
_chTLabel = rule9 _chName
_lhsOppL :: PP_Doc
_lhsOppL = rule10 _chLabel _chTLabel _ppTCh arg_kind_
_lhsOppLI :: [PP_Doc]
_lhsOppLI = rule11 _chLabel _chTLabel
_lhsOppR :: PP_Doc
_lhsOppR = rule12 _lhsIppNt _lhsIppProd arg_name_
_lhsOidCL :: [(Identifier,Type)]
_lhsOidCL = rule13 arg_name_ arg_tp_
_lhsOppCSF :: [(Identifier,(PP_Doc,PP_Doc))]
_lhsOppCSF = rule14 _chLabel arg_kind_ arg_name_ arg_tp_
__result_ = T_Child_vOut1 _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh
in __result_ )
in C_Child_s2 v1
rule0 = \ name_ tp_ ->
case tp_ of
NT nt _ _ -> nt
Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.")
Haskell t -> identifier ""
rule1 = \ _chnt ((_lhsIinhMap) :: Map Identifier Attributes) ->
Map.findWithDefault Map.empty _chnt _lhsIinhMap
rule2 = \ _chnt ((_lhsIsynMap) :: Map Identifier Attributes) ->
Map.findWithDefault Map.empty _chnt _lhsIsynMap
rule3 = \ _inh ->
_inh
rule4 = \ name_ ->
pp name_
rule5 = \ tp_ ->
ppShow tp_
rule6 = \ ((_lhsIppNt) :: PP_Doc) ((_lhsIppProd) :: PP_Doc) _ppCh ->
ppName [_ppCh , _lhsIppNt, _lhsIppProd]
rule7 = \ _chName _ppTCh kind_ ->
case kind_ of
ChildSyntax -> [ _chName >|< pp " :: " >|< _ppTCh ]
_ -> []
rule8 = \ _chName ->
"ch_" >|< _chName
rule9 = \ _chName ->
"Ch_" >|< _chName
rule10 = \ _chLabel _chTLabel _ppTCh kind_ ->
"data " >|< _chTLabel >|< "; " >|< _chLabel >|< pp " = proxy :: " >|<
case kind_ of
ChildSyntax -> "Proxy " >|< "(" >|< _chTLabel >|< ", " >|< _ppTCh >|< ")"
_ -> "SemType " >|< _ppTCh >|< pp " nt => Proxy " >|<
"(" >|< _chTLabel >|< ", nt)"
rule11 = \ _chLabel _chTLabel ->
[ _chLabel , _chTLabel ]
rule12 = \ ((_lhsIppNt) :: PP_Doc) ((_lhsIppProd) :: PP_Doc) name_ ->
let chName = ppListSep "" "" "_" [pp name_, _lhsIppNt, _lhsIppProd]
in pp name_ >|< " <- at ch_" >|< chName
rule13 = \ name_ tp_ ->
[ (name_, removeDeforested tp_ ) ]
rule14 = \ _chLabel kind_ name_ tp_ ->
let
semC = if (isNonterminal tp_)
then "sem_" >|< ppShow tp_ >|< " _" >|< name_
else "sem_Lit _" >|< name_
in case kind_ of
ChildSyntax -> [(name_, ( _chLabel >|< " .=. (" >|< semC >|< ") .*. "
, _chLabel >|< " .=. _" >|< name_ >|< " .*. "))]
_ -> []
data Inh_Children = Inh_Children { ext_Inh_Children :: (Maybe String), inhMap_Inh_Children :: (Map Identifier Attributes), inhNoGroup_Inh_Children :: ([String]), newAtts_Inh_Children :: ( Attributes ), o_noGroup_Inh_Children :: ([String]), o_rename_Inh_Children :: (Bool), ppNt_Inh_Children :: (PP_Doc), ppProd_Inh_Children :: (PP_Doc), synMap_Inh_Children :: (Map Identifier Attributes), synNoGroup_Inh_Children :: ([String]) }
data Syn_Children = Syn_Children { idCL_Syn_Children :: ([(Identifier,Type)]), ppCSF_Syn_Children :: ([(Identifier,(PP_Doc,PP_Doc))]), ppDL_Syn_Children :: ([PP_Doc]), ppL_Syn_Children :: (PP_Doc), ppLI_Syn_Children :: ([PP_Doc]), ppR_Syn_Children :: (PP_Doc), prdInh_Syn_Children :: (Attributes) }
wrap_Children :: T_Children -> Inh_Children -> (Syn_Children )
wrap_Children (T_Children act) (Inh_Children _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg4 = T_Children_vIn4 _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup
(T_Children_vOut4 _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh) <- return (inv_Children_s5 sem arg4)
return (Syn_Children _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh)
)
sem_Children :: Children -> T_Children
sem_Children list = Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list)
newtype T_Children = T_Children {
attach_T_Children :: Identity (T_Children_s5 )
}
newtype T_Children_s5 = C_Children_s5 {
inv_Children_s5 :: (T_Children_v4 )
}
data T_Children_s6 = C_Children_s6
type T_Children_v4 = (T_Children_vIn4 ) -> (T_Children_vOut4 )
data T_Children_vIn4 = T_Children_vIn4 (Maybe String) (Map Identifier Attributes) ([String]) ( Attributes ) ([String]) (Bool) (PP_Doc) (PP_Doc) (Map Identifier Attributes) ([String])
data T_Children_vOut4 = T_Children_vOut4 ([(Identifier,Type)]) ([(Identifier,(PP_Doc,PP_Doc))]) ([PP_Doc]) (PP_Doc) ([PP_Doc]) (PP_Doc) (Attributes)
sem_Children_Cons :: T_Child -> T_Children -> T_Children
sem_Children_Cons arg_hd_ arg_tl_ = T_Children (return st5) where
st5 = let
v4 :: T_Children_v4
v4 = \ (T_Children_vIn4 _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup) -> ( let
_hdX2 = Control.Monad.Identity.runIdentity (attach_T_Child (arg_hd_))
_tlX5 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_tl_))
(T_Child_vOut1 _hdIidCL _hdIppCSF _hdIppDL _hdIppL _hdIppLI _hdIppR _hdIprdInh) = inv_Child_s2 _hdX2 (T_Child_vIn1 _hdOext _hdOinhMap _hdOinhNoGroup _hdOnewAtts _hdOo_noGroup _hdOo_rename _hdOppNt _hdOppProd _hdOsynMap _hdOsynNoGroup)
(T_Children_vOut4 _tlIidCL _tlIppCSF _tlIppDL _tlIppL _tlIppLI _tlIppR _tlIprdInh) = inv_Children_s5 _tlX5 (T_Children_vIn4 _tlOext _tlOinhMap _tlOinhNoGroup _tlOnewAtts _tlOo_noGroup _tlOo_rename _tlOppNt _tlOppProd _tlOsynMap _tlOsynNoGroup)
_lhsOppDL :: [PP_Doc]
_lhsOppDL = rule15 _hdIppDL _tlIppDL
_lhsOidCL :: [(Identifier,Type)]
_lhsOidCL = rule16 _hdIidCL _tlIidCL
_lhsOppCSF :: [(Identifier,(PP_Doc,PP_Doc))]
_lhsOppCSF = rule17 _hdIppCSF _tlIppCSF
_lhsOppL :: PP_Doc
_lhsOppL = rule18 _hdIppL _tlIppL
_lhsOppLI :: [PP_Doc]
_lhsOppLI = rule19 _hdIppLI _tlIppLI
_lhsOppR :: PP_Doc
_lhsOppR = rule20 _hdIppR _tlIppR
_lhsOprdInh :: Attributes
_lhsOprdInh = rule21 _hdIprdInh _tlIprdInh
_hdOext = rule22 _lhsIext
_hdOinhMap = rule23 _lhsIinhMap
_hdOinhNoGroup = rule24 _lhsIinhNoGroup
_hdOnewAtts = rule25 _lhsInewAtts
_hdOo_noGroup = rule26 _lhsIo_noGroup
_hdOo_rename = rule27 _lhsIo_rename
_hdOppNt = rule28 _lhsIppNt
_hdOppProd = rule29 _lhsIppProd
_hdOsynMap = rule30 _lhsIsynMap
_hdOsynNoGroup = rule31 _lhsIsynNoGroup
_tlOext = rule32 _lhsIext
_tlOinhMap = rule33 _lhsIinhMap
_tlOinhNoGroup = rule34 _lhsIinhNoGroup
_tlOnewAtts = rule35 _lhsInewAtts
_tlOo_noGroup = rule36 _lhsIo_noGroup
_tlOo_rename = rule37 _lhsIo_rename
_tlOppNt = rule38 _lhsIppNt
_tlOppProd = rule39 _lhsIppProd
_tlOsynMap = rule40 _lhsIsynMap
_tlOsynNoGroup = rule41 _lhsIsynNoGroup
__result_ = T_Children_vOut4 _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh
in __result_ )
in C_Children_s5 v4
rule15 = \ ((_hdIppDL) :: [PP_Doc]) ((_tlIppDL) :: [PP_Doc]) ->
_hdIppDL ++ _tlIppDL
rule16 = \ ((_hdIidCL) :: [(Identifier,Type)]) ((_tlIidCL) :: [(Identifier,Type)]) ->
_hdIidCL ++ _tlIidCL
rule17 = \ ((_hdIppCSF) :: [(Identifier,(PP_Doc,PP_Doc))]) ((_tlIppCSF) :: [(Identifier,(PP_Doc,PP_Doc))]) ->
_hdIppCSF ++ _tlIppCSF
rule18 = \ ((_hdIppL) :: PP_Doc) ((_tlIppL) :: PP_Doc) ->
_hdIppL >-< _tlIppL
rule19 = \ ((_hdIppLI) :: [PP_Doc]) ((_tlIppLI) :: [PP_Doc]) ->
_hdIppLI ++ _tlIppLI
rule20 = \ ((_hdIppR) :: PP_Doc) ((_tlIppR) :: PP_Doc) ->
_hdIppR >-< _tlIppR
rule21 = \ ((_hdIprdInh) :: Attributes) ((_tlIprdInh) :: Attributes) ->
_hdIprdInh `Map.union` _tlIprdInh
rule22 = \ ((_lhsIext) :: Maybe String) ->
_lhsIext
rule23 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
_lhsIinhMap
rule24 = \ ((_lhsIinhNoGroup) :: [String]) ->
_lhsIinhNoGroup
rule25 = \ ((_lhsInewAtts) :: Attributes ) ->
_lhsInewAtts
rule26 = \ ((_lhsIo_noGroup) :: [String]) ->
_lhsIo_noGroup
rule27 = \ ((_lhsIo_rename) :: Bool) ->
_lhsIo_rename
rule28 = \ ((_lhsIppNt) :: PP_Doc) ->
_lhsIppNt
rule29 = \ ((_lhsIppProd) :: PP_Doc) ->
_lhsIppProd
rule30 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
_lhsIsynMap
rule31 = \ ((_lhsIsynNoGroup) :: [String]) ->
_lhsIsynNoGroup
rule32 = \ ((_lhsIext) :: Maybe String) ->
_lhsIext
rule33 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
_lhsIinhMap
rule34 = \ ((_lhsIinhNoGroup) :: [String]) ->
_lhsIinhNoGroup
rule35 = \ ((_lhsInewAtts) :: Attributes ) ->
_lhsInewAtts
rule36 = \ ((_lhsIo_noGroup) :: [String]) ->
_lhsIo_noGroup
rule37 = \ ((_lhsIo_rename) :: Bool) ->
_lhsIo_rename
rule38 = \ ((_lhsIppNt) :: PP_Doc) ->
_lhsIppNt
rule39 = \ ((_lhsIppProd) :: PP_Doc) ->
_lhsIppProd
rule40 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
_lhsIsynMap
rule41 = \ ((_lhsIsynNoGroup) :: [String]) ->
_lhsIsynNoGroup
sem_Children_Nil :: T_Children
sem_Children_Nil = T_Children (return st5) where
st5 = let
v4 :: T_Children_v4
v4 = \ (T_Children_vIn4 _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup) -> ( let
_lhsOppDL :: [PP_Doc]
_lhsOppDL = rule42 ()
_lhsOidCL :: [(Identifier,Type)]
_lhsOidCL = rule43 ()
_lhsOppCSF :: [(Identifier,(PP_Doc,PP_Doc))]
_lhsOppCSF = rule44 ()
_lhsOppL :: PP_Doc
_lhsOppL = rule45 ()
_lhsOppLI :: [PP_Doc]
_lhsOppLI = rule46 ()
_lhsOppR :: PP_Doc
_lhsOppR = rule47 ()
_lhsOprdInh :: Attributes
_lhsOprdInh = rule48 ()
__result_ = T_Children_vOut4 _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh
in __result_ )
in C_Children_s5 v4
rule42 = \ (_ :: ()) ->
[]
rule43 = \ (_ :: ()) ->
[]
rule44 = \ (_ :: ()) ->
[]
rule45 = \ (_ :: ()) ->
empty
rule46 = \ (_ :: ()) ->
[]
rule47 = \ (_ :: ()) ->
empty
rule48 = \ (_ :: ()) ->
Map.empty
data Inh_Expression = Inh_Expression { ppNt_Inh_Expression :: (PP_Doc), ppProd_Inh_Expression :: (PP_Doc) }
data Syn_Expression = Syn_Expression { ppRE_Syn_Expression :: ([String] -> Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc) }
wrap_Expression :: T_Expression -> Inh_Expression -> (Syn_Expression )
wrap_Expression (T_Expression act) (Inh_Expression _lhsIppNt _lhsIppProd) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg7 = T_Expression_vIn7 _lhsIppNt _lhsIppProd
(T_Expression_vOut7 _lhsOppRE) <- return (inv_Expression_s8 sem arg7)
return (Syn_Expression _lhsOppRE)
)
sem_Expression :: Expression -> T_Expression
sem_Expression ( Expression pos_ tks_ ) = sem_Expression_Expression pos_ tks_
newtype T_Expression = T_Expression {
attach_T_Expression :: Identity (T_Expression_s8 )
}
newtype T_Expression_s8 = C_Expression_s8 {
inv_Expression_s8 :: (T_Expression_v7 )
}
data T_Expression_s9 = C_Expression_s9
type T_Expression_v7 = (T_Expression_vIn7 ) -> (T_Expression_vOut7 )
data T_Expression_vIn7 = T_Expression_vIn7 (PP_Doc) (PP_Doc)
data T_Expression_vOut7 = T_Expression_vOut7 ([String] -> Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc)
sem_Expression_Expression :: (Pos) -> ([HsToken]) -> T_Expression
sem_Expression_Expression _ arg_tks_ = T_Expression (return st8) where
st8 = let
v7 :: T_Expression_v7
v7 = \ (T_Expression_vIn7 _lhsIppNt _lhsIppProd) -> ( let
_lhsOppRE :: [String] -> Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc
_lhsOppRE = rule49 _lhsIppNt _lhsIppProd arg_tks_
__result_ = T_Expression_vOut7 _lhsOppRE
in __result_ )
in C_Expression_s8 v7
rule49 = \ ((_lhsIppNt) :: PP_Doc) ((_lhsIppProd) :: PP_Doc) tks_ ->
rhsRule _lhsIppNt _lhsIppProd tks_
data Inh_Grammar = Inh_Grammar { agi_Inh_Grammar :: ((Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))), ext_Inh_Grammar :: (Maybe String), options_Inh_Grammar :: (Options) }
data Syn_Grammar = Syn_Grammar { imp_Syn_Grammar :: (PP_Doc), pp_Syn_Grammar :: (PP_Doc) }
wrap_Grammar :: T_Grammar -> Inh_Grammar -> (Syn_Grammar )
wrap_Grammar (T_Grammar act) (Inh_Grammar _lhsIagi _lhsIext _lhsIoptions) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg10 = T_Grammar_vIn10 _lhsIagi _lhsIext _lhsIoptions
(T_Grammar_vOut10 _lhsOimp _lhsOpp) <- return (inv_Grammar_s11 sem arg10)
return (Syn_Grammar _lhsOimp _lhsOpp)
)
sem_Grammar :: Grammar -> T_Grammar
sem_Grammar ( Grammar typeSyns_ useMap_ derivings_ wrappers_ nonts_ pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ ) = sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ ( sem_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_
newtype T_Grammar = T_Grammar {
attach_T_Grammar :: Identity (T_Grammar_s11 )
}
newtype T_Grammar_s11 = C_Grammar_s11 {
inv_Grammar_s11 :: (T_Grammar_v10 )
}
data T_Grammar_s12 = C_Grammar_s12
type T_Grammar_v10 = (T_Grammar_vIn10 ) -> (T_Grammar_vOut10 )
data T_Grammar_vIn10 = T_Grammar_vIn10 ((Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))) (Maybe String) (Options)
data T_Grammar_vOut10 = T_Grammar_vOut10 (PP_Doc) (PP_Doc)
sem_Grammar_Grammar :: (TypeSyns) -> (UseMap) -> (Derivings) -> (Set NontermIdent) -> T_Nonterminals -> (PragmaMap) -> (AttrOrderMap) -> (ParamMap) -> (ContextMap) -> (QuantMap) -> (UniqueMap) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> T_Grammar
sem_Grammar_Grammar arg_typeSyns_ _ arg_derivings_ _ arg_nonts_ _ _ _ _ _ _ _ _ _ = T_Grammar (return st11) where
st11 = let
v10 :: T_Grammar_v10
v10 = \ (T_Grammar_vIn10 _lhsIagi _lhsIext _lhsIoptions) -> ( let
_nontsX26 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_nonts_))
(T_Nonterminals_vOut25 _nontsIextendedNTs _nontsIinhMap' _nontsIppA _nontsIppAI _nontsIppCata _nontsIppD _nontsIppDI _nontsIppL _nontsIppLI _nontsIppNtL _nontsIppR _nontsIppSF _nontsIppW _nontsIsynMap') = inv_Nonterminals_s26 _nontsX26 (T_Nonterminals_vIn25 _nontsOderivs _nontsOext _nontsOinhMap _nontsOnewAtts _nontsOnewNTs _nontsOnewProds _nontsOo_noGroup _nontsOo_rename _nontsOsynMap _nontsOtSyns)
_nontsOinhMap = rule50 _nontsIinhMap'
_nontsOsynMap = rule51 _nontsIsynMap'
_nontsOo_rename = rule52 _lhsIoptions
_o_noGroup = rule53 _lhsIoptions
_nontsOo_noGroup = rule54 _o_noGroup
_newAtts = rule55 _lhsIagi
_nontsOnewAtts = rule56 _newAtts
_newProds = rule57 _lhsIagi
_nontsOnewProds = rule58 _newProds
_nontsOnewNTs = rule59 _lhsIagi _nontsIextendedNTs
_lhsOimp :: PP_Doc
_lhsOimp = rule60 _lhsIext _nontsIppDI _nontsIppLI _ppAI _ppANT
_lhsOpp :: PP_Doc
_lhsOpp = rule61 _lhsIoptions _nontsIppCata _nontsIppD _nontsIppL _nontsIppSF _nontsIppW _ppA _ppR
_nontsOderivs = rule62 arg_derivings_
_nontsOtSyns = rule63 arg_typeSyns_
_ppA = rule64 _lhsIext _newAtts _nontsIppA _o_noGroup
_ppAI = rule65 _lhsIext _newAtts _nontsIppAI _o_noGroup
_ppANT = rule66 _newAtts _o_noGroup
_ppNtL = rule67 _nontsIppNtL
_ppR = rule68 _newAtts _nontsIppR _o_noGroup _ppNtL
_nontsOext = rule69 _lhsIext
__result_ = T_Grammar_vOut10 _lhsOimp _lhsOpp
in __result_ )
in C_Grammar_s11 v10
rule50 = \ ((_nontsIinhMap') :: Map Identifier Attributes) ->
_nontsIinhMap'
rule51 = \ ((_nontsIsynMap') :: Map Identifier Attributes) ->
_nontsIsynMap'
rule52 = \ ((_lhsIoptions) :: Options) ->
rename _lhsIoptions
rule53 = \ ((_lhsIoptions) :: Options) ->
sort $ noGroup _lhsIoptions
rule54 = \ _o_noGroup ->
_o_noGroup
rule55 = \ ((_lhsIagi) :: (Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))) ->
case _lhsIagi of
(_,_,atts) -> ( Map.unions . (\(a,b) -> a++b) . unzip . Map.elems) atts
rule56 = \ _newAtts ->
_newAtts
rule57 = \ ((_lhsIagi) :: (Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))) ->
case _lhsIagi of
(_,prods,_) -> prods
rule58 = \ _newProds ->
_newProds
rule59 = \ ((_lhsIagi) :: (Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))) ((_nontsIextendedNTs) :: Set NontermIdent) ->
case _lhsIagi of
(newNTs,_,_) -> Set.difference newNTs _nontsIextendedNTs
rule60 = \ ((_lhsIext) :: Maybe String) ((_nontsIppDI) :: [PP_Doc]) ((_nontsIppLI) :: [PP_Doc]) _ppAI _ppANT ->
"import Language.Grammars.AspectAG" >-<
"import Language.Grammars.AspectAG.Derive" >-<
"import Data.HList.Label4" >-<
"import Data.HList.TypeEqGeneric1" >-<
"import Data.HList.TypeCastGeneric1" >-<
maybe empty ("import qualified" >#<) _lhsIext >-<
maybe empty (\ext -> "import" >#< ext >#< ppListSep "(" ")" "," (_nontsIppDI ++ _nontsIppLI ++ _ppAI ++ _ppANT )) _lhsIext
rule61 = \ ((_lhsIoptions) :: Options) ((_nontsIppCata) :: PP_Doc) ((_nontsIppD) :: PP_Doc) ((_nontsIppL) :: PP_Doc) ((_nontsIppSF) :: PP_Doc) ((_nontsIppW) :: PP_Doc) _ppA _ppR ->
(if dataTypes _lhsIoptions
then "-- datatypes" >-< _nontsIppD >-<
"-- labels" >-< _nontsIppL
else empty)
>-<
(if folds _lhsIoptions
then "-- attributes" >-< _ppA >-<
"-- rules" >-< _ppR >-<
"-- catas" >-< _nontsIppCata
else empty)
>-<
(if semfuns _lhsIoptions
then "-- semantic functions" >-< _nontsIppSF
else empty)
>-<
(if wrappers _lhsIoptions
then "-- wrappers" >-< _nontsIppW
else empty)
rule62 = \ derivings_ ->
derivings_
rule63 = \ typeSyns_ ->
typeSyns_
rule64 = \ ((_lhsIext) :: Maybe String) _newAtts ((_nontsIppA) :: PP_Doc) _o_noGroup ->
vlist (map defAtt (filterAtts _newAtts _o_noGroup )) >-<
defAtt "loc" >-<
(case _lhsIext of
Nothing -> defAtt "inh" >-< defAtt "syn"
otherwise -> empty) >-<
_nontsIppA
rule65 = \ ((_lhsIext) :: Maybe String) _newAtts ((_nontsIppAI) :: [PP_Doc]) _o_noGroup ->
let atts = filterNotAtts _newAtts _o_noGroup
in (foldr (\a as -> attName a : as) [] atts) ++
(foldr (\a as -> attTName a : as) [] atts) ++
(case _lhsIext of
Nothing -> []
otherwise -> [ attName "inh", attName "syn", attTName "inh", attTName "syn" ]) ++
_nontsIppAI
rule66 = \ _newAtts _o_noGroup ->
let atts = filterNotAtts _newAtts _o_noGroup
in (foldr (\a as -> ("nts_" >|< a) : as) [] atts)
rule67 = \ ((_nontsIppNtL) :: [(PP_Doc, Attributes)]) ->
_nontsIppNtL
rule68 = \ _newAtts ((_nontsIppR) :: PP_Doc) _o_noGroup _ppNtL ->
ntsList "group" _ppNtL >-<
vlist (map (\att -> ntsList att (filterNts att _ppNtL )) (filterAtts _newAtts _o_noGroup )) >-<
_nontsIppR
rule69 = \ ((_lhsIext) :: Maybe String) ->
_lhsIext
data Inh_HsToken = Inh_HsToken { }
data Syn_HsToken = Syn_HsToken { }
wrap_HsToken :: T_HsToken -> Inh_HsToken -> (Syn_HsToken )
wrap_HsToken (T_HsToken act) (Inh_HsToken ) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg13 = T_HsToken_vIn13
(T_HsToken_vOut13 ) <- return (inv_HsToken_s14 sem arg13)
return (Syn_HsToken )
)
sem_HsToken :: HsToken -> T_HsToken
sem_HsToken ( AGLocal var_ pos_ rdesc_ ) = sem_HsToken_AGLocal var_ pos_ rdesc_
sem_HsToken ( AGField field_ attr_ pos_ rdesc_ ) = sem_HsToken_AGField field_ attr_ pos_ rdesc_
sem_HsToken ( HsToken value_ pos_ ) = sem_HsToken_HsToken value_ pos_
sem_HsToken ( CharToken value_ pos_ ) = sem_HsToken_CharToken value_ pos_
sem_HsToken ( StrToken value_ pos_ ) = sem_HsToken_StrToken value_ pos_
sem_HsToken ( Err mesg_ pos_ ) = sem_HsToken_Err mesg_ pos_
newtype T_HsToken = T_HsToken {
attach_T_HsToken :: Identity (T_HsToken_s14 )
}
newtype T_HsToken_s14 = C_HsToken_s14 {
inv_HsToken_s14 :: (T_HsToken_v13 )
}
data T_HsToken_s15 = C_HsToken_s15
type T_HsToken_v13 = (T_HsToken_vIn13 ) -> (T_HsToken_vOut13 )
data T_HsToken_vIn13 = T_HsToken_vIn13
data T_HsToken_vOut13 = T_HsToken_vOut13
sem_HsToken_AGLocal :: (Identifier) -> (Pos) -> (Maybe String) -> T_HsToken
sem_HsToken_AGLocal _ _ _ = T_HsToken (return st14) where
st14 = let
v13 :: T_HsToken_v13
v13 = \ (T_HsToken_vIn13 ) -> ( let
__result_ = T_HsToken_vOut13
in __result_ )
in C_HsToken_s14 v13
sem_HsToken_AGField :: (Identifier) -> (Identifier) -> (Pos) -> (Maybe String) -> T_HsToken
sem_HsToken_AGField _ _ _ _ = T_HsToken (return st14) where
st14 = let
v13 :: T_HsToken_v13
v13 = \ (T_HsToken_vIn13 ) -> ( let
__result_ = T_HsToken_vOut13
in __result_ )
in C_HsToken_s14 v13
sem_HsToken_HsToken :: (String) -> (Pos) -> T_HsToken
sem_HsToken_HsToken _ _ = T_HsToken (return st14) where
st14 = let
v13 :: T_HsToken_v13
v13 = \ (T_HsToken_vIn13 ) -> ( let
__result_ = T_HsToken_vOut13
in __result_ )
in C_HsToken_s14 v13
sem_HsToken_CharToken :: (String) -> (Pos) -> T_HsToken
sem_HsToken_CharToken _ _ = T_HsToken (return st14) where
st14 = let
v13 :: T_HsToken_v13
v13 = \ (T_HsToken_vIn13 ) -> ( let
__result_ = T_HsToken_vOut13
in __result_ )
in C_HsToken_s14 v13
sem_HsToken_StrToken :: (String) -> (Pos) -> T_HsToken
sem_HsToken_StrToken _ _ = T_HsToken (return st14) where
st14 = let
v13 :: T_HsToken_v13
v13 = \ (T_HsToken_vIn13 ) -> ( let
__result_ = T_HsToken_vOut13
in __result_ )
in C_HsToken_s14 v13
sem_HsToken_Err :: (String) -> (Pos) -> T_HsToken
sem_HsToken_Err _ _ = T_HsToken (return st14) where
st14 = let
v13 :: T_HsToken_v13
v13 = \ (T_HsToken_vIn13 ) -> ( let
__result_ = T_HsToken_vOut13
in __result_ )
in C_HsToken_s14 v13
data Inh_HsTokens = Inh_HsTokens { }
data Syn_HsTokens = Syn_HsTokens { }
wrap_HsTokens :: T_HsTokens -> Inh_HsTokens -> (Syn_HsTokens )
wrap_HsTokens (T_HsTokens act) (Inh_HsTokens ) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg16 = T_HsTokens_vIn16
(T_HsTokens_vOut16 ) <- return (inv_HsTokens_s17 sem arg16)
return (Syn_HsTokens )
)
sem_HsTokens :: HsTokens -> T_HsTokens
sem_HsTokens list = Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list)
newtype T_HsTokens = T_HsTokens {
attach_T_HsTokens :: Identity (T_HsTokens_s17 )
}
newtype T_HsTokens_s17 = C_HsTokens_s17 {
inv_HsTokens_s17 :: (T_HsTokens_v16 )
}
data T_HsTokens_s18 = C_HsTokens_s18
type T_HsTokens_v16 = (T_HsTokens_vIn16 ) -> (T_HsTokens_vOut16 )
data T_HsTokens_vIn16 = T_HsTokens_vIn16
data T_HsTokens_vOut16 = T_HsTokens_vOut16
sem_HsTokens_Cons :: T_HsToken -> T_HsTokens -> T_HsTokens
sem_HsTokens_Cons arg_hd_ arg_tl_ = T_HsTokens (return st17) where
st17 = let
v16 :: T_HsTokens_v16
v16 = \ (T_HsTokens_vIn16 ) -> ( let
_hdX14 = Control.Monad.Identity.runIdentity (attach_T_HsToken (arg_hd_))
_tlX17 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tl_))
(T_HsToken_vOut13 ) = inv_HsToken_s14 _hdX14 (T_HsToken_vIn13 )
(T_HsTokens_vOut16 ) = inv_HsTokens_s17 _tlX17 (T_HsTokens_vIn16 )
__result_ = T_HsTokens_vOut16
in __result_ )
in C_HsTokens_s17 v16
sem_HsTokens_Nil :: T_HsTokens
sem_HsTokens_Nil = T_HsTokens (return st17) where
st17 = let
v16 :: T_HsTokens_v16
v16 = \ (T_HsTokens_vIn16 ) -> ( let
__result_ = T_HsTokens_vOut16
in __result_ )
in C_HsTokens_s17 v16
data Inh_HsTokensRoot = Inh_HsTokensRoot { }
data Syn_HsTokensRoot = Syn_HsTokensRoot { }
wrap_HsTokensRoot :: T_HsTokensRoot -> Inh_HsTokensRoot -> (Syn_HsTokensRoot )
wrap_HsTokensRoot (T_HsTokensRoot act) (Inh_HsTokensRoot ) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg19 = T_HsTokensRoot_vIn19
(T_HsTokensRoot_vOut19 ) <- return (inv_HsTokensRoot_s20 sem arg19)
return (Syn_HsTokensRoot )
)
sem_HsTokensRoot :: HsTokensRoot -> T_HsTokensRoot
sem_HsTokensRoot ( HsTokensRoot tokens_ ) = sem_HsTokensRoot_HsTokensRoot ( sem_HsTokens tokens_ )
newtype T_HsTokensRoot = T_HsTokensRoot {
attach_T_HsTokensRoot :: Identity (T_HsTokensRoot_s20 )
}
newtype T_HsTokensRoot_s20 = C_HsTokensRoot_s20 {
inv_HsTokensRoot_s20 :: (T_HsTokensRoot_v19 )
}
data T_HsTokensRoot_s21 = C_HsTokensRoot_s21
type T_HsTokensRoot_v19 = (T_HsTokensRoot_vIn19 ) -> (T_HsTokensRoot_vOut19 )
data T_HsTokensRoot_vIn19 = T_HsTokensRoot_vIn19
data T_HsTokensRoot_vOut19 = T_HsTokensRoot_vOut19
sem_HsTokensRoot_HsTokensRoot :: T_HsTokens -> T_HsTokensRoot
sem_HsTokensRoot_HsTokensRoot arg_tokens_ = T_HsTokensRoot (return st20) where
st20 = let
v19 :: T_HsTokensRoot_v19
v19 = \ (T_HsTokensRoot_vIn19 ) -> ( let
_tokensX17 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tokens_))
(T_HsTokens_vOut16 ) = inv_HsTokens_s17 _tokensX17 (T_HsTokens_vIn16 )
__result_ = T_HsTokensRoot_vOut19
in __result_ )
in C_HsTokensRoot_s20 v19
data Inh_Nonterminal = Inh_Nonterminal { derivs_Inh_Nonterminal :: (Derivings), ext_Inh_Nonterminal :: (Maybe String), inhMap_Inh_Nonterminal :: (Map Identifier Attributes), newAtts_Inh_Nonterminal :: ( Attributes ), newNTs_Inh_Nonterminal :: (Set NontermIdent), newProds_Inh_Nonterminal :: ( DataTypes ), o_noGroup_Inh_Nonterminal :: ([String]), o_rename_Inh_Nonterminal :: (Bool), synMap_Inh_Nonterminal :: (Map Identifier Attributes), tSyns_Inh_Nonterminal :: (TypeSyns) }
data Syn_Nonterminal = Syn_Nonterminal { extendedNTs_Syn_Nonterminal :: (Set NontermIdent), inhMap'_Syn_Nonterminal :: (Map Identifier Attributes), ppA_Syn_Nonterminal :: (PP_Doc), ppAI_Syn_Nonterminal :: ([PP_Doc]), ppCata_Syn_Nonterminal :: (PP_Doc), ppD_Syn_Nonterminal :: (PP_Doc), ppDI_Syn_Nonterminal :: ([PP_Doc]), ppL_Syn_Nonterminal :: (PP_Doc), ppLI_Syn_Nonterminal :: ([PP_Doc]), ppNtL_Syn_Nonterminal :: ([(PP_Doc, Attributes)]), ppR_Syn_Nonterminal :: (PP_Doc), ppSF_Syn_Nonterminal :: (PP_Doc), ppW_Syn_Nonterminal :: (PP_Doc), synMap'_Syn_Nonterminal :: (Map Identifier Attributes) }
wrap_Nonterminal :: T_Nonterminal -> Inh_Nonterminal -> (Syn_Nonterminal )
wrap_Nonterminal (T_Nonterminal act) (Inh_Nonterminal _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg22 = T_Nonterminal_vIn22 _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns
(T_Nonterminal_vOut22 _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap') <- return (inv_Nonterminal_s23 sem arg22)
return (Syn_Nonterminal _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap')
)
sem_Nonterminal :: Nonterminal -> T_Nonterminal
sem_Nonterminal ( Nonterminal nt_ params_ inh_ syn_ prods_ ) = sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ ( sem_Productions prods_ )
newtype T_Nonterminal = T_Nonterminal {
attach_T_Nonterminal :: Identity (T_Nonterminal_s23 )
}
newtype T_Nonterminal_s23 = C_Nonterminal_s23 {
inv_Nonterminal_s23 :: (T_Nonterminal_v22 )
}
data T_Nonterminal_s24 = C_Nonterminal_s24
type T_Nonterminal_v22 = (T_Nonterminal_vIn22 ) -> (T_Nonterminal_vOut22 )
data T_Nonterminal_vIn22 = T_Nonterminal_vIn22 (Derivings) (Maybe String) (Map Identifier Attributes) ( Attributes ) (Set NontermIdent) ( DataTypes ) ([String]) (Bool) (Map Identifier Attributes) (TypeSyns)
data T_Nonterminal_vOut22 = T_Nonterminal_vOut22 (Set NontermIdent) (Map Identifier Attributes) (PP_Doc) ([PP_Doc]) (PP_Doc) (PP_Doc) ([PP_Doc]) (PP_Doc) ([PP_Doc]) ([(PP_Doc, Attributes)]) (PP_Doc) (PP_Doc) (PP_Doc) (Map Identifier Attributes)
sem_Nonterminal_Nonterminal :: (NontermIdent) -> ([Identifier]) -> (Attributes) -> (Attributes) -> T_Productions -> T_Nonterminal
sem_Nonterminal_Nonterminal arg_nt_ _ arg_inh_ arg_syn_ arg_prods_ = T_Nonterminal (return st23) where
st23 = let
v22 :: T_Nonterminal_v22
v22 = \ (T_Nonterminal_vIn22 _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns) -> ( let
_prodsX38 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_))
(T_Productions_vOut37 _prodsIhasMoreProds _prodsIppA _prodsIppCata _prodsIppDL _prodsIppL _prodsIppLI _prodsIppR _prodsIppRA _prodsIppSF _prodsIppSPF _prodsIprdInh) = inv_Productions_s38 _prodsX38 (T_Productions_vIn37 _prodsOext _prodsOinh _prodsOinhMap _prodsOinhNoGroup _prodsOnewAtts _prodsOnewNT _prodsOnewProds _prodsOo_noGroup _prodsOo_rename _prodsOppNt _prodsOsyn _prodsOsynMap _prodsOsynNoGroup)
_lhsOinhMap' :: Map Identifier Attributes
_lhsOinhMap' = rule70 arg_inh_ arg_nt_
_lhsOsynMap' :: Map Identifier Attributes
_lhsOsynMap' = rule71 arg_nt_ arg_syn_
_inhNoGroup = rule72 _lhsIo_noGroup _prodsIprdInh
_synNoGroup = rule73 _lhsIo_noGroup arg_syn_
_prodsOinhNoGroup = rule74 _inhNoGroup
_prodsOsynNoGroup = rule75 _synNoGroup
_prodsOnewProds = rule76 _lhsInewProds arg_nt_
_lhsOextendedNTs :: Set NontermIdent
_lhsOextendedNTs = rule77 _prodsIhasMoreProds arg_nt_
_ppNt = rule78 arg_nt_
_prodsOppNt = rule79 _ppNt
_lhsOppD :: PP_Doc
_lhsOppD = rule80 _lhsIderivs _lhsInewNTs _lhsItSyns _ppNt _prodsIppDL arg_nt_
_lhsOppDI :: [PP_Doc]
_lhsOppDI = rule81 _lhsInewNTs _ppNt arg_nt_
_ntLabel = rule82 _ppNt
_lhsOppL :: PP_Doc
_lhsOppL = rule83 _lhsInewNTs _ntLabel _ppNt _prodsIppL arg_nt_
_lhsOppLI :: [PP_Doc]
_lhsOppLI = rule84 _lhsInewNTs _ntLabel _prodsIppLI arg_nt_
_lhsOppA :: PP_Doc
_lhsOppA = rule85 _inhNoGroup _lhsInewNTs _ppNt _prodsIppA _synNoGroup arg_inh_ arg_nt_ arg_syn_
_lhsOppAI :: [PP_Doc]
_lhsOppAI = rule86 _lhsInewNTs _ppNt arg_nt_
_lhsOppNtL :: [(PP_Doc, Attributes)]
_lhsOppNtL = rule87 arg_inh_ arg_nt_ arg_syn_
_prodsOnewNT = rule88 _lhsInewNTs arg_nt_
_lhsOppR :: PP_Doc
_lhsOppR = rule89 _prodsIppR arg_nt_
_lhsOppCata :: PP_Doc
_lhsOppCata = rule90 _ppNt _prodsIppCata
_prodsOsyn = rule91 arg_syn_
_prodsOinh = rule92 arg_inh_
_lhsOppSF :: PP_Doc
_lhsOppSF = rule93 _inhNoGroup _ppNt _prodsIppSPF _synNoGroup
_lhsOppW :: PP_Doc
_lhsOppW = rule94 _inhNoGroup _ppNt arg_inh_
_prodsOext = rule95 _lhsIext
_prodsOinhMap = rule96 _lhsIinhMap
_prodsOnewAtts = rule97 _lhsInewAtts
_prodsOo_noGroup = rule98 _lhsIo_noGroup
_prodsOo_rename = rule99 _lhsIo_rename
_prodsOsynMap = rule100 _lhsIsynMap
__result_ = T_Nonterminal_vOut22 _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap'
in __result_ )
in C_Nonterminal_s23 v22
rule70 = \ inh_ nt_ ->
Map.singleton nt_ inh_
rule71 = \ nt_ syn_ ->
Map.singleton nt_ syn_
rule72 = \ ((_lhsIo_noGroup) :: [String]) ((_prodsIprdInh) :: Attributes) ->
Map.filterWithKey (\att _ -> elem (getName att) _lhsIo_noGroup) _prodsIprdInh
rule73 = \ ((_lhsIo_noGroup) :: [String]) syn_ ->
Map.filterWithKey (\att _ -> elem (getName att) _lhsIo_noGroup) syn_
rule74 = \ _inhNoGroup ->
map show $ Map.keys _inhNoGroup
rule75 = \ _synNoGroup ->
map show $ Map.keys _synNoGroup
rule76 = \ ((_lhsInewProds) :: DataTypes ) nt_ ->
case Map.lookup nt_ _lhsInewProds of
Just prds -> prds
Nothing -> Map.empty
rule77 = \ ((_prodsIhasMoreProds) :: Bool ) nt_ ->
if _prodsIhasMoreProds
then Set.singleton nt_
else Set.empty
rule78 = \ nt_ ->
pp nt_
rule79 = \ _ppNt ->
_ppNt
rule80 = \ ((_lhsIderivs) :: Derivings) ((_lhsInewNTs) :: Set NontermIdent) ((_lhsItSyns) :: TypeSyns) _ppNt ((_prodsIppDL) :: [PP_Doc]) nt_ ->
if (Set.member nt_ _lhsInewNTs)
then case (lookup nt_ _lhsItSyns) of
Nothing -> "data " >|< _ppNt
>|< " = " >|< vlist_sep " | " _prodsIppDL >-<
case (Map.lookup nt_ _lhsIderivs) of
Just ntds -> pp " deriving " >|< (ppListSep "(" ")" ", " $ Set.elems ntds)
Nothing -> empty
Just tp -> "type " >|< _ppNt >|< " = " >|< ppShow tp
else empty
rule81 = \ ((_lhsInewNTs) :: Set NontermIdent) _ppNt nt_ ->
if (not $ Set.member nt_ _lhsInewNTs)
then [ _ppNt ]
else [ ]
rule82 = \ _ppNt ->
"nt_" >|< _ppNt
rule83 = \ ((_lhsInewNTs) :: Set NontermIdent) _ntLabel _ppNt ((_prodsIppL) :: PP_Doc) nt_ ->
( if (Set.member nt_ _lhsInewNTs)
then _ntLabel >|< " = proxy :: Proxy " >|< _ppNt
else empty) >-<
_prodsIppL
rule84 = \ ((_lhsInewNTs) :: Set NontermIdent) _ntLabel ((_prodsIppLI) :: [PP_Doc]) nt_ ->
( if (not $ Set.member nt_ _lhsInewNTs)
then [ _ntLabel ]
else [ ]) ++
_prodsIppLI
rule85 = \ _inhNoGroup ((_lhsInewNTs) :: Set NontermIdent) _ppNt ((_prodsIppA) :: PP_Doc) _synNoGroup inh_ nt_ syn_ ->
( if (Set.member nt_ _lhsInewNTs)
then
defAttRec (pp "InhG") _ppNt inh_ _inhNoGroup >-<
defAttRec (pp "SynG") _ppNt syn_ _synNoGroup
else empty) >-<
_prodsIppA
rule86 = \ ((_lhsInewNTs) :: Set NontermIdent) _ppNt nt_ ->
if (not $ Set.member nt_ _lhsInewNTs)
then [ ppName [(pp "InhG"), _ppNt ] >#< pp "(..)", ppName [(pp "SynG"), _ppNt ] >#< pp "(..)" ]
else [ ]
rule87 = \ inh_ nt_ syn_ ->
[ ("nt_" >|< nt_, Map.union inh_ syn_) ]
rule88 = \ ((_lhsInewNTs) :: Set NontermIdent) nt_ ->
Set.member nt_ _lhsInewNTs
rule89 = \ ((_prodsIppR) :: PP_Doc) nt_ ->
pp "----" >|< pp nt_ >-< _prodsIppR
rule90 = \ _ppNt ((_prodsIppCata) :: PP_Doc) ->
"----" >|< _ppNt >-< _prodsIppCata
rule91 = \ syn_ ->
syn_
rule92 = \ inh_ ->
inh_
rule93 = \ _inhNoGroup _ppNt ((_prodsIppSPF) :: PP_Doc) _synNoGroup ->
let inhAtts = attTypes _inhNoGroup
synAtts = attTypes _synNoGroup
in
"----" >|< _ppNt >-<
"type T_" >|< _ppNt >|< " = " >|<
"(Record " >|<
inhAtts >|<
"(HCons (LVPair (Proxy Att_inh) InhG_" >|< _ppNt >|< ") HNil))" >|<
replicate (length inhAtts) ")" >|< " -> " >|<
"(Record " >|<
synAtts >|<
"(HCons (LVPair (Proxy Att_syn) SynG_" >|< _ppNt >|< ") HNil))" >|<
replicate (length synAtts) ")" >-<
"-- instance SemType T_" >|< _ppNt >|< " " >|< _ppNt >-<
"-- sem_" >|< _ppNt >|< " :: " >|< _ppNt >|< " -> T_" >|< _ppNt >-<
_prodsIppSPF
rule94 = \ _inhNoGroup _ppNt inh_ ->
ppName [pp "wrap", _ppNt ] >|< " sem " >|< attVars inh_ >|< " = " >-<
" sem " >|< attFields inh_ _inhNoGroup _ppNt
rule95 = \ ((_lhsIext) :: Maybe String) ->
_lhsIext
rule96 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
_lhsIinhMap
rule97 = \ ((_lhsInewAtts) :: Attributes ) ->
_lhsInewAtts
rule98 = \ ((_lhsIo_noGroup) :: [String]) ->
_lhsIo_noGroup
rule99 = \ ((_lhsIo_rename) :: Bool) ->
_lhsIo_rename
rule100 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
_lhsIsynMap
data Inh_Nonterminals = Inh_Nonterminals { derivs_Inh_Nonterminals :: (Derivings), ext_Inh_Nonterminals :: (Maybe String), inhMap_Inh_Nonterminals :: (Map Identifier Attributes), newAtts_Inh_Nonterminals :: ( Attributes ), newNTs_Inh_Nonterminals :: (Set NontermIdent), newProds_Inh_Nonterminals :: ( DataTypes ), o_noGroup_Inh_Nonterminals :: ([String]), o_rename_Inh_Nonterminals :: (Bool), synMap_Inh_Nonterminals :: (Map Identifier Attributes), tSyns_Inh_Nonterminals :: (TypeSyns) }
data Syn_Nonterminals = Syn_Nonterminals { extendedNTs_Syn_Nonterminals :: (Set NontermIdent), inhMap'_Syn_Nonterminals :: (Map Identifier Attributes), ppA_Syn_Nonterminals :: (PP_Doc), ppAI_Syn_Nonterminals :: ([PP_Doc]), ppCata_Syn_Nonterminals :: (PP_Doc), ppD_Syn_Nonterminals :: (PP_Doc), ppDI_Syn_Nonterminals :: ([PP_Doc]), ppL_Syn_Nonterminals :: (PP_Doc), ppLI_Syn_Nonterminals :: ([PP_Doc]), ppNtL_Syn_Nonterminals :: ([(PP_Doc, Attributes)]), ppR_Syn_Nonterminals :: (PP_Doc), ppSF_Syn_Nonterminals :: (PP_Doc), ppW_Syn_Nonterminals :: (PP_Doc), synMap'_Syn_Nonterminals :: (Map Identifier Attributes) }
wrap_Nonterminals :: T_Nonterminals -> Inh_Nonterminals -> (Syn_Nonterminals )
wrap_Nonterminals (T_Nonterminals act) (Inh_Nonterminals _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg25 = T_Nonterminals_vIn25 _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns
(T_Nonterminals_vOut25 _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap') <- return (inv_Nonterminals_s26 sem arg25)
return (Syn_Nonterminals _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap')
)
sem_Nonterminals :: Nonterminals -> T_Nonterminals
sem_Nonterminals list = Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list)
newtype T_Nonterminals = T_Nonterminals {
attach_T_Nonterminals :: Identity (T_Nonterminals_s26 )
}
newtype T_Nonterminals_s26 = C_Nonterminals_s26 {
inv_Nonterminals_s26 :: (T_Nonterminals_v25 )
}
data T_Nonterminals_s27 = C_Nonterminals_s27
type T_Nonterminals_v25 = (T_Nonterminals_vIn25 ) -> (T_Nonterminals_vOut25 )
data T_Nonterminals_vIn25 = T_Nonterminals_vIn25 (Derivings) (Maybe String) (Map Identifier Attributes) ( Attributes ) (Set NontermIdent) ( DataTypes ) ([String]) (Bool) (Map Identifier Attributes) (TypeSyns)
data T_Nonterminals_vOut25 = T_Nonterminals_vOut25 (Set NontermIdent) (Map Identifier Attributes) (PP_Doc) ([PP_Doc]) (PP_Doc) (PP_Doc) ([PP_Doc]) (PP_Doc) ([PP_Doc]) ([(PP_Doc, Attributes)]) (PP_Doc) (PP_Doc) (PP_Doc) (Map Identifier Attributes)
sem_Nonterminals_Cons :: T_Nonterminal -> T_Nonterminals -> T_Nonterminals
sem_Nonterminals_Cons arg_hd_ arg_tl_ = T_Nonterminals (return st26) where
st26 = let
v25 :: T_Nonterminals_v25
v25 = \ (T_Nonterminals_vIn25 _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns) -> ( let
_hdX23 = Control.Monad.Identity.runIdentity (attach_T_Nonterminal (arg_hd_))
_tlX26 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_tl_))
(T_Nonterminal_vOut22 _hdIextendedNTs _hdIinhMap' _hdIppA _hdIppAI _hdIppCata _hdIppD _hdIppDI _hdIppL _hdIppLI _hdIppNtL _hdIppR _hdIppSF _hdIppW _hdIsynMap') = inv_Nonterminal_s23 _hdX23 (T_Nonterminal_vIn22 _hdOderivs _hdOext _hdOinhMap _hdOnewAtts _hdOnewNTs _hdOnewProds _hdOo_noGroup _hdOo_rename _hdOsynMap _hdOtSyns)
(T_Nonterminals_vOut25 _tlIextendedNTs _tlIinhMap' _tlIppA _tlIppAI _tlIppCata _tlIppD _tlIppDI _tlIppL _tlIppLI _tlIppNtL _tlIppR _tlIppSF _tlIppW _tlIsynMap') = inv_Nonterminals_s26 _tlX26 (T_Nonterminals_vIn25 _tlOderivs _tlOext _tlOinhMap _tlOnewAtts _tlOnewNTs _tlOnewProds _tlOo_noGroup _tlOo_rename _tlOsynMap _tlOtSyns)
_lhsOextendedNTs :: Set NontermIdent
_lhsOextendedNTs = rule101 _hdIextendedNTs _tlIextendedNTs
_lhsOinhMap' :: Map Identifier Attributes
_lhsOinhMap' = rule102 _hdIinhMap' _tlIinhMap'
_lhsOppA :: PP_Doc
_lhsOppA = rule103 _hdIppA _tlIppA
_lhsOppAI :: [PP_Doc]
_lhsOppAI = rule104 _hdIppAI _tlIppAI
_lhsOppCata :: PP_Doc
_lhsOppCata = rule105 _hdIppCata _tlIppCata
_lhsOppD :: PP_Doc
_lhsOppD = rule106 _hdIppD _tlIppD
_lhsOppDI :: [PP_Doc]
_lhsOppDI = rule107 _hdIppDI _tlIppDI
_lhsOppL :: PP_Doc
_lhsOppL = rule108 _hdIppL _tlIppL
_lhsOppLI :: [PP_Doc]
_lhsOppLI = rule109 _hdIppLI _tlIppLI
_lhsOppNtL :: [(PP_Doc, Attributes)]
_lhsOppNtL = rule110 _hdIppNtL _tlIppNtL
_lhsOppR :: PP_Doc
_lhsOppR = rule111 _hdIppR _tlIppR
_lhsOppSF :: PP_Doc
_lhsOppSF = rule112 _hdIppSF _tlIppSF
_lhsOppW :: PP_Doc
_lhsOppW = rule113 _hdIppW _tlIppW
_lhsOsynMap' :: Map Identifier Attributes
_lhsOsynMap' = rule114 _hdIsynMap' _tlIsynMap'
_hdOderivs = rule115 _lhsIderivs
_hdOext = rule116 _lhsIext
_hdOinhMap = rule117 _lhsIinhMap
_hdOnewAtts = rule118 _lhsInewAtts
_hdOnewNTs = rule119 _lhsInewNTs
_hdOnewProds = rule120 _lhsInewProds
_hdOo_noGroup = rule121 _lhsIo_noGroup
_hdOo_rename = rule122 _lhsIo_rename
_hdOsynMap = rule123 _lhsIsynMap
_hdOtSyns = rule124 _lhsItSyns
_tlOderivs = rule125 _lhsIderivs
_tlOext = rule126 _lhsIext
_tlOinhMap = rule127 _lhsIinhMap
_tlOnewAtts = rule128 _lhsInewAtts
_tlOnewNTs = rule129 _lhsInewNTs
_tlOnewProds = rule130 _lhsInewProds
_tlOo_noGroup = rule131 _lhsIo_noGroup
_tlOo_rename = rule132 _lhsIo_rename
_tlOsynMap = rule133 _lhsIsynMap
_tlOtSyns = rule134 _lhsItSyns
__result_ = T_Nonterminals_vOut25 _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap'
in __result_ )
in C_Nonterminals_s26 v25
rule101 = \ ((_hdIextendedNTs) :: Set NontermIdent) ((_tlIextendedNTs) :: Set NontermIdent) ->
_hdIextendedNTs `Set.union` _tlIextendedNTs
rule102 = \ ((_hdIinhMap') :: Map Identifier Attributes) ((_tlIinhMap') :: Map Identifier Attributes) ->
_hdIinhMap' `Map.union` _tlIinhMap'
rule103 = \ ((_hdIppA) :: PP_Doc) ((_tlIppA) :: PP_Doc) ->
_hdIppA >-< _tlIppA
rule104 = \ ((_hdIppAI) :: [PP_Doc]) ((_tlIppAI) :: [PP_Doc]) ->
_hdIppAI ++ _tlIppAI
rule105 = \ ((_hdIppCata) :: PP_Doc) ((_tlIppCata) :: PP_Doc) ->
_hdIppCata >-< _tlIppCata
rule106 = \ ((_hdIppD) :: PP_Doc) ((_tlIppD) :: PP_Doc) ->
_hdIppD >-< _tlIppD
rule107 = \ ((_hdIppDI) :: [PP_Doc]) ((_tlIppDI) :: [PP_Doc]) ->
_hdIppDI ++ _tlIppDI
rule108 = \ ((_hdIppL) :: PP_Doc) ((_tlIppL) :: PP_Doc) ->
_hdIppL >-< _tlIppL
rule109 = \ ((_hdIppLI) :: [PP_Doc]) ((_tlIppLI) :: [PP_Doc]) ->
_hdIppLI ++ _tlIppLI
rule110 = \ ((_hdIppNtL) :: [(PP_Doc, Attributes)]) ((_tlIppNtL) :: [(PP_Doc, Attributes)]) ->
_hdIppNtL ++ _tlIppNtL
rule111 = \ ((_hdIppR) :: PP_Doc) ((_tlIppR) :: PP_Doc) ->
_hdIppR >-< _tlIppR
rule112 = \ ((_hdIppSF) :: PP_Doc) ((_tlIppSF) :: PP_Doc) ->
_hdIppSF >-< _tlIppSF
rule113 = \ ((_hdIppW) :: PP_Doc) ((_tlIppW) :: PP_Doc) ->
_hdIppW >-< _tlIppW
rule114 = \ ((_hdIsynMap') :: Map Identifier Attributes) ((_tlIsynMap') :: Map Identifier Attributes) ->
_hdIsynMap' `Map.union` _tlIsynMap'
rule115 = \ ((_lhsIderivs) :: Derivings) ->
_lhsIderivs
rule116 = \ ((_lhsIext) :: Maybe String) ->
_lhsIext
rule117 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
_lhsIinhMap
rule118 = \ ((_lhsInewAtts) :: Attributes ) ->
_lhsInewAtts
rule119 = \ ((_lhsInewNTs) :: Set NontermIdent) ->
_lhsInewNTs
rule120 = \ ((_lhsInewProds) :: DataTypes ) ->
_lhsInewProds
rule121 = \ ((_lhsIo_noGroup) :: [String]) ->
_lhsIo_noGroup
rule122 = \ ((_lhsIo_rename) :: Bool) ->
_lhsIo_rename
rule123 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
_lhsIsynMap
rule124 = \ ((_lhsItSyns) :: TypeSyns) ->
_lhsItSyns
rule125 = \ ((_lhsIderivs) :: Derivings) ->
_lhsIderivs
rule126 = \ ((_lhsIext) :: Maybe String) ->
_lhsIext
rule127 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
_lhsIinhMap
rule128 = \ ((_lhsInewAtts) :: Attributes ) ->
_lhsInewAtts
rule129 = \ ((_lhsInewNTs) :: Set NontermIdent) ->
_lhsInewNTs
rule130 = \ ((_lhsInewProds) :: DataTypes ) ->
_lhsInewProds
rule131 = \ ((_lhsIo_noGroup) :: [String]) ->
_lhsIo_noGroup
rule132 = \ ((_lhsIo_rename) :: Bool) ->
_lhsIo_rename
rule133 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
_lhsIsynMap
rule134 = \ ((_lhsItSyns) :: TypeSyns) ->
_lhsItSyns
sem_Nonterminals_Nil :: T_Nonterminals
sem_Nonterminals_Nil = T_Nonterminals (return st26) where
st26 = let
v25 :: T_Nonterminals_v25
v25 = \ (T_Nonterminals_vIn25 _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns) -> ( let
_lhsOextendedNTs :: Set NontermIdent
_lhsOextendedNTs = rule135 ()
_lhsOinhMap' :: Map Identifier Attributes
_lhsOinhMap' = rule136 ()
_lhsOppA :: PP_Doc
_lhsOppA = rule137 ()
_lhsOppAI :: [PP_Doc]
_lhsOppAI = rule138 ()
_lhsOppCata :: PP_Doc
_lhsOppCata = rule139 ()
_lhsOppD :: PP_Doc
_lhsOppD = rule140 ()
_lhsOppDI :: [PP_Doc]
_lhsOppDI = rule141 ()
_lhsOppL :: PP_Doc
_lhsOppL = rule142 ()
_lhsOppLI :: [PP_Doc]
_lhsOppLI = rule143 ()
_lhsOppNtL :: [(PP_Doc, Attributes)]
_lhsOppNtL = rule144 ()
_lhsOppR :: PP_Doc
_lhsOppR = rule145 ()
_lhsOppSF :: PP_Doc
_lhsOppSF = rule146 ()
_lhsOppW :: PP_Doc
_lhsOppW = rule147 ()
_lhsOsynMap' :: Map Identifier Attributes
_lhsOsynMap' = rule148 ()
__result_ = T_Nonterminals_vOut25 _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap'
in __result_ )
in C_Nonterminals_s26 v25
rule135 = \ (_ :: ()) ->
Set.empty
rule136 = \ (_ :: ()) ->
Map.empty
rule137 = \ (_ :: ()) ->
empty
rule138 = \ (_ :: ()) ->
[]
rule139 = \ (_ :: ()) ->
empty
rule140 = \ (_ :: ()) ->
empty
rule141 = \ (_ :: ()) ->
[]
rule142 = \ (_ :: ()) ->
empty
rule143 = \ (_ :: ()) ->
[]
rule144 = \ (_ :: ()) ->
[]
rule145 = \ (_ :: ()) ->
empty
rule146 = \ (_ :: ()) ->
empty
rule147 = \ (_ :: ()) ->
empty
rule148 = \ (_ :: ()) ->
Map.empty
data Inh_Pattern = Inh_Pattern { }
data Syn_Pattern = Syn_Pattern { copy_Syn_Pattern :: (Pattern), info_Syn_Pattern :: ((Identifier, Identifier)) }
wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern )
wrap_Pattern (T_Pattern act) (Inh_Pattern ) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg28 = T_Pattern_vIn28
(T_Pattern_vOut28 _lhsOcopy _lhsOinfo) <- return (inv_Pattern_s29 sem arg28)
return (Syn_Pattern _lhsOcopy _lhsOinfo)
)
sem_Pattern :: Pattern -> T_Pattern
sem_Pattern ( Constr name_ pats_ ) = sem_Pattern_Constr name_ ( sem_Patterns pats_ )
sem_Pattern ( Product pos_ pats_ ) = sem_Pattern_Product pos_ ( sem_Patterns pats_ )
sem_Pattern ( Alias field_ attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ )
sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ )
sem_Pattern ( Underscore pos_ ) = sem_Pattern_Underscore pos_
newtype T_Pattern = T_Pattern {
attach_T_Pattern :: Identity (T_Pattern_s29 )
}
newtype T_Pattern_s29 = C_Pattern_s29 {
inv_Pattern_s29 :: (T_Pattern_v28 )
}
data T_Pattern_s30 = C_Pattern_s30
type T_Pattern_v28 = (T_Pattern_vIn28 ) -> (T_Pattern_vOut28 )
data T_Pattern_vIn28 = T_Pattern_vIn28
data T_Pattern_vOut28 = T_Pattern_vOut28 (Pattern) ((Identifier, Identifier))
sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern
sem_Pattern_Constr arg_name_ arg_pats_ = T_Pattern (return st29) where
st29 = let
v28 :: T_Pattern_v28
v28 = \ (T_Pattern_vIn28 ) -> ( let
_patsX32 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_))
(T_Patterns_vOut31 _patsIcopy) = inv_Patterns_s32 _patsX32 (T_Patterns_vIn31 )
_lhsOinfo :: (Identifier, Identifier)
_lhsOinfo = rule149 ()
_copy = rule150 _patsIcopy arg_name_
_lhsOcopy :: Pattern
_lhsOcopy = rule151 _copy
__result_ = T_Pattern_vOut28 _lhsOcopy _lhsOinfo
in __result_ )
in C_Pattern_s29 v28
rule149 = \ (_ :: ()) ->
error "Pattern Constr undefined!!"
rule150 = \ ((_patsIcopy) :: Patterns) name_ ->
Constr name_ _patsIcopy
rule151 = \ _copy ->
_copy
sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern
sem_Pattern_Product arg_pos_ arg_pats_ = T_Pattern (return st29) where
st29 = let
v28 :: T_Pattern_v28
v28 = \ (T_Pattern_vIn28 ) -> ( let
_patsX32 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_))
(T_Patterns_vOut31 _patsIcopy) = inv_Patterns_s32 _patsX32 (T_Patterns_vIn31 )
_lhsOinfo :: (Identifier, Identifier)
_lhsOinfo = rule152 ()
_copy = rule153 _patsIcopy arg_pos_
_lhsOcopy :: Pattern
_lhsOcopy = rule154 _copy
__result_ = T_Pattern_vOut28 _lhsOcopy _lhsOinfo
in __result_ )
in C_Pattern_s29 v28
rule152 = \ (_ :: ()) ->
error "Pattern Product undefined!!"
rule153 = \ ((_patsIcopy) :: Patterns) pos_ ->
Product pos_ _patsIcopy
rule154 = \ _copy ->
_copy
sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern
sem_Pattern_Alias arg_field_ arg_attr_ arg_pat_ = T_Pattern (return st29) where
st29 = let
v28 :: T_Pattern_v28
v28 = \ (T_Pattern_vIn28 ) -> ( let
_patX29 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_))
(T_Pattern_vOut28 _patIcopy _patIinfo) = inv_Pattern_s29 _patX29 (T_Pattern_vIn28 )
_lhsOinfo :: (Identifier, Identifier)
_lhsOinfo = rule155 arg_attr_ arg_field_
_copy = rule156 _patIcopy arg_attr_ arg_field_
_lhsOcopy :: Pattern
_lhsOcopy = rule157 _copy
__result_ = T_Pattern_vOut28 _lhsOcopy _lhsOinfo
in __result_ )
in C_Pattern_s29 v28
rule155 = \ attr_ field_ ->
(field_, attr_)
rule156 = \ ((_patIcopy) :: Pattern) attr_ field_ ->
Alias field_ attr_ _patIcopy
rule157 = \ _copy ->
_copy
sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern
sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st29) where
st29 = let
v28 :: T_Pattern_v28
v28 = \ (T_Pattern_vIn28 ) -> ( let
_patX29 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_))
(T_Pattern_vOut28 _patIcopy _patIinfo) = inv_Pattern_s29 _patX29 (T_Pattern_vIn28 )
_copy = rule158 _patIcopy
_lhsOcopy :: Pattern
_lhsOcopy = rule159 _copy
_lhsOinfo :: (Identifier, Identifier)
_lhsOinfo = rule160 _patIinfo
__result_ = T_Pattern_vOut28 _lhsOcopy _lhsOinfo
in __result_ )
in C_Pattern_s29 v28
rule158 = \ ((_patIcopy) :: Pattern) ->
Irrefutable _patIcopy
rule159 = \ _copy ->
_copy
rule160 = \ ((_patIinfo) :: (Identifier, Identifier)) ->
_patIinfo
sem_Pattern_Underscore :: (Pos) -> T_Pattern
sem_Pattern_Underscore arg_pos_ = T_Pattern (return st29) where
st29 = let
v28 :: T_Pattern_v28
v28 = \ (T_Pattern_vIn28 ) -> ( let
_lhsOinfo :: (Identifier, Identifier)
_lhsOinfo = rule161 ()
_copy = rule162 arg_pos_
_lhsOcopy :: Pattern
_lhsOcopy = rule163 _copy
__result_ = T_Pattern_vOut28 _lhsOcopy _lhsOinfo
in __result_ )
in C_Pattern_s29 v28
rule161 = \ (_ :: ()) ->
error "Pattern Underscore undefined!!"
rule162 = \ pos_ ->
Underscore pos_
rule163 = \ _copy ->
_copy
data Inh_Patterns = Inh_Patterns { }
data Syn_Patterns = Syn_Patterns { copy_Syn_Patterns :: (Patterns) }
wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns )
wrap_Patterns (T_Patterns act) (Inh_Patterns ) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg31 = T_Patterns_vIn31
(T_Patterns_vOut31 _lhsOcopy) <- return (inv_Patterns_s32 sem arg31)
return (Syn_Patterns _lhsOcopy)
)
sem_Patterns :: Patterns -> T_Patterns
sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list)
newtype T_Patterns = T_Patterns {
attach_T_Patterns :: Identity (T_Patterns_s32 )
}
newtype T_Patterns_s32 = C_Patterns_s32 {
inv_Patterns_s32 :: (T_Patterns_v31 )
}
data T_Patterns_s33 = C_Patterns_s33
type T_Patterns_v31 = (T_Patterns_vIn31 ) -> (T_Patterns_vOut31 )
data T_Patterns_vIn31 = T_Patterns_vIn31
data T_Patterns_vOut31 = T_Patterns_vOut31 (Patterns)
sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns
sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st32) where
st32 = let
v31 :: T_Patterns_v31
v31 = \ (T_Patterns_vIn31 ) -> ( let
_hdX29 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_))
_tlX32 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_))
(T_Pattern_vOut28 _hdIcopy _hdIinfo) = inv_Pattern_s29 _hdX29 (T_Pattern_vIn28 )
(T_Patterns_vOut31 _tlIcopy) = inv_Patterns_s32 _tlX32 (T_Patterns_vIn31 )
_copy = rule164 _hdIcopy _tlIcopy
_lhsOcopy :: Patterns
_lhsOcopy = rule165 _copy
__result_ = T_Patterns_vOut31 _lhsOcopy
in __result_ )
in C_Patterns_s32 v31
rule164 = \ ((_hdIcopy) :: Pattern) ((_tlIcopy) :: Patterns) ->
(:) _hdIcopy _tlIcopy
rule165 = \ _copy ->
_copy
sem_Patterns_Nil :: T_Patterns
sem_Patterns_Nil = T_Patterns (return st32) where
st32 = let
v31 :: T_Patterns_v31
v31 = \ (T_Patterns_vIn31 ) -> ( let
_copy = rule166 ()
_lhsOcopy :: Patterns
_lhsOcopy = rule167 _copy
__result_ = T_Patterns_vOut31 _lhsOcopy
in __result_ )
in C_Patterns_s32 v31
rule166 = \ (_ :: ()) ->
[]
rule167 = \ _copy ->
_copy
data Inh_Production = Inh_Production { ext_Inh_Production :: (Maybe String), inh_Inh_Production :: ( Attributes ), inhMap_Inh_Production :: (Map Identifier Attributes), inhNoGroup_Inh_Production :: ([String]), newAtts_Inh_Production :: ( Attributes ), newNT_Inh_Production :: (Bool), newProds_Inh_Production :: ( Map.Map ConstructorIdent FieldMap ), o_noGroup_Inh_Production :: ([String]), o_rename_Inh_Production :: (Bool), ppNt_Inh_Production :: (PP_Doc), syn_Inh_Production :: ( Attributes ), synMap_Inh_Production :: (Map Identifier Attributes), synNoGroup_Inh_Production :: ([String]) }
data Syn_Production = Syn_Production { hasMoreProds_Syn_Production :: ( Bool ), ppA_Syn_Production :: (PP_Doc), ppCata_Syn_Production :: (PP_Doc), ppD_Syn_Production :: (PP_Doc), ppDI_Syn_Production :: ([PP_Doc]), ppL_Syn_Production :: (PP_Doc), ppLI_Syn_Production :: ([PP_Doc]), ppR_Syn_Production :: (PP_Doc), ppRA_Syn_Production :: ([PP_Doc]), ppSF_Syn_Production :: (PP_Doc), ppSPF_Syn_Production :: (PP_Doc), prdInh_Syn_Production :: (Attributes) }
wrap_Production :: T_Production -> Inh_Production -> (Syn_Production )
wrap_Production (T_Production act) (Inh_Production _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg34 = T_Production_vIn34 _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup
(T_Production_vOut34 _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh) <- return (inv_Production_s35 sem arg34)
return (Syn_Production _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh)
)
sem_Production :: Production -> T_Production
sem_Production ( Production con_ params_ constraints_ children_ rules_ typeSigs_ macro_ ) = sem_Production_Production con_ params_ constraints_ ( sem_Children children_ ) ( sem_Rules rules_ ) ( sem_TypeSigs typeSigs_ ) macro_
newtype T_Production = T_Production {
attach_T_Production :: Identity (T_Production_s35 )
}
newtype T_Production_s35 = C_Production_s35 {
inv_Production_s35 :: (T_Production_v34 )
}
data T_Production_s36 = C_Production_s36
type T_Production_v34 = (T_Production_vIn34 ) -> (T_Production_vOut34 )
data T_Production_vIn34 = T_Production_vIn34 (Maybe String) ( Attributes ) (Map Identifier Attributes) ([String]) ( Attributes ) (Bool) ( Map.Map ConstructorIdent FieldMap ) ([String]) (Bool) (PP_Doc) ( Attributes ) (Map Identifier Attributes) ([String])
data T_Production_vOut34 = T_Production_vOut34 ( Bool ) (PP_Doc) (PP_Doc) (PP_Doc) ([PP_Doc]) (PP_Doc) ([PP_Doc]) (PP_Doc) ([PP_Doc]) (PP_Doc) (PP_Doc) (Attributes)
sem_Production_Production :: (ConstructorIdent) -> ([Identifier]) -> ([Type]) -> T_Children -> T_Rules -> T_TypeSigs -> (MaybeMacro) -> T_Production
sem_Production_Production arg_con_ _ _ arg_children_ arg_rules_ arg_typeSigs_ arg_macro_ = T_Production (return st35) where
st35 = let
v34 :: T_Production_v34
v34 = \ (T_Production_vIn34 _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup) -> ( let
_childrenX5 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_children_))
_rulesX44 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_rules_))
_typeSigsX50 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_typeSigs_))
(T_Children_vOut4 _childrenIidCL _childrenIppCSF _childrenIppDL _childrenIppL _childrenIppLI _childrenIppR _childrenIprdInh) = inv_Children_s5 _childrenX5 (T_Children_vIn4 _childrenOext _childrenOinhMap _childrenOinhNoGroup _childrenOnewAtts _childrenOo_noGroup _childrenOo_rename _childrenOppNt _childrenOppProd _childrenOsynMap _childrenOsynNoGroup)
(T_Rules_vOut43 _rulesIlocals _rulesIppRL) = inv_Rules_s44 _rulesX44 (T_Rules_vIn43 _rulesOext _rulesOinhNoGroup _rulesOnewAtts _rulesOnewProd _rulesOo_noGroup _rulesOppNt _rulesOppProd _rulesOsynNoGroup)
(T_TypeSigs_vOut49 ) = inv_TypeSigs_s50 _typeSigsX50 (T_TypeSigs_vIn49 )
_lhsOhasMoreProds :: Bool
_lhsOhasMoreProds = rule168 _lhsInewProds arg_con_
_ppProd = rule169 arg_con_
_prodName = rule170 _lhsIppNt _ppProd
_conName = rule171 _lhsIo_rename _ppProd _prodName
_childrenOppProd = rule172 _ppProd
_rulesOppProd = rule173 _ppProd
_lhsOppD :: PP_Doc
_lhsOppD = rule174 _childrenIppDL _conName
_lhsOppL :: PP_Doc
_lhsOppL = rule175 _childrenIppL _lhsInewProds arg_con_
_lhsOppLI :: [PP_Doc]
_lhsOppLI = rule176 _childrenIppLI _lhsInewProds arg_con_
_lhsOppA :: PP_Doc
_lhsOppA = rule177 _prodName _rulesIlocals
_newProd = rule178 _lhsInewProds arg_con_
(_ppR,_ppRA) = rule179 _childrenIidCL _childrenIppR _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsIppNt _lhsIsynNoGroup _newProd _prodName _rulesIlocals _rulesIppRL arg_con_
_lhsOppCata :: PP_Doc
_lhsOppCata = rule180 _lhsIext _lhsInewNT _newProd _ppRA _prodName arg_macro_
_lhsOppSF :: PP_Doc
_lhsOppSF = rule181 _childrenIppCSF _conName _lhsIppNt _prodName arg_con_
_lhsOppSPF :: PP_Doc
_lhsOppSPF = rule182 _childrenIppCSF _lhsIppNt _prodName arg_con_
_lhsOppDI :: [PP_Doc]
_lhsOppDI = rule183 ()
_lhsOppR :: PP_Doc
_lhsOppR = rule184 _ppR
_lhsOppRA :: [PP_Doc]
_lhsOppRA = rule185 _ppRA
_lhsOprdInh :: Attributes
_lhsOprdInh = rule186 _childrenIprdInh
_childrenOext = rule187 _lhsIext
_childrenOinhMap = rule188 _lhsIinhMap
_childrenOinhNoGroup = rule189 _lhsIinhNoGroup
_childrenOnewAtts = rule190 _lhsInewAtts
_childrenOo_noGroup = rule191 _lhsIo_noGroup
_childrenOo_rename = rule192 _lhsIo_rename
_childrenOppNt = rule193 _lhsIppNt
_childrenOsynMap = rule194 _lhsIsynMap
_childrenOsynNoGroup = rule195 _lhsIsynNoGroup
_rulesOext = rule196 _lhsIext
_rulesOinhNoGroup = rule197 _lhsIinhNoGroup
_rulesOnewAtts = rule198 _lhsInewAtts
_rulesOnewProd = rule199 _newProd
_rulesOo_noGroup = rule200 _lhsIo_noGroup
_rulesOppNt = rule201 _lhsIppNt
_rulesOsynNoGroup = rule202 _lhsIsynNoGroup
__result_ = T_Production_vOut34 _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh
in __result_ )
in C_Production_s35 v34
rule168 = \ ((_lhsInewProds) :: Map.Map ConstructorIdent FieldMap ) con_ ->
not $ Map.member con_ _lhsInewProds
rule169 = \ con_ ->
pp con_
rule170 = \ ((_lhsIppNt) :: PP_Doc) _ppProd ->
ppName [_lhsIppNt, _ppProd ]
rule171 = \ ((_lhsIo_rename) :: Bool) _ppProd _prodName ->
if _lhsIo_rename
then _prodName
else _ppProd
rule172 = \ _ppProd ->
_ppProd
rule173 = \ _ppProd ->
_ppProd
rule174 = \ ((_childrenIppDL) :: [PP_Doc]) _conName ->
_conName >|< ppListSep " {" "}" ", " _childrenIppDL
rule175 = \ ((_childrenIppL) :: PP_Doc) ((_lhsInewProds) :: Map.Map ConstructorIdent FieldMap ) con_ ->
if (Map.member con_ _lhsInewProds)
then _childrenIppL
else empty
rule176 = \ ((_childrenIppLI) :: [PP_Doc]) ((_lhsInewProds) :: Map.Map ConstructorIdent FieldMap ) con_ ->
if (not $ Map.member con_ _lhsInewProds)
then _childrenIppLI
else []
rule177 = \ _prodName ((_rulesIlocals) :: [Identifier]) ->
defLocalAtts _prodName (length _rulesIlocals) 1 $ sort _rulesIlocals
rule178 = \ ((_lhsInewProds) :: Map.Map ConstructorIdent FieldMap ) con_ ->
Map.member con_ _lhsInewProds
rule179 = \ ((_childrenIidCL) :: [(Identifier,Type)]) ((_childrenIppR) :: PP_Doc) ((_lhsIinhNoGroup) :: [String]) ((_lhsInewAtts) :: Attributes ) ((_lhsInewNT) :: Bool) ((_lhsIppNt) :: PP_Doc) ((_lhsIsynNoGroup) :: [String]) _newProd _prodName ((_rulesIlocals) :: [Identifier]) ((_rulesIppRL) :: [ PPRule ]) con_ ->
let (instR, instRA) = defInstRules _lhsIppNt con_ _lhsInewNT _newProd
_childrenIppR _rulesIppRL _childrenIidCL _rulesIlocals
(locR, locRA) = defLocRule _lhsIppNt con_ _lhsInewNT _newProd
_childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals
(inhGR, inhGRA) = defInhGRule _lhsIppNt _prodName _lhsInewNT _newProd
_childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals
(synGR, synGRA) = defSynGRule _lhsIppNt con_ _lhsInewNT _newProd
_childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals
(inhR, inhRA) = defInhRules _lhsIppNt _prodName _lhsInewNT _newProd _lhsInewAtts
_childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals
(synR, synRA) = defSynRules _lhsIppNt con_ _lhsInewNT _newProd _lhsInewAtts
_childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals
(inhMR, inhMRA) = modInhRules _lhsIppNt _prodName _lhsInewNT _newProd _lhsInewAtts
_childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals
(synMR, synMRA) = modSynRules _lhsIppNt con_ _lhsInewNT _newProd _lhsInewAtts
_childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals
in ( vlist [instR,locR,inhGR,synGR,inhR,synR,inhMR,synMR]
, instRA ++ locRA ++ inhGRA ++ synGRA ++ inhMRA ++ synMRA ++ inhRA ++ synRA)
rule180 = \ ((_lhsIext) :: Maybe String) ((_lhsInewNT) :: Bool) _newProd _ppRA _prodName macro_ ->
let extend = maybe []
( \ext -> if (_lhsInewNT || (not _lhsInewNT && _newProd ))
then []
else [ ext >|< ".atts_" >|< _prodName ])
_lhsIext
macro = case macro_ of
Nothing -> []
Just macro -> [ "agMacro " >|< ppMacro macro ]
atts = sortBy (\a b -> compare (show a) (show b)) _ppRA
in "atts_" >|< _prodName >|< " = " >|<
ppListSep "" "" " `ext` "
(atts ++ macro ++ extend ) >-<
"semP_" >|< _prodName >|< pp " = knit atts_" >|< _prodName
rule181 = \ ((_childrenIppCSF) :: [(Identifier,(PP_Doc,PP_Doc))]) _conName ((_lhsIppNt) :: PP_Doc) _prodName con_ ->
let chi = _childrenIppCSF
ppPattern = case (show con_) of
"Cons" -> ppParams (ppListSep "" "" " : ")
"Nil" -> pp "[]"
otherwise -> _conName >|< " " >|< (ppParams ppSpaced)
ppParams f = f $ map (((>|<) (pp "_")) . fst) chi
in "sem_" >|< _lhsIppNt >|< " (" >|< ppPattern >|< ") = sem_" >|< _prodName >|<
" (" >|< map (fst . snd) chi >|< "emptyRecord)"
rule182 = \ ((_childrenIppCSF) :: [(Identifier,(PP_Doc,PP_Doc))]) ((_lhsIppNt) :: PP_Doc) _prodName con_ ->
let chi = _childrenIppCSF
ppParams f = f $ map (((>|<) (pp "_")) . fst) chi
in "sem_" >|< _lhsIppNt >|< "_" >|< con_ >#< ppParams ppSpaced >|< " = semP_" >|< _prodName >|<
" (" >|< map (snd . snd) chi >|< "emptyRecord)"
rule183 = \ (_ :: ()) ->
[]
rule184 = \ _ppR ->
_ppR
rule185 = \ _ppRA ->
_ppRA
rule186 = \ ((_childrenIprdInh) :: Attributes) ->
_childrenIprdInh
rule187 = \ ((_lhsIext) :: Maybe String) ->
_lhsIext
rule188 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
_lhsIinhMap
rule189 = \ ((_lhsIinhNoGroup) :: [String]) ->
_lhsIinhNoGroup
rule190 = \ ((_lhsInewAtts) :: Attributes ) ->
_lhsInewAtts
rule191 = \ ((_lhsIo_noGroup) :: [String]) ->
_lhsIo_noGroup
rule192 = \ ((_lhsIo_rename) :: Bool) ->
_lhsIo_rename
rule193 = \ ((_lhsIppNt) :: PP_Doc) ->
_lhsIppNt
rule194 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
_lhsIsynMap
rule195 = \ ((_lhsIsynNoGroup) :: [String]) ->
_lhsIsynNoGroup
rule196 = \ ((_lhsIext) :: Maybe String) ->
_lhsIext
rule197 = \ ((_lhsIinhNoGroup) :: [String]) ->
_lhsIinhNoGroup
rule198 = \ ((_lhsInewAtts) :: Attributes ) ->
_lhsInewAtts
rule199 = \ _newProd ->
_newProd
rule200 = \ ((_lhsIo_noGroup) :: [String]) ->
_lhsIo_noGroup
rule201 = \ ((_lhsIppNt) :: PP_Doc) ->
_lhsIppNt
rule202 = \ ((_lhsIsynNoGroup) :: [String]) ->
_lhsIsynNoGroup
data Inh_Productions = Inh_Productions { ext_Inh_Productions :: (Maybe String), inh_Inh_Productions :: ( Attributes ), inhMap_Inh_Productions :: (Map Identifier Attributes), inhNoGroup_Inh_Productions :: ([String]), newAtts_Inh_Productions :: ( Attributes ), newNT_Inh_Productions :: (Bool), newProds_Inh_Productions :: ( Map.Map ConstructorIdent FieldMap ), o_noGroup_Inh_Productions :: ([String]), o_rename_Inh_Productions :: (Bool), ppNt_Inh_Productions :: (PP_Doc), syn_Inh_Productions :: ( Attributes ), synMap_Inh_Productions :: (Map Identifier Attributes), synNoGroup_Inh_Productions :: ([String]) }
data Syn_Productions = Syn_Productions { hasMoreProds_Syn_Productions :: ( Bool ), ppA_Syn_Productions :: (PP_Doc), ppCata_Syn_Productions :: (PP_Doc), ppDL_Syn_Productions :: ([PP_Doc]), ppL_Syn_Productions :: (PP_Doc), ppLI_Syn_Productions :: ([PP_Doc]), ppR_Syn_Productions :: (PP_Doc), ppRA_Syn_Productions :: ([PP_Doc]), ppSF_Syn_Productions :: (PP_Doc), ppSPF_Syn_Productions :: (PP_Doc), prdInh_Syn_Productions :: (Attributes) }
wrap_Productions :: T_Productions -> Inh_Productions -> (Syn_Productions )
wrap_Productions (T_Productions act) (Inh_Productions _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg37 = T_Productions_vIn37 _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup
(T_Productions_vOut37 _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh) <- return (inv_Productions_s38 sem arg37)
return (Syn_Productions _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh)
)
sem_Productions :: Productions -> T_Productions
sem_Productions list = Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list)
newtype T_Productions = T_Productions {
attach_T_Productions :: Identity (T_Productions_s38 )
}
newtype T_Productions_s38 = C_Productions_s38 {
inv_Productions_s38 :: (T_Productions_v37 )
}
data T_Productions_s39 = C_Productions_s39
type T_Productions_v37 = (T_Productions_vIn37 ) -> (T_Productions_vOut37 )
data T_Productions_vIn37 = T_Productions_vIn37 (Maybe String) ( Attributes ) (Map Identifier Attributes) ([String]) ( Attributes ) (Bool) ( Map.Map ConstructorIdent FieldMap ) ([String]) (Bool) (PP_Doc) ( Attributes ) (Map Identifier Attributes) ([String])
data T_Productions_vOut37 = T_Productions_vOut37 ( Bool ) (PP_Doc) (PP_Doc) ([PP_Doc]) (PP_Doc) ([PP_Doc]) (PP_Doc) ([PP_Doc]) (PP_Doc) (PP_Doc) (Attributes)
sem_Productions_Cons :: T_Production -> T_Productions -> T_Productions
sem_Productions_Cons arg_hd_ arg_tl_ = T_Productions (return st38) where
st38 = let
v37 :: T_Productions_v37
v37 = \ (T_Productions_vIn37 _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup) -> ( let
_hdX35 = Control.Monad.Identity.runIdentity (attach_T_Production (arg_hd_))
_tlX38 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_tl_))
(T_Production_vOut34 _hdIhasMoreProds _hdIppA _hdIppCata _hdIppD _hdIppDI _hdIppL _hdIppLI _hdIppR _hdIppRA _hdIppSF _hdIppSPF _hdIprdInh) = inv_Production_s35 _hdX35 (T_Production_vIn34 _hdOext _hdOinh _hdOinhMap _hdOinhNoGroup _hdOnewAtts _hdOnewNT _hdOnewProds _hdOo_noGroup _hdOo_rename _hdOppNt _hdOsyn _hdOsynMap _hdOsynNoGroup)
(T_Productions_vOut37 _tlIhasMoreProds _tlIppA _tlIppCata _tlIppDL _tlIppL _tlIppLI _tlIppR _tlIppRA _tlIppSF _tlIppSPF _tlIprdInh) = inv_Productions_s38 _tlX38 (T_Productions_vIn37 _tlOext _tlOinh _tlOinhMap _tlOinhNoGroup _tlOnewAtts _tlOnewNT _tlOnewProds _tlOo_noGroup _tlOo_rename _tlOppNt _tlOsyn _tlOsynMap _tlOsynNoGroup)
_hdOinhNoGroup = rule203 _hdIprdInh _lhsIinhNoGroup
_lhsOppDL :: [PP_Doc]
_lhsOppDL = rule204 _hdIppD _tlIppDL
_lhsOhasMoreProds :: Bool
_lhsOhasMoreProds = rule205 _hdIhasMoreProds _tlIhasMoreProds
_lhsOppA :: PP_Doc
_lhsOppA = rule206 _hdIppA _tlIppA
_lhsOppCata :: PP_Doc
_lhsOppCata = rule207 _hdIppCata _tlIppCata
_lhsOppL :: PP_Doc
_lhsOppL = rule208 _hdIppL _tlIppL
_lhsOppLI :: [PP_Doc]
_lhsOppLI = rule209 _hdIppLI _tlIppLI
_lhsOppR :: PP_Doc
_lhsOppR = rule210 _hdIppR _tlIppR
_lhsOppRA :: [PP_Doc]
_lhsOppRA = rule211 _hdIppRA _tlIppRA
_lhsOppSF :: PP_Doc
_lhsOppSF = rule212 _hdIppSF _tlIppSF
_lhsOppSPF :: PP_Doc
_lhsOppSPF = rule213 _hdIppSPF _tlIppSPF
_lhsOprdInh :: Attributes
_lhsOprdInh = rule214 _hdIprdInh _tlIprdInh
_hdOext = rule215 _lhsIext
_hdOinh = rule216 _lhsIinh
_hdOinhMap = rule217 _lhsIinhMap
_hdOnewAtts = rule218 _lhsInewAtts
_hdOnewNT = rule219 _lhsInewNT
_hdOnewProds = rule220 _lhsInewProds
_hdOo_noGroup = rule221 _lhsIo_noGroup
_hdOo_rename = rule222 _lhsIo_rename
_hdOppNt = rule223 _lhsIppNt
_hdOsyn = rule224 _lhsIsyn
_hdOsynMap = rule225 _lhsIsynMap
_hdOsynNoGroup = rule226 _lhsIsynNoGroup
_tlOext = rule227 _lhsIext
_tlOinh = rule228 _lhsIinh
_tlOinhMap = rule229 _lhsIinhMap
_tlOinhNoGroup = rule230 _lhsIinhNoGroup
_tlOnewAtts = rule231 _lhsInewAtts
_tlOnewNT = rule232 _lhsInewNT
_tlOnewProds = rule233 _lhsInewProds
_tlOo_noGroup = rule234 _lhsIo_noGroup
_tlOo_rename = rule235 _lhsIo_rename
_tlOppNt = rule236 _lhsIppNt
_tlOsyn = rule237 _lhsIsyn
_tlOsynMap = rule238 _lhsIsynMap
_tlOsynNoGroup = rule239 _lhsIsynNoGroup
__result_ = T_Productions_vOut37 _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh
in __result_ )
in C_Productions_s38 v37
rule203 = \ ((_hdIprdInh) :: Attributes) ((_lhsIinhNoGroup) :: [String]) ->
filter (flip Map.member _hdIprdInh . identifier) _lhsIinhNoGroup
rule204 = \ ((_hdIppD) :: PP_Doc) ((_tlIppDL) :: [PP_Doc]) ->
_hdIppD : _tlIppDL
rule205 = \ ((_hdIhasMoreProds) :: Bool ) ((_tlIhasMoreProds) :: Bool ) ->
_hdIhasMoreProds || _tlIhasMoreProds
rule206 = \ ((_hdIppA) :: PP_Doc) ((_tlIppA) :: PP_Doc) ->
_hdIppA >-< _tlIppA
rule207 = \ ((_hdIppCata) :: PP_Doc) ((_tlIppCata) :: PP_Doc) ->
_hdIppCata >-< _tlIppCata
rule208 = \ ((_hdIppL) :: PP_Doc) ((_tlIppL) :: PP_Doc) ->
_hdIppL >-< _tlIppL
rule209 = \ ((_hdIppLI) :: [PP_Doc]) ((_tlIppLI) :: [PP_Doc]) ->
_hdIppLI ++ _tlIppLI
rule210 = \ ((_hdIppR) :: PP_Doc) ((_tlIppR) :: PP_Doc) ->
_hdIppR >-< _tlIppR
rule211 = \ ((_hdIppRA) :: [PP_Doc]) ((_tlIppRA) :: [PP_Doc]) ->
_hdIppRA ++ _tlIppRA
rule212 = \ ((_hdIppSF) :: PP_Doc) ((_tlIppSF) :: PP_Doc) ->
_hdIppSF >-< _tlIppSF
rule213 = \ ((_hdIppSPF) :: PP_Doc) ((_tlIppSPF) :: PP_Doc) ->
_hdIppSPF >-< _tlIppSPF
rule214 = \ ((_hdIprdInh) :: Attributes) ((_tlIprdInh) :: Attributes) ->
_hdIprdInh `Map.union` _tlIprdInh
rule215 = \ ((_lhsIext) :: Maybe String) ->
_lhsIext
rule216 = \ ((_lhsIinh) :: Attributes ) ->
_lhsIinh
rule217 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
_lhsIinhMap
rule218 = \ ((_lhsInewAtts) :: Attributes ) ->
_lhsInewAtts
rule219 = \ ((_lhsInewNT) :: Bool) ->
_lhsInewNT
rule220 = \ ((_lhsInewProds) :: Map.Map ConstructorIdent FieldMap ) ->
_lhsInewProds
rule221 = \ ((_lhsIo_noGroup) :: [String]) ->
_lhsIo_noGroup
rule222 = \ ((_lhsIo_rename) :: Bool) ->
_lhsIo_rename
rule223 = \ ((_lhsIppNt) :: PP_Doc) ->
_lhsIppNt
rule224 = \ ((_lhsIsyn) :: Attributes ) ->
_lhsIsyn
rule225 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
_lhsIsynMap
rule226 = \ ((_lhsIsynNoGroup) :: [String]) ->
_lhsIsynNoGroup
rule227 = \ ((_lhsIext) :: Maybe String) ->
_lhsIext
rule228 = \ ((_lhsIinh) :: Attributes ) ->
_lhsIinh
rule229 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
_lhsIinhMap
rule230 = \ ((_lhsIinhNoGroup) :: [String]) ->
_lhsIinhNoGroup
rule231 = \ ((_lhsInewAtts) :: Attributes ) ->
_lhsInewAtts
rule232 = \ ((_lhsInewNT) :: Bool) ->
_lhsInewNT
rule233 = \ ((_lhsInewProds) :: Map.Map ConstructorIdent FieldMap ) ->
_lhsInewProds
rule234 = \ ((_lhsIo_noGroup) :: [String]) ->
_lhsIo_noGroup
rule235 = \ ((_lhsIo_rename) :: Bool) ->
_lhsIo_rename
rule236 = \ ((_lhsIppNt) :: PP_Doc) ->
_lhsIppNt
rule237 = \ ((_lhsIsyn) :: Attributes ) ->
_lhsIsyn
rule238 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
_lhsIsynMap
rule239 = \ ((_lhsIsynNoGroup) :: [String]) ->
_lhsIsynNoGroup
sem_Productions_Nil :: T_Productions
sem_Productions_Nil = T_Productions (return st38) where
st38 = let
v37 :: T_Productions_v37
v37 = \ (T_Productions_vIn37 _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup) -> ( let
_lhsOppDL :: [PP_Doc]
_lhsOppDL = rule240 ()
_lhsOhasMoreProds :: Bool
_lhsOhasMoreProds = rule241 ()
_lhsOppA :: PP_Doc
_lhsOppA = rule242 ()
_lhsOppCata :: PP_Doc
_lhsOppCata = rule243 ()
_lhsOppL :: PP_Doc
_lhsOppL = rule244 ()
_lhsOppLI :: [PP_Doc]
_lhsOppLI = rule245 ()
_lhsOppR :: PP_Doc
_lhsOppR = rule246 ()
_lhsOppRA :: [PP_Doc]
_lhsOppRA = rule247 ()
_lhsOppSF :: PP_Doc
_lhsOppSF = rule248 ()
_lhsOppSPF :: PP_Doc
_lhsOppSPF = rule249 ()
_lhsOprdInh :: Attributes
_lhsOprdInh = rule250 ()
__result_ = T_Productions_vOut37 _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh
in __result_ )
in C_Productions_s38 v37
rule240 = \ (_ :: ()) ->
[]
rule241 = \ (_ :: ()) ->
False
rule242 = \ (_ :: ()) ->
empty
rule243 = \ (_ :: ()) ->
empty
rule244 = \ (_ :: ()) ->
empty
rule245 = \ (_ :: ()) ->
[]
rule246 = \ (_ :: ()) ->
empty
rule247 = \ (_ :: ()) ->
[]
rule248 = \ (_ :: ()) ->
empty
rule249 = \ (_ :: ()) ->
empty
rule250 = \ (_ :: ()) ->
Map.empty
data Inh_Rule = Inh_Rule { ext_Inh_Rule :: (Maybe String), inhNoGroup_Inh_Rule :: ([String]), newAtts_Inh_Rule :: ( Attributes ), newProd_Inh_Rule :: (Bool), o_noGroup_Inh_Rule :: ([String]), ppNt_Inh_Rule :: (PP_Doc), ppProd_Inh_Rule :: (PP_Doc), synNoGroup_Inh_Rule :: ([String]) }
data Syn_Rule = Syn_Rule { locals_Syn_Rule :: ([Identifier]), ppRL_Syn_Rule :: ([ PPRule ]) }
wrap_Rule :: T_Rule -> Inh_Rule -> (Syn_Rule )
wrap_Rule (T_Rule act) (Inh_Rule _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg40 = T_Rule_vIn40 _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup
(T_Rule_vOut40 _lhsOlocals _lhsOppRL) <- return (inv_Rule_s41 sem arg40)
return (Syn_Rule _lhsOlocals _lhsOppRL)
)
sem_Rule :: Rule -> T_Rule
sem_Rule ( Rule mbName_ pattern_ rhs_ owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ ) = sem_Rule_Rule mbName_ ( sem_Pattern pattern_ ) ( sem_Expression rhs_ ) owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_
newtype T_Rule = T_Rule {
attach_T_Rule :: Identity (T_Rule_s41 )
}
newtype T_Rule_s41 = C_Rule_s41 {
inv_Rule_s41 :: (T_Rule_v40 )
}
data T_Rule_s42 = C_Rule_s42
type T_Rule_v40 = (T_Rule_vIn40 ) -> (T_Rule_vOut40 )
data T_Rule_vIn40 = T_Rule_vIn40 (Maybe String) ([String]) ( Attributes ) (Bool) ([String]) (PP_Doc) (PP_Doc) ([String])
data T_Rule_vOut40 = T_Rule_vOut40 ([Identifier]) ([ PPRule ])
sem_Rule_Rule :: (Maybe Identifier) -> T_Pattern -> T_Expression -> (Bool) -> (String) -> (Bool) -> (Bool) -> (Bool) -> (Maybe Error) -> (Bool) -> T_Rule
sem_Rule_Rule _ arg_pattern_ arg_rhs_ arg_owrt_ _ arg_explicit_ _ _ _ _ = T_Rule (return st41) where
st41 = let
v40 :: T_Rule_v40
v40 = \ (T_Rule_vIn40 _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup) -> ( let
_patternX29 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_))
_rhsX8 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_rhs_))
(T_Pattern_vOut28 _patternIcopy _patternIinfo) = inv_Pattern_s29 _patternX29 (T_Pattern_vIn28 )
(T_Expression_vOut7 _rhsIppRE) = inv_Expression_s8 _rhsX8 (T_Expression_vIn7 _rhsOppNt _rhsOppProd)
_lhsOlocals :: [Identifier]
_lhsOlocals = rule251 _patternIinfo
_lhsOppRL :: [ PPRule ]
_lhsOppRL = rule252 _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _patternIinfo _rhsIppRE arg_explicit_ arg_owrt_
_rhsOppNt = rule253 _lhsIppNt
_rhsOppProd = rule254 _lhsIppProd
__result_ = T_Rule_vOut40 _lhsOlocals _lhsOppRL
in __result_ )
in C_Rule_s41 v40
rule251 = \ ((_patternIinfo) :: (Identifier, Identifier)) ->
if (show (fst _patternIinfo) == "loc")
then [ snd _patternIinfo ]
else [ ]
rule252 = \ ((_lhsInewAtts) :: Attributes ) ((_lhsInewProd) :: Bool) ((_lhsIo_noGroup) :: [String]) ((_lhsIppNt) :: PP_Doc) ((_patternIinfo) :: (Identifier, Identifier)) ((_rhsIppRE) :: [String] -> Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc) explicit_ owrt_ ->
if (not explicit_ && not _lhsInewProd && not (Map.member (snd _patternIinfo) _lhsInewAtts) )
then []
else [ ppRule _patternIinfo owrt_ (defRule _lhsIppNt _patternIinfo _lhsIo_noGroup _rhsIppRE) ]
rule253 = \ ((_lhsIppNt) :: PP_Doc) ->
_lhsIppNt
rule254 = \ ((_lhsIppProd) :: PP_Doc) ->
_lhsIppProd
data Inh_Rules = Inh_Rules { ext_Inh_Rules :: (Maybe String), inhNoGroup_Inh_Rules :: ([String]), newAtts_Inh_Rules :: ( Attributes ), newProd_Inh_Rules :: (Bool), o_noGroup_Inh_Rules :: ([String]), ppNt_Inh_Rules :: (PP_Doc), ppProd_Inh_Rules :: (PP_Doc), synNoGroup_Inh_Rules :: ([String]) }
data Syn_Rules = Syn_Rules { locals_Syn_Rules :: ([Identifier]), ppRL_Syn_Rules :: ([ PPRule ]) }
wrap_Rules :: T_Rules -> Inh_Rules -> (Syn_Rules )
wrap_Rules (T_Rules act) (Inh_Rules _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg43 = T_Rules_vIn43 _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup
(T_Rules_vOut43 _lhsOlocals _lhsOppRL) <- return (inv_Rules_s44 sem arg43)
return (Syn_Rules _lhsOlocals _lhsOppRL)
)
sem_Rules :: Rules -> T_Rules
sem_Rules list = Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list)
newtype T_Rules = T_Rules {
attach_T_Rules :: Identity (T_Rules_s44 )
}
newtype T_Rules_s44 = C_Rules_s44 {
inv_Rules_s44 :: (T_Rules_v43 )
}
data T_Rules_s45 = C_Rules_s45
type T_Rules_v43 = (T_Rules_vIn43 ) -> (T_Rules_vOut43 )
data T_Rules_vIn43 = T_Rules_vIn43 (Maybe String) ([String]) ( Attributes ) (Bool) ([String]) (PP_Doc) (PP_Doc) ([String])
data T_Rules_vOut43 = T_Rules_vOut43 ([Identifier]) ([ PPRule ])
sem_Rules_Cons :: T_Rule -> T_Rules -> T_Rules
sem_Rules_Cons arg_hd_ arg_tl_ = T_Rules (return st44) where
st44 = let
v43 :: T_Rules_v43
v43 = \ (T_Rules_vIn43 _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup) -> ( let
_hdX41 = Control.Monad.Identity.runIdentity (attach_T_Rule (arg_hd_))
_tlX44 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_tl_))
(T_Rule_vOut40 _hdIlocals _hdIppRL) = inv_Rule_s41 _hdX41 (T_Rule_vIn40 _hdOext _hdOinhNoGroup _hdOnewAtts _hdOnewProd _hdOo_noGroup _hdOppNt _hdOppProd _hdOsynNoGroup)
(T_Rules_vOut43 _tlIlocals _tlIppRL) = inv_Rules_s44 _tlX44 (T_Rules_vIn43 _tlOext _tlOinhNoGroup _tlOnewAtts _tlOnewProd _tlOo_noGroup _tlOppNt _tlOppProd _tlOsynNoGroup)
_lhsOppRL :: [ PPRule ]
_lhsOppRL = rule255 _hdIppRL _tlIppRL
_lhsOlocals :: [Identifier]
_lhsOlocals = rule256 _hdIlocals _tlIlocals
_hdOext = rule257 _lhsIext
_hdOinhNoGroup = rule258 _lhsIinhNoGroup
_hdOnewAtts = rule259 _lhsInewAtts
_hdOnewProd = rule260 _lhsInewProd
_hdOo_noGroup = rule261 _lhsIo_noGroup
_hdOppNt = rule262 _lhsIppNt
_hdOppProd = rule263 _lhsIppProd
_hdOsynNoGroup = rule264 _lhsIsynNoGroup
_tlOext = rule265 _lhsIext
_tlOinhNoGroup = rule266 _lhsIinhNoGroup
_tlOnewAtts = rule267 _lhsInewAtts
_tlOnewProd = rule268 _lhsInewProd
_tlOo_noGroup = rule269 _lhsIo_noGroup
_tlOppNt = rule270 _lhsIppNt
_tlOppProd = rule271 _lhsIppProd
_tlOsynNoGroup = rule272 _lhsIsynNoGroup
__result_ = T_Rules_vOut43 _lhsOlocals _lhsOppRL
in __result_ )
in C_Rules_s44 v43
rule255 = \ ((_hdIppRL) :: [ PPRule ]) ((_tlIppRL) :: [ PPRule ]) ->
_hdIppRL ++ _tlIppRL
rule256 = \ ((_hdIlocals) :: [Identifier]) ((_tlIlocals) :: [Identifier]) ->
_hdIlocals ++ _tlIlocals
rule257 = \ ((_lhsIext) :: Maybe String) ->
_lhsIext
rule258 = \ ((_lhsIinhNoGroup) :: [String]) ->
_lhsIinhNoGroup
rule259 = \ ((_lhsInewAtts) :: Attributes ) ->
_lhsInewAtts
rule260 = \ ((_lhsInewProd) :: Bool) ->
_lhsInewProd
rule261 = \ ((_lhsIo_noGroup) :: [String]) ->
_lhsIo_noGroup
rule262 = \ ((_lhsIppNt) :: PP_Doc) ->
_lhsIppNt
rule263 = \ ((_lhsIppProd) :: PP_Doc) ->
_lhsIppProd
rule264 = \ ((_lhsIsynNoGroup) :: [String]) ->
_lhsIsynNoGroup
rule265 = \ ((_lhsIext) :: Maybe String) ->
_lhsIext
rule266 = \ ((_lhsIinhNoGroup) :: [String]) ->
_lhsIinhNoGroup
rule267 = \ ((_lhsInewAtts) :: Attributes ) ->
_lhsInewAtts
rule268 = \ ((_lhsInewProd) :: Bool) ->
_lhsInewProd
rule269 = \ ((_lhsIo_noGroup) :: [String]) ->
_lhsIo_noGroup
rule270 = \ ((_lhsIppNt) :: PP_Doc) ->
_lhsIppNt
rule271 = \ ((_lhsIppProd) :: PP_Doc) ->
_lhsIppProd
rule272 = \ ((_lhsIsynNoGroup) :: [String]) ->
_lhsIsynNoGroup
sem_Rules_Nil :: T_Rules
sem_Rules_Nil = T_Rules (return st44) where
st44 = let
v43 :: T_Rules_v43
v43 = \ (T_Rules_vIn43 _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup) -> ( let
_lhsOppRL :: [ PPRule ]
_lhsOppRL = rule273 ()
_lhsOlocals :: [Identifier]
_lhsOlocals = rule274 ()
__result_ = T_Rules_vOut43 _lhsOlocals _lhsOppRL
in __result_ )
in C_Rules_s44 v43
rule273 = \ (_ :: ()) ->
[]
rule274 = \ (_ :: ()) ->
[]
data Inh_TypeSig = Inh_TypeSig { }
data Syn_TypeSig = Syn_TypeSig { }
wrap_TypeSig :: T_TypeSig -> Inh_TypeSig -> (Syn_TypeSig )
wrap_TypeSig (T_TypeSig act) (Inh_TypeSig ) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg46 = T_TypeSig_vIn46
(T_TypeSig_vOut46 ) <- return (inv_TypeSig_s47 sem arg46)
return (Syn_TypeSig )
)
sem_TypeSig :: TypeSig -> T_TypeSig
sem_TypeSig ( TypeSig name_ tp_ ) = sem_TypeSig_TypeSig name_ tp_
newtype T_TypeSig = T_TypeSig {
attach_T_TypeSig :: Identity (T_TypeSig_s47 )
}
newtype T_TypeSig_s47 = C_TypeSig_s47 {
inv_TypeSig_s47 :: (T_TypeSig_v46 )
}
data T_TypeSig_s48 = C_TypeSig_s48
type T_TypeSig_v46 = (T_TypeSig_vIn46 ) -> (T_TypeSig_vOut46 )
data T_TypeSig_vIn46 = T_TypeSig_vIn46
data T_TypeSig_vOut46 = T_TypeSig_vOut46
sem_TypeSig_TypeSig :: (Identifier) -> (Type) -> T_TypeSig
sem_TypeSig_TypeSig _ _ = T_TypeSig (return st47) where
st47 = let
v46 :: T_TypeSig_v46
v46 = \ (T_TypeSig_vIn46 ) -> ( let
__result_ = T_TypeSig_vOut46
in __result_ )
in C_TypeSig_s47 v46
data Inh_TypeSigs = Inh_TypeSigs { }
data Syn_TypeSigs = Syn_TypeSigs { }
wrap_TypeSigs :: T_TypeSigs -> Inh_TypeSigs -> (Syn_TypeSigs )
wrap_TypeSigs (T_TypeSigs act) (Inh_TypeSigs ) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg49 = T_TypeSigs_vIn49
(T_TypeSigs_vOut49 ) <- return (inv_TypeSigs_s50 sem arg49)
return (Syn_TypeSigs )
)
sem_TypeSigs :: TypeSigs -> T_TypeSigs
sem_TypeSigs list = Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list)
newtype T_TypeSigs = T_TypeSigs {
attach_T_TypeSigs :: Identity (T_TypeSigs_s50 )
}
newtype T_TypeSigs_s50 = C_TypeSigs_s50 {
inv_TypeSigs_s50 :: (T_TypeSigs_v49 )
}
data T_TypeSigs_s51 = C_TypeSigs_s51
type T_TypeSigs_v49 = (T_TypeSigs_vIn49 ) -> (T_TypeSigs_vOut49 )
data T_TypeSigs_vIn49 = T_TypeSigs_vIn49
data T_TypeSigs_vOut49 = T_TypeSigs_vOut49
sem_TypeSigs_Cons :: T_TypeSig -> T_TypeSigs -> T_TypeSigs
sem_TypeSigs_Cons arg_hd_ arg_tl_ = T_TypeSigs (return st50) where
st50 = let
v49 :: T_TypeSigs_v49
v49 = \ (T_TypeSigs_vIn49 ) -> ( let
_hdX47 = Control.Monad.Identity.runIdentity (attach_T_TypeSig (arg_hd_))
_tlX50 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_tl_))
(T_TypeSig_vOut46 ) = inv_TypeSig_s47 _hdX47 (T_TypeSig_vIn46 )
(T_TypeSigs_vOut49 ) = inv_TypeSigs_s50 _tlX50 (T_TypeSigs_vIn49 )
__result_ = T_TypeSigs_vOut49
in __result_ )
in C_TypeSigs_s50 v49
sem_TypeSigs_Nil :: T_TypeSigs
sem_TypeSigs_Nil = T_TypeSigs (return st50) where
st50 = let
v49 :: T_TypeSigs_v49
v49 = \ (T_TypeSigs_vIn49 ) -> ( let
__result_ = T_TypeSigs_vOut49
in __result_ )
in C_TypeSigs_s50 v49