uuagc-0.9.32: src-derived/AG2AspectAG.hs
-- UUAGC 0.9.30 (AG2AspectAG.ag)
module AG2AspectAG where
{-# LINE 7 "AG2AspectAG.ag" #-}
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 AbstractSyntax
import TokenDef
import CommonTypes
{-# LINE 20 "../src-derived/AG2AspectAG.hs" #-}
{-# LINE 2 "./AbstractSyntax.ag" #-}
-- AbstractSyntax.ag imports
import Data.Set(Set)
import Data.Map(Map)
import Patterns (Pattern(..),Patterns)
import Expression (Expression(..))
import CommonTypes
{-# LINE 30 "../src-derived/AG2AspectAG.hs" #-}
{-# LINE 2 "./Patterns.ag" #-}
-- Patterns.ag imports
import UU.Scanner.Position(Pos)
import CommonTypes (ConstructorIdent,Identifier)
{-# LINE 37 "../src-derived/AG2AspectAG.hs" #-}
{-# LINE 2 "./Expression.ag" #-}
import UU.Scanner.Position(Pos)
import HsToken
{-# LINE 43 "../src-derived/AG2AspectAG.hs" #-}
{-# LINE 2 "./HsToken.ag" #-}
import CommonTypes
import UU.Scanner.Position(Pos)
{-# LINE 49 "../src-derived/AG2AspectAG.hs" #-}
{-# LINE 22 "AG2AspectAG.ag" #-}
pragmaAspectAG = pp "{-# LANGUAGE EmptyDataDecls, NoMonomorphismRestriction , TypeSynonymInstances, MultiParamTypeClasses, FlexibleContexts #-}"
importAspectAG = pp "import Language.Grammars.AspectAG" >-<
pp "import Language.Grammars.AspectAG.Derive" >-<
pp "import Data.HList.Label4" >-<
pp "import Data.HList.TypeEqGeneric1" >-<
pp "import Data.HList.TypeCastGeneric1"
{-# LINE 60 "../src-derived/AG2AspectAG.hs" #-}
{-# LINE 142 "AG2AspectAG.ag" #-}
defAtts = pp "data Att_inh; att_inh = proxy :: Proxy Att_inh" >-<
pp "data Att_syn; att_syn = proxy :: Proxy Att_syn" >-<
pp "data Att_loc; att_loc = proxy :: Proxy Att_loc"
defTAtt t@(f:r) ppN atts =
let tT = (toUpper f) : r
fields = ppCommas (map (\(a,t) -> ppListSep "" "" "_" [pp a, pp tT, ppN ] >|< pp " ::" >|< ppShow t) $ Map.assocs atts)
in
pp ("data " ++ tT ++ "_") >|< ppN >|< pp (" = " ++ tT ++ "_") >|< ppN >|<
pp " { " >|< fields >|< pp " }"
defLocalAtts ppNt ppProd total actual (l:ls) = ppListSep "" "" "_" [pp l, ppNt, ppProd] >|<
ppListSep "(" ")" "," (replicate (actual-1) "_" ++ "x" : replicate (total-actual) "_") >|<
pp " = x" >-<
defLocalAtts ppNt ppProd total (actual+1) ls
defLocalAtts _ _ _ _ [] = empty
{-# LINE 84 "../src-derived/AG2AspectAG.hs" #-}
{-# LINE 235 "AG2AspectAG.ag" #-}
defInhRule ppNt prod ch rules chids locals =
let ppAtt = ppListSep "" "" "_" [pp "inh", ppNt, pp prod]
in ppAtt >|< pp " = inhdefM att_inh listNt $" >-<
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 (chRule ppNt prod rules chids locals) chids))
chRule ppNt prod rules chids locals (idCh,tp) =
let chName = ppListSep "" "" "_" [pp "ch", pp idCh, ppNt, pp prod]
ppTp = ppShow tp
chRules = ppCommas $ mapRuleDefs (== idCh) rules chids locals
in if (isNonterminal tp)
then chName >|< ".=." >-<
indent 1 "Inh_" >|< ppShow tp >|< pp " {" >-<
indent 2 chRules >-<
indent 1 "} .*. "
else empty
defSynRule ppNt prod ch rules chids locals =
let ppAtt = ppListSep "" "" "_" [pp "syn", ppNt, pp prod]
ppTAtt = "Syn_" >|< ppNt
in 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 $ mapRuleDefs ((== "lhs") . show) rules chids locals) >-<
indent 6 "}"
defLocRule ppNt prod ch rules chids locals =
let ppAtt = ppListSep "" "" "_" [pp "loc", ppNt, pp prod]
ppTAtt = ppListSep "" "" "_" [pp "Loc", ppNt, pp prod]
in 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 "(" ")" "," $ mapRuleDefs ((== "loc") . show) rules chids locals)
defInstRules ppNt prod ch rules chids locals = let ppAsp = ppListSep "" "" "_" [pp "inst", ppNt, pp prod]
instRules = filter ((=="inst") . show . fst . fst) rules
ppAtt att = ppListSep "`ext` " "" "_" [pp "inst_ch", pp att, ppNt, pp prod]
in ppAsp >|< pp " = emptyRule " >|< (map (ppAtt . snd . fst) instRules) >-<
(vlist $ map (defInstRule ppNt prod ch chids locals) instRules)
defInstRule ppNt prod ch chids locals ((_,att),rule) =
let ppAtt = ppListSep "" "" "_" [pp "ch", pp att, 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 (rule chids locals)
mapRuleDefs filt rules chids locals = map appSnd $ sortBy cmpFst $ filter ( filt . fst . fst) rules
where cmpFst (a,_) (b,_) = compare a b
appSnd rule = (snd rule) chids locals
defRule ppNt (field,att) rhs = \chids locals ->
let ppAtt = case (show field) of
"lhs" -> att >|< "_" >|< pp "Syn" >|< pp "_" >|< ppNt >|< " = "
"loc" -> empty
"inst" -> empty
otherwise -> att >|< "_" >|< pp "Inh" >|< pp "_" >|<
(maybe (error $ "lhs field " ++ show field ++" is not a child") ppShow (lookup field chids))
>|< " = "
in ppAtt >|< (rhs field chids locals)
rhsRule ppNt ppProd tks field chids locals = hv_sp $ map (token2PP ppNt ppProd field chids locals) tks
token2PP ppNt ppProd field chids locals tk
= case tk of
AGLocal var _ _ -> if (elem var locals)
then (ppListSep "(" "" "_" [pp var, ppNt, ppProd]) >|< pp " (loc # att_loc))"
else pp var
AGField field attr _ _ -> let ppChT = maybe (error $ "rhs field " ++ show field ++ " is not a child") ppShow (lookup field chids)
ppAtt = case (show field) of
"lhs" -> pp "att_inh"
"loc" -> pp "att_loc"
otherwise -> pp "att_syn"
ppSubAtt = case (show field) of
"lhs" -> ppListSep "" "" "_" [pp (getName attr), pp "Inh", ppNt]
"loc" -> ppListSep "" "" "_" [pp (getName attr), ppNt, ppProd]
otherwise -> ppListSep "" "" "_" [pp (getName attr), pp "Syn", ppChT]
in pp "(" >|< ppSubAtt >|< " (" >|< pp (getName field) >|< " # " >|< ppAtt >|< "))"
HsToken value _ -> pp value
CharToken value _ -> pp $ show value
StrToken value _ -> pp $ show value
Err mesg _ -> pp $ " ***" ++ mesg ++ "*** "
{-# LINE 190 "../src-derived/AG2AspectAG.hs" #-}
-- Child -------------------------------------------------------
{-
visit 0:
inherited attributes:
ppNt : PP_Doc
ppProd : PP_Doc
synthesized attributes:
idCL : [(Identifier,Type)]
ppCSF : [(Identifier,PP_Doc)]
ppDL : [PP_Doc]
ppL : PP_Doc
ppR : PP_Doc
alternatives:
alternative Child:
child name : {Identifier}
child tp : {Type}
child inh : {Attributes}
child syn : {Attributes}
child virtual : {Maybe (Maybe Type)}
-}
-- cata
sem_Child :: Child ->
T_Child
sem_Child (Child _name _tp _inh _syn _virtual ) =
(sem_Child_Child _name _tp _inh _syn _virtual )
-- semantic domain
newtype T_Child = T_Child (PP_Doc ->
PP_Doc ->
( ([(Identifier,Type)]),([(Identifier,PP_Doc)]),([PP_Doc]),PP_Doc,PP_Doc))
data Inh_Child = Inh_Child {ppNt_Inh_Child :: PP_Doc,ppProd_Inh_Child :: PP_Doc}
data Syn_Child = Syn_Child {idCL_Syn_Child :: ([(Identifier,Type)]),ppCSF_Syn_Child :: ([(Identifier,PP_Doc)]),ppDL_Syn_Child :: ([PP_Doc]),ppL_Syn_Child :: PP_Doc,ppR_Syn_Child :: PP_Doc}
wrap_Child :: T_Child ->
Inh_Child ->
Syn_Child
wrap_Child (T_Child sem ) (Inh_Child _lhsIppNt _lhsIppProd ) =
(let ( _lhsOidCL,_lhsOppCSF,_lhsOppDL,_lhsOppL,_lhsOppR) = sem _lhsIppNt _lhsIppProd
in (Syn_Child _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppR ))
sem_Child_Child :: Identifier ->
Type ->
Attributes ->
Attributes ->
(Maybe (Maybe Type)) ->
T_Child
sem_Child_Child name_ tp_ inh_ syn_ virtual_ =
(T_Child (\ _lhsIppNt
_lhsIppProd ->
(let _lhsOppDL :: ([PP_Doc])
_lhsOppL :: PP_Doc
_lhsOppR :: PP_Doc
_lhsOidCL :: ([(Identifier,Type)])
_lhsOppCSF :: ([(Identifier,PP_Doc)])
-- "AG2AspectAG.ag"(line 93, column 25)
_lhsOppDL =
({-# LINE 93 "AG2AspectAG.ag" #-}
case virtual_ of
Nothing -> let chName = ppListSep "" "" "_" [pp name_, _lhsIppNt, _lhsIppProd]
in [ chName >|< pp " :: " >|< ppShow tp_ ]
otherwise -> []
{-# LINE 249 "AG2AspectAG.hs" #-})
-- "AG2AspectAG.ag"(line 118, column 25)
_lhsOppL =
({-# LINE 118 "AG2AspectAG.ag" #-}
let chName = ppListSep "" "" "_" [pp name_, _lhsIppNt, _lhsIppProd]
in pp "data Ch_" >|< chName >|< pp "; " >|<
pp "ch_" >|< chName >|< pp " = proxy :: " >|<
case virtual_ of
Nothing -> pp "Proxy " >|< pp "(Ch_" >|< chName >|< ", " >|< ppShow tp_ >|< pp ")"
otherwise -> pp "SemType " >|< ppShow tp_ >|< pp " nt => Proxy " >|<
pp "(Ch_" >|< chName >|< pp ", nt)"
{-# LINE 260 "AG2AspectAG.hs" #-})
-- "AG2AspectAG.ag"(line 196, column 25)
_lhsOppR =
({-# LINE 196 "AG2AspectAG.ag" #-}
let chName = ppListSep "" "" "_" [pp name_, _lhsIppNt, _lhsIppProd]
in pp name_ >|< " <- at ch_" >|< chName
{-# LINE 266 "AG2AspectAG.hs" #-})
-- "AG2AspectAG.ag"(line 227, column 25)
_lhsOidCL =
({-# LINE 227 "AG2AspectAG.ag" #-}
[ (name_, case (stripPrefix "T_" (show tp_)) of
Nothing -> tp_
Just t -> NT (Ident t undefined) []
) ]
{-# LINE 274 "AG2AspectAG.hs" #-})
-- "AG2AspectAG.ag"(line 389, column 25)
_lhsOppCSF =
({-# LINE 389 "AG2AspectAG.ag" #-}
let
ppProd = ppListSep "" "" "_" [_lhsIppNt,_lhsIppProd]
ppChi = ppListSep "" "" "_" [pp "ch", pp name_, ppProd]
semC = if (isNonterminal tp_)
then pp "sem_" >|< ppShow tp_ >|< pp " _" >|< pp name_
else pp "sem_Lit _" >|< pp name_
in case virtual_ of
Nothing -> [(name_, ppChi >|< pp " .=. (" >|< semC >|< pp ") .*. ")]
otherwise -> []
{-# LINE 287 "AG2AspectAG.hs" #-})
in ( _lhsOidCL,_lhsOppCSF,_lhsOppDL,_lhsOppL,_lhsOppR))) )
-- Children ----------------------------------------------------
{-
visit 0:
inherited attributes:
ppNt : PP_Doc
ppProd : PP_Doc
synthesized attributes:
idCL : [(Identifier,Type)]
ppCSF : [(Identifier,PP_Doc)]
ppDL : [PP_Doc]
ppL : PP_Doc
ppR : PP_Doc
alternatives:
alternative Cons:
child hd : Child
child tl : Children
alternative Nil:
-}
-- cata
sem_Children :: Children ->
T_Children
sem_Children list =
(Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list) )
-- semantic domain
newtype T_Children = T_Children (PP_Doc ->
PP_Doc ->
( ([(Identifier,Type)]),([(Identifier,PP_Doc)]),([PP_Doc]),PP_Doc,PP_Doc))
data Inh_Children = Inh_Children {ppNt_Inh_Children :: PP_Doc,ppProd_Inh_Children :: PP_Doc}
data Syn_Children = Syn_Children {idCL_Syn_Children :: ([(Identifier,Type)]),ppCSF_Syn_Children :: ([(Identifier,PP_Doc)]),ppDL_Syn_Children :: ([PP_Doc]),ppL_Syn_Children :: PP_Doc,ppR_Syn_Children :: PP_Doc}
wrap_Children :: T_Children ->
Inh_Children ->
Syn_Children
wrap_Children (T_Children sem ) (Inh_Children _lhsIppNt _lhsIppProd ) =
(let ( _lhsOidCL,_lhsOppCSF,_lhsOppDL,_lhsOppL,_lhsOppR) = sem _lhsIppNt _lhsIppProd
in (Syn_Children _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppR ))
sem_Children_Cons :: T_Child ->
T_Children ->
T_Children
sem_Children_Cons (T_Child hd_ ) (T_Children tl_ ) =
(T_Children (\ _lhsIppNt
_lhsIppProd ->
(let _lhsOppDL :: ([PP_Doc])
_lhsOidCL :: ([(Identifier,Type)])
_lhsOppCSF :: ([(Identifier,PP_Doc)])
_lhsOppL :: PP_Doc
_lhsOppR :: PP_Doc
_hdOppNt :: PP_Doc
_hdOppProd :: PP_Doc
_tlOppNt :: PP_Doc
_tlOppProd :: PP_Doc
_hdIidCL :: ([(Identifier,Type)])
_hdIppCSF :: ([(Identifier,PP_Doc)])
_hdIppDL :: ([PP_Doc])
_hdIppL :: PP_Doc
_hdIppR :: PP_Doc
_tlIidCL :: ([(Identifier,Type)])
_tlIppCSF :: ([(Identifier,PP_Doc)])
_tlIppDL :: ([PP_Doc])
_tlIppL :: PP_Doc
_tlIppR :: PP_Doc
-- "AG2AspectAG.ag"(line 89, column 33)
_lhsOppDL =
({-# LINE 89 "AG2AspectAG.ag" #-}
_hdIppDL ++ _tlIppDL
{-# LINE 353 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 225, column 31)
_lhsOidCL =
({-# LINE 225 "AG2AspectAG.ag" #-}
_hdIidCL ++ _tlIidCL
{-# LINE 358 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 385, column 34)
_lhsOppCSF =
({-# LINE 385 "AG2AspectAG.ag" #-}
_hdIppCSF ++ _tlIppCSF
{-# LINE 363 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 110, column 79)
_lhsOppL =
({-# LINE 110 "AG2AspectAG.ag" #-}
_hdIppL >-< _tlIppL
{-# LINE 368 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 184, column 79)
_lhsOppR =
({-# LINE 184 "AG2AspectAG.ag" #-}
_hdIppR >-< _tlIppR
{-# LINE 373 "AG2AspectAG.hs" #-})
-- copy rule (down)
_hdOppNt =
({-# LINE 47 "AG2AspectAG.ag" #-}
_lhsIppNt
{-# LINE 378 "AG2AspectAG.hs" #-})
-- copy rule (down)
_hdOppProd =
({-# LINE 53 "AG2AspectAG.ag" #-}
_lhsIppProd
{-# LINE 383 "AG2AspectAG.hs" #-})
-- copy rule (down)
_tlOppNt =
({-# LINE 47 "AG2AspectAG.ag" #-}
_lhsIppNt
{-# LINE 388 "AG2AspectAG.hs" #-})
-- copy rule (down)
_tlOppProd =
({-# LINE 53 "AG2AspectAG.ag" #-}
_lhsIppProd
{-# LINE 393 "AG2AspectAG.hs" #-})
( _hdIidCL,_hdIppCSF,_hdIppDL,_hdIppL,_hdIppR) =
hd_ _hdOppNt _hdOppProd
( _tlIidCL,_tlIppCSF,_tlIppDL,_tlIppL,_tlIppR) =
tl_ _tlOppNt _tlOppProd
in ( _lhsOidCL,_lhsOppCSF,_lhsOppDL,_lhsOppL,_lhsOppR))) )
sem_Children_Nil :: T_Children
sem_Children_Nil =
(T_Children (\ _lhsIppNt
_lhsIppProd ->
(let _lhsOppDL :: ([PP_Doc])
_lhsOidCL :: ([(Identifier,Type)])
_lhsOppCSF :: ([(Identifier,PP_Doc)])
_lhsOppL :: PP_Doc
_lhsOppR :: PP_Doc
-- "AG2AspectAG.ag"(line 90, column 33)
_lhsOppDL =
({-# LINE 90 "AG2AspectAG.ag" #-}
[]
{-# LINE 412 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 225, column 31)
_lhsOidCL =
({-# LINE 225 "AG2AspectAG.ag" #-}
[]
{-# LINE 417 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 385, column 34)
_lhsOppCSF =
({-# LINE 385 "AG2AspectAG.ag" #-}
[]
{-# LINE 422 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 110, column 79)
_lhsOppL =
({-# LINE 110 "AG2AspectAG.ag" #-}
empty
{-# LINE 427 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 184, column 79)
_lhsOppR =
({-# LINE 184 "AG2AspectAG.ag" #-}
empty
{-# LINE 432 "AG2AspectAG.hs" #-})
in ( _lhsOidCL,_lhsOppCSF,_lhsOppDL,_lhsOppL,_lhsOppR))) )
-- Expression --------------------------------------------------
{-
visit 0:
inherited attributes:
ppNt : PP_Doc
ppProd : PP_Doc
synthesized attribute:
ppRE : Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc
alternatives:
alternative Expression:
child pos : {Pos}
child tks : {[HsToken]}
-}
-- cata
sem_Expression :: Expression ->
T_Expression
sem_Expression (Expression _pos _tks ) =
(sem_Expression_Expression _pos _tks )
-- semantic domain
newtype T_Expression = T_Expression (PP_Doc ->
PP_Doc ->
( (Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc)))
data Inh_Expression = Inh_Expression {ppNt_Inh_Expression :: PP_Doc,ppProd_Inh_Expression :: PP_Doc}
data Syn_Expression = Syn_Expression {ppRE_Syn_Expression :: (Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc)}
wrap_Expression :: T_Expression ->
Inh_Expression ->
Syn_Expression
wrap_Expression (T_Expression sem ) (Inh_Expression _lhsIppNt _lhsIppProd ) =
(let ( _lhsOppRE) = sem _lhsIppNt _lhsIppProd
in (Syn_Expression _lhsOppRE ))
sem_Expression_Expression :: Pos ->
([HsToken]) ->
T_Expression
sem_Expression_Expression pos_ tks_ =
(T_Expression (\ _lhsIppNt
_lhsIppProd ->
(let _lhsOppRE :: (Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc)
-- "AG2AspectAG.ag"(line 221, column 25)
_lhsOppRE =
({-# LINE 221 "AG2AspectAG.ag" #-}
rhsRule _lhsIppNt _lhsIppProd tks_
{-# LINE 475 "AG2AspectAG.hs" #-})
in ( _lhsOppRE))) )
-- Grammar -----------------------------------------------------
{-
visit 0:
synthesized attribute:
pp : PP_Doc
alternatives:
alternative Grammar:
child typeSyns : {TypeSyns}
child useMap : {UseMap}
child derivings : {Derivings}
child wrappers : {Set NontermIdent}
child nonts : Nonterminals
child pragmas : {PragmaMap}
child manualAttrOrderMap : {AttrOrderMap}
child paramMap : {ParamMap}
child contextMap : {ContextMap}
child uniqueMap : {UniqueMap}
child augmentsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))}
child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))}
child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))}
-}
-- cata
sem_Grammar :: Grammar ->
T_Grammar
sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap _augmentsMap _aroundsMap _mergeMap ) =
(sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts ) _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap _augmentsMap _aroundsMap _mergeMap )
-- semantic domain
newtype T_Grammar = T_Grammar (( PP_Doc))
data Inh_Grammar = Inh_Grammar {}
data Syn_Grammar = Syn_Grammar {pp_Syn_Grammar :: PP_Doc}
wrap_Grammar :: T_Grammar ->
Inh_Grammar ->
Syn_Grammar
wrap_Grammar (T_Grammar sem ) (Inh_Grammar ) =
(let ( _lhsOpp) = sem
in (Syn_Grammar _lhsOpp ))
sem_Grammar_Grammar :: TypeSyns ->
UseMap ->
Derivings ->
(Set NontermIdent) ->
T_Nonterminals ->
PragmaMap ->
AttrOrderMap ->
ParamMap ->
ContextMap ->
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 typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ =
(T_Grammar (let _lhsOpp :: PP_Doc
_nontsOderivs :: Derivings
_nontsOtSyns :: TypeSyns
_nontsIppA :: PP_Doc
_nontsIppD :: PP_Doc
_nontsIppL :: PP_Doc
_nontsIppNtL :: PP_Doc
_nontsIppR :: PP_Doc
_nontsIppS :: PP_Doc
_nontsIppW :: PP_Doc
-- "AG2AspectAG.ag"(line 36, column 25)
_lhsOpp =
({-# LINE 36 "AG2AspectAG.ag" #-}
pp "-- datatypes" >-< _nontsIppD >-<
pp "-- labels" >-< _nontsIppL >-<
pp "-- attributes" >-< defAtts >-< _nontsIppA >-<
pp "-- rules" >-< pp "listNt = " >|< _nontsIppNtL >-< _nontsIppR >-<
pp "-- semantic functions" >-< _nontsIppS >-<
pp "-- wrappers" >-< _nontsIppW
{-# LINE 547 "AG2AspectAG.hs" #-})
-- "AG2AspectAG.ag"(line 63, column 25)
_nontsOderivs =
({-# LINE 63 "AG2AspectAG.ag" #-}
derivings_
{-# LINE 552 "AG2AspectAG.hs" #-})
-- "AG2AspectAG.ag"(line 102, column 34)
_nontsOtSyns =
({-# LINE 102 "AG2AspectAG.ag" #-}
typeSyns_
{-# LINE 557 "AG2AspectAG.hs" #-})
( _nontsIppA,_nontsIppD,_nontsIppL,_nontsIppNtL,_nontsIppR,_nontsIppS,_nontsIppW) =
nonts_ _nontsOderivs _nontsOtSyns
in ( _lhsOpp)) )
-- HsToken -----------------------------------------------------
{-
alternatives:
alternative AGField:
child field : {Identifier}
child attr : {Identifier}
child pos : {Pos}
child rdesc : {Maybe String}
alternative AGLocal:
child var : {Identifier}
child pos : {Pos}
child rdesc : {Maybe String}
alternative CharToken:
child value : {String}
child pos : {Pos}
alternative Err:
child mesg : {String}
child pos : {Pos}
alternative HsToken:
child value : {String}
child pos : {Pos}
alternative StrToken:
child value : {String}
child pos : {Pos}
-}
-- cata
sem_HsToken :: HsToken ->
T_HsToken
sem_HsToken (AGField _field _attr _pos _rdesc ) =
(sem_HsToken_AGField _field _attr _pos _rdesc )
sem_HsToken (AGLocal _var _pos _rdesc ) =
(sem_HsToken_AGLocal _var _pos _rdesc )
sem_HsToken (CharToken _value _pos ) =
(sem_HsToken_CharToken _value _pos )
sem_HsToken (Err _mesg _pos ) =
(sem_HsToken_Err _mesg _pos )
sem_HsToken (HsToken _value _pos ) =
(sem_HsToken_HsToken _value _pos )
sem_HsToken (StrToken _value _pos ) =
(sem_HsToken_StrToken _value _pos )
-- semantic domain
newtype T_HsToken = T_HsToken (( ))
data Inh_HsToken = Inh_HsToken {}
data Syn_HsToken = Syn_HsToken {}
wrap_HsToken :: T_HsToken ->
Inh_HsToken ->
Syn_HsToken
wrap_HsToken (T_HsToken sem ) (Inh_HsToken ) =
(let ( ) = sem
in (Syn_HsToken ))
sem_HsToken_AGField :: Identifier ->
Identifier ->
Pos ->
(Maybe String) ->
T_HsToken
sem_HsToken_AGField field_ attr_ pos_ rdesc_ =
(T_HsToken (let
in ( )) )
sem_HsToken_AGLocal :: Identifier ->
Pos ->
(Maybe String) ->
T_HsToken
sem_HsToken_AGLocal var_ pos_ rdesc_ =
(T_HsToken (let
in ( )) )
sem_HsToken_CharToken :: String ->
Pos ->
T_HsToken
sem_HsToken_CharToken value_ pos_ =
(T_HsToken (let
in ( )) )
sem_HsToken_Err :: String ->
Pos ->
T_HsToken
sem_HsToken_Err mesg_ pos_ =
(T_HsToken (let
in ( )) )
sem_HsToken_HsToken :: String ->
Pos ->
T_HsToken
sem_HsToken_HsToken value_ pos_ =
(T_HsToken (let
in ( )) )
sem_HsToken_StrToken :: String ->
Pos ->
T_HsToken
sem_HsToken_StrToken value_ pos_ =
(T_HsToken (let
in ( )) )
-- HsTokens ----------------------------------------------------
{-
alternatives:
alternative Cons:
child hd : HsToken
child tl : HsTokens
alternative Nil:
-}
-- cata
sem_HsTokens :: HsTokens ->
T_HsTokens
sem_HsTokens list =
(Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list) )
-- semantic domain
newtype T_HsTokens = T_HsTokens (( ))
data Inh_HsTokens = Inh_HsTokens {}
data Syn_HsTokens = Syn_HsTokens {}
wrap_HsTokens :: T_HsTokens ->
Inh_HsTokens ->
Syn_HsTokens
wrap_HsTokens (T_HsTokens sem ) (Inh_HsTokens ) =
(let ( ) = sem
in (Syn_HsTokens ))
sem_HsTokens_Cons :: T_HsToken ->
T_HsTokens ->
T_HsTokens
sem_HsTokens_Cons (T_HsToken hd_ ) (T_HsTokens tl_ ) =
(T_HsTokens (let
in ( )) )
sem_HsTokens_Nil :: T_HsTokens
sem_HsTokens_Nil =
(T_HsTokens (let
in ( )) )
-- HsTokensRoot ------------------------------------------------
{-
alternatives:
alternative HsTokensRoot:
child tokens : HsTokens
-}
-- cata
sem_HsTokensRoot :: HsTokensRoot ->
T_HsTokensRoot
sem_HsTokensRoot (HsTokensRoot _tokens ) =
(sem_HsTokensRoot_HsTokensRoot (sem_HsTokens _tokens ) )
-- semantic domain
newtype T_HsTokensRoot = T_HsTokensRoot (( ))
data Inh_HsTokensRoot = Inh_HsTokensRoot {}
data Syn_HsTokensRoot = Syn_HsTokensRoot {}
wrap_HsTokensRoot :: T_HsTokensRoot ->
Inh_HsTokensRoot ->
Syn_HsTokensRoot
wrap_HsTokensRoot (T_HsTokensRoot sem ) (Inh_HsTokensRoot ) =
(let ( ) = sem
in (Syn_HsTokensRoot ))
sem_HsTokensRoot_HsTokensRoot :: T_HsTokens ->
T_HsTokensRoot
sem_HsTokensRoot_HsTokensRoot (T_HsTokens tokens_ ) =
(T_HsTokensRoot (let
in ( )) )
-- Nonterminal -------------------------------------------------
{-
visit 0:
inherited attributes:
derivs : Derivings
tSyns : TypeSyns
synthesized attributes:
ppA : PP_Doc
ppD : PP_Doc
ppL : PP_Doc
ppNtL : PP_Doc
ppR : PP_Doc
ppS : PP_Doc
ppW : PP_Doc
alternatives:
alternative Nonterminal:
child nt : {NontermIdent}
child params : {[Identifier]}
child inh : {Attributes}
child syn : {Attributes}
child prods : Productions
-}
-- cata
sem_Nonterminal :: Nonterminal ->
T_Nonterminal
sem_Nonterminal (Nonterminal _nt _params _inh _syn _prods ) =
(sem_Nonterminal_Nonterminal _nt _params _inh _syn (sem_Productions _prods ) )
-- semantic domain
newtype T_Nonterminal = T_Nonterminal (Derivings ->
TypeSyns ->
( PP_Doc,PP_Doc,PP_Doc,PP_Doc,PP_Doc,PP_Doc,PP_Doc))
data Inh_Nonterminal = Inh_Nonterminal {derivs_Inh_Nonterminal :: Derivings,tSyns_Inh_Nonterminal :: TypeSyns}
data Syn_Nonterminal = Syn_Nonterminal {ppA_Syn_Nonterminal :: PP_Doc,ppD_Syn_Nonterminal :: PP_Doc,ppL_Syn_Nonterminal :: PP_Doc,ppNtL_Syn_Nonterminal :: PP_Doc,ppR_Syn_Nonterminal :: PP_Doc,ppS_Syn_Nonterminal :: PP_Doc,ppW_Syn_Nonterminal :: PP_Doc}
wrap_Nonterminal :: T_Nonterminal ->
Inh_Nonterminal ->
Syn_Nonterminal
wrap_Nonterminal (T_Nonterminal sem ) (Inh_Nonterminal _lhsIderivs _lhsItSyns ) =
(let ( _lhsOppA,_lhsOppD,_lhsOppL,_lhsOppNtL,_lhsOppR,_lhsOppS,_lhsOppW) = sem _lhsIderivs _lhsItSyns
in (Syn_Nonterminal _lhsOppA _lhsOppD _lhsOppL _lhsOppNtL _lhsOppR _lhsOppS _lhsOppW ))
sem_Nonterminal_Nonterminal :: NontermIdent ->
([Identifier]) ->
Attributes ->
Attributes ->
T_Productions ->
T_Nonterminal
sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ (T_Productions prods_ ) =
(T_Nonterminal (\ _lhsIderivs
_lhsItSyns ->
(let _prodsOppNt :: PP_Doc
_lhsOppD :: PP_Doc
_lhsOppL :: PP_Doc
_lhsOppA :: PP_Doc
_lhsOppNtL :: PP_Doc
_lhsOppR :: PP_Doc
_lhsOppS :: PP_Doc
_lhsOppW :: PP_Doc
_prodsIppA :: PP_Doc
_prodsIppDL :: ([PP_Doc])
_prodsIppL :: PP_Doc
_prodsIppR :: PP_Doc
_prodsIppS :: PP_Doc
_prodsIppSF :: PP_Doc
-- "AG2AspectAG.ag"(line 50, column 25)
_prodsOppNt =
({-# LINE 50 "AG2AspectAG.ag" #-}
pp nt_
{-# LINE 775 "AG2AspectAG.hs" #-})
-- "AG2AspectAG.ag"(line 69, column 25)
_lhsOppD =
({-# LINE 69 "AG2AspectAG.ag" #-}
case (lookup nt_ _lhsItSyns) of
Nothing -> pp "data " >|< pp nt_ >|< " = " >|< vlist_sep " | " _prodsIppDL >-<
case (Map.lookup nt_ _lhsIderivs) of
Just ntds -> pp " deriving " >|< (ppListSep "(" ")" ", " $ Set.elems ntds)
Nothing -> empty
Just tp -> pp "type " >|< pp nt_ >|< " = " >|< ppShow tp
{-# LINE 785 "AG2AspectAG.hs" #-})
-- "AG2AspectAG.ag"(line 113, column 25)
_lhsOppL =
({-# LINE 113 "AG2AspectAG.ag" #-}
pp "nt_" >|< pp nt_ >|< " = proxy :: Proxy " >|< pp nt_ >-<
_prodsIppL
{-# LINE 791 "AG2AspectAG.hs" #-})
-- "AG2AspectAG.ag"(line 135, column 25)
_lhsOppA =
({-# LINE 135 "AG2AspectAG.ag" #-}
defTAtt "inh" (pp nt_) inh_ >-<
defTAtt "syn" (pp nt_) syn_ >-<
_prodsIppA
{-# LINE 798 "AG2AspectAG.hs" #-})
-- "AG2AspectAG.ag"(line 180, column 25)
_lhsOppNtL =
({-# LINE 180 "AG2AspectAG.ag" #-}
pp "nt_" >|< pp nt_ >|< pp " .*. "
{-# LINE 803 "AG2AspectAG.hs" #-})
-- "AG2AspectAG.ag"(line 187, column 25)
_lhsOppR =
({-# LINE 187 "AG2AspectAG.ag" #-}
pp "----" >|< pp nt_ >-< _prodsIppR
{-# LINE 808 "AG2AspectAG.hs" #-})
-- "AG2AspectAG.ag"(line 347, column 25)
_lhsOppS =
({-# LINE 347 "AG2AspectAG.ag" #-}
let ppNt = pp nt_
in pp "----" >|< ppNt >-<
pp "type T_" >|< ppNt >|< pp " = " >|<
pp "(Record (HCons (LVPair (Proxy Att_inh) Inh_" >|< ppNt >|< pp ") HNil)) -> " >|<
pp "(Record (HCons (LVPair (Proxy Att_syn) Syn_" >|< ppNt >|< pp ") HNil))" >-<
pp "instance SemType T_" >|< ppNt >|< pp " " >|< ppNt >-<
_prodsIppS >-<
pp "-- sem_" >|< ppNt >|< pp " :: " >|< ppNt >|< pp " -> T_" >|< ppNt >-<
_prodsIppSF
{-# LINE 821 "AG2AspectAG.hs" #-})
-- "AG2AspectAG.ag"(line 406, column 25)
_lhsOppW =
({-# LINE 406 "AG2AspectAG.ag" #-}
pp "wrap_" >|< pp nt_ >|< pp " sem _inh = " >-<
pp " let (Record (HCons _syn HNil)) = sem (att_inh .=. _inh .*. emptyRecord)" >|<
pp " in (valueLVPair _syn)"
{-# LINE 828 "AG2AspectAG.hs" #-})
( _prodsIppA,_prodsIppDL,_prodsIppL,_prodsIppR,_prodsIppS,_prodsIppSF) =
prods_ _prodsOppNt
in ( _lhsOppA,_lhsOppD,_lhsOppL,_lhsOppNtL,_lhsOppR,_lhsOppS,_lhsOppW))) )
-- Nonterminals ------------------------------------------------
{-
visit 0:
inherited attributes:
derivs : Derivings
tSyns : TypeSyns
synthesized attributes:
ppA : PP_Doc
ppD : PP_Doc
ppL : PP_Doc
ppNtL : PP_Doc
ppR : PP_Doc
ppS : PP_Doc
ppW : PP_Doc
alternatives:
alternative Cons:
child hd : Nonterminal
child tl : Nonterminals
alternative Nil:
-}
-- cata
sem_Nonterminals :: Nonterminals ->
T_Nonterminals
sem_Nonterminals list =
(Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list) )
-- semantic domain
newtype T_Nonterminals = T_Nonterminals (Derivings ->
TypeSyns ->
( PP_Doc,PP_Doc,PP_Doc,PP_Doc,PP_Doc,PP_Doc,PP_Doc))
data Inh_Nonterminals = Inh_Nonterminals {derivs_Inh_Nonterminals :: Derivings,tSyns_Inh_Nonterminals :: TypeSyns}
data Syn_Nonterminals = Syn_Nonterminals {ppA_Syn_Nonterminals :: PP_Doc,ppD_Syn_Nonterminals :: PP_Doc,ppL_Syn_Nonterminals :: PP_Doc,ppNtL_Syn_Nonterminals :: PP_Doc,ppR_Syn_Nonterminals :: PP_Doc,ppS_Syn_Nonterminals :: PP_Doc,ppW_Syn_Nonterminals :: PP_Doc}
wrap_Nonterminals :: T_Nonterminals ->
Inh_Nonterminals ->
Syn_Nonterminals
wrap_Nonterminals (T_Nonterminals sem ) (Inh_Nonterminals _lhsIderivs _lhsItSyns ) =
(let ( _lhsOppA,_lhsOppD,_lhsOppL,_lhsOppNtL,_lhsOppR,_lhsOppS,_lhsOppW) = sem _lhsIderivs _lhsItSyns
in (Syn_Nonterminals _lhsOppA _lhsOppD _lhsOppL _lhsOppNtL _lhsOppR _lhsOppS _lhsOppW ))
sem_Nonterminals_Cons :: T_Nonterminal ->
T_Nonterminals ->
T_Nonterminals
sem_Nonterminals_Cons (T_Nonterminal hd_ ) (T_Nonterminals tl_ ) =
(T_Nonterminals (\ _lhsIderivs
_lhsItSyns ->
(let _lhsOppA :: PP_Doc
_lhsOppD :: PP_Doc
_lhsOppL :: PP_Doc
_lhsOppNtL :: PP_Doc
_lhsOppR :: PP_Doc
_lhsOppS :: PP_Doc
_lhsOppW :: PP_Doc
_hdOderivs :: Derivings
_hdOtSyns :: TypeSyns
_tlOderivs :: Derivings
_tlOtSyns :: TypeSyns
_hdIppA :: PP_Doc
_hdIppD :: PP_Doc
_hdIppL :: PP_Doc
_hdIppNtL :: PP_Doc
_hdIppR :: PP_Doc
_hdIppS :: PP_Doc
_hdIppW :: PP_Doc
_tlIppA :: PP_Doc
_tlIppD :: PP_Doc
_tlIppL :: PP_Doc
_tlIppNtL :: PP_Doc
_tlIppR :: PP_Doc
_tlIppS :: PP_Doc
_tlIppW :: PP_Doc
-- use rule "AG2AspectAG.ag"(line 132, column 64)
_lhsOppA =
({-# LINE 132 "AG2AspectAG.ag" #-}
_hdIppA >-< _tlIppA
{-# LINE 904 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 66, column 52)
_lhsOppD =
({-# LINE 66 "AG2AspectAG.ag" #-}
_hdIppD >-< _tlIppD
{-# LINE 909 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 110, column 79)
_lhsOppL =
({-# LINE 110 "AG2AspectAG.ag" #-}
_hdIppL >-< _tlIppL
{-# LINE 914 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 177, column 44)
_lhsOppNtL =
({-# LINE 177 "AG2AspectAG.ag" #-}
_hdIppNtL >|< _tlIppNtL
{-# LINE 919 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 184, column 79)
_lhsOppR =
({-# LINE 184 "AG2AspectAG.ag" #-}
_hdIppR >-< _tlIppR
{-# LINE 924 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 344, column 64)
_lhsOppS =
({-# LINE 344 "AG2AspectAG.ag" #-}
_hdIppS >-< _tlIppS
{-# LINE 929 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 403, column 42)
_lhsOppW =
({-# LINE 403 "AG2AspectAG.ag" #-}
_hdIppW >-< _tlIppW
{-# LINE 934 "AG2AspectAG.hs" #-})
-- copy rule (down)
_hdOderivs =
({-# LINE 60 "AG2AspectAG.ag" #-}
_lhsIderivs
{-# LINE 939 "AG2AspectAG.hs" #-})
-- copy rule (down)
_hdOtSyns =
({-# LINE 99 "AG2AspectAG.ag" #-}
_lhsItSyns
{-# LINE 944 "AG2AspectAG.hs" #-})
-- copy rule (down)
_tlOderivs =
({-# LINE 60 "AG2AspectAG.ag" #-}
_lhsIderivs
{-# LINE 949 "AG2AspectAG.hs" #-})
-- copy rule (down)
_tlOtSyns =
({-# LINE 99 "AG2AspectAG.ag" #-}
_lhsItSyns
{-# LINE 954 "AG2AspectAG.hs" #-})
( _hdIppA,_hdIppD,_hdIppL,_hdIppNtL,_hdIppR,_hdIppS,_hdIppW) =
hd_ _hdOderivs _hdOtSyns
( _tlIppA,_tlIppD,_tlIppL,_tlIppNtL,_tlIppR,_tlIppS,_tlIppW) =
tl_ _tlOderivs _tlOtSyns
in ( _lhsOppA,_lhsOppD,_lhsOppL,_lhsOppNtL,_lhsOppR,_lhsOppS,_lhsOppW))) )
sem_Nonterminals_Nil :: T_Nonterminals
sem_Nonterminals_Nil =
(T_Nonterminals (\ _lhsIderivs
_lhsItSyns ->
(let _lhsOppA :: PP_Doc
_lhsOppD :: PP_Doc
_lhsOppL :: PP_Doc
_lhsOppNtL :: PP_Doc
_lhsOppR :: PP_Doc
_lhsOppS :: PP_Doc
_lhsOppW :: PP_Doc
-- use rule "AG2AspectAG.ag"(line 132, column 64)
_lhsOppA =
({-# LINE 132 "AG2AspectAG.ag" #-}
empty
{-# LINE 975 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 66, column 52)
_lhsOppD =
({-# LINE 66 "AG2AspectAG.ag" #-}
empty
{-# LINE 980 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 110, column 79)
_lhsOppL =
({-# LINE 110 "AG2AspectAG.ag" #-}
empty
{-# LINE 985 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 177, column 44)
_lhsOppNtL =
({-# LINE 177 "AG2AspectAG.ag" #-}
pp "hNil"
{-# LINE 990 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 184, column 79)
_lhsOppR =
({-# LINE 184 "AG2AspectAG.ag" #-}
empty
{-# LINE 995 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 344, column 64)
_lhsOppS =
({-# LINE 344 "AG2AspectAG.ag" #-}
empty
{-# LINE 1000 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 403, column 42)
_lhsOppW =
({-# LINE 403 "AG2AspectAG.ag" #-}
empty
{-# LINE 1005 "AG2AspectAG.hs" #-})
in ( _lhsOppA,_lhsOppD,_lhsOppL,_lhsOppNtL,_lhsOppR,_lhsOppS,_lhsOppW))) )
-- Pattern -----------------------------------------------------
{-
visit 0:
synthesized attributes:
copy : SELF
info : (Identifier, Identifier)
alternatives:
alternative Alias:
child field : {Identifier}
child attr : {Identifier}
child pat : Pattern
child parts : Patterns
visit 0:
local copy : _
alternative Constr:
child name : {ConstructorIdent}
child pats : Patterns
visit 0:
local copy : _
alternative Irrefutable:
child pat : Pattern
visit 0:
local copy : _
alternative Product:
child pos : {Pos}
child pats : Patterns
visit 0:
local copy : _
alternative Underscore:
child pos : {Pos}
visit 0:
local copy : _
-}
-- cata
sem_Pattern :: Pattern ->
T_Pattern
sem_Pattern (Alias _field _attr _pat _parts ) =
(sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) )
sem_Pattern (Constr _name _pats ) =
(sem_Pattern_Constr _name (sem_Patterns _pats ) )
sem_Pattern (Irrefutable _pat ) =
(sem_Pattern_Irrefutable (sem_Pattern _pat ) )
sem_Pattern (Product _pos _pats ) =
(sem_Pattern_Product _pos (sem_Patterns _pats ) )
sem_Pattern (Underscore _pos ) =
(sem_Pattern_Underscore _pos )
-- semantic domain
newtype T_Pattern = T_Pattern (( Pattern ,((Identifier, Identifier))))
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 sem ) (Inh_Pattern ) =
(let ( _lhsOcopy,_lhsOinfo) = sem
in (Syn_Pattern _lhsOcopy _lhsOinfo ))
sem_Pattern_Alias :: Identifier ->
Identifier ->
T_Pattern ->
T_Patterns ->
T_Pattern
sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) =
(T_Pattern (let _lhsOinfo :: ((Identifier, Identifier))
_lhsOcopy :: Pattern
_patIcopy :: Pattern
_patIinfo :: ((Identifier, Identifier))
_partsIcopy :: Patterns
-- "AG2AspectAG.ag"(line 204, column 25)
_lhsOinfo =
({-# LINE 204 "AG2AspectAG.ag" #-}
(field_, attr_)
{-# LINE 1078 "AG2AspectAG.hs" #-})
-- self rule
_copy =
({-# LINE 23 "./Patterns.ag" #-}
Alias field_ attr_ _patIcopy _partsIcopy
{-# LINE 1083 "AG2AspectAG.hs" #-})
-- self rule
_lhsOcopy =
({-# LINE 23 "./Patterns.ag" #-}
_copy
{-# LINE 1088 "AG2AspectAG.hs" #-})
( _patIcopy,_patIinfo) =
pat_
( _partsIcopy) =
parts_
in ( _lhsOcopy,_lhsOinfo)) )
sem_Pattern_Constr :: ConstructorIdent ->
T_Patterns ->
T_Pattern
sem_Pattern_Constr name_ (T_Patterns pats_ ) =
(T_Pattern (let _lhsOinfo :: ((Identifier, Identifier))
_lhsOcopy :: Pattern
_patsIcopy :: Patterns
-- "AG2AspectAG.ag"(line 205, column 25)
_lhsOinfo =
({-# LINE 205 "AG2AspectAG.ag" #-}
error "Pattern Constr undefined!!"
{-# LINE 1105 "AG2AspectAG.hs" #-})
-- self rule
_copy =
({-# LINE 23 "./Patterns.ag" #-}
Constr name_ _patsIcopy
{-# LINE 1110 "AG2AspectAG.hs" #-})
-- self rule
_lhsOcopy =
({-# LINE 23 "./Patterns.ag" #-}
_copy
{-# LINE 1115 "AG2AspectAG.hs" #-})
( _patsIcopy) =
pats_
in ( _lhsOcopy,_lhsOinfo)) )
sem_Pattern_Irrefutable :: T_Pattern ->
T_Pattern
sem_Pattern_Irrefutable (T_Pattern pat_ ) =
(T_Pattern (let _lhsOcopy :: Pattern
_lhsOinfo :: ((Identifier, Identifier))
_patIcopy :: Pattern
_patIinfo :: ((Identifier, Identifier))
-- self rule
_copy =
({-# LINE 23 "./Patterns.ag" #-}
Irrefutable _patIcopy
{-# LINE 1130 "AG2AspectAG.hs" #-})
-- self rule
_lhsOcopy =
({-# LINE 23 "./Patterns.ag" #-}
_copy
{-# LINE 1135 "AG2AspectAG.hs" #-})
-- copy rule (up)
_lhsOinfo =
({-# LINE 202 "AG2AspectAG.ag" #-}
_patIinfo
{-# LINE 1140 "AG2AspectAG.hs" #-})
( _patIcopy,_patIinfo) =
pat_
in ( _lhsOcopy,_lhsOinfo)) )
sem_Pattern_Product :: Pos ->
T_Patterns ->
T_Pattern
sem_Pattern_Product pos_ (T_Patterns pats_ ) =
(T_Pattern (let _lhsOinfo :: ((Identifier, Identifier))
_lhsOcopy :: Pattern
_patsIcopy :: Patterns
-- "AG2AspectAG.ag"(line 206, column 25)
_lhsOinfo =
({-# LINE 206 "AG2AspectAG.ag" #-}
error "Pattern Product undefined!!"
{-# LINE 1155 "AG2AspectAG.hs" #-})
-- self rule
_copy =
({-# LINE 23 "./Patterns.ag" #-}
Product pos_ _patsIcopy
{-# LINE 1160 "AG2AspectAG.hs" #-})
-- self rule
_lhsOcopy =
({-# LINE 23 "./Patterns.ag" #-}
_copy
{-# LINE 1165 "AG2AspectAG.hs" #-})
( _patsIcopy) =
pats_
in ( _lhsOcopy,_lhsOinfo)) )
sem_Pattern_Underscore :: Pos ->
T_Pattern
sem_Pattern_Underscore pos_ =
(T_Pattern (let _lhsOinfo :: ((Identifier, Identifier))
_lhsOcopy :: Pattern
-- "AG2AspectAG.ag"(line 207, column 25)
_lhsOinfo =
({-# LINE 207 "AG2AspectAG.ag" #-}
error "Pattern Underscore undefined!!"
{-# LINE 1178 "AG2AspectAG.hs" #-})
-- self rule
_copy =
({-# LINE 23 "./Patterns.ag" #-}
Underscore pos_
{-# LINE 1183 "AG2AspectAG.hs" #-})
-- self rule
_lhsOcopy =
({-# LINE 23 "./Patterns.ag" #-}
_copy
{-# LINE 1188 "AG2AspectAG.hs" #-})
in ( _lhsOcopy,_lhsOinfo)) )
-- Patterns ----------------------------------------------------
{-
visit 0:
synthesized attribute:
copy : SELF
alternatives:
alternative Cons:
child hd : Pattern
child tl : Patterns
visit 0:
local copy : _
alternative Nil:
visit 0:
local copy : _
-}
-- cata
sem_Patterns :: Patterns ->
T_Patterns
sem_Patterns list =
(Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) )
-- semantic domain
newtype T_Patterns = T_Patterns (( Patterns ))
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 sem ) (Inh_Patterns ) =
(let ( _lhsOcopy) = sem
in (Syn_Patterns _lhsOcopy ))
sem_Patterns_Cons :: T_Pattern ->
T_Patterns ->
T_Patterns
sem_Patterns_Cons (T_Pattern hd_ ) (T_Patterns tl_ ) =
(T_Patterns (let _lhsOcopy :: Patterns
_hdIcopy :: Pattern
_hdIinfo :: ((Identifier, Identifier))
_tlIcopy :: Patterns
-- self rule
_copy =
({-# LINE 23 "./Patterns.ag" #-}
(:) _hdIcopy _tlIcopy
{-# LINE 1232 "AG2AspectAG.hs" #-})
-- self rule
_lhsOcopy =
({-# LINE 23 "./Patterns.ag" #-}
_copy
{-# LINE 1237 "AG2AspectAG.hs" #-})
( _hdIcopy,_hdIinfo) =
hd_
( _tlIcopy) =
tl_
in ( _lhsOcopy)) )
sem_Patterns_Nil :: T_Patterns
sem_Patterns_Nil =
(T_Patterns (let _lhsOcopy :: Patterns
-- self rule
_copy =
({-# LINE 23 "./Patterns.ag" #-}
[]
{-# LINE 1250 "AG2AspectAG.hs" #-})
-- self rule
_lhsOcopy =
({-# LINE 23 "./Patterns.ag" #-}
_copy
{-# LINE 1255 "AG2AspectAG.hs" #-})
in ( _lhsOcopy)) )
-- Production --------------------------------------------------
{-
visit 0:
inherited attribute:
ppNt : PP_Doc
synthesized attributes:
ppA : PP_Doc
ppD : PP_Doc
ppL : PP_Doc
ppR : PP_Doc
ppS : PP_Doc
ppSF : PP_Doc
alternatives:
alternative Production:
child con : {ConstructorIdent}
child children : Children
child rules : Rules
child typeSigs : TypeSigs
-}
-- cata
sem_Production :: Production ->
T_Production
sem_Production (Production _con _children _rules _typeSigs ) =
(sem_Production_Production _con (sem_Children _children ) (sem_Rules _rules ) (sem_TypeSigs _typeSigs ) )
-- semantic domain
newtype T_Production = T_Production (PP_Doc ->
( PP_Doc,PP_Doc,PP_Doc,PP_Doc,PP_Doc,PP_Doc))
data Inh_Production = Inh_Production {ppNt_Inh_Production :: PP_Doc}
data Syn_Production = Syn_Production {ppA_Syn_Production :: PP_Doc,ppD_Syn_Production :: PP_Doc,ppL_Syn_Production :: PP_Doc,ppR_Syn_Production :: PP_Doc,ppS_Syn_Production :: PP_Doc,ppSF_Syn_Production :: PP_Doc}
wrap_Production :: T_Production ->
Inh_Production ->
Syn_Production
wrap_Production (T_Production sem ) (Inh_Production _lhsIppNt ) =
(let ( _lhsOppA,_lhsOppD,_lhsOppL,_lhsOppR,_lhsOppS,_lhsOppSF) = sem _lhsIppNt
in (Syn_Production _lhsOppA _lhsOppD _lhsOppL _lhsOppR _lhsOppS _lhsOppSF ))
sem_Production_Production :: ConstructorIdent ->
T_Children ->
T_Rules ->
T_TypeSigs ->
T_Production
sem_Production_Production con_ (T_Children children_ ) (T_Rules rules_ ) (T_TypeSigs typeSigs_ ) =
(T_Production (\ _lhsIppNt ->
(let _childrenOppProd :: PP_Doc
_rulesOppProd :: PP_Doc
_lhsOppD :: PP_Doc
_lhsOppA :: PP_Doc
_lhsOppR :: PP_Doc
_lhsOppS :: PP_Doc
_lhsOppSF :: PP_Doc
_lhsOppL :: PP_Doc
_childrenOppNt :: PP_Doc
_rulesOppNt :: PP_Doc
_childrenIidCL :: ([(Identifier,Type)])
_childrenIppCSF :: ([(Identifier,PP_Doc)])
_childrenIppDL :: ([PP_Doc])
_childrenIppL :: PP_Doc
_childrenIppR :: PP_Doc
_rulesIlocals :: ([Identifier])
_rulesIppRL :: ([((Identifier,Identifier),[(Identifier,Type)] -> [Identifier] -> PP_Doc)])
-- "AG2AspectAG.ag"(line 56, column 25)
_childrenOppProd =
({-# LINE 56 "AG2AspectAG.ag" #-}
pp con_
{-# LINE 1320 "AG2AspectAG.hs" #-})
-- "AG2AspectAG.ag"(line 57, column 25)
_rulesOppProd =
({-# LINE 57 "AG2AspectAG.ag" #-}
pp con_
{-# LINE 1325 "AG2AspectAG.hs" #-})
-- "AG2AspectAG.ag"(line 78, column 25)
_lhsOppD =
({-# LINE 78 "AG2AspectAG.ag" #-}
let prodName = ppListSep "" "" "_" [_lhsIppNt, pp con_]
in prodName >|< ppListSep " {" "}" ", " _childrenIppDL
{-# LINE 1331 "AG2AspectAG.hs" #-})
-- "AG2AspectAG.ag"(line 140, column 25)
_lhsOppA =
({-# LINE 140 "AG2AspectAG.ag" #-}
defLocalAtts _lhsIppNt (pp con_) (length _rulesIlocals) 1 $ sort _rulesIlocals
{-# LINE 1336 "AG2AspectAG.hs" #-})
-- "AG2AspectAG.ag"(line 190, column 25)
_lhsOppR =
({-# LINE 190 "AG2AspectAG.ag" #-}
defInstRules _lhsIppNt con_ _childrenIppR _rulesIppRL _childrenIidCL _rulesIlocals >-<
defLocRule _lhsIppNt con_ _childrenIppR _rulesIppRL _childrenIidCL _rulesIlocals >-<
defInhRule _lhsIppNt con_ _childrenIppR _rulesIppRL _childrenIidCL _rulesIlocals >-<
defSynRule _lhsIppNt con_ _childrenIppR _rulesIppRL _childrenIidCL _rulesIlocals
{-# LINE 1344 "AG2AspectAG.hs" #-})
-- "AG2AspectAG.ag"(line 359, column 25)
_lhsOppS =
({-# LINE 359 "AG2AspectAG.ag" #-}
let ppProd = ppListSep "" "" "_" [_lhsIppNt, pp con_]
in pp "asp_" >|< ppProd >|< pp " = inh_" >|< ppProd >|<
pp " `ext` syn_" >|< ppProd >|<
pp " `ext` loc_" >|< ppProd >|<
pp " `ext` inst_" >|< ppProd >-<
pp "sem_" >|< ppProd >|< pp " = knit asp_" >|< ppProd
{-# LINE 1354 "AG2AspectAG.hs" #-})
-- "AG2AspectAG.ag"(line 370, column 25)
_lhsOppSF =
({-# LINE 370 "AG2AspectAG.ag" #-}
let chi = _childrenIppCSF
ppProd = ppListSep "" "" "_" [_lhsIppNt,pp con_]
ppPattern = case (show con_) of
"Cons" -> ppParams (ppListSep "" "" " : ")
"Nil" -> pp "[]"
otherwise -> ppProd >|< pp " " >|< (ppParams ppSpaced)
ppParams f = f $ map (((>|<) (pp "_")) . fst) chi
in pp "sem_" >|< _lhsIppNt >|< pp " (" >|< ppPattern >|< ") = sem_" >|< ppProd >|<
pp " (" >|< map snd chi >|< pp "emptyRecord)"
{-# LINE 1367 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 110, column 79)
_lhsOppL =
({-# LINE 110 "AG2AspectAG.ag" #-}
_childrenIppL
{-# LINE 1372 "AG2AspectAG.hs" #-})
-- copy rule (down)
_childrenOppNt =
({-# LINE 47 "AG2AspectAG.ag" #-}
_lhsIppNt
{-# LINE 1377 "AG2AspectAG.hs" #-})
-- copy rule (down)
_rulesOppNt =
({-# LINE 47 "AG2AspectAG.ag" #-}
_lhsIppNt
{-# LINE 1382 "AG2AspectAG.hs" #-})
( _childrenIidCL,_childrenIppCSF,_childrenIppDL,_childrenIppL,_childrenIppR) =
children_ _childrenOppNt _childrenOppProd
( _rulesIlocals,_rulesIppRL) =
rules_ _rulesOppNt _rulesOppProd
in ( _lhsOppA,_lhsOppD,_lhsOppL,_lhsOppR,_lhsOppS,_lhsOppSF))) )
-- Productions -------------------------------------------------
{-
visit 0:
inherited attribute:
ppNt : PP_Doc
synthesized attributes:
ppA : PP_Doc
ppDL : [PP_Doc]
ppL : PP_Doc
ppR : PP_Doc
ppS : PP_Doc
ppSF : PP_Doc
alternatives:
alternative Cons:
child hd : Production
child tl : Productions
alternative Nil:
-}
-- cata
sem_Productions :: Productions ->
T_Productions
sem_Productions list =
(Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list) )
-- semantic domain
newtype T_Productions = T_Productions (PP_Doc ->
( PP_Doc,([PP_Doc]),PP_Doc,PP_Doc,PP_Doc,PP_Doc))
data Inh_Productions = Inh_Productions {ppNt_Inh_Productions :: PP_Doc}
data Syn_Productions = Syn_Productions {ppA_Syn_Productions :: PP_Doc,ppDL_Syn_Productions :: ([PP_Doc]),ppL_Syn_Productions :: PP_Doc,ppR_Syn_Productions :: PP_Doc,ppS_Syn_Productions :: PP_Doc,ppSF_Syn_Productions :: PP_Doc}
wrap_Productions :: T_Productions ->
Inh_Productions ->
Syn_Productions
wrap_Productions (T_Productions sem ) (Inh_Productions _lhsIppNt ) =
(let ( _lhsOppA,_lhsOppDL,_lhsOppL,_lhsOppR,_lhsOppS,_lhsOppSF) = sem _lhsIppNt
in (Syn_Productions _lhsOppA _lhsOppDL _lhsOppL _lhsOppR _lhsOppS _lhsOppSF ))
sem_Productions_Cons :: T_Production ->
T_Productions ->
T_Productions
sem_Productions_Cons (T_Production hd_ ) (T_Productions tl_ ) =
(T_Productions (\ _lhsIppNt ->
(let _lhsOppDL :: ([PP_Doc])
_lhsOppA :: PP_Doc
_lhsOppL :: PP_Doc
_lhsOppR :: PP_Doc
_lhsOppS :: PP_Doc
_lhsOppSF :: PP_Doc
_hdOppNt :: PP_Doc
_tlOppNt :: PP_Doc
_hdIppA :: PP_Doc
_hdIppD :: PP_Doc
_hdIppL :: PP_Doc
_hdIppR :: PP_Doc
_hdIppS :: PP_Doc
_hdIppSF :: PP_Doc
_tlIppA :: PP_Doc
_tlIppDL :: ([PP_Doc])
_tlIppL :: PP_Doc
_tlIppR :: PP_Doc
_tlIppS :: PP_Doc
_tlIppSF :: PP_Doc
-- "AG2AspectAG.ag"(line 85, column 33)
_lhsOppDL =
({-# LINE 85 "AG2AspectAG.ag" #-}
_hdIppD : _tlIppDL
{-# LINE 1451 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 132, column 64)
_lhsOppA =
({-# LINE 132 "AG2AspectAG.ag" #-}
_hdIppA >-< _tlIppA
{-# LINE 1456 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 110, column 79)
_lhsOppL =
({-# LINE 110 "AG2AspectAG.ag" #-}
_hdIppL >-< _tlIppL
{-# LINE 1461 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 184, column 79)
_lhsOppR =
({-# LINE 184 "AG2AspectAG.ag" #-}
_hdIppR >-< _tlIppR
{-# LINE 1466 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 344, column 64)
_lhsOppS =
({-# LINE 344 "AG2AspectAG.ag" #-}
_hdIppS >-< _tlIppS
{-# LINE 1471 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 368, column 41)
_lhsOppSF =
({-# LINE 368 "AG2AspectAG.ag" #-}
_hdIppSF >-< _tlIppSF
{-# LINE 1476 "AG2AspectAG.hs" #-})
-- copy rule (down)
_hdOppNt =
({-# LINE 47 "AG2AspectAG.ag" #-}
_lhsIppNt
{-# LINE 1481 "AG2AspectAG.hs" #-})
-- copy rule (down)
_tlOppNt =
({-# LINE 47 "AG2AspectAG.ag" #-}
_lhsIppNt
{-# LINE 1486 "AG2AspectAG.hs" #-})
( _hdIppA,_hdIppD,_hdIppL,_hdIppR,_hdIppS,_hdIppSF) =
hd_ _hdOppNt
( _tlIppA,_tlIppDL,_tlIppL,_tlIppR,_tlIppS,_tlIppSF) =
tl_ _tlOppNt
in ( _lhsOppA,_lhsOppDL,_lhsOppL,_lhsOppR,_lhsOppS,_lhsOppSF))) )
sem_Productions_Nil :: T_Productions
sem_Productions_Nil =
(T_Productions (\ _lhsIppNt ->
(let _lhsOppDL :: ([PP_Doc])
_lhsOppA :: PP_Doc
_lhsOppL :: PP_Doc
_lhsOppR :: PP_Doc
_lhsOppS :: PP_Doc
_lhsOppSF :: PP_Doc
-- "AG2AspectAG.ag"(line 86, column 33)
_lhsOppDL =
({-# LINE 86 "AG2AspectAG.ag" #-}
[]
{-# LINE 1505 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 132, column 64)
_lhsOppA =
({-# LINE 132 "AG2AspectAG.ag" #-}
empty
{-# LINE 1510 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 110, column 79)
_lhsOppL =
({-# LINE 110 "AG2AspectAG.ag" #-}
empty
{-# LINE 1515 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 184, column 79)
_lhsOppR =
({-# LINE 184 "AG2AspectAG.ag" #-}
empty
{-# LINE 1520 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 344, column 64)
_lhsOppS =
({-# LINE 344 "AG2AspectAG.ag" #-}
empty
{-# LINE 1525 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 368, column 41)
_lhsOppSF =
({-# LINE 368 "AG2AspectAG.ag" #-}
empty
{-# LINE 1530 "AG2AspectAG.hs" #-})
in ( _lhsOppA,_lhsOppDL,_lhsOppL,_lhsOppR,_lhsOppS,_lhsOppSF))) )
-- Rule --------------------------------------------------------
{-
visit 0:
inherited attributes:
ppNt : PP_Doc
ppProd : PP_Doc
synthesized attributes:
locals : [Identifier]
ppRL : [((Identifier,Identifier),[(Identifier,Type)] -> [Identifier] -> PP_Doc)]
alternatives:
alternative Rule:
child mbName : {Maybe Identifier}
child pattern : Pattern
child rhs : Expression
child owrt : {Bool}
child origin : {String}
child explicit : {Bool}
-}
-- cata
sem_Rule :: Rule ->
T_Rule
sem_Rule (Rule _mbName _pattern _rhs _owrt _origin _explicit ) =
(sem_Rule_Rule _mbName (sem_Pattern _pattern ) (sem_Expression _rhs ) _owrt _origin _explicit )
-- semantic domain
newtype T_Rule = T_Rule (PP_Doc ->
PP_Doc ->
( ([Identifier]),([((Identifier,Identifier),[(Identifier,Type)] -> [Identifier] -> PP_Doc)])))
data Inh_Rule = Inh_Rule {ppNt_Inh_Rule :: PP_Doc,ppProd_Inh_Rule :: PP_Doc}
data Syn_Rule = Syn_Rule {locals_Syn_Rule :: ([Identifier]),ppRL_Syn_Rule :: ([((Identifier,Identifier),[(Identifier,Type)] -> [Identifier] -> PP_Doc)])}
wrap_Rule :: T_Rule ->
Inh_Rule ->
Syn_Rule
wrap_Rule (T_Rule sem ) (Inh_Rule _lhsIppNt _lhsIppProd ) =
(let ( _lhsOlocals,_lhsOppRL) = sem _lhsIppNt _lhsIppProd
in (Syn_Rule _lhsOlocals _lhsOppRL ))
sem_Rule_Rule :: (Maybe Identifier) ->
T_Pattern ->
T_Expression ->
Bool ->
String ->
Bool ->
T_Rule
sem_Rule_Rule mbName_ (T_Pattern pattern_ ) (T_Expression rhs_ ) owrt_ origin_ explicit_ =
(T_Rule (\ _lhsIppNt
_lhsIppProd ->
(let _lhsOlocals :: ([Identifier])
_lhsOppRL :: ([((Identifier,Identifier),[(Identifier,Type)] -> [Identifier] -> PP_Doc)])
_rhsOppNt :: PP_Doc
_rhsOppProd :: PP_Doc
_patternIcopy :: Pattern
_patternIinfo :: ((Identifier, Identifier))
_rhsIppRE :: (Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc)
-- "AG2AspectAG.ag"(line 170, column 25)
_lhsOlocals =
({-# LINE 170 "AG2AspectAG.ag" #-}
if (show (fst _patternIinfo) == "loc")
then [ snd _patternIinfo ]
else [ ]
{-# LINE 1590 "AG2AspectAG.hs" #-})
-- "AG2AspectAG.ag"(line 217, column 33)
_lhsOppRL =
({-# LINE 217 "AG2AspectAG.ag" #-}
[ (_patternIinfo, defRule _lhsIppNt _patternIinfo _rhsIppRE) ]
{-# LINE 1595 "AG2AspectAG.hs" #-})
-- copy rule (down)
_rhsOppNt =
({-# LINE 47 "AG2AspectAG.ag" #-}
_lhsIppNt
{-# LINE 1600 "AG2AspectAG.hs" #-})
-- copy rule (down)
_rhsOppProd =
({-# LINE 53 "AG2AspectAG.ag" #-}
_lhsIppProd
{-# LINE 1605 "AG2AspectAG.hs" #-})
( _patternIcopy,_patternIinfo) =
pattern_
( _rhsIppRE) =
rhs_ _rhsOppNt _rhsOppProd
in ( _lhsOlocals,_lhsOppRL))) )
-- Rules -------------------------------------------------------
{-
visit 0:
inherited attributes:
ppNt : PP_Doc
ppProd : PP_Doc
synthesized attributes:
locals : [Identifier]
ppRL : [((Identifier,Identifier),[(Identifier,Type)] -> [Identifier] -> PP_Doc)]
alternatives:
alternative Cons:
child hd : Rule
child tl : Rules
alternative Nil:
-}
-- cata
sem_Rules :: Rules ->
T_Rules
sem_Rules list =
(Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list) )
-- semantic domain
newtype T_Rules = T_Rules (PP_Doc ->
PP_Doc ->
( ([Identifier]),([((Identifier,Identifier),[(Identifier,Type)] -> [Identifier] -> PP_Doc)])))
data Inh_Rules = Inh_Rules {ppNt_Inh_Rules :: PP_Doc,ppProd_Inh_Rules :: PP_Doc}
data Syn_Rules = Syn_Rules {locals_Syn_Rules :: ([Identifier]),ppRL_Syn_Rules :: ([((Identifier,Identifier),[(Identifier,Type)] -> [Identifier] -> PP_Doc)])}
wrap_Rules :: T_Rules ->
Inh_Rules ->
Syn_Rules
wrap_Rules (T_Rules sem ) (Inh_Rules _lhsIppNt _lhsIppProd ) =
(let ( _lhsOlocals,_lhsOppRL) = sem _lhsIppNt _lhsIppProd
in (Syn_Rules _lhsOlocals _lhsOppRL ))
sem_Rules_Cons :: T_Rule ->
T_Rules ->
T_Rules
sem_Rules_Cons (T_Rule hd_ ) (T_Rules tl_ ) =
(T_Rules (\ _lhsIppNt
_lhsIppProd ->
(let _lhsOppRL :: ([((Identifier,Identifier),[(Identifier,Type)] -> [Identifier] -> PP_Doc)])
_lhsOlocals :: ([Identifier])
_hdOppNt :: PP_Doc
_hdOppProd :: PP_Doc
_tlOppNt :: PP_Doc
_tlOppProd :: PP_Doc
_hdIlocals :: ([Identifier])
_hdIppRL :: ([((Identifier,Identifier),[(Identifier,Type)] -> [Identifier] -> PP_Doc)])
_tlIlocals :: ([Identifier])
_tlIppRL :: ([((Identifier,Identifier),[(Identifier,Type)] -> [Identifier] -> PP_Doc)])
-- "AG2AspectAG.ag"(line 213, column 33)
_lhsOppRL =
({-# LINE 213 "AG2AspectAG.ag" #-}
_hdIppRL ++ _tlIppRL
{-# LINE 1663 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 166, column 30)
_lhsOlocals =
({-# LINE 166 "AG2AspectAG.ag" #-}
_hdIlocals ++ _tlIlocals
{-# LINE 1668 "AG2AspectAG.hs" #-})
-- copy rule (down)
_hdOppNt =
({-# LINE 47 "AG2AspectAG.ag" #-}
_lhsIppNt
{-# LINE 1673 "AG2AspectAG.hs" #-})
-- copy rule (down)
_hdOppProd =
({-# LINE 53 "AG2AspectAG.ag" #-}
_lhsIppProd
{-# LINE 1678 "AG2AspectAG.hs" #-})
-- copy rule (down)
_tlOppNt =
({-# LINE 47 "AG2AspectAG.ag" #-}
_lhsIppNt
{-# LINE 1683 "AG2AspectAG.hs" #-})
-- copy rule (down)
_tlOppProd =
({-# LINE 53 "AG2AspectAG.ag" #-}
_lhsIppProd
{-# LINE 1688 "AG2AspectAG.hs" #-})
( _hdIlocals,_hdIppRL) =
hd_ _hdOppNt _hdOppProd
( _tlIlocals,_tlIppRL) =
tl_ _tlOppNt _tlOppProd
in ( _lhsOlocals,_lhsOppRL))) )
sem_Rules_Nil :: T_Rules
sem_Rules_Nil =
(T_Rules (\ _lhsIppNt
_lhsIppProd ->
(let _lhsOppRL :: ([((Identifier,Identifier),[(Identifier,Type)] -> [Identifier] -> PP_Doc)])
_lhsOlocals :: ([Identifier])
-- "AG2AspectAG.ag"(line 214, column 33)
_lhsOppRL =
({-# LINE 214 "AG2AspectAG.ag" #-}
[]
{-# LINE 1704 "AG2AspectAG.hs" #-})
-- use rule "AG2AspectAG.ag"(line 166, column 30)
_lhsOlocals =
({-# LINE 166 "AG2AspectAG.ag" #-}
[]
{-# LINE 1709 "AG2AspectAG.hs" #-})
in ( _lhsOlocals,_lhsOppRL))) )
-- TypeSig -----------------------------------------------------
{-
alternatives:
alternative TypeSig:
child name : {Identifier}
child tp : {Type}
-}
-- cata
sem_TypeSig :: TypeSig ->
T_TypeSig
sem_TypeSig (TypeSig _name _tp ) =
(sem_TypeSig_TypeSig _name _tp )
-- semantic domain
newtype T_TypeSig = T_TypeSig (( ))
data Inh_TypeSig = Inh_TypeSig {}
data Syn_TypeSig = Syn_TypeSig {}
wrap_TypeSig :: T_TypeSig ->
Inh_TypeSig ->
Syn_TypeSig
wrap_TypeSig (T_TypeSig sem ) (Inh_TypeSig ) =
(let ( ) = sem
in (Syn_TypeSig ))
sem_TypeSig_TypeSig :: Identifier ->
Type ->
T_TypeSig
sem_TypeSig_TypeSig name_ tp_ =
(T_TypeSig (let
in ( )) )
-- TypeSigs ----------------------------------------------------
{-
alternatives:
alternative Cons:
child hd : TypeSig
child tl : TypeSigs
alternative Nil:
-}
-- cata
sem_TypeSigs :: TypeSigs ->
T_TypeSigs
sem_TypeSigs list =
(Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) )
-- semantic domain
newtype T_TypeSigs = T_TypeSigs (( ))
data Inh_TypeSigs = Inh_TypeSigs {}
data Syn_TypeSigs = Syn_TypeSigs {}
wrap_TypeSigs :: T_TypeSigs ->
Inh_TypeSigs ->
Syn_TypeSigs
wrap_TypeSigs (T_TypeSigs sem ) (Inh_TypeSigs ) =
(let ( ) = sem
in (Syn_TypeSigs ))
sem_TypeSigs_Cons :: T_TypeSig ->
T_TypeSigs ->
T_TypeSigs
sem_TypeSigs_Cons (T_TypeSig hd_ ) (T_TypeSigs tl_ ) =
(T_TypeSigs (let
in ( )) )
sem_TypeSigs_Nil :: T_TypeSigs
sem_TypeSigs_Nil =
(T_TypeSigs (let
in ( )) )