diff --git a/src-derived/AG2AspectAG.hs b/src-derived/AG2AspectAG.hs new file mode 100644 --- /dev/null +++ b/src-derived/AG2AspectAG.hs @@ -0,0 +1,1770 @@ + + +-- 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 ( )) ) diff --git a/src/Version.hs b/src/Version.hs --- a/src/Version.hs +++ b/src/Version.hs @@ -1,4 +1,4 @@ module Version where banner :: String -banner = "Attribute Grammar compiler / HUT project. Version 0.9.31" +banner = "Attribute Grammar compiler / HUT project. Version 0.9.32" diff --git a/uuagc.cabal b/uuagc.cabal --- a/uuagc.cabal +++ b/uuagc.cabal @@ -1,7 +1,7 @@ cabal-version: >=1.2 build-type: Simple name: uuagc -version: 0.9.31 +version: 0.9.32 license: GPL license-file: LICENSE maintainer: Arie Middelkoop @@ -74,6 +74,7 @@ , Visage , VisageSyntax , VisagePatterns + , AG2AspectAG extensions: TypeSynonymInstances, MultiParamTypeClasses hs-source-dirs: src, src-derived diff --git a/uuagc.cabal-for-ghc-6.6 b/uuagc.cabal-for-ghc-6.6 --- a/uuagc.cabal-for-ghc-6.6 +++ b/uuagc.cabal-for-ghc-6.6 @@ -1,5 +1,5 @@ name: uuagc -version: 0.9.31 +version: 0.9.32 license: GPL license-file: LICENSE maintainer: Arie Middelkoop