-- UUAGC 0.9.40.1 (src-ag/Visage.ag) module Visage where {-# LINE 6 "src-ag/Visage.ag" #-} import UU.Scanner.Position(Pos(..)) import CommonTypes import ATermAbstractSyntax import Expression import VisagePatterns import VisageSyntax import qualified Data.Map as Map import Data.Map(Map) import Data.List(intersperse) import TokenDef {-# LINE 18 "dist/build/Visage.hs" #-} {-# LINE 2 "src-ag/VisageSyntax.ag" #-} import CommonTypes import UU.Pretty import AbstractSyntax import VisagePatterns import Expression {-# LINE 27 "dist/build/Visage.hs" #-} {-# LINE 2 "src-ag/VisagePatterns.ag" #-} import UU.Scanner.Position(Pos) import CommonTypes {-# LINE 33 "dist/build/Visage.hs" #-} {-# LINE 2 "src-ag/Expression.ag" #-} import UU.Scanner.Position(Pos) import HsToken {-# LINE 39 "dist/build/Visage.hs" #-} {-# LINE 19 "src-ag/Visage.ag" #-} convert :: String -> String convert [] = [] convert (c:ct) | c == '\n' = '\\' : 'n' : convert ct | otherwise = c : convert ct sQ :: String -> String sQ [] = [] sQ (x:xs) = if (x=='"') then rest else x:rest where rest = if not (null xs) && last xs == '"' then init xs else xs showAGPos :: Pos -> String showAGPos (Pos l c f) | l == (-1) = "" | otherwise = let file = if null f then "" else f -- No show of f lc = "(line " ++ show l ++ ", column " ++ show c ++")" in file ++ lc showMap :: (Show a, Show b) => Map a b -> String showMap = braces . concat . intersperse "," . map (uncurry assign) . Map.assocs where braces s = "{" ++ s ++ "}" assign a b = show a ++ ":=" ++ show b {-# LINE 65 "dist/build/Visage.hs" #-} -- Expression -------------------------------------------------- {- visit 0: synthesized attribute: aterm : ATerm 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 (( ATerm)) data Inh_Expression = Inh_Expression {} data Syn_Expression = Syn_Expression {aterm_Syn_Expression :: ATerm} wrap_Expression :: T_Expression -> Inh_Expression -> Syn_Expression wrap_Expression (T_Expression sem) (Inh_Expression) = (let ( _lhsOaterm) = sem in (Syn_Expression _lhsOaterm)) sem_Expression_Expression :: Pos -> ([HsToken]) -> T_Expression sem_Expression_Expression pos_ tks_ = (T_Expression (let _lhsOaterm :: ATerm -- "src-ag/Visage.ag"(line 103, column 17) _lhsOaterm = ({-# LINE 103 "src-ag/Visage.ag" #-} AAppl "Expression" [AString (sQ (showAGPos pos_)), AString (sQ (unlines . showTokens . tokensToStrings $ tks_))] {-# LINE 100 "dist/build/Visage" #-} ) ___node = (Syn_Expression _lhsOaterm) in ( _lhsOaterm))) -- VisageChild ------------------------------------------------- {- visit 0: synthesized attribute: aterm : ATerm alternatives: alternative VChild: child name : {Identifier} child tp : {Type} child inh : {Attributes} child syn : {Attributes} child rules : VisageRules -} -- cata sem_VisageChild :: VisageChild -> T_VisageChild sem_VisageChild (VChild _name _tp _inh _syn _rules) = (sem_VisageChild_VChild _name _tp _inh _syn (sem_VisageRules _rules)) -- semantic domain newtype T_VisageChild = T_VisageChild (( ATerm)) data Inh_VisageChild = Inh_VisageChild {} data Syn_VisageChild = Syn_VisageChild {aterm_Syn_VisageChild :: ATerm} wrap_VisageChild :: T_VisageChild -> Inh_VisageChild -> Syn_VisageChild wrap_VisageChild (T_VisageChild sem) (Inh_VisageChild) = (let ( _lhsOaterm) = sem in (Syn_VisageChild _lhsOaterm)) sem_VisageChild_VChild :: Identifier -> Type -> Attributes -> Attributes -> T_VisageRules -> T_VisageChild sem_VisageChild_VChild name_ tp_ inh_ syn_ (T_VisageRules rules_) = (T_VisageChild (let _lhsOaterm :: ATerm _rulesOisLoc :: Bool _rulesIaterms :: ([ATerm]) -- "src-ag/Visage.ag"(line 85, column 18) _lhsOaterm = ({-# LINE 85 "src-ag/Visage.ag" #-} AAppl "Child" [AString (sQ (getName name_)), AString (sQ (show tp_)), AString (sQ (showMap inh_)), AString (sQ (showMap syn_)), AAppl "Rules" _rulesIaterms] {-# LINE 150 "dist/build/Visage" #-} ) -- "src-ag/Visage.ag"(line 89, column 18) _rulesOisLoc = ({-# LINE 89 "src-ag/Visage.ag" #-} False {-# LINE 156 "dist/build/Visage" #-} ) ( _rulesIaterms) = rules_ _rulesOisLoc ___node = (Syn_VisageChild _lhsOaterm) in ( _lhsOaterm))) -- VisageChildren ---------------------------------------------- {- visit 0: synthesized attribute: aterms : [ATerm] alternatives: alternative Cons: child hd : VisageChild child tl : VisageChildren alternative Nil: -} -- cata sem_VisageChildren :: VisageChildren -> T_VisageChildren sem_VisageChildren list = (Prelude.foldr sem_VisageChildren_Cons sem_VisageChildren_Nil (Prelude.map sem_VisageChild list)) -- semantic domain newtype T_VisageChildren = T_VisageChildren (( ([ATerm]))) data Inh_VisageChildren = Inh_VisageChildren {} data Syn_VisageChildren = Syn_VisageChildren {aterms_Syn_VisageChildren :: ([ATerm])} wrap_VisageChildren :: T_VisageChildren -> Inh_VisageChildren -> Syn_VisageChildren wrap_VisageChildren (T_VisageChildren sem) (Inh_VisageChildren) = (let ( _lhsOaterms) = sem in (Syn_VisageChildren _lhsOaterms)) sem_VisageChildren_Cons :: T_VisageChild -> T_VisageChildren -> T_VisageChildren sem_VisageChildren_Cons (T_VisageChild hd_) (T_VisageChildren tl_) = (T_VisageChildren (let _lhsOaterms :: ([ATerm]) _hdIaterm :: ATerm _tlIaterms :: ([ATerm]) -- "src-ag/Visage.ag"(line 80, column 17) _lhsOaterms = ({-# LINE 80 "src-ag/Visage.ag" #-} _hdIaterm : _tlIaterms {-# LINE 200 "dist/build/Visage" #-} ) ( _hdIaterm) = hd_ ( _tlIaterms) = tl_ ___node = (Syn_VisageChildren _lhsOaterms) in ( _lhsOaterms))) sem_VisageChildren_Nil :: T_VisageChildren sem_VisageChildren_Nil = (T_VisageChildren (let _lhsOaterms :: ([ATerm]) -- "src-ag/Visage.ag"(line 81, column 17) _lhsOaterms = ({-# LINE 81 "src-ag/Visage.ag" #-} [] {-# LINE 216 "dist/build/Visage" #-} ) ___node = (Syn_VisageChildren _lhsOaterms) in ( _lhsOaterms))) -- VisageGrammar ----------------------------------------------- {- visit 0: synthesized attribute: aterm : ATerm alternatives: alternative VGrammar: child nonts : VisageNonterminals -} -- cata sem_VisageGrammar :: VisageGrammar -> T_VisageGrammar sem_VisageGrammar (VGrammar _nonts) = (sem_VisageGrammar_VGrammar (sem_VisageNonterminals _nonts)) -- semantic domain newtype T_VisageGrammar = T_VisageGrammar (( ATerm)) data Inh_VisageGrammar = Inh_VisageGrammar {} data Syn_VisageGrammar = Syn_VisageGrammar {aterm_Syn_VisageGrammar :: ATerm} wrap_VisageGrammar :: T_VisageGrammar -> Inh_VisageGrammar -> Syn_VisageGrammar wrap_VisageGrammar (T_VisageGrammar sem) (Inh_VisageGrammar) = (let ( _lhsOaterm) = sem in (Syn_VisageGrammar _lhsOaterm)) sem_VisageGrammar_VGrammar :: T_VisageNonterminals -> T_VisageGrammar sem_VisageGrammar_VGrammar (T_VisageNonterminals nonts_) = (T_VisageGrammar (let _lhsOaterm :: ATerm _nontsIaterms :: ([ATerm]) -- "src-ag/Visage.ag"(line 54, column 18) _lhsOaterm = ({-# LINE 54 "src-ag/Visage.ag" #-} AAppl "Productions" _nontsIaterms {-# LINE 254 "dist/build/Visage" #-} ) ( _nontsIaterms) = nonts_ ___node = (Syn_VisageGrammar _lhsOaterm) in ( _lhsOaterm))) -- VisageNonterminal ------------------------------------------- {- visit 0: synthesized attribute: aterm : ATerm alternatives: alternative VNonterminal: child nt : {NontermIdent} child inh : {Attributes} child syn : {Attributes} child alts : VisageProductions -} -- cata sem_VisageNonterminal :: VisageNonterminal -> T_VisageNonterminal sem_VisageNonterminal (VNonterminal _nt _inh _syn _alts) = (sem_VisageNonterminal_VNonterminal _nt _inh _syn (sem_VisageProductions _alts)) -- semantic domain newtype T_VisageNonterminal = T_VisageNonterminal (( ATerm)) data Inh_VisageNonterminal = Inh_VisageNonterminal {} data Syn_VisageNonterminal = Syn_VisageNonterminal {aterm_Syn_VisageNonterminal :: ATerm} wrap_VisageNonterminal :: T_VisageNonterminal -> Inh_VisageNonterminal -> Syn_VisageNonterminal wrap_VisageNonterminal (T_VisageNonterminal sem) (Inh_VisageNonterminal) = (let ( _lhsOaterm) = sem in (Syn_VisageNonterminal _lhsOaterm)) sem_VisageNonterminal_VNonterminal :: NontermIdent -> Attributes -> Attributes -> T_VisageProductions -> T_VisageNonterminal sem_VisageNonterminal_VNonterminal nt_ inh_ syn_ (T_VisageProductions alts_) = (T_VisageNonterminal (let _lhsOaterm :: ATerm _altsIaterms :: ([ATerm]) -- "src-ag/Visage.ag"(line 63, column 19) _lhsOaterm = ({-# LINE 63 "src-ag/Visage.ag" #-} AAppl "Production" [AString (sQ (getName nt_)), AString (sQ(showMap inh_)), AString (sQ(showMap syn_)), AAppl "Alternatives" _altsIaterms] {-# LINE 301 "dist/build/Visage" #-} ) ( _altsIaterms) = alts_ ___node = (Syn_VisageNonterminal _lhsOaterm) in ( _lhsOaterm))) -- VisageNonterminals ------------------------------------------ {- visit 0: synthesized attribute: aterms : [ATerm] alternatives: alternative Cons: child hd : VisageNonterminal child tl : VisageNonterminals alternative Nil: -} -- cata sem_VisageNonterminals :: VisageNonterminals -> T_VisageNonterminals sem_VisageNonterminals list = (Prelude.foldr sem_VisageNonterminals_Cons sem_VisageNonterminals_Nil (Prelude.map sem_VisageNonterminal list)) -- semantic domain newtype T_VisageNonterminals = T_VisageNonterminals (( ([ATerm]))) data Inh_VisageNonterminals = Inh_VisageNonterminals {} data Syn_VisageNonterminals = Syn_VisageNonterminals {aterms_Syn_VisageNonterminals :: ([ATerm])} wrap_VisageNonterminals :: T_VisageNonterminals -> Inh_VisageNonterminals -> Syn_VisageNonterminals wrap_VisageNonterminals (T_VisageNonterminals sem) (Inh_VisageNonterminals) = (let ( _lhsOaterms) = sem in (Syn_VisageNonterminals _lhsOaterms)) sem_VisageNonterminals_Cons :: T_VisageNonterminal -> T_VisageNonterminals -> T_VisageNonterminals sem_VisageNonterminals_Cons (T_VisageNonterminal hd_) (T_VisageNonterminals tl_) = (T_VisageNonterminals (let _lhsOaterms :: ([ATerm]) _hdIaterm :: ATerm _tlIaterms :: ([ATerm]) -- "src-ag/Visage.ag"(line 58, column 17) _lhsOaterms = ({-# LINE 58 "src-ag/Visage.ag" #-} _hdIaterm : _tlIaterms {-# LINE 345 "dist/build/Visage" #-} ) ( _hdIaterm) = hd_ ( _tlIaterms) = tl_ ___node = (Syn_VisageNonterminals _lhsOaterms) in ( _lhsOaterms))) sem_VisageNonterminals_Nil :: T_VisageNonterminals sem_VisageNonterminals_Nil = (T_VisageNonterminals (let _lhsOaterms :: ([ATerm]) -- "src-ag/Visage.ag"(line 59, column 17) _lhsOaterms = ({-# LINE 59 "src-ag/Visage.ag" #-} [] {-# LINE 361 "dist/build/Visage" #-} ) ___node = (Syn_VisageNonterminals _lhsOaterms) in ( _lhsOaterms))) -- VisagePattern ----------------------------------------------- {- visit 0: synthesized attribute: aterm : ATerm alternatives: alternative VAlias: child field : {Identifier} child attr : {Identifier} child pat : VisagePattern alternative VConstr: child name : {ConstructorIdent} child pats : VisagePatterns alternative VProduct: child pos : {Pos} child pats : VisagePatterns alternative VUnderscore: child pos : {Pos} alternative VVar: child field : {Identifier} child attr : {Identifier} -} -- cata sem_VisagePattern :: VisagePattern -> T_VisagePattern sem_VisagePattern (VAlias _field _attr _pat) = (sem_VisagePattern_VAlias _field _attr (sem_VisagePattern _pat)) sem_VisagePattern (VConstr _name _pats) = (sem_VisagePattern_VConstr _name (sem_VisagePatterns _pats)) sem_VisagePattern (VProduct _pos _pats) = (sem_VisagePattern_VProduct _pos (sem_VisagePatterns _pats)) sem_VisagePattern (VUnderscore _pos) = (sem_VisagePattern_VUnderscore _pos) sem_VisagePattern (VVar _field _attr) = (sem_VisagePattern_VVar _field _attr) -- semantic domain newtype T_VisagePattern = T_VisagePattern (( ATerm)) data Inh_VisagePattern = Inh_VisagePattern {} data Syn_VisagePattern = Syn_VisagePattern {aterm_Syn_VisagePattern :: ATerm} wrap_VisagePattern :: T_VisagePattern -> Inh_VisagePattern -> Syn_VisagePattern wrap_VisagePattern (T_VisagePattern sem) (Inh_VisagePattern) = (let ( _lhsOaterm) = sem in (Syn_VisagePattern _lhsOaterm)) sem_VisagePattern_VAlias :: Identifier -> Identifier -> T_VisagePattern -> T_VisagePattern sem_VisagePattern_VAlias field_ attr_ (T_VisagePattern pat_) = (T_VisagePattern (let _lhsOaterm :: ATerm _patIaterm :: ATerm -- "src-ag/Visage.ag"(line 119, column 18) _lhsOaterm = ({-# LINE 119 "src-ag/Visage.ag" #-} AAppl "Pattern" [AAppl "Alias" [AString (sQ (showAGPos (getPos field_))), AString (sQ (getName field_ ++ "." ++ getName attr_)), _patIaterm]] {-# LINE 423 "dist/build/Visage" #-} ) ( _patIaterm) = pat_ ___node = (Syn_VisagePattern _lhsOaterm) in ( _lhsOaterm))) sem_VisagePattern_VConstr :: ConstructorIdent -> T_VisagePatterns -> T_VisagePattern sem_VisagePattern_VConstr name_ (T_VisagePatterns pats_) = (T_VisagePattern (let _lhsOaterm :: ATerm _patsIaterms :: ([ATerm]) -- "src-ag/Visage.ag"(line 112, column 18) _lhsOaterm = ({-# LINE 112 "src-ag/Visage.ag" #-} AAppl "Pattern" [AAppl "Constr" [AString (sQ (showAGPos (getPos name_))), AString (sQ (getName name_)), AAppl "Patterns" _patsIaterms]] {-# LINE 442 "dist/build/Visage" #-} ) ( _patsIaterms) = pats_ ___node = (Syn_VisagePattern _lhsOaterm) in ( _lhsOaterm))) sem_VisagePattern_VProduct :: Pos -> T_VisagePatterns -> T_VisagePattern sem_VisagePattern_VProduct pos_ (T_VisagePatterns pats_) = (T_VisagePattern (let _lhsOaterm :: ATerm _patsIaterms :: ([ATerm]) -- "src-ag/Visage.ag"(line 115, column 18) _lhsOaterm = ({-# LINE 115 "src-ag/Visage.ag" #-} AAppl "Pattern" [AAppl "Product" [AString (sQ (showAGPos pos_)), AAppl "Patterns" _patsIaterms]] {-# LINE 460 "dist/build/Visage" #-} ) ( _patsIaterms) = pats_ ___node = (Syn_VisagePattern _lhsOaterm) in ( _lhsOaterm))) sem_VisagePattern_VUnderscore :: Pos -> T_VisagePattern sem_VisagePattern_VUnderscore pos_ = (T_VisagePattern (let _lhsOaterm :: ATerm -- "src-ag/Visage.ag"(line 121, column 18) _lhsOaterm = ({-# LINE 121 "src-ag/Visage.ag" #-} AAppl "Pattern" [AAppl "Underscore" [AString (sQ (showAGPos pos_))]] {-# LINE 475 "dist/build/Visage" #-} ) ___node = (Syn_VisagePattern _lhsOaterm) in ( _lhsOaterm))) sem_VisagePattern_VVar :: Identifier -> Identifier -> T_VisagePattern sem_VisagePattern_VVar field_ attr_ = (T_VisagePattern (let _lhsOaterm :: ATerm -- "src-ag/Visage.ag"(line 117, column 18) _lhsOaterm = ({-# LINE 117 "src-ag/Visage.ag" #-} AAppl "Pattern" [AAppl "Var" [AString (sQ (showAGPos (getPos field_))), AString (sQ (getName field_ ++ "." ++ getName attr_))]] {-# LINE 490 "dist/build/Visage" #-} ) ___node = (Syn_VisagePattern _lhsOaterm) in ( _lhsOaterm))) -- VisagePatterns ---------------------------------------------- {- visit 0: synthesized attribute: aterms : [ATerm] alternatives: alternative Cons: child hd : VisagePattern child tl : VisagePatterns alternative Nil: -} -- cata sem_VisagePatterns :: VisagePatterns -> T_VisagePatterns sem_VisagePatterns list = (Prelude.foldr sem_VisagePatterns_Cons sem_VisagePatterns_Nil (Prelude.map sem_VisagePattern list)) -- semantic domain newtype T_VisagePatterns = T_VisagePatterns (( ([ATerm]))) data Inh_VisagePatterns = Inh_VisagePatterns {} data Syn_VisagePatterns = Syn_VisagePatterns {aterms_Syn_VisagePatterns :: ([ATerm])} wrap_VisagePatterns :: T_VisagePatterns -> Inh_VisagePatterns -> Syn_VisagePatterns wrap_VisagePatterns (T_VisagePatterns sem) (Inh_VisagePatterns) = (let ( _lhsOaterms) = sem in (Syn_VisagePatterns _lhsOaterms)) sem_VisagePatterns_Cons :: T_VisagePattern -> T_VisagePatterns -> T_VisagePatterns sem_VisagePatterns_Cons (T_VisagePattern hd_) (T_VisagePatterns tl_) = (T_VisagePatterns (let _lhsOaterms :: ([ATerm]) _hdIaterm :: ATerm _tlIaterms :: ([ATerm]) -- "src-ag/Visage.ag"(line 107, column 17) _lhsOaterms = ({-# LINE 107 "src-ag/Visage.ag" #-} _hdIaterm : _tlIaterms {-# LINE 532 "dist/build/Visage" #-} ) ( _hdIaterm) = hd_ ( _tlIaterms) = tl_ ___node = (Syn_VisagePatterns _lhsOaterms) in ( _lhsOaterms))) sem_VisagePatterns_Nil :: T_VisagePatterns sem_VisagePatterns_Nil = (T_VisagePatterns (let _lhsOaterms :: ([ATerm]) -- "src-ag/Visage.ag"(line 108, column 17) _lhsOaterms = ({-# LINE 108 "src-ag/Visage.ag" #-} [] {-# LINE 548 "dist/build/Visage" #-} ) ___node = (Syn_VisagePatterns _lhsOaterms) in ( _lhsOaterms))) -- VisageProduction -------------------------------------------- {- visit 0: synthesized attribute: aterm : ATerm alternatives: alternative VProduction: child con : {ConstructorIdent} child children : VisageChildren child rules : VisageRules child locrules : VisageRules -} -- cata sem_VisageProduction :: VisageProduction -> T_VisageProduction sem_VisageProduction (VProduction _con _children _rules _locrules) = (sem_VisageProduction_VProduction _con (sem_VisageChildren _children) (sem_VisageRules _rules) (sem_VisageRules _locrules)) -- semantic domain newtype T_VisageProduction = T_VisageProduction (( ATerm)) data Inh_VisageProduction = Inh_VisageProduction {} data Syn_VisageProduction = Syn_VisageProduction {aterm_Syn_VisageProduction :: ATerm} wrap_VisageProduction :: T_VisageProduction -> Inh_VisageProduction -> Syn_VisageProduction wrap_VisageProduction (T_VisageProduction sem) (Inh_VisageProduction) = (let ( _lhsOaterm) = sem in (Syn_VisageProduction _lhsOaterm)) sem_VisageProduction_VProduction :: ConstructorIdent -> T_VisageChildren -> T_VisageRules -> T_VisageRules -> T_VisageProduction sem_VisageProduction_VProduction con_ (T_VisageChildren children_) (T_VisageRules rules_) (T_VisageRules locrules_) = (T_VisageProduction (let _lhsOaterm :: ATerm _locrulesOisLoc :: Bool _rulesOisLoc :: Bool _childrenIaterms :: ([ATerm]) _rulesIaterms :: ([ATerm]) _locrulesIaterms :: ([ATerm]) -- "src-ag/Visage.ag"(line 73, column 17) _lhsOaterm = ({-# LINE 73 "src-ag/Visage.ag" #-} AAppl "Alternative" [AString (sQ (getName con_)), AAppl "Children" _childrenIaterms, AAppl "Rules" _rulesIaterms, AAppl "LocRules" _locrulesIaterms] {-# LINE 598 "dist/build/Visage" #-} ) -- "src-ag/Visage.ag"(line 76, column 18) _locrulesOisLoc = ({-# LINE 76 "src-ag/Visage.ag" #-} True {-# LINE 604 "dist/build/Visage" #-} ) -- "src-ag/Visage.ag"(line 77, column 18) _rulesOisLoc = ({-# LINE 77 "src-ag/Visage.ag" #-} False {-# LINE 610 "dist/build/Visage" #-} ) ( _childrenIaterms) = children_ ( _rulesIaterms) = rules_ _rulesOisLoc ( _locrulesIaterms) = locrules_ _locrulesOisLoc ___node = (Syn_VisageProduction _lhsOaterm) in ( _lhsOaterm))) -- VisageProductions ------------------------------------------- {- visit 0: synthesized attribute: aterms : [ATerm] alternatives: alternative Cons: child hd : VisageProduction child tl : VisageProductions alternative Nil: -} -- cata sem_VisageProductions :: VisageProductions -> T_VisageProductions sem_VisageProductions list = (Prelude.foldr sem_VisageProductions_Cons sem_VisageProductions_Nil (Prelude.map sem_VisageProduction list)) -- semantic domain newtype T_VisageProductions = T_VisageProductions (( ([ATerm]))) data Inh_VisageProductions = Inh_VisageProductions {} data Syn_VisageProductions = Syn_VisageProductions {aterms_Syn_VisageProductions :: ([ATerm])} wrap_VisageProductions :: T_VisageProductions -> Inh_VisageProductions -> Syn_VisageProductions wrap_VisageProductions (T_VisageProductions sem) (Inh_VisageProductions) = (let ( _lhsOaterms) = sem in (Syn_VisageProductions _lhsOaterms)) sem_VisageProductions_Cons :: T_VisageProduction -> T_VisageProductions -> T_VisageProductions sem_VisageProductions_Cons (T_VisageProduction hd_) (T_VisageProductions tl_) = (T_VisageProductions (let _lhsOaterms :: ([ATerm]) _hdIaterm :: ATerm _tlIaterms :: ([ATerm]) -- "src-ag/Visage.ag"(line 68, column 17) _lhsOaterms = ({-# LINE 68 "src-ag/Visage.ag" #-} _hdIaterm : _tlIaterms {-# LINE 658 "dist/build/Visage" #-} ) ( _hdIaterm) = hd_ ( _tlIaterms) = tl_ ___node = (Syn_VisageProductions _lhsOaterms) in ( _lhsOaterms))) sem_VisageProductions_Nil :: T_VisageProductions sem_VisageProductions_Nil = (T_VisageProductions (let _lhsOaterms :: ([ATerm]) -- "src-ag/Visage.ag"(line 69, column 17) _lhsOaterms = ({-# LINE 69 "src-ag/Visage.ag" #-} [] {-# LINE 674 "dist/build/Visage" #-} ) ___node = (Syn_VisageProductions _lhsOaterms) in ( _lhsOaterms))) -- VisageRule -------------------------------------------------- {- visit 0: inherited attribute: isLoc : Bool synthesized attribute: aterm : ATerm alternatives: alternative VRule: child fieldattrs : {[(Identifier,Identifier)]} child attr : {Identifier} child pat : VisagePattern child rhs : Expression child owrt : {Bool} -} -- cata sem_VisageRule :: VisageRule -> T_VisageRule sem_VisageRule (VRule _fieldattrs _attr _pat _rhs _owrt) = (sem_VisageRule_VRule _fieldattrs _attr (sem_VisagePattern _pat) (sem_Expression _rhs) _owrt) -- semantic domain newtype T_VisageRule = T_VisageRule (Bool -> ( ATerm)) data Inh_VisageRule = Inh_VisageRule {isLoc_Inh_VisageRule :: Bool} data Syn_VisageRule = Syn_VisageRule {aterm_Syn_VisageRule :: ATerm} wrap_VisageRule :: T_VisageRule -> Inh_VisageRule -> Syn_VisageRule wrap_VisageRule (T_VisageRule sem) (Inh_VisageRule _lhsIisLoc) = (let ( _lhsOaterm) = sem _lhsIisLoc in (Syn_VisageRule _lhsOaterm)) sem_VisageRule_VRule :: ([(Identifier,Identifier)]) -> Identifier -> T_VisagePattern -> T_Expression -> Bool -> T_VisageRule sem_VisageRule_VRule fieldattrs_ attr_ (T_VisagePattern pat_) (T_Expression rhs_) owrt_ = (T_VisageRule (\ _lhsIisLoc -> (let _lhsOaterm :: ATerm _patIaterm :: ATerm _rhsIaterm :: ATerm -- "src-ag/Visage.ag"(line 97, column 18) _lhsOaterm = ({-# LINE 97 "src-ag/Visage.ag" #-} AAppl (if _lhsIisLoc then "LocRule" else "Rule") ([AString (sQ (getName attr_)), _patIaterm, _rhsIaterm] ++ if _lhsIisLoc then [AString (sQ (show owrt_))] else []) {-# LINE 726 "dist/build/Visage" #-} ) ( _patIaterm) = pat_ ( _rhsIaterm) = rhs_ ___node = (Syn_VisageRule _lhsOaterm) in ( _lhsOaterm)))) -- VisageRules ------------------------------------------------- {- visit 0: inherited attribute: isLoc : Bool synthesized attribute: aterms : [ATerm] alternatives: alternative Cons: child hd : VisageRule child tl : VisageRules alternative Nil: -} -- cata sem_VisageRules :: VisageRules -> T_VisageRules sem_VisageRules list = (Prelude.foldr sem_VisageRules_Cons sem_VisageRules_Nil (Prelude.map sem_VisageRule list)) -- semantic domain newtype T_VisageRules = T_VisageRules (Bool -> ( ([ATerm]))) data Inh_VisageRules = Inh_VisageRules {isLoc_Inh_VisageRules :: Bool} data Syn_VisageRules = Syn_VisageRules {aterms_Syn_VisageRules :: ([ATerm])} wrap_VisageRules :: T_VisageRules -> Inh_VisageRules -> Syn_VisageRules wrap_VisageRules (T_VisageRules sem) (Inh_VisageRules _lhsIisLoc) = (let ( _lhsOaterms) = sem _lhsIisLoc in (Syn_VisageRules _lhsOaterms)) sem_VisageRules_Cons :: T_VisageRule -> T_VisageRules -> T_VisageRules sem_VisageRules_Cons (T_VisageRule hd_) (T_VisageRules tl_) = (T_VisageRules (\ _lhsIisLoc -> (let _lhsOaterms :: ([ATerm]) _hdOisLoc :: Bool _tlOisLoc :: Bool _hdIaterm :: ATerm _tlIaterms :: ([ATerm]) -- "src-ag/Visage.ag"(line 92, column 17) _lhsOaterms = ({-# LINE 92 "src-ag/Visage.ag" #-} _hdIaterm : _tlIaterms {-# LINE 778 "dist/build/Visage" #-} ) -- copy rule (down) _hdOisLoc = ({-# LINE 51 "src-ag/Visage.ag" #-} _lhsIisLoc {-# LINE 784 "dist/build/Visage" #-} ) -- copy rule (down) _tlOisLoc = ({-# LINE 51 "src-ag/Visage.ag" #-} _lhsIisLoc {-# LINE 790 "dist/build/Visage" #-} ) ( _hdIaterm) = hd_ _hdOisLoc ( _tlIaterms) = tl_ _tlOisLoc ___node = (Syn_VisageRules _lhsOaterms) in ( _lhsOaterms)))) sem_VisageRules_Nil :: T_VisageRules sem_VisageRules_Nil = (T_VisageRules (\ _lhsIisLoc -> (let _lhsOaterms :: ([ATerm]) -- "src-ag/Visage.ag"(line 93, column 17) _lhsOaterms = ({-# LINE 93 "src-ag/Visage.ag" #-} [] {-# LINE 807 "dist/build/Visage" #-} ) ___node = (Syn_VisageRules _lhsOaterms) in ( _lhsOaterms))))