uuagc 0.9.5 → 0.9.6
raw patch · 41 files changed
+22885/−19440 lines, 41 files
Files
- src-derived/AbstractSyntax.hs +35/−33
- src-derived/AbstractSyntaxDump.hs +292/−260
- src-derived/Code.hs +49/−35
- src-derived/CodeSyntax.hs +44/−42
- src-derived/CodeSyntaxDump.hs +277/−247
- src-derived/ConcreteSyntax.hs +44/−39
- src-derived/DeclBlocks.hs +2/−2
- src-derived/DefaultRules.hs +2115/−2034
- src-derived/Desugar.hs +2279/−1837
- src-derived/ErrorMessages.hs +92/−97
- src-derived/Expression.hs +3/−2
- src-derived/GenerateCode.hs +5024/−4544
- src-derived/HsToken.hs +12/−11
- src-derived/Interfaces.hs +9/−9
- src-derived/InterfacesRules.hs +85/−74
- src-derived/Order.hs +3481/−3399
- src-derived/Patterns.hs +13/−9
- src-derived/PrintCode.hs +2858/−2620
- src-derived/PrintErrorMessages.hs +398/−401
- src-derived/SemHsTokens.hs +94/−83
- src-derived/TfmToVisage.hs +926/−0
- src-derived/Transform.hs +3657/−3541
- src-derived/Visage.hs +655/−0
- src-derived/VisagePatterns.hs +39/−0
- src-derived/VisageSyntax.hs +94/−0
- src/ATermAbstractSyntax.hs +23/−0
- src/ATermWrite.hs +24/−0
- src/Ag.hs +49/−12
- src/CommonTypes.hs +56/−38
- src/DepTypes.hs +19/−19
- src/GrammarInfo.hs +5/−5
- src/HsTokenScanner.hs +2/−2
- src/Options.hs +16/−0
- src/Parser.hs +72/−33
- src/Scanner.hs +2/−0
- src/SequentialComputation.lhs +1/−1
- src/SequentialTypes.hs +8/−8
- src/TokenDef.hs +16/−0
- src/Version.hs +1/−1
- uuagc.cabal +7/−1
- uuagc.cabal-for-ghc-6.6 +7/−1
src-derived/AbstractSyntax.hs view
@@ -1,4 +1,3 @@- -- UUAGC 0.9.5 (AbstractSyntax.ag) module AbstractSyntax where @@ -8,36 +7,17 @@ import Patterns (Pattern(..),Patterns) import Expression (Expression(..)) import CommonTypes--- Alternative --------------------------------------------------{-- alternatives:- alternative Alternative:- child con : {Constructor}- child children : Children- child rules : Rules- child typeSigs : TypeSigs--}-data Alternative = Alternative (Constructor) (Children) (Rules) (TypeSigs) --- Alternatives -------------------------------------------------{-- alternatives:- alternative Cons:- child hd : Alternative- child tl : Alternatives- alternative Nil:--}-type Alternatives = [Alternative] -- Child ------------------------------------------------------- {- alternatives: alternative Child:- child name : {Name}+ child name : {Identifier} child tp : {Type} child inh : {Attributes} child syn : {Attributes} child higherOrder : {Bool} -}-data Child = Child (Name) (Type) (Attributes) (Attributes) (Bool) +data Child = Child (Identifier) (Type) (Attributes) (Attributes) (Bool) -- Children ---------------------------------------------------- {- alternatives:@@ -54,22 +34,44 @@ child typeSyns : {TypeSyns} child useMap : {UseMap} child derivings : {Derivings}- child wrappers : {Set Nonterminal}- child prods : Productions+ child wrappers : {Set NontermIdent}+ child nonts : Nonterminals child pragmas : {PragmaMap} child manualAttrOrderMap : {AttrOrderMap}+ child paramMap : {ParamMap}+ child contextMap : {ContextMap} -}-data Grammar = Grammar (TypeSyns) (UseMap) (Derivings) (Set Nonterminal) (Productions) (PragmaMap) (AttrOrderMap) --- Production --------------------------------------------------+data Grammar = Grammar (TypeSyns) (UseMap) (Derivings) (Set NontermIdent) (Nonterminals) (PragmaMap) (AttrOrderMap) (ParamMap) (ContextMap)+-- Nonterminal ------------------------------------------------- {- alternatives:- alternative Production:- child nt : {Nonterminal}+ alternative Nonterminal:+ child nt : {NontermIdent}+ child params : {[Identifier]} child inh : {Attributes} child syn : {Attributes}- child alts : Alternatives+ child prods : Productions -}-data Production = Production (Nonterminal) (Attributes) (Attributes) (Alternatives) +data Nonterminal = Nonterminal (NontermIdent) ([Identifier]) (Attributes) (Attributes) (Productions)+-- Nonterminals ------------------------------------------------+{-+ alternatives:+ alternative Cons:+ child hd : Nonterminal+ child tl : Nonterminals+ alternative Nil:+-}+type Nonterminals = [Nonterminal]+-- Production --------------------------------------------------+{-+ alternatives:+ alternative Production:+ child con : {ConstructorIdent}+ child children : Children+ child rules : Rules+ child typeSigs : TypeSigs+-}+data Production = Production (ConstructorIdent) (Children) (Rules) (TypeSigs) -- Productions ------------------------------------------------- {- alternatives:@@ -88,7 +90,7 @@ child owrt : {Bool} child origin : {String} -}-data Rule = Rule (Pattern) (Expression) (Bool) (String) +data Rule = Rule (Pattern) (Expression) (Bool) (String) -- Rules ------------------------------------------------------- {- alternatives:@@ -102,10 +104,10 @@ {- alternatives: alternative TypeSig:- child name : {Name}+ child name : {Identifier} child tp : {Type} -}-data TypeSig = TypeSig (Name) (Type) +data TypeSig = TypeSig (Identifier) (Type) -- TypeSigs ---------------------------------------------------- {- alternatives:
src-derived/AbstractSyntaxDump.hs view
@@ -1,4 +1,3 @@- -- UUAGC 0.9.5 (AbstractSyntaxDump.ag) module AbstractSyntaxDump where @@ -9,6 +8,7 @@ import PPUtil import AbstractSyntax+import TokenDef -- AbstractSyntax.ag imports import Data.Set(Set)@@ -19,113 +19,10 @@ -- Patterns.ag imports import UU.Scanner.Position(Pos)-import CommonTypes (Constructor,Name)+import CommonTypes (ConstructorIdent,Identifier) import UU.Scanner.Position(Pos)--- Alternative --------------------------------------------------{-- visit 0:- synthesized attribute:- pp : PP_Doc- alternatives:- alternative Alternative:- child con : {Constructor}- child children : Children- child rules : Rules- child typeSigs : TypeSigs--}--- cata-sem_Alternative :: Alternative ->- T_Alternative-sem_Alternative (Alternative _con _children _rules _typeSigs ) =- (sem_Alternative_Alternative _con (sem_Children _children ) (sem_Rules _rules ) (sem_TypeSigs _typeSigs ) )--- semantic domain-newtype T_Alternative = T_Alternative (( PP_Doc))-data Inh_Alternative = Inh_Alternative {}-data Syn_Alternative = Syn_Alternative {pp_Syn_Alternative :: PP_Doc}-wrap_Alternative (T_Alternative sem ) (Inh_Alternative ) =- (let ( _lhsOpp) =- (sem )- in (Syn_Alternative _lhsOpp ))-sem_Alternative_Alternative :: Constructor ->- T_Children ->- T_Rules ->- T_TypeSigs ->- T_Alternative-sem_Alternative_Alternative con_ (T_Children children_ ) (T_Rules rules_ ) (T_TypeSigs typeSigs_ ) =- (T_Alternative (let _lhsOpp :: PP_Doc- _childrenIpp :: PP_Doc- _childrenIppL :: ([PP_Doc])- _rulesIpp :: PP_Doc- _rulesIppL :: ([PP_Doc])- _typeSigsIpp :: PP_Doc- _typeSigsIppL :: ([PP_Doc])- -- "AbstractSyntaxDump.ag"(line 31, column 25)- _lhsOpp =- ppNestInfo ["Alternative","Alternative"] [pp con_] [ppF "children" $ ppVList _childrenIppL,ppF "rules" $ ppVList _rulesIppL,ppF "typeSigs" $ ppVList _typeSigsIppL] []- ( _childrenIpp,_childrenIppL) =- (children_ )- ( _rulesIpp,_rulesIppL) =- (rules_ )- ( _typeSigsIpp,_typeSigsIppL) =- (typeSigs_ )- in ( _lhsOpp)) )--- Alternatives -------------------------------------------------{-- visit 0:- synthesized attributes:- pp : PP_Doc- ppL : [PP_Doc]- alternatives:- alternative Cons:- child hd : Alternative- child tl : Alternatives- alternative Nil:--}--- cata-sem_Alternatives :: Alternatives ->- T_Alternatives-sem_Alternatives list =- (Prelude.foldr sem_Alternatives_Cons sem_Alternatives_Nil (Prelude.map sem_Alternative list) )--- semantic domain-newtype T_Alternatives = T_Alternatives (( PP_Doc,([PP_Doc])))-data Inh_Alternatives = Inh_Alternatives {}-data Syn_Alternatives = Syn_Alternatives {pp_Syn_Alternatives :: PP_Doc,ppL_Syn_Alternatives :: [PP_Doc]}-wrap_Alternatives (T_Alternatives sem ) (Inh_Alternatives ) =- (let ( _lhsOpp,_lhsOppL) =- (sem )- in (Syn_Alternatives _lhsOpp _lhsOppL ))-sem_Alternatives_Cons :: T_Alternative ->- T_Alternatives ->- T_Alternatives-sem_Alternatives_Cons (T_Alternative hd_ ) (T_Alternatives tl_ ) =- (T_Alternatives (let _lhsOppL :: ([PP_Doc])- _lhsOpp :: PP_Doc- _hdIpp :: PP_Doc- _tlIpp :: PP_Doc- _tlIppL :: ([PP_Doc])- -- "AbstractSyntaxDump.ag"(line 70, column 33)- _lhsOppL =- _hdIpp : _tlIppL- -- use rule "AbstractSyntaxDump.ag"(line 16, column 58)- _lhsOpp =- _hdIpp >-< _tlIpp- ( _hdIpp) =- (hd_ )- ( _tlIpp,_tlIppL) =- (tl_ )- in ( _lhsOpp,_lhsOppL)) )-sem_Alternatives_Nil :: T_Alternatives-sem_Alternatives_Nil =- (T_Alternatives (let _lhsOppL :: ([PP_Doc])- _lhsOpp :: PP_Doc- -- "AbstractSyntaxDump.ag"(line 71, column 33)- _lhsOppL =- []- -- use rule "AbstractSyntaxDump.ag"(line 16, column 58)- _lhsOpp =- empty- in ( _lhsOpp,_lhsOppL)) )+import HsToken -- Child ------------------------------------------------------- {- visit 0:@@ -133,7 +30,7 @@ pp : PP_Doc alternatives: alternative Child:- child name : {Name}+ child name : {Identifier} child tp : {Type} child inh : {Attributes} child syn : {Attributes}@@ -142,28 +39,28 @@ -- cata sem_Child :: Child -> T_Child-sem_Child (Child _name _tp _inh _syn _higherOrder ) =- (sem_Child_Child _name _tp _inh _syn _higherOrder )+sem_Child (Child _name _tp _inh _syn _higherOrder) =+ (sem_Child_Child _name _tp _inh _syn _higherOrder) -- semantic domain newtype T_Child = T_Child (( PP_Doc)) data Inh_Child = Inh_Child {} data Syn_Child = Syn_Child {pp_Syn_Child :: PP_Doc}-wrap_Child (T_Child sem ) (Inh_Child ) =+wrap_Child (T_Child sem) (Inh_Child ) = (let ( _lhsOpp) = (sem )- in (Syn_Child _lhsOpp ))-sem_Child_Child :: Name ->+ in (Syn_Child _lhsOpp))+sem_Child_Child :: Identifier -> Type -> Attributes -> Attributes -> Bool -> T_Child-sem_Child_Child name_ tp_ inh_ syn_ higherOrder_ =+sem_Child_Child name_ tp_ inh_ syn_ higherOrder_ = (T_Child (let _lhsOpp :: PP_Doc- -- "AbstractSyntaxDump.ag"(line 34, column 33)+ -- "AbstractSyntaxDump.ag"(line 35, column 33) _lhsOpp = ppNestInfo ["Child","Child"] [pp name_, ppShow tp_] [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_] []- in ( _lhsOpp)) )+ in ( _lhsOpp))) -- Children ---------------------------------------------------- {- visit 0:@@ -179,47 +76,47 @@ -- cata sem_Children :: Children -> T_Children-sem_Children list =- (Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list) )+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]))) data Inh_Children = Inh_Children {} data Syn_Children = Syn_Children {pp_Syn_Children :: PP_Doc,ppL_Syn_Children :: [PP_Doc]}-wrap_Children (T_Children sem ) (Inh_Children ) =+wrap_Children (T_Children sem) (Inh_Children ) = (let ( _lhsOpp,_lhsOppL) = (sem )- in (Syn_Children _lhsOpp _lhsOppL ))+ in (Syn_Children _lhsOpp _lhsOppL)) sem_Children_Cons :: T_Child -> T_Children -> T_Children-sem_Children_Cons (T_Child hd_ ) (T_Children tl_ ) =+sem_Children_Cons (T_Child hd_) (T_Children tl_) = (T_Children (let _lhsOppL :: ([PP_Doc]) _lhsOpp :: PP_Doc _hdIpp :: PP_Doc _tlIpp :: PP_Doc _tlIppL :: ([PP_Doc])- -- "AbstractSyntaxDump.ag"(line 66, column 33)+ -- "AbstractSyntaxDump.ag"(line 67, column 33) _lhsOppL = _hdIpp : _tlIppL- -- use rule "AbstractSyntaxDump.ag"(line 16, column 58)+ -- use rule "AbstractSyntaxDump.ag"(line 17, column 58) _lhsOpp = _hdIpp >-< _tlIpp ( _hdIpp) = (hd_ ) ( _tlIpp,_tlIppL) = (tl_ )- in ( _lhsOpp,_lhsOppL)) )+ in ( _lhsOpp,_lhsOppL))) sem_Children_Nil :: T_Children sem_Children_Nil = (T_Children (let _lhsOppL :: ([PP_Doc]) _lhsOpp :: PP_Doc- -- "AbstractSyntaxDump.ag"(line 67, column 33)+ -- "AbstractSyntaxDump.ag"(line 68, column 33) _lhsOppL = []- -- use rule "AbstractSyntaxDump.ag"(line 16, column 58)+ -- use rule "AbstractSyntaxDump.ag"(line 17, column 58) _lhsOpp = empty- in ( _lhsOpp,_lhsOppL)) )+ in ( _lhsOpp,_lhsOppL))) -- Expression -------------------------------------------------- {- visit 0:@@ -228,30 +125,30 @@ alternatives: alternative Expression: child pos : {Pos}- child txt : {String}+ child tks : {[HsToken]} -} -- cata sem_Expression :: Expression -> T_Expression-sem_Expression (Expression _pos _txt ) =- (sem_Expression_Expression _pos _txt )+sem_Expression (Expression _pos _tks) =+ (sem_Expression_Expression _pos _tks) -- semantic domain newtype T_Expression = T_Expression (( PP_Doc)) data Inh_Expression = Inh_Expression {} data Syn_Expression = Syn_Expression {pp_Syn_Expression :: PP_Doc}-wrap_Expression (T_Expression sem ) (Inh_Expression ) =+wrap_Expression (T_Expression sem) (Inh_Expression ) = (let ( _lhsOpp) = (sem )- in (Syn_Expression _lhsOpp ))+ in (Syn_Expression _lhsOpp)) sem_Expression_Expression :: Pos ->- String ->+ ([HsToken]) -> T_Expression-sem_Expression_Expression pos_ txt_ =+sem_Expression_Expression pos_ tks_ = (T_Expression (let _lhsOpp :: PP_Doc- -- "AbstractSyntaxDump.ag"(line 49, column 25)+ -- "AbstractSyntaxDump.ag"(line 50, column 25) _lhsOpp =- ppNestInfo ["Expression","Expression"] [ppShow pos_] [ppF "txt" $ text txt_] []- in ( _lhsOpp)) )+ ppNestInfo ["Expression","Expression"] [ppShow pos_] [ppF "txt" $ vlist . showTokens . tokensToStrings $ tks_] []+ in ( _lhsOpp))) -- Grammar ----------------------------------------------------- {- visit 0:@@ -262,48 +159,150 @@ child typeSyns : {TypeSyns} child useMap : {UseMap} child derivings : {Derivings}- child wrappers : {Set Nonterminal}- child prods : Productions+ child wrappers : {Set NontermIdent}+ child nonts : Nonterminals child pragmas : {PragmaMap} child manualAttrOrderMap : {AttrOrderMap}+ child paramMap : {ParamMap}+ child contextMap : {ContextMap} -} -- cata sem_Grammar :: Grammar -> T_Grammar-sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _prods _pragmas _manualAttrOrderMap ) =- (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Productions _prods ) _pragmas _manualAttrOrderMap )+sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap) =+ (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts) _pragmas _manualAttrOrderMap _paramMap _contextMap) -- 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 sem ) (Inh_Grammar ) =+wrap_Grammar (T_Grammar sem) (Inh_Grammar ) = (let ( _lhsOpp) = (sem )- in (Syn_Grammar _lhsOpp ))+ in (Syn_Grammar _lhsOpp)) sem_Grammar_Grammar :: TypeSyns -> UseMap -> Derivings ->- (Set Nonterminal) ->- T_Productions ->+ (Set NontermIdent) ->+ T_Nonterminals -> PragmaMap -> AttrOrderMap ->+ ParamMap ->+ ContextMap -> T_Grammar-sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Productions prods_ ) pragmas_ manualAttrOrderMap_ =+sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ = (T_Grammar (let _lhsOpp :: PP_Doc- _prodsIpp :: PP_Doc- _prodsIppL :: ([PP_Doc])- -- "AbstractSyntaxDump.ag"(line 19, column 25)+ _nontsIpp :: PP_Doc+ _nontsIppL :: ([PP_Doc])+ -- "AbstractSyntaxDump.ag"(line 20, column 25) _lhsOpp = ppNestInfo ["Grammar","Grammar"] [] [ ppF "typeSyns" $ ppAssocL typeSyns_ , ppF "useMap" $ ppMap $ Map.map ppMap $ useMap_ , ppF "derivings" $ ppMap $ derivings_ , ppF "wrappers" $ ppShow $ wrappers_- , ppF "prods" $ ppVList _prodsIppL+ , ppF "nonts" $ ppVList _nontsIppL ] []- ( _prodsIpp,_prodsIppL) =- (prods_ )- in ( _lhsOpp)) )+ ( _nontsIpp,_nontsIppL) =+ (nonts_ )+ in ( _lhsOpp)))+-- Nonterminal -------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ pp : 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 (( PP_Doc))+data Inh_Nonterminal = Inh_Nonterminal {}+data Syn_Nonterminal = Syn_Nonterminal {pp_Syn_Nonterminal :: PP_Doc}+wrap_Nonterminal (T_Nonterminal sem) (Inh_Nonterminal ) =+ (let ( _lhsOpp) =+ (sem )+ in (Syn_Nonterminal _lhsOpp))+sem_Nonterminal_Nonterminal :: NontermIdent ->+ ([Identifier]) ->+ Attributes ->+ Attributes ->+ T_Productions ->+ T_Nonterminal+sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ (T_Productions prods_) =+ (T_Nonterminal (let _lhsOpp :: PP_Doc+ _prodsIpp :: PP_Doc+ _prodsIppL :: ([PP_Doc])+ -- "AbstractSyntaxDump.ag"(line 29, column 25)+ _lhsOpp =+ ppNestInfo ["Nonterminal","Nonterminal"] (pp nt_ : map pp params_) [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_, ppF "prods" $ ppVList _prodsIppL] []+ ( _prodsIpp,_prodsIppL) =+ (prods_ )+ in ( _lhsOpp)))+-- Nonterminals ------------------------------------------------+{-+ visit 0:+ synthesized attributes:+ pp : PP_Doc+ ppL : [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 (( PP_Doc,([PP_Doc])))+data Inh_Nonterminals = Inh_Nonterminals {}+data Syn_Nonterminals = Syn_Nonterminals {pp_Syn_Nonterminals :: PP_Doc,ppL_Syn_Nonterminals :: [PP_Doc]}+wrap_Nonterminals (T_Nonterminals sem) (Inh_Nonterminals ) =+ (let ( _lhsOpp,_lhsOppL) =+ (sem )+ in (Syn_Nonterminals _lhsOpp _lhsOppL))+sem_Nonterminals_Cons :: T_Nonterminal ->+ T_Nonterminals ->+ T_Nonterminals+sem_Nonterminals_Cons (T_Nonterminal hd_) (T_Nonterminals tl_) =+ (T_Nonterminals (let _lhsOppL :: ([PP_Doc])+ _lhsOpp :: PP_Doc+ _hdIpp :: PP_Doc+ _tlIpp :: PP_Doc+ _tlIppL :: ([PP_Doc])+ -- "AbstractSyntaxDump.ag"(line 75, column 33)+ _lhsOppL =+ _hdIpp : _tlIppL+ -- use rule "AbstractSyntaxDump.ag"(line 17, column 58)+ _lhsOpp =+ _hdIpp >-< _tlIpp+ ( _hdIpp) =+ (hd_ )+ ( _tlIpp,_tlIppL) =+ (tl_ )+ in ( _lhsOpp,_lhsOppL)))+sem_Nonterminals_Nil :: T_Nonterminals+sem_Nonterminals_Nil =+ (T_Nonterminals (let _lhsOppL :: ([PP_Doc])+ _lhsOpp :: PP_Doc+ -- "AbstractSyntaxDump.ag"(line 76, column 33)+ _lhsOppL =+ []+ -- use rule "AbstractSyntaxDump.ag"(line 17, column 58)+ _lhsOpp =+ empty+ in ( _lhsOpp,_lhsOppL))) -- Pattern ----------------------------------------------------- {- visit 0:@@ -312,17 +311,21 @@ pp : PP_Doc alternatives: alternative Alias:- child field : {Name}- child attr : {Name}+ child field : {Identifier}+ child attr : {Identifier} child pat : Pattern child parts : Patterns visit 0: local copy : _ alternative Constr:- child name : {Constructor}+ 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@@ -336,28 +339,30 @@ -- 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 (Product _pos _pats ) =- (sem_Pattern_Product _pos (sem_Patterns _pats ) )-sem_Pattern (Underscore _pos ) =- (sem_Pattern_Underscore _pos )+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,PP_Doc)) data Inh_Pattern = Inh_Pattern {} data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern,pp_Syn_Pattern :: PP_Doc}-wrap_Pattern (T_Pattern sem ) (Inh_Pattern ) =+wrap_Pattern (T_Pattern sem) (Inh_Pattern ) = (let ( _lhsOcopy,_lhsOpp) = (sem )- in (Syn_Pattern _lhsOcopy _lhsOpp ))-sem_Pattern_Alias :: Name ->- Name ->+ in (Syn_Pattern _lhsOcopy _lhsOpp))+sem_Pattern_Alias :: Identifier ->+ Identifier -> T_Pattern -> T_Patterns -> T_Pattern-sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) =+sem_Pattern_Alias field_ attr_ (T_Pattern pat_) (T_Patterns parts_) = (T_Pattern (let _lhsOpp :: PP_Doc _lhsOcopy :: Pattern _patIcopy :: Pattern@@ -365,7 +370,7 @@ _partsIcopy :: Patterns _partsIpp :: PP_Doc _partsIppL :: ([PP_Doc])- -- "AbstractSyntaxDump.ag"(line 45, column 33)+ -- "AbstractSyntaxDump.ag"(line 46, column 33) _lhsOpp = ppNestInfo ["Pattern","Alias"] [pp field_, pp attr_] [ppF "pat" $ _patIpp] [] -- self rule@@ -378,17 +383,17 @@ (pat_ ) ( _partsIcopy,_partsIpp,_partsIppL) = (parts_ )- in ( _lhsOcopy,_lhsOpp)) )-sem_Pattern_Constr :: Constructor ->+ in ( _lhsOcopy,_lhsOpp)))+sem_Pattern_Constr :: ConstructorIdent -> T_Patterns -> T_Pattern-sem_Pattern_Constr name_ (T_Patterns pats_ ) =+sem_Pattern_Constr name_ (T_Patterns pats_) = (T_Pattern (let _lhsOpp :: PP_Doc _lhsOcopy :: Pattern _patsIcopy :: Patterns _patsIpp :: PP_Doc _patsIppL :: ([PP_Doc])- -- "AbstractSyntaxDump.ag"(line 43, column 33)+ -- "AbstractSyntaxDump.ag"(line 44, column 33) _lhsOpp = ppNestInfo ["Pattern","Constr"] [pp name_] [ppF "pats" $ ppVList _patsIppL] [] -- self rule@@ -399,17 +404,36 @@ _copy ( _patsIcopy,_patsIpp,_patsIppL) = (pats_ )- in ( _lhsOcopy,_lhsOpp)) )+ in ( _lhsOcopy,_lhsOpp)))+sem_Pattern_Irrefutable :: T_Pattern ->+ T_Pattern+sem_Pattern_Irrefutable (T_Pattern pat_) =+ (T_Pattern (let _lhsOpp :: PP_Doc+ _lhsOcopy :: Pattern+ _patIcopy :: Pattern+ _patIpp :: PP_Doc+ -- use rule "AbstractSyntaxDump.ag"(line 17, column 58)+ _lhsOpp =+ _patIpp+ -- self rule+ _copy =+ Irrefutable _patIcopy+ -- self rule+ _lhsOcopy =+ _copy+ ( _patIcopy,_patIpp) =+ (pat_ )+ in ( _lhsOcopy,_lhsOpp))) sem_Pattern_Product :: Pos -> T_Patterns -> T_Pattern-sem_Pattern_Product pos_ (T_Patterns pats_ ) =+sem_Pattern_Product pos_ (T_Patterns pats_) = (T_Pattern (let _lhsOpp :: PP_Doc _lhsOcopy :: Pattern _patsIcopy :: Patterns _patsIpp :: PP_Doc _patsIppL :: ([PP_Doc])- -- "AbstractSyntaxDump.ag"(line 44, column 33)+ -- "AbstractSyntaxDump.ag"(line 45, column 33) _lhsOpp = ppNestInfo ["Pattern","Product"] [ppShow pos_] [ppF "pats" $ ppVList _patsIppL] [] -- self rule@@ -420,13 +444,13 @@ _copy ( _patsIcopy,_patsIpp,_patsIppL) = (pats_ )- in ( _lhsOcopy,_lhsOpp)) )+ in ( _lhsOcopy,_lhsOpp))) sem_Pattern_Underscore :: Pos -> T_Pattern-sem_Pattern_Underscore pos_ =+sem_Pattern_Underscore pos_ = (T_Pattern (let _lhsOpp :: PP_Doc _lhsOcopy :: Pattern- -- "AbstractSyntaxDump.ag"(line 46, column 25)+ -- "AbstractSyntaxDump.ag"(line 47, column 25) _lhsOpp = ppNestInfo ["Pattern","Underscore"] [ppShow pos_] [] [] -- self rule@@ -435,7 +459,7 @@ -- self rule _lhsOcopy = _copy- in ( _lhsOcopy,_lhsOpp)) )+ in ( _lhsOcopy,_lhsOpp))) -- Patterns ---------------------------------------------------- {- visit 0:@@ -456,20 +480,20 @@ -- cata sem_Patterns :: Patterns -> T_Patterns-sem_Patterns list =- (Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) )+sem_Patterns list =+ (Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list)) -- semantic domain newtype T_Patterns = T_Patterns (( Patterns,PP_Doc,([PP_Doc]))) data Inh_Patterns = Inh_Patterns {} data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns,pp_Syn_Patterns :: PP_Doc,ppL_Syn_Patterns :: [PP_Doc]}-wrap_Patterns (T_Patterns sem ) (Inh_Patterns ) =+wrap_Patterns (T_Patterns sem) (Inh_Patterns ) = (let ( _lhsOcopy,_lhsOpp,_lhsOppL) = (sem )- in (Syn_Patterns _lhsOcopy _lhsOpp _lhsOppL ))+ in (Syn_Patterns _lhsOcopy _lhsOpp _lhsOppL)) sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns-sem_Patterns_Cons (T_Pattern hd_ ) (T_Patterns tl_ ) =+sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) = (T_Patterns (let _lhsOppL :: ([PP_Doc]) _lhsOpp :: PP_Doc _lhsOcopy :: Patterns@@ -478,10 +502,10 @@ _tlIcopy :: Patterns _tlIpp :: PP_Doc _tlIppL :: ([PP_Doc])- -- "AbstractSyntaxDump.ag"(line 54, column 33)+ -- "AbstractSyntaxDump.ag"(line 55, column 33) _lhsOppL = _hdIpp : _tlIppL- -- use rule "AbstractSyntaxDump.ag"(line 16, column 58)+ -- use rule "AbstractSyntaxDump.ag"(line 17, column 58) _lhsOpp = _hdIpp >-< _tlIpp -- self rule@@ -494,16 +518,16 @@ (hd_ ) ( _tlIcopy,_tlIpp,_tlIppL) = (tl_ )- in ( _lhsOcopy,_lhsOpp,_lhsOppL)) )+ in ( _lhsOcopy,_lhsOpp,_lhsOppL))) sem_Patterns_Nil :: T_Patterns sem_Patterns_Nil = (T_Patterns (let _lhsOppL :: ([PP_Doc]) _lhsOpp :: PP_Doc _lhsOcopy :: Patterns- -- "AbstractSyntaxDump.ag"(line 55, column 33)+ -- "AbstractSyntaxDump.ag"(line 56, column 33) _lhsOppL = []- -- use rule "AbstractSyntaxDump.ag"(line 16, column 58)+ -- use rule "AbstractSyntaxDump.ag"(line 17, column 58) _lhsOpp = empty -- self rule@@ -512,7 +536,7 @@ -- self rule _lhsOcopy = _copy- in ( _lhsOcopy,_lhsOpp,_lhsOppL)) )+ in ( _lhsOcopy,_lhsOpp,_lhsOppL))) -- Production -------------------------------------------------- {- visit 0:@@ -520,39 +544,47 @@ pp : PP_Doc alternatives: alternative Production:- child nt : {Nonterminal}- child inh : {Attributes}- child syn : {Attributes}- child alts : Alternatives+ child con : {ConstructorIdent}+ child children : Children+ child rules : Rules+ child typeSigs : TypeSigs -} -- cata sem_Production :: Production -> T_Production-sem_Production (Production _nt _inh _syn _alts ) =- (sem_Production_Production _nt _inh _syn (sem_Alternatives _alts ) )+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)) data Inh_Production = Inh_Production {} data Syn_Production = Syn_Production {pp_Syn_Production :: PP_Doc}-wrap_Production (T_Production sem ) (Inh_Production ) =+wrap_Production (T_Production sem) (Inh_Production ) = (let ( _lhsOpp) = (sem )- in (Syn_Production _lhsOpp ))-sem_Production_Production :: Nonterminal ->- Attributes ->- Attributes ->- T_Alternatives ->+ in (Syn_Production _lhsOpp))+sem_Production_Production :: ConstructorIdent ->+ T_Children ->+ T_Rules ->+ T_TypeSigs -> T_Production-sem_Production_Production nt_ inh_ syn_ (T_Alternatives alts_ ) =+sem_Production_Production con_ (T_Children children_) (T_Rules rules_) (T_TypeSigs typeSigs_) = (T_Production (let _lhsOpp :: PP_Doc- _altsIpp :: PP_Doc- _altsIppL :: ([PP_Doc])- -- "AbstractSyntaxDump.ag"(line 28, column 25)+ _childrenIpp :: PP_Doc+ _childrenIppL :: ([PP_Doc])+ _rulesIpp :: PP_Doc+ _rulesIppL :: ([PP_Doc])+ _typeSigsIpp :: PP_Doc+ _typeSigsIppL :: ([PP_Doc])+ -- "AbstractSyntaxDump.ag"(line 32, column 25) _lhsOpp =- ppNestInfo ["Production","Production"] [pp nt_] [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_, ppF "alts" $ ppVList _altsIppL] []- ( _altsIpp,_altsIppL) =- (alts_ )- in ( _lhsOpp)) )+ ppNestInfo ["Production","Production"] [pp con_] [ppF "children" $ ppVList _childrenIppL,ppF "rules" $ ppVList _rulesIppL,ppF "typeSigs" $ ppVList _typeSigsIppL] []+ ( _childrenIpp,_childrenIppL) =+ (children_ )+ ( _rulesIpp,_rulesIppL) =+ (rules_ )+ ( _typeSigsIpp,_typeSigsIppL) =+ (typeSigs_ )+ in ( _lhsOpp))) -- Productions ------------------------------------------------- {- visit 0:@@ -568,47 +600,47 @@ -- cata sem_Productions :: Productions -> T_Productions-sem_Productions list =- (Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list) )+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]))) data Inh_Productions = Inh_Productions {} data Syn_Productions = Syn_Productions {pp_Syn_Productions :: PP_Doc,ppL_Syn_Productions :: [PP_Doc]}-wrap_Productions (T_Productions sem ) (Inh_Productions ) =+wrap_Productions (T_Productions sem) (Inh_Productions ) = (let ( _lhsOpp,_lhsOppL) = (sem )- in (Syn_Productions _lhsOpp _lhsOppL ))+ in (Syn_Productions _lhsOpp _lhsOppL)) sem_Productions_Cons :: T_Production -> T_Productions -> T_Productions-sem_Productions_Cons (T_Production hd_ ) (T_Productions tl_ ) =+sem_Productions_Cons (T_Production hd_) (T_Productions tl_) = (T_Productions (let _lhsOppL :: ([PP_Doc]) _lhsOpp :: PP_Doc _hdIpp :: PP_Doc _tlIpp :: PP_Doc _tlIppL :: ([PP_Doc])- -- "AbstractSyntaxDump.ag"(line 74, column 33)+ -- "AbstractSyntaxDump.ag"(line 71, column 33) _lhsOppL = _hdIpp : _tlIppL- -- use rule "AbstractSyntaxDump.ag"(line 16, column 58)+ -- use rule "AbstractSyntaxDump.ag"(line 17, column 58) _lhsOpp = _hdIpp >-< _tlIpp ( _hdIpp) = (hd_ ) ( _tlIpp,_tlIppL) = (tl_ )- in ( _lhsOpp,_lhsOppL)) )+ in ( _lhsOpp,_lhsOppL))) sem_Productions_Nil :: T_Productions sem_Productions_Nil = (T_Productions (let _lhsOppL :: ([PP_Doc]) _lhsOpp :: PP_Doc- -- "AbstractSyntaxDump.ag"(line 75, column 33)+ -- "AbstractSyntaxDump.ag"(line 72, column 33) _lhsOppL = []- -- use rule "AbstractSyntaxDump.ag"(line 16, column 58)+ -- use rule "AbstractSyntaxDump.ag"(line 17, column 58) _lhsOpp = empty- in ( _lhsOpp,_lhsOppL)) )+ in ( _lhsOpp,_lhsOppL))) -- Rule -------------------------------------------------------- {- visit 0:@@ -624,34 +656,34 @@ -- cata sem_Rule :: Rule -> T_Rule-sem_Rule (Rule _pattern _rhs _owrt _origin ) =- (sem_Rule_Rule (sem_Pattern _pattern ) (sem_Expression _rhs ) _owrt _origin )+sem_Rule (Rule _pattern _rhs _owrt _origin) =+ (sem_Rule_Rule (sem_Pattern _pattern) (sem_Expression _rhs) _owrt _origin) -- semantic domain newtype T_Rule = T_Rule (( PP_Doc)) data Inh_Rule = Inh_Rule {} data Syn_Rule = Syn_Rule {pp_Syn_Rule :: PP_Doc}-wrap_Rule (T_Rule sem ) (Inh_Rule ) =+wrap_Rule (T_Rule sem) (Inh_Rule ) = (let ( _lhsOpp) = (sem )- in (Syn_Rule _lhsOpp ))+ in (Syn_Rule _lhsOpp)) sem_Rule_Rule :: T_Pattern -> T_Expression -> Bool -> String -> T_Rule-sem_Rule_Rule (T_Pattern pattern_ ) (T_Expression rhs_ ) owrt_ origin_ =+sem_Rule_Rule (T_Pattern pattern_) (T_Expression rhs_) owrt_ origin_ = (T_Rule (let _lhsOpp :: PP_Doc _patternIcopy :: Pattern _patternIpp :: PP_Doc _rhsIpp :: PP_Doc- -- "AbstractSyntaxDump.ag"(line 37, column 33)+ -- "AbstractSyntaxDump.ag"(line 38, column 33) _lhsOpp = ppNestInfo ["Rule","Rule"] [ppShow owrt_, pp origin_] [ppF "pattern" $ _patternIpp, ppF "rhs" $ _rhsIpp] [] ( _patternIcopy,_patternIpp) = (pattern_ ) ( _rhsIpp) = (rhs_ )- in ( _lhsOpp)) )+ in ( _lhsOpp))) -- Rules ------------------------------------------------------- {- visit 0:@@ -667,47 +699,47 @@ -- cata sem_Rules :: Rules -> T_Rules-sem_Rules list =- (Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list) )+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]))) data Inh_Rules = Inh_Rules {} data Syn_Rules = Syn_Rules {pp_Syn_Rules :: PP_Doc,ppL_Syn_Rules :: [PP_Doc]}-wrap_Rules (T_Rules sem ) (Inh_Rules ) =+wrap_Rules (T_Rules sem) (Inh_Rules ) = (let ( _lhsOpp,_lhsOppL) = (sem )- in (Syn_Rules _lhsOpp _lhsOppL ))+ in (Syn_Rules _lhsOpp _lhsOppL)) sem_Rules_Cons :: T_Rule -> T_Rules -> T_Rules-sem_Rules_Cons (T_Rule hd_ ) (T_Rules tl_ ) =+sem_Rules_Cons (T_Rule hd_) (T_Rules tl_) = (T_Rules (let _lhsOppL :: ([PP_Doc]) _lhsOpp :: PP_Doc _hdIpp :: PP_Doc _tlIpp :: PP_Doc _tlIppL :: ([PP_Doc])- -- "AbstractSyntaxDump.ag"(line 62, column 33)+ -- "AbstractSyntaxDump.ag"(line 63, column 33) _lhsOppL = _hdIpp : _tlIppL- -- use rule "AbstractSyntaxDump.ag"(line 16, column 58)+ -- use rule "AbstractSyntaxDump.ag"(line 17, column 58) _lhsOpp = _hdIpp >-< _tlIpp ( _hdIpp) = (hd_ ) ( _tlIpp,_tlIppL) = (tl_ )- in ( _lhsOpp,_lhsOppL)) )+ in ( _lhsOpp,_lhsOppL))) sem_Rules_Nil :: T_Rules sem_Rules_Nil = (T_Rules (let _lhsOppL :: ([PP_Doc]) _lhsOpp :: PP_Doc- -- "AbstractSyntaxDump.ag"(line 63, column 33)+ -- "AbstractSyntaxDump.ag"(line 64, column 33) _lhsOppL = []- -- use rule "AbstractSyntaxDump.ag"(line 16, column 58)+ -- use rule "AbstractSyntaxDump.ag"(line 17, column 58) _lhsOpp = empty- in ( _lhsOpp,_lhsOppL)) )+ in ( _lhsOpp,_lhsOppL))) -- TypeSig ----------------------------------------------------- {- visit 0:@@ -715,31 +747,31 @@ pp : PP_Doc alternatives: alternative TypeSig:- child name : {Name}+ child name : {Identifier} child tp : {Type} -} -- cata sem_TypeSig :: TypeSig -> T_TypeSig-sem_TypeSig (TypeSig _name _tp ) =- (sem_TypeSig_TypeSig _name _tp )+sem_TypeSig (TypeSig _name _tp) =+ (sem_TypeSig_TypeSig _name _tp) -- semantic domain newtype T_TypeSig = T_TypeSig (( PP_Doc)) data Inh_TypeSig = Inh_TypeSig {} data Syn_TypeSig = Syn_TypeSig {pp_Syn_TypeSig :: PP_Doc}-wrap_TypeSig (T_TypeSig sem ) (Inh_TypeSig ) =+wrap_TypeSig (T_TypeSig sem) (Inh_TypeSig ) = (let ( _lhsOpp) = (sem )- in (Syn_TypeSig _lhsOpp ))-sem_TypeSig_TypeSig :: Name ->+ in (Syn_TypeSig _lhsOpp))+sem_TypeSig_TypeSig :: Identifier -> Type -> T_TypeSig-sem_TypeSig_TypeSig name_ tp_ =+sem_TypeSig_TypeSig name_ tp_ = (T_TypeSig (let _lhsOpp :: PP_Doc- -- "AbstractSyntaxDump.ag"(line 40, column 33)+ -- "AbstractSyntaxDump.ag"(line 41, column 33) _lhsOpp = ppNestInfo ["TypeSig","TypeSig"] [pp name_, ppShow tp_] [] []- in ( _lhsOpp)) )+ in ( _lhsOpp))) -- TypeSigs ---------------------------------------------------- {- visit 0:@@ -755,44 +787,44 @@ -- cata sem_TypeSigs :: TypeSigs -> T_TypeSigs-sem_TypeSigs list =- (Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) )+sem_TypeSigs list =+ (Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list)) -- semantic domain newtype T_TypeSigs = T_TypeSigs (( PP_Doc,([PP_Doc]))) data Inh_TypeSigs = Inh_TypeSigs {} data Syn_TypeSigs = Syn_TypeSigs {pp_Syn_TypeSigs :: PP_Doc,ppL_Syn_TypeSigs :: [PP_Doc]}-wrap_TypeSigs (T_TypeSigs sem ) (Inh_TypeSigs ) =+wrap_TypeSigs (T_TypeSigs sem) (Inh_TypeSigs ) = (let ( _lhsOpp,_lhsOppL) = (sem )- in (Syn_TypeSigs _lhsOpp _lhsOppL ))+ in (Syn_TypeSigs _lhsOpp _lhsOppL)) sem_TypeSigs_Cons :: T_TypeSig -> T_TypeSigs -> T_TypeSigs-sem_TypeSigs_Cons (T_TypeSig hd_ ) (T_TypeSigs tl_ ) =+sem_TypeSigs_Cons (T_TypeSig hd_) (T_TypeSigs tl_) = (T_TypeSigs (let _lhsOppL :: ([PP_Doc]) _lhsOpp :: PP_Doc _hdIpp :: PP_Doc _tlIpp :: PP_Doc _tlIppL :: ([PP_Doc])- -- "AbstractSyntaxDump.ag"(line 58, column 33)+ -- "AbstractSyntaxDump.ag"(line 59, column 33) _lhsOppL = _hdIpp : _tlIppL- -- use rule "AbstractSyntaxDump.ag"(line 16, column 58)+ -- use rule "AbstractSyntaxDump.ag"(line 17, column 58) _lhsOpp = _hdIpp >-< _tlIpp ( _hdIpp) = (hd_ ) ( _tlIpp,_tlIppL) = (tl_ )- in ( _lhsOpp,_lhsOppL)) )+ in ( _lhsOpp,_lhsOppL))) sem_TypeSigs_Nil :: T_TypeSigs sem_TypeSigs_Nil = (T_TypeSigs (let _lhsOppL :: ([PP_Doc]) _lhsOpp :: PP_Doc- -- "AbstractSyntaxDump.ag"(line 59, column 33)+ -- "AbstractSyntaxDump.ag"(line 60, column 33) _lhsOppL = []- -- use rule "AbstractSyntaxDump.ag"(line 16, column 58)+ -- use rule "AbstractSyntaxDump.ag"(line 17, column 58) _lhsOpp = empty- in ( _lhsOpp,_lhsOppL)) )+ in ( _lhsOpp,_lhsOppL)))
src-derived/Code.hs view
@@ -1,4 +1,3 @@- -- UUAGC 0.9.5 (Code.ag) module Code where @@ -32,7 +31,7 @@ child left : Lhs child expr : Expr -}-data CaseAlt = CaseAlt (Lhs) (Expr) +data CaseAlt = CaseAlt (Lhs) (Expr) -- CaseAlts ---------------------------------------------------- {- alternatives:@@ -56,7 +55,7 @@ child semFunctions : Decls child semNames : {[String]} -}-data Chunk = Chunk (String) (Decl) (Decls) (Decls) (Decls) (Decls) (Decls) (Decls) ([String]) +data Chunk = Chunk (String) (Decl) (Decls) (Decls) (Decls) (Decls) (Decls) (Decls) ([String]) -- Chunks ------------------------------------------------------ {- alternatives:@@ -76,8 +75,8 @@ child name : {String} child args : {[(String,String)]} -}-data DataAlt = DataAlt (String) ([String]) - | Record (String) ([(String,String)]) +data DataAlt = DataAlt (String) ([String])+ | Record (String) ([(String,String)]) -- DataAlts ---------------------------------------------------- {- alternatives:@@ -94,6 +93,7 @@ child txt : {String} alternative Data: child name : {String}+ child params : {[String]} child alts : DataAlts child strict : {Bool} child derivings : {[String]}@@ -104,6 +104,7 @@ child uses : {Set String} alternative NewType: child name : {String}+ child params : {[String]} child con : {String} child tp : Type alternative PragmaDecl:@@ -113,15 +114,16 @@ child tp : Type alternative Type: child name : {String}+ child params : {[String]} child tp : Type -}-data Decl = Comment (String) - | Data (String) (DataAlts) (Bool) ([String]) - | Decl (Lhs) (Expr) (Set String) (Set String) - | NewType (String) (String) (Type) - | PragmaDecl (String) - | TSig (String) (Type) - | Type (String) (Type) +data Decl = Comment (String)+ | Data (String) ([String]) (DataAlts) (Bool) ([String])+ | Decl (Lhs) (Expr) (Set String) (Set String)+ | NewType (String) ([String]) (String) (Type)+ | PragmaDecl (String)+ | TSig (String) (Type)+ | Type (String) ([String]) (Type) -- Decls ------------------------------------------------------- {- alternatives:@@ -141,7 +143,7 @@ child expr : Expr child alts : CaseAlts alternative Lambda:- child args : {[String]}+ child args : Exprs child body : Expr alternative Let: child decls : Decls@@ -162,20 +164,24 @@ child expr : Expr alternative TupleExpr: child exprs : Exprs+ alternative TypedExpr:+ child expr : Expr+ child tp : Type alternative UnboxedTupleExpr: child exprs : Exprs -}-data Expr = App (String) (Exprs) - | Case (Expr) (CaseAlts) - | Lambda ([String]) (Expr) - | Let (Decls) (Expr) - | LineExpr (Expr) - | PragmaExpr (Bool) (Bool) (String) (Expr) - | SimpleExpr (String) - | TextExpr ([String]) - | Trace (String) (Expr) - | TupleExpr (Exprs) - | UnboxedTupleExpr (Exprs) +data Expr = App (String) (Exprs)+ | Case (Expr) (CaseAlts)+ | Lambda (Exprs) (Expr)+ | Let (Decls) (Expr)+ | LineExpr (Expr)+ | PragmaExpr (Bool) (Bool) (String) (Expr)+ | SimpleExpr (String)+ | TextExpr ([String])+ | Trace (String) (Expr)+ | TupleExpr (Exprs)+ | TypedExpr (Expr) (Type)+ | UnboxedTupleExpr (Exprs) -- Exprs ------------------------------------------------------- {- alternatives:@@ -200,38 +206,46 @@ alternative UnboxedTupleLhs: child comps : {[String]} -}-data Lhs = Fun (String) (Exprs) - | Pattern3 (Pattern) - | Pattern3SM (Pattern) - | TupleLhs ([String]) - | UnboxedTupleLhs ([String]) +data Lhs = Fun (String) (Exprs)+ | Pattern3 (Pattern)+ | Pattern3SM (Pattern)+ | TupleLhs ([String])+ | UnboxedTupleLhs ([String]) -- Program ----------------------------------------------------- {- alternatives: alternative Program: child chunks : Chunks -}-data Program = Program (Chunks) +data Program = Program (Chunks) -- Type -------------------------------------------------------- {- alternatives: alternative Arr: child left : Type child right : Type+ alternative CtxApp:+ child left : {[(String, [String])]}+ child right : Type alternative List: child tp : Type alternative SimpleType: child txt : {String} alternative TupleType: child tps : Types+ alternative TypeApp:+ child func : Type+ child args : Types alternative UnboxedTupleType: child tps : Types -}-data Type = Arr (Type) (Type) - | List (Type) - | SimpleType (String) - | TupleType (Types) - | UnboxedTupleType (Types) +data Type = Arr (Type) (Type)+ | CtxApp ([(String, [String])]) (Type)+ | List (Type)+ | SimpleType (String)+ | TupleType (Types)+ | TypeApp (Type) (Types)+ | UnboxedTupleType (Types) -- Types ------------------------------------------------------- {- alternatives:
src-derived/CodeSyntax.hs view
@@ -1,4 +1,3 @@- -- UUAGC 0.9.5 (CodeSyntax.ag) module CodeSyntax where @@ -6,54 +5,57 @@ import CommonTypes import Data.Map(Map) import Data.Set(Set)--- CAlternative -------------------------------------------------{-- alternatives:- alternative CAlternative:- child con : {Constructor}- child visits : CVisits- child children : {[(Name,Type,Bool)]}- child terminals : {[Name]}--}-data CAlternative = CAlternative (Constructor) (CVisits) ([(Name,Type,Bool)]) ([Name]) --- CAlternatives ------------------------------------------------{-- alternatives:- alternative Cons:- child hd : CAlternative- child tl : CAlternatives- alternative Nil:--}-type CAlternatives = [CAlternative] -- CGrammar ---------------------------------------------------- {- alternatives: alternative CGrammar: child typeSyns : {TypeSyns} child derivings : {Derivings}- child wrappers : {Set Nonterminal}- child prods : CProductions+ child wrappers : {Set NontermIdent}+ child nonts : CNonterminals child pragmas : {PragmaMap}+ child paramMap : {ParamMap}+ child contextMap : {ContextMap} -}-data CGrammar = CGrammar (TypeSyns) (Derivings) (Set Nonterminal) (CProductions) (PragmaMap) +data CGrammar = CGrammar (TypeSyns) (Derivings) (Set NontermIdent) (CNonterminals) (PragmaMap) (ParamMap) (ContextMap) -- CInterface -------------------------------------------------- {- alternatives: alternative CInterface: child seg : CSegments -}-data CInterface = CInterface (CSegments) --- CProduction -------------------------------------------------+data CInterface = CInterface (CSegments)+-- CNonterminal ------------------------------------------------ {- alternatives:- alternative CProduction:- child nt : {Nonterminal}+ alternative CNonterminal:+ child nt : {NontermIdent}+ child params : {[Identifier]} child inh : {Attributes} child syn : {Attributes}- child alts : CAlternatives+ child prods : CProductions child inter : CInterface -}-data CProduction = CProduction (Nonterminal) (Attributes) (Attributes) (CAlternatives) (CInterface) +data CNonterminal = CNonterminal (NontermIdent) ([Identifier]) (Attributes) (Attributes) (CProductions) (CInterface)+-- CNonterminals -----------------------------------------------+{-+ alternatives:+ alternative Cons:+ child hd : CNonterminal+ child tl : CNonterminals+ alternative Nil:+-}+type CNonterminals = [CNonterminal]+-- CProduction -------------------------------------------------+{-+ alternatives:+ alternative CProduction:+ child con : {ConstructorIdent}+ child visits : CVisits+ child children : {[(Identifier,Type,Bool)]}+ child terminals : {[Identifier]}+-}+data CProduction = CProduction (ConstructorIdent) (CVisits) ([(Identifier,Type,Bool)]) ([Identifier]) -- CProductions ------------------------------------------------ {- alternatives:@@ -67,30 +69,30 @@ {- alternatives: alternative CChildVisit:- child name : {Name}- child nt : {Nonterminal}+ child name : {Identifier}+ child nt : {NontermIdent} child nr : {Int} child inh : {Attributes} child syn : {Attributes} child isLast : {Bool} alternative CRule:- child name : {Name}+ child name : {Identifier} child isIn : {Bool} child hasCode : {Bool}- child nt : {Nonterminal}- child con : {Constructor}- child field : {Name}- child childnt : {Maybe Nonterminal}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child field : {Identifier}+ child childnt : {Maybe NontermIdent} child tp : {Maybe Type} child pattern : {Pattern} child rhs : {[String]}- child defines : {Map Int (Name,Name,Maybe Type)}+ child defines : {Map Int (Identifier,Identifier,Maybe Type)} child owrt : {Bool} child origin : {String}- child uses : {Set (Name, Name)}+ child uses : {Set (Identifier, Identifier)} -}-data CRule = CChildVisit (Name) (Nonterminal) (Int) (Attributes) (Attributes) (Bool) - | CRule (Name) (Bool) (Bool) (Nonterminal) (Constructor) (Name) (Maybe Nonterminal) (Maybe Type) (Pattern) ([String]) (Map Int (Name,Name,Maybe Type)) (Bool) (String) (Set (Name, Name)) +data CRule = CChildVisit (Identifier) (NontermIdent) (Int) (Attributes) (Attributes) (Bool)+ | CRule (Identifier) (Bool) (Bool) (NontermIdent) (ConstructorIdent) (Identifier) (Maybe NontermIdent) (Maybe Type) (Pattern) ([String]) (Map Int (Identifier,Identifier,Maybe Type)) (Bool) (String) (Set (Identifier, Identifier)) -- CSegment ---------------------------------------------------- {- alternatives:@@ -98,7 +100,7 @@ child inh : {Attributes} child syn : {Attributes} -}-data CSegment = CSegment (Attributes) (Attributes) +data CSegment = CSegment (Attributes) (Attributes) -- CSegments --------------------------------------------------- {- alternatives:@@ -118,7 +120,7 @@ child intra : Sequence child ordered : {Bool} -}-data CVisit = CVisit (Attributes) (Attributes) (Sequence) (Sequence) (Bool) +data CVisit = CVisit (Attributes) (Attributes) (Sequence) (Sequence) (Bool) -- CVisits ----------------------------------------------------- {- alternatives:
src-derived/CodeSyntaxDump.hs view
@@ -1,4 +1,3 @@- -- UUAGC 0.9.5 (CodeSyntaxDump.ag) module CodeSyntaxDump where @@ -17,17 +16,17 @@ -- Patterns.ag imports import UU.Scanner.Position(Pos)-import CommonTypes (Constructor,Name)+import CommonTypes (ConstructorIdent,Identifier) -ppChild :: (Name,Type,Bool) -> PP_Doc+ppChild :: (Identifier,Type,Bool) -> PP_Doc ppChild (nm,tp,b) = pp nm >#< "::" >#< pp (show tp) >#< "<" >|< ppBool b >|< ">" -ppVertexMap :: Map Int (Name,Name,Maybe Type) -> PP_Doc+ppVertexMap :: Map Int (Identifier,Identifier,Maybe Type) -> PP_Doc ppVertexMap m = ppVList [ ppF (show k) $ ppAttr v | (k,v) <- Map.toList m ] -ppAttr :: (Name,Name,Maybe Type) -> PP_Doc+ppAttr :: (Identifier,Identifier,Maybe Type) -> PP_Doc ppAttr (fld,nm,mTp) = pp fld >|< "." >|< pp nm >#< case mTp of@@ -44,102 +43,6 @@ ppStrings :: [String] -> PP_Doc ppStrings = vlist--- CAlternative -------------------------------------------------{-- visit 0:- synthesized attribute:- pp : PP_Doc- alternatives:- alternative CAlternative:- child con : {Constructor}- child visits : CVisits- child children : {[(Name,Type,Bool)]}- child terminals : {[Name]}--}--- cata-sem_CAlternative :: CAlternative ->- T_CAlternative-sem_CAlternative (CAlternative _con _visits _children _terminals ) =- (sem_CAlternative_CAlternative _con (sem_CVisits _visits ) _children _terminals )--- semantic domain-newtype T_CAlternative = T_CAlternative (( PP_Doc))-data Inh_CAlternative = Inh_CAlternative {}-data Syn_CAlternative = Syn_CAlternative {pp_Syn_CAlternative :: PP_Doc}-wrap_CAlternative (T_CAlternative sem ) (Inh_CAlternative ) =- (let ( _lhsOpp) =- (sem )- in (Syn_CAlternative _lhsOpp ))-sem_CAlternative_CAlternative :: Constructor ->- T_CVisits ->- ([(Name,Type,Bool)]) ->- ([Name]) ->- T_CAlternative-sem_CAlternative_CAlternative con_ (T_CVisits visits_ ) children_ terminals_ =- (T_CAlternative (let _lhsOpp :: PP_Doc- _visitsIpp :: PP_Doc- _visitsIppL :: ([PP_Doc])- -- "CodeSyntaxDump.ag"(line 63, column 25)- _lhsOpp =- ppNestInfo ["CAlternative","CAlternative"] [pp con_] [ppF "visits" $ ppVList _visitsIppL, ppF "children" $ ppVList (map ppChild children_),ppF "terminals" $ ppVList (map ppShow terminals_)] []- ( _visitsIpp,_visitsIppL) =- (visits_ )- in ( _lhsOpp)) )--- CAlternatives ------------------------------------------------{-- visit 0:- synthesized attributes:- pp : PP_Doc- ppL : [PP_Doc]- alternatives:- alternative Cons:- child hd : CAlternative- child tl : CAlternatives- alternative Nil:--}--- cata-sem_CAlternatives :: CAlternatives ->- T_CAlternatives-sem_CAlternatives list =- (Prelude.foldr sem_CAlternatives_Cons sem_CAlternatives_Nil (Prelude.map sem_CAlternative list) )--- semantic domain-newtype T_CAlternatives = T_CAlternatives (( PP_Doc,([PP_Doc])))-data Inh_CAlternatives = Inh_CAlternatives {}-data Syn_CAlternatives = Syn_CAlternatives {pp_Syn_CAlternatives :: PP_Doc,ppL_Syn_CAlternatives :: [PP_Doc]}-wrap_CAlternatives (T_CAlternatives sem ) (Inh_CAlternatives ) =- (let ( _lhsOpp,_lhsOppL) =- (sem )- in (Syn_CAlternatives _lhsOpp _lhsOppL ))-sem_CAlternatives_Cons :: T_CAlternative ->- T_CAlternatives ->- T_CAlternatives-sem_CAlternatives_Cons (T_CAlternative hd_ ) (T_CAlternatives tl_ ) =- (T_CAlternatives (let _lhsOppL :: ([PP_Doc])- _lhsOpp :: PP_Doc- _hdIpp :: PP_Doc- _tlIpp :: PP_Doc- _tlIppL :: ([PP_Doc])- -- "CodeSyntaxDump.ag"(line 94, column 33)- _lhsOppL =- _hdIpp : _tlIppL- -- use rule "CodeSyntaxDump.ag"(line 44, column 40)- _lhsOpp =- _hdIpp >-< _tlIpp- ( _hdIpp) =- (hd_ )- ( _tlIpp,_tlIppL) =- (tl_ )- in ( _lhsOpp,_lhsOppL)) )-sem_CAlternatives_Nil :: T_CAlternatives-sem_CAlternatives_Nil =- (T_CAlternatives (let _lhsOppL :: ([PP_Doc])- _lhsOpp :: PP_Doc- -- "CodeSyntaxDump.ag"(line 95, column 33)- _lhsOppL =- []- -- use rule "CodeSyntaxDump.ag"(line 44, column 40)- _lhsOpp =- empty- in ( _lhsOpp,_lhsOppL)) ) -- CGrammar ---------------------------------------------------- {- visit 0:@@ -149,43 +52,47 @@ alternative CGrammar: child typeSyns : {TypeSyns} child derivings : {Derivings}- child wrappers : {Set Nonterminal}- child prods : CProductions+ child wrappers : {Set NontermIdent}+ child nonts : CNonterminals child pragmas : {PragmaMap}+ child paramMap : {ParamMap}+ child contextMap : {ContextMap} -} -- cata sem_CGrammar :: CGrammar -> T_CGrammar-sem_CGrammar (CGrammar _typeSyns _derivings _wrappers _prods _pragmas ) =- (sem_CGrammar_CGrammar _typeSyns _derivings _wrappers (sem_CProductions _prods ) _pragmas )+sem_CGrammar (CGrammar _typeSyns _derivings _wrappers _nonts _pragmas _paramMap _contextMap) =+ (sem_CGrammar_CGrammar _typeSyns _derivings _wrappers (sem_CNonterminals _nonts) _pragmas _paramMap _contextMap) -- semantic domain newtype T_CGrammar = T_CGrammar (( PP_Doc)) data Inh_CGrammar = Inh_CGrammar {} data Syn_CGrammar = Syn_CGrammar {pp_Syn_CGrammar :: PP_Doc}-wrap_CGrammar (T_CGrammar sem ) (Inh_CGrammar ) =+wrap_CGrammar (T_CGrammar sem) (Inh_CGrammar ) = (let ( _lhsOpp) = (sem )- in (Syn_CGrammar _lhsOpp ))+ in (Syn_CGrammar _lhsOpp)) sem_CGrammar_CGrammar :: TypeSyns -> Derivings ->- (Set Nonterminal) ->- T_CProductions ->+ (Set NontermIdent) ->+ T_CNonterminals -> PragmaMap ->+ ParamMap ->+ ContextMap -> T_CGrammar-sem_CGrammar_CGrammar typeSyns_ derivings_ wrappers_ (T_CProductions prods_ ) pragmas_ =+sem_CGrammar_CGrammar typeSyns_ derivings_ wrappers_ (T_CNonterminals nonts_) pragmas_ paramMap_ contextMap_ = (T_CGrammar (let _lhsOpp :: PP_Doc- _prodsIpp :: PP_Doc- _prodsIppL :: ([PP_Doc])+ _nontsIpp :: PP_Doc+ _nontsIppL :: ([PP_Doc]) -- "CodeSyntaxDump.ag"(line 47, column 21) _lhsOpp = ppNestInfo ["CGrammar","CGrammar"] [] [ ppF "typeSyns" $ ppAssocL typeSyns_ , ppF "derivings" $ ppMap $ derivings_- , ppF "prods" $ ppVList _prodsIppL+ , ppF "nonts" $ ppVList _nontsIppL ] []- ( _prodsIpp,_prodsIppL) =- (prods_ )- in ( _lhsOpp)) )+ ( _nontsIpp,_nontsIppL) =+ (nonts_ )+ in ( _lhsOpp))) -- CInterface -------------------------------------------------- {- visit 0:@@ -198,19 +105,19 @@ -- cata sem_CInterface :: CInterface -> T_CInterface-sem_CInterface (CInterface _seg ) =- (sem_CInterface_CInterface (sem_CSegments _seg ) )+sem_CInterface (CInterface _seg) =+ (sem_CInterface_CInterface (sem_CSegments _seg)) -- semantic domain newtype T_CInterface = T_CInterface (( PP_Doc)) data Inh_CInterface = Inh_CInterface {} data Syn_CInterface = Syn_CInterface {pp_Syn_CInterface :: PP_Doc}-wrap_CInterface (T_CInterface sem ) (Inh_CInterface ) =+wrap_CInterface (T_CInterface sem) (Inh_CInterface ) = (let ( _lhsOpp) = (sem )- in (Syn_CInterface _lhsOpp ))+ in (Syn_CInterface _lhsOpp)) sem_CInterface_CInterface :: T_CSegments -> T_CInterface-sem_CInterface_CInterface (T_CSegments seg_ ) =+sem_CInterface_CInterface (T_CSegments seg_) = (T_CInterface (let _lhsOpp :: PP_Doc _segIpp :: PP_Doc _segIppL :: ([PP_Doc])@@ -219,52 +126,150 @@ ppNestInfo ["CInterface","CInterface"] [] [ppF "seg" $ ppVList _segIppL] [] ( _segIpp,_segIppL) = (seg_ )- in ( _lhsOpp)) )--- CProduction -------------------------------------------------+ in ( _lhsOpp)))+-- CNonterminal ------------------------------------------------ {- visit 0: synthesized attribute: pp : PP_Doc alternatives:- alternative CProduction:- child nt : {Nonterminal}+ alternative CNonterminal:+ child nt : {NontermIdent}+ child params : {[Identifier]} child inh : {Attributes} child syn : {Attributes}- child alts : CAlternatives+ child prods : CProductions child inter : CInterface -} -- cata+sem_CNonterminal :: CNonterminal ->+ T_CNonterminal+sem_CNonterminal (CNonterminal _nt _params _inh _syn _prods _inter) =+ (sem_CNonterminal_CNonterminal _nt _params _inh _syn (sem_CProductions _prods) (sem_CInterface _inter))+-- semantic domain+newtype T_CNonterminal = T_CNonterminal (( PP_Doc))+data Inh_CNonterminal = Inh_CNonterminal {}+data Syn_CNonterminal = Syn_CNonterminal {pp_Syn_CNonterminal :: PP_Doc}+wrap_CNonterminal (T_CNonterminal sem) (Inh_CNonterminal ) =+ (let ( _lhsOpp) =+ (sem )+ in (Syn_CNonterminal _lhsOpp))+sem_CNonterminal_CNonterminal :: NontermIdent ->+ ([Identifier]) ->+ Attributes ->+ Attributes ->+ T_CProductions ->+ T_CInterface ->+ T_CNonterminal+sem_CNonterminal_CNonterminal nt_ params_ inh_ syn_ (T_CProductions prods_) (T_CInterface inter_) =+ (T_CNonterminal (let _lhsOpp :: PP_Doc+ _prodsIpp :: PP_Doc+ _prodsIppL :: ([PP_Doc])+ _interIpp :: PP_Doc+ -- "CodeSyntaxDump.ag"(line 54, column 33)+ _lhsOpp =+ ppNestInfo ["CNonterminal","CNonterminal"] (pp nt_ : map pp params_) [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_, ppF "prods" $ ppVList _prodsIppL, ppF "inter" _interIpp] []+ ( _prodsIpp,_prodsIppL) =+ (prods_ )+ ( _interIpp) =+ (inter_ )+ in ( _lhsOpp)))+-- CNonterminals -----------------------------------------------+{-+ visit 0:+ synthesized attributes:+ pp : PP_Doc+ ppL : [PP_Doc]+ alternatives:+ alternative Cons:+ child hd : CNonterminal+ child tl : CNonterminals+ alternative Nil:+-}+-- cata+sem_CNonterminals :: CNonterminals ->+ T_CNonterminals+sem_CNonterminals list =+ (Prelude.foldr sem_CNonterminals_Cons sem_CNonterminals_Nil (Prelude.map sem_CNonterminal list))+-- semantic domain+newtype T_CNonterminals = T_CNonterminals (( PP_Doc,([PP_Doc])))+data Inh_CNonterminals = Inh_CNonterminals {}+data Syn_CNonterminals = Syn_CNonterminals {pp_Syn_CNonterminals :: PP_Doc,ppL_Syn_CNonterminals :: [PP_Doc]}+wrap_CNonterminals (T_CNonterminals sem) (Inh_CNonterminals ) =+ (let ( _lhsOpp,_lhsOppL) =+ (sem )+ in (Syn_CNonterminals _lhsOpp _lhsOppL))+sem_CNonterminals_Cons :: T_CNonterminal ->+ T_CNonterminals ->+ T_CNonterminals+sem_CNonterminals_Cons (T_CNonterminal hd_) (T_CNonterminals tl_) =+ (T_CNonterminals (let _lhsOppL :: ([PP_Doc])+ _lhsOpp :: PP_Doc+ _hdIpp :: PP_Doc+ _tlIpp :: PP_Doc+ _tlIppL :: ([PP_Doc])+ -- "CodeSyntaxDump.ag"(line 102, column 33)+ _lhsOppL =+ _hdIpp : _tlIppL+ -- use rule "CodeSyntaxDump.ag"(line 44, column 40)+ _lhsOpp =+ _hdIpp >-< _tlIpp+ ( _hdIpp) =+ (hd_ )+ ( _tlIpp,_tlIppL) =+ (tl_ )+ in ( _lhsOpp,_lhsOppL)))+sem_CNonterminals_Nil :: T_CNonterminals+sem_CNonterminals_Nil =+ (T_CNonterminals (let _lhsOppL :: ([PP_Doc])+ _lhsOpp :: PP_Doc+ -- "CodeSyntaxDump.ag"(line 103, column 33)+ _lhsOppL =+ []+ -- use rule "CodeSyntaxDump.ag"(line 44, column 40)+ _lhsOpp =+ empty+ in ( _lhsOpp,_lhsOppL)))+-- CProduction -------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ pp : PP_Doc+ alternatives:+ alternative CProduction:+ child con : {ConstructorIdent}+ child visits : CVisits+ child children : {[(Identifier,Type,Bool)]}+ child terminals : {[Identifier]}+-}+-- cata sem_CProduction :: CProduction -> T_CProduction-sem_CProduction (CProduction _nt _inh _syn _alts _inter ) =- (sem_CProduction_CProduction _nt _inh _syn (sem_CAlternatives _alts ) (sem_CInterface _inter ) )+sem_CProduction (CProduction _con _visits _children _terminals) =+ (sem_CProduction_CProduction _con (sem_CVisits _visits) _children _terminals) -- semantic domain newtype T_CProduction = T_CProduction (( PP_Doc)) data Inh_CProduction = Inh_CProduction {} data Syn_CProduction = Syn_CProduction {pp_Syn_CProduction :: PP_Doc}-wrap_CProduction (T_CProduction sem ) (Inh_CProduction ) =+wrap_CProduction (T_CProduction sem) (Inh_CProduction ) = (let ( _lhsOpp) = (sem )- in (Syn_CProduction _lhsOpp ))-sem_CProduction_CProduction :: Nonterminal ->- Attributes ->- Attributes ->- T_CAlternatives ->- T_CInterface ->+ in (Syn_CProduction _lhsOpp))+sem_CProduction_CProduction :: ConstructorIdent ->+ T_CVisits ->+ ([(Identifier,Type,Bool)]) ->+ ([Identifier]) -> T_CProduction-sem_CProduction_CProduction nt_ inh_ syn_ (T_CAlternatives alts_ ) (T_CInterface inter_ ) =+sem_CProduction_CProduction con_ (T_CVisits visits_) children_ terminals_ = (T_CProduction (let _lhsOpp :: PP_Doc- _altsIpp :: PP_Doc- _altsIppL :: ([PP_Doc])- _interIpp :: PP_Doc- -- "CodeSyntaxDump.ag"(line 54, column 25)+ _visitsIpp :: PP_Doc+ _visitsIppL :: ([PP_Doc])+ -- "CodeSyntaxDump.ag"(line 63, column 17) _lhsOpp =- ppNestInfo ["CProduction","CProduction"] [pp nt_] [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_, ppF "alts" $ ppVList _altsIppL, ppF "inter" _interIpp] []- ( _altsIpp,_altsIppL) =- (alts_ )- ( _interIpp) =- (inter_ )- in ( _lhsOpp)) )+ ppNestInfo ["CProduction","CProduction"] [pp con_] [ppF "visits" $ ppVList _visitsIppL, ppF "children" $ ppVList (map ppChild children_),ppF "terminals" $ ppVList (map ppShow terminals_)] []+ ( _visitsIpp,_visitsIppL) =+ (visits_ )+ in ( _lhsOpp))) -- CProductions ------------------------------------------------ {- visit 0:@@ -280,26 +285,26 @@ -- cata sem_CProductions :: CProductions -> T_CProductions-sem_CProductions list =- (Prelude.foldr sem_CProductions_Cons sem_CProductions_Nil (Prelude.map sem_CProduction list) )+sem_CProductions list =+ (Prelude.foldr sem_CProductions_Cons sem_CProductions_Nil (Prelude.map sem_CProduction list)) -- semantic domain newtype T_CProductions = T_CProductions (( PP_Doc,([PP_Doc]))) data Inh_CProductions = Inh_CProductions {} data Syn_CProductions = Syn_CProductions {pp_Syn_CProductions :: PP_Doc,ppL_Syn_CProductions :: [PP_Doc]}-wrap_CProductions (T_CProductions sem ) (Inh_CProductions ) =+wrap_CProductions (T_CProductions sem) (Inh_CProductions ) = (let ( _lhsOpp,_lhsOppL) = (sem )- in (Syn_CProductions _lhsOpp _lhsOppL ))+ in (Syn_CProductions _lhsOpp _lhsOppL)) sem_CProductions_Cons :: T_CProduction -> T_CProductions -> T_CProductions-sem_CProductions_Cons (T_CProduction hd_ ) (T_CProductions tl_ ) =+sem_CProductions_Cons (T_CProduction hd_) (T_CProductions tl_) = (T_CProductions (let _lhsOppL :: ([PP_Doc]) _lhsOpp :: PP_Doc _hdIpp :: PP_Doc _tlIpp :: PP_Doc _tlIppL :: ([PP_Doc])- -- "CodeSyntaxDump.ag"(line 102, column 33)+ -- "CodeSyntaxDump.ag"(line 94, column 33) _lhsOppL = _hdIpp : _tlIppL -- use rule "CodeSyntaxDump.ag"(line 44, column 40)@@ -309,18 +314,18 @@ (hd_ ) ( _tlIpp,_tlIppL) = (tl_ )- in ( _lhsOpp,_lhsOppL)) )+ in ( _lhsOpp,_lhsOppL))) sem_CProductions_Nil :: T_CProductions sem_CProductions_Nil = (T_CProductions (let _lhsOppL :: ([PP_Doc]) _lhsOpp :: PP_Doc- -- "CodeSyntaxDump.ag"(line 103, column 33)+ -- "CodeSyntaxDump.ag"(line 95, column 33) _lhsOppL = [] -- use rule "CodeSyntaxDump.ag"(line 44, column 40) _lhsOpp = empty- in ( _lhsOpp,_lhsOppL)) )+ in ( _lhsOpp,_lhsOppL))) -- CRule ------------------------------------------------------- {- visit 0:@@ -328,72 +333,72 @@ pp : PP_Doc alternatives: alternative CChildVisit:- child name : {Name}- child nt : {Nonterminal}+ child name : {Identifier}+ child nt : {NontermIdent} child nr : {Int} child inh : {Attributes} child syn : {Attributes} child isLast : {Bool} alternative CRule:- child name : {Name}+ child name : {Identifier} child isIn : {Bool} child hasCode : {Bool}- child nt : {Nonterminal}- child con : {Constructor}- child field : {Name}- child childnt : {Maybe Nonterminal}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child field : {Identifier}+ child childnt : {Maybe NontermIdent} child tp : {Maybe Type} child pattern : Pattern child rhs : {[String]}- child defines : {Map Int (Name,Name,Maybe Type)}+ child defines : {Map Int (Identifier,Identifier,Maybe Type)} child owrt : {Bool} child origin : {String}- child uses : {Set (Name, Name)}+ child uses : {Set (Identifier, Identifier)} -} -- cata sem_CRule :: CRule -> T_CRule-sem_CRule (CChildVisit _name _nt _nr _inh _syn _isLast ) =- (sem_CRule_CChildVisit _name _nt _nr _inh _syn _isLast )-sem_CRule (CRule _name _isIn _hasCode _nt _con _field _childnt _tp _pattern _rhs _defines _owrt _origin _uses ) =- (sem_CRule_CRule _name _isIn _hasCode _nt _con _field _childnt _tp (sem_Pattern _pattern ) _rhs _defines _owrt _origin _uses )+sem_CRule (CChildVisit _name _nt _nr _inh _syn _isLast) =+ (sem_CRule_CChildVisit _name _nt _nr _inh _syn _isLast)+sem_CRule (CRule _name _isIn _hasCode _nt _con _field _childnt _tp _pattern _rhs _defines _owrt _origin _uses) =+ (sem_CRule_CRule _name _isIn _hasCode _nt _con _field _childnt _tp (sem_Pattern _pattern) _rhs _defines _owrt _origin _uses) -- semantic domain newtype T_CRule = T_CRule (( PP_Doc)) data Inh_CRule = Inh_CRule {} data Syn_CRule = Syn_CRule {pp_Syn_CRule :: PP_Doc}-wrap_CRule (T_CRule sem ) (Inh_CRule ) =+wrap_CRule (T_CRule sem) (Inh_CRule ) = (let ( _lhsOpp) = (sem )- in (Syn_CRule _lhsOpp ))-sem_CRule_CChildVisit :: Name ->- Nonterminal ->+ in (Syn_CRule _lhsOpp))+sem_CRule_CChildVisit :: Identifier ->+ NontermIdent -> Int -> Attributes -> Attributes -> Bool -> T_CRule-sem_CRule_CChildVisit name_ nt_ nr_ inh_ syn_ isLast_ =+sem_CRule_CChildVisit name_ nt_ nr_ inh_ syn_ isLast_ = (T_CRule (let _lhsOpp :: PP_Doc -- "CodeSyntaxDump.ag"(line 70, column 21) _lhsOpp = ppNestInfo ["CRule","CChildVisit"] [pp name_] [ppF "nt" $ pp nt_, ppF "nr" $ ppShow nr_, ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_, ppF "last" $ ppBool isLast_] []- in ( _lhsOpp)) )-sem_CRule_CRule :: Name ->+ in ( _lhsOpp)))+sem_CRule_CRule :: Identifier -> Bool -> Bool ->- Nonterminal ->- Constructor ->- Name ->- (Maybe Nonterminal) ->+ NontermIdent ->+ ConstructorIdent ->+ Identifier ->+ (Maybe NontermIdent) -> (Maybe Type) -> T_Pattern -> ([String]) ->- (Map Int (Name,Name,Maybe Type)) ->+ (Map Int (Identifier,Identifier,Maybe Type)) -> Bool -> String ->- (Set (Name, Name)) ->+ (Set (Identifier, Identifier)) -> T_CRule-sem_CRule_CRule name_ isIn_ hasCode_ nt_ con_ field_ childnt_ tp_ (T_Pattern pattern_ ) rhs_ defines_ owrt_ origin_ uses_ =+sem_CRule_CRule name_ isIn_ hasCode_ nt_ con_ field_ childnt_ tp_ (T_Pattern pattern_) rhs_ defines_ owrt_ origin_ uses_ = (T_CRule (let _lhsOpp :: PP_Doc _patternIcopy :: Pattern _patternIpp :: PP_Doc@@ -402,7 +407,7 @@ ppNestInfo ["CRule","CRule"] [pp name_] [ppF "isIn" $ ppBool isIn_, ppF "hasCode" $ ppBool hasCode_, ppF "nt" $ pp nt_, ppF "con" $ pp con_, ppF "field" $ pp field_, ppF "childnt" $ ppMaybeShow childnt_, ppF "tp" $ ppMaybeShow tp_, ppF "pattern" $ if isIn_ then pp "<no pat because In>" else _patternIpp, ppF "rhs" $ ppStrings rhs_, ppF "defines" $ ppVertexMap defines_, ppF "owrt" $ ppBool owrt_, ppF "origin" $ pp origin_] [] ( _patternIcopy,_patternIpp) = (pattern_ )- in ( _lhsOpp)) )+ in ( _lhsOpp))) -- CSegment ---------------------------------------------------- {- visit 0:@@ -416,25 +421,25 @@ -- cata sem_CSegment :: CSegment -> T_CSegment-sem_CSegment (CSegment _inh _syn ) =- (sem_CSegment_CSegment _inh _syn )+sem_CSegment (CSegment _inh _syn) =+ (sem_CSegment_CSegment _inh _syn) -- semantic domain newtype T_CSegment = T_CSegment (( PP_Doc)) data Inh_CSegment = Inh_CSegment {} data Syn_CSegment = Syn_CSegment {pp_Syn_CSegment :: PP_Doc}-wrap_CSegment (T_CSegment sem ) (Inh_CSegment ) =+wrap_CSegment (T_CSegment sem) (Inh_CSegment ) = (let ( _lhsOpp) = (sem )- in (Syn_CSegment _lhsOpp ))+ in (Syn_CSegment _lhsOpp)) sem_CSegment_CSegment :: Attributes -> Attributes -> T_CSegment-sem_CSegment_CSegment inh_ syn_ =+sem_CSegment_CSegment inh_ syn_ = (T_CSegment (let _lhsOpp :: PP_Doc -- "CodeSyntaxDump.ag"(line 60, column 21) _lhsOpp = ppNestInfo ["CSegment","CSegment"] [] [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_] []- in ( _lhsOpp)) )+ in ( _lhsOpp))) -- CSegments --------------------------------------------------- {- visit 0:@@ -450,20 +455,20 @@ -- cata sem_CSegments :: CSegments -> T_CSegments-sem_CSegments list =- (Prelude.foldr sem_CSegments_Cons sem_CSegments_Nil (Prelude.map sem_CSegment list) )+sem_CSegments list =+ (Prelude.foldr sem_CSegments_Cons sem_CSegments_Nil (Prelude.map sem_CSegment list)) -- semantic domain newtype T_CSegments = T_CSegments (( PP_Doc,([PP_Doc]))) data Inh_CSegments = Inh_CSegments {} data Syn_CSegments = Syn_CSegments {pp_Syn_CSegments :: PP_Doc,ppL_Syn_CSegments :: [PP_Doc]}-wrap_CSegments (T_CSegments sem ) (Inh_CSegments ) =+wrap_CSegments (T_CSegments sem) (Inh_CSegments ) = (let ( _lhsOpp,_lhsOppL) = (sem )- in (Syn_CSegments _lhsOpp _lhsOppL ))+ in (Syn_CSegments _lhsOpp _lhsOppL)) sem_CSegments_Cons :: T_CSegment -> T_CSegments -> T_CSegments-sem_CSegments_Cons (T_CSegment hd_ ) (T_CSegments tl_ ) =+sem_CSegments_Cons (T_CSegment hd_) (T_CSegments tl_) = (T_CSegments (let _lhsOppL :: ([PP_Doc]) _lhsOpp :: PP_Doc _hdIpp :: PP_Doc@@ -479,7 +484,7 @@ (hd_ ) ( _tlIpp,_tlIppL) = (tl_ )- in ( _lhsOpp,_lhsOppL)) )+ in ( _lhsOpp,_lhsOppL))) sem_CSegments_Nil :: T_CSegments sem_CSegments_Nil = (T_CSegments (let _lhsOppL :: ([PP_Doc])@@ -490,7 +495,7 @@ -- use rule "CodeSyntaxDump.ag"(line 44, column 40) _lhsOpp = empty- in ( _lhsOpp,_lhsOppL)) )+ in ( _lhsOpp,_lhsOppL))) -- CVisit ------------------------------------------------------ {- visit 0:@@ -507,23 +512,23 @@ -- cata sem_CVisit :: CVisit -> T_CVisit-sem_CVisit (CVisit _inh _syn _vss _intra _ordered ) =- (sem_CVisit_CVisit _inh _syn (sem_Sequence _vss ) (sem_Sequence _intra ) _ordered )+sem_CVisit (CVisit _inh _syn _vss _intra _ordered) =+ (sem_CVisit_CVisit _inh _syn (sem_Sequence _vss) (sem_Sequence _intra) _ordered) -- semantic domain newtype T_CVisit = T_CVisit (( PP_Doc)) data Inh_CVisit = Inh_CVisit {} data Syn_CVisit = Syn_CVisit {pp_Syn_CVisit :: PP_Doc}-wrap_CVisit (T_CVisit sem ) (Inh_CVisit ) =+wrap_CVisit (T_CVisit sem) (Inh_CVisit ) = (let ( _lhsOpp) = (sem )- in (Syn_CVisit _lhsOpp ))+ in (Syn_CVisit _lhsOpp)) sem_CVisit_CVisit :: Attributes -> Attributes -> T_Sequence -> T_Sequence -> Bool -> T_CVisit-sem_CVisit_CVisit inh_ syn_ (T_Sequence vss_ ) (T_Sequence intra_ ) ordered_ =+sem_CVisit_CVisit inh_ syn_ (T_Sequence vss_) (T_Sequence intra_) ordered_ = (T_CVisit (let _lhsOpp :: PP_Doc _vssIppL :: ([PP_Doc]) _intraIppL :: ([PP_Doc])@@ -534,7 +539,7 @@ (vss_ ) ( _intraIppL) = (intra_ )- in ( _lhsOpp)) )+ in ( _lhsOpp))) -- CVisits ----------------------------------------------------- {- visit 0:@@ -550,20 +555,20 @@ -- cata sem_CVisits :: CVisits -> T_CVisits-sem_CVisits list =- (Prelude.foldr sem_CVisits_Cons sem_CVisits_Nil (Prelude.map sem_CVisit list) )+sem_CVisits list =+ (Prelude.foldr sem_CVisits_Cons sem_CVisits_Nil (Prelude.map sem_CVisit list)) -- semantic domain newtype T_CVisits = T_CVisits (( PP_Doc,([PP_Doc]))) data Inh_CVisits = Inh_CVisits {} data Syn_CVisits = Syn_CVisits {pp_Syn_CVisits :: PP_Doc,ppL_Syn_CVisits :: [PP_Doc]}-wrap_CVisits (T_CVisits sem ) (Inh_CVisits ) =+wrap_CVisits (T_CVisits sem) (Inh_CVisits ) = (let ( _lhsOpp,_lhsOppL) = (sem )- in (Syn_CVisits _lhsOpp _lhsOppL ))+ in (Syn_CVisits _lhsOpp _lhsOppL)) sem_CVisits_Cons :: T_CVisit -> T_CVisits -> T_CVisits-sem_CVisits_Cons (T_CVisit hd_ ) (T_CVisits tl_ ) =+sem_CVisits_Cons (T_CVisit hd_) (T_CVisits tl_) = (T_CVisits (let _lhsOppL :: ([PP_Doc]) _lhsOpp :: PP_Doc _hdIpp :: PP_Doc@@ -579,7 +584,7 @@ (hd_ ) ( _tlIpp,_tlIppL) = (tl_ )- in ( _lhsOpp,_lhsOppL)) )+ in ( _lhsOpp,_lhsOppL))) sem_CVisits_Nil :: T_CVisits sem_CVisits_Nil = (T_CVisits (let _lhsOppL :: ([PP_Doc])@@ -590,7 +595,7 @@ -- use rule "CodeSyntaxDump.ag"(line 44, column 40) _lhsOpp = empty- in ( _lhsOpp,_lhsOppL)) )+ in ( _lhsOpp,_lhsOppL))) -- Pattern ----------------------------------------------------- {- visit 0:@@ -599,17 +604,21 @@ pp : PP_Doc alternatives: alternative Alias:- child field : {Name}- child attr : {Name}+ child field : {Identifier}+ child attr : {Identifier} child pat : Pattern child parts : Patterns visit 0: local copy : _ alternative Constr:- child name : {Constructor}+ 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@@ -623,28 +632,30 @@ -- 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 (Product _pos _pats ) =- (sem_Pattern_Product _pos (sem_Patterns _pats ) )-sem_Pattern (Underscore _pos ) =- (sem_Pattern_Underscore _pos )+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,PP_Doc)) data Inh_Pattern = Inh_Pattern {} data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern,pp_Syn_Pattern :: PP_Doc}-wrap_Pattern (T_Pattern sem ) (Inh_Pattern ) =+wrap_Pattern (T_Pattern sem) (Inh_Pattern ) = (let ( _lhsOcopy,_lhsOpp) = (sem )- in (Syn_Pattern _lhsOcopy _lhsOpp ))-sem_Pattern_Alias :: Name ->- Name ->+ in (Syn_Pattern _lhsOcopy _lhsOpp))+sem_Pattern_Alias :: Identifier ->+ Identifier -> T_Pattern -> T_Patterns -> T_Pattern-sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) =+sem_Pattern_Alias field_ attr_ (T_Pattern pat_) (T_Patterns parts_) = (T_Pattern (let _lhsOpp :: PP_Doc _lhsOcopy :: Pattern _patIcopy :: Pattern@@ -665,11 +676,11 @@ (pat_ ) ( _partsIcopy,_partsIpp,_partsIppL) = (parts_ )- in ( _lhsOcopy,_lhsOpp)) )-sem_Pattern_Constr :: Constructor ->+ in ( _lhsOcopy,_lhsOpp)))+sem_Pattern_Constr :: ConstructorIdent -> T_Patterns -> T_Pattern-sem_Pattern_Constr name_ (T_Patterns pats_ ) =+sem_Pattern_Constr name_ (T_Patterns pats_) = (T_Pattern (let _lhsOpp :: PP_Doc _lhsOcopy :: Pattern _patsIcopy :: Patterns@@ -686,11 +697,30 @@ _copy ( _patsIcopy,_patsIpp,_patsIppL) = (pats_ )- in ( _lhsOcopy,_lhsOpp)) )+ in ( _lhsOcopy,_lhsOpp)))+sem_Pattern_Irrefutable :: T_Pattern ->+ T_Pattern+sem_Pattern_Irrefutable (T_Pattern pat_) =+ (T_Pattern (let _lhsOpp :: PP_Doc+ _lhsOcopy :: Pattern+ _patIcopy :: Pattern+ _patIpp :: PP_Doc+ -- use rule "CodeSyntaxDump.ag"(line 44, column 40)+ _lhsOpp =+ _patIpp+ -- self rule+ _copy =+ Irrefutable _patIcopy+ -- self rule+ _lhsOcopy =+ _copy+ ( _patIcopy,_patIpp) =+ (pat_ )+ in ( _lhsOcopy,_lhsOpp))) sem_Pattern_Product :: Pos -> T_Patterns -> T_Pattern-sem_Pattern_Product pos_ (T_Patterns pats_ ) =+sem_Pattern_Product pos_ (T_Patterns pats_) = (T_Pattern (let _lhsOpp :: PP_Doc _lhsOcopy :: Pattern _patsIcopy :: Patterns@@ -707,10 +737,10 @@ _copy ( _patsIcopy,_patsIpp,_patsIppL) = (pats_ )- in ( _lhsOcopy,_lhsOpp)) )+ in ( _lhsOcopy,_lhsOpp))) sem_Pattern_Underscore :: Pos -> T_Pattern-sem_Pattern_Underscore pos_ =+sem_Pattern_Underscore pos_ = (T_Pattern (let _lhsOpp :: PP_Doc _lhsOcopy :: Pattern -- "CodeSyntaxDump.ag"(line 76, column 25)@@ -722,7 +752,7 @@ -- self rule _lhsOcopy = _copy- in ( _lhsOcopy,_lhsOpp)) )+ in ( _lhsOcopy,_lhsOpp))) -- Patterns ---------------------------------------------------- {- visit 0:@@ -743,20 +773,20 @@ -- cata sem_Patterns :: Patterns -> T_Patterns-sem_Patterns list =- (Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) )+sem_Patterns list =+ (Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list)) -- semantic domain newtype T_Patterns = T_Patterns (( Patterns,PP_Doc,([PP_Doc]))) data Inh_Patterns = Inh_Patterns {} data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns,pp_Syn_Patterns :: PP_Doc,ppL_Syn_Patterns :: [PP_Doc]}-wrap_Patterns (T_Patterns sem ) (Inh_Patterns ) =+wrap_Patterns (T_Patterns sem) (Inh_Patterns ) = (let ( _lhsOcopy,_lhsOpp,_lhsOppL) = (sem )- in (Syn_Patterns _lhsOcopy _lhsOpp _lhsOppL ))+ in (Syn_Patterns _lhsOcopy _lhsOpp _lhsOppL)) sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns-sem_Patterns_Cons (T_Pattern hd_ ) (T_Patterns tl_ ) =+sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) = (T_Patterns (let _lhsOppL :: ([PP_Doc]) _lhsOpp :: PP_Doc _lhsOcopy :: Patterns@@ -781,7 +811,7 @@ (hd_ ) ( _tlIcopy,_tlIpp,_tlIppL) = (tl_ )- in ( _lhsOcopy,_lhsOpp,_lhsOppL)) )+ in ( _lhsOcopy,_lhsOpp,_lhsOppL))) sem_Patterns_Nil :: T_Patterns sem_Patterns_Nil = (T_Patterns (let _lhsOppL :: ([PP_Doc])@@ -799,7 +829,7 @@ -- self rule _lhsOcopy = _copy- in ( _lhsOcopy,_lhsOpp,_lhsOppL)) )+ in ( _lhsOcopy,_lhsOpp,_lhsOppL))) -- Sequence ---------------------------------------------------- {- visit 0:@@ -814,20 +844,20 @@ -- cata sem_Sequence :: Sequence -> T_Sequence-sem_Sequence list =- (Prelude.foldr sem_Sequence_Cons sem_Sequence_Nil (Prelude.map sem_CRule list) )+sem_Sequence list =+ (Prelude.foldr sem_Sequence_Cons sem_Sequence_Nil (Prelude.map sem_CRule list)) -- semantic domain newtype T_Sequence = T_Sequence (( ([PP_Doc]))) data Inh_Sequence = Inh_Sequence {} data Syn_Sequence = Syn_Sequence {ppL_Syn_Sequence :: [PP_Doc]}-wrap_Sequence (T_Sequence sem ) (Inh_Sequence ) =+wrap_Sequence (T_Sequence sem) (Inh_Sequence ) = (let ( _lhsOppL) = (sem )- in (Syn_Sequence _lhsOppL ))+ in (Syn_Sequence _lhsOppL)) sem_Sequence_Cons :: T_CRule -> T_Sequence -> T_Sequence-sem_Sequence_Cons (T_CRule hd_ ) (T_Sequence tl_ ) =+sem_Sequence_Cons (T_CRule hd_) (T_Sequence tl_) = (T_Sequence (let _lhsOppL :: ([PP_Doc]) _hdIpp :: PP_Doc _tlIppL :: ([PP_Doc])@@ -838,11 +868,11 @@ (hd_ ) ( _tlIppL) = (tl_ )- in ( _lhsOppL)) )+ in ( _lhsOppL))) sem_Sequence_Nil :: T_Sequence sem_Sequence_Nil = (T_Sequence (let _lhsOppL :: ([PP_Doc]) -- "CodeSyntaxDump.ag"(line 87, column 33) _lhsOppL = []- in ( _lhsOppL)) )+ in ( _lhsOppL)))
src-derived/ConcreteSyntax.hs view
@@ -1,4 +1,3 @@- -- UUAGC 0.9.5 (ConcreteSyntax.ag) module ConcreteSyntax where @@ -12,7 +11,7 @@ alternative AG: child elems : Elems -}-data AG = AG (Elems) +data AG = AG (Elems) -- Alt --------------------------------------------------------- {- alternatives:@@ -21,7 +20,7 @@ child names : ConstructorSet child fields : {Fields} -}-data Alt = Alt (Pos) (ConstructorSet) (Fields) +data Alt = Alt (Pos) (ConstructorSet) (Fields) -- Alts -------------------------------------------------------- {- alternatives:@@ -40,7 +39,7 @@ child chn : {AttrNames} child syn : {AttrNames} -}-data Attrs = Attrs (Pos) (AttrNames) (AttrNames) (AttrNames) +data Attrs = Attrs (Pos) (AttrNames) (AttrNames) (AttrNames) -- ConstructorSet ---------------------------------------------- {- alternatives:@@ -49,32 +48,35 @@ child set1 : ConstructorSet child set2 : ConstructorSet alternative CName:- child name : {Constructor}+ child name : {ConstructorIdent} alternative CUnion: child set1 : ConstructorSet child set2 : ConstructorSet -} data ConstructorSet = CAll - | CDifference (ConstructorSet) (ConstructorSet) - | CName (Constructor) - | CUnion (ConstructorSet) (ConstructorSet) + | CDifference (ConstructorSet) (ConstructorSet)+ | CName (ConstructorIdent)+ | CUnion (ConstructorSet) (ConstructorSet) -- Elem -------------------------------------------------------- {- alternatives: alternative Attr: child pos : {Pos}+ child ctx : {ClassContext} child names : NontSet child attrs : Attrs alternative Data: child pos : {Pos}+ child ctx : {ClassContext} child names : NontSet+ child params : {[Identifier]} child attrs : Attrs child alts : Alts child ext : {Bool} alternative Deriving: child pos : {Pos} child set : NontSet- child classes : {[Name]}+ child classes : {[NontermIdent]} alternative Module: child pos : {Pos} child name : {String}@@ -82,38 +84,41 @@ child imports : {String} alternative Pragma: child pos : {Pos}- child names : {[Name]}+ child names : {[NontermIdent]} alternative Sem: child pos : {Pos}+ child ctx : {ClassContext} child names : NontSet child attrs : Attrs child alts : SemAlts alternative Set: child pos : {Pos}- child name : {Name}+ child name : {NontermIdent} child set : NontSet alternative Txt: child pos : {Pos}- child name : {Name}+ child name : {NontermIdent} child lines : {[String]} alternative Type: child pos : {Pos}- child name : {Nonterminal}+ child ctx : {ClassContext}+ child name : {NontermIdent}+ child params : {[Identifier]} child type : {ComplexType} alternative Wrapper: child pos : {Pos} child set : NontSet -}-data Elem = Attr (Pos) (NontSet) (Attrs) - | Data (Pos) (NontSet) (Attrs) (Alts) (Bool) - | Deriving (Pos) (NontSet) ([Name]) - | Module (Pos) (String) (String) (String) - | Pragma (Pos) ([Name]) - | Sem (Pos) (NontSet) (Attrs) (SemAlts) - | Set (Pos) (Name) (NontSet) - | Txt (Pos) (Name) ([String]) - | Type (Pos) (Nonterminal) (ComplexType) - | Wrapper (Pos) (NontSet) +data Elem = Attr (Pos) (ClassContext) (NontSet) (Attrs)+ | Data (Pos) (ClassContext) (NontSet) ([Identifier]) (Attrs) (Alts) (Bool)+ | Deriving (Pos) (NontSet) ([NontermIdent])+ | Module (Pos) (String) (String) (String)+ | Pragma (Pos) ([NontermIdent])+ | Sem (Pos) (ClassContext) (NontSet) (Attrs) (SemAlts)+ | Set (Pos) (NontermIdent) (NontSet)+ | Txt (Pos) (NontermIdent) ([String])+ | Type (Pos) (ClassContext) (NontermIdent) ([Identifier]) (ComplexType)+ | Wrapper (Pos) (NontSet) -- Elems ------------------------------------------------------- {- alternatives:@@ -134,20 +139,20 @@ child set1 : NontSet child set2 : NontSet alternative NamedSet:- child name : {Nonterminal}+ child name : {NontermIdent} alternative Path:- child from : {Nonterminal}- child to : {Nonterminal}+ child from : {NontermIdent}+ child to : {NontermIdent} alternative Union: child set1 : NontSet child set2 : NontSet -} data NontSet = All - | Difference (NontSet) (NontSet) - | Intersect (NontSet) (NontSet) - | NamedSet (Nonterminal) - | Path (Nonterminal) (Nonterminal) - | Union (NontSet) (NontSet) + | Difference (NontSet) (NontSet)+ | Intersect (NontSet) (NontSet)+ | NamedSet (NontermIdent)+ | Path (NontermIdent) (NontermIdent)+ | Union (NontSet) (NontSet) -- SemAlt ------------------------------------------------------ {- alternatives:@@ -156,7 +161,7 @@ child constructorSet : ConstructorSet child rules : SemDefs -}-data SemAlt = SemAlt (Pos) (ConstructorSet) (SemDefs) +data SemAlt = SemAlt (Pos) (ConstructorSet) (SemDefs) -- SemAlts ----------------------------------------------------- {- alternatives:@@ -170,22 +175,22 @@ {- alternatives: alternative AttrOrderBefore:- child before : {(Identifier,Identifier)}- child after : {(Identifier,Identifier)}+ child before : {[(Identifier,Identifier)]}+ child after : {[(Identifier,Identifier)]} alternative Def: child pattern : {Pattern} child rhs : {Expression} child owrt : {Bool} alternative SemPragma:- child names : {[Name]}+ child names : {[NontermIdent]} alternative TypeDef: child ident : {Identifier} child tp : {Type} -}-data SemDef = AttrOrderBefore ((Identifier,Identifier)) ((Identifier,Identifier)) - | Def (Pattern) (Expression) (Bool) - | SemPragma ([Name]) - | TypeDef (Identifier) (Type) +data SemDef = AttrOrderBefore ([(Identifier,Identifier)]) ([(Identifier,Identifier)])+ | Def (Pattern) (Expression) (Bool)+ | SemPragma ([NontermIdent])+ | TypeDef (Identifier) (Type) -- SemDefs ----------------------------------------------------- {- alternatives:
src-derived/DeclBlocks.hs view
@@ -9,7 +9,7 @@ alternative DeclBlock: child defs : {[Decl]} child visit : {Decl}- child next : DeclBlocks+ child next : DeclBlocks alternative DeclTerminator: child defs : {[Decl]} child result : {Expr}@@ -20,6 +20,6 @@ {- alternatives: alternative DeclBlocksRoot:- child blocks : DeclBlocks+ child blocks : DeclBlocks -} data DeclBlocksRoot = DeclBlocksRoot (DeclBlocks)
src-derived/DefaultRules.hs view
@@ -1,2034 +1,2115 @@---- UUAGC 0.9.5 (DefaultRules.ag)-module DefaultRules where--import qualified List (delete,intersperse)--import qualified Data.Set as Set-import qualified Data.Map as Map-import Data.Map(Map)-import qualified UU.DData.Seq as Seq-import UU.DData.Seq(Seq,(<>))-import UU.Scanner.Position(noPos)-import Pretty-import Maybe--import AbstractSyntax-import ErrorMessages--import Options(Options,modcopy,rename)---- AbstractSyntax.ag imports-import Data.Set(Set)-import Data.Map(Map)-import Patterns (Pattern(..),Patterns)-import Expression (Expression(..))-import CommonTypes---- Patterns.ag imports-import UU.Scanner.Position(Pos)-import CommonTypes (Constructor,Name)--fieldName n = '@' : getName n- -locName n = '@' : getName n--attrName fld attr- | fld == _LOC = '@' : getName attr - | otherwise = '@' : getName fld ++ "." ++ getName attr--_ACHILD = Ident "(" noPos -- hack- - -getConName typeSyns rename nt con1 - | nt `elem` map fst typeSyns = synonym- | otherwise = normalName- where con = getName con1- normalName | rename = getName nt++"_"++ con- | otherwise = con- synonym | con == "Cons" = "(:)"- | con == "Nil" = "[]"- | con == "Just" = "Just"- | con == "Nothing" = "Nothing"- | otherwise = normalName----concatSeq = foldr Seq.append Seq.empty--splitAttrs :: Map Name a -> [Name] -> ([(Name,a)],[Name]) -- a used as (String,String)-splitAttrs _ [] - = ([],[])-splitAttrs useMap (n:rest) - = let (uses,normals) = splitAttrs useMap rest- in case Map.lookup n useMap of- Just x -> ((n,x):uses , normals ) - Nothing -> ( uses , n:normals )--removeDefined :: Set (Name,Name) -> (Name,Attributes) -> (Name,[Name])-removeDefined defined (fld,as) - = ( fld- , [ a - | a <- Map.keys as- , not (Set.member (fld,a) defined) - ]- )--- - - -deprecatedCopyRuleError nt con fld a- = let mesg = - "In the definitions for alternative" - >#< getName con - >#< "of nonterminal" - >#< getName nt - >|< "," - >-< "the value of field" - >#< getName a - >#< "is copied by a copy-rule." - >-< "Copying the value of a field using a copy-rule is deprecated"- >-< "Please add the following lines to your code:"- >-< ( "SEM" - >#< getName nt- >-< indent 2 ( "|" - >#< getName con - >#< getName fld - >#< "." - >#< a - >#< "=" - >#< "@" - >|< a- )- ) - in CustomError True (getPos a) mesg- - -missingRuleErrorExpr nt con fld a- = "error \"missing rule: " - ++ show nt ++ "." ++ show con ++ "." - ++ show fld ++ "." ++ show a ++ "\""- - - -makeRule :: (Name,Name) -> Expression -> String -> Rule-makeRule (f1,a1) expr origin - = Rule (Alias f1 a1 (Underscore noPos) []) - expr - False - origin---useRule :: Set Name -> [(Name,Attributes)] -> (Name,(String,String,String)) -> Rule-useRule locals ch_outs (n,(op,e,pos)) - = let elems = [ fld - | (fld,as) <- ch_outs- , Map.member n as- ]- - expr | Set.member n locals = attrName _LOC n- | null elems = e- | otherwise = foldr1 (\x y -> x ++ " " ++ op ++ " " ++ y) - (map (flip attrName n) elems)- - in makeRule (_LHS,n) - (Expression noPos expr) - ("use rule " ++ pos)-----selfRule lhsNecLoc attr x - = let expr | lhsNecLoc = locName attr- | otherwise = x- - in makeRule (if lhsNecLoc then _LHS else _LOC,attr)- (Expression noPos expr)- "self rule"- ----concatRE rsess = let (rss,ess) = unzip rsess- in (concat rss, concatSeq ess)---copyRule :: Name -> Name -> Bool -> Set Name -> (Map Name Name, (Name,[Name])) -> ([Rule], Seq Error)-copyRule nt con modcopy locals (env,(fld,as)) - = concatRE (map copyRu as)- - where - copyRu a- = ( [ makeRule (fld,a) - (Expression noPos expr)- (cruletxt sel)- ]- , err- )- - where - sel - | not modcopy - && Set.member a locals = Just _LOC- | otherwise = Map.lookup a env-- (expr,err) - = case sel of- Nothing -> ( missingRuleErrorExpr nt con fld a- , Seq.single (MissingRule nt con fld a)- )- Just f - | f == _ACHILD -> ( fieldName a- , Seq.single (deprecatedCopyRuleError nt con fld a)- )- | otherwise -> ( attrName f a- , Seq.empty- )- - cruletxt sel - | local = "copy rule (from local)"- | deprChild = "deprecated child copy"- | Set.member a locals && nonlocal = "modified copy rule"- | incoming && outgoing = "copy rule (chain)"- | incoming = "copy rule (down)"- | outgoing = "copy rule (up)"- | otherwise = "copy rule (chain)"- where outgoing = fld == _LHS- incoming = maybe False (== _LHS) sel- nonlocal = maybe False (/= _LOC) sel- local = maybe False (== _LOC) sel- deprChild = maybe False (== _ACHILD) sel--{- -multiRule replaces- loc.(a,b) = e-by - loc.tup1 = e- loc.(a,_) = @loc.tup1- loc.(_,b) = @loc.tup1-It needs to thread a unique number for inventing names for the tuples.--It also works for nested tuples:- loc.(a,(b,c)) = e-becomes- loc.tup1 = e- loc.(a,_) = @loc.tup1- loc.(_,tup2) = @loc.tup1- loc.(b,_) = @loc.tup2- loc.(_,c) = @loc.tup2--}--multiRule :: Rule -> Int -> ([Rule], Int) -multiRule (Rule pat expr owrt origin) uniq- = let f :: (Pattern->Pattern) -> Expression -> Pattern -> Int -> (Pattern, ([Rule], Int))- f w e (Product pos pats) n - = let freshName = Ident ("_tup" ++ show n) pos - freshExpr = Expression pos (attrName _LOC freshName)- freshPat = Alias _LOC freshName (Underscore pos) pats- a = length pats - 1- us b p = Product pos (replicate (a-b) (Underscore pos) ++ [p] ++ replicate b (Underscore pos))- g :: Pattern -> ([Pattern],[Rule],Int) -> ([Pattern],[Rule],Int)- g p (xs1,rs1,n1) = let (x2,(rs2,n2)) = f (us (length xs1)) freshExpr p n1- in (x2:xs1, rs2++rs1, n2)- (xs9,rs9,n9) = foldr g ([], [], n+1) pats- in ( freshPat- , ( Rule (w freshPat) e owrt origin : rs9- , n9- )- )- f w e p n - = ( p- , ( [Rule (w p) e owrt origin]- , n- )- )- in snd (f id expr pat uniq)---isDefined :: Map Name Attributes -> Identifier -> Identifier -> Bool-isDefined mp fld nm- = Map.member nm $ Map.findWithDefault Map.empty fld mp---- check that for a dependency a < b, that a is an In attribute-isInAttribute :: [(Name,Attributes)] -> Identifier -> Identifier -> Bool-isInAttribute allSyns fld nm- | fld == _INST || fld == _LOC || fld == _LHS- = True- | otherwise -- is nm it a synthesized attribute of fld?- = maybe False (Map.member nm) (lookup fld allSyns)--- Alternative --------------------------------------------------{-- visit 0:- inherited attributes:- cr : Bool- inh : Attributes- manualAttrOrderMap : AttrOrderMap- nonterminals : Set Nonterminal- nt : Nonterminal- o_rename : Bool- syn : Attributes- typeSyns : TypeSyns- useMap : Map Name (String,String,String)- chained attribute:- uniq : Int- synthesized attributes:- errors : Seq Error- output : SELF- alternatives:- alternative Alternative:- child con : {Constructor}- child children : Children- child rules : Rules- child typeSigs : TypeSigs- visit 0:- local _tup1 : _- local newRls : _- local errs : _- local orderDeps : _- local allAttrsInScope : _- local invalidOrderDepsErrors : _- local undefinedAttributeInDepsErrors : _- local orderErrs : _- local output : _--}--- cata-sem_Alternative :: Alternative ->- T_Alternative-sem_Alternative (Alternative _con _children _rules _typeSigs ) =- (sem_Alternative_Alternative _con (sem_Children _children ) (sem_Rules _rules ) (sem_TypeSigs _typeSigs ) )--- semantic domain-newtype T_Alternative = T_Alternative (Bool ->- Attributes ->- AttrOrderMap ->- (Set Nonterminal) ->- Nonterminal ->- Bool ->- Attributes ->- TypeSyns ->- Int ->- (Map Name (String,String,String)) ->- ( (Seq Error),Alternative,Int))-data Inh_Alternative = Inh_Alternative {cr_Inh_Alternative :: Bool,inh_Inh_Alternative :: Attributes,manualAttrOrderMap_Inh_Alternative :: AttrOrderMap,nonterminals_Inh_Alternative :: Set Nonterminal,nt_Inh_Alternative :: Nonterminal,o_rename_Inh_Alternative :: Bool,syn_Inh_Alternative :: Attributes,typeSyns_Inh_Alternative :: TypeSyns,uniq_Inh_Alternative :: Int,useMap_Inh_Alternative :: Map Name (String,String,String)}-data Syn_Alternative = Syn_Alternative {errors_Syn_Alternative :: Seq Error,output_Syn_Alternative :: Alternative,uniq_Syn_Alternative :: Int}-wrap_Alternative (T_Alternative sem ) (Inh_Alternative _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap ) =- (let ( _lhsOerrors,_lhsOoutput,_lhsOuniq) =- (sem _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap )- in (Syn_Alternative _lhsOerrors _lhsOoutput _lhsOuniq ))-sem_Alternative_Alternative :: Constructor ->- T_Children ->- T_Rules ->- T_TypeSigs ->- T_Alternative-sem_Alternative_Alternative con_ (T_Children children_ ) (T_Rules rules_ ) (T_TypeSigs typeSigs_ ) =- (T_Alternative (\ _lhsIcr- _lhsIinh- _lhsImanualAttrOrderMap- _lhsInonterminals- _lhsInt- _lhsIo_rename- _lhsIsyn- _lhsItypeSyns- _lhsIuniq- _lhsIuseMap ->- (let _rulesOcon :: Constructor- _childrenOcon :: Constructor- _lhsOerrors :: (Seq Error)- _lhsOoutput :: Alternative- _lhsOuniq :: Int- _childrenOcr :: Bool- _childrenOnt :: Nonterminal- _rulesOnt :: Nonterminal- _rulesOuniq :: Int- _childrenIerrors :: (Seq Error)- _childrenIfields :: ([(Name,Type,Bool)])- _childrenIinputs :: ([(Name, Attributes)])- _childrenIoutput :: Children- _childrenIoutputs :: ([(Name, Attributes)])- _rulesIdefinedAttrs :: (Set (Name,Name))- _rulesIerrors :: (Seq Error)- _rulesIlocals :: (Set Name)- _rulesIoutput :: Rules- _rulesIuniq :: Int- _typeSigsIoutput :: TypeSigs- -- "DefaultRules.ag"(line 135, column 17)- _rulesOcon =- con_- -- "DefaultRules.ag"(line 136, column 17)- _childrenOcon =- con_- -- "DefaultRules.ag"(line 295, column 4)- _lhsOerrors =- _childrenIerrors <> _errs <> _rulesIerrors <> _orderErrs- -- "DefaultRules.ag"(line 297, column 8)- __tup1 =- let locals = _rulesIlocals- initenv = Map.fromList ( [ (a,_ACHILD)- | (a,_,_) <- _childrenIfields- ]- ++ attrs(_LHS, _lhsIinh)- ++ [ (a,_LOC)- | a <- Set.toList locals- ]- )- attrs (n,as) = [ (a,n) | a <- Map.keys as ]- envs = scanl (flip Map.union)- initenv- (map (Map.fromList . attrs ) _childrenIoutputs)- child_envs = init envs- lhs_env = last envs- (selfAttrs, normalAttrs)- = Map.partition (==NT _SELF) _lhsIsyn- (_,undefAttrs)- = removeDefined _rulesIdefinedAttrs (_LHS, normalAttrs)- (useAttrs,others)- = splitAttrs _lhsIuseMap undefAttrs- (rules1, errors1)- = concatRE $ map (copyRule _lhsInt con_ _lhsIcr locals)- (zip envs (map (removeDefined _rulesIdefinedAttrs) _childrenIinputs))- uRules- = map (useRule locals _childrenIoutputs) useAttrs- selfLocRules- = [ selfRule False attr (constructor [childSelf attr nm tp | (nm,tp,ho) <- _childrenIfields, not ho])- | attr <- Map.keys selfAttrs- , not (Set.member attr locals)- ]- where- childSelf self nm tp- = case tp of NT nt -> attrName nm self- _ | nm `Set.member` locals -> locname nm- | otherwise -> fieldName nm- constructor fs- | getName con_ == "Tuple" && _lhsInt `elem` map fst _lhsItypeSyns- = "(" ++ concat (List.intersperse "," fs) ++ ")"- | otherwise- = getConName _lhsItypeSyns _lhsIo_rename _lhsInt con_ ++ " " ++ unwords fs- selfRules- = [ selfRule True attr undefined- | attr <- Map.keys selfAttrs- , not (Set.member (_LHS,attr) _rulesIdefinedAttrs)- ]- (rules5, errs5)- = copyRule _lhsInt- con_- _lhsIcr- locals- (lhs_env, (_LHS, others))- in (uRules++selfLocRules++selfRules++rules5++rules1, errors1<>errs5)- -- "DefaultRules.ag"(line 297, column 8)- (_newRls,_) =- __tup1- -- "DefaultRules.ag"(line 297, column 8)- (_,_errs) =- __tup1- -- "DefaultRules.ag"(line 413, column 17)- _lhsOoutput =- Alternative con_ _childrenIoutput (_rulesIoutput ++ _newRls) _typeSigsIoutput- -- "DefaultRules.ag"(line 484, column 7)- _orderDeps =- Set.toList $ Map.findWithDefault Set.empty con_ $ Map.findWithDefault Map.empty _lhsInt _lhsImanualAttrOrderMap- -- "DefaultRules.ag"(line 486, column 7)- _allAttrsInScope =- Map.fromList ( [ (_LHS, _lhsIsyn `Map.union` _lhsIinh)- , (_LOC, Map.fromList [ (l,Haskell "LOC") | l <- Set.toList _rulesIlocals]) ]- ++ _childrenIinputs- ++ _childrenIoutputs- )- -- "DefaultRules.ag"(line 493, column 7)- _invalidOrderDepsErrors =- [ ErroneousOrder _lhsInt con_ dep- | dep@(Dependency (fld,nm) _) <- _orderDeps- , not $ isInAttribute _childrenIoutputs fld nm- ]- -- "DefaultRules.ag"(line 499, column 7)- _undefinedAttributeInDepsErrors =- [ UndefAttr _lhsInt con_ fld nm- | (fld,nm) <- concatMap (\(Dependency a b) -> [a,b]) $ _orderDeps- , not $ isDefined _allAttrsInScope fld nm- ]- -- "DefaultRules.ag"(line 505, column 7)- _orderErrs =- if null _undefinedAttributeInDepsErrors- then Seq.fromList _invalidOrderDepsErrors- else Seq.fromList _undefinedAttributeInDepsErrors- -- self rule- _output =- Alternative con_ _childrenIoutput _rulesIoutput _typeSigsIoutput- -- copy rule (up)- _lhsOuniq =- _rulesIuniq- -- copy rule (down)- _childrenOcr =- _lhsIcr- -- copy rule (down)- _childrenOnt =- _lhsInt- -- copy rule (down)- _rulesOnt =- _lhsInt- -- copy rule (down)- _rulesOuniq =- _lhsIuniq- ( _childrenIerrors,_childrenIfields,_childrenIinputs,_childrenIoutput,_childrenIoutputs) =- (children_ _childrenOcon _childrenOcr _childrenOnt )- ( _rulesIdefinedAttrs,_rulesIerrors,_rulesIlocals,_rulesIoutput,_rulesIuniq) =- (rules_ _rulesOcon _rulesOnt _rulesOuniq )- ( _typeSigsIoutput) =- (typeSigs_ )- in ( _lhsOerrors,_lhsOoutput,_lhsOuniq))) )--- Alternatives -------------------------------------------------{-- visit 0:- inherited attributes:- cr : Bool- inh : Attributes- manualAttrOrderMap : AttrOrderMap- nonterminals : Set Nonterminal- nt : Nonterminal- o_rename : Bool- syn : Attributes- typeSyns : TypeSyns- useMap : Map Name (String,String,String)- chained attribute:- uniq : Int- synthesized attributes:- errors : Seq Error- output : SELF- alternatives:- alternative Cons:- child hd : Alternative- child tl : Alternatives- visit 0:- local output : _- alternative Nil:- visit 0:- local output : _--}--- cata-sem_Alternatives :: Alternatives ->- T_Alternatives-sem_Alternatives list =- (Prelude.foldr sem_Alternatives_Cons sem_Alternatives_Nil (Prelude.map sem_Alternative list) )--- semantic domain-newtype T_Alternatives = T_Alternatives (Bool ->- Attributes ->- AttrOrderMap ->- (Set Nonterminal) ->- Nonterminal ->- Bool ->- Attributes ->- TypeSyns ->- Int ->- (Map Name (String,String,String)) ->- ( (Seq Error),Alternatives,Int))-data Inh_Alternatives = Inh_Alternatives {cr_Inh_Alternatives :: Bool,inh_Inh_Alternatives :: Attributes,manualAttrOrderMap_Inh_Alternatives :: AttrOrderMap,nonterminals_Inh_Alternatives :: Set Nonterminal,nt_Inh_Alternatives :: Nonterminal,o_rename_Inh_Alternatives :: Bool,syn_Inh_Alternatives :: Attributes,typeSyns_Inh_Alternatives :: TypeSyns,uniq_Inh_Alternatives :: Int,useMap_Inh_Alternatives :: Map Name (String,String,String)}-data Syn_Alternatives = Syn_Alternatives {errors_Syn_Alternatives :: Seq Error,output_Syn_Alternatives :: Alternatives,uniq_Syn_Alternatives :: Int}-wrap_Alternatives (T_Alternatives sem ) (Inh_Alternatives _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap ) =- (let ( _lhsOerrors,_lhsOoutput,_lhsOuniq) =- (sem _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap )- in (Syn_Alternatives _lhsOerrors _lhsOoutput _lhsOuniq ))-sem_Alternatives_Cons :: T_Alternative ->- T_Alternatives ->- T_Alternatives-sem_Alternatives_Cons (T_Alternative hd_ ) (T_Alternatives tl_ ) =- (T_Alternatives (\ _lhsIcr- _lhsIinh- _lhsImanualAttrOrderMap- _lhsInonterminals- _lhsInt- _lhsIo_rename- _lhsIsyn- _lhsItypeSyns- _lhsIuniq- _lhsIuseMap ->- (let _lhsOerrors :: (Seq Error)- _lhsOoutput :: Alternatives- _lhsOuniq :: Int- _hdOcr :: Bool- _hdOinh :: Attributes- _hdOmanualAttrOrderMap :: AttrOrderMap- _hdOnonterminals :: (Set Nonterminal)- _hdOnt :: Nonterminal- _hdOo_rename :: Bool- _hdOsyn :: Attributes- _hdOtypeSyns :: TypeSyns- _hdOuniq :: Int- _hdOuseMap :: (Map Name (String,String,String))- _tlOcr :: Bool- _tlOinh :: Attributes- _tlOmanualAttrOrderMap :: AttrOrderMap- _tlOnonterminals :: (Set Nonterminal)- _tlOnt :: Nonterminal- _tlOo_rename :: Bool- _tlOsyn :: Attributes- _tlOtypeSyns :: TypeSyns- _tlOuniq :: Int- _tlOuseMap :: (Map Name (String,String,String))- _hdIerrors :: (Seq Error)- _hdIoutput :: Alternative- _hdIuniq :: Int- _tlIerrors :: (Seq Error)- _tlIoutput :: Alternatives- _tlIuniq :: Int- -- use rule "DefaultRules.ag"(line 107, column 19)- _lhsOerrors =- _hdIerrors Seq.<> _tlIerrors- -- self rule- _output =- (:) _hdIoutput _tlIoutput- -- self rule- _lhsOoutput =- _output- -- copy rule (up)- _lhsOuniq =- _tlIuniq- -- copy rule (down)- _hdOcr =- _lhsIcr- -- copy rule (down)- _hdOinh =- _lhsIinh- -- copy rule (down)- _hdOmanualAttrOrderMap =- _lhsImanualAttrOrderMap- -- copy rule (down)- _hdOnonterminals =- _lhsInonterminals- -- copy rule (down)- _hdOnt =- _lhsInt- -- copy rule (down)- _hdOo_rename =- _lhsIo_rename- -- copy rule (down)- _hdOsyn =- _lhsIsyn- -- copy rule (down)- _hdOtypeSyns =- _lhsItypeSyns- -- copy rule (down)- _hdOuniq =- _lhsIuniq- -- copy rule (down)- _hdOuseMap =- _lhsIuseMap- -- copy rule (down)- _tlOcr =- _lhsIcr- -- copy rule (down)- _tlOinh =- _lhsIinh- -- copy rule (down)- _tlOmanualAttrOrderMap =- _lhsImanualAttrOrderMap- -- copy rule (down)- _tlOnonterminals =- _lhsInonterminals- -- copy rule (down)- _tlOnt =- _lhsInt- -- copy rule (down)- _tlOo_rename =- _lhsIo_rename- -- copy rule (down)- _tlOsyn =- _lhsIsyn- -- copy rule (down)- _tlOtypeSyns =- _lhsItypeSyns- -- copy rule (chain)- _tlOuniq =- _hdIuniq- -- copy rule (down)- _tlOuseMap =- _lhsIuseMap- ( _hdIerrors,_hdIoutput,_hdIuniq) =- (hd_ _hdOcr _hdOinh _hdOmanualAttrOrderMap _hdOnonterminals _hdOnt _hdOo_rename _hdOsyn _hdOtypeSyns _hdOuniq _hdOuseMap )- ( _tlIerrors,_tlIoutput,_tlIuniq) =- (tl_ _tlOcr _tlOinh _tlOmanualAttrOrderMap _tlOnonterminals _tlOnt _tlOo_rename _tlOsyn _tlOtypeSyns _tlOuniq _tlOuseMap )- in ( _lhsOerrors,_lhsOoutput,_lhsOuniq))) )-sem_Alternatives_Nil :: T_Alternatives-sem_Alternatives_Nil =- (T_Alternatives (\ _lhsIcr- _lhsIinh- _lhsImanualAttrOrderMap- _lhsInonterminals- _lhsInt- _lhsIo_rename- _lhsIsyn- _lhsItypeSyns- _lhsIuniq- _lhsIuseMap ->- (let _lhsOerrors :: (Seq Error)- _lhsOoutput :: Alternatives- _lhsOuniq :: Int- -- use rule "DefaultRules.ag"(line 107, column 19)- _lhsOerrors =- Seq.empty- -- self rule- _output =- []- -- self rule- _lhsOoutput =- _output- -- copy rule (chain)- _lhsOuniq =- _lhsIuniq- in ( _lhsOerrors,_lhsOoutput,_lhsOuniq))) )--- Child --------------------------------------------------------{-- visit 0:- inherited attributes:- con : Constructor- cr : Bool- nt : Nonterminal- synthesized attributes:- errors : Seq Error- field : (Name,Type,Bool) - inherited : Attributes- name : Name- output : SELF- synthesized : Attributes- alternatives:- alternative Child:- child name : {Name}- child tp : {Type}- child inh : {Attributes}- child syn : {Attributes}- child higherOrder : {Bool}- visit 0:- local output : _--}--- cata-sem_Child :: Child ->- T_Child-sem_Child (Child _name _tp _inh _syn _higherOrder ) =- (sem_Child_Child _name _tp _inh _syn _higherOrder )--- semantic domain-newtype T_Child = T_Child (Constructor ->- Bool ->- Nonterminal ->- ( (Seq Error),( (Name,Type,Bool) ),Attributes,Name,Child,Attributes))-data Inh_Child = Inh_Child {con_Inh_Child :: Constructor,cr_Inh_Child :: Bool,nt_Inh_Child :: Nonterminal}-data Syn_Child = Syn_Child {errors_Syn_Child :: Seq Error,field_Syn_Child :: (Name,Type,Bool) ,inherited_Syn_Child :: Attributes,name_Syn_Child :: Name,output_Syn_Child :: Child,synthesized_Syn_Child :: Attributes}-wrap_Child (T_Child sem ) (Inh_Child _lhsIcon _lhsIcr _lhsInt ) =- (let ( _lhsOerrors,_lhsOfield,_lhsOinherited,_lhsOname,_lhsOoutput,_lhsOsynthesized) =- (sem _lhsIcon _lhsIcr _lhsInt )- in (Syn_Child _lhsOerrors _lhsOfield _lhsOinherited _lhsOname _lhsOoutput _lhsOsynthesized ))-sem_Child_Child :: Name ->- Type ->- Attributes ->- Attributes ->- Bool ->- T_Child-sem_Child_Child name_ tp_ inh_ syn_ higherOrder_ =- (T_Child (\ _lhsIcon- _lhsIcr- _lhsInt ->- (let _lhsOname :: Name- _lhsOinherited :: Attributes- _lhsOsynthesized :: Attributes- _lhsOfield :: ( (Name,Type,Bool) )- _lhsOerrors :: (Seq Error)- _lhsOoutput :: Child- -- "DefaultRules.ag"(line 138, column 11)- _lhsOname =- name_- -- "DefaultRules.ag"(line 147, column 11)- _lhsOinherited =- inh_- -- "DefaultRules.ag"(line 148, column 11)- _lhsOsynthesized =- syn_- -- "DefaultRules.ag"(line 386, column 11)- _lhsOfield =- (name_,tp_,higherOrder_)- -- use rule "DefaultRules.ag"(line 107, column 19)- _lhsOerrors =- Seq.empty- -- self rule- _output =- Child name_ tp_ inh_ syn_ higherOrder_- -- self rule- _lhsOoutput =- _output- in ( _lhsOerrors,_lhsOfield,_lhsOinherited,_lhsOname,_lhsOoutput,_lhsOsynthesized))) )--- Children -----------------------------------------------------{-- visit 0:- inherited attributes:- con : Constructor- cr : Bool- nt : Nonterminal- synthesized attributes:- errors : Seq Error- fields : [(Name,Type,Bool)]- inputs : [(Name, Attributes)]- output : SELF- outputs : [(Name, Attributes)]- alternatives:- alternative Cons:- child hd : Child- child tl : Children- visit 0:- local output : _- alternative Nil:- visit 0:- local output : _--}--- 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 (Constructor ->- Bool ->- Nonterminal ->- ( (Seq Error),([(Name,Type,Bool)]),([(Name, Attributes)]),Children,([(Name, Attributes)])))-data Inh_Children = Inh_Children {con_Inh_Children :: Constructor,cr_Inh_Children :: Bool,nt_Inh_Children :: Nonterminal}-data Syn_Children = Syn_Children {errors_Syn_Children :: Seq Error,fields_Syn_Children :: [(Name,Type,Bool)],inputs_Syn_Children :: [(Name, Attributes)],output_Syn_Children :: Children,outputs_Syn_Children :: [(Name, Attributes)]}-wrap_Children (T_Children sem ) (Inh_Children _lhsIcon _lhsIcr _lhsInt ) =- (let ( _lhsOerrors,_lhsOfields,_lhsOinputs,_lhsOoutput,_lhsOoutputs) =- (sem _lhsIcon _lhsIcr _lhsInt )- in (Syn_Children _lhsOerrors _lhsOfields _lhsOinputs _lhsOoutput _lhsOoutputs ))-sem_Children_Cons :: T_Child ->- T_Children ->- T_Children-sem_Children_Cons (T_Child hd_ ) (T_Children tl_ ) =- (T_Children (\ _lhsIcon- _lhsIcr- _lhsInt ->- (let _lhsOinputs :: ([(Name, Attributes)])- _lhsOoutputs :: ([(Name, Attributes)])- _lhsOfields :: ([(Name,Type,Bool)])- _lhsOerrors :: (Seq Error)- _lhsOoutput :: Children- _hdOcon :: Constructor- _hdOcr :: Bool- _hdOnt :: Nonterminal- _tlOcon :: Constructor- _tlOcr :: Bool- _tlOnt :: Nonterminal- _hdIerrors :: (Seq Error)- _hdIfield :: ( (Name,Type,Bool) )- _hdIinherited :: Attributes- _hdIname :: Name- _hdIoutput :: Child- _hdIsynthesized :: Attributes- _tlIerrors :: (Seq Error)- _tlIfields :: ([(Name,Type,Bool)])- _tlIinputs :: ([(Name, Attributes)])- _tlIoutput :: Children- _tlIoutputs :: ([(Name, Attributes)])- -- "DefaultRules.ag"(line 151, column 10)- _lhsOinputs =- (_hdIname, _hdIinherited) : _tlIinputs- -- "DefaultRules.ag"(line 151, column 10)- _lhsOoutputs =- (_hdIname, _hdIsynthesized) : _tlIoutputs- -- "DefaultRules.ag"(line 382, column 10)- _lhsOfields =- _hdIfield : _tlIfields- -- use rule "DefaultRules.ag"(line 107, column 19)- _lhsOerrors =- _hdIerrors Seq.<> _tlIerrors- -- self rule- _output =- (:) _hdIoutput _tlIoutput- -- self rule- _lhsOoutput =- _output- -- copy rule (down)- _hdOcon =- _lhsIcon- -- copy rule (down)- _hdOcr =- _lhsIcr- -- copy rule (down)- _hdOnt =- _lhsInt- -- copy rule (down)- _tlOcon =- _lhsIcon- -- copy rule (down)- _tlOcr =- _lhsIcr- -- copy rule (down)- _tlOnt =- _lhsInt- ( _hdIerrors,_hdIfield,_hdIinherited,_hdIname,_hdIoutput,_hdIsynthesized) =- (hd_ _hdOcon _hdOcr _hdOnt )- ( _tlIerrors,_tlIfields,_tlIinputs,_tlIoutput,_tlIoutputs) =- (tl_ _tlOcon _tlOcr _tlOnt )- in ( _lhsOerrors,_lhsOfields,_lhsOinputs,_lhsOoutput,_lhsOoutputs))) )-sem_Children_Nil :: T_Children-sem_Children_Nil =- (T_Children (\ _lhsIcon- _lhsIcr- _lhsInt ->- (let _lhsOinputs :: ([(Name, Attributes)])- _lhsOoutputs :: ([(Name, Attributes)])- _lhsOfields :: ([(Name,Type,Bool)])- _lhsOerrors :: (Seq Error)- _lhsOoutput :: Children- -- "DefaultRules.ag"(line 153, column 10)- _lhsOinputs =- []- -- "DefaultRules.ag"(line 153, column 10)- _lhsOoutputs =- []- -- "DefaultRules.ag"(line 383, column 10)- _lhsOfields =- []- -- use rule "DefaultRules.ag"(line 107, column 19)- _lhsOerrors =- Seq.empty- -- self rule- _output =- []- -- self rule- _lhsOoutput =- _output- in ( _lhsOerrors,_lhsOfields,_lhsOinputs,_lhsOoutput,_lhsOoutputs))) )--- Grammar ------------------------------------------------------{-- visit 0:- inherited attribute:- options : Options- synthesized attributes:- errors : Seq Error- output : SELF- alternatives:- alternative Grammar:- child typeSyns : {TypeSyns}- child useMap : {UseMap}- child derivings : {Derivings}- child wrappers : {Set Nonterminal}- child prods : Productions- child pragmas : {PragmaMap}- child manualAttrOrderMap : {AttrOrderMap}- visit 0:- local output : _--}--- cata-sem_Grammar :: Grammar ->- T_Grammar-sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _prods _pragmas _manualAttrOrderMap ) =- (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Productions _prods ) _pragmas _manualAttrOrderMap )--- semantic domain-newtype T_Grammar = T_Grammar (Options ->- ( (Seq Error),Grammar))-data Inh_Grammar = Inh_Grammar {options_Inh_Grammar :: Options}-data Syn_Grammar = Syn_Grammar {errors_Syn_Grammar :: Seq Error,output_Syn_Grammar :: Grammar}-wrap_Grammar (T_Grammar sem ) (Inh_Grammar _lhsIoptions ) =- (let ( _lhsOerrors,_lhsOoutput) =- (sem _lhsIoptions )- in (Syn_Grammar _lhsOerrors _lhsOoutput ))-sem_Grammar_Grammar :: TypeSyns ->- UseMap ->- Derivings ->- (Set Nonterminal) ->- T_Productions ->- PragmaMap ->- AttrOrderMap ->- T_Grammar-sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Productions prods_ ) pragmas_ manualAttrOrderMap_ =- (T_Grammar (\ _lhsIoptions ->- (let _prodsOo_rename :: Bool- _prodsOcr :: Bool- _prodsOnonterminals :: (Set Nonterminal)- _prodsOuseMap :: UseMap- _prodsOtypeSyns :: TypeSyns- _prodsOuniq :: Int- _prodsOmanualAttrOrderMap :: AttrOrderMap- _lhsOerrors :: (Seq Error)- _lhsOoutput :: Grammar- _prodsIcollect_nts :: (Set Nonterminal)- _prodsIerrors :: (Seq Error)- _prodsIoutput :: Productions- _prodsIuniq :: Int- -- "DefaultRules.ag"(line 41, column 17)- _prodsOo_rename =- rename _lhsIoptions- -- "DefaultRules.ag"(line 42, column 17)- _prodsOcr =- modcopy _lhsIoptions- -- "DefaultRules.ag"(line 119, column 13)- _prodsOnonterminals =- _prodsIcollect_nts- -- "DefaultRules.ag"(line 140, column 13)- _prodsOuseMap =- useMap_- -- "DefaultRules.ag"(line 142, column 13)- _prodsOtypeSyns =- typeSyns_- -- "DefaultRules.ag"(line 403, column 13)- _prodsOuniq =- 1- -- "DefaultRules.ag"(line 479, column 7)- _prodsOmanualAttrOrderMap =- manualAttrOrderMap_- -- use rule "DefaultRules.ag"(line 107, column 19)- _lhsOerrors =- _prodsIerrors- -- self rule- _output =- Grammar typeSyns_ useMap_ derivings_ wrappers_ _prodsIoutput pragmas_ manualAttrOrderMap_- -- self rule- _lhsOoutput =- _output- ( _prodsIcollect_nts,_prodsIerrors,_prodsIoutput,_prodsIuniq) =- (prods_ _prodsOcr _prodsOmanualAttrOrderMap _prodsOnonterminals _prodsOo_rename _prodsOtypeSyns _prodsOuniq _prodsOuseMap )- in ( _lhsOerrors,_lhsOoutput))) )--- Pattern ------------------------------------------------------{-- visit 0:- inherited attributes:- con : Constructor- nt : Nonterminal- synthesized attributes:- containsVars : Bool- copy : SELF- definedAttrs : Set (Name,Name)- errors : Seq Error- locals : Set Name- output : SELF- alternatives:- alternative Alias:- child field : {Name}- child attr : {Name}- child pat : Pattern- child parts : Patterns- visit 0:- local copy : _- local output : _- alternative Constr:- child name : {Constructor}- child pats : Patterns- visit 0:- local copy : _- local output : _- alternative Product:- child pos : {Pos}- child pats : Patterns- visit 0:- local copy : _- local output : _- alternative Underscore:- child pos : {Pos}- visit 0:- local copy : _- local output : _--}--- 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 (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 (Constructor ->- Nonterminal ->- ( Bool,Pattern,(Set (Name,Name)),(Seq Error),(Set Name),Pattern))-data Inh_Pattern = Inh_Pattern {con_Inh_Pattern :: Constructor,nt_Inh_Pattern :: Nonterminal}-data Syn_Pattern = Syn_Pattern {containsVars_Syn_Pattern :: Bool,copy_Syn_Pattern :: Pattern,definedAttrs_Syn_Pattern :: Set (Name,Name),errors_Syn_Pattern :: Seq Error,locals_Syn_Pattern :: Set Name,output_Syn_Pattern :: Pattern}-wrap_Pattern (T_Pattern sem ) (Inh_Pattern _lhsIcon _lhsInt ) =- (let ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) =- (sem _lhsIcon _lhsInt )- in (Syn_Pattern _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput ))-sem_Pattern_Alias :: Name ->- Name ->- T_Pattern ->- T_Patterns ->- T_Pattern-sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) =- (T_Pattern (\ _lhsIcon- _lhsInt ->- (let _lhsOdefinedAttrs :: (Set (Name,Name))- _lhsOlocals :: (Set Name)- _lhsOcontainsVars :: Bool- _lhsOerrors :: (Seq Error)- _lhsOcopy :: Pattern- _lhsOoutput :: Pattern- _patOcon :: Constructor- _patOnt :: Nonterminal- _partsOcon :: Constructor- _partsOnt :: Nonterminal- _patIcontainsVars :: Bool- _patIcopy :: Pattern- _patIdefinedAttrs :: (Set (Name,Name))- _patIerrors :: (Seq Error)- _patIlocals :: (Set Name)- _patIoutput :: Pattern- _partsIcontainsVars :: Bool- _partsIcopy :: Patterns- _partsIdefinedAttrs :: (Set (Name,Name))- _partsIerrors :: (Seq Error)- _partsIlocals :: (Set Name)- _partsIoutput :: Patterns- -- "DefaultRules.ag"(line 376, column 11)- _lhsOdefinedAttrs =- Set.insert (field_,attr_) _patIdefinedAttrs- -- "DefaultRules.ag"(line 376, column 11)- _lhsOlocals =- if field_ == _LOC- then Set.insert attr_ _patIlocals- else _patIlocals- -- "DefaultRules.ag"(line 394, column 16)- _lhsOcontainsVars =- True- -- use rule "DefaultRules.ag"(line 107, column 19)- _lhsOerrors =- _patIerrors Seq.<> _partsIerrors- -- self rule- _copy =- Alias field_ attr_ _patIcopy _partsIcopy- -- self rule- _output =- Alias field_ attr_ _patIoutput _partsIoutput- -- self rule- _lhsOcopy =- _copy- -- self rule- _lhsOoutput =- _output- -- copy rule (down)- _patOcon =- _lhsIcon- -- copy rule (down)- _patOnt =- _lhsInt- -- copy rule (down)- _partsOcon =- _lhsIcon- -- copy rule (down)- _partsOnt =- _lhsInt- ( _patIcontainsVars,_patIcopy,_patIdefinedAttrs,_patIerrors,_patIlocals,_patIoutput) =- (pat_ _patOcon _patOnt )- ( _partsIcontainsVars,_partsIcopy,_partsIdefinedAttrs,_partsIerrors,_partsIlocals,_partsIoutput) =- (parts_ _partsOcon _partsOnt )- in ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput))) )-sem_Pattern_Constr :: Constructor ->- T_Patterns ->- T_Pattern-sem_Pattern_Constr name_ (T_Patterns pats_ ) =- (T_Pattern (\ _lhsIcon- _lhsInt ->- (let _lhsOcontainsVars :: Bool- _lhsOdefinedAttrs :: (Set (Name,Name))- _lhsOerrors :: (Seq Error)- _lhsOlocals :: (Set Name)- _lhsOcopy :: Pattern- _lhsOoutput :: Pattern- _patsOcon :: Constructor- _patsOnt :: Nonterminal- _patsIcontainsVars :: Bool- _patsIcopy :: Patterns- _patsIdefinedAttrs :: (Set (Name,Name))- _patsIerrors :: (Seq Error)- _patsIlocals :: (Set Name)- _patsIoutput :: Patterns- -- use rule "DefaultRules.ag"(line 391, column 46)- _lhsOcontainsVars =- _patsIcontainsVars- -- use rule "DefaultRules.ag"(line 371, column 23)- _lhsOdefinedAttrs =- _patsIdefinedAttrs- -- use rule "DefaultRules.ag"(line 107, column 19)- _lhsOerrors =- _patsIerrors- -- use rule "DefaultRules.ag"(line 370, column 23)- _lhsOlocals =- _patsIlocals- -- self rule- _copy =- Constr name_ _patsIcopy- -- self rule- _output =- Constr name_ _patsIoutput- -- self rule- _lhsOcopy =- _copy- -- self rule- _lhsOoutput =- _output- -- copy rule (down)- _patsOcon =- _lhsIcon- -- copy rule (down)- _patsOnt =- _lhsInt- ( _patsIcontainsVars,_patsIcopy,_patsIdefinedAttrs,_patsIerrors,_patsIlocals,_patsIoutput) =- (pats_ _patsOcon _patsOnt )- in ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput))) )-sem_Pattern_Product :: Pos ->- T_Patterns ->- T_Pattern-sem_Pattern_Product pos_ (T_Patterns pats_ ) =- (T_Pattern (\ _lhsIcon- _lhsInt ->- (let _lhsOcontainsVars :: Bool- _lhsOdefinedAttrs :: (Set (Name,Name))- _lhsOerrors :: (Seq Error)- _lhsOlocals :: (Set Name)- _lhsOcopy :: Pattern- _lhsOoutput :: Pattern- _patsOcon :: Constructor- _patsOnt :: Nonterminal- _patsIcontainsVars :: Bool- _patsIcopy :: Patterns- _patsIdefinedAttrs :: (Set (Name,Name))- _patsIerrors :: (Seq Error)- _patsIlocals :: (Set Name)- _patsIoutput :: Patterns- -- use rule "DefaultRules.ag"(line 391, column 46)- _lhsOcontainsVars =- _patsIcontainsVars- -- use rule "DefaultRules.ag"(line 371, column 23)- _lhsOdefinedAttrs =- _patsIdefinedAttrs- -- use rule "DefaultRules.ag"(line 107, column 19)- _lhsOerrors =- _patsIerrors- -- use rule "DefaultRules.ag"(line 370, column 23)- _lhsOlocals =- _patsIlocals- -- self rule- _copy =- Product pos_ _patsIcopy- -- self rule- _output =- Product pos_ _patsIoutput- -- self rule- _lhsOcopy =- _copy- -- self rule- _lhsOoutput =- _output- -- copy rule (down)- _patsOcon =- _lhsIcon- -- copy rule (down)- _patsOnt =- _lhsInt- ( _patsIcontainsVars,_patsIcopy,_patsIdefinedAttrs,_patsIerrors,_patsIlocals,_patsIoutput) =- (pats_ _patsOcon _patsOnt )- in ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput))) )-sem_Pattern_Underscore :: Pos ->- T_Pattern-sem_Pattern_Underscore pos_ =- (T_Pattern (\ _lhsIcon- _lhsInt ->- (let _lhsOcontainsVars :: Bool- _lhsOdefinedAttrs :: (Set (Name,Name))- _lhsOerrors :: (Seq Error)- _lhsOlocals :: (Set Name)- _lhsOcopy :: Pattern- _lhsOoutput :: Pattern- -- use rule "DefaultRules.ag"(line 391, column 46)- _lhsOcontainsVars =- False- -- use rule "DefaultRules.ag"(line 371, column 23)- _lhsOdefinedAttrs =- Set.empty- -- use rule "DefaultRules.ag"(line 107, column 19)- _lhsOerrors =- Seq.empty- -- use rule "DefaultRules.ag"(line 370, column 23)- _lhsOlocals =- Set.empty- -- self rule- _copy =- Underscore pos_- -- self rule- _output =- Underscore pos_- -- self rule- _lhsOcopy =- _copy- -- self rule- _lhsOoutput =- _output- in ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput))) )--- Patterns -----------------------------------------------------{-- visit 0:- inherited attributes:- con : Constructor- nt : Nonterminal- synthesized attributes:- containsVars : Bool- copy : SELF- definedAttrs : Set (Name,Name)- errors : Seq Error- locals : Set Name- output : SELF- alternatives:- alternative Cons:- child hd : Pattern- child tl : Patterns- visit 0:- local copy : _- local output : _- alternative Nil:- visit 0:- local copy : _- local output : _--}--- 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 (Constructor ->- Nonterminal ->- ( Bool,Patterns,(Set (Name,Name)),(Seq Error),(Set Name),Patterns))-data Inh_Patterns = Inh_Patterns {con_Inh_Patterns :: Constructor,nt_Inh_Patterns :: Nonterminal}-data Syn_Patterns = Syn_Patterns {containsVars_Syn_Patterns :: Bool,copy_Syn_Patterns :: Patterns,definedAttrs_Syn_Patterns :: Set (Name,Name),errors_Syn_Patterns :: Seq Error,locals_Syn_Patterns :: Set Name,output_Syn_Patterns :: Patterns}-wrap_Patterns (T_Patterns sem ) (Inh_Patterns _lhsIcon _lhsInt ) =- (let ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) =- (sem _lhsIcon _lhsInt )- in (Syn_Patterns _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput ))-sem_Patterns_Cons :: T_Pattern ->- T_Patterns ->- T_Patterns-sem_Patterns_Cons (T_Pattern hd_ ) (T_Patterns tl_ ) =- (T_Patterns (\ _lhsIcon- _lhsInt ->- (let _lhsOcontainsVars :: Bool- _lhsOdefinedAttrs :: (Set (Name,Name))- _lhsOerrors :: (Seq Error)- _lhsOlocals :: (Set Name)- _lhsOcopy :: Patterns- _lhsOoutput :: Patterns- _hdOcon :: Constructor- _hdOnt :: Nonterminal- _tlOcon :: Constructor- _tlOnt :: Nonterminal- _hdIcontainsVars :: Bool- _hdIcopy :: Pattern- _hdIdefinedAttrs :: (Set (Name,Name))- _hdIerrors :: (Seq Error)- _hdIlocals :: (Set Name)- _hdIoutput :: Pattern- _tlIcontainsVars :: Bool- _tlIcopy :: Patterns- _tlIdefinedAttrs :: (Set (Name,Name))- _tlIerrors :: (Seq Error)- _tlIlocals :: (Set Name)- _tlIoutput :: Patterns- -- use rule "DefaultRules.ag"(line 391, column 46)- _lhsOcontainsVars =- _hdIcontainsVars || _tlIcontainsVars- -- use rule "DefaultRules.ag"(line 371, column 23)- _lhsOdefinedAttrs =- _hdIdefinedAttrs `Set.union` _tlIdefinedAttrs- -- use rule "DefaultRules.ag"(line 107, column 19)- _lhsOerrors =- _hdIerrors Seq.<> _tlIerrors- -- use rule "DefaultRules.ag"(line 370, column 23)- _lhsOlocals =- _hdIlocals `Set.union` _tlIlocals- -- self rule- _copy =- (:) _hdIcopy _tlIcopy- -- self rule- _output =- (:) _hdIoutput _tlIoutput- -- self rule- _lhsOcopy =- _copy- -- self rule- _lhsOoutput =- _output- -- copy rule (down)- _hdOcon =- _lhsIcon- -- copy rule (down)- _hdOnt =- _lhsInt- -- copy rule (down)- _tlOcon =- _lhsIcon- -- copy rule (down)- _tlOnt =- _lhsInt- ( _hdIcontainsVars,_hdIcopy,_hdIdefinedAttrs,_hdIerrors,_hdIlocals,_hdIoutput) =- (hd_ _hdOcon _hdOnt )- ( _tlIcontainsVars,_tlIcopy,_tlIdefinedAttrs,_tlIerrors,_tlIlocals,_tlIoutput) =- (tl_ _tlOcon _tlOnt )- in ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput))) )-sem_Patterns_Nil :: T_Patterns-sem_Patterns_Nil =- (T_Patterns (\ _lhsIcon- _lhsInt ->- (let _lhsOcontainsVars :: Bool- _lhsOdefinedAttrs :: (Set (Name,Name))- _lhsOerrors :: (Seq Error)- _lhsOlocals :: (Set Name)- _lhsOcopy :: Patterns- _lhsOoutput :: Patterns- -- use rule "DefaultRules.ag"(line 391, column 46)- _lhsOcontainsVars =- False- -- use rule "DefaultRules.ag"(line 371, column 23)- _lhsOdefinedAttrs =- Set.empty- -- use rule "DefaultRules.ag"(line 107, column 19)- _lhsOerrors =- Seq.empty- -- use rule "DefaultRules.ag"(line 370, column 23)- _lhsOlocals =- Set.empty- -- self rule- _copy =- []- -- self rule- _output =- []- -- self rule- _lhsOcopy =- _copy- -- self rule- _lhsOoutput =- _output- in ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput))) )--- Production ---------------------------------------------------{-- visit 0:- inherited attributes:- cr : Bool- manualAttrOrderMap : AttrOrderMap- nonterminals : Set Nonterminal- o_rename : Bool- typeSyns : TypeSyns- useMap : UseMap- chained attribute:- uniq : Int- synthesized attributes:- collect_nts : Set Nonterminal- errors : Seq Error- output : SELF- alternatives:- alternative Production:- child nt : {Nonterminal}- child inh : {Attributes}- child syn : {Attributes}- child alts : Alternatives- visit 0:- local output : _--}--- cata-sem_Production :: Production ->- T_Production-sem_Production (Production _nt _inh _syn _alts ) =- (sem_Production_Production _nt _inh _syn (sem_Alternatives _alts ) )--- semantic domain-newtype T_Production = T_Production (Bool ->- AttrOrderMap ->- (Set Nonterminal) ->- Bool ->- TypeSyns ->- Int ->- UseMap ->- ( (Set Nonterminal),(Seq Error),Production,Int))-data Inh_Production = Inh_Production {cr_Inh_Production :: Bool,manualAttrOrderMap_Inh_Production :: AttrOrderMap,nonterminals_Inh_Production :: Set Nonterminal,o_rename_Inh_Production :: Bool,typeSyns_Inh_Production :: TypeSyns,uniq_Inh_Production :: Int,useMap_Inh_Production :: UseMap}-data Syn_Production = Syn_Production {collect_nts_Syn_Production :: Set Nonterminal,errors_Syn_Production :: Seq Error,output_Syn_Production :: Production,uniq_Syn_Production :: Int}-wrap_Production (T_Production sem ) (Inh_Production _lhsIcr _lhsImanualAttrOrderMap _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap ) =- (let ( _lhsOcollect_nts,_lhsOerrors,_lhsOoutput,_lhsOuniq) =- (sem _lhsIcr _lhsImanualAttrOrderMap _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap )- in (Syn_Production _lhsOcollect_nts _lhsOerrors _lhsOoutput _lhsOuniq ))-sem_Production_Production :: Nonterminal ->- Attributes ->- Attributes ->- T_Alternatives ->- T_Production-sem_Production_Production nt_ inh_ syn_ (T_Alternatives alts_ ) =- (T_Production (\ _lhsIcr- _lhsImanualAttrOrderMap- _lhsInonterminals- _lhsIo_rename- _lhsItypeSyns- _lhsIuniq- _lhsIuseMap ->- (let _lhsOcollect_nts :: (Set Nonterminal)- _altsOinh :: Attributes- _altsOsyn :: Attributes- _altsOuseMap :: (Map Name (String,String,String))- _altsOnt :: Nonterminal- _lhsOerrors :: (Seq Error)- _lhsOoutput :: Production- _lhsOuniq :: Int- _altsOcr :: Bool- _altsOmanualAttrOrderMap :: AttrOrderMap- _altsOnonterminals :: (Set Nonterminal)- _altsOo_rename :: Bool- _altsOtypeSyns :: TypeSyns- _altsOuniq :: Int- _altsIerrors :: (Seq Error)- _altsIoutput :: Alternatives- _altsIuniq :: Int- -- "DefaultRules.ag"(line 115, column 16)- _lhsOcollect_nts =- Set.singleton nt_- -- "DefaultRules.ag"(line 130, column 17)- _altsOinh =- inh_- -- "DefaultRules.ag"(line 131, column 17)- _altsOsyn =- syn_- -- "DefaultRules.ag"(line 132, column 17)- _altsOuseMap =- Map.findWithDefault Map.empty nt_ _lhsIuseMap- -- "DefaultRules.ag"(line 144, column 16)- _altsOnt =- nt_- -- use rule "DefaultRules.ag"(line 107, column 19)- _lhsOerrors =- _altsIerrors- -- self rule- _output =- Production nt_ inh_ syn_ _altsIoutput- -- self rule- _lhsOoutput =- _output- -- copy rule (up)- _lhsOuniq =- _altsIuniq- -- copy rule (down)- _altsOcr =- _lhsIcr- -- copy rule (down)- _altsOmanualAttrOrderMap =- _lhsImanualAttrOrderMap- -- copy rule (down)- _altsOnonterminals =- _lhsInonterminals- -- copy rule (down)- _altsOo_rename =- _lhsIo_rename- -- copy rule (down)- _altsOtypeSyns =- _lhsItypeSyns- -- copy rule (down)- _altsOuniq =- _lhsIuniq- ( _altsIerrors,_altsIoutput,_altsIuniq) =- (alts_ _altsOcr _altsOinh _altsOmanualAttrOrderMap _altsOnonterminals _altsOnt _altsOo_rename _altsOsyn _altsOtypeSyns _altsOuniq _altsOuseMap )- in ( _lhsOcollect_nts,_lhsOerrors,_lhsOoutput,_lhsOuniq))) )--- Productions --------------------------------------------------{-- visit 0:- inherited attributes:- cr : Bool- manualAttrOrderMap : AttrOrderMap- nonterminals : Set Nonterminal- o_rename : Bool- typeSyns : TypeSyns- useMap : UseMap- chained attribute:- uniq : Int- synthesized attributes:- collect_nts : Set Nonterminal- errors : Seq Error- output : SELF- alternatives:- alternative Cons:- child hd : Production- child tl : Productions- visit 0:- local output : _- alternative Nil:- visit 0:- local output : _--}--- 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 (Bool ->- AttrOrderMap ->- (Set Nonterminal) ->- Bool ->- TypeSyns ->- Int ->- UseMap ->- ( (Set Nonterminal),(Seq Error),Productions,Int))-data Inh_Productions = Inh_Productions {cr_Inh_Productions :: Bool,manualAttrOrderMap_Inh_Productions :: AttrOrderMap,nonterminals_Inh_Productions :: Set Nonterminal,o_rename_Inh_Productions :: Bool,typeSyns_Inh_Productions :: TypeSyns,uniq_Inh_Productions :: Int,useMap_Inh_Productions :: UseMap}-data Syn_Productions = Syn_Productions {collect_nts_Syn_Productions :: Set Nonterminal,errors_Syn_Productions :: Seq Error,output_Syn_Productions :: Productions,uniq_Syn_Productions :: Int}-wrap_Productions (T_Productions sem ) (Inh_Productions _lhsIcr _lhsImanualAttrOrderMap _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap ) =- (let ( _lhsOcollect_nts,_lhsOerrors,_lhsOoutput,_lhsOuniq) =- (sem _lhsIcr _lhsImanualAttrOrderMap _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap )- in (Syn_Productions _lhsOcollect_nts _lhsOerrors _lhsOoutput _lhsOuniq ))-sem_Productions_Cons :: T_Production ->- T_Productions ->- T_Productions-sem_Productions_Cons (T_Production hd_ ) (T_Productions tl_ ) =- (T_Productions (\ _lhsIcr- _lhsImanualAttrOrderMap- _lhsInonterminals- _lhsIo_rename- _lhsItypeSyns- _lhsIuniq- _lhsIuseMap ->- (let _lhsOcollect_nts :: (Set Nonterminal)- _lhsOerrors :: (Seq Error)- _lhsOoutput :: Productions- _lhsOuniq :: Int- _hdOcr :: Bool- _hdOmanualAttrOrderMap :: AttrOrderMap- _hdOnonterminals :: (Set Nonterminal)- _hdOo_rename :: Bool- _hdOtypeSyns :: TypeSyns- _hdOuniq :: Int- _hdOuseMap :: UseMap- _tlOcr :: Bool- _tlOmanualAttrOrderMap :: AttrOrderMap- _tlOnonterminals :: (Set Nonterminal)- _tlOo_rename :: Bool- _tlOtypeSyns :: TypeSyns- _tlOuniq :: Int- _tlOuseMap :: UseMap- _hdIcollect_nts :: (Set Nonterminal)- _hdIerrors :: (Seq Error)- _hdIoutput :: Production- _hdIuniq :: Int- _tlIcollect_nts :: (Set Nonterminal)- _tlIerrors :: (Seq Error)- _tlIoutput :: Productions- _tlIuniq :: Int- -- use rule "DefaultRules.ag"(line 113, column 47)- _lhsOcollect_nts =- _hdIcollect_nts `Set.union` _tlIcollect_nts- -- use rule "DefaultRules.ag"(line 107, column 19)- _lhsOerrors =- _hdIerrors Seq.<> _tlIerrors- -- self rule- _output =- (:) _hdIoutput _tlIoutput- -- self rule- _lhsOoutput =- _output- -- copy rule (up)- _lhsOuniq =- _tlIuniq- -- copy rule (down)- _hdOcr =- _lhsIcr- -- copy rule (down)- _hdOmanualAttrOrderMap =- _lhsImanualAttrOrderMap- -- copy rule (down)- _hdOnonterminals =- _lhsInonterminals- -- copy rule (down)- _hdOo_rename =- _lhsIo_rename- -- copy rule (down)- _hdOtypeSyns =- _lhsItypeSyns- -- copy rule (down)- _hdOuniq =- _lhsIuniq- -- copy rule (down)- _hdOuseMap =- _lhsIuseMap- -- copy rule (down)- _tlOcr =- _lhsIcr- -- copy rule (down)- _tlOmanualAttrOrderMap =- _lhsImanualAttrOrderMap- -- copy rule (down)- _tlOnonterminals =- _lhsInonterminals- -- copy rule (down)- _tlOo_rename =- _lhsIo_rename- -- copy rule (down)- _tlOtypeSyns =- _lhsItypeSyns- -- copy rule (chain)- _tlOuniq =- _hdIuniq- -- copy rule (down)- _tlOuseMap =- _lhsIuseMap- ( _hdIcollect_nts,_hdIerrors,_hdIoutput,_hdIuniq) =- (hd_ _hdOcr _hdOmanualAttrOrderMap _hdOnonterminals _hdOo_rename _hdOtypeSyns _hdOuniq _hdOuseMap )- ( _tlIcollect_nts,_tlIerrors,_tlIoutput,_tlIuniq) =- (tl_ _tlOcr _tlOmanualAttrOrderMap _tlOnonterminals _tlOo_rename _tlOtypeSyns _tlOuniq _tlOuseMap )- in ( _lhsOcollect_nts,_lhsOerrors,_lhsOoutput,_lhsOuniq))) )-sem_Productions_Nil :: T_Productions-sem_Productions_Nil =- (T_Productions (\ _lhsIcr- _lhsImanualAttrOrderMap- _lhsInonterminals- _lhsIo_rename- _lhsItypeSyns- _lhsIuniq- _lhsIuseMap ->- (let _lhsOcollect_nts :: (Set Nonterminal)- _lhsOerrors :: (Seq Error)- _lhsOoutput :: Productions- _lhsOuniq :: Int- -- use rule "DefaultRules.ag"(line 113, column 47)- _lhsOcollect_nts =- Set.empty- -- use rule "DefaultRules.ag"(line 107, column 19)- _lhsOerrors =- Seq.empty- -- self rule- _output =- []- -- self rule- _lhsOoutput =- _output- -- copy rule (chain)- _lhsOuniq =- _lhsIuniq- in ( _lhsOcollect_nts,_lhsOerrors,_lhsOoutput,_lhsOuniq))) )--- Rule ---------------------------------------------------------{-- visit 0:- inherited attributes:- con : Constructor- nt : Nonterminal- chained attribute:- uniq : Int- synthesized attributes:- containsVars : Bool- definedAttrs : Set (Name,Name)- errors : Seq Error- locals : Set Name- output : SELF- outputs : Rules- alternatives:- alternative Rule:- child pattern : Pattern- child rhs : {Expression}- child owrt : {Bool}- child origin : {String}- visit 0:- local _tup2 : {(Rules,Int)}- local output : _--}--- cata-sem_Rule :: Rule ->- T_Rule-sem_Rule (Rule _pattern _rhs _owrt _origin ) =- (sem_Rule_Rule (sem_Pattern _pattern ) _rhs _owrt _origin )--- semantic domain-newtype T_Rule = T_Rule (Constructor ->- Nonterminal ->- Int ->- ( Bool,(Set (Name,Name)),(Seq Error),(Set Name),Rule,Rules,Int))-data Inh_Rule = Inh_Rule {con_Inh_Rule :: Constructor,nt_Inh_Rule :: Nonterminal,uniq_Inh_Rule :: Int}-data Syn_Rule = Syn_Rule {containsVars_Syn_Rule :: Bool,definedAttrs_Syn_Rule :: Set (Name,Name),errors_Syn_Rule :: Seq Error,locals_Syn_Rule :: Set Name,output_Syn_Rule :: Rule,outputs_Syn_Rule :: Rules,uniq_Syn_Rule :: Int}-wrap_Rule (T_Rule sem ) (Inh_Rule _lhsIcon _lhsInt _lhsIuniq ) =- (let ( _lhsOcontainsVars,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOoutputs,_lhsOuniq) =- (sem _lhsIcon _lhsInt _lhsIuniq )- in (Syn_Rule _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOoutputs _lhsOuniq ))-sem_Rule_Rule :: T_Pattern ->- Expression ->- Bool ->- String ->- T_Rule-sem_Rule_Rule (T_Pattern pattern_ ) rhs_ owrt_ origin_ =- (T_Rule (\ _lhsIcon- _lhsInt- _lhsIuniq ->- (let __tup2 :: ((Rules,Int))- _lhsOoutputs :: Rules- _lhsOuniq :: Int- _lhsOcontainsVars :: Bool- _lhsOdefinedAttrs :: (Set (Name,Name))- _lhsOerrors :: (Seq Error)- _lhsOlocals :: (Set Name)- _lhsOoutput :: Rule- _patternOcon :: Constructor- _patternOnt :: Nonterminal- _patternIcontainsVars :: Bool- _patternIcopy :: Pattern- _patternIdefinedAttrs :: (Set (Name,Name))- _patternIerrors :: (Seq Error)- _patternIlocals :: (Set Name)- _patternIoutput :: Pattern- -- "DefaultRules.ag"(line 420, column 11)- __tup2 =- multiRule _output _lhsIuniq- -- "DefaultRules.ag"(line 420, column 11)- (_lhsOoutputs,_) =- __tup2- -- "DefaultRules.ag"(line 420, column 11)- (_,_lhsOuniq) =- __tup2- -- use rule "DefaultRules.ag"(line 391, column 46)- _lhsOcontainsVars =- _patternIcontainsVars- -- use rule "DefaultRules.ag"(line 371, column 23)- _lhsOdefinedAttrs =- _patternIdefinedAttrs- -- use rule "DefaultRules.ag"(line 107, column 19)- _lhsOerrors =- _patternIerrors- -- use rule "DefaultRules.ag"(line 370, column 23)- _lhsOlocals =- _patternIlocals- -- self rule- _output =- Rule _patternIoutput rhs_ owrt_ origin_- -- self rule- _lhsOoutput =- _output- -- copy rule (down)- _patternOcon =- _lhsIcon- -- copy rule (down)- _patternOnt =- _lhsInt- ( _patternIcontainsVars,_patternIcopy,_patternIdefinedAttrs,_patternIerrors,_patternIlocals,_patternIoutput) =- (pattern_ _patternOcon _patternOnt )- in ( _lhsOcontainsVars,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOoutputs,_lhsOuniq))) )--- Rules --------------------------------------------------------{-- visit 0:- inherited attributes:- con : Constructor- nt : Nonterminal- chained attribute:- uniq : Int- synthesized attributes:- definedAttrs : Set (Name,Name)- errors : Seq Error- locals : Set Name- output : SELF- alternatives:- alternative Cons:- child hd : Rule- child tl : Rules- visit 0:- local output : _- alternative Nil:- visit 0:- local output : _--}--- 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 (Constructor ->- Nonterminal ->- Int ->- ( (Set (Name,Name)),(Seq Error),(Set Name),Rules,Int))-data Inh_Rules = Inh_Rules {con_Inh_Rules :: Constructor,nt_Inh_Rules :: Nonterminal,uniq_Inh_Rules :: Int}-data Syn_Rules = Syn_Rules {definedAttrs_Syn_Rules :: Set (Name,Name),errors_Syn_Rules :: Seq Error,locals_Syn_Rules :: Set Name,output_Syn_Rules :: Rules,uniq_Syn_Rules :: Int}-wrap_Rules (T_Rules sem ) (Inh_Rules _lhsIcon _lhsInt _lhsIuniq ) =- (let ( _lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOuniq) =- (sem _lhsIcon _lhsInt _lhsIuniq )- in (Syn_Rules _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOuniq ))-sem_Rules_Cons :: T_Rule ->- T_Rules ->- T_Rules-sem_Rules_Cons (T_Rule hd_ ) (T_Rules tl_ ) =- (T_Rules (\ _lhsIcon- _lhsInt- _lhsIuniq ->- (let _lhsOoutput :: Rules- _lhsOdefinedAttrs :: (Set (Name,Name))- _lhsOerrors :: (Seq Error)- _lhsOlocals :: (Set Name)- _lhsOuniq :: Int- _hdOcon :: Constructor- _hdOnt :: Nonterminal- _hdOuniq :: Int- _tlOcon :: Constructor- _tlOnt :: Nonterminal- _tlOuniq :: Int- _hdIcontainsVars :: Bool- _hdIdefinedAttrs :: (Set (Name,Name))- _hdIerrors :: (Seq Error)- _hdIlocals :: (Set Name)- _hdIoutput :: Rule- _hdIoutputs :: Rules- _hdIuniq :: Int- _tlIdefinedAttrs :: (Set (Name,Name))- _tlIerrors :: (Seq Error)- _tlIlocals :: (Set Name)- _tlIoutput :: Rules- _tlIuniq :: Int- -- "DefaultRules.ag"(line 416, column 10)- _lhsOoutput =- if _hdIcontainsVars then _hdIoutputs ++ _tlIoutput else _tlIoutput- -- use rule "DefaultRules.ag"(line 371, column 23)- _lhsOdefinedAttrs =- _hdIdefinedAttrs `Set.union` _tlIdefinedAttrs- -- use rule "DefaultRules.ag"(line 107, column 19)- _lhsOerrors =- _hdIerrors Seq.<> _tlIerrors- -- use rule "DefaultRules.ag"(line 370, column 23)- _lhsOlocals =- _hdIlocals `Set.union` _tlIlocals- -- self rule- _output =- (:) _hdIoutput _tlIoutput- -- copy rule (up)- _lhsOuniq =- _tlIuniq- -- copy rule (down)- _hdOcon =- _lhsIcon- -- copy rule (down)- _hdOnt =- _lhsInt- -- copy rule (down)- _hdOuniq =- _lhsIuniq- -- copy rule (down)- _tlOcon =- _lhsIcon- -- copy rule (down)- _tlOnt =- _lhsInt- -- copy rule (chain)- _tlOuniq =- _hdIuniq- ( _hdIcontainsVars,_hdIdefinedAttrs,_hdIerrors,_hdIlocals,_hdIoutput,_hdIoutputs,_hdIuniq) =- (hd_ _hdOcon _hdOnt _hdOuniq )- ( _tlIdefinedAttrs,_tlIerrors,_tlIlocals,_tlIoutput,_tlIuniq) =- (tl_ _tlOcon _tlOnt _tlOuniq )- in ( _lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOuniq))) )-sem_Rules_Nil :: T_Rules-sem_Rules_Nil =- (T_Rules (\ _lhsIcon- _lhsInt- _lhsIuniq ->- (let _lhsOdefinedAttrs :: (Set (Name,Name))- _lhsOerrors :: (Seq Error)- _lhsOlocals :: (Set Name)- _lhsOoutput :: Rules- _lhsOuniq :: Int- -- use rule "DefaultRules.ag"(line 371, column 23)- _lhsOdefinedAttrs =- Set.empty- -- use rule "DefaultRules.ag"(line 107, column 19)- _lhsOerrors =- Seq.empty- -- use rule "DefaultRules.ag"(line 370, column 23)- _lhsOlocals =- Set.empty- -- self rule- _output =- []- -- self rule- _lhsOoutput =- _output- -- copy rule (chain)- _lhsOuniq =- _lhsIuniq- in ( _lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOuniq))) )--- TypeSig ------------------------------------------------------{-- visit 0:- synthesized attribute:- output : SELF- alternatives:- alternative TypeSig:- child name : {Name}- child tp : {Type}- visit 0:- local output : _--}--- cata-sem_TypeSig :: TypeSig ->- T_TypeSig-sem_TypeSig (TypeSig _name _tp ) =- (sem_TypeSig_TypeSig _name _tp )--- semantic domain-newtype T_TypeSig = T_TypeSig (( TypeSig))-data Inh_TypeSig = Inh_TypeSig {}-data Syn_TypeSig = Syn_TypeSig {output_Syn_TypeSig :: TypeSig}-wrap_TypeSig (T_TypeSig sem ) (Inh_TypeSig ) =- (let ( _lhsOoutput) =- (sem )- in (Syn_TypeSig _lhsOoutput ))-sem_TypeSig_TypeSig :: Name ->- Type ->- T_TypeSig-sem_TypeSig_TypeSig name_ tp_ =- (T_TypeSig (let _lhsOoutput :: TypeSig- -- self rule- _output =- TypeSig name_ tp_- -- self rule- _lhsOoutput =- _output- in ( _lhsOoutput)) )--- TypeSigs -----------------------------------------------------{-- visit 0:- synthesized attribute:- output : SELF- alternatives:- alternative Cons:- child hd : TypeSig- child tl : TypeSigs- visit 0:- local output : _- alternative Nil:- visit 0:- local output : _--}--- 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 (( TypeSigs))-data Inh_TypeSigs = Inh_TypeSigs {}-data Syn_TypeSigs = Syn_TypeSigs {output_Syn_TypeSigs :: TypeSigs}-wrap_TypeSigs (T_TypeSigs sem ) (Inh_TypeSigs ) =- (let ( _lhsOoutput) =- (sem )- in (Syn_TypeSigs _lhsOoutput ))-sem_TypeSigs_Cons :: T_TypeSig ->- T_TypeSigs ->- T_TypeSigs-sem_TypeSigs_Cons (T_TypeSig hd_ ) (T_TypeSigs tl_ ) =- (T_TypeSigs (let _lhsOoutput :: TypeSigs- _hdIoutput :: TypeSig- _tlIoutput :: TypeSigs- -- self rule- _output =- (:) _hdIoutput _tlIoutput- -- self rule- _lhsOoutput =- _output- ( _hdIoutput) =- (hd_ )- ( _tlIoutput) =- (tl_ )- in ( _lhsOoutput)) )-sem_TypeSigs_Nil :: T_TypeSigs-sem_TypeSigs_Nil =- (T_TypeSigs (let _lhsOoutput :: TypeSigs- -- self rule- _output =- []- -- self rule- _lhsOoutput =- _output- in ( _lhsOoutput)) )+-- UUAGC 0.9.5 (DefaultRules.ag)+module DefaultRules where++import qualified List (delete,intersperse)++import qualified Data.Set as Set+import qualified Data.Map as Map+import Data.Map(Map)+import qualified UU.DData.Seq as Seq+import UU.DData.Seq(Seq,(<>))+import UU.Scanner.Position(noPos)+import Pretty+import Maybe+import HsToken+import HsTokenScanner++import AbstractSyntax+import ErrorMessages++import Options(Options,modcopy,rename)++-- AbstractSyntax.ag imports+import Data.Set(Set)+import Data.Map(Map)+import Patterns (Pattern(..),Patterns)+import Expression (Expression(..))+import CommonTypes++-- Patterns.ag imports+import UU.Scanner.Position(Pos)+import CommonTypes (ConstructorIdent,Identifier)++fieldName n = '@' : getName n+ +locName n = '@' : getName n++attrName fld attr+ | fld == _LOC = '@' : getName attr + | otherwise = '@' : getName fld ++ "." ++ getName attr++_ACHILD = Ident "(" noPos -- hack+ + +getConName typeSyns rename nt con1 + | nt `elem` map fst typeSyns = synonym+ | otherwise = normalName+ where con = getName con1+ normalName | rename = getName nt++"_"++ con+ | otherwise = con+ synonym | con == "Cons" = "(:)"+ | con == "Nil" = "[]"+ | con == "Just" = "Just"+ | con == "Nothing" = "Nothing"+ | otherwise = normalName++++concatSeq = foldr Seq.append Seq.empty++splitAttrs :: Map Identifier a -> [Identifier] -> ([(Identifier,a)],[Identifier]) -- a used as (String,String)+splitAttrs _ [] + = ([],[])+splitAttrs useMap (n:rest) + = let (uses,normals) = splitAttrs useMap rest+ in case Map.lookup n useMap of+ Just x -> ((n,x):uses , normals ) + Nothing -> ( uses , n:normals )++removeDefined :: Set (Identifier,Identifier) -> (Identifier,Attributes) -> (Identifier,[Identifier])+removeDefined defined (fld,as) + = ( fld+ , [ a + | a <- Map.keys as+ , not (Set.member (fld,a) defined) + ]+ )+++ + + +deprecatedCopyRuleError nt con fld a+ = let mesg = + "In the definitions for alternative" + >#< getName con + >#< "of nonterminal" + >#< getName nt + >|< "," + >-< "the value of field" + >#< getName a + >#< "is copied by a copy-rule." + >-< "Copying the value of a field using a copy-rule is deprecated"+ >-< "Please add the following lines to your code:"+ >-< ( "SEM" + >#< getName nt+ >-< indent 2 ( "|" + >#< getName con + >#< getName fld + >#< "." + >#< a + >#< "=" + >#< "@" + >|< a+ )+ ) + in CustomError True (getPos a) mesg+ + +missingRuleErrorExpr nt con fld a+ = "error \"missing rule: " + ++ show nt ++ "." ++ show con ++ "." + ++ show fld ++ "." ++ show a ++ "\""+ + + +makeRule :: (Identifier,Identifier) -> Expression -> String -> Rule+makeRule (f1,a1) expr origin + = Rule (Alias f1 a1 (Underscore noPos) []) + expr + False + origin+++useRule :: Set Identifier -> [(Identifier,Attributes)] -> (Identifier,(String,String,String)) -> Rule+useRule locals ch_outs (n,(op,e,pos)) + = let elems = [ fld + | (fld,as) <- ch_outs+ , Map.member n as+ ]++ expr | Set.member n locals = attrName _LOC n+ | null elems = e+ | otherwise = foldr1 (\x y -> x ++ " " ++ op ++ " " ++ y) + (map (flip attrName n) elems)++ tks | Set.member n locals = [AGLocal n noPos Nothing]+ | null elems = lexTokens noPos e+ | otherwise = lexTokens noPos str+ where+ str = foldr1 (\x y -> x ++ " " ++ op ++ " " ++ y) + (map (flip attrName n) elems)++ in makeRule (_LHS,n) + (Expression noPos tks)+ ("use rule " ++ pos)+++++selfRule lhsNecLoc attr x + = let expr | lhsNecLoc = locName attr+ | otherwise = x++ tks | lhsNecLoc = [AGLocal attr noPos Nothing]+ | otherwise = lexTokens noPos x++ in makeRule (if lhsNecLoc then _LHS else _LOC,attr)+ (Expression noPos tks)+ "self rule"+ ++++concatRE rsess = let (rss,ess) = unzip rsess+ in (concat rss, concatSeq ess)+++copyRule :: Identifier -> Identifier -> Bool -> Set Identifier -> (Map Identifier Identifier, (Identifier,[Identifier])) -> ([Rule], Seq Error)+copyRule nt con modcopy locals (env,(fld,as)) + = concatRE (map copyRu as)+ + where + copyRu a+ = ( [ makeRule (fld,a) + (Expression noPos tks)+ (cruletxt sel)+ ]+ , err+ )+ + where + sel + | not modcopy + && Set.member a locals = Just _LOC+ | otherwise = Map.lookup a env++ (expr,err) + = case sel of+ Nothing -> ( missingRuleErrorExpr nt con fld a+ , Seq.single (MissingRule nt con fld a)+ )+ Just f + | f == _ACHILD -> ( fieldName a+ , Seq.single (deprecatedCopyRuleError nt con fld a)+ )+ | otherwise -> ( attrName f a+ , Seq.empty+ )+ + (tks,err')+ = case sel of+ Nothing -> ( [HsToken (missingRuleErrorExpr nt con fld a) noPos]+ , Seq.single (MissingRule nt con fld a)+ )+ Just f + | f == _ACHILD -> ( [AGLocal a noPos Nothing]+ , Seq.single (deprecatedCopyRuleError nt con fld a)+ )+ | otherwise -> ( [AGField f a noPos Nothing]+ , Seq.empty+ )++ cruletxt sel+ | local = "copy rule (from local)"+ | deprChild = "deprecated child copy"+ | Set.member a locals && nonlocal = "modified copy rule"+ | incoming && outgoing = "copy rule (chain)"+ | incoming = "copy rule (down)"+ | outgoing = "copy rule (up)"+ | otherwise = "copy rule (chain)"+ where outgoing = fld == _LHS+ incoming = maybe False (== _LHS) sel+ nonlocal = maybe False (/= _LOC) sel+ local = maybe False (== _LOC) sel+ deprChild = maybe False (== _ACHILD) sel++{- +multiRule replaces+ loc.(a,b) = e+by + loc.tup1 = e+ loc.(a,_) = @loc.tup1+ loc.(_,b) = @loc.tup1+It needs to thread a unique number for inventing names for the tuples.++It also works for nested tuples:+ loc.(a,(b,c)) = e+becomes+ loc.tup1 = e+ loc.(a,_) = @loc.tup1+ loc.(_,tup2) = @loc.tup1+ loc.(b,_) = @loc.tup2+ loc.(_,c) = @loc.tup2+-}++multiRule :: Rule -> Int -> ([Rule], Int) +multiRule (Rule pat expr owrt origin) uniq+ = let f :: (Pattern->Pattern) -> Expression -> Pattern -> Int -> (Pattern, ([Rule], Int))+ f w e (Product pos pats) n + = let freshName = Ident ("_tup" ++ show n) pos + freshExpr = Expression pos freshTks+ freshTks = [AGField _LOC freshName pos Nothing]+ freshPat = Alias _LOC freshName (Underscore pos) pats+ a = length pats - 1+ us b p = Product pos (replicate (a-b) (Underscore pos) ++ [p] ++ replicate b (Underscore pos))+ g :: Pattern -> ([Pattern],[Rule],Int) -> ([Pattern],[Rule],Int)+ g p (xs1,rs1,n1) = let (x2,(rs2,n2)) = f (us (length xs1)) freshExpr p n1+ in (x2:xs1, rs2++rs1, n2)+ (xs9,rs9,n9) = foldr g ([], [], n+1) pats+ in ( freshPat+ , ( Rule (w freshPat) e owrt origin : rs9+ , n9+ )+ )+ f w e p n + = ( p+ , ( [Rule (w p) e owrt origin]+ , n+ )+ )+ in snd (f id expr pat uniq)++-- Child -------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ con : ConstructorIdent+ cr : Bool+ nt : NontermIdent+ synthesized attributes:+ errors : Seq Error+ field : (Identifier,Type,Bool) + inherited : Attributes+ name : Identifier+ output : SELF+ synthesized : Attributes+ alternatives:+ alternative Child:+ child name : {Identifier}+ child tp : {Type}+ child inh : {Attributes}+ child syn : {Attributes}+ child higherOrder : {Bool}+ visit 0:+ local output : _+-}+-- cata+sem_Child :: Child ->+ T_Child+sem_Child (Child _name _tp _inh _syn _higherOrder) =+ (sem_Child_Child _name _tp _inh _syn _higherOrder)+-- semantic domain+newtype T_Child = T_Child (ConstructorIdent ->+ Bool ->+ NontermIdent ->+ ( (Seq Error),( (Identifier,Type,Bool) ),Attributes,Identifier,Child,Attributes))+data Inh_Child = Inh_Child {con_Inh_Child :: ConstructorIdent,cr_Inh_Child :: Bool,nt_Inh_Child :: NontermIdent}+data Syn_Child = Syn_Child {errors_Syn_Child :: Seq Error,field_Syn_Child :: (Identifier,Type,Bool) ,inherited_Syn_Child :: Attributes,name_Syn_Child :: Identifier,output_Syn_Child :: Child,synthesized_Syn_Child :: Attributes}+wrap_Child (T_Child sem) (Inh_Child _lhsIcon _lhsIcr _lhsInt) =+ (let ( _lhsOerrors,_lhsOfield,_lhsOinherited,_lhsOname,_lhsOoutput,_lhsOsynthesized) =+ (sem _lhsIcon _lhsIcr _lhsInt)+ in (Syn_Child _lhsOerrors _lhsOfield _lhsOinherited _lhsOname _lhsOoutput _lhsOsynthesized))+sem_Child_Child :: Identifier ->+ Type ->+ Attributes ->+ Attributes ->+ Bool ->+ T_Child+sem_Child_Child name_ tp_ inh_ syn_ higherOrder_ =+ (T_Child (\ _lhsIcon+ _lhsIcr+ _lhsInt ->+ (let _lhsOname :: Identifier+ _lhsOinherited :: Attributes+ _lhsOsynthesized :: Attributes+ _lhsOfield :: ( (Identifier,Type,Bool) )+ _lhsOerrors :: (Seq Error)+ _lhsOoutput :: Child+ -- "DefaultRules.ag"(line 140, column 11)+ _lhsOname =+ name_+ -- "DefaultRules.ag"(line 149, column 11)+ _lhsOinherited =+ inh_+ -- "DefaultRules.ag"(line 150, column 11)+ _lhsOsynthesized =+ syn_+ -- "DefaultRules.ag"(line 411, column 11)+ _lhsOfield =+ (name_,tp_,higherOrder_)+ -- use rule "DefaultRules.ag"(line 109, column 19)+ _lhsOerrors =+ Seq.empty+ -- self rule+ _output =+ Child name_ tp_ inh_ syn_ higherOrder_+ -- self rule+ _lhsOoutput =+ _output+ in ( _lhsOerrors,_lhsOfield,_lhsOinherited,_lhsOname,_lhsOoutput,_lhsOsynthesized))))+-- Children ----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ con : ConstructorIdent+ cr : Bool+ nt : NontermIdent+ synthesized attributes:+ errors : Seq Error+ fields : [(Identifier,Type,Bool)]+ inputs : [(Identifier, Attributes)]+ output : SELF+ outputs : [(Identifier, Attributes)]+ alternatives:+ alternative Cons:+ child hd : Child+ child tl : Children+ visit 0:+ local output : _+ alternative Nil:+ visit 0:+ local output : _+-}+-- 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 (ConstructorIdent ->+ Bool ->+ NontermIdent ->+ ( (Seq Error),([(Identifier,Type,Bool)]),([(Identifier, Attributes)]),Children,([(Identifier, Attributes)])))+data Inh_Children = Inh_Children {con_Inh_Children :: ConstructorIdent,cr_Inh_Children :: Bool,nt_Inh_Children :: NontermIdent}+data Syn_Children = Syn_Children {errors_Syn_Children :: Seq Error,fields_Syn_Children :: [(Identifier,Type,Bool)],inputs_Syn_Children :: [(Identifier, Attributes)],output_Syn_Children :: Children,outputs_Syn_Children :: [(Identifier, Attributes)]}+wrap_Children (T_Children sem) (Inh_Children _lhsIcon _lhsIcr _lhsInt) =+ (let ( _lhsOerrors,_lhsOfields,_lhsOinputs,_lhsOoutput,_lhsOoutputs) =+ (sem _lhsIcon _lhsIcr _lhsInt)+ in (Syn_Children _lhsOerrors _lhsOfields _lhsOinputs _lhsOoutput _lhsOoutputs))+sem_Children_Cons :: T_Child ->+ T_Children ->+ T_Children+sem_Children_Cons (T_Child hd_) (T_Children tl_) =+ (T_Children (\ _lhsIcon+ _lhsIcr+ _lhsInt ->+ (let _lhsOinputs :: ([(Identifier, Attributes)])+ _lhsOoutputs :: ([(Identifier, Attributes)])+ _lhsOfields :: ([(Identifier,Type,Bool)])+ _lhsOerrors :: (Seq Error)+ _lhsOoutput :: Children+ _hdOcon :: ConstructorIdent+ _hdOcr :: Bool+ _hdOnt :: NontermIdent+ _tlOcon :: ConstructorIdent+ _tlOcr :: Bool+ _tlOnt :: NontermIdent+ _hdIerrors :: (Seq Error)+ _hdIfield :: ( (Identifier,Type,Bool) )+ _hdIinherited :: Attributes+ _hdIname :: Identifier+ _hdIoutput :: Child+ _hdIsynthesized :: Attributes+ _tlIerrors :: (Seq Error)+ _tlIfields :: ([(Identifier,Type,Bool)])+ _tlIinputs :: ([(Identifier, Attributes)])+ _tlIoutput :: Children+ _tlIoutputs :: ([(Identifier, Attributes)])+ -- "DefaultRules.ag"(line 153, column 10)+ _lhsOinputs =+ (_hdIname, _hdIinherited) : _tlIinputs+ -- "DefaultRules.ag"(line 153, column 10)+ _lhsOoutputs =+ (_hdIname, _hdIsynthesized) : _tlIoutputs+ -- "DefaultRules.ag"(line 407, column 10)+ _lhsOfields =+ _hdIfield : _tlIfields+ -- use rule "DefaultRules.ag"(line 109, column 19)+ _lhsOerrors =+ _hdIerrors Seq.<> _tlIerrors+ -- self rule+ _output =+ (:) _hdIoutput _tlIoutput+ -- self rule+ _lhsOoutput =+ _output+ -- copy rule (down)+ _hdOcon =+ _lhsIcon+ -- copy rule (down)+ _hdOcr =+ _lhsIcr+ -- copy rule (down)+ _hdOnt =+ _lhsInt+ -- copy rule (down)+ _tlOcon =+ _lhsIcon+ -- copy rule (down)+ _tlOcr =+ _lhsIcr+ -- copy rule (down)+ _tlOnt =+ _lhsInt+ ( _hdIerrors,_hdIfield,_hdIinherited,_hdIname,_hdIoutput,_hdIsynthesized) =+ (hd_ _hdOcon _hdOcr _hdOnt)+ ( _tlIerrors,_tlIfields,_tlIinputs,_tlIoutput,_tlIoutputs) =+ (tl_ _tlOcon _tlOcr _tlOnt)+ in ( _lhsOerrors,_lhsOfields,_lhsOinputs,_lhsOoutput,_lhsOoutputs))))+sem_Children_Nil :: T_Children+sem_Children_Nil =+ (T_Children (\ _lhsIcon+ _lhsIcr+ _lhsInt ->+ (let _lhsOinputs :: ([(Identifier, Attributes)])+ _lhsOoutputs :: ([(Identifier, Attributes)])+ _lhsOfields :: ([(Identifier,Type,Bool)])+ _lhsOerrors :: (Seq Error)+ _lhsOoutput :: Children+ -- "DefaultRules.ag"(line 155, column 10)+ _lhsOinputs =+ []+ -- "DefaultRules.ag"(line 155, column 10)+ _lhsOoutputs =+ []+ -- "DefaultRules.ag"(line 408, column 10)+ _lhsOfields =+ []+ -- use rule "DefaultRules.ag"(line 109, column 19)+ _lhsOerrors =+ Seq.empty+ -- self rule+ _output =+ []+ -- self rule+ _lhsOoutput =+ _output+ in ( _lhsOerrors,_lhsOfields,_lhsOinputs,_lhsOoutput,_lhsOoutputs))))+-- Grammar -----------------------------------------------------+{-+ visit 0:+ inherited attribute:+ options : Options+ synthesized attributes:+ errors : Seq Error+ output : SELF+ 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}+ visit 0:+ local output : _+-}+-- cata+sem_Grammar :: Grammar ->+ T_Grammar+sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap) =+ (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts) _pragmas _manualAttrOrderMap _paramMap _contextMap)+-- semantic domain+newtype T_Grammar = T_Grammar (Options ->+ ( (Seq Error),Grammar))+data Inh_Grammar = Inh_Grammar {options_Inh_Grammar :: Options}+data Syn_Grammar = Syn_Grammar {errors_Syn_Grammar :: Seq Error,output_Syn_Grammar :: Grammar}+wrap_Grammar (T_Grammar sem) (Inh_Grammar _lhsIoptions) =+ (let ( _lhsOerrors,_lhsOoutput) =+ (sem _lhsIoptions)+ in (Syn_Grammar _lhsOerrors _lhsOoutput))+sem_Grammar_Grammar :: TypeSyns ->+ UseMap ->+ Derivings ->+ (Set NontermIdent) ->+ T_Nonterminals ->+ PragmaMap ->+ AttrOrderMap ->+ ParamMap ->+ ContextMap ->+ T_Grammar+sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ =+ (T_Grammar (\ _lhsIoptions ->+ (let _nontsOo_rename :: Bool+ _nontsOcr :: Bool+ _nontsOnonterminals :: (Set NontermIdent)+ _nontsOuseMap :: UseMap+ _nontsOtypeSyns :: TypeSyns+ _nontsOuniq :: Int+ _nontsOmanualAttrOrderMap :: AttrOrderMap+ _lhsOerrors :: (Seq Error)+ _lhsOoutput :: Grammar+ _nontsIcollect_nts :: (Set NontermIdent)+ _nontsIerrors :: (Seq Error)+ _nontsIoutput :: Nonterminals+ _nontsIuniq :: Int+ -- "DefaultRules.ag"(line 43, column 17)+ _nontsOo_rename =+ rename _lhsIoptions+ -- "DefaultRules.ag"(line 44, column 17)+ _nontsOcr =+ modcopy _lhsIoptions+ -- "DefaultRules.ag"(line 121, column 13)+ _nontsOnonterminals =+ _nontsIcollect_nts+ -- "DefaultRules.ag"(line 142, column 13)+ _nontsOuseMap =+ useMap_+ -- "DefaultRules.ag"(line 144, column 13)+ _nontsOtypeSyns =+ typeSyns_+ -- "DefaultRules.ag"(line 428, column 13)+ _nontsOuniq =+ 1+ -- "DefaultRules.ag"(line 505, column 7)+ _nontsOmanualAttrOrderMap =+ manualAttrOrderMap_+ -- use rule "DefaultRules.ag"(line 109, column 19)+ _lhsOerrors =+ _nontsIerrors+ -- self rule+ _output =+ Grammar typeSyns_ useMap_ derivings_ wrappers_ _nontsIoutput pragmas_ manualAttrOrderMap_ paramMap_ contextMap_+ -- self rule+ _lhsOoutput =+ _output+ ( _nontsIcollect_nts,_nontsIerrors,_nontsIoutput,_nontsIuniq) =+ (nonts_ _nontsOcr _nontsOmanualAttrOrderMap _nontsOnonterminals _nontsOo_rename _nontsOtypeSyns _nontsOuniq _nontsOuseMap)+ in ( _lhsOerrors,_lhsOoutput))))+-- Nonterminal -------------------------------------------------+{-+ visit 0:+ inherited attributes:+ cr : Bool+ manualAttrOrderMap : AttrOrderMap+ nonterminals : Set NontermIdent+ o_rename : Bool+ typeSyns : TypeSyns+ useMap : UseMap+ chained attribute:+ uniq : Int+ synthesized attributes:+ collect_nts : Set NontermIdent+ errors : Seq Error+ output : SELF+ alternatives:+ alternative Nonterminal:+ child nt : {NontermIdent}+ child params : {[Identifier]}+ child inh : {Attributes}+ child syn : {Attributes}+ child prods : Productions+ visit 0:+ local output : _+-}+-- 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 (Bool ->+ AttrOrderMap ->+ (Set NontermIdent) ->+ Bool ->+ TypeSyns ->+ Int ->+ UseMap ->+ ( (Set NontermIdent),(Seq Error),Nonterminal,Int))+data Inh_Nonterminal = Inh_Nonterminal {cr_Inh_Nonterminal :: Bool,manualAttrOrderMap_Inh_Nonterminal :: AttrOrderMap,nonterminals_Inh_Nonterminal :: Set NontermIdent,o_rename_Inh_Nonterminal :: Bool,typeSyns_Inh_Nonterminal :: TypeSyns,uniq_Inh_Nonterminal :: Int,useMap_Inh_Nonterminal :: UseMap}+data Syn_Nonterminal = Syn_Nonterminal {collect_nts_Syn_Nonterminal :: Set NontermIdent,errors_Syn_Nonterminal :: Seq Error,output_Syn_Nonterminal :: Nonterminal,uniq_Syn_Nonterminal :: Int}+wrap_Nonterminal (T_Nonterminal sem) (Inh_Nonterminal _lhsIcr _lhsImanualAttrOrderMap _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap) =+ (let ( _lhsOcollect_nts,_lhsOerrors,_lhsOoutput,_lhsOuniq) =+ (sem _lhsIcr _lhsImanualAttrOrderMap _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap)+ in (Syn_Nonterminal _lhsOcollect_nts _lhsOerrors _lhsOoutput _lhsOuniq))+sem_Nonterminal_Nonterminal :: NontermIdent ->+ ([Identifier]) ->+ Attributes ->+ Attributes ->+ T_Productions ->+ T_Nonterminal+sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ (T_Productions prods_) =+ (T_Nonterminal (\ _lhsIcr+ _lhsImanualAttrOrderMap+ _lhsInonterminals+ _lhsIo_rename+ _lhsItypeSyns+ _lhsIuniq+ _lhsIuseMap ->+ (let _lhsOcollect_nts :: (Set NontermIdent)+ _prodsOinh :: Attributes+ _prodsOsyn :: Attributes+ _prodsOuseMap :: (Map Identifier (String,String,String))+ _prodsOnt :: NontermIdent+ _lhsOerrors :: (Seq Error)+ _lhsOoutput :: Nonterminal+ _lhsOuniq :: Int+ _prodsOcr :: Bool+ _prodsOmanualAttrOrderMap :: AttrOrderMap+ _prodsOnonterminals :: (Set NontermIdent)+ _prodsOo_rename :: Bool+ _prodsOtypeSyns :: TypeSyns+ _prodsOuniq :: Int+ _prodsIerrors :: (Seq Error)+ _prodsIoutput :: Productions+ _prodsIuniq :: Int+ -- "DefaultRules.ag"(line 117, column 17)+ _lhsOcollect_nts =+ Set.singleton nt_+ -- "DefaultRules.ag"(line 132, column 18)+ _prodsOinh =+ inh_+ -- "DefaultRules.ag"(line 133, column 18)+ _prodsOsyn =+ syn_+ -- "DefaultRules.ag"(line 134, column 18)+ _prodsOuseMap =+ Map.findWithDefault Map.empty nt_ _lhsIuseMap+ -- "DefaultRules.ag"(line 146, column 17)+ _prodsOnt =+ nt_+ -- use rule "DefaultRules.ag"(line 109, column 19)+ _lhsOerrors =+ _prodsIerrors+ -- self rule+ _output =+ Nonterminal nt_ params_ inh_ syn_ _prodsIoutput+ -- self rule+ _lhsOoutput =+ _output+ -- copy rule (up)+ _lhsOuniq =+ _prodsIuniq+ -- copy rule (down)+ _prodsOcr =+ _lhsIcr+ -- copy rule (down)+ _prodsOmanualAttrOrderMap =+ _lhsImanualAttrOrderMap+ -- copy rule (down)+ _prodsOnonterminals =+ _lhsInonterminals+ -- copy rule (down)+ _prodsOo_rename =+ _lhsIo_rename+ -- copy rule (down)+ _prodsOtypeSyns =+ _lhsItypeSyns+ -- copy rule (down)+ _prodsOuniq =+ _lhsIuniq+ ( _prodsIerrors,_prodsIoutput,_prodsIuniq) =+ (prods_ _prodsOcr _prodsOinh _prodsOmanualAttrOrderMap _prodsOnonterminals _prodsOnt _prodsOo_rename _prodsOsyn _prodsOtypeSyns _prodsOuniq _prodsOuseMap)+ in ( _lhsOcollect_nts,_lhsOerrors,_lhsOoutput,_lhsOuniq))))+-- Nonterminals ------------------------------------------------+{-+ visit 0:+ inherited attributes:+ cr : Bool+ manualAttrOrderMap : AttrOrderMap+ nonterminals : Set NontermIdent+ o_rename : Bool+ typeSyns : TypeSyns+ useMap : UseMap+ chained attribute:+ uniq : Int+ synthesized attributes:+ collect_nts : Set NontermIdent+ errors : Seq Error+ output : SELF+ alternatives:+ alternative Cons:+ child hd : Nonterminal+ child tl : Nonterminals+ visit 0:+ local output : _+ alternative Nil:+ visit 0:+ local output : _+-}+-- 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 (Bool ->+ AttrOrderMap ->+ (Set NontermIdent) ->+ Bool ->+ TypeSyns ->+ Int ->+ UseMap ->+ ( (Set NontermIdent),(Seq Error),Nonterminals,Int))+data Inh_Nonterminals = Inh_Nonterminals {cr_Inh_Nonterminals :: Bool,manualAttrOrderMap_Inh_Nonterminals :: AttrOrderMap,nonterminals_Inh_Nonterminals :: Set NontermIdent,o_rename_Inh_Nonterminals :: Bool,typeSyns_Inh_Nonterminals :: TypeSyns,uniq_Inh_Nonterminals :: Int,useMap_Inh_Nonterminals :: UseMap}+data Syn_Nonterminals = Syn_Nonterminals {collect_nts_Syn_Nonterminals :: Set NontermIdent,errors_Syn_Nonterminals :: Seq Error,output_Syn_Nonterminals :: Nonterminals,uniq_Syn_Nonterminals :: Int}+wrap_Nonterminals (T_Nonterminals sem) (Inh_Nonterminals _lhsIcr _lhsImanualAttrOrderMap _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap) =+ (let ( _lhsOcollect_nts,_lhsOerrors,_lhsOoutput,_lhsOuniq) =+ (sem _lhsIcr _lhsImanualAttrOrderMap _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap)+ in (Syn_Nonterminals _lhsOcollect_nts _lhsOerrors _lhsOoutput _lhsOuniq))+sem_Nonterminals_Cons :: T_Nonterminal ->+ T_Nonterminals ->+ T_Nonterminals+sem_Nonterminals_Cons (T_Nonterminal hd_) (T_Nonterminals tl_) =+ (T_Nonterminals (\ _lhsIcr+ _lhsImanualAttrOrderMap+ _lhsInonterminals+ _lhsIo_rename+ _lhsItypeSyns+ _lhsIuniq+ _lhsIuseMap ->+ (let _lhsOcollect_nts :: (Set NontermIdent)+ _lhsOerrors :: (Seq Error)+ _lhsOoutput :: Nonterminals+ _lhsOuniq :: Int+ _hdOcr :: Bool+ _hdOmanualAttrOrderMap :: AttrOrderMap+ _hdOnonterminals :: (Set NontermIdent)+ _hdOo_rename :: Bool+ _hdOtypeSyns :: TypeSyns+ _hdOuniq :: Int+ _hdOuseMap :: UseMap+ _tlOcr :: Bool+ _tlOmanualAttrOrderMap :: AttrOrderMap+ _tlOnonterminals :: (Set NontermIdent)+ _tlOo_rename :: Bool+ _tlOtypeSyns :: TypeSyns+ _tlOuniq :: Int+ _tlOuseMap :: UseMap+ _hdIcollect_nts :: (Set NontermIdent)+ _hdIerrors :: (Seq Error)+ _hdIoutput :: Nonterminal+ _hdIuniq :: Int+ _tlIcollect_nts :: (Set NontermIdent)+ _tlIerrors :: (Seq Error)+ _tlIoutput :: Nonterminals+ _tlIuniq :: Int+ -- use rule "DefaultRules.ag"(line 115, column 49)+ _lhsOcollect_nts =+ _hdIcollect_nts `Set.union` _tlIcollect_nts+ -- use rule "DefaultRules.ag"(line 109, column 19)+ _lhsOerrors =+ _hdIerrors Seq.<> _tlIerrors+ -- self rule+ _output =+ (:) _hdIoutput _tlIoutput+ -- self rule+ _lhsOoutput =+ _output+ -- copy rule (up)+ _lhsOuniq =+ _tlIuniq+ -- copy rule (down)+ _hdOcr =+ _lhsIcr+ -- copy rule (down)+ _hdOmanualAttrOrderMap =+ _lhsImanualAttrOrderMap+ -- copy rule (down)+ _hdOnonterminals =+ _lhsInonterminals+ -- copy rule (down)+ _hdOo_rename =+ _lhsIo_rename+ -- copy rule (down)+ _hdOtypeSyns =+ _lhsItypeSyns+ -- copy rule (down)+ _hdOuniq =+ _lhsIuniq+ -- copy rule (down)+ _hdOuseMap =+ _lhsIuseMap+ -- copy rule (down)+ _tlOcr =+ _lhsIcr+ -- copy rule (down)+ _tlOmanualAttrOrderMap =+ _lhsImanualAttrOrderMap+ -- copy rule (down)+ _tlOnonterminals =+ _lhsInonterminals+ -- copy rule (down)+ _tlOo_rename =+ _lhsIo_rename+ -- copy rule (down)+ _tlOtypeSyns =+ _lhsItypeSyns+ -- copy rule (chain)+ _tlOuniq =+ _hdIuniq+ -- copy rule (down)+ _tlOuseMap =+ _lhsIuseMap+ ( _hdIcollect_nts,_hdIerrors,_hdIoutput,_hdIuniq) =+ (hd_ _hdOcr _hdOmanualAttrOrderMap _hdOnonterminals _hdOo_rename _hdOtypeSyns _hdOuniq _hdOuseMap)+ ( _tlIcollect_nts,_tlIerrors,_tlIoutput,_tlIuniq) =+ (tl_ _tlOcr _tlOmanualAttrOrderMap _tlOnonterminals _tlOo_rename _tlOtypeSyns _tlOuniq _tlOuseMap)+ in ( _lhsOcollect_nts,_lhsOerrors,_lhsOoutput,_lhsOuniq))))+sem_Nonterminals_Nil :: T_Nonterminals+sem_Nonterminals_Nil =+ (T_Nonterminals (\ _lhsIcr+ _lhsImanualAttrOrderMap+ _lhsInonterminals+ _lhsIo_rename+ _lhsItypeSyns+ _lhsIuniq+ _lhsIuseMap ->+ (let _lhsOcollect_nts :: (Set NontermIdent)+ _lhsOerrors :: (Seq Error)+ _lhsOoutput :: Nonterminals+ _lhsOuniq :: Int+ -- use rule "DefaultRules.ag"(line 115, column 49)+ _lhsOcollect_nts =+ Set.empty+ -- use rule "DefaultRules.ag"(line 109, column 19)+ _lhsOerrors =+ Seq.empty+ -- self rule+ _output =+ []+ -- self rule+ _lhsOoutput =+ _output+ -- copy rule (chain)+ _lhsOuniq =+ _lhsIuniq+ in ( _lhsOcollect_nts,_lhsOerrors,_lhsOoutput,_lhsOuniq))))+-- Pattern -----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ con : ConstructorIdent+ nt : NontermIdent+ synthesized attributes:+ containsVars : Bool+ copy : SELF+ definedAttrs : Set (Identifier,Identifier)+ errors : Seq Error+ locals : Set Identifier+ output : SELF+ alternatives:+ alternative Alias:+ child field : {Identifier}+ child attr : {Identifier}+ child pat : Pattern+ child parts : Patterns+ visit 0:+ local copy : _+ local output : _+ alternative Constr:+ child name : {ConstructorIdent}+ child pats : Patterns+ visit 0:+ local copy : _+ local output : _+ alternative Irrefutable:+ child pat : Pattern+ visit 0:+ local copy : _+ local output : _+ alternative Product:+ child pos : {Pos}+ child pats : Patterns+ visit 0:+ local copy : _+ local output : _+ alternative Underscore:+ child pos : {Pos}+ visit 0:+ local copy : _+ local output : _+-}+-- 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 (ConstructorIdent ->+ NontermIdent ->+ ( Bool,Pattern,(Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Pattern))+data Inh_Pattern = Inh_Pattern {con_Inh_Pattern :: ConstructorIdent,nt_Inh_Pattern :: NontermIdent}+data Syn_Pattern = Syn_Pattern {containsVars_Syn_Pattern :: Bool,copy_Syn_Pattern :: Pattern,definedAttrs_Syn_Pattern :: Set (Identifier,Identifier),errors_Syn_Pattern :: Seq Error,locals_Syn_Pattern :: Set Identifier,output_Syn_Pattern :: Pattern}+wrap_Pattern (T_Pattern sem) (Inh_Pattern _lhsIcon _lhsInt) =+ (let ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) =+ (sem _lhsIcon _lhsInt)+ in (Syn_Pattern _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput))+sem_Pattern_Alias :: Identifier ->+ Identifier ->+ T_Pattern ->+ T_Patterns ->+ T_Pattern+sem_Pattern_Alias field_ attr_ (T_Pattern pat_) (T_Patterns parts_) =+ (T_Pattern (\ _lhsIcon+ _lhsInt ->+ (let _lhsOdefinedAttrs :: (Set (Identifier,Identifier))+ _lhsOlocals :: (Set Identifier)+ _lhsOcontainsVars :: Bool+ _lhsOerrors :: (Seq Error)+ _lhsOcopy :: Pattern+ _lhsOoutput :: Pattern+ _patOcon :: ConstructorIdent+ _patOnt :: NontermIdent+ _partsOcon :: ConstructorIdent+ _partsOnt :: NontermIdent+ _patIcontainsVars :: Bool+ _patIcopy :: Pattern+ _patIdefinedAttrs :: (Set (Identifier,Identifier))+ _patIerrors :: (Seq Error)+ _patIlocals :: (Set Identifier)+ _patIoutput :: Pattern+ _partsIcontainsVars :: Bool+ _partsIcopy :: Patterns+ _partsIdefinedAttrs :: (Set (Identifier,Identifier))+ _partsIerrors :: (Seq Error)+ _partsIlocals :: (Set Identifier)+ _partsIoutput :: Patterns+ -- "DefaultRules.ag"(line 401, column 11)+ _lhsOdefinedAttrs =+ Set.insert (field_,attr_) _patIdefinedAttrs+ -- "DefaultRules.ag"(line 401, column 11)+ _lhsOlocals =+ if field_ == _LOC+ then Set.insert attr_ _patIlocals+ else _patIlocals+ -- "DefaultRules.ag"(line 419, column 16)+ _lhsOcontainsVars =+ True+ -- use rule "DefaultRules.ag"(line 109, column 19)+ _lhsOerrors =+ _patIerrors Seq.<> _partsIerrors+ -- self rule+ _copy =+ Alias field_ attr_ _patIcopy _partsIcopy+ -- self rule+ _output =+ Alias field_ attr_ _patIoutput _partsIoutput+ -- self rule+ _lhsOcopy =+ _copy+ -- self rule+ _lhsOoutput =+ _output+ -- copy rule (down)+ _patOcon =+ _lhsIcon+ -- copy rule (down)+ _patOnt =+ _lhsInt+ -- copy rule (down)+ _partsOcon =+ _lhsIcon+ -- copy rule (down)+ _partsOnt =+ _lhsInt+ ( _patIcontainsVars,_patIcopy,_patIdefinedAttrs,_patIerrors,_patIlocals,_patIoutput) =+ (pat_ _patOcon _patOnt)+ ( _partsIcontainsVars,_partsIcopy,_partsIdefinedAttrs,_partsIerrors,_partsIlocals,_partsIoutput) =+ (parts_ _partsOcon _partsOnt)+ in ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput))))+sem_Pattern_Constr :: ConstructorIdent ->+ T_Patterns ->+ T_Pattern+sem_Pattern_Constr name_ (T_Patterns pats_) =+ (T_Pattern (\ _lhsIcon+ _lhsInt ->+ (let _lhsOcontainsVars :: Bool+ _lhsOdefinedAttrs :: (Set (Identifier,Identifier))+ _lhsOerrors :: (Seq Error)+ _lhsOlocals :: (Set Identifier)+ _lhsOcopy :: Pattern+ _lhsOoutput :: Pattern+ _patsOcon :: ConstructorIdent+ _patsOnt :: NontermIdent+ _patsIcontainsVars :: Bool+ _patsIcopy :: Patterns+ _patsIdefinedAttrs :: (Set (Identifier,Identifier))+ _patsIerrors :: (Seq Error)+ _patsIlocals :: (Set Identifier)+ _patsIoutput :: Patterns+ -- use rule "DefaultRules.ag"(line 416, column 46)+ _lhsOcontainsVars =+ _patsIcontainsVars+ -- use rule "DefaultRules.ag"(line 396, column 23)+ _lhsOdefinedAttrs =+ _patsIdefinedAttrs+ -- use rule "DefaultRules.ag"(line 109, column 19)+ _lhsOerrors =+ _patsIerrors+ -- use rule "DefaultRules.ag"(line 395, column 23)+ _lhsOlocals =+ _patsIlocals+ -- self rule+ _copy =+ Constr name_ _patsIcopy+ -- self rule+ _output =+ Constr name_ _patsIoutput+ -- self rule+ _lhsOcopy =+ _copy+ -- self rule+ _lhsOoutput =+ _output+ -- copy rule (down)+ _patsOcon =+ _lhsIcon+ -- copy rule (down)+ _patsOnt =+ _lhsInt+ ( _patsIcontainsVars,_patsIcopy,_patsIdefinedAttrs,_patsIerrors,_patsIlocals,_patsIoutput) =+ (pats_ _patsOcon _patsOnt)+ in ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput))))+sem_Pattern_Irrefutable :: T_Pattern ->+ T_Pattern+sem_Pattern_Irrefutable (T_Pattern pat_) =+ (T_Pattern (\ _lhsIcon+ _lhsInt ->+ (let _lhsOcontainsVars :: Bool+ _lhsOdefinedAttrs :: (Set (Identifier,Identifier))+ _lhsOerrors :: (Seq Error)+ _lhsOlocals :: (Set Identifier)+ _lhsOcopy :: Pattern+ _lhsOoutput :: Pattern+ _patOcon :: ConstructorIdent+ _patOnt :: NontermIdent+ _patIcontainsVars :: Bool+ _patIcopy :: Pattern+ _patIdefinedAttrs :: (Set (Identifier,Identifier))+ _patIerrors :: (Seq Error)+ _patIlocals :: (Set Identifier)+ _patIoutput :: Pattern+ -- use rule "DefaultRules.ag"(line 416, column 46)+ _lhsOcontainsVars =+ _patIcontainsVars+ -- use rule "DefaultRules.ag"(line 396, column 23)+ _lhsOdefinedAttrs =+ _patIdefinedAttrs+ -- use rule "DefaultRules.ag"(line 109, column 19)+ _lhsOerrors =+ _patIerrors+ -- use rule "DefaultRules.ag"(line 395, column 23)+ _lhsOlocals =+ _patIlocals+ -- self rule+ _copy =+ Irrefutable _patIcopy+ -- self rule+ _output =+ Irrefutable _patIoutput+ -- self rule+ _lhsOcopy =+ _copy+ -- self rule+ _lhsOoutput =+ _output+ -- copy rule (down)+ _patOcon =+ _lhsIcon+ -- copy rule (down)+ _patOnt =+ _lhsInt+ ( _patIcontainsVars,_patIcopy,_patIdefinedAttrs,_patIerrors,_patIlocals,_patIoutput) =+ (pat_ _patOcon _patOnt)+ in ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput))))+sem_Pattern_Product :: Pos ->+ T_Patterns ->+ T_Pattern+sem_Pattern_Product pos_ (T_Patterns pats_) =+ (T_Pattern (\ _lhsIcon+ _lhsInt ->+ (let _lhsOcontainsVars :: Bool+ _lhsOdefinedAttrs :: (Set (Identifier,Identifier))+ _lhsOerrors :: (Seq Error)+ _lhsOlocals :: (Set Identifier)+ _lhsOcopy :: Pattern+ _lhsOoutput :: Pattern+ _patsOcon :: ConstructorIdent+ _patsOnt :: NontermIdent+ _patsIcontainsVars :: Bool+ _patsIcopy :: Patterns+ _patsIdefinedAttrs :: (Set (Identifier,Identifier))+ _patsIerrors :: (Seq Error)+ _patsIlocals :: (Set Identifier)+ _patsIoutput :: Patterns+ -- use rule "DefaultRules.ag"(line 416, column 46)+ _lhsOcontainsVars =+ _patsIcontainsVars+ -- use rule "DefaultRules.ag"(line 396, column 23)+ _lhsOdefinedAttrs =+ _patsIdefinedAttrs+ -- use rule "DefaultRules.ag"(line 109, column 19)+ _lhsOerrors =+ _patsIerrors+ -- use rule "DefaultRules.ag"(line 395, column 23)+ _lhsOlocals =+ _patsIlocals+ -- self rule+ _copy =+ Product pos_ _patsIcopy+ -- self rule+ _output =+ Product pos_ _patsIoutput+ -- self rule+ _lhsOcopy =+ _copy+ -- self rule+ _lhsOoutput =+ _output+ -- copy rule (down)+ _patsOcon =+ _lhsIcon+ -- copy rule (down)+ _patsOnt =+ _lhsInt+ ( _patsIcontainsVars,_patsIcopy,_patsIdefinedAttrs,_patsIerrors,_patsIlocals,_patsIoutput) =+ (pats_ _patsOcon _patsOnt)+ in ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput))))+sem_Pattern_Underscore :: Pos ->+ T_Pattern+sem_Pattern_Underscore pos_ =+ (T_Pattern (\ _lhsIcon+ _lhsInt ->+ (let _lhsOcontainsVars :: Bool+ _lhsOdefinedAttrs :: (Set (Identifier,Identifier))+ _lhsOerrors :: (Seq Error)+ _lhsOlocals :: (Set Identifier)+ _lhsOcopy :: Pattern+ _lhsOoutput :: Pattern+ -- use rule "DefaultRules.ag"(line 416, column 46)+ _lhsOcontainsVars =+ False+ -- use rule "DefaultRules.ag"(line 396, column 23)+ _lhsOdefinedAttrs =+ Set.empty+ -- use rule "DefaultRules.ag"(line 109, column 19)+ _lhsOerrors =+ Seq.empty+ -- use rule "DefaultRules.ag"(line 395, column 23)+ _lhsOlocals =+ Set.empty+ -- self rule+ _copy =+ Underscore pos_+ -- self rule+ _output =+ Underscore pos_+ -- self rule+ _lhsOcopy =+ _copy+ -- self rule+ _lhsOoutput =+ _output+ in ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput))))+-- Patterns ----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ con : ConstructorIdent+ nt : NontermIdent+ synthesized attributes:+ containsVars : Bool+ copy : SELF+ definedAttrs : Set (Identifier,Identifier)+ errors : Seq Error+ locals : Set Identifier+ output : SELF+ alternatives:+ alternative Cons:+ child hd : Pattern+ child tl : Patterns+ visit 0:+ local copy : _+ local output : _+ alternative Nil:+ visit 0:+ local copy : _+ local output : _+-}+-- 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 (ConstructorIdent ->+ NontermIdent ->+ ( Bool,Patterns,(Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Patterns))+data Inh_Patterns = Inh_Patterns {con_Inh_Patterns :: ConstructorIdent,nt_Inh_Patterns :: NontermIdent}+data Syn_Patterns = Syn_Patterns {containsVars_Syn_Patterns :: Bool,copy_Syn_Patterns :: Patterns,definedAttrs_Syn_Patterns :: Set (Identifier,Identifier),errors_Syn_Patterns :: Seq Error,locals_Syn_Patterns :: Set Identifier,output_Syn_Patterns :: Patterns}+wrap_Patterns (T_Patterns sem) (Inh_Patterns _lhsIcon _lhsInt) =+ (let ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) =+ (sem _lhsIcon _lhsInt)+ in (Syn_Patterns _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput))+sem_Patterns_Cons :: T_Pattern ->+ T_Patterns ->+ T_Patterns+sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) =+ (T_Patterns (\ _lhsIcon+ _lhsInt ->+ (let _lhsOcontainsVars :: Bool+ _lhsOdefinedAttrs :: (Set (Identifier,Identifier))+ _lhsOerrors :: (Seq Error)+ _lhsOlocals :: (Set Identifier)+ _lhsOcopy :: Patterns+ _lhsOoutput :: Patterns+ _hdOcon :: ConstructorIdent+ _hdOnt :: NontermIdent+ _tlOcon :: ConstructorIdent+ _tlOnt :: NontermIdent+ _hdIcontainsVars :: Bool+ _hdIcopy :: Pattern+ _hdIdefinedAttrs :: (Set (Identifier,Identifier))+ _hdIerrors :: (Seq Error)+ _hdIlocals :: (Set Identifier)+ _hdIoutput :: Pattern+ _tlIcontainsVars :: Bool+ _tlIcopy :: Patterns+ _tlIdefinedAttrs :: (Set (Identifier,Identifier))+ _tlIerrors :: (Seq Error)+ _tlIlocals :: (Set Identifier)+ _tlIoutput :: Patterns+ -- use rule "DefaultRules.ag"(line 416, column 46)+ _lhsOcontainsVars =+ _hdIcontainsVars || _tlIcontainsVars+ -- use rule "DefaultRules.ag"(line 396, column 23)+ _lhsOdefinedAttrs =+ _hdIdefinedAttrs `Set.union` _tlIdefinedAttrs+ -- use rule "DefaultRules.ag"(line 109, column 19)+ _lhsOerrors =+ _hdIerrors Seq.<> _tlIerrors+ -- use rule "DefaultRules.ag"(line 395, column 23)+ _lhsOlocals =+ _hdIlocals `Set.union` _tlIlocals+ -- self rule+ _copy =+ (:) _hdIcopy _tlIcopy+ -- self rule+ _output =+ (:) _hdIoutput _tlIoutput+ -- self rule+ _lhsOcopy =+ _copy+ -- self rule+ _lhsOoutput =+ _output+ -- copy rule (down)+ _hdOcon =+ _lhsIcon+ -- copy rule (down)+ _hdOnt =+ _lhsInt+ -- copy rule (down)+ _tlOcon =+ _lhsIcon+ -- copy rule (down)+ _tlOnt =+ _lhsInt+ ( _hdIcontainsVars,_hdIcopy,_hdIdefinedAttrs,_hdIerrors,_hdIlocals,_hdIoutput) =+ (hd_ _hdOcon _hdOnt)+ ( _tlIcontainsVars,_tlIcopy,_tlIdefinedAttrs,_tlIerrors,_tlIlocals,_tlIoutput) =+ (tl_ _tlOcon _tlOnt)+ in ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput))))+sem_Patterns_Nil :: T_Patterns+sem_Patterns_Nil =+ (T_Patterns (\ _lhsIcon+ _lhsInt ->+ (let _lhsOcontainsVars :: Bool+ _lhsOdefinedAttrs :: (Set (Identifier,Identifier))+ _lhsOerrors :: (Seq Error)+ _lhsOlocals :: (Set Identifier)+ _lhsOcopy :: Patterns+ _lhsOoutput :: Patterns+ -- use rule "DefaultRules.ag"(line 416, column 46)+ _lhsOcontainsVars =+ False+ -- use rule "DefaultRules.ag"(line 396, column 23)+ _lhsOdefinedAttrs =+ Set.empty+ -- use rule "DefaultRules.ag"(line 109, column 19)+ _lhsOerrors =+ Seq.empty+ -- use rule "DefaultRules.ag"(line 395, column 23)+ _lhsOlocals =+ Set.empty+ -- self rule+ _copy =+ []+ -- self rule+ _output =+ []+ -- self rule+ _lhsOcopy =+ _copy+ -- self rule+ _lhsOoutput =+ _output+ in ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput))))+-- Production --------------------------------------------------+{-+ visit 0:+ inherited attributes:+ cr : Bool+ inh : Attributes+ manualAttrOrderMap : AttrOrderMap+ nonterminals : Set NontermIdent+ nt : NontermIdent+ o_rename : Bool+ syn : Attributes+ typeSyns : TypeSyns+ useMap : Map Identifier (String,String,String)+ chained attribute:+ uniq : Int+ synthesized attributes:+ errors : Seq Error+ output : SELF+ alternatives:+ alternative Production:+ child con : {ConstructorIdent}+ child children : Children+ child rules : Rules+ child typeSigs : TypeSigs+ visit 0:+ local _tup1 : _+ local newRls : _+ local errs : _+ local orderDeps : _+ local orderErrs : _+ local output : _+-}+-- 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 (Bool ->+ Attributes ->+ AttrOrderMap ->+ (Set NontermIdent) ->+ NontermIdent ->+ Bool ->+ Attributes ->+ TypeSyns ->+ Int ->+ (Map Identifier (String,String,String)) ->+ ( (Seq Error),Production,Int))+data Inh_Production = Inh_Production {cr_Inh_Production :: Bool,inh_Inh_Production :: Attributes,manualAttrOrderMap_Inh_Production :: AttrOrderMap,nonterminals_Inh_Production :: Set NontermIdent,nt_Inh_Production :: NontermIdent,o_rename_Inh_Production :: Bool,syn_Inh_Production :: Attributes,typeSyns_Inh_Production :: TypeSyns,uniq_Inh_Production :: Int,useMap_Inh_Production :: Map Identifier (String,String,String)}+data Syn_Production = Syn_Production {errors_Syn_Production :: Seq Error,output_Syn_Production :: Production,uniq_Syn_Production :: Int}+wrap_Production (T_Production sem) (Inh_Production _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap) =+ (let ( _lhsOerrors,_lhsOoutput,_lhsOuniq) =+ (sem _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap)+ in (Syn_Production _lhsOerrors _lhsOoutput _lhsOuniq))+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 (\ _lhsIcr+ _lhsIinh+ _lhsImanualAttrOrderMap+ _lhsInonterminals+ _lhsInt+ _lhsIo_rename+ _lhsIsyn+ _lhsItypeSyns+ _lhsIuniq+ _lhsIuseMap ->+ (let _rulesOcon :: ConstructorIdent+ _childrenOcon :: ConstructorIdent+ _lhsOerrors :: (Seq Error)+ _lhsOoutput :: Production+ _lhsOuniq :: Int+ _childrenOcr :: Bool+ _childrenOnt :: NontermIdent+ _rulesOnt :: NontermIdent+ _rulesOuniq :: Int+ _childrenIerrors :: (Seq Error)+ _childrenIfields :: ([(Identifier,Type,Bool)])+ _childrenIinputs :: ([(Identifier, Attributes)])+ _childrenIoutput :: Children+ _childrenIoutputs :: ([(Identifier, Attributes)])+ _rulesIdefinedAttrs :: (Set (Identifier,Identifier))+ _rulesIerrors :: (Seq Error)+ _rulesIlocals :: (Set Identifier)+ _rulesIoutput :: Rules+ _rulesIuniq :: Int+ _typeSigsIoutput :: TypeSigs+ -- "DefaultRules.ag"(line 137, column 16)+ _rulesOcon =+ con_+ -- "DefaultRules.ag"(line 138, column 17)+ _childrenOcon =+ con_+ -- "DefaultRules.ag"(line 320, column 4)+ _lhsOerrors =+ _childrenIerrors <> _errs <> _rulesIerrors <> _orderErrs+ -- "DefaultRules.ag"(line 322, column 8)+ __tup1 =+ let locals = _rulesIlocals+ initenv = Map.fromList ( [ (a,_ACHILD)+ | (a,_,_) <- _childrenIfields+ ]+ ++ attrs(_LHS, _lhsIinh)+ ++ [ (a,_LOC)+ | a <- Set.toList locals+ ]+ )+ attrs (n,as) = [ (a,n) | a <- Map.keys as ]+ envs = scanl (flip Map.union)+ initenv+ (map (Map.fromList . attrs ) _childrenIoutputs)+ child_envs = init envs+ lhs_env = last envs+ (selfAttrs, normalAttrs)+ = Map.partition isSELFNonterminal _lhsIsyn+ (_,undefAttrs)+ = removeDefined _rulesIdefinedAttrs (_LHS, normalAttrs)+ (useAttrs,others)+ = splitAttrs _lhsIuseMap undefAttrs+ (rules1, errors1)+ = concatRE $ map (copyRule _lhsInt con_ _lhsIcr locals)+ (zip envs (map (removeDefined _rulesIdefinedAttrs) _childrenIinputs))+ uRules+ = map (useRule locals _childrenIoutputs) useAttrs+ selfLocRules+ = [ selfRule False attr (constructor [childSelf attr nm tp | (nm,tp,ho) <- _childrenIfields, not ho])+ | attr <- Map.keys selfAttrs+ , not (Set.member attr locals)+ ]+ where+ childSelf self nm tp+ = case tp of NT nt _ -> attrName nm self+ _ | nm `Set.member` locals -> locname nm+ | otherwise -> fieldName nm+ constructor fs+ | getName con_ == "Tuple" && _lhsInt `elem` map fst _lhsItypeSyns+ = "(" ++ concat (List.intersperse "," fs) ++ ")"+ | otherwise+ = getConName _lhsItypeSyns _lhsIo_rename _lhsInt con_ ++ " " ++ unwords fs+ selfRules+ = [ selfRule True attr undefined+ | attr <- Map.keys selfAttrs+ , not (Set.member (_LHS,attr) _rulesIdefinedAttrs)+ ]+ (rules5, errs5)+ = copyRule _lhsInt+ con_+ _lhsIcr+ locals+ (lhs_env, (_LHS, others))+ in (uRules++selfLocRules++selfRules++rules5++rules1, errors1<>errs5)+ -- "DefaultRules.ag"(line 322, column 8)+ (_newRls,_) =+ __tup1+ -- "DefaultRules.ag"(line 322, column 8)+ (_,_errs) =+ __tup1+ -- "DefaultRules.ag"(line 438, column 16)+ _lhsOoutput =+ Production con_ _childrenIoutput (_rulesIoutput ++ _newRls) _typeSigsIoutput+ -- "DefaultRules.ag"(line 510, column 7)+ _orderDeps =+ Set.toList $ Map.findWithDefault Set.empty con_ $ Map.findWithDefault Map.empty _lhsInt _lhsImanualAttrOrderMap+ -- "DefaultRules.ag"(line 512, column 7)+ _orderErrs =+ let chldOutMap = Map.fromList [ (k, Map.keysSet s) | (k,s) <- _childrenIoutputs ]+ chldInMap = Map.fromList [ (k, Map.keysSet s) | (k,s) <- _childrenIinputs ]+ isInAttribute :: Identifier -> Identifier -> [Error]+ isInAttribute fld nm+ | fld == _LOC = if nm `Set.member` _rulesIlocals+ then []+ else [UndefAttr _lhsInt con_ fld nm False]+ | fld == _LHS = if nm `Map.member` _lhsIinh+ then []+ else [UndefAttr _lhsInt con_ fld nm False]+ | otherwise = if nm `Set.member` (Map.findWithDefault Set.empty fld chldOutMap)+ then []+ else [UndefAttr _lhsInt con_ fld nm False]+ isOutAttribute :: Identifier -> Identifier -> [Error]+ isOutAttribute fld nm+ | fld == _LOC = if nm `Set.member` _rulesIlocals+ then []+ else [UndefAttr _lhsInt con_ fld nm True]+ | fld == _LHS = if nm `Map.member` _lhsIsyn+ then []+ else [UndefAttr _lhsInt con_ fld nm True]+ | otherwise = if nm `Set.member` (Map.findWithDefault Set.empty fld chldInMap)+ then []+ else [UndefAttr _lhsInt con_ fld nm True]+ in Seq.fromList . concat $+ [ isInAttribute fldA nmA ++ isOutAttribute fldB nmB+ | dep@(Dependency (fldA,nmA) (fldB,nmB)) <- _orderDeps+ ]+ -- self rule+ _output =+ Production con_ _childrenIoutput _rulesIoutput _typeSigsIoutput+ -- copy rule (up)+ _lhsOuniq =+ _rulesIuniq+ -- copy rule (down)+ _childrenOcr =+ _lhsIcr+ -- copy rule (down)+ _childrenOnt =+ _lhsInt+ -- copy rule (down)+ _rulesOnt =+ _lhsInt+ -- copy rule (down)+ _rulesOuniq =+ _lhsIuniq+ ( _childrenIerrors,_childrenIfields,_childrenIinputs,_childrenIoutput,_childrenIoutputs) =+ (children_ _childrenOcon _childrenOcr _childrenOnt)+ ( _rulesIdefinedAttrs,_rulesIerrors,_rulesIlocals,_rulesIoutput,_rulesIuniq) =+ (rules_ _rulesOcon _rulesOnt _rulesOuniq)+ ( _typeSigsIoutput) =+ (typeSigs_ )+ in ( _lhsOerrors,_lhsOoutput,_lhsOuniq))))+-- Productions -------------------------------------------------+{-+ visit 0:+ inherited attributes:+ cr : Bool+ inh : Attributes+ manualAttrOrderMap : AttrOrderMap+ nonterminals : Set NontermIdent+ nt : NontermIdent+ o_rename : Bool+ syn : Attributes+ typeSyns : TypeSyns+ useMap : Map Identifier (String,String,String)+ chained attribute:+ uniq : Int+ synthesized attributes:+ errors : Seq Error+ output : SELF+ alternatives:+ alternative Cons:+ child hd : Production+ child tl : Productions+ visit 0:+ local output : _+ alternative Nil:+ visit 0:+ local output : _+-}+-- 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 (Bool ->+ Attributes ->+ AttrOrderMap ->+ (Set NontermIdent) ->+ NontermIdent ->+ Bool ->+ Attributes ->+ TypeSyns ->+ Int ->+ (Map Identifier (String,String,String)) ->+ ( (Seq Error),Productions,Int))+data Inh_Productions = Inh_Productions {cr_Inh_Productions :: Bool,inh_Inh_Productions :: Attributes,manualAttrOrderMap_Inh_Productions :: AttrOrderMap,nonterminals_Inh_Productions :: Set NontermIdent,nt_Inh_Productions :: NontermIdent,o_rename_Inh_Productions :: Bool,syn_Inh_Productions :: Attributes,typeSyns_Inh_Productions :: TypeSyns,uniq_Inh_Productions :: Int,useMap_Inh_Productions :: Map Identifier (String,String,String)}+data Syn_Productions = Syn_Productions {errors_Syn_Productions :: Seq Error,output_Syn_Productions :: Productions,uniq_Syn_Productions :: Int}+wrap_Productions (T_Productions sem) (Inh_Productions _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap) =+ (let ( _lhsOerrors,_lhsOoutput,_lhsOuniq) =+ (sem _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap)+ in (Syn_Productions _lhsOerrors _lhsOoutput _lhsOuniq))+sem_Productions_Cons :: T_Production ->+ T_Productions ->+ T_Productions+sem_Productions_Cons (T_Production hd_) (T_Productions tl_) =+ (T_Productions (\ _lhsIcr+ _lhsIinh+ _lhsImanualAttrOrderMap+ _lhsInonterminals+ _lhsInt+ _lhsIo_rename+ _lhsIsyn+ _lhsItypeSyns+ _lhsIuniq+ _lhsIuseMap ->+ (let _lhsOerrors :: (Seq Error)+ _lhsOoutput :: Productions+ _lhsOuniq :: Int+ _hdOcr :: Bool+ _hdOinh :: Attributes+ _hdOmanualAttrOrderMap :: AttrOrderMap+ _hdOnonterminals :: (Set NontermIdent)+ _hdOnt :: NontermIdent+ _hdOo_rename :: Bool+ _hdOsyn :: Attributes+ _hdOtypeSyns :: TypeSyns+ _hdOuniq :: Int+ _hdOuseMap :: (Map Identifier (String,String,String))+ _tlOcr :: Bool+ _tlOinh :: Attributes+ _tlOmanualAttrOrderMap :: AttrOrderMap+ _tlOnonterminals :: (Set NontermIdent)+ _tlOnt :: NontermIdent+ _tlOo_rename :: Bool+ _tlOsyn :: Attributes+ _tlOtypeSyns :: TypeSyns+ _tlOuniq :: Int+ _tlOuseMap :: (Map Identifier (String,String,String))+ _hdIerrors :: (Seq Error)+ _hdIoutput :: Production+ _hdIuniq :: Int+ _tlIerrors :: (Seq Error)+ _tlIoutput :: Productions+ _tlIuniq :: Int+ -- use rule "DefaultRules.ag"(line 109, column 19)+ _lhsOerrors =+ _hdIerrors Seq.<> _tlIerrors+ -- self rule+ _output =+ (:) _hdIoutput _tlIoutput+ -- self rule+ _lhsOoutput =+ _output+ -- copy rule (up)+ _lhsOuniq =+ _tlIuniq+ -- copy rule (down)+ _hdOcr =+ _lhsIcr+ -- copy rule (down)+ _hdOinh =+ _lhsIinh+ -- copy rule (down)+ _hdOmanualAttrOrderMap =+ _lhsImanualAttrOrderMap+ -- copy rule (down)+ _hdOnonterminals =+ _lhsInonterminals+ -- copy rule (down)+ _hdOnt =+ _lhsInt+ -- copy rule (down)+ _hdOo_rename =+ _lhsIo_rename+ -- copy rule (down)+ _hdOsyn =+ _lhsIsyn+ -- copy rule (down)+ _hdOtypeSyns =+ _lhsItypeSyns+ -- copy rule (down)+ _hdOuniq =+ _lhsIuniq+ -- copy rule (down)+ _hdOuseMap =+ _lhsIuseMap+ -- copy rule (down)+ _tlOcr =+ _lhsIcr+ -- copy rule (down)+ _tlOinh =+ _lhsIinh+ -- copy rule (down)+ _tlOmanualAttrOrderMap =+ _lhsImanualAttrOrderMap+ -- copy rule (down)+ _tlOnonterminals =+ _lhsInonterminals+ -- copy rule (down)+ _tlOnt =+ _lhsInt+ -- copy rule (down)+ _tlOo_rename =+ _lhsIo_rename+ -- copy rule (down)+ _tlOsyn =+ _lhsIsyn+ -- copy rule (down)+ _tlOtypeSyns =+ _lhsItypeSyns+ -- copy rule (chain)+ _tlOuniq =+ _hdIuniq+ -- copy rule (down)+ _tlOuseMap =+ _lhsIuseMap+ ( _hdIerrors,_hdIoutput,_hdIuniq) =+ (hd_ _hdOcr _hdOinh _hdOmanualAttrOrderMap _hdOnonterminals _hdOnt _hdOo_rename _hdOsyn _hdOtypeSyns _hdOuniq _hdOuseMap)+ ( _tlIerrors,_tlIoutput,_tlIuniq) =+ (tl_ _tlOcr _tlOinh _tlOmanualAttrOrderMap _tlOnonterminals _tlOnt _tlOo_rename _tlOsyn _tlOtypeSyns _tlOuniq _tlOuseMap)+ in ( _lhsOerrors,_lhsOoutput,_lhsOuniq))))+sem_Productions_Nil :: T_Productions+sem_Productions_Nil =+ (T_Productions (\ _lhsIcr+ _lhsIinh+ _lhsImanualAttrOrderMap+ _lhsInonterminals+ _lhsInt+ _lhsIo_rename+ _lhsIsyn+ _lhsItypeSyns+ _lhsIuniq+ _lhsIuseMap ->+ (let _lhsOerrors :: (Seq Error)+ _lhsOoutput :: Productions+ _lhsOuniq :: Int+ -- use rule "DefaultRules.ag"(line 109, column 19)+ _lhsOerrors =+ Seq.empty+ -- self rule+ _output =+ []+ -- self rule+ _lhsOoutput =+ _output+ -- copy rule (chain)+ _lhsOuniq =+ _lhsIuniq+ in ( _lhsOerrors,_lhsOoutput,_lhsOuniq))))+-- Rule --------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ con : ConstructorIdent+ nt : NontermIdent+ chained attribute:+ uniq : Int+ synthesized attributes:+ containsVars : Bool+ definedAttrs : Set (Identifier,Identifier)+ errors : Seq Error+ locals : Set Identifier+ output : SELF+ outputs : Rules+ alternatives:+ alternative Rule:+ child pattern : Pattern+ child rhs : {Expression}+ child owrt : {Bool}+ child origin : {String}+ visit 0:+ local _tup2 : {(Rules,Int)}+ local output : _+-}+-- cata+sem_Rule :: Rule ->+ T_Rule+sem_Rule (Rule _pattern _rhs _owrt _origin) =+ (sem_Rule_Rule (sem_Pattern _pattern) _rhs _owrt _origin)+-- semantic domain+newtype T_Rule = T_Rule (ConstructorIdent ->+ NontermIdent ->+ Int ->+ ( Bool,(Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Rule,Rules,Int))+data Inh_Rule = Inh_Rule {con_Inh_Rule :: ConstructorIdent,nt_Inh_Rule :: NontermIdent,uniq_Inh_Rule :: Int}+data Syn_Rule = Syn_Rule {containsVars_Syn_Rule :: Bool,definedAttrs_Syn_Rule :: Set (Identifier,Identifier),errors_Syn_Rule :: Seq Error,locals_Syn_Rule :: Set Identifier,output_Syn_Rule :: Rule,outputs_Syn_Rule :: Rules,uniq_Syn_Rule :: Int}+wrap_Rule (T_Rule sem) (Inh_Rule _lhsIcon _lhsInt _lhsIuniq) =+ (let ( _lhsOcontainsVars,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOoutputs,_lhsOuniq) =+ (sem _lhsIcon _lhsInt _lhsIuniq)+ in (Syn_Rule _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOoutputs _lhsOuniq))+sem_Rule_Rule :: T_Pattern ->+ Expression ->+ Bool ->+ String ->+ T_Rule+sem_Rule_Rule (T_Pattern pattern_) rhs_ owrt_ origin_ =+ (T_Rule (\ _lhsIcon+ _lhsInt+ _lhsIuniq ->+ (let __tup2 :: ((Rules,Int))+ _lhsOoutputs :: Rules+ _lhsOuniq :: Int+ _lhsOcontainsVars :: Bool+ _lhsOdefinedAttrs :: (Set (Identifier,Identifier))+ _lhsOerrors :: (Seq Error)+ _lhsOlocals :: (Set Identifier)+ _lhsOoutput :: Rule+ _patternOcon :: ConstructorIdent+ _patternOnt :: NontermIdent+ _patternIcontainsVars :: Bool+ _patternIcopy :: Pattern+ _patternIdefinedAttrs :: (Set (Identifier,Identifier))+ _patternIerrors :: (Seq Error)+ _patternIlocals :: (Set Identifier)+ _patternIoutput :: Pattern+ -- "DefaultRules.ag"(line 445, column 11)+ __tup2 =+ multiRule _output _lhsIuniq+ -- "DefaultRules.ag"(line 445, column 11)+ (_lhsOoutputs,_) =+ __tup2+ -- "DefaultRules.ag"(line 445, column 11)+ (_,_lhsOuniq) =+ __tup2+ -- use rule "DefaultRules.ag"(line 416, column 46)+ _lhsOcontainsVars =+ _patternIcontainsVars+ -- use rule "DefaultRules.ag"(line 396, column 23)+ _lhsOdefinedAttrs =+ _patternIdefinedAttrs+ -- use rule "DefaultRules.ag"(line 109, column 19)+ _lhsOerrors =+ _patternIerrors+ -- use rule "DefaultRules.ag"(line 395, column 23)+ _lhsOlocals =+ _patternIlocals+ -- self rule+ _output =+ Rule _patternIoutput rhs_ owrt_ origin_+ -- self rule+ _lhsOoutput =+ _output+ -- copy rule (down)+ _patternOcon =+ _lhsIcon+ -- copy rule (down)+ _patternOnt =+ _lhsInt+ ( _patternIcontainsVars,_patternIcopy,_patternIdefinedAttrs,_patternIerrors,_patternIlocals,_patternIoutput) =+ (pattern_ _patternOcon _patternOnt)+ in ( _lhsOcontainsVars,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOoutputs,_lhsOuniq))))+-- Rules -------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ con : ConstructorIdent+ nt : NontermIdent+ chained attribute:+ uniq : Int+ synthesized attributes:+ definedAttrs : Set (Identifier,Identifier)+ errors : Seq Error+ locals : Set Identifier+ output : SELF+ alternatives:+ alternative Cons:+ child hd : Rule+ child tl : Rules+ visit 0:+ local output : _+ alternative Nil:+ visit 0:+ local output : _+-}+-- 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 (ConstructorIdent ->+ NontermIdent ->+ Int ->+ ( (Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Rules,Int))+data Inh_Rules = Inh_Rules {con_Inh_Rules :: ConstructorIdent,nt_Inh_Rules :: NontermIdent,uniq_Inh_Rules :: Int}+data Syn_Rules = Syn_Rules {definedAttrs_Syn_Rules :: Set (Identifier,Identifier),errors_Syn_Rules :: Seq Error,locals_Syn_Rules :: Set Identifier,output_Syn_Rules :: Rules,uniq_Syn_Rules :: Int}+wrap_Rules (T_Rules sem) (Inh_Rules _lhsIcon _lhsInt _lhsIuniq) =+ (let ( _lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOuniq) =+ (sem _lhsIcon _lhsInt _lhsIuniq)+ in (Syn_Rules _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOuniq))+sem_Rules_Cons :: T_Rule ->+ T_Rules ->+ T_Rules+sem_Rules_Cons (T_Rule hd_) (T_Rules tl_) =+ (T_Rules (\ _lhsIcon+ _lhsInt+ _lhsIuniq ->+ (let _lhsOoutput :: Rules+ _lhsOdefinedAttrs :: (Set (Identifier,Identifier))+ _lhsOerrors :: (Seq Error)+ _lhsOlocals :: (Set Identifier)+ _lhsOuniq :: Int+ _hdOcon :: ConstructorIdent+ _hdOnt :: NontermIdent+ _hdOuniq :: Int+ _tlOcon :: ConstructorIdent+ _tlOnt :: NontermIdent+ _tlOuniq :: Int+ _hdIcontainsVars :: Bool+ _hdIdefinedAttrs :: (Set (Identifier,Identifier))+ _hdIerrors :: (Seq Error)+ _hdIlocals :: (Set Identifier)+ _hdIoutput :: Rule+ _hdIoutputs :: Rules+ _hdIuniq :: Int+ _tlIdefinedAttrs :: (Set (Identifier,Identifier))+ _tlIerrors :: (Seq Error)+ _tlIlocals :: (Set Identifier)+ _tlIoutput :: Rules+ _tlIuniq :: Int+ -- "DefaultRules.ag"(line 441, column 10)+ _lhsOoutput =+ if _hdIcontainsVars then _hdIoutputs ++ _tlIoutput else _tlIoutput+ -- use rule "DefaultRules.ag"(line 396, column 23)+ _lhsOdefinedAttrs =+ _hdIdefinedAttrs `Set.union` _tlIdefinedAttrs+ -- use rule "DefaultRules.ag"(line 109, column 19)+ _lhsOerrors =+ _hdIerrors Seq.<> _tlIerrors+ -- use rule "DefaultRules.ag"(line 395, column 23)+ _lhsOlocals =+ _hdIlocals `Set.union` _tlIlocals+ -- self rule+ _output =+ (:) _hdIoutput _tlIoutput+ -- copy rule (up)+ _lhsOuniq =+ _tlIuniq+ -- copy rule (down)+ _hdOcon =+ _lhsIcon+ -- copy rule (down)+ _hdOnt =+ _lhsInt+ -- copy rule (down)+ _hdOuniq =+ _lhsIuniq+ -- copy rule (down)+ _tlOcon =+ _lhsIcon+ -- copy rule (down)+ _tlOnt =+ _lhsInt+ -- copy rule (chain)+ _tlOuniq =+ _hdIuniq+ ( _hdIcontainsVars,_hdIdefinedAttrs,_hdIerrors,_hdIlocals,_hdIoutput,_hdIoutputs,_hdIuniq) =+ (hd_ _hdOcon _hdOnt _hdOuniq)+ ( _tlIdefinedAttrs,_tlIerrors,_tlIlocals,_tlIoutput,_tlIuniq) =+ (tl_ _tlOcon _tlOnt _tlOuniq)+ in ( _lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOuniq))))+sem_Rules_Nil :: T_Rules+sem_Rules_Nil =+ (T_Rules (\ _lhsIcon+ _lhsInt+ _lhsIuniq ->+ (let _lhsOdefinedAttrs :: (Set (Identifier,Identifier))+ _lhsOerrors :: (Seq Error)+ _lhsOlocals :: (Set Identifier)+ _lhsOoutput :: Rules+ _lhsOuniq :: Int+ -- use rule "DefaultRules.ag"(line 396, column 23)+ _lhsOdefinedAttrs =+ Set.empty+ -- use rule "DefaultRules.ag"(line 109, column 19)+ _lhsOerrors =+ Seq.empty+ -- use rule "DefaultRules.ag"(line 395, column 23)+ _lhsOlocals =+ Set.empty+ -- self rule+ _output =+ []+ -- self rule+ _lhsOoutput =+ _output+ -- copy rule (chain)+ _lhsOuniq =+ _lhsIuniq+ in ( _lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOuniq))))+-- TypeSig -----------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ output : SELF+ alternatives:+ alternative TypeSig:+ child name : {Identifier}+ child tp : {Type}+ visit 0:+ local output : _+-}+-- cata+sem_TypeSig :: TypeSig ->+ T_TypeSig+sem_TypeSig (TypeSig _name _tp) =+ (sem_TypeSig_TypeSig _name _tp)+-- semantic domain+newtype T_TypeSig = T_TypeSig (( TypeSig))+data Inh_TypeSig = Inh_TypeSig {}+data Syn_TypeSig = Syn_TypeSig {output_Syn_TypeSig :: TypeSig}+wrap_TypeSig (T_TypeSig sem) (Inh_TypeSig ) =+ (let ( _lhsOoutput) =+ (sem )+ in (Syn_TypeSig _lhsOoutput))+sem_TypeSig_TypeSig :: Identifier ->+ Type ->+ T_TypeSig+sem_TypeSig_TypeSig name_ tp_ =+ (T_TypeSig (let _lhsOoutput :: TypeSig+ -- self rule+ _output =+ TypeSig name_ tp_+ -- self rule+ _lhsOoutput =+ _output+ in ( _lhsOoutput)))+-- TypeSigs ----------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ output : SELF+ alternatives:+ alternative Cons:+ child hd : TypeSig+ child tl : TypeSigs+ visit 0:+ local output : _+ alternative Nil:+ visit 0:+ local output : _+-}+-- 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 (( TypeSigs))+data Inh_TypeSigs = Inh_TypeSigs {}+data Syn_TypeSigs = Syn_TypeSigs {output_Syn_TypeSigs :: TypeSigs}+wrap_TypeSigs (T_TypeSigs sem) (Inh_TypeSigs ) =+ (let ( _lhsOoutput) =+ (sem )+ in (Syn_TypeSigs _lhsOoutput))+sem_TypeSigs_Cons :: T_TypeSig ->+ T_TypeSigs ->+ T_TypeSigs+sem_TypeSigs_Cons (T_TypeSig hd_) (T_TypeSigs tl_) =+ (T_TypeSigs (let _lhsOoutput :: TypeSigs+ _hdIoutput :: TypeSig+ _tlIoutput :: TypeSigs+ -- self rule+ _output =+ (:) _hdIoutput _tlIoutput+ -- self rule+ _lhsOoutput =+ _output+ ( _hdIoutput) =+ (hd_ )+ ( _tlIoutput) =+ (tl_ )+ in ( _lhsOoutput)))+sem_TypeSigs_Nil :: T_TypeSigs+sem_TypeSigs_Nil =+ (T_TypeSigs (let _lhsOoutput :: TypeSigs+ -- self rule+ _output =+ []+ -- self rule+ _lhsOoutput =+ _output+ in ( _lhsOoutput)))
src-derived/Desugar.hs view
@@ -1,1837 +1,2279 @@---- UUAGC 0.9.5 (Desugar.ag)-module Desugar where--import qualified Data.Set as Set-import qualified Data.Map as Map-import Data.Map(Map)-import qualified UU.DData.Seq as Seq-import UU.DData.Seq(Seq,(<>))-import UU.Scanner.Position(Pos(..))-import Maybe--import AbstractSyntax-import ErrorMessages-import Options-import HsToken-import HsTokenScanner-import TokenDef---- AbstractSyntax.ag imports-import Data.Set(Set)-import Data.Map(Map)-import Patterns (Pattern(..),Patterns)-import Expression (Expression(..))-import CommonTypes---- Patterns.ag imports-import UU.Scanner.Position(Pos)-import CommonTypes (Constructor,Name)--import UU.Scanner.Position(Pos)--import CommonTypes-import UU.Scanner.Position(Pos)--addl :: Int -> Pos -> Pos-addl n (Pos l c f) = Pos (l+n) c f--maybeError :: a -> Error -> Maybe a -> (a, Seq Error)-maybeError def err mb- = maybe (def, Seq.single err) (\r -> (r, Seq.empty)) mb--findField :: Name -> Name -> [(Name,Name)] -> Maybe Name-findField fld attr list- | fld == _FIRST = f list- | fld == _LAST = f (reverse list)- | otherwise = Just fld- where- f = lookup attr--- Alternative --------------------------------------------------{-- visit 0:- inherited attribute:- nt : Nonterminal- synthesized attributes:- errors : Seq Error- output : SELF- alternatives:- alternative Alternative:- child con : {Constructor}- child children : Children- child rules : Rules- child typeSigs : TypeSigs- visit 0:- local output : _--}--- cata-sem_Alternative :: Alternative ->- T_Alternative-sem_Alternative (Alternative _con _children _rules _typeSigs ) =- (sem_Alternative_Alternative _con (sem_Children _children ) (sem_Rules _rules ) (sem_TypeSigs _typeSigs ) )--- semantic domain-newtype T_Alternative = T_Alternative (Nonterminal ->- ( (Seq Error),Alternative))-data Inh_Alternative = Inh_Alternative {nt_Inh_Alternative :: Nonterminal}-data Syn_Alternative = Syn_Alternative {errors_Syn_Alternative :: Seq Error,output_Syn_Alternative :: Alternative}-wrap_Alternative (T_Alternative sem ) (Inh_Alternative _lhsInt ) =- (let ( _lhsOerrors,_lhsOoutput) =- (sem _lhsInt )- in (Syn_Alternative _lhsOerrors _lhsOoutput ))-sem_Alternative_Alternative :: Constructor ->- T_Children ->- T_Rules ->- T_TypeSigs ->- T_Alternative-sem_Alternative_Alternative con_ (T_Children children_ ) (T_Rules rules_ ) (T_TypeSigs typeSigs_ ) =- (T_Alternative (\ _lhsInt ->- (let _rulesOcon :: Constructor- _rulesOdefs :: (Set (Name, Name))- _lhsOerrors :: (Seq Error)- _lhsOoutput :: Alternative- _rulesOchildInhs :: ([(Name, Name)])- _rulesOchildSyns :: ([(Name, Name)])- _rulesOnt :: Nonterminal- _childrenIchildInhs :: ([(Name, Name)])- _childrenIchildSyns :: ([(Name, Name)])- _childrenIoutput :: Children- _rulesIdefsCollect :: (Set (Name, Name))- _rulesIerrors :: (Seq Error)- _rulesIoutput :: Rules- _typeSigsIoutput :: TypeSigs- -- "Desugar.ag"(line 149, column 7)- _rulesOcon =- con_- -- "Desugar.ag"(line 165, column 7)- _rulesOdefs =- _rulesIdefsCollect- -- use rule "Desugar.ag"(line 30, column 144)- _lhsOerrors =- _rulesIerrors- -- self rule- _output =- Alternative con_ _childrenIoutput _rulesIoutput _typeSigsIoutput- -- self rule- _lhsOoutput =- _output- -- copy rule (chain)- _rulesOchildInhs =- _childrenIchildInhs- -- copy rule (chain)- _rulesOchildSyns =- _childrenIchildSyns- -- copy rule (down)- _rulesOnt =- _lhsInt- ( _childrenIchildInhs,_childrenIchildSyns,_childrenIoutput) =- (children_ )- ( _rulesIdefsCollect,_rulesIerrors,_rulesIoutput) =- (rules_ _rulesOchildInhs _rulesOchildSyns _rulesOcon _rulesOdefs _rulesOnt )- ( _typeSigsIoutput) =- (typeSigs_ )- in ( _lhsOerrors,_lhsOoutput))) )--- Alternatives -------------------------------------------------{-- visit 0:- inherited attribute:- nt : Nonterminal- synthesized attributes:- errors : Seq Error- output : SELF- alternatives:- alternative Cons:- child hd : Alternative- child tl : Alternatives- visit 0:- local output : _- alternative Nil:- visit 0:- local output : _--}--- cata-sem_Alternatives :: Alternatives ->- T_Alternatives-sem_Alternatives list =- (Prelude.foldr sem_Alternatives_Cons sem_Alternatives_Nil (Prelude.map sem_Alternative list) )--- semantic domain-newtype T_Alternatives = T_Alternatives (Nonterminal ->- ( (Seq Error),Alternatives))-data Inh_Alternatives = Inh_Alternatives {nt_Inh_Alternatives :: Nonterminal}-data Syn_Alternatives = Syn_Alternatives {errors_Syn_Alternatives :: Seq Error,output_Syn_Alternatives :: Alternatives}-wrap_Alternatives (T_Alternatives sem ) (Inh_Alternatives _lhsInt ) =- (let ( _lhsOerrors,_lhsOoutput) =- (sem _lhsInt )- in (Syn_Alternatives _lhsOerrors _lhsOoutput ))-sem_Alternatives_Cons :: T_Alternative ->- T_Alternatives ->- T_Alternatives-sem_Alternatives_Cons (T_Alternative hd_ ) (T_Alternatives tl_ ) =- (T_Alternatives (\ _lhsInt ->- (let _lhsOerrors :: (Seq Error)- _lhsOoutput :: Alternatives- _hdOnt :: Nonterminal- _tlOnt :: Nonterminal- _hdIerrors :: (Seq Error)- _hdIoutput :: Alternative- _tlIerrors :: (Seq Error)- _tlIoutput :: Alternatives- -- use rule "Desugar.ag"(line 30, column 144)- _lhsOerrors =- _hdIerrors Seq.<> _tlIerrors- -- self rule- _output =- (:) _hdIoutput _tlIoutput- -- self rule- _lhsOoutput =- _output- -- copy rule (down)- _hdOnt =- _lhsInt- -- copy rule (down)- _tlOnt =- _lhsInt- ( _hdIerrors,_hdIoutput) =- (hd_ _hdOnt )- ( _tlIerrors,_tlIoutput) =- (tl_ _tlOnt )- in ( _lhsOerrors,_lhsOoutput))) )-sem_Alternatives_Nil :: T_Alternatives-sem_Alternatives_Nil =- (T_Alternatives (\ _lhsInt ->- (let _lhsOerrors :: (Seq Error)- _lhsOoutput :: Alternatives- -- use rule "Desugar.ag"(line 30, column 144)- _lhsOerrors =- Seq.empty- -- self rule- _output =- []- -- self rule- _lhsOoutput =- _output- in ( _lhsOerrors,_lhsOoutput))) )--- Child --------------------------------------------------------{-- visit 0:- synthesized attributes:- childInhs : [(Name, Name)]- childSyns : [(Name, Name)]- output : SELF- alternatives:- alternative Child:- child name : {Name}- child tp : {Type}- child inh : {Attributes}- child syn : {Attributes}- child higherOrder : {Bool}- visit 0:- local output : _--}--- cata-sem_Child :: Child ->- T_Child-sem_Child (Child _name _tp _inh _syn _higherOrder ) =- (sem_Child_Child _name _tp _inh _syn _higherOrder )--- semantic domain-newtype T_Child = T_Child (( ([(Name, Name)]),([(Name, Name)]),Child))-data Inh_Child = Inh_Child {}-data Syn_Child = Syn_Child {childInhs_Syn_Child :: [(Name, Name)],childSyns_Syn_Child :: [(Name, Name)],output_Syn_Child :: Child}-wrap_Child (T_Child sem ) (Inh_Child ) =- (let ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput) =- (sem )- in (Syn_Child _lhsOchildInhs _lhsOchildSyns _lhsOoutput ))-sem_Child_Child :: Name ->- Type ->- Attributes ->- Attributes ->- Bool ->- T_Child-sem_Child_Child name_ tp_ inh_ syn_ higherOrder_ =- (T_Child (let _lhsOchildInhs :: ([(Name, Name)])- _lhsOchildSyns :: ([(Name, Name)])- _lhsOoutput :: Child- -- "Desugar.ag"(line 118, column 7)- _lhsOchildInhs =- [(i, name_) | i <- Map.keys inh_ ]- -- "Desugar.ag"(line 119, column 7)- _lhsOchildSyns =- [(s, name_) | s <- Map.keys syn_ ]- -- self rule- _output =- Child name_ tp_ inh_ syn_ higherOrder_- -- self rule- _lhsOoutput =- _output- in ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput)) )--- Children -----------------------------------------------------{-- visit 0:- synthesized attributes:- childInhs : [(Name, Name)]- childSyns : [(Name, Name)]- output : SELF- alternatives:- alternative Cons:- child hd : Child- child tl : Children- visit 0:- local output : _- alternative Nil:- visit 0:- local output : _--}--- 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 (( ([(Name, Name)]),([(Name, Name)]),Children))-data Inh_Children = Inh_Children {}-data Syn_Children = Syn_Children {childInhs_Syn_Children :: [(Name, Name)],childSyns_Syn_Children :: [(Name, Name)],output_Syn_Children :: Children}-wrap_Children (T_Children sem ) (Inh_Children ) =- (let ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput) =- (sem )- in (Syn_Children _lhsOchildInhs _lhsOchildSyns _lhsOoutput ))-sem_Children_Cons :: T_Child ->- T_Children ->- T_Children-sem_Children_Cons (T_Child hd_ ) (T_Children tl_ ) =- (T_Children (let _lhsOchildInhs :: ([(Name, Name)])- _lhsOchildSyns :: ([(Name, Name)])- _lhsOoutput :: Children- _hdIchildInhs :: ([(Name, Name)])- _hdIchildSyns :: ([(Name, Name)])- _hdIoutput :: Child- _tlIchildInhs :: ([(Name, Name)])- _tlIchildSyns :: ([(Name, Name)])- _tlIoutput :: Children- -- use rule "Desugar.ag"(line 113, column 48)- _lhsOchildInhs =- _hdIchildInhs ++ _tlIchildInhs- -- use rule "Desugar.ag"(line 113, column 48)- _lhsOchildSyns =- _hdIchildSyns ++ _tlIchildSyns- -- self rule- _output =- (:) _hdIoutput _tlIoutput- -- self rule- _lhsOoutput =- _output- ( _hdIchildInhs,_hdIchildSyns,_hdIoutput) =- (hd_ )- ( _tlIchildInhs,_tlIchildSyns,_tlIoutput) =- (tl_ )- in ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput)) )-sem_Children_Nil :: T_Children-sem_Children_Nil =- (T_Children (let _lhsOchildInhs :: ([(Name, Name)])- _lhsOchildSyns :: ([(Name, Name)])- _lhsOoutput :: Children- -- use rule "Desugar.ag"(line 113, column 48)- _lhsOchildInhs =- []- -- use rule "Desugar.ag"(line 113, column 48)- _lhsOchildSyns =- []- -- self rule- _output =- []- -- self rule- _lhsOoutput =- _output- in ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput)) )--- Expression ---------------------------------------------------{-- visit 0:- inherited attributes:- childInhs : [(Name, Name)]- childSyns : [(Name, Name)]- con : Constructor- nt : Nonterminal- synthesized attributes:- errors : Seq Error- output : SELF- alternatives:- alternative Expression:- child pos : {Pos}- child txt : {String}- visit 0:- local tokens : _- local _tup1 : _- local txt' : _- local output : _--}--- cata-sem_Expression :: Expression ->- T_Expression-sem_Expression (Expression _pos _txt ) =- (sem_Expression_Expression _pos _txt )--- semantic domain-newtype T_Expression = T_Expression (([(Name, Name)]) ->- ([(Name, Name)]) ->- Constructor ->- Nonterminal ->- ( (Seq Error),Expression))-data Inh_Expression = Inh_Expression {childInhs_Inh_Expression :: [(Name, Name)],childSyns_Inh_Expression :: [(Name, Name)],con_Inh_Expression :: Constructor,nt_Inh_Expression :: Nonterminal}-data Syn_Expression = Syn_Expression {errors_Syn_Expression :: Seq Error,output_Syn_Expression :: Expression}-wrap_Expression (T_Expression sem ) (Inh_Expression _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt ) =- (let ( _lhsOerrors,_lhsOoutput) =- (sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt )- in (Syn_Expression _lhsOerrors _lhsOoutput ))-sem_Expression_Expression :: Pos ->- String ->- T_Expression-sem_Expression_Expression pos_ txt_ =- (T_Expression (\ _lhsIchildInhs- _lhsIchildSyns- _lhsIcon- _lhsInt ->- (let _lhsOerrors :: (Seq Error)- _lhsOoutput :: Expression- -- "Desugar.ag"(line 41, column 7)- _tokens =- lexTokens pos_ txt_- -- "Desugar.ag"(line 42, column 7)- __tup1 =- let inh = Inh_HsTokensRoot { childInhs_Inh_HsTokensRoot = _lhsIchildInhs- , childSyns_Inh_HsTokensRoot = _lhsIchildSyns- , nt_Inh_HsTokensRoot = _lhsInt- , con_Inh_HsTokensRoot = _lhsIcon- }- sem = sem_HsTokensRoot (HsTokensRoot _tokens )- syn = wrap_HsTokensRoot sem inh- in (txt_Syn_HsTokensRoot syn, errors_Syn_HsTokensRoot syn)- -- "Desugar.ag"(line 42, column 7)- (_txt',_) =- __tup1- -- "Desugar.ag"(line 42, column 7)- (_,_lhsOerrors) =- __tup1- -- "Desugar.ag"(line 50, column 7)- _lhsOoutput =- Expression pos_ _txt'- -- self rule- _output =- Expression pos_ txt_- in ( _lhsOerrors,_lhsOoutput))) )--- Grammar ------------------------------------------------------{-- visit 0:- inherited attribute:- options : Options- synthesized attributes:- errors : Seq Error- output : SELF- alternatives:- alternative Grammar:- child typeSyns : {TypeSyns}- child useMap : {UseMap}- child derivings : {Derivings}- child wrappers : {Set Nonterminal}- child prods : Productions- child pragmas : {PragmaMap}- child manualAttrOrderMap : {AttrOrderMap}- visit 0:- local output : _--}--- cata-sem_Grammar :: Grammar ->- T_Grammar-sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _prods _pragmas _manualAttrOrderMap ) =- (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Productions _prods ) _pragmas _manualAttrOrderMap )--- semantic domain-newtype T_Grammar = T_Grammar (Options ->- ( (Seq Error),Grammar))-data Inh_Grammar = Inh_Grammar {options_Inh_Grammar :: Options}-data Syn_Grammar = Syn_Grammar {errors_Syn_Grammar :: Seq Error,output_Syn_Grammar :: Grammar}-wrap_Grammar (T_Grammar sem ) (Inh_Grammar _lhsIoptions ) =- (let ( _lhsOerrors,_lhsOoutput) =- (sem _lhsIoptions )- in (Syn_Grammar _lhsOerrors _lhsOoutput ))-sem_Grammar_Grammar :: TypeSyns ->- UseMap ->- Derivings ->- (Set Nonterminal) ->- T_Productions ->- PragmaMap ->- AttrOrderMap ->- T_Grammar-sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Productions prods_ ) pragmas_ manualAttrOrderMap_ =- (T_Grammar (\ _lhsIoptions ->- (let _lhsOerrors :: (Seq Error)- _lhsOoutput :: Grammar- _prodsIerrors :: (Seq Error)- _prodsIoutput :: Productions- -- use rule "Desugar.ag"(line 30, column 144)- _lhsOerrors =- _prodsIerrors- -- self rule- _output =- Grammar typeSyns_ useMap_ derivings_ wrappers_ _prodsIoutput pragmas_ manualAttrOrderMap_- -- self rule- _lhsOoutput =- _output- ( _prodsIerrors,_prodsIoutput) =- (prods_ )- in ( _lhsOerrors,_lhsOoutput))) )--- HsToken ------------------------------------------------------{-- visit 0:- inherited attributes:- childInhs : [(Name, Name)]- childSyns : [(Name, Name)]- con : Constructor- nt : Nonterminal- chained attribute:- addLines : Int- synthesized attributes:- errors : Seq Error- tks : [(Pos,String)]- alternatives:- alternative AGField:- child field : {Name}- child attr : {Name}- child pos : {Pos}- visit 0:- local mField : _- local field' : _- alternative AGLocal:- child var : {Name}- child pos : {Pos}- 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 ) =- (sem_HsToken_AGField _field _attr _pos )-sem_HsToken (AGLocal _var _pos ) =- (sem_HsToken_AGLocal _var _pos )-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 (Int ->- ([(Name, Name)]) ->- ([(Name, Name)]) ->- Constructor ->- Nonterminal ->- ( Int,(Seq Error),([(Pos,String)])))-data Inh_HsToken = Inh_HsToken {addLines_Inh_HsToken :: Int,childInhs_Inh_HsToken :: [(Name, Name)],childSyns_Inh_HsToken :: [(Name, Name)],con_Inh_HsToken :: Constructor,nt_Inh_HsToken :: Nonterminal}-data Syn_HsToken = Syn_HsToken {addLines_Syn_HsToken :: Int,errors_Syn_HsToken :: Seq Error,tks_Syn_HsToken :: [(Pos,String)]}-wrap_HsToken (T_HsToken sem ) (Inh_HsToken _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt ) =- (let ( _lhsOaddLines,_lhsOerrors,_lhsOtks) =- (sem _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt )- in (Syn_HsToken _lhsOaddLines _lhsOerrors _lhsOtks ))-sem_HsToken_AGField :: Name ->- Name ->- Pos ->- T_HsToken-sem_HsToken_AGField field_ attr_ pos_ =- (T_HsToken (\ _lhsIaddLines- _lhsIchildInhs- _lhsIchildSyns- _lhsIcon- _lhsInt ->- (let _lhsOerrors :: (Seq Error)- _lhsOaddLines :: Int- _lhsOtks :: ([(Pos,String)])- -- "Desugar.ag"(line 67, column 7)- _mField =- findField field_ attr_ _lhsIchildSyns- -- "Desugar.ag"(line 69, column 7)- _field' =- maybe field_ id _mField- -- "Desugar.ag"(line 70, column 7)- _lhsOerrors =- maybe (Seq.single (UndefAttr _lhsInt _lhsIcon field_ (Ident "<ANY>" (getPos field_)))) (const Seq.empty) _mField- -- "Desugar.ag"(line 72, column 7)- _lhsOaddLines =- if length (getName field_) < length (getName _field' )- then _lhsIaddLines + 1- else _lhsIaddLines- -- "Desugar.ag"(line 76, column 7)- _lhsOtks =- [(addl _lhsIaddLines pos_, "@" ++ show _field' ++ "." ++ show attr_)]- in ( _lhsOaddLines,_lhsOerrors,_lhsOtks))) )-sem_HsToken_AGLocal :: Name ->- Pos ->- T_HsToken-sem_HsToken_AGLocal var_ pos_ =- (T_HsToken (\ _lhsIaddLines- _lhsIchildInhs- _lhsIchildSyns- _lhsIcon- _lhsInt ->- (let _lhsOtks :: ([(Pos,String)])- _lhsOerrors :: (Seq Error)- _lhsOaddLines :: Int- -- "Desugar.ag"(line 65, column 7)- _lhsOtks =- [(addl _lhsIaddLines pos_, "@" ++ show var_)]- -- use rule "Desugar.ag"(line 30, column 144)- _lhsOerrors =- Seq.empty- -- copy rule (chain)- _lhsOaddLines =- _lhsIaddLines- in ( _lhsOaddLines,_lhsOerrors,_lhsOtks))) )-sem_HsToken_CharToken :: String ->- Pos ->- T_HsToken-sem_HsToken_CharToken value_ pos_ =- (T_HsToken (\ _lhsIaddLines- _lhsIchildInhs- _lhsIchildSyns- _lhsIcon- _lhsInt ->- (let _lhsOtks :: ([(Pos,String)])- _lhsOerrors :: (Seq Error)- _lhsOaddLines :: Int- -- "Desugar.ag"(line 80, column 7)- _lhsOtks =- [(addl _lhsIaddLines pos_, if null value_ then "" else showCharShort (head value_))]- -- use rule "Desugar.ag"(line 30, column 144)- _lhsOerrors =- Seq.empty- -- copy rule (chain)- _lhsOaddLines =- _lhsIaddLines- in ( _lhsOaddLines,_lhsOerrors,_lhsOtks))) )-sem_HsToken_Err :: String ->- Pos ->- T_HsToken-sem_HsToken_Err mesg_ pos_ =- (T_HsToken (\ _lhsIaddLines- _lhsIchildInhs- _lhsIchildSyns- _lhsIcon- _lhsInt ->- (let _lhsOtks :: ([(Pos,String)])- _lhsOerrors :: (Seq Error)- _lhsOaddLines :: Int- -- "Desugar.ag"(line 84, column 7)- _lhsOtks =- [(addl _lhsIaddLines pos_, "***" ++ mesg_ ++ "***")]- -- use rule "Desugar.ag"(line 30, column 144)- _lhsOerrors =- Seq.empty- -- copy rule (chain)- _lhsOaddLines =- _lhsIaddLines- in ( _lhsOaddLines,_lhsOerrors,_lhsOtks))) )-sem_HsToken_HsToken :: String ->- Pos ->- T_HsToken-sem_HsToken_HsToken value_ pos_ =- (T_HsToken (\ _lhsIaddLines- _lhsIchildInhs- _lhsIchildSyns- _lhsIcon- _lhsInt ->- (let _lhsOtks :: ([(Pos,String)])- _lhsOerrors :: (Seq Error)- _lhsOaddLines :: Int- -- "Desugar.ag"(line 78, column 7)- _lhsOtks =- [(addl _lhsIaddLines pos_, value_)]- -- use rule "Desugar.ag"(line 30, column 144)- _lhsOerrors =- Seq.empty- -- copy rule (chain)- _lhsOaddLines =- _lhsIaddLines- in ( _lhsOaddLines,_lhsOerrors,_lhsOtks))) )-sem_HsToken_StrToken :: String ->- Pos ->- T_HsToken-sem_HsToken_StrToken value_ pos_ =- (T_HsToken (\ _lhsIaddLines- _lhsIchildInhs- _lhsIchildSyns- _lhsIcon- _lhsInt ->- (let _lhsOtks :: ([(Pos,String)])- _lhsOerrors :: (Seq Error)- _lhsOaddLines :: Int- -- "Desugar.ag"(line 82, column 7)- _lhsOtks =- [(addl _lhsIaddLines pos_, showStrShort value_)]- -- use rule "Desugar.ag"(line 30, column 144)- _lhsOerrors =- Seq.empty- -- copy rule (chain)- _lhsOaddLines =- _lhsIaddLines- in ( _lhsOaddLines,_lhsOerrors,_lhsOtks))) )--- HsTokens -----------------------------------------------------{-- visit 0:- inherited attributes:- childInhs : [(Name, Name)]- childSyns : [(Name, Name)]- con : Constructor- nt : Nonterminal- chained attribute:- addLines : Int- synthesized attributes:- errors : Seq Error- tks : [(Pos,String)]- 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 (Int ->- ([(Name, Name)]) ->- ([(Name, Name)]) ->- Constructor ->- Nonterminal ->- ( Int,(Seq Error),([(Pos,String)])))-data Inh_HsTokens = Inh_HsTokens {addLines_Inh_HsTokens :: Int,childInhs_Inh_HsTokens :: [(Name, Name)],childSyns_Inh_HsTokens :: [(Name, Name)],con_Inh_HsTokens :: Constructor,nt_Inh_HsTokens :: Nonterminal}-data Syn_HsTokens = Syn_HsTokens {addLines_Syn_HsTokens :: Int,errors_Syn_HsTokens :: Seq Error,tks_Syn_HsTokens :: [(Pos,String)]}-wrap_HsTokens (T_HsTokens sem ) (Inh_HsTokens _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt ) =- (let ( _lhsOaddLines,_lhsOerrors,_lhsOtks) =- (sem _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt )- in (Syn_HsTokens _lhsOaddLines _lhsOerrors _lhsOtks ))-sem_HsTokens_Cons :: T_HsToken ->- T_HsTokens ->- T_HsTokens-sem_HsTokens_Cons (T_HsToken hd_ ) (T_HsTokens tl_ ) =- (T_HsTokens (\ _lhsIaddLines- _lhsIchildInhs- _lhsIchildSyns- _lhsIcon- _lhsInt ->- (let _lhsOerrors :: (Seq Error)- _lhsOtks :: ([(Pos,String)])- _lhsOaddLines :: Int- _hdOaddLines :: Int- _hdOchildInhs :: ([(Name, Name)])- _hdOchildSyns :: ([(Name, Name)])- _hdOcon :: Constructor- _hdOnt :: Nonterminal- _tlOaddLines :: Int- _tlOchildInhs :: ([(Name, Name)])- _tlOchildSyns :: ([(Name, Name)])- _tlOcon :: Constructor- _tlOnt :: Nonterminal- _hdIaddLines :: Int- _hdIerrors :: (Seq Error)- _hdItks :: ([(Pos,String)])- _tlIaddLines :: Int- _tlIerrors :: (Seq Error)- _tlItks :: ([(Pos,String)])- -- use rule "Desugar.ag"(line 30, column 144)- _lhsOerrors =- _hdIerrors Seq.<> _tlIerrors- -- use rule "Desugar.ag"(line 62, column 46)- _lhsOtks =- _hdItks ++ _tlItks- -- copy rule (up)- _lhsOaddLines =- _tlIaddLines- -- copy rule (down)- _hdOaddLines =- _lhsIaddLines- -- copy rule (down)- _hdOchildInhs =- _lhsIchildInhs- -- copy rule (down)- _hdOchildSyns =- _lhsIchildSyns- -- copy rule (down)- _hdOcon =- _lhsIcon- -- copy rule (down)- _hdOnt =- _lhsInt- -- copy rule (chain)- _tlOaddLines =- _hdIaddLines- -- copy rule (down)- _tlOchildInhs =- _lhsIchildInhs- -- copy rule (down)- _tlOchildSyns =- _lhsIchildSyns- -- copy rule (down)- _tlOcon =- _lhsIcon- -- copy rule (down)- _tlOnt =- _lhsInt- ( _hdIaddLines,_hdIerrors,_hdItks) =- (hd_ _hdOaddLines _hdOchildInhs _hdOchildSyns _hdOcon _hdOnt )- ( _tlIaddLines,_tlIerrors,_tlItks) =- (tl_ _tlOaddLines _tlOchildInhs _tlOchildSyns _tlOcon _tlOnt )- in ( _lhsOaddLines,_lhsOerrors,_lhsOtks))) )-sem_HsTokens_Nil :: T_HsTokens-sem_HsTokens_Nil =- (T_HsTokens (\ _lhsIaddLines- _lhsIchildInhs- _lhsIchildSyns- _lhsIcon- _lhsInt ->- (let _lhsOerrors :: (Seq Error)- _lhsOtks :: ([(Pos,String)])- _lhsOaddLines :: Int- -- use rule "Desugar.ag"(line 30, column 144)- _lhsOerrors =- Seq.empty- -- use rule "Desugar.ag"(line 62, column 46)- _lhsOtks =- []- -- copy rule (chain)- _lhsOaddLines =- _lhsIaddLines- in ( _lhsOaddLines,_lhsOerrors,_lhsOtks))) )--- HsTokensRoot -------------------------------------------------{-- visit 0:- inherited attributes:- childInhs : [(Name, Name)]- childSyns : [(Name, Name)]- con : Constructor- nt : Nonterminal- synthesized attributes:- errors : Seq Error- tks : [(Pos,String)]- txt : String- 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 (([(Name, Name)]) ->- ([(Name, Name)]) ->- Constructor ->- Nonterminal ->- ( (Seq Error),([(Pos,String)]),String))-data Inh_HsTokensRoot = Inh_HsTokensRoot {childInhs_Inh_HsTokensRoot :: [(Name, Name)],childSyns_Inh_HsTokensRoot :: [(Name, Name)],con_Inh_HsTokensRoot :: Constructor,nt_Inh_HsTokensRoot :: Nonterminal}-data Syn_HsTokensRoot = Syn_HsTokensRoot {errors_Syn_HsTokensRoot :: Seq Error,tks_Syn_HsTokensRoot :: [(Pos,String)],txt_Syn_HsTokensRoot :: String}-wrap_HsTokensRoot (T_HsTokensRoot sem ) (Inh_HsTokensRoot _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt ) =- (let ( _lhsOerrors,_lhsOtks,_lhsOtxt) =- (sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt )- in (Syn_HsTokensRoot _lhsOerrors _lhsOtks _lhsOtxt ))-sem_HsTokensRoot_HsTokensRoot :: T_HsTokens ->- T_HsTokensRoot-sem_HsTokensRoot_HsTokensRoot (T_HsTokens tokens_ ) =- (T_HsTokensRoot (\ _lhsIchildInhs- _lhsIchildSyns- _lhsIcon- _lhsInt ->- (let _lhsOtxt :: String- _tokensOaddLines :: Int- _lhsOerrors :: (Seq Error)- _lhsOtks :: ([(Pos,String)])- _tokensOchildInhs :: ([(Name, Name)])- _tokensOchildSyns :: ([(Name, Name)])- _tokensOcon :: Constructor- _tokensOnt :: Nonterminal- _tokensIaddLines :: Int- _tokensIerrors :: (Seq Error)- _tokensItks :: ([(Pos,String)])- -- "Desugar.ag"(line 55, column 7)- _lhsOtxt =- unlines $ showTokens _tokensItks- -- "Desugar.ag"(line 60, column 7)- _tokensOaddLines =- 0- -- use rule "Desugar.ag"(line 30, column 144)- _lhsOerrors =- _tokensIerrors- -- use rule "Desugar.ag"(line 62, column 46)- _lhsOtks =- _tokensItks- -- copy rule (down)- _tokensOchildInhs =- _lhsIchildInhs- -- copy rule (down)- _tokensOchildSyns =- _lhsIchildSyns- -- copy rule (down)- _tokensOcon =- _lhsIcon- -- copy rule (down)- _tokensOnt =- _lhsInt- ( _tokensIaddLines,_tokensIerrors,_tokensItks) =- (tokens_ _tokensOaddLines _tokensOchildInhs _tokensOchildSyns _tokensOcon _tokensOnt )- in ( _lhsOerrors,_lhsOtks,_lhsOtxt))) )--- Pattern ------------------------------------------------------{-- visit 0:- inherited attributes:- childInhs : [(Name, Name)]- childSyns : [(Name, Name)]- con : Constructor- defs : Set (Name, Name)- nt : Nonterminal- synthesized attributes:- copy : SELF- defsCollect : Set (Name, Name)- errors : Seq Error- output : SELF- alternatives:- alternative Alias:- child field : {Name}- child attr : {Name}- child pat : Pattern- child parts : Patterns- visit 0:- local _tup2 : _- local field' : _- local err1 : _- local err2 : _- local def : _- local copy : _- local output : _- alternative Constr:- child name : {Constructor}- child pats : Patterns- visit 0:- local copy : _- local output : _- alternative Product:- child pos : {Pos}- child pats : Patterns- visit 0:- local copy : _- local output : _- alternative Underscore:- child pos : {Pos}- visit 0:- local copy : _- local output : _--}--- 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 (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 (([(Name, Name)]) ->- ([(Name, Name)]) ->- Constructor ->- (Set (Name, Name)) ->- Nonterminal ->- ( Pattern,(Set (Name, Name)),(Seq Error),Pattern))-data Inh_Pattern = Inh_Pattern {childInhs_Inh_Pattern :: [(Name, Name)],childSyns_Inh_Pattern :: [(Name, Name)],con_Inh_Pattern :: Constructor,defs_Inh_Pattern :: Set (Name, Name),nt_Inh_Pattern :: Nonterminal}-data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern,defsCollect_Syn_Pattern :: Set (Name, Name),errors_Syn_Pattern :: Seq Error,output_Syn_Pattern :: Pattern}-wrap_Pattern (T_Pattern sem ) (Inh_Pattern _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsInt ) =- (let ( _lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput) =- (sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsInt )- in (Syn_Pattern _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput ))-sem_Pattern_Alias :: Name ->- Name ->- T_Pattern ->- T_Patterns ->- T_Pattern-sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) =- (T_Pattern (\ _lhsIchildInhs- _lhsIchildSyns- _lhsIcon- _lhsIdefs- _lhsInt ->- (let _lhsOerrors :: (Seq Error)- _lhsOoutput :: Pattern- _lhsOdefsCollect :: (Set (Name, Name))- _lhsOcopy :: Pattern- _patOchildInhs :: ([(Name, Name)])- _patOchildSyns :: ([(Name, Name)])- _patOcon :: Constructor- _patOdefs :: (Set (Name, Name))- _patOnt :: Nonterminal- _partsOchildInhs :: ([(Name, Name)])- _partsOchildSyns :: ([(Name, Name)])- _partsOcon :: Constructor- _partsOdefs :: (Set (Name, Name))- _partsOnt :: Nonterminal- _patIcopy :: Pattern- _patIdefsCollect :: (Set (Name, Name))- _patIerrors :: (Seq Error)- _patIoutput :: Pattern- _partsIcopy :: Patterns- _partsIdefsCollect :: (Set (Name, Name))- _partsIerrors :: (Seq Error)- _partsIoutput :: Patterns- -- "Desugar.ag"(line 98, column 7)- __tup2 =- maybeError field_ (UndefAttr _lhsInt _lhsIcon (Ident "<ANY>" (getPos field_)) attr_) $- findField field_ attr_ _lhsIchildInhs- -- "Desugar.ag"(line 98, column 7)- (_field',_) =- __tup2- -- "Desugar.ag"(line 98, column 7)- (_,_err1) =- __tup2- -- "Desugar.ag"(line 100, column 7)- _err2 =- if _field' == field_- then Seq.empty- else if (_field' , attr_) `Set.member` _lhsIdefs- then Seq.single $ DupRule _lhsInt _lhsIcon field_ attr_ _field'- else Seq.empty- -- "Desugar.ag"(line 105, column 7)- _lhsOerrors =- _err1 Seq.<> _err2 Seq.<> _patIerrors <> _partsIerrors- -- "Desugar.ag"(line 106, column 7)- _lhsOoutput =- Alias _field' attr_ _patIoutput _partsIoutput- -- "Desugar.ag"(line 159, column 7)- _def =- Set.singleton (field_, attr_)- -- "Desugar.ag"(line 160, column 7)- _lhsOdefsCollect =- _def `Set.union` _patIdefsCollect `Set.union` _partsIdefsCollect- -- self rule- _copy =- Alias field_ attr_ _patIcopy _partsIcopy- -- self rule- _output =- Alias field_ attr_ _patIoutput _partsIoutput- -- self rule- _lhsOcopy =- _copy- -- copy rule (down)- _patOchildInhs =- _lhsIchildInhs- -- copy rule (down)- _patOchildSyns =- _lhsIchildSyns- -- copy rule (down)- _patOcon =- _lhsIcon- -- copy rule (down)- _patOdefs =- _lhsIdefs- -- copy rule (down)- _patOnt =- _lhsInt- -- copy rule (down)- _partsOchildInhs =- _lhsIchildInhs- -- copy rule (down)- _partsOchildSyns =- _lhsIchildSyns- -- copy rule (down)- _partsOcon =- _lhsIcon- -- copy rule (down)- _partsOdefs =- _lhsIdefs- -- copy rule (down)- _partsOnt =- _lhsInt- ( _patIcopy,_patIdefsCollect,_patIerrors,_patIoutput) =- (pat_ _patOchildInhs _patOchildSyns _patOcon _patOdefs _patOnt )- ( _partsIcopy,_partsIdefsCollect,_partsIerrors,_partsIoutput) =- (parts_ _partsOchildInhs _partsOchildSyns _partsOcon _partsOdefs _partsOnt )- in ( _lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))) )-sem_Pattern_Constr :: Constructor ->- T_Patterns ->- T_Pattern-sem_Pattern_Constr name_ (T_Patterns pats_ ) =- (T_Pattern (\ _lhsIchildInhs- _lhsIchildSyns- _lhsIcon- _lhsIdefs- _lhsInt ->- (let _lhsOdefsCollect :: (Set (Name, Name))- _lhsOerrors :: (Seq Error)- _lhsOcopy :: Pattern- _lhsOoutput :: Pattern- _patsOchildInhs :: ([(Name, Name)])- _patsOchildSyns :: ([(Name, Name)])- _patsOcon :: Constructor- _patsOdefs :: (Set (Name, Name))- _patsOnt :: Nonterminal- _patsIcopy :: Patterns- _patsIdefsCollect :: (Set (Name, Name))- _patsIerrors :: (Seq Error)- _patsIoutput :: Patterns- -- use rule "Desugar.ag"(line 156, column 52)- _lhsOdefsCollect =- _patsIdefsCollect- -- use rule "Desugar.ag"(line 30, column 144)- _lhsOerrors =- _patsIerrors- -- self rule- _copy =- Constr name_ _patsIcopy- -- self rule- _output =- Constr name_ _patsIoutput- -- self rule- _lhsOcopy =- _copy- -- self rule- _lhsOoutput =- _output- -- copy rule (down)- _patsOchildInhs =- _lhsIchildInhs- -- copy rule (down)- _patsOchildSyns =- _lhsIchildSyns- -- copy rule (down)- _patsOcon =- _lhsIcon- -- copy rule (down)- _patsOdefs =- _lhsIdefs- -- copy rule (down)- _patsOnt =- _lhsInt- ( _patsIcopy,_patsIdefsCollect,_patsIerrors,_patsIoutput) =- (pats_ _patsOchildInhs _patsOchildSyns _patsOcon _patsOdefs _patsOnt )- in ( _lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))) )-sem_Pattern_Product :: Pos ->- T_Patterns ->- T_Pattern-sem_Pattern_Product pos_ (T_Patterns pats_ ) =- (T_Pattern (\ _lhsIchildInhs- _lhsIchildSyns- _lhsIcon- _lhsIdefs- _lhsInt ->- (let _lhsOdefsCollect :: (Set (Name, Name))- _lhsOerrors :: (Seq Error)- _lhsOcopy :: Pattern- _lhsOoutput :: Pattern- _patsOchildInhs :: ([(Name, Name)])- _patsOchildSyns :: ([(Name, Name)])- _patsOcon :: Constructor- _patsOdefs :: (Set (Name, Name))- _patsOnt :: Nonterminal- _patsIcopy :: Patterns- _patsIdefsCollect :: (Set (Name, Name))- _patsIerrors :: (Seq Error)- _patsIoutput :: Patterns- -- use rule "Desugar.ag"(line 156, column 52)- _lhsOdefsCollect =- _patsIdefsCollect- -- use rule "Desugar.ag"(line 30, column 144)- _lhsOerrors =- _patsIerrors- -- self rule- _copy =- Product pos_ _patsIcopy- -- self rule- _output =- Product pos_ _patsIoutput- -- self rule- _lhsOcopy =- _copy- -- self rule- _lhsOoutput =- _output- -- copy rule (down)- _patsOchildInhs =- _lhsIchildInhs- -- copy rule (down)- _patsOchildSyns =- _lhsIchildSyns- -- copy rule (down)- _patsOcon =- _lhsIcon- -- copy rule (down)- _patsOdefs =- _lhsIdefs- -- copy rule (down)- _patsOnt =- _lhsInt- ( _patsIcopy,_patsIdefsCollect,_patsIerrors,_patsIoutput) =- (pats_ _patsOchildInhs _patsOchildSyns _patsOcon _patsOdefs _patsOnt )- in ( _lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))) )-sem_Pattern_Underscore :: Pos ->- T_Pattern-sem_Pattern_Underscore pos_ =- (T_Pattern (\ _lhsIchildInhs- _lhsIchildSyns- _lhsIcon- _lhsIdefs- _lhsInt ->- (let _lhsOdefsCollect :: (Set (Name, Name))- _lhsOerrors :: (Seq Error)- _lhsOcopy :: Pattern- _lhsOoutput :: Pattern- -- use rule "Desugar.ag"(line 156, column 52)- _lhsOdefsCollect =- Set.empty- -- use rule "Desugar.ag"(line 30, column 144)- _lhsOerrors =- Seq.empty- -- self rule- _copy =- Underscore pos_- -- self rule- _output =- Underscore pos_- -- self rule- _lhsOcopy =- _copy- -- self rule- _lhsOoutput =- _output- in ( _lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))) )--- Patterns -----------------------------------------------------{-- visit 0:- inherited attributes:- childInhs : [(Name, Name)]- childSyns : [(Name, Name)]- con : Constructor- defs : Set (Name, Name)- nt : Nonterminal- synthesized attributes:- copy : SELF- defsCollect : Set (Name, Name)- errors : Seq Error- output : SELF- alternatives:- alternative Cons:- child hd : Pattern- child tl : Patterns- visit 0:- local copy : _- local output : _- alternative Nil:- visit 0:- local copy : _- local output : _--}--- 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 (([(Name, Name)]) ->- ([(Name, Name)]) ->- Constructor ->- (Set (Name, Name)) ->- Nonterminal ->- ( Patterns,(Set (Name, Name)),(Seq Error),Patterns))-data Inh_Patterns = Inh_Patterns {childInhs_Inh_Patterns :: [(Name, Name)],childSyns_Inh_Patterns :: [(Name, Name)],con_Inh_Patterns :: Constructor,defs_Inh_Patterns :: Set (Name, Name),nt_Inh_Patterns :: Nonterminal}-data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns,defsCollect_Syn_Patterns :: Set (Name, Name),errors_Syn_Patterns :: Seq Error,output_Syn_Patterns :: Patterns}-wrap_Patterns (T_Patterns sem ) (Inh_Patterns _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsInt ) =- (let ( _lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput) =- (sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsInt )- in (Syn_Patterns _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput ))-sem_Patterns_Cons :: T_Pattern ->- T_Patterns ->- T_Patterns-sem_Patterns_Cons (T_Pattern hd_ ) (T_Patterns tl_ ) =- (T_Patterns (\ _lhsIchildInhs- _lhsIchildSyns- _lhsIcon- _lhsIdefs- _lhsInt ->- (let _lhsOdefsCollect :: (Set (Name, Name))- _lhsOerrors :: (Seq Error)- _lhsOcopy :: Patterns- _lhsOoutput :: Patterns- _hdOchildInhs :: ([(Name, Name)])- _hdOchildSyns :: ([(Name, Name)])- _hdOcon :: Constructor- _hdOdefs :: (Set (Name, Name))- _hdOnt :: Nonterminal- _tlOchildInhs :: ([(Name, Name)])- _tlOchildSyns :: ([(Name, Name)])- _tlOcon :: Constructor- _tlOdefs :: (Set (Name, Name))- _tlOnt :: Nonterminal- _hdIcopy :: Pattern- _hdIdefsCollect :: (Set (Name, Name))- _hdIerrors :: (Seq Error)- _hdIoutput :: Pattern- _tlIcopy :: Patterns- _tlIdefsCollect :: (Set (Name, Name))- _tlIerrors :: (Seq Error)- _tlIoutput :: Patterns- -- use rule "Desugar.ag"(line 156, column 52)- _lhsOdefsCollect =- _hdIdefsCollect `Set.union` _tlIdefsCollect- -- use rule "Desugar.ag"(line 30, column 144)- _lhsOerrors =- _hdIerrors Seq.<> _tlIerrors- -- self rule- _copy =- (:) _hdIcopy _tlIcopy- -- self rule- _output =- (:) _hdIoutput _tlIoutput- -- self rule- _lhsOcopy =- _copy- -- self rule- _lhsOoutput =- _output- -- copy rule (down)- _hdOchildInhs =- _lhsIchildInhs- -- copy rule (down)- _hdOchildSyns =- _lhsIchildSyns- -- copy rule (down)- _hdOcon =- _lhsIcon- -- copy rule (down)- _hdOdefs =- _lhsIdefs- -- copy rule (down)- _hdOnt =- _lhsInt- -- copy rule (down)- _tlOchildInhs =- _lhsIchildInhs- -- copy rule (down)- _tlOchildSyns =- _lhsIchildSyns- -- copy rule (down)- _tlOcon =- _lhsIcon- -- copy rule (down)- _tlOdefs =- _lhsIdefs- -- copy rule (down)- _tlOnt =- _lhsInt- ( _hdIcopy,_hdIdefsCollect,_hdIerrors,_hdIoutput) =- (hd_ _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOnt )- ( _tlIcopy,_tlIdefsCollect,_tlIerrors,_tlIoutput) =- (tl_ _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOnt )- in ( _lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))) )-sem_Patterns_Nil :: T_Patterns-sem_Patterns_Nil =- (T_Patterns (\ _lhsIchildInhs- _lhsIchildSyns- _lhsIcon- _lhsIdefs- _lhsInt ->- (let _lhsOdefsCollect :: (Set (Name, Name))- _lhsOerrors :: (Seq Error)- _lhsOcopy :: Patterns- _lhsOoutput :: Patterns- -- use rule "Desugar.ag"(line 156, column 52)- _lhsOdefsCollect =- Set.empty- -- use rule "Desugar.ag"(line 30, column 144)- _lhsOerrors =- Seq.empty- -- self rule- _copy =- []- -- self rule- _output =- []- -- self rule- _lhsOcopy =- _copy- -- self rule- _lhsOoutput =- _output- in ( _lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))) )--- Production ---------------------------------------------------{-- visit 0:- synthesized attributes:- errors : Seq Error- output : SELF- alternatives:- alternative Production:- child nt : {Nonterminal}- child inh : {Attributes}- child syn : {Attributes}- child alts : Alternatives- visit 0:- local output : _--}--- cata-sem_Production :: Production ->- T_Production-sem_Production (Production _nt _inh _syn _alts ) =- (sem_Production_Production _nt _inh _syn (sem_Alternatives _alts ) )--- semantic domain-newtype T_Production = T_Production (( (Seq Error),Production))-data Inh_Production = Inh_Production {}-data Syn_Production = Syn_Production {errors_Syn_Production :: Seq Error,output_Syn_Production :: Production}-wrap_Production (T_Production sem ) (Inh_Production ) =- (let ( _lhsOerrors,_lhsOoutput) =- (sem )- in (Syn_Production _lhsOerrors _lhsOoutput ))-sem_Production_Production :: Nonterminal ->- Attributes ->- Attributes ->- T_Alternatives ->- T_Production-sem_Production_Production nt_ inh_ syn_ (T_Alternatives alts_ ) =- (T_Production (let _altsOnt :: Nonterminal- _lhsOerrors :: (Seq Error)- _lhsOoutput :: Production- _altsIerrors :: (Seq Error)- _altsIoutput :: Alternatives- -- "Desugar.ag"(line 145, column 7)- _altsOnt =- nt_- -- use rule "Desugar.ag"(line 30, column 144)- _lhsOerrors =- _altsIerrors- -- self rule- _output =- Production nt_ inh_ syn_ _altsIoutput- -- self rule- _lhsOoutput =- _output- ( _altsIerrors,_altsIoutput) =- (alts_ _altsOnt )- in ( _lhsOerrors,_lhsOoutput)) )--- Productions --------------------------------------------------{-- visit 0:- synthesized attributes:- errors : Seq Error- output : SELF- alternatives:- alternative Cons:- child hd : Production- child tl : Productions- visit 0:- local output : _- alternative Nil:- visit 0:- local output : _--}--- 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 (( (Seq Error),Productions))-data Inh_Productions = Inh_Productions {}-data Syn_Productions = Syn_Productions {errors_Syn_Productions :: Seq Error,output_Syn_Productions :: Productions}-wrap_Productions (T_Productions sem ) (Inh_Productions ) =- (let ( _lhsOerrors,_lhsOoutput) =- (sem )- in (Syn_Productions _lhsOerrors _lhsOoutput ))-sem_Productions_Cons :: T_Production ->- T_Productions ->- T_Productions-sem_Productions_Cons (T_Production hd_ ) (T_Productions tl_ ) =- (T_Productions (let _lhsOerrors :: (Seq Error)- _lhsOoutput :: Productions- _hdIerrors :: (Seq Error)- _hdIoutput :: Production- _tlIerrors :: (Seq Error)- _tlIoutput :: Productions- -- use rule "Desugar.ag"(line 30, column 144)- _lhsOerrors =- _hdIerrors Seq.<> _tlIerrors- -- self rule- _output =- (:) _hdIoutput _tlIoutput- -- self rule- _lhsOoutput =- _output- ( _hdIerrors,_hdIoutput) =- (hd_ )- ( _tlIerrors,_tlIoutput) =- (tl_ )- in ( _lhsOerrors,_lhsOoutput)) )-sem_Productions_Nil :: T_Productions-sem_Productions_Nil =- (T_Productions (let _lhsOerrors :: (Seq Error)- _lhsOoutput :: Productions- -- use rule "Desugar.ag"(line 30, column 144)- _lhsOerrors =- Seq.empty- -- self rule- _output =- []- -- self rule- _lhsOoutput =- _output- in ( _lhsOerrors,_lhsOoutput)) )--- Rule ---------------------------------------------------------{-- visit 0:- inherited attributes:- childInhs : [(Name, Name)]- childSyns : [(Name, Name)]- con : Constructor- defs : Set (Name, Name)- nt : Nonterminal- synthesized attributes:- defsCollect : Set (Name, Name)- errors : Seq Error- output : SELF- alternatives:- alternative Rule:- child pattern : Pattern- child rhs : Expression- child owrt : {Bool}- child origin : {String}- visit 0:- local output : _--}--- cata-sem_Rule :: Rule ->- T_Rule-sem_Rule (Rule _pattern _rhs _owrt _origin ) =- (sem_Rule_Rule (sem_Pattern _pattern ) (sem_Expression _rhs ) _owrt _origin )--- semantic domain-newtype T_Rule = T_Rule (([(Name, Name)]) ->- ([(Name, Name)]) ->- Constructor ->- (Set (Name, Name)) ->- Nonterminal ->- ( (Set (Name, Name)),(Seq Error),Rule))-data Inh_Rule = Inh_Rule {childInhs_Inh_Rule :: [(Name, Name)],childSyns_Inh_Rule :: [(Name, Name)],con_Inh_Rule :: Constructor,defs_Inh_Rule :: Set (Name, Name),nt_Inh_Rule :: Nonterminal}-data Syn_Rule = Syn_Rule {defsCollect_Syn_Rule :: Set (Name, Name),errors_Syn_Rule :: Seq Error,output_Syn_Rule :: Rule}-wrap_Rule (T_Rule sem ) (Inh_Rule _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsInt ) =- (let ( _lhsOdefsCollect,_lhsOerrors,_lhsOoutput) =- (sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsInt )- in (Syn_Rule _lhsOdefsCollect _lhsOerrors _lhsOoutput ))-sem_Rule_Rule :: T_Pattern ->- T_Expression ->- Bool ->- String ->- T_Rule-sem_Rule_Rule (T_Pattern pattern_ ) (T_Expression rhs_ ) owrt_ origin_ =- (T_Rule (\ _lhsIchildInhs- _lhsIchildSyns- _lhsIcon- _lhsIdefs- _lhsInt ->- (let _lhsOdefsCollect :: (Set (Name, Name))- _lhsOerrors :: (Seq Error)- _lhsOoutput :: Rule- _patternOchildInhs :: ([(Name, Name)])- _patternOchildSyns :: ([(Name, Name)])- _patternOcon :: Constructor- _patternOdefs :: (Set (Name, Name))- _patternOnt :: Nonterminal- _rhsOchildInhs :: ([(Name, Name)])- _rhsOchildSyns :: ([(Name, Name)])- _rhsOcon :: Constructor- _rhsOnt :: Nonterminal- _patternIcopy :: Pattern- _patternIdefsCollect :: (Set (Name, Name))- _patternIerrors :: (Seq Error)- _patternIoutput :: Pattern- _rhsIerrors :: (Seq Error)- _rhsIoutput :: Expression- -- use rule "Desugar.ag"(line 156, column 52)- _lhsOdefsCollect =- _patternIdefsCollect- -- use rule "Desugar.ag"(line 30, column 144)- _lhsOerrors =- _patternIerrors Seq.<> _rhsIerrors- -- self rule- _output =- Rule _patternIoutput _rhsIoutput owrt_ origin_- -- self rule- _lhsOoutput =- _output- -- copy rule (down)- _patternOchildInhs =- _lhsIchildInhs- -- copy rule (down)- _patternOchildSyns =- _lhsIchildSyns- -- copy rule (down)- _patternOcon =- _lhsIcon- -- copy rule (down)- _patternOdefs =- _lhsIdefs- -- copy rule (down)- _patternOnt =- _lhsInt- -- copy rule (down)- _rhsOchildInhs =- _lhsIchildInhs- -- copy rule (down)- _rhsOchildSyns =- _lhsIchildSyns- -- copy rule (down)- _rhsOcon =- _lhsIcon- -- copy rule (down)- _rhsOnt =- _lhsInt- ( _patternIcopy,_patternIdefsCollect,_patternIerrors,_patternIoutput) =- (pattern_ _patternOchildInhs _patternOchildSyns _patternOcon _patternOdefs _patternOnt )- ( _rhsIerrors,_rhsIoutput) =- (rhs_ _rhsOchildInhs _rhsOchildSyns _rhsOcon _rhsOnt )- in ( _lhsOdefsCollect,_lhsOerrors,_lhsOoutput))) )--- Rules --------------------------------------------------------{-- visit 0:- inherited attributes:- childInhs : [(Name, Name)]- childSyns : [(Name, Name)]- con : Constructor- defs : Set (Name, Name)- nt : Nonterminal- synthesized attributes:- defsCollect : Set (Name, Name)- errors : Seq Error- output : SELF- alternatives:- alternative Cons:- child hd : Rule- child tl : Rules- visit 0:- local output : _- alternative Nil:- visit 0:- local output : _--}--- 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 (([(Name, Name)]) ->- ([(Name, Name)]) ->- Constructor ->- (Set (Name, Name)) ->- Nonterminal ->- ( (Set (Name, Name)),(Seq Error),Rules))-data Inh_Rules = Inh_Rules {childInhs_Inh_Rules :: [(Name, Name)],childSyns_Inh_Rules :: [(Name, Name)],con_Inh_Rules :: Constructor,defs_Inh_Rules :: Set (Name, Name),nt_Inh_Rules :: Nonterminal}-data Syn_Rules = Syn_Rules {defsCollect_Syn_Rules :: Set (Name, Name),errors_Syn_Rules :: Seq Error,output_Syn_Rules :: Rules}-wrap_Rules (T_Rules sem ) (Inh_Rules _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsInt ) =- (let ( _lhsOdefsCollect,_lhsOerrors,_lhsOoutput) =- (sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsInt )- in (Syn_Rules _lhsOdefsCollect _lhsOerrors _lhsOoutput ))-sem_Rules_Cons :: T_Rule ->- T_Rules ->- T_Rules-sem_Rules_Cons (T_Rule hd_ ) (T_Rules tl_ ) =- (T_Rules (\ _lhsIchildInhs- _lhsIchildSyns- _lhsIcon- _lhsIdefs- _lhsInt ->- (let _lhsOdefsCollect :: (Set (Name, Name))- _lhsOerrors :: (Seq Error)- _lhsOoutput :: Rules- _hdOchildInhs :: ([(Name, Name)])- _hdOchildSyns :: ([(Name, Name)])- _hdOcon :: Constructor- _hdOdefs :: (Set (Name, Name))- _hdOnt :: Nonterminal- _tlOchildInhs :: ([(Name, Name)])- _tlOchildSyns :: ([(Name, Name)])- _tlOcon :: Constructor- _tlOdefs :: (Set (Name, Name))- _tlOnt :: Nonterminal- _hdIdefsCollect :: (Set (Name, Name))- _hdIerrors :: (Seq Error)- _hdIoutput :: Rule- _tlIdefsCollect :: (Set (Name, Name))- _tlIerrors :: (Seq Error)- _tlIoutput :: Rules- -- use rule "Desugar.ag"(line 156, column 52)- _lhsOdefsCollect =- _hdIdefsCollect `Set.union` _tlIdefsCollect- -- use rule "Desugar.ag"(line 30, column 144)- _lhsOerrors =- _hdIerrors Seq.<> _tlIerrors- -- self rule- _output =- (:) _hdIoutput _tlIoutput- -- self rule- _lhsOoutput =- _output- -- copy rule (down)- _hdOchildInhs =- _lhsIchildInhs- -- copy rule (down)- _hdOchildSyns =- _lhsIchildSyns- -- copy rule (down)- _hdOcon =- _lhsIcon- -- copy rule (down)- _hdOdefs =- _lhsIdefs- -- copy rule (down)- _hdOnt =- _lhsInt- -- copy rule (down)- _tlOchildInhs =- _lhsIchildInhs- -- copy rule (down)- _tlOchildSyns =- _lhsIchildSyns- -- copy rule (down)- _tlOcon =- _lhsIcon- -- copy rule (down)- _tlOdefs =- _lhsIdefs- -- copy rule (down)- _tlOnt =- _lhsInt- ( _hdIdefsCollect,_hdIerrors,_hdIoutput) =- (hd_ _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOnt )- ( _tlIdefsCollect,_tlIerrors,_tlIoutput) =- (tl_ _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOnt )- in ( _lhsOdefsCollect,_lhsOerrors,_lhsOoutput))) )-sem_Rules_Nil :: T_Rules-sem_Rules_Nil =- (T_Rules (\ _lhsIchildInhs- _lhsIchildSyns- _lhsIcon- _lhsIdefs- _lhsInt ->- (let _lhsOdefsCollect :: (Set (Name, Name))- _lhsOerrors :: (Seq Error)- _lhsOoutput :: Rules- -- use rule "Desugar.ag"(line 156, column 52)- _lhsOdefsCollect =- Set.empty- -- use rule "Desugar.ag"(line 30, column 144)- _lhsOerrors =- Seq.empty- -- self rule- _output =- []- -- self rule- _lhsOoutput =- _output- in ( _lhsOdefsCollect,_lhsOerrors,_lhsOoutput))) )--- TypeSig ------------------------------------------------------{-- visit 0:- synthesized attribute:- output : SELF- alternatives:- alternative TypeSig:- child name : {Name}- child tp : {Type}- visit 0:- local output : _--}--- cata-sem_TypeSig :: TypeSig ->- T_TypeSig-sem_TypeSig (TypeSig _name _tp ) =- (sem_TypeSig_TypeSig _name _tp )--- semantic domain-newtype T_TypeSig = T_TypeSig (( TypeSig))-data Inh_TypeSig = Inh_TypeSig {}-data Syn_TypeSig = Syn_TypeSig {output_Syn_TypeSig :: TypeSig}-wrap_TypeSig (T_TypeSig sem ) (Inh_TypeSig ) =- (let ( _lhsOoutput) =- (sem )- in (Syn_TypeSig _lhsOoutput ))-sem_TypeSig_TypeSig :: Name ->- Type ->- T_TypeSig-sem_TypeSig_TypeSig name_ tp_ =- (T_TypeSig (let _lhsOoutput :: TypeSig- -- self rule- _output =- TypeSig name_ tp_- -- self rule- _lhsOoutput =- _output- in ( _lhsOoutput)) )--- TypeSigs -----------------------------------------------------{-- visit 0:- synthesized attribute:- output : SELF- alternatives:- alternative Cons:- child hd : TypeSig- child tl : TypeSigs- visit 0:- local output : _- alternative Nil:- visit 0:- local output : _--}--- 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 (( TypeSigs))-data Inh_TypeSigs = Inh_TypeSigs {}-data Syn_TypeSigs = Syn_TypeSigs {output_Syn_TypeSigs :: TypeSigs}-wrap_TypeSigs (T_TypeSigs sem ) (Inh_TypeSigs ) =- (let ( _lhsOoutput) =- (sem )- in (Syn_TypeSigs _lhsOoutput ))-sem_TypeSigs_Cons :: T_TypeSig ->- T_TypeSigs ->- T_TypeSigs-sem_TypeSigs_Cons (T_TypeSig hd_ ) (T_TypeSigs tl_ ) =- (T_TypeSigs (let _lhsOoutput :: TypeSigs- _hdIoutput :: TypeSig- _tlIoutput :: TypeSigs- -- self rule- _output =- (:) _hdIoutput _tlIoutput- -- self rule- _lhsOoutput =- _output- ( _hdIoutput) =- (hd_ )- ( _tlIoutput) =- (tl_ )- in ( _lhsOoutput)) )-sem_TypeSigs_Nil :: T_TypeSigs-sem_TypeSigs_Nil =- (T_TypeSigs (let _lhsOoutput :: TypeSigs- -- self rule- _output =- []- -- self rule- _lhsOoutput =- _output- in ( _lhsOoutput)) )+-- UUAGC 0.9.5 (Desugar.ag)+module Desugar where++import qualified Data.Set as Set+import qualified Data.Map as Map+import Data.Map(Map)+import qualified UU.DData.Seq as Seq+import UU.DData.Seq(Seq,(<>))+import UU.Scanner.Position(Pos(..))+import Maybe+import Data.List(intersperse)++import AbstractSyntax+import ErrorMessages+import Options+import HsToken+import HsTokenScanner+import TokenDef++-- AbstractSyntax.ag imports+import Data.Set(Set)+import Data.Map(Map)+import Patterns (Pattern(..),Patterns)+import Expression (Expression(..))+import CommonTypes++-- Patterns.ag imports+import UU.Scanner.Position(Pos)+import CommonTypes (ConstructorIdent,Identifier)++import UU.Scanner.Position(Pos)+import HsToken++import CommonTypes+import UU.Scanner.Position(Pos)++addl :: Int -> Pos -> Pos+addl n (Pos l c f) = Pos (l+n) c f++maybeError :: a -> Error -> Maybe a -> (a, Seq Error)+maybeError def err mb+ = maybe (def, Seq.single err) (\r -> (r, Seq.empty)) mb++findField :: Identifier -> Identifier -> [(Identifier,Identifier)] -> Maybe Identifier+findField fld attr list+ | fld == _FIRST = f list+ | fld == _LAST = f (reverse list)+ | otherwise = Just fld+ where+ f = lookup attr++mergeAttributes :: AttrMap -> AttrMap -> AttrMap+mergeAttributes = Map.unionWith $ Map.unionWith $ Set.union+-- Child -------------------------------------------------------+{-+ visit 0:+ synthesized attributes:+ childInhs : [(Identifier, Identifier)]+ childSyns : [(Identifier, Identifier)]+ output : SELF+ alternatives:+ alternative Child:+ child name : {Identifier}+ child tp : {Type}+ child inh : {Attributes}+ child syn : {Attributes}+ child higherOrder : {Bool}+ visit 0:+ local output : _+-}+-- cata+sem_Child :: Child ->+ T_Child+sem_Child (Child _name _tp _inh _syn _higherOrder) =+ (sem_Child_Child _name _tp _inh _syn _higherOrder)+-- semantic domain+newtype T_Child = T_Child (( ([(Identifier, Identifier)]),([(Identifier, Identifier)]),Child))+data Inh_Child = Inh_Child {}+data Syn_Child = Syn_Child {childInhs_Syn_Child :: [(Identifier, Identifier)],childSyns_Syn_Child :: [(Identifier, Identifier)],output_Syn_Child :: Child}+wrap_Child (T_Child sem) (Inh_Child ) =+ (let ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput) =+ (sem )+ in (Syn_Child _lhsOchildInhs _lhsOchildSyns _lhsOoutput))+sem_Child_Child :: Identifier ->+ Type ->+ Attributes ->+ Attributes ->+ Bool ->+ T_Child+sem_Child_Child name_ tp_ inh_ syn_ higherOrder_ =+ (T_Child (let _lhsOchildInhs :: ([(Identifier, Identifier)])+ _lhsOchildSyns :: ([(Identifier, Identifier)])+ _lhsOoutput :: Child+ -- "Desugar.ag"(line 123, column 7)+ _lhsOchildInhs =+ [(i, name_) | i <- Map.keys inh_ ]+ -- "Desugar.ag"(line 124, column 7)+ _lhsOchildSyns =+ [(s, name_) | s <- Map.keys syn_ ]+ -- self rule+ _output =+ Child name_ tp_ inh_ syn_ higherOrder_+ -- self rule+ _lhsOoutput =+ _output+ in ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput)))+-- Children ----------------------------------------------------+{-+ visit 0:+ synthesized attributes:+ childInhs : [(Identifier, Identifier)]+ childSyns : [(Identifier, Identifier)]+ output : SELF+ alternatives:+ alternative Cons:+ child hd : Child+ child tl : Children+ visit 0:+ local output : _+ alternative Nil:+ visit 0:+ local output : _+-}+-- 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 (( ([(Identifier, Identifier)]),([(Identifier, Identifier)]),Children))+data Inh_Children = Inh_Children {}+data Syn_Children = Syn_Children {childInhs_Syn_Children :: [(Identifier, Identifier)],childSyns_Syn_Children :: [(Identifier, Identifier)],output_Syn_Children :: Children}+wrap_Children (T_Children sem) (Inh_Children ) =+ (let ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput) =+ (sem )+ in (Syn_Children _lhsOchildInhs _lhsOchildSyns _lhsOoutput))+sem_Children_Cons :: T_Child ->+ T_Children ->+ T_Children+sem_Children_Cons (T_Child hd_) (T_Children tl_) =+ (T_Children (let _lhsOchildInhs :: ([(Identifier, Identifier)])+ _lhsOchildSyns :: ([(Identifier, Identifier)])+ _lhsOoutput :: Children+ _hdIchildInhs :: ([(Identifier, Identifier)])+ _hdIchildSyns :: ([(Identifier, Identifier)])+ _hdIoutput :: Child+ _tlIchildInhs :: ([(Identifier, Identifier)])+ _tlIchildSyns :: ([(Identifier, Identifier)])+ _tlIoutput :: Children+ -- use rule "Desugar.ag"(line 118, column 48)+ _lhsOchildInhs =+ _hdIchildInhs ++ _tlIchildInhs+ -- use rule "Desugar.ag"(line 118, column 48)+ _lhsOchildSyns =+ _hdIchildSyns ++ _tlIchildSyns+ -- self rule+ _output =+ (:) _hdIoutput _tlIoutput+ -- self rule+ _lhsOoutput =+ _output+ ( _hdIchildInhs,_hdIchildSyns,_hdIoutput) =+ (hd_ )+ ( _tlIchildInhs,_tlIchildSyns,_tlIoutput) =+ (tl_ )+ in ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput)))+sem_Children_Nil :: T_Children+sem_Children_Nil =+ (T_Children (let _lhsOchildInhs :: ([(Identifier, Identifier)])+ _lhsOchildSyns :: ([(Identifier, Identifier)])+ _lhsOoutput :: Children+ -- use rule "Desugar.ag"(line 118, column 48)+ _lhsOchildInhs =+ []+ -- use rule "Desugar.ag"(line 118, column 48)+ _lhsOchildSyns =+ []+ -- self rule+ _output =+ []+ -- self rule+ _lhsOoutput =+ _output+ in ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput)))+-- Expression --------------------------------------------------+{-+ visit 0:+ inherited attributes:+ childInhs : [(Identifier, Identifier)]+ childSyns : [(Identifier, Identifier)]+ con : ConstructorIdent+ nt : NontermIdent+ options : Options+ ruleDescr : String+ synthesized attributes:+ errors : Seq Error+ output : SELF+ alternatives:+ alternative Expression:+ child pos : {Pos}+ child tks : {[HsToken]}+ visit 0:+ local _tup1 : _+ local tks' : _+ local output : _+-}+-- cata+sem_Expression :: Expression ->+ T_Expression+sem_Expression (Expression _pos _tks) =+ (sem_Expression_Expression _pos _tks)+-- semantic domain+newtype T_Expression = T_Expression (([(Identifier, Identifier)]) ->+ ([(Identifier, Identifier)]) ->+ ConstructorIdent ->+ NontermIdent ->+ Options ->+ String ->+ ( (Seq Error),Expression))+data Inh_Expression = Inh_Expression {childInhs_Inh_Expression :: [(Identifier, Identifier)],childSyns_Inh_Expression :: [(Identifier, Identifier)],con_Inh_Expression :: ConstructorIdent,nt_Inh_Expression :: NontermIdent,options_Inh_Expression :: Options,ruleDescr_Inh_Expression :: String}+data Syn_Expression = Syn_Expression {errors_Syn_Expression :: Seq Error,output_Syn_Expression :: Expression}+wrap_Expression (T_Expression sem) (Inh_Expression _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIoptions _lhsIruleDescr) =+ (let ( _lhsOerrors,_lhsOoutput) =+ (sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIoptions _lhsIruleDescr)+ in (Syn_Expression _lhsOerrors _lhsOoutput))+sem_Expression_Expression :: Pos ->+ ([HsToken]) ->+ T_Expression+sem_Expression_Expression pos_ tks_ =+ (T_Expression (\ _lhsIchildInhs+ _lhsIchildSyns+ _lhsIcon+ _lhsInt+ _lhsIoptions+ _lhsIruleDescr ->+ (let _lhsOerrors :: (Seq Error)+ _lhsOoutput :: Expression+ -- "Desugar.ag"(line 42, column 7)+ __tup1 =+ let inh = Inh_HsTokensRoot { childInhs_Inh_HsTokensRoot = _lhsIchildInhs+ , childSyns_Inh_HsTokensRoot = _lhsIchildSyns+ , nt_Inh_HsTokensRoot = _lhsInt+ , con_Inh_HsTokensRoot = _lhsIcon+ , ruleDescr_Inh_HsTokensRoot = _lhsIruleDescr+ , useFieldIdent_Inh_HsTokensRoot = genUseTraces _lhsIoptions+ }+ sem = sem_HsTokensRoot (HsTokensRoot tks_)+ syn = wrap_HsTokensRoot sem inh+ in (tks_Syn_HsTokensRoot syn, errors_Syn_HsTokensRoot syn)+ -- "Desugar.ag"(line 42, column 7)+ (_tks',_) =+ __tup1+ -- "Desugar.ag"(line 42, column 7)+ (_,_lhsOerrors) =+ __tup1+ -- "Desugar.ag"(line 52, column 7)+ _lhsOoutput =+ Expression pos_ _tks'+ -- self rule+ _output =+ Expression pos_ tks_+ in ( _lhsOerrors,_lhsOoutput))))+-- Grammar -----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ forcedIrrefutables : AttrMap+ options : Options+ synthesized attributes:+ allAttributes : AttrMap+ errors : Seq Error+ output : SELF+ 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}+ visit 0:+ local output : _+-}+-- cata+sem_Grammar :: Grammar ->+ T_Grammar+sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap) =+ (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts) _pragmas _manualAttrOrderMap _paramMap _contextMap)+-- semantic domain+newtype T_Grammar = T_Grammar (AttrMap ->+ Options ->+ ( AttrMap,(Seq Error),Grammar))+data Inh_Grammar = Inh_Grammar {forcedIrrefutables_Inh_Grammar :: AttrMap,options_Inh_Grammar :: Options}+data Syn_Grammar = Syn_Grammar {allAttributes_Syn_Grammar :: AttrMap,errors_Syn_Grammar :: Seq Error,output_Syn_Grammar :: Grammar}+wrap_Grammar (T_Grammar sem) (Inh_Grammar _lhsIforcedIrrefutables _lhsIoptions) =+ (let ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) =+ (sem _lhsIforcedIrrefutables _lhsIoptions)+ in (Syn_Grammar _lhsOallAttributes _lhsOerrors _lhsOoutput))+sem_Grammar_Grammar :: TypeSyns ->+ UseMap ->+ Derivings ->+ (Set NontermIdent) ->+ T_Nonterminals ->+ PragmaMap ->+ AttrOrderMap ->+ ParamMap ->+ ContextMap ->+ T_Grammar+sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ =+ (T_Grammar (\ _lhsIforcedIrrefutables+ _lhsIoptions ->+ (let _lhsOallAttributes :: AttrMap+ _lhsOerrors :: (Seq Error)+ _lhsOoutput :: Grammar+ _nontsOforcedIrrefutables :: AttrMap+ _nontsOoptions :: Options+ _nontsIallAttributes :: AttrMap+ _nontsIerrors :: (Seq Error)+ _nontsIoutput :: Nonterminals+ -- use rule "Desugar.ag"(line 189, column 23)+ _lhsOallAttributes =+ _nontsIallAttributes+ -- use rule "Desugar.ag"(line 31, column 144)+ _lhsOerrors =+ _nontsIerrors+ -- self rule+ _output =+ Grammar typeSyns_ useMap_ derivings_ wrappers_ _nontsIoutput pragmas_ manualAttrOrderMap_ paramMap_ contextMap_+ -- self rule+ _lhsOoutput =+ _output+ -- copy rule (down)+ _nontsOforcedIrrefutables =+ _lhsIforcedIrrefutables+ -- copy rule (down)+ _nontsOoptions =+ _lhsIoptions+ ( _nontsIallAttributes,_nontsIerrors,_nontsIoutput) =+ (nonts_ _nontsOforcedIrrefutables _nontsOoptions)+ in ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput))))+-- HsToken -----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ childInhs : [(Identifier, Identifier)]+ childSyns : [(Identifier, Identifier)]+ con : ConstructorIdent+ nt : NontermIdent+ ruleDescr : String+ useFieldIdent : Bool+ chained attribute:+ addLines : Int+ synthesized attributes:+ errors : Seq Error+ tks : SELF+ alternatives:+ alternative AGField:+ child field : {Identifier}+ child attr : {Identifier}+ child pos : {Pos}+ child rdesc : {Maybe String}+ visit 0:+ local mField : _+ local field' : _+ local tks : _+ alternative AGLocal:+ child var : {Identifier}+ child pos : {Pos}+ child rdesc : {Maybe String}+ visit 0:+ local tks : _+ alternative CharToken:+ child value : {String}+ child pos : {Pos}+ visit 0:+ local tks : _+ alternative Err:+ child mesg : {String}+ child pos : {Pos}+ visit 0:+ local tks : _+ alternative HsToken:+ child value : {String}+ child pos : {Pos}+ visit 0:+ local tks : _+ alternative StrToken:+ child value : {String}+ child pos : {Pos}+ visit 0:+ local tks : _+-}+-- 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 (Int ->+ ([(Identifier, Identifier)]) ->+ ([(Identifier, Identifier)]) ->+ ConstructorIdent ->+ NontermIdent ->+ String ->+ Bool ->+ ( Int,(Seq Error),HsToken))+data Inh_HsToken = Inh_HsToken {addLines_Inh_HsToken :: Int,childInhs_Inh_HsToken :: [(Identifier, Identifier)],childSyns_Inh_HsToken :: [(Identifier, Identifier)],con_Inh_HsToken :: ConstructorIdent,nt_Inh_HsToken :: NontermIdent,ruleDescr_Inh_HsToken :: String,useFieldIdent_Inh_HsToken :: Bool}+data Syn_HsToken = Syn_HsToken {addLines_Syn_HsToken :: Int,errors_Syn_HsToken :: Seq Error,tks_Syn_HsToken :: HsToken}+wrap_HsToken (T_HsToken sem) (Inh_HsToken _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) =+ (let ( _lhsOaddLines,_lhsOerrors,_lhsOtks) =+ (sem _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent)+ in (Syn_HsToken _lhsOaddLines _lhsOerrors _lhsOtks))+sem_HsToken_AGField :: Identifier ->+ Identifier ->+ Pos ->+ (Maybe String) ->+ T_HsToken+sem_HsToken_AGField field_ attr_ pos_ rdesc_ =+ (T_HsToken (\ _lhsIaddLines+ _lhsIchildInhs+ _lhsIchildSyns+ _lhsIcon+ _lhsInt+ _lhsIruleDescr+ _lhsIuseFieldIdent ->+ (let _lhsOerrors :: (Seq Error)+ _lhsOaddLines :: Int+ _lhsOtks :: HsToken+ -- "Desugar.ag"(line 72, column 7)+ _mField =+ findField field_ attr_ _lhsIchildSyns+ -- "Desugar.ag"(line 74, column 7)+ _field' =+ maybe field_ id _mField+ -- "Desugar.ag"(line 75, column 7)+ _lhsOerrors =+ maybe (Seq.single (UndefAttr _lhsInt _lhsIcon field_ (Ident "<ANY>" (getPos field_)) False)) (const Seq.empty) _mField+ -- "Desugar.ag"(line 77, column 7)+ _lhsOaddLines =+ if _lhsIuseFieldIdent || length (getName field_) < length (getName _field' )+ then _lhsIaddLines + 1+ else _lhsIaddLines+ -- "Desugar.ag"(line 81, column 7)+ _tks =+ AGField field_ attr_ (addl _lhsIaddLines pos_) (if _lhsIuseFieldIdent then Just _lhsIruleDescr else Nothing)+ -- self rule+ _lhsOtks =+ _tks+ in ( _lhsOaddLines,_lhsOerrors,_lhsOtks))))+sem_HsToken_AGLocal :: Identifier ->+ Pos ->+ (Maybe String) ->+ T_HsToken+sem_HsToken_AGLocal var_ pos_ rdesc_ =+ (T_HsToken (\ _lhsIaddLines+ _lhsIchildInhs+ _lhsIchildSyns+ _lhsIcon+ _lhsInt+ _lhsIruleDescr+ _lhsIuseFieldIdent ->+ (let _lhsOaddLines :: Int+ _lhsOerrors :: (Seq Error)+ _lhsOtks :: HsToken+ -- "Desugar.ag"(line 67, column 7)+ _lhsOaddLines =+ if _lhsIuseFieldIdent+ then _lhsIaddLines + 1+ else _lhsIaddLines+ -- "Desugar.ag"(line 70, column 7)+ _tks =+ AGLocal var_ (addl _lhsIaddLines pos_) (if _lhsIuseFieldIdent then Just _lhsIruleDescr else Nothing)+ -- use rule "Desugar.ag"(line 31, column 144)+ _lhsOerrors =+ Seq.empty+ -- self rule+ _lhsOtks =+ _tks+ in ( _lhsOaddLines,_lhsOerrors,_lhsOtks))))+sem_HsToken_CharToken :: String ->+ Pos ->+ T_HsToken+sem_HsToken_CharToken value_ pos_ =+ (T_HsToken (\ _lhsIaddLines+ _lhsIchildInhs+ _lhsIchildSyns+ _lhsIcon+ _lhsInt+ _lhsIruleDescr+ _lhsIuseFieldIdent ->+ (let _lhsOerrors :: (Seq Error)+ _lhsOtks :: HsToken+ _lhsOaddLines :: Int+ -- "Desugar.ag"(line 85, column 7)+ _tks =+ CharToken value_ (addl _lhsIaddLines pos_)+ -- use rule "Desugar.ag"(line 31, column 144)+ _lhsOerrors =+ Seq.empty+ -- self rule+ _lhsOtks =+ _tks+ -- copy rule (chain)+ _lhsOaddLines =+ _lhsIaddLines+ in ( _lhsOaddLines,_lhsOerrors,_lhsOtks))))+sem_HsToken_Err :: String ->+ Pos ->+ T_HsToken+sem_HsToken_Err mesg_ pos_ =+ (T_HsToken (\ _lhsIaddLines+ _lhsIchildInhs+ _lhsIchildSyns+ _lhsIcon+ _lhsInt+ _lhsIruleDescr+ _lhsIuseFieldIdent ->+ (let _lhsOerrors :: (Seq Error)+ _lhsOtks :: HsToken+ _lhsOaddLines :: Int+ -- "Desugar.ag"(line 89, column 7)+ _tks =+ Err mesg_ (addl _lhsIaddLines pos_)+ -- use rule "Desugar.ag"(line 31, column 144)+ _lhsOerrors =+ Seq.empty+ -- self rule+ _lhsOtks =+ _tks+ -- copy rule (chain)+ _lhsOaddLines =+ _lhsIaddLines+ in ( _lhsOaddLines,_lhsOerrors,_lhsOtks))))+sem_HsToken_HsToken :: String ->+ Pos ->+ T_HsToken+sem_HsToken_HsToken value_ pos_ =+ (T_HsToken (\ _lhsIaddLines+ _lhsIchildInhs+ _lhsIchildSyns+ _lhsIcon+ _lhsInt+ _lhsIruleDescr+ _lhsIuseFieldIdent ->+ (let _lhsOerrors :: (Seq Error)+ _lhsOtks :: HsToken+ _lhsOaddLines :: Int+ -- "Desugar.ag"(line 83, column 7)+ _tks =+ HsToken value_ (addl _lhsIaddLines pos_)+ -- use rule "Desugar.ag"(line 31, column 144)+ _lhsOerrors =+ Seq.empty+ -- self rule+ _lhsOtks =+ _tks+ -- copy rule (chain)+ _lhsOaddLines =+ _lhsIaddLines+ in ( _lhsOaddLines,_lhsOerrors,_lhsOtks))))+sem_HsToken_StrToken :: String ->+ Pos ->+ T_HsToken+sem_HsToken_StrToken value_ pos_ =+ (T_HsToken (\ _lhsIaddLines+ _lhsIchildInhs+ _lhsIchildSyns+ _lhsIcon+ _lhsInt+ _lhsIruleDescr+ _lhsIuseFieldIdent ->+ (let _lhsOerrors :: (Seq Error)+ _lhsOtks :: HsToken+ _lhsOaddLines :: Int+ -- "Desugar.ag"(line 87, column 7)+ _tks =+ StrToken value_ (addl _lhsIaddLines pos_)+ -- use rule "Desugar.ag"(line 31, column 144)+ _lhsOerrors =+ Seq.empty+ -- self rule+ _lhsOtks =+ _tks+ -- copy rule (chain)+ _lhsOaddLines =+ _lhsIaddLines+ in ( _lhsOaddLines,_lhsOerrors,_lhsOtks))))+-- HsTokens ----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ childInhs : [(Identifier, Identifier)]+ childSyns : [(Identifier, Identifier)]+ con : ConstructorIdent+ nt : NontermIdent+ ruleDescr : String+ useFieldIdent : Bool+ chained attribute:+ addLines : Int+ synthesized attributes:+ errors : Seq Error+ tks : SELF+ alternatives:+ alternative Cons:+ child hd : HsToken+ child tl : HsTokens+ visit 0:+ local tks : _+ alternative Nil:+ visit 0:+ local tks : _+-}+-- 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 (Int ->+ ([(Identifier, Identifier)]) ->+ ([(Identifier, Identifier)]) ->+ ConstructorIdent ->+ NontermIdent ->+ String ->+ Bool ->+ ( Int,(Seq Error),HsTokens))+data Inh_HsTokens = Inh_HsTokens {addLines_Inh_HsTokens :: Int,childInhs_Inh_HsTokens :: [(Identifier, Identifier)],childSyns_Inh_HsTokens :: [(Identifier, Identifier)],con_Inh_HsTokens :: ConstructorIdent,nt_Inh_HsTokens :: NontermIdent,ruleDescr_Inh_HsTokens :: String,useFieldIdent_Inh_HsTokens :: Bool}+data Syn_HsTokens = Syn_HsTokens {addLines_Syn_HsTokens :: Int,errors_Syn_HsTokens :: Seq Error,tks_Syn_HsTokens :: HsTokens}+wrap_HsTokens (T_HsTokens sem) (Inh_HsTokens _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) =+ (let ( _lhsOaddLines,_lhsOerrors,_lhsOtks) =+ (sem _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent)+ in (Syn_HsTokens _lhsOaddLines _lhsOerrors _lhsOtks))+sem_HsTokens_Cons :: T_HsToken ->+ T_HsTokens ->+ T_HsTokens+sem_HsTokens_Cons (T_HsToken hd_) (T_HsTokens tl_) =+ (T_HsTokens (\ _lhsIaddLines+ _lhsIchildInhs+ _lhsIchildSyns+ _lhsIcon+ _lhsInt+ _lhsIruleDescr+ _lhsIuseFieldIdent ->+ (let _lhsOerrors :: (Seq Error)+ _lhsOtks :: HsTokens+ _lhsOaddLines :: Int+ _hdOaddLines :: Int+ _hdOchildInhs :: ([(Identifier, Identifier)])+ _hdOchildSyns :: ([(Identifier, Identifier)])+ _hdOcon :: ConstructorIdent+ _hdOnt :: NontermIdent+ _hdOruleDescr :: String+ _hdOuseFieldIdent :: Bool+ _tlOaddLines :: Int+ _tlOchildInhs :: ([(Identifier, Identifier)])+ _tlOchildSyns :: ([(Identifier, Identifier)])+ _tlOcon :: ConstructorIdent+ _tlOnt :: NontermIdent+ _tlOruleDescr :: String+ _tlOuseFieldIdent :: Bool+ _hdIaddLines :: Int+ _hdIerrors :: (Seq Error)+ _hdItks :: HsToken+ _tlIaddLines :: Int+ _tlIerrors :: (Seq Error)+ _tlItks :: HsTokens+ -- use rule "Desugar.ag"(line 31, column 144)+ _lhsOerrors =+ _hdIerrors Seq.<> _tlIerrors+ -- self rule+ _tks =+ (:) _hdItks _tlItks+ -- self rule+ _lhsOtks =+ _tks+ -- copy rule (up)+ _lhsOaddLines =+ _tlIaddLines+ -- copy rule (down)+ _hdOaddLines =+ _lhsIaddLines+ -- copy rule (down)+ _hdOchildInhs =+ _lhsIchildInhs+ -- copy rule (down)+ _hdOchildSyns =+ _lhsIchildSyns+ -- copy rule (down)+ _hdOcon =+ _lhsIcon+ -- copy rule (down)+ _hdOnt =+ _lhsInt+ -- copy rule (down)+ _hdOruleDescr =+ _lhsIruleDescr+ -- copy rule (down)+ _hdOuseFieldIdent =+ _lhsIuseFieldIdent+ -- copy rule (chain)+ _tlOaddLines =+ _hdIaddLines+ -- copy rule (down)+ _tlOchildInhs =+ _lhsIchildInhs+ -- copy rule (down)+ _tlOchildSyns =+ _lhsIchildSyns+ -- copy rule (down)+ _tlOcon =+ _lhsIcon+ -- copy rule (down)+ _tlOnt =+ _lhsInt+ -- copy rule (down)+ _tlOruleDescr =+ _lhsIruleDescr+ -- copy rule (down)+ _tlOuseFieldIdent =+ _lhsIuseFieldIdent+ ( _hdIaddLines,_hdIerrors,_hdItks) =+ (hd_ _hdOaddLines _hdOchildInhs _hdOchildSyns _hdOcon _hdOnt _hdOruleDescr _hdOuseFieldIdent)+ ( _tlIaddLines,_tlIerrors,_tlItks) =+ (tl_ _tlOaddLines _tlOchildInhs _tlOchildSyns _tlOcon _tlOnt _tlOruleDescr _tlOuseFieldIdent)+ in ( _lhsOaddLines,_lhsOerrors,_lhsOtks))))+sem_HsTokens_Nil :: T_HsTokens+sem_HsTokens_Nil =+ (T_HsTokens (\ _lhsIaddLines+ _lhsIchildInhs+ _lhsIchildSyns+ _lhsIcon+ _lhsInt+ _lhsIruleDescr+ _lhsIuseFieldIdent ->+ (let _lhsOerrors :: (Seq Error)+ _lhsOtks :: HsTokens+ _lhsOaddLines :: Int+ -- use rule "Desugar.ag"(line 31, column 144)+ _lhsOerrors =+ Seq.empty+ -- self rule+ _tks =+ []+ -- self rule+ _lhsOtks =+ _tks+ -- copy rule (chain)+ _lhsOaddLines =+ _lhsIaddLines+ in ( _lhsOaddLines,_lhsOerrors,_lhsOtks))))+-- HsTokensRoot ------------------------------------------------+{-+ visit 0:+ inherited attributes:+ childInhs : [(Identifier, Identifier)]+ childSyns : [(Identifier, Identifier)]+ con : ConstructorIdent+ nt : NontermIdent+ ruleDescr : String+ useFieldIdent : Bool+ synthesized attributes:+ errors : Seq Error+ tks : [HsToken]+ 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 (([(Identifier, Identifier)]) ->+ ([(Identifier, Identifier)]) ->+ ConstructorIdent ->+ NontermIdent ->+ String ->+ Bool ->+ ( (Seq Error),([HsToken])))+data Inh_HsTokensRoot = Inh_HsTokensRoot {childInhs_Inh_HsTokensRoot :: [(Identifier, Identifier)],childSyns_Inh_HsTokensRoot :: [(Identifier, Identifier)],con_Inh_HsTokensRoot :: ConstructorIdent,nt_Inh_HsTokensRoot :: NontermIdent,ruleDescr_Inh_HsTokensRoot :: String,useFieldIdent_Inh_HsTokensRoot :: Bool}+data Syn_HsTokensRoot = Syn_HsTokensRoot {errors_Syn_HsTokensRoot :: Seq Error,tks_Syn_HsTokensRoot :: [HsToken]}+wrap_HsTokensRoot (T_HsTokensRoot sem) (Inh_HsTokensRoot _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) =+ (let ( _lhsOerrors,_lhsOtks) =+ (sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent)+ in (Syn_HsTokensRoot _lhsOerrors _lhsOtks))+sem_HsTokensRoot_HsTokensRoot :: T_HsTokens ->+ T_HsTokensRoot+sem_HsTokensRoot_HsTokensRoot (T_HsTokens tokens_) =+ (T_HsTokensRoot (\ _lhsIchildInhs+ _lhsIchildSyns+ _lhsIcon+ _lhsInt+ _lhsIruleDescr+ _lhsIuseFieldIdent ->+ (let _tokensOaddLines :: Int+ _lhsOerrors :: (Seq Error)+ _lhsOtks :: ([HsToken])+ _tokensOchildInhs :: ([(Identifier, Identifier)])+ _tokensOchildSyns :: ([(Identifier, Identifier)])+ _tokensOcon :: ConstructorIdent+ _tokensOnt :: NontermIdent+ _tokensOruleDescr :: String+ _tokensOuseFieldIdent :: Bool+ _tokensIaddLines :: Int+ _tokensIerrors :: (Seq Error)+ _tokensItks :: HsTokens+ -- "Desugar.ag"(line 60, column 7)+ _tokensOaddLines =+ 0+ -- use rule "Desugar.ag"(line 31, column 144)+ _lhsOerrors =+ _tokensIerrors+ -- copy rule (up)+ _lhsOtks =+ _tokensItks+ -- copy rule (down)+ _tokensOchildInhs =+ _lhsIchildInhs+ -- copy rule (down)+ _tokensOchildSyns =+ _lhsIchildSyns+ -- copy rule (down)+ _tokensOcon =+ _lhsIcon+ -- copy rule (down)+ _tokensOnt =+ _lhsInt+ -- copy rule (down)+ _tokensOruleDescr =+ _lhsIruleDescr+ -- copy rule (down)+ _tokensOuseFieldIdent =+ _lhsIuseFieldIdent+ ( _tokensIaddLines,_tokensIerrors,_tokensItks) =+ (tokens_ _tokensOaddLines _tokensOchildInhs _tokensOchildSyns _tokensOcon _tokensOnt _tokensOruleDescr _tokensOuseFieldIdent)+ in ( _lhsOerrors,_lhsOtks))))+-- Nonterminal -------------------------------------------------+{-+ visit 0:+ inherited attributes:+ forcedIrrefutables : AttrMap+ options : Options+ synthesized attributes:+ allAttributes : AttrMap+ errors : Seq Error+ output : SELF+ alternatives:+ alternative Nonterminal:+ child nt : {NontermIdent}+ child params : {[Identifier]}+ child inh : {Attributes}+ child syn : {Attributes}+ child prods : Productions+ visit 0:+ local output : _+-}+-- 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 (AttrMap ->+ Options ->+ ( AttrMap,(Seq Error),Nonterminal))+data Inh_Nonterminal = Inh_Nonterminal {forcedIrrefutables_Inh_Nonterminal :: AttrMap,options_Inh_Nonterminal :: Options}+data Syn_Nonterminal = Syn_Nonterminal {allAttributes_Syn_Nonterminal :: AttrMap,errors_Syn_Nonterminal :: Seq Error,output_Syn_Nonterminal :: Nonterminal}+wrap_Nonterminal (T_Nonterminal sem) (Inh_Nonterminal _lhsIforcedIrrefutables _lhsIoptions) =+ (let ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) =+ (sem _lhsIforcedIrrefutables _lhsIoptions)+ in (Syn_Nonterminal _lhsOallAttributes _lhsOerrors _lhsOoutput))+sem_Nonterminal_Nonterminal :: NontermIdent ->+ ([Identifier]) ->+ Attributes ->+ Attributes ->+ T_Productions ->+ T_Nonterminal+sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ (T_Productions prods_) =+ (T_Nonterminal (\ _lhsIforcedIrrefutables+ _lhsIoptions ->+ (let _prodsOnt :: NontermIdent+ _lhsOallAttributes :: AttrMap+ _lhsOerrors :: (Seq Error)+ _lhsOoutput :: Nonterminal+ _prodsOforcedIrrefutables :: AttrMap+ _prodsOoptions :: Options+ _prodsIallAttributes :: AttrMap+ _prodsIerrors :: (Seq Error)+ _prodsIoutput :: Productions+ -- "Desugar.ag"(line 150, column 7)+ _prodsOnt =+ nt_+ -- use rule "Desugar.ag"(line 189, column 23)+ _lhsOallAttributes =+ _prodsIallAttributes+ -- use rule "Desugar.ag"(line 31, column 144)+ _lhsOerrors =+ _prodsIerrors+ -- self rule+ _output =+ Nonterminal nt_ params_ inh_ syn_ _prodsIoutput+ -- self rule+ _lhsOoutput =+ _output+ -- copy rule (down)+ _prodsOforcedIrrefutables =+ _lhsIforcedIrrefutables+ -- copy rule (down)+ _prodsOoptions =+ _lhsIoptions+ ( _prodsIallAttributes,_prodsIerrors,_prodsIoutput) =+ (prods_ _prodsOforcedIrrefutables _prodsOnt _prodsOoptions)+ in ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput))))+-- Nonterminals ------------------------------------------------+{-+ visit 0:+ inherited attributes:+ forcedIrrefutables : AttrMap+ options : Options+ synthesized attributes:+ allAttributes : AttrMap+ errors : Seq Error+ output : SELF+ alternatives:+ alternative Cons:+ child hd : Nonterminal+ child tl : Nonterminals+ visit 0:+ local output : _+ alternative Nil:+ visit 0:+ local output : _+-}+-- 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 (AttrMap ->+ Options ->+ ( AttrMap,(Seq Error),Nonterminals))+data Inh_Nonterminals = Inh_Nonterminals {forcedIrrefutables_Inh_Nonterminals :: AttrMap,options_Inh_Nonterminals :: Options}+data Syn_Nonterminals = Syn_Nonterminals {allAttributes_Syn_Nonterminals :: AttrMap,errors_Syn_Nonterminals :: Seq Error,output_Syn_Nonterminals :: Nonterminals}+wrap_Nonterminals (T_Nonterminals sem) (Inh_Nonterminals _lhsIforcedIrrefutables _lhsIoptions) =+ (let ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) =+ (sem _lhsIforcedIrrefutables _lhsIoptions)+ in (Syn_Nonterminals _lhsOallAttributes _lhsOerrors _lhsOoutput))+sem_Nonterminals_Cons :: T_Nonterminal ->+ T_Nonterminals ->+ T_Nonterminals+sem_Nonterminals_Cons (T_Nonterminal hd_) (T_Nonterminals tl_) =+ (T_Nonterminals (\ _lhsIforcedIrrefutables+ _lhsIoptions ->+ (let _lhsOallAttributes :: AttrMap+ _lhsOerrors :: (Seq Error)+ _lhsOoutput :: Nonterminals+ _hdOforcedIrrefutables :: AttrMap+ _hdOoptions :: Options+ _tlOforcedIrrefutables :: AttrMap+ _tlOoptions :: Options+ _hdIallAttributes :: AttrMap+ _hdIerrors :: (Seq Error)+ _hdIoutput :: Nonterminal+ _tlIallAttributes :: AttrMap+ _tlIerrors :: (Seq Error)+ _tlIoutput :: Nonterminals+ -- use rule "Desugar.ag"(line 189, column 23)+ _lhsOallAttributes =+ _hdIallAttributes `mergeAttributes` _tlIallAttributes+ -- use rule "Desugar.ag"(line 31, column 144)+ _lhsOerrors =+ _hdIerrors Seq.<> _tlIerrors+ -- self rule+ _output =+ (:) _hdIoutput _tlIoutput+ -- self rule+ _lhsOoutput =+ _output+ -- copy rule (down)+ _hdOforcedIrrefutables =+ _lhsIforcedIrrefutables+ -- copy rule (down)+ _hdOoptions =+ _lhsIoptions+ -- copy rule (down)+ _tlOforcedIrrefutables =+ _lhsIforcedIrrefutables+ -- copy rule (down)+ _tlOoptions =+ _lhsIoptions+ ( _hdIallAttributes,_hdIerrors,_hdIoutput) =+ (hd_ _hdOforcedIrrefutables _hdOoptions)+ ( _tlIallAttributes,_tlIerrors,_tlIoutput) =+ (tl_ _tlOforcedIrrefutables _tlOoptions)+ in ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput))))+sem_Nonterminals_Nil :: T_Nonterminals+sem_Nonterminals_Nil =+ (T_Nonterminals (\ _lhsIforcedIrrefutables+ _lhsIoptions ->+ (let _lhsOallAttributes :: AttrMap+ _lhsOerrors :: (Seq Error)+ _lhsOoutput :: Nonterminals+ -- use rule "Desugar.ag"(line 189, column 23)+ _lhsOallAttributes =+ Map.empty+ -- use rule "Desugar.ag"(line 31, column 144)+ _lhsOerrors =+ Seq.empty+ -- self rule+ _output =+ []+ -- self rule+ _lhsOoutput =+ _output+ in ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput))))+-- Pattern -----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ childInhs : [(Identifier, Identifier)]+ childSyns : [(Identifier, Identifier)]+ con : ConstructorIdent+ defs : Set (Identifier, Identifier)+ forcedIrrefutables : AttrMap+ nt : NontermIdent+ synthesized attributes:+ allAttributes : AttrMap+ copy : SELF+ defsCollect : Set (Identifier, Identifier)+ errors : Seq Error+ output : SELF+ alternatives:+ alternative Alias:+ child field : {Identifier}+ child attr : {Identifier}+ child pat : Pattern+ child parts : Patterns+ visit 0:+ local _tup2 : _+ local field' : _+ local err1 : _+ local err2 : _+ local output : _+ local def : _+ local copy : _+ alternative Constr:+ child name : {ConstructorIdent}+ child pats : Patterns+ visit 0:+ local copy : _+ local output : _+ alternative Irrefutable:+ child pat : Pattern+ visit 0:+ local copy : _+ local output : _+ alternative Product:+ child pos : {Pos}+ child pats : Patterns+ visit 0:+ local copy : _+ local output : _+ alternative Underscore:+ child pos : {Pos}+ visit 0:+ local copy : _+ local output : _+-}+-- 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 (([(Identifier, Identifier)]) ->+ ([(Identifier, Identifier)]) ->+ ConstructorIdent ->+ (Set (Identifier, Identifier)) ->+ AttrMap ->+ NontermIdent ->+ ( AttrMap,Pattern,(Set (Identifier, Identifier)),(Seq Error),Pattern))+data Inh_Pattern = Inh_Pattern {childInhs_Inh_Pattern :: [(Identifier, Identifier)],childSyns_Inh_Pattern :: [(Identifier, Identifier)],con_Inh_Pattern :: ConstructorIdent,defs_Inh_Pattern :: Set (Identifier, Identifier),forcedIrrefutables_Inh_Pattern :: AttrMap,nt_Inh_Pattern :: NontermIdent}+data Syn_Pattern = Syn_Pattern {allAttributes_Syn_Pattern :: AttrMap,copy_Syn_Pattern :: Pattern,defsCollect_Syn_Pattern :: Set (Identifier, Identifier),errors_Syn_Pattern :: Seq Error,output_Syn_Pattern :: Pattern}+wrap_Pattern (T_Pattern sem) (Inh_Pattern _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) =+ (let ( _lhsOallAttributes,_lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput) =+ (sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt)+ in (Syn_Pattern _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput))+sem_Pattern_Alias :: Identifier ->+ Identifier ->+ T_Pattern ->+ T_Patterns ->+ T_Pattern+sem_Pattern_Alias field_ attr_ (T_Pattern pat_) (T_Patterns parts_) =+ (T_Pattern (\ _lhsIchildInhs+ _lhsIchildSyns+ _lhsIcon+ _lhsIdefs+ _lhsIforcedIrrefutables+ _lhsInt ->+ (let _lhsOerrors :: (Seq Error)+ _lhsOdefsCollect :: (Set (Identifier, Identifier))+ _lhsOallAttributes :: AttrMap+ _lhsOoutput :: Pattern+ _lhsOcopy :: Pattern+ _patOchildInhs :: ([(Identifier, Identifier)])+ _patOchildSyns :: ([(Identifier, Identifier)])+ _patOcon :: ConstructorIdent+ _patOdefs :: (Set (Identifier, Identifier))+ _patOforcedIrrefutables :: AttrMap+ _patOnt :: NontermIdent+ _partsOchildInhs :: ([(Identifier, Identifier)])+ _partsOchildSyns :: ([(Identifier, Identifier)])+ _partsOcon :: ConstructorIdent+ _partsOdefs :: (Set (Identifier, Identifier))+ _partsOforcedIrrefutables :: AttrMap+ _partsOnt :: NontermIdent+ _patIallAttributes :: AttrMap+ _patIcopy :: Pattern+ _patIdefsCollect :: (Set (Identifier, Identifier))+ _patIerrors :: (Seq Error)+ _patIoutput :: Pattern+ _partsIallAttributes :: AttrMap+ _partsIcopy :: Patterns+ _partsIdefsCollect :: (Set (Identifier, Identifier))+ _partsIerrors :: (Seq Error)+ _partsIoutput :: Patterns+ -- "Desugar.ag"(line 103, column 7)+ __tup2 =+ maybeError field_ (UndefAttr _lhsInt _lhsIcon (Ident "<ANY>" (getPos field_)) attr_ True) $+ findField field_ attr_ _lhsIchildInhs+ -- "Desugar.ag"(line 103, column 7)+ (_field',_) =+ __tup2+ -- "Desugar.ag"(line 103, column 7)+ (_,_err1) =+ __tup2+ -- "Desugar.ag"(line 105, column 7)+ _err2 =+ if _field' == field_+ then Seq.empty+ else if (_field' , attr_) `Set.member` _lhsIdefs+ then Seq.single $ DupRule _lhsInt _lhsIcon field_ attr_ _field'+ else Seq.empty+ -- "Desugar.ag"(line 110, column 7)+ _lhsOerrors =+ _err1 Seq.<> _err2 Seq.<> _patIerrors <> _partsIerrors+ -- "Desugar.ag"(line 111, column 7)+ _output =+ Alias _field' attr_ _patIoutput _partsIoutput+ -- "Desugar.ag"(line 175, column 7)+ _def =+ Set.singleton (field_, attr_)+ -- "Desugar.ag"(line 176, column 7)+ _lhsOdefsCollect =+ _def `Set.union` _patIdefsCollect `Set.union` _partsIdefsCollect+ -- "Desugar.ag"(line 193, column 7)+ _lhsOallAttributes =+ (Map.singleton _lhsInt $ Map.singleton _lhsIcon $ Set.singleton (field_, attr_)) `mergeAttributes` _patIallAttributes+ -- "Desugar.ag"(line 212, column 7)+ _lhsOoutput =+ if Set.member (field_, attr_) $ Map.findWithDefault Set.empty _lhsIcon $ Map.findWithDefault Map.empty _lhsInt $ _lhsIforcedIrrefutables+ then Irrefutable _output+ else _output+ -- self rule+ _copy =+ Alias field_ attr_ _patIcopy _partsIcopy+ -- self rule+ _lhsOcopy =+ _copy+ -- copy rule (down)+ _patOchildInhs =+ _lhsIchildInhs+ -- copy rule (down)+ _patOchildSyns =+ _lhsIchildSyns+ -- copy rule (down)+ _patOcon =+ _lhsIcon+ -- copy rule (down)+ _patOdefs =+ _lhsIdefs+ -- copy rule (down)+ _patOforcedIrrefutables =+ _lhsIforcedIrrefutables+ -- copy rule (down)+ _patOnt =+ _lhsInt+ -- copy rule (down)+ _partsOchildInhs =+ _lhsIchildInhs+ -- copy rule (down)+ _partsOchildSyns =+ _lhsIchildSyns+ -- copy rule (down)+ _partsOcon =+ _lhsIcon+ -- copy rule (down)+ _partsOdefs =+ _lhsIdefs+ -- copy rule (down)+ _partsOforcedIrrefutables =+ _lhsIforcedIrrefutables+ -- copy rule (down)+ _partsOnt =+ _lhsInt+ ( _patIallAttributes,_patIcopy,_patIdefsCollect,_patIerrors,_patIoutput) =+ (pat_ _patOchildInhs _patOchildSyns _patOcon _patOdefs _patOforcedIrrefutables _patOnt)+ ( _partsIallAttributes,_partsIcopy,_partsIdefsCollect,_partsIerrors,_partsIoutput) =+ (parts_ _partsOchildInhs _partsOchildSyns _partsOcon _partsOdefs _partsOforcedIrrefutables _partsOnt)+ in ( _lhsOallAttributes,_lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))))+sem_Pattern_Constr :: ConstructorIdent ->+ T_Patterns ->+ T_Pattern+sem_Pattern_Constr name_ (T_Patterns pats_) =+ (T_Pattern (\ _lhsIchildInhs+ _lhsIchildSyns+ _lhsIcon+ _lhsIdefs+ _lhsIforcedIrrefutables+ _lhsInt ->+ (let _lhsOallAttributes :: AttrMap+ _lhsOdefsCollect :: (Set (Identifier, Identifier))+ _lhsOerrors :: (Seq Error)+ _lhsOcopy :: Pattern+ _lhsOoutput :: Pattern+ _patsOchildInhs :: ([(Identifier, Identifier)])+ _patsOchildSyns :: ([(Identifier, Identifier)])+ _patsOcon :: ConstructorIdent+ _patsOdefs :: (Set (Identifier, Identifier))+ _patsOforcedIrrefutables :: AttrMap+ _patsOnt :: NontermIdent+ _patsIallAttributes :: AttrMap+ _patsIcopy :: Patterns+ _patsIdefsCollect :: (Set (Identifier, Identifier))+ _patsIerrors :: (Seq Error)+ _patsIoutput :: Patterns+ -- use rule "Desugar.ag"(line 189, column 23)+ _lhsOallAttributes =+ _patsIallAttributes+ -- use rule "Desugar.ag"(line 172, column 52)+ _lhsOdefsCollect =+ _patsIdefsCollect+ -- use rule "Desugar.ag"(line 31, column 144)+ _lhsOerrors =+ _patsIerrors+ -- self rule+ _copy =+ Constr name_ _patsIcopy+ -- self rule+ _output =+ Constr name_ _patsIoutput+ -- self rule+ _lhsOcopy =+ _copy+ -- self rule+ _lhsOoutput =+ _output+ -- copy rule (down)+ _patsOchildInhs =+ _lhsIchildInhs+ -- copy rule (down)+ _patsOchildSyns =+ _lhsIchildSyns+ -- copy rule (down)+ _patsOcon =+ _lhsIcon+ -- copy rule (down)+ _patsOdefs =+ _lhsIdefs+ -- copy rule (down)+ _patsOforcedIrrefutables =+ _lhsIforcedIrrefutables+ -- copy rule (down)+ _patsOnt =+ _lhsInt+ ( _patsIallAttributes,_patsIcopy,_patsIdefsCollect,_patsIerrors,_patsIoutput) =+ (pats_ _patsOchildInhs _patsOchildSyns _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt)+ in ( _lhsOallAttributes,_lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))))+sem_Pattern_Irrefutable :: T_Pattern ->+ T_Pattern+sem_Pattern_Irrefutable (T_Pattern pat_) =+ (T_Pattern (\ _lhsIchildInhs+ _lhsIchildSyns+ _lhsIcon+ _lhsIdefs+ _lhsIforcedIrrefutables+ _lhsInt ->+ (let _lhsOallAttributes :: AttrMap+ _lhsOdefsCollect :: (Set (Identifier, Identifier))+ _lhsOerrors :: (Seq Error)+ _lhsOcopy :: Pattern+ _lhsOoutput :: Pattern+ _patOchildInhs :: ([(Identifier, Identifier)])+ _patOchildSyns :: ([(Identifier, Identifier)])+ _patOcon :: ConstructorIdent+ _patOdefs :: (Set (Identifier, Identifier))+ _patOforcedIrrefutables :: AttrMap+ _patOnt :: NontermIdent+ _patIallAttributes :: AttrMap+ _patIcopy :: Pattern+ _patIdefsCollect :: (Set (Identifier, Identifier))+ _patIerrors :: (Seq Error)+ _patIoutput :: Pattern+ -- "Desugar.ag"(line 195, column 7)+ _lhsOallAttributes =+ Map.empty+ -- use rule "Desugar.ag"(line 172, column 52)+ _lhsOdefsCollect =+ _patIdefsCollect+ -- use rule "Desugar.ag"(line 31, column 144)+ _lhsOerrors =+ _patIerrors+ -- self rule+ _copy =+ Irrefutable _patIcopy+ -- self rule+ _output =+ Irrefutable _patIoutput+ -- self rule+ _lhsOcopy =+ _copy+ -- self rule+ _lhsOoutput =+ _output+ -- copy rule (down)+ _patOchildInhs =+ _lhsIchildInhs+ -- copy rule (down)+ _patOchildSyns =+ _lhsIchildSyns+ -- copy rule (down)+ _patOcon =+ _lhsIcon+ -- copy rule (down)+ _patOdefs =+ _lhsIdefs+ -- copy rule (down)+ _patOforcedIrrefutables =+ _lhsIforcedIrrefutables+ -- copy rule (down)+ _patOnt =+ _lhsInt+ ( _patIallAttributes,_patIcopy,_patIdefsCollect,_patIerrors,_patIoutput) =+ (pat_ _patOchildInhs _patOchildSyns _patOcon _patOdefs _patOforcedIrrefutables _patOnt)+ in ( _lhsOallAttributes,_lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))))+sem_Pattern_Product :: Pos ->+ T_Patterns ->+ T_Pattern+sem_Pattern_Product pos_ (T_Patterns pats_) =+ (T_Pattern (\ _lhsIchildInhs+ _lhsIchildSyns+ _lhsIcon+ _lhsIdefs+ _lhsIforcedIrrefutables+ _lhsInt ->+ (let _lhsOallAttributes :: AttrMap+ _lhsOdefsCollect :: (Set (Identifier, Identifier))+ _lhsOerrors :: (Seq Error)+ _lhsOcopy :: Pattern+ _lhsOoutput :: Pattern+ _patsOchildInhs :: ([(Identifier, Identifier)])+ _patsOchildSyns :: ([(Identifier, Identifier)])+ _patsOcon :: ConstructorIdent+ _patsOdefs :: (Set (Identifier, Identifier))+ _patsOforcedIrrefutables :: AttrMap+ _patsOnt :: NontermIdent+ _patsIallAttributes :: AttrMap+ _patsIcopy :: Patterns+ _patsIdefsCollect :: (Set (Identifier, Identifier))+ _patsIerrors :: (Seq Error)+ _patsIoutput :: Patterns+ -- use rule "Desugar.ag"(line 189, column 23)+ _lhsOallAttributes =+ _patsIallAttributes+ -- use rule "Desugar.ag"(line 172, column 52)+ _lhsOdefsCollect =+ _patsIdefsCollect+ -- use rule "Desugar.ag"(line 31, column 144)+ _lhsOerrors =+ _patsIerrors+ -- self rule+ _copy =+ Product pos_ _patsIcopy+ -- self rule+ _output =+ Product pos_ _patsIoutput+ -- self rule+ _lhsOcopy =+ _copy+ -- self rule+ _lhsOoutput =+ _output+ -- copy rule (down)+ _patsOchildInhs =+ _lhsIchildInhs+ -- copy rule (down)+ _patsOchildSyns =+ _lhsIchildSyns+ -- copy rule (down)+ _patsOcon =+ _lhsIcon+ -- copy rule (down)+ _patsOdefs =+ _lhsIdefs+ -- copy rule (down)+ _patsOforcedIrrefutables =+ _lhsIforcedIrrefutables+ -- copy rule (down)+ _patsOnt =+ _lhsInt+ ( _patsIallAttributes,_patsIcopy,_patsIdefsCollect,_patsIerrors,_patsIoutput) =+ (pats_ _patsOchildInhs _patsOchildSyns _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt)+ in ( _lhsOallAttributes,_lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))))+sem_Pattern_Underscore :: Pos ->+ T_Pattern+sem_Pattern_Underscore pos_ =+ (T_Pattern (\ _lhsIchildInhs+ _lhsIchildSyns+ _lhsIcon+ _lhsIdefs+ _lhsIforcedIrrefutables+ _lhsInt ->+ (let _lhsOallAttributes :: AttrMap+ _lhsOdefsCollect :: (Set (Identifier, Identifier))+ _lhsOerrors :: (Seq Error)+ _lhsOcopy :: Pattern+ _lhsOoutput :: Pattern+ -- use rule "Desugar.ag"(line 189, column 23)+ _lhsOallAttributes =+ Map.empty+ -- use rule "Desugar.ag"(line 172, column 52)+ _lhsOdefsCollect =+ Set.empty+ -- use rule "Desugar.ag"(line 31, column 144)+ _lhsOerrors =+ Seq.empty+ -- self rule+ _copy =+ Underscore pos_+ -- self rule+ _output =+ Underscore pos_+ -- self rule+ _lhsOcopy =+ _copy+ -- self rule+ _lhsOoutput =+ _output+ in ( _lhsOallAttributes,_lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))))+-- Patterns ----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ childInhs : [(Identifier, Identifier)]+ childSyns : [(Identifier, Identifier)]+ con : ConstructorIdent+ defs : Set (Identifier, Identifier)+ forcedIrrefutables : AttrMap+ nt : NontermIdent+ synthesized attributes:+ allAttributes : AttrMap+ copy : SELF+ defsCollect : Set (Identifier, Identifier)+ errors : Seq Error+ output : SELF+ alternatives:+ alternative Cons:+ child hd : Pattern+ child tl : Patterns+ visit 0:+ local copy : _+ local output : _+ alternative Nil:+ visit 0:+ local copy : _+ local output : _+-}+-- 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 (([(Identifier, Identifier)]) ->+ ([(Identifier, Identifier)]) ->+ ConstructorIdent ->+ (Set (Identifier, Identifier)) ->+ AttrMap ->+ NontermIdent ->+ ( AttrMap,Patterns,(Set (Identifier, Identifier)),(Seq Error),Patterns))+data Inh_Patterns = Inh_Patterns {childInhs_Inh_Patterns :: [(Identifier, Identifier)],childSyns_Inh_Patterns :: [(Identifier, Identifier)],con_Inh_Patterns :: ConstructorIdent,defs_Inh_Patterns :: Set (Identifier, Identifier),forcedIrrefutables_Inh_Patterns :: AttrMap,nt_Inh_Patterns :: NontermIdent}+data Syn_Patterns = Syn_Patterns {allAttributes_Syn_Patterns :: AttrMap,copy_Syn_Patterns :: Patterns,defsCollect_Syn_Patterns :: Set (Identifier, Identifier),errors_Syn_Patterns :: Seq Error,output_Syn_Patterns :: Patterns}+wrap_Patterns (T_Patterns sem) (Inh_Patterns _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) =+ (let ( _lhsOallAttributes,_lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput) =+ (sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt)+ in (Syn_Patterns _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput))+sem_Patterns_Cons :: T_Pattern ->+ T_Patterns ->+ T_Patterns+sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) =+ (T_Patterns (\ _lhsIchildInhs+ _lhsIchildSyns+ _lhsIcon+ _lhsIdefs+ _lhsIforcedIrrefutables+ _lhsInt ->+ (let _lhsOallAttributes :: AttrMap+ _lhsOdefsCollect :: (Set (Identifier, Identifier))+ _lhsOerrors :: (Seq Error)+ _lhsOcopy :: Patterns+ _lhsOoutput :: Patterns+ _hdOchildInhs :: ([(Identifier, Identifier)])+ _hdOchildSyns :: ([(Identifier, Identifier)])+ _hdOcon :: ConstructorIdent+ _hdOdefs :: (Set (Identifier, Identifier))+ _hdOforcedIrrefutables :: AttrMap+ _hdOnt :: NontermIdent+ _tlOchildInhs :: ([(Identifier, Identifier)])+ _tlOchildSyns :: ([(Identifier, Identifier)])+ _tlOcon :: ConstructorIdent+ _tlOdefs :: (Set (Identifier, Identifier))+ _tlOforcedIrrefutables :: AttrMap+ _tlOnt :: NontermIdent+ _hdIallAttributes :: AttrMap+ _hdIcopy :: Pattern+ _hdIdefsCollect :: (Set (Identifier, Identifier))+ _hdIerrors :: (Seq Error)+ _hdIoutput :: Pattern+ _tlIallAttributes :: AttrMap+ _tlIcopy :: Patterns+ _tlIdefsCollect :: (Set (Identifier, Identifier))+ _tlIerrors :: (Seq Error)+ _tlIoutput :: Patterns+ -- use rule "Desugar.ag"(line 189, column 23)+ _lhsOallAttributes =+ _hdIallAttributes `mergeAttributes` _tlIallAttributes+ -- use rule "Desugar.ag"(line 172, column 52)+ _lhsOdefsCollect =+ _hdIdefsCollect `Set.union` _tlIdefsCollect+ -- use rule "Desugar.ag"(line 31, column 144)+ _lhsOerrors =+ _hdIerrors Seq.<> _tlIerrors+ -- self rule+ _copy =+ (:) _hdIcopy _tlIcopy+ -- self rule+ _output =+ (:) _hdIoutput _tlIoutput+ -- self rule+ _lhsOcopy =+ _copy+ -- self rule+ _lhsOoutput =+ _output+ -- copy rule (down)+ _hdOchildInhs =+ _lhsIchildInhs+ -- copy rule (down)+ _hdOchildSyns =+ _lhsIchildSyns+ -- copy rule (down)+ _hdOcon =+ _lhsIcon+ -- copy rule (down)+ _hdOdefs =+ _lhsIdefs+ -- copy rule (down)+ _hdOforcedIrrefutables =+ _lhsIforcedIrrefutables+ -- copy rule (down)+ _hdOnt =+ _lhsInt+ -- copy rule (down)+ _tlOchildInhs =+ _lhsIchildInhs+ -- copy rule (down)+ _tlOchildSyns =+ _lhsIchildSyns+ -- copy rule (down)+ _tlOcon =+ _lhsIcon+ -- copy rule (down)+ _tlOdefs =+ _lhsIdefs+ -- copy rule (down)+ _tlOforcedIrrefutables =+ _lhsIforcedIrrefutables+ -- copy rule (down)+ _tlOnt =+ _lhsInt+ ( _hdIallAttributes,_hdIcopy,_hdIdefsCollect,_hdIerrors,_hdIoutput) =+ (hd_ _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt)+ ( _tlIallAttributes,_tlIcopy,_tlIdefsCollect,_tlIerrors,_tlIoutput) =+ (tl_ _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt)+ in ( _lhsOallAttributes,_lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))))+sem_Patterns_Nil :: T_Patterns+sem_Patterns_Nil =+ (T_Patterns (\ _lhsIchildInhs+ _lhsIchildSyns+ _lhsIcon+ _lhsIdefs+ _lhsIforcedIrrefutables+ _lhsInt ->+ (let _lhsOallAttributes :: AttrMap+ _lhsOdefsCollect :: (Set (Identifier, Identifier))+ _lhsOerrors :: (Seq Error)+ _lhsOcopy :: Patterns+ _lhsOoutput :: Patterns+ -- use rule "Desugar.ag"(line 189, column 23)+ _lhsOallAttributes =+ Map.empty+ -- use rule "Desugar.ag"(line 172, column 52)+ _lhsOdefsCollect =+ Set.empty+ -- use rule "Desugar.ag"(line 31, column 144)+ _lhsOerrors =+ Seq.empty+ -- self rule+ _copy =+ []+ -- self rule+ _output =+ []+ -- self rule+ _lhsOcopy =+ _copy+ -- self rule+ _lhsOoutput =+ _output+ in ( _lhsOallAttributes,_lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))))+-- Production --------------------------------------------------+{-+ visit 0:+ inherited attributes:+ forcedIrrefutables : AttrMap+ nt : NontermIdent+ options : Options+ synthesized attributes:+ allAttributes : AttrMap+ errors : Seq Error+ output : SELF+ alternatives:+ alternative Production:+ child con : {ConstructorIdent}+ child children : Children+ child rules : Rules+ child typeSigs : TypeSigs+ visit 0:+ local output : _+-}+-- 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 (AttrMap ->+ NontermIdent ->+ Options ->+ ( AttrMap,(Seq Error),Production))+data Inh_Production = Inh_Production {forcedIrrefutables_Inh_Production :: AttrMap,nt_Inh_Production :: NontermIdent,options_Inh_Production :: Options}+data Syn_Production = Syn_Production {allAttributes_Syn_Production :: AttrMap,errors_Syn_Production :: Seq Error,output_Syn_Production :: Production}+wrap_Production (T_Production sem) (Inh_Production _lhsIforcedIrrefutables _lhsInt _lhsIoptions) =+ (let ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) =+ (sem _lhsIforcedIrrefutables _lhsInt _lhsIoptions)+ in (Syn_Production _lhsOallAttributes _lhsOerrors _lhsOoutput))+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 (\ _lhsIforcedIrrefutables+ _lhsInt+ _lhsIoptions ->+ (let _rulesOcon :: ConstructorIdent+ _rulesOdefs :: (Set (Identifier, Identifier))+ _lhsOallAttributes :: AttrMap+ _lhsOerrors :: (Seq Error)+ _lhsOoutput :: Production+ _rulesOchildInhs :: ([(Identifier, Identifier)])+ _rulesOchildSyns :: ([(Identifier, Identifier)])+ _rulesOforcedIrrefutables :: AttrMap+ _rulesOnt :: NontermIdent+ _rulesOoptions :: Options+ _childrenIchildInhs :: ([(Identifier, Identifier)])+ _childrenIchildSyns :: ([(Identifier, Identifier)])+ _childrenIoutput :: Children+ _rulesIallAttributes :: AttrMap+ _rulesIdefsCollect :: (Set (Identifier, Identifier))+ _rulesIerrors :: (Seq Error)+ _rulesIoutput :: Rules+ _typeSigsIoutput :: TypeSigs+ -- "Desugar.ag"(line 154, column 7)+ _rulesOcon =+ con_+ -- "Desugar.ag"(line 181, column 7)+ _rulesOdefs =+ _rulesIdefsCollect+ -- use rule "Desugar.ag"(line 189, column 23)+ _lhsOallAttributes =+ _rulesIallAttributes+ -- use rule "Desugar.ag"(line 31, column 144)+ _lhsOerrors =+ _rulesIerrors+ -- self rule+ _output =+ Production con_ _childrenIoutput _rulesIoutput _typeSigsIoutput+ -- self rule+ _lhsOoutput =+ _output+ -- copy rule (chain)+ _rulesOchildInhs =+ _childrenIchildInhs+ -- copy rule (chain)+ _rulesOchildSyns =+ _childrenIchildSyns+ -- copy rule (down)+ _rulesOforcedIrrefutables =+ _lhsIforcedIrrefutables+ -- copy rule (down)+ _rulesOnt =+ _lhsInt+ -- copy rule (down)+ _rulesOoptions =+ _lhsIoptions+ ( _childrenIchildInhs,_childrenIchildSyns,_childrenIoutput) =+ (children_ )+ ( _rulesIallAttributes,_rulesIdefsCollect,_rulesIerrors,_rulesIoutput) =+ (rules_ _rulesOchildInhs _rulesOchildSyns _rulesOcon _rulesOdefs _rulesOforcedIrrefutables _rulesOnt _rulesOoptions)+ ( _typeSigsIoutput) =+ (typeSigs_ )+ in ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput))))+-- Productions -------------------------------------------------+{-+ visit 0:+ inherited attributes:+ forcedIrrefutables : AttrMap+ nt : NontermIdent+ options : Options+ synthesized attributes:+ allAttributes : AttrMap+ errors : Seq Error+ output : SELF+ alternatives:+ alternative Cons:+ child hd : Production+ child tl : Productions+ visit 0:+ local output : _+ alternative Nil:+ visit 0:+ local output : _+-}+-- 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 (AttrMap ->+ NontermIdent ->+ Options ->+ ( AttrMap,(Seq Error),Productions))+data Inh_Productions = Inh_Productions {forcedIrrefutables_Inh_Productions :: AttrMap,nt_Inh_Productions :: NontermIdent,options_Inh_Productions :: Options}+data Syn_Productions = Syn_Productions {allAttributes_Syn_Productions :: AttrMap,errors_Syn_Productions :: Seq Error,output_Syn_Productions :: Productions}+wrap_Productions (T_Productions sem) (Inh_Productions _lhsIforcedIrrefutables _lhsInt _lhsIoptions) =+ (let ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) =+ (sem _lhsIforcedIrrefutables _lhsInt _lhsIoptions)+ in (Syn_Productions _lhsOallAttributes _lhsOerrors _lhsOoutput))+sem_Productions_Cons :: T_Production ->+ T_Productions ->+ T_Productions+sem_Productions_Cons (T_Production hd_) (T_Productions tl_) =+ (T_Productions (\ _lhsIforcedIrrefutables+ _lhsInt+ _lhsIoptions ->+ (let _lhsOallAttributes :: AttrMap+ _lhsOerrors :: (Seq Error)+ _lhsOoutput :: Productions+ _hdOforcedIrrefutables :: AttrMap+ _hdOnt :: NontermIdent+ _hdOoptions :: Options+ _tlOforcedIrrefutables :: AttrMap+ _tlOnt :: NontermIdent+ _tlOoptions :: Options+ _hdIallAttributes :: AttrMap+ _hdIerrors :: (Seq Error)+ _hdIoutput :: Production+ _tlIallAttributes :: AttrMap+ _tlIerrors :: (Seq Error)+ _tlIoutput :: Productions+ -- use rule "Desugar.ag"(line 189, column 23)+ _lhsOallAttributes =+ _hdIallAttributes `mergeAttributes` _tlIallAttributes+ -- use rule "Desugar.ag"(line 31, column 144)+ _lhsOerrors =+ _hdIerrors Seq.<> _tlIerrors+ -- self rule+ _output =+ (:) _hdIoutput _tlIoutput+ -- self rule+ _lhsOoutput =+ _output+ -- copy rule (down)+ _hdOforcedIrrefutables =+ _lhsIforcedIrrefutables+ -- copy rule (down)+ _hdOnt =+ _lhsInt+ -- copy rule (down)+ _hdOoptions =+ _lhsIoptions+ -- copy rule (down)+ _tlOforcedIrrefutables =+ _lhsIforcedIrrefutables+ -- copy rule (down)+ _tlOnt =+ _lhsInt+ -- copy rule (down)+ _tlOoptions =+ _lhsIoptions+ ( _hdIallAttributes,_hdIerrors,_hdIoutput) =+ (hd_ _hdOforcedIrrefutables _hdOnt _hdOoptions)+ ( _tlIallAttributes,_tlIerrors,_tlIoutput) =+ (tl_ _tlOforcedIrrefutables _tlOnt _tlOoptions)+ in ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput))))+sem_Productions_Nil :: T_Productions+sem_Productions_Nil =+ (T_Productions (\ _lhsIforcedIrrefutables+ _lhsInt+ _lhsIoptions ->+ (let _lhsOallAttributes :: AttrMap+ _lhsOerrors :: (Seq Error)+ _lhsOoutput :: Productions+ -- use rule "Desugar.ag"(line 189, column 23)+ _lhsOallAttributes =+ Map.empty+ -- use rule "Desugar.ag"(line 31, column 144)+ _lhsOerrors =+ Seq.empty+ -- self rule+ _output =+ []+ -- self rule+ _lhsOoutput =+ _output+ in ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput))))+-- Rule --------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ childInhs : [(Identifier, Identifier)]+ childSyns : [(Identifier, Identifier)]+ con : ConstructorIdent+ defs : Set (Identifier, Identifier)+ forcedIrrefutables : AttrMap+ nt : NontermIdent+ options : Options+ synthesized attributes:+ allAttributes : AttrMap+ defsCollect : Set (Identifier, Identifier)+ errors : Seq Error+ output : SELF+ alternatives:+ alternative Rule:+ child pattern : Pattern+ child rhs : Expression+ child owrt : {Bool}+ child origin : {String}+ visit 0:+ local ruleDescr : _+ local output : _+-}+-- cata+sem_Rule :: Rule ->+ T_Rule+sem_Rule (Rule _pattern _rhs _owrt _origin) =+ (sem_Rule_Rule (sem_Pattern _pattern) (sem_Expression _rhs) _owrt _origin)+-- semantic domain+newtype T_Rule = T_Rule (([(Identifier, Identifier)]) ->+ ([(Identifier, Identifier)]) ->+ ConstructorIdent ->+ (Set (Identifier, Identifier)) ->+ AttrMap ->+ NontermIdent ->+ Options ->+ ( AttrMap,(Set (Identifier, Identifier)),(Seq Error),Rule))+data Inh_Rule = Inh_Rule {childInhs_Inh_Rule :: [(Identifier, Identifier)],childSyns_Inh_Rule :: [(Identifier, Identifier)],con_Inh_Rule :: ConstructorIdent,defs_Inh_Rule :: Set (Identifier, Identifier),forcedIrrefutables_Inh_Rule :: AttrMap,nt_Inh_Rule :: NontermIdent,options_Inh_Rule :: Options}+data Syn_Rule = Syn_Rule {allAttributes_Syn_Rule :: AttrMap,defsCollect_Syn_Rule :: Set (Identifier, Identifier),errors_Syn_Rule :: Seq Error,output_Syn_Rule :: Rule}+wrap_Rule (T_Rule sem) (Inh_Rule _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions) =+ (let ( _lhsOallAttributes,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput) =+ (sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions)+ in (Syn_Rule _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput))+sem_Rule_Rule :: T_Pattern ->+ T_Expression ->+ Bool ->+ String ->+ T_Rule+sem_Rule_Rule (T_Pattern pattern_) (T_Expression rhs_) owrt_ origin_ =+ (T_Rule (\ _lhsIchildInhs+ _lhsIchildSyns+ _lhsIcon+ _lhsIdefs+ _lhsIforcedIrrefutables+ _lhsInt+ _lhsIoptions ->+ (let _lhsOallAttributes :: AttrMap+ _lhsOdefsCollect :: (Set (Identifier, Identifier))+ _lhsOerrors :: (Seq Error)+ _lhsOoutput :: Rule+ _patternOchildInhs :: ([(Identifier, Identifier)])+ _patternOchildSyns :: ([(Identifier, Identifier)])+ _patternOcon :: ConstructorIdent+ _patternOdefs :: (Set (Identifier, Identifier))+ _patternOforcedIrrefutables :: AttrMap+ _patternOnt :: NontermIdent+ _rhsOchildInhs :: ([(Identifier, Identifier)])+ _rhsOchildSyns :: ([(Identifier, Identifier)])+ _rhsOcon :: ConstructorIdent+ _rhsOnt :: NontermIdent+ _rhsOoptions :: Options+ _rhsOruleDescr :: String+ _patternIallAttributes :: AttrMap+ _patternIcopy :: Pattern+ _patternIdefsCollect :: (Set (Identifier, Identifier))+ _patternIerrors :: (Seq Error)+ _patternIoutput :: Pattern+ _rhsIerrors :: (Seq Error)+ _rhsIoutput :: Expression+ -- "Desugar.ag"(line 165, column 7)+ _ruleDescr =+ show _lhsInt ++ " :: " ++ show _lhsIcon ++ " :: " ++ (concat $ intersperse "," $ map (\(f,a) -> show f ++ "." ++ show a) $ Set.toList _patternIdefsCollect)+ -- use rule "Desugar.ag"(line 189, column 23)+ _lhsOallAttributes =+ _patternIallAttributes+ -- use rule "Desugar.ag"(line 172, column 52)+ _lhsOdefsCollect =+ _patternIdefsCollect+ -- use rule "Desugar.ag"(line 31, column 144)+ _lhsOerrors =+ _patternIerrors Seq.<> _rhsIerrors+ -- self rule+ _output =+ Rule _patternIoutput _rhsIoutput owrt_ origin_+ -- self rule+ _lhsOoutput =+ _output+ -- copy rule (down)+ _patternOchildInhs =+ _lhsIchildInhs+ -- copy rule (down)+ _patternOchildSyns =+ _lhsIchildSyns+ -- copy rule (down)+ _patternOcon =+ _lhsIcon+ -- copy rule (down)+ _patternOdefs =+ _lhsIdefs+ -- copy rule (down)+ _patternOforcedIrrefutables =+ _lhsIforcedIrrefutables+ -- copy rule (down)+ _patternOnt =+ _lhsInt+ -- copy rule (down)+ _rhsOchildInhs =+ _lhsIchildInhs+ -- copy rule (down)+ _rhsOchildSyns =+ _lhsIchildSyns+ -- copy rule (down)+ _rhsOcon =+ _lhsIcon+ -- copy rule (down)+ _rhsOnt =+ _lhsInt+ -- copy rule (down)+ _rhsOoptions =+ _lhsIoptions+ -- copy rule (from local)+ _rhsOruleDescr =+ _ruleDescr+ ( _patternIallAttributes,_patternIcopy,_patternIdefsCollect,_patternIerrors,_patternIoutput) =+ (pattern_ _patternOchildInhs _patternOchildSyns _patternOcon _patternOdefs _patternOforcedIrrefutables _patternOnt)+ ( _rhsIerrors,_rhsIoutput) =+ (rhs_ _rhsOchildInhs _rhsOchildSyns _rhsOcon _rhsOnt _rhsOoptions _rhsOruleDescr)+ in ( _lhsOallAttributes,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))))+-- Rules -------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ childInhs : [(Identifier, Identifier)]+ childSyns : [(Identifier, Identifier)]+ con : ConstructorIdent+ defs : Set (Identifier, Identifier)+ forcedIrrefutables : AttrMap+ nt : NontermIdent+ options : Options+ synthesized attributes:+ allAttributes : AttrMap+ defsCollect : Set (Identifier, Identifier)+ errors : Seq Error+ output : SELF+ alternatives:+ alternative Cons:+ child hd : Rule+ child tl : Rules+ visit 0:+ local output : _+ alternative Nil:+ visit 0:+ local output : _+-}+-- 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 (([(Identifier, Identifier)]) ->+ ([(Identifier, Identifier)]) ->+ ConstructorIdent ->+ (Set (Identifier, Identifier)) ->+ AttrMap ->+ NontermIdent ->+ Options ->+ ( AttrMap,(Set (Identifier, Identifier)),(Seq Error),Rules))+data Inh_Rules = Inh_Rules {childInhs_Inh_Rules :: [(Identifier, Identifier)],childSyns_Inh_Rules :: [(Identifier, Identifier)],con_Inh_Rules :: ConstructorIdent,defs_Inh_Rules :: Set (Identifier, Identifier),forcedIrrefutables_Inh_Rules :: AttrMap,nt_Inh_Rules :: NontermIdent,options_Inh_Rules :: Options}+data Syn_Rules = Syn_Rules {allAttributes_Syn_Rules :: AttrMap,defsCollect_Syn_Rules :: Set (Identifier, Identifier),errors_Syn_Rules :: Seq Error,output_Syn_Rules :: Rules}+wrap_Rules (T_Rules sem) (Inh_Rules _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions) =+ (let ( _lhsOallAttributes,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput) =+ (sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions)+ in (Syn_Rules _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput))+sem_Rules_Cons :: T_Rule ->+ T_Rules ->+ T_Rules+sem_Rules_Cons (T_Rule hd_) (T_Rules tl_) =+ (T_Rules (\ _lhsIchildInhs+ _lhsIchildSyns+ _lhsIcon+ _lhsIdefs+ _lhsIforcedIrrefutables+ _lhsInt+ _lhsIoptions ->+ (let _lhsOallAttributes :: AttrMap+ _lhsOdefsCollect :: (Set (Identifier, Identifier))+ _lhsOerrors :: (Seq Error)+ _lhsOoutput :: Rules+ _hdOchildInhs :: ([(Identifier, Identifier)])+ _hdOchildSyns :: ([(Identifier, Identifier)])+ _hdOcon :: ConstructorIdent+ _hdOdefs :: (Set (Identifier, Identifier))+ _hdOforcedIrrefutables :: AttrMap+ _hdOnt :: NontermIdent+ _hdOoptions :: Options+ _tlOchildInhs :: ([(Identifier, Identifier)])+ _tlOchildSyns :: ([(Identifier, Identifier)])+ _tlOcon :: ConstructorIdent+ _tlOdefs :: (Set (Identifier, Identifier))+ _tlOforcedIrrefutables :: AttrMap+ _tlOnt :: NontermIdent+ _tlOoptions :: Options+ _hdIallAttributes :: AttrMap+ _hdIdefsCollect :: (Set (Identifier, Identifier))+ _hdIerrors :: (Seq Error)+ _hdIoutput :: Rule+ _tlIallAttributes :: AttrMap+ _tlIdefsCollect :: (Set (Identifier, Identifier))+ _tlIerrors :: (Seq Error)+ _tlIoutput :: Rules+ -- use rule "Desugar.ag"(line 189, column 23)+ _lhsOallAttributes =+ _hdIallAttributes `mergeAttributes` _tlIallAttributes+ -- use rule "Desugar.ag"(line 172, column 52)+ _lhsOdefsCollect =+ _hdIdefsCollect `Set.union` _tlIdefsCollect+ -- use rule "Desugar.ag"(line 31, column 144)+ _lhsOerrors =+ _hdIerrors Seq.<> _tlIerrors+ -- self rule+ _output =+ (:) _hdIoutput _tlIoutput+ -- self rule+ _lhsOoutput =+ _output+ -- copy rule (down)+ _hdOchildInhs =+ _lhsIchildInhs+ -- copy rule (down)+ _hdOchildSyns =+ _lhsIchildSyns+ -- copy rule (down)+ _hdOcon =+ _lhsIcon+ -- copy rule (down)+ _hdOdefs =+ _lhsIdefs+ -- copy rule (down)+ _hdOforcedIrrefutables =+ _lhsIforcedIrrefutables+ -- copy rule (down)+ _hdOnt =+ _lhsInt+ -- copy rule (down)+ _hdOoptions =+ _lhsIoptions+ -- copy rule (down)+ _tlOchildInhs =+ _lhsIchildInhs+ -- copy rule (down)+ _tlOchildSyns =+ _lhsIchildSyns+ -- copy rule (down)+ _tlOcon =+ _lhsIcon+ -- copy rule (down)+ _tlOdefs =+ _lhsIdefs+ -- copy rule (down)+ _tlOforcedIrrefutables =+ _lhsIforcedIrrefutables+ -- copy rule (down)+ _tlOnt =+ _lhsInt+ -- copy rule (down)+ _tlOoptions =+ _lhsIoptions+ ( _hdIallAttributes,_hdIdefsCollect,_hdIerrors,_hdIoutput) =+ (hd_ _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt _hdOoptions)+ ( _tlIallAttributes,_tlIdefsCollect,_tlIerrors,_tlIoutput) =+ (tl_ _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt _tlOoptions)+ in ( _lhsOallAttributes,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))))+sem_Rules_Nil :: T_Rules+sem_Rules_Nil =+ (T_Rules (\ _lhsIchildInhs+ _lhsIchildSyns+ _lhsIcon+ _lhsIdefs+ _lhsIforcedIrrefutables+ _lhsInt+ _lhsIoptions ->+ (let _lhsOallAttributes :: AttrMap+ _lhsOdefsCollect :: (Set (Identifier, Identifier))+ _lhsOerrors :: (Seq Error)+ _lhsOoutput :: Rules+ -- use rule "Desugar.ag"(line 189, column 23)+ _lhsOallAttributes =+ Map.empty+ -- use rule "Desugar.ag"(line 172, column 52)+ _lhsOdefsCollect =+ Set.empty+ -- use rule "Desugar.ag"(line 31, column 144)+ _lhsOerrors =+ Seq.empty+ -- self rule+ _output =+ []+ -- self rule+ _lhsOoutput =+ _output+ in ( _lhsOallAttributes,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))))+-- TypeSig -----------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ output : SELF+ alternatives:+ alternative TypeSig:+ child name : {Identifier}+ child tp : {Type}+ visit 0:+ local output : _+-}+-- cata+sem_TypeSig :: TypeSig ->+ T_TypeSig+sem_TypeSig (TypeSig _name _tp) =+ (sem_TypeSig_TypeSig _name _tp)+-- semantic domain+newtype T_TypeSig = T_TypeSig (( TypeSig))+data Inh_TypeSig = Inh_TypeSig {}+data Syn_TypeSig = Syn_TypeSig {output_Syn_TypeSig :: TypeSig}+wrap_TypeSig (T_TypeSig sem) (Inh_TypeSig ) =+ (let ( _lhsOoutput) =+ (sem )+ in (Syn_TypeSig _lhsOoutput))+sem_TypeSig_TypeSig :: Identifier ->+ Type ->+ T_TypeSig+sem_TypeSig_TypeSig name_ tp_ =+ (T_TypeSig (let _lhsOoutput :: TypeSig+ -- self rule+ _output =+ TypeSig name_ tp_+ -- self rule+ _lhsOoutput =+ _output+ in ( _lhsOoutput)))+-- TypeSigs ----------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ output : SELF+ alternatives:+ alternative Cons:+ child hd : TypeSig+ child tl : TypeSigs+ visit 0:+ local output : _+ alternative Nil:+ visit 0:+ local output : _+-}+-- 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 (( TypeSigs))+data Inh_TypeSigs = Inh_TypeSigs {}+data Syn_TypeSigs = Syn_TypeSigs {output_Syn_TypeSigs :: TypeSigs}+wrap_TypeSigs (T_TypeSigs sem) (Inh_TypeSigs ) =+ (let ( _lhsOoutput) =+ (sem )+ in (Syn_TypeSigs _lhsOoutput))+sem_TypeSigs_Cons :: T_TypeSig ->+ T_TypeSigs ->+ T_TypeSigs+sem_TypeSigs_Cons (T_TypeSig hd_) (T_TypeSigs tl_) =+ (T_TypeSigs (let _lhsOoutput :: TypeSigs+ _hdIoutput :: TypeSig+ _tlIoutput :: TypeSigs+ -- self rule+ _output =+ (:) _hdIoutput _tlIoutput+ -- self rule+ _lhsOoutput =+ _output+ ( _hdIoutput) =+ (hd_ )+ ( _tlIoutput) =+ (tl_ )+ in ( _lhsOoutput)))+sem_TypeSigs_Nil :: T_TypeSigs+sem_TypeSigs_Nil =+ (T_TypeSigs (let _lhsOoutput :: TypeSigs+ -- self rule+ _output =+ []+ -- self rule+ _lhsOoutput =+ _output+ in ( _lhsOoutput)))
src-derived/ErrorMessages.hs view
@@ -1,4 +1,3 @@- -- UUAGC 0.9.5 (ErrorMessages.ag) module ErrorMessages where @@ -11,139 +10,135 @@ {- alternatives: alternative ChildAsLocal:- child nt : {Nonterminal}- child con : {Constructor}- child var : {Name}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child var : {Identifier} alternative CustomError: child isWarning : {Bool} child pos : {Pos} child mesg : {PP_Doc} alternative CyclicSet:- child name : {Name}+ child name : {Identifier} alternative DirectCirc:- child nt : {Nonterminal}+ child nt : {NontermIdent} child o_visit : {Bool}- child cyclic : {[((Name,Name),[String],[String])]}+ child cyclic : {[((Identifier,Identifier),[String],[String])]} alternative DupAlt:- child nt : {Nonterminal}- child con : {Constructor}- child occ1 : {Constructor}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child occ1 : {ConstructorIdent} alternative DupChild:- child nt : {Nonterminal}- child con : {Constructor}- child name : {Name}- child occ1 : {Name}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child name : {Identifier}+ child occ1 : {Identifier} alternative DupInhAttr:- child nt : {Nonterminal}- child attr : {Name}- child occ1 : {Name}+ child nt : {NontermIdent}+ child attr : {Identifier}+ child occ1 : {Identifier} alternative DupRule:- child nt : {Nonterminal}- child con : {Constructor}- child field : {Name}- child attr : {Name}- child occ1 : {Name}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child field : {Identifier}+ child attr : {Identifier}+ child occ1 : {Identifier} alternative DupSet:- child name : {Nonterminal}- child occ1 : {Nonterminal}+ child name : {NontermIdent}+ child occ1 : {NontermIdent} alternative DupSig:- child nt : {Nonterminal}- child con : {Constructor}- child attr : {Name}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child attr : {Identifier} alternative DupSynAttr:- child nt : {Nonterminal}- child attr : {Name}- child occ1 : {Name}+ child nt : {NontermIdent}+ child attr : {Identifier}+ child occ1 : {Identifier} alternative DupSynonym:- child nt : {Nonterminal}- child occ1 : {Nonterminal}- alternative ErroneousOrder:- child nt : {Nonterminal}- child con : {Constructor}- child order : {Dependency}+ child nt : {NontermIdent}+ child occ1 : {NontermIdent} alternative InducedCirc:- child nt : {Nonterminal}+ child nt : {NontermIdent} child cinter : {CInterface}- child cyclic : {[((Name,Name),[String],[String])]}+ child cyclic : {[((Identifier,Identifier),[String],[String])]} alternative InstCirc:- child nt : {Nonterminal}- child con : {Constructor}- child attr : {Name}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child attr : {Identifier} child o_visit : {Bool} child path : {[String]} alternative LocalCirc:- child nt : {Nonterminal}- child con : {Constructor}- child attr : {Name}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child attr : {Identifier} child o_visit : {Bool} child path : {[String]} alternative MissingInstSig:- child nt : {Nonterminal}- child con : {Constructor}- child attr : {Name}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child attr : {Identifier} alternative MissingRule:- child nt : {Nonterminal}- child con : {Constructor}- child field : {Name}- child attr : {Name}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child field : {Identifier}+ child attr : {Identifier} alternative MissingTypeSig:- child nt : {Nonterminal}- child con : {Constructor}- child attr : {Name}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child attr : {Identifier} alternative ParserError: child pos : {Pos} child problem : {String} child action : {String} alternative SuperfluousRule:- child nt : {Nonterminal}- child con : {Constructor}- child field : {Name}- child attr : {Name}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child field : {Identifier}+ child attr : {Identifier} alternative UndefAlt:- child nt : {Nonterminal}- child con : {Constructor}+ child nt : {NontermIdent}+ child con : {ConstructorIdent} alternative UndefAttr:- child nt : {Nonterminal}- child con : {Constructor}- child field : {Name}- child attr : {Name}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child field : {Identifier}+ child attr : {Identifier}+ child isOut : {Bool} alternative UndefChild:- child nt : {Nonterminal}- child con : {Constructor}- child name : {Name}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child name : {Identifier} alternative UndefLocal:- child nt : {Nonterminal}- child con : {Constructor}- child var : {Name}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child var : {Identifier} alternative UndefNont:- child nt : {Nonterminal}+ child nt : {NontermIdent} -}-data Error = ChildAsLocal (Nonterminal) (Constructor) (Name) - | CustomError (Bool) (Pos) (PP_Doc) - | CyclicSet (Name) - | DirectCirc (Nonterminal) (Bool) ([((Name,Name),[String],[String])]) - | DupAlt (Nonterminal) (Constructor) (Constructor) - | DupChild (Nonterminal) (Constructor) (Name) (Name) - | DupInhAttr (Nonterminal) (Name) (Name) - | DupRule (Nonterminal) (Constructor) (Name) (Name) (Name) - | DupSet (Nonterminal) (Nonterminal) - | DupSig (Nonterminal) (Constructor) (Name) - | DupSynAttr (Nonterminal) (Name) (Name) - | DupSynonym (Nonterminal) (Nonterminal) - | ErroneousOrder (Nonterminal) (Constructor) (Dependency) - | InducedCirc (Nonterminal) (CInterface) ([((Name,Name),[String],[String])]) - | InstCirc (Nonterminal) (Constructor) (Name) (Bool) ([String]) - | LocalCirc (Nonterminal) (Constructor) (Name) (Bool) ([String]) - | MissingInstSig (Nonterminal) (Constructor) (Name) - | MissingRule (Nonterminal) (Constructor) (Name) (Name) - | MissingTypeSig (Nonterminal) (Constructor) (Name) - | ParserError (Pos) (String) (String) - | SuperfluousRule (Nonterminal) (Constructor) (Name) (Name) - | UndefAlt (Nonterminal) (Constructor) - | UndefAttr (Nonterminal) (Constructor) (Name) (Name) - | UndefChild (Nonterminal) (Constructor) (Name) - | UndefLocal (Nonterminal) (Constructor) (Name) - | UndefNont (Nonterminal) +data Error = ChildAsLocal (NontermIdent) (ConstructorIdent) (Identifier)+ | CustomError (Bool) (Pos) (PP_Doc)+ | CyclicSet (Identifier)+ | DirectCirc (NontermIdent) (Bool) ([((Identifier,Identifier),[String],[String])])+ | DupAlt (NontermIdent) (ConstructorIdent) (ConstructorIdent)+ | DupChild (NontermIdent) (ConstructorIdent) (Identifier) (Identifier)+ | DupInhAttr (NontermIdent) (Identifier) (Identifier)+ | DupRule (NontermIdent) (ConstructorIdent) (Identifier) (Identifier) (Identifier)+ | DupSet (NontermIdent) (NontermIdent)+ | DupSig (NontermIdent) (ConstructorIdent) (Identifier)+ | DupSynAttr (NontermIdent) (Identifier) (Identifier)+ | DupSynonym (NontermIdent) (NontermIdent)+ | InducedCirc (NontermIdent) (CInterface) ([((Identifier,Identifier),[String],[String])])+ | InstCirc (NontermIdent) (ConstructorIdent) (Identifier) (Bool) ([String])+ | LocalCirc (NontermIdent) (ConstructorIdent) (Identifier) (Bool) ([String])+ | MissingInstSig (NontermIdent) (ConstructorIdent) (Identifier)+ | MissingRule (NontermIdent) (ConstructorIdent) (Identifier) (Identifier)+ | MissingTypeSig (NontermIdent) (ConstructorIdent) (Identifier)+ | ParserError (Pos) (String) (String)+ | SuperfluousRule (NontermIdent) (ConstructorIdent) (Identifier) (Identifier)+ | UndefAlt (NontermIdent) (ConstructorIdent)+ | UndefAttr (NontermIdent) (ConstructorIdent) (Identifier) (Identifier) (Bool)+ | UndefChild (NontermIdent) (ConstructorIdent) (Identifier)+ | UndefLocal (NontermIdent) (ConstructorIdent) (Identifier)+ | UndefNont (NontermIdent) -- Errors ------------------------------------------------------ {- alternatives:
src-derived/Expression.hs view
@@ -3,11 +3,12 @@ module Expression where import UU.Scanner.Position(Pos)+import HsToken -- Expression -------------------------------------------------- {- alternatives: alternative Expression: child pos : {Pos}- child txt : {String}+ child tks : {[HsToken]} -}-data Expression = Expression (Pos) (String) +data Expression = Expression (Pos) ([HsToken])
src-derived/GenerateCode.hs view
@@ -1,4544 +1,5024 @@---- UUAGC 0.9.5 (GenerateCode.ag)-module GenerateCode where--import SequentialTypes-import Code hiding (Type)-import qualified Code-import Options-import CodeSyntax-import ErrorMessages-import GrammarInfo-import DeclBlocks--import qualified Data.Map as Map-import Data.Map(Map) -import qualified Data.Set as Set-import Data.Set(Set) -import qualified UU.DData.Seq as Seq-import UU.DData.Seq(Seq)-import UU.Scanner.Position--import Data.List(partition,intersperse,intersect,(\\))-import Maybe(fromJust,isJust)--import Patterns-import CommonTypes-import Data.Map(Map)-import Data.Set(Set)---- Patterns.ag imports-import UU.Scanner.Position(Pos)-import CommonTypes (Constructor,Name)--import Code (Decl,Expr)--substSelf nt tp = if tp==NT _SELF - then Haskell (getName nt)- else tp--mkLambda [] e = e-mkLambda xs e = Lambda xs e---- dead code - replaced by mkPartitionedFunction-{--localCpsToExpr :: Bool -> [Decl] -> DeclBlocks -> Expr-localCpsToExpr o_case nextVisitDecl- = rec- where- rec cps- = case cps of- DeclTerminator decls expr- -> mkLet o_case (decls ++ nextVisitDecl) expr- DeclBlock decls (Decl lhs rhs _ _) remainder- -> let inDecls = [ PragmaDecl ("NOINLINE " ++ internalCpsName)- , Decl (Fun internalCpsName [SimpleExpr internalCpsVarName])- (mkLet o_case [Decl lhs (SimpleExpr internalCpsVarName) Set.empty Set.empty] (rec remainder))- Set.empty Set.empty- ]- inBody = App "head" [App "(:)" [App internalCpsName [rhs], App "(:)" [App internalCpsName [rhs], SimpleExpr "[]"]]]- outerBody = Let inDecls inBody- block = mkLet o_case decls outerBody- in block--internalCpsName :: String-internalCpsName = "internalCps_"--internalCpsVarName :: String-internalCpsVarName = "internalCps_var_"--}--mkPartitionedFunction :: String -> Bool -> [Decl] -> [String] -> DeclBlocks -> ([Decl], Expr)-mkPartitionedFunction prefix optCase nextVisitDecls lastExprVars cpsTree- = let inh = Inh_DeclBlocksRoot { prefix_Inh_DeclBlocksRoot = prefix- , optCase_Inh_DeclBlocksRoot = optCase- , nextVisitDecls_Inh_DeclBlocksRoot = nextVisitDecls- , lastExprVars_Inh_DeclBlocksRoot = lastExprVars- }- sem = sem_DeclBlocksRoot (DeclBlocksRoot cpsTree)- syn = wrap_DeclBlocksRoot sem inh- in (lambdas_Syn_DeclBlocksRoot syn, firstCall_Syn_DeclBlocksRoot syn)--freevars :: [String] -> [Decl] -> [String]-freevars additional decls- = Set.toList (allused `Set.difference` alldefined)- where- allused = Set.unions (Set.fromList additional : map usedvars decls)- alldefined = Set.unions (map definedvars decls)- - usedvars (Decl _ _ _ uses) = uses- usedvars _ = Set.empty- - definedvars (Decl _ _ defs _) = defs- definedvars _ = Set.empty--mkBlockLambda :: Bool -> String -> [String] -> [Decl] -> Expr -> Decl-mkBlockLambda optCase name args decls expr- = Decl lhs rhs Set.empty Set.empty- where- lhs = Fun name (map SimpleExpr args)- rhs = mkLet optCase decls expr--makeLocalComment :: Int -> String -> Name -> Maybe Type -> String-makeLocalComment width what name tp = let x = getName name- y = maybe "_" (\t -> case t of (NT nt) -> getName nt; Haskell t -> '{':t++"}") tp- in ( what ++ " " ++ x ++ replicate ((width - length x) `max` 0) ' ' ++ " : " ++ y )----- Lets or nested Cases?-mkLet :: Bool -> Decls -> Expr -> Expr-mkLet False decls body = Let decls body-mkLet True decls body = foldr oneCase body decls--oneCase :: Decl -> Expr -> Expr-oneCase (Decl left rhs _ _) exp = Case rhs [CaseAlt left exp]-oneCase _ exp = exp---- Gives the name of the visit function-funname field 0 = show field ++ "_"-funname field nr = show field ++ "_" ++ show nr---- Gives the name of a semantic function-seqSemname :: String -> Nonterminal -> Constructor -> Int -> String-seqSemname pre nt con 0 = semname pre nt con-seqSemname pre nt con nr = semname pre nt con ++ "_" ++ show nr---- Gives the name of a type-typeName :: Nonterminal -> Int -> String-typeName nt 0 = "T_" ++ show nt-typeName nt n = "T_" ++ show nt ++ "_" ++ show n---- Gives the name of a visit function-visitname :: String -> Nonterminal -> Int -> String-visitname pre nt n = pre ++ getName nt ++ "_" ++ show n--- CAlternative -------------------------------------------------{-- visit 0:- inherited attributes:- allPragmas : PragmaMap- inh : Attributes- nt : Nonterminal- o_case : Bool- o_cata : Bool- o_costcentre : Bool- o_data : Maybe Bool- o_linePragmas : Bool- o_newtypes : Bool- o_pretty : Bool- o_rename : Bool- o_sem : Bool- o_sig : Bool- o_splitsems : Bool- o_strictwrap : Bool- o_traces : Bool- o_unbox : Bool- prefix : String- syn : Attributes- with_sig : Bool- chained attribute:- errors : Seq Error- synthesized attributes:- allTpsFound : Bool- cataAlt : Decl- comments : [String]- dataAlt : DataAlt- decls : Decls- semNames : [String]- alternatives:- alternative CAlternative:- child con : {Constructor}- child visits : CVisits- child children : {[(Name,Type,Bool)]}- child terminals : {[Name]}- visit 0:- local firstOrderChildren : _--}--- cata-sem_CAlternative :: CAlternative ->- T_CAlternative-sem_CAlternative (CAlternative _con _visits _children _terminals ) =- (sem_CAlternative_CAlternative _con (sem_CVisits _visits ) _children _terminals )--- semantic domain-newtype T_CAlternative = T_CAlternative (PragmaMap ->- (Seq Error) ->- Attributes ->- Nonterminal ->- Bool ->- Bool ->- Bool ->- (Maybe Bool) ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- String ->- Attributes ->- Bool ->- ( Bool,Decl,([String]),DataAlt,Decls,(Seq Error),([String])))-data Inh_CAlternative = Inh_CAlternative {allPragmas_Inh_CAlternative :: PragmaMap,errors_Inh_CAlternative :: Seq Error,inh_Inh_CAlternative :: Attributes,nt_Inh_CAlternative :: Nonterminal,o_case_Inh_CAlternative :: Bool,o_cata_Inh_CAlternative :: Bool,o_costcentre_Inh_CAlternative :: Bool,o_data_Inh_CAlternative :: Maybe Bool,o_linePragmas_Inh_CAlternative :: Bool,o_newtypes_Inh_CAlternative :: Bool,o_pretty_Inh_CAlternative :: Bool,o_rename_Inh_CAlternative :: Bool,o_sem_Inh_CAlternative :: Bool,o_sig_Inh_CAlternative :: Bool,o_splitsems_Inh_CAlternative :: Bool,o_strictwrap_Inh_CAlternative :: Bool,o_traces_Inh_CAlternative :: Bool,o_unbox_Inh_CAlternative :: Bool,prefix_Inh_CAlternative :: String,syn_Inh_CAlternative :: Attributes,with_sig_Inh_CAlternative :: Bool}-data Syn_CAlternative = Syn_CAlternative {allTpsFound_Syn_CAlternative :: Bool,cataAlt_Syn_CAlternative :: Decl,comments_Syn_CAlternative :: [String],dataAlt_Syn_CAlternative :: DataAlt,decls_Syn_CAlternative :: Decls,errors_Syn_CAlternative :: Seq Error,semNames_Syn_CAlternative :: [String]}-wrap_CAlternative (T_CAlternative sem ) (Inh_CAlternative _lhsIallPragmas _lhsIerrors _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn _lhsIwith_sig ) =- (let ( _lhsOallTpsFound,_lhsOcataAlt,_lhsOcomments,_lhsOdataAlt,_lhsOdecls,_lhsOerrors,_lhsOsemNames) =- (sem _lhsIallPragmas _lhsIerrors _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn _lhsIwith_sig )- in (Syn_CAlternative _lhsOallTpsFound _lhsOcataAlt _lhsOcomments _lhsOdataAlt _lhsOdecls _lhsOerrors _lhsOsemNames ))-sem_CAlternative_CAlternative :: Constructor ->- T_CVisits ->- ([(Name,Type,Bool)]) ->- ([Name]) ->- T_CAlternative-sem_CAlternative_CAlternative con_ (T_CVisits visits_ ) children_ terminals_ =- (T_CAlternative (\ _lhsIallPragmas- _lhsIerrors- _lhsIinh- _lhsInt- _lhsIo_case- _lhsIo_cata- _lhsIo_costcentre- _lhsIo_data- _lhsIo_linePragmas- _lhsIo_newtypes- _lhsIo_pretty- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_splitsems- _lhsIo_strictwrap- _lhsIo_traces- _lhsIo_unbox- _lhsIprefix- _lhsIsyn- _lhsIwith_sig ->- (let _visitsOcon :: Constructor- _visitsOterminals :: ([Name])- _visitsOnr :: Int- _visitsOchildren :: ([(Name,Type,Bool)])- _visitsOinstVisitNrs :: (Map Identifier Int)- _lhsOcomments :: ([String])- _lhsOdataAlt :: DataAlt- _lhsOcataAlt :: Decl- _lhsOallTpsFound :: Bool- _lhsOdecls :: Decls- _lhsOerrors :: (Seq Error)- _lhsOsemNames :: ([String])- _visitsOallPragmas :: PragmaMap- _visitsOerrors :: (Seq Error)- _visitsOinh :: Attributes- _visitsOnt :: Nonterminal- _visitsOo_case :: Bool- _visitsOo_cata :: Bool- _visitsOo_costcentre :: Bool- _visitsOo_data :: (Maybe Bool)- _visitsOo_linePragmas :: Bool- _visitsOo_newtypes :: Bool- _visitsOo_pretty :: Bool- _visitsOo_rename :: Bool- _visitsOo_sem :: Bool- _visitsOo_sig :: Bool- _visitsOo_splitsems :: Bool- _visitsOo_strictwrap :: Bool- _visitsOo_traces :: Bool- _visitsOo_unbox :: Bool- _visitsOprefix :: String- _visitsOsyn :: Attributes- _visitsOwith_sig :: Bool- _visitsIallTpsFound :: Bool- _visitsIcomments :: ([String])- _visitsIdecls :: Decls- _visitsIerrors :: (Seq Error)- _visitsIgatherInstVisitNrs :: (Map Identifier Int)- _visitsIintra :: Exprs- _visitsIintraVars :: (Set String)- _visitsIisNil :: Bool- _visitsIsemNames :: ([String])- -- "GenerateCode.ag"(line 78, column 20)- _visitsOcon =- con_- -- "GenerateCode.ag"(line 79, column 20)- _visitsOterminals =- terminals_- -- "GenerateCode.ag"(line 159, column 19)- _visitsOnr =- 0- -- "GenerateCode.ag"(line 261, column 19)- _visitsOchildren =- children_- -- "GenerateCode.ag"(line 349, column 7)- _visitsOinstVisitNrs =- _visitsIgatherInstVisitNrs- -- "GenerateCode.ag"(line 594, column 18)- _firstOrderChildren =- filter (\(_,_,ho) -> not ho) children_- -- "GenerateCode.ag"(line 595, column 18)- _lhsOcomments =- ("alternative " ++ getName con_ ++ ":")- : map ind ( map (\(x,y,_) -> makeLocalComment 14 "child" x (Just y)) _firstOrderChildren- ++ _visitsIcomments- )- -- "GenerateCode.ag"(line 704, column 19)- _lhsOdataAlt =- DataAlt (conname _lhsIo_rename _lhsInt con_) (map (\(_,t,_) -> typeToString _lhsInt t) _firstOrderChildren )- -- "GenerateCode.ag"(line 759, column 18)- _lhsOcataAlt =- let lhs = Fun (cataname _lhsIprefix _lhsInt) [lhs_pat]- lhs_pat = App (conname _lhsIo_rename _lhsInt con_)- (map (\(n,_,_) -> SimpleExpr $ locname $ n) _firstOrderChildren )- rhs = App (semname _lhsIprefix _lhsInt con_)- (map argument _firstOrderChildren )- argument (nm,NT tp,_) = App (cataname _lhsIprefix tp)- [SimpleExpr (locname nm)]- argument (nm, _,_) = SimpleExpr (locname nm)- in Decl lhs rhs Set.empty Set.empty- -- use rule "GenerateCode.ag"(line 551, column 39)- _lhsOallTpsFound =- _visitsIallTpsFound- -- use rule "GenerateCode.ag"(line 626, column 46)- _lhsOdecls =- _visitsIdecls- -- use rule "GenerateCode.ag"(line 564, column 32)- _lhsOerrors =- _visitsIerrors- -- use rule "GenerateCode.ag"(line 774, column 63)- _lhsOsemNames =- _visitsIsemNames- -- copy rule (down)- _visitsOallPragmas =- _lhsIallPragmas- -- copy rule (down)- _visitsOerrors =- _lhsIerrors- -- copy rule (down)- _visitsOinh =- _lhsIinh- -- copy rule (down)- _visitsOnt =- _lhsInt- -- copy rule (down)- _visitsOo_case =- _lhsIo_case- -- copy rule (down)- _visitsOo_cata =- _lhsIo_cata- -- copy rule (down)- _visitsOo_costcentre =- _lhsIo_costcentre- -- copy rule (down)- _visitsOo_data =- _lhsIo_data- -- copy rule (down)- _visitsOo_linePragmas =- _lhsIo_linePragmas- -- copy rule (down)- _visitsOo_newtypes =- _lhsIo_newtypes- -- copy rule (down)- _visitsOo_pretty =- _lhsIo_pretty- -- copy rule (down)- _visitsOo_rename =- _lhsIo_rename- -- copy rule (down)- _visitsOo_sem =- _lhsIo_sem- -- copy rule (down)- _visitsOo_sig =- _lhsIo_sig- -- copy rule (down)- _visitsOo_splitsems =- _lhsIo_splitsems- -- copy rule (down)- _visitsOo_strictwrap =- _lhsIo_strictwrap- -- copy rule (down)- _visitsOo_traces =- _lhsIo_traces- -- copy rule (down)- _visitsOo_unbox =- _lhsIo_unbox- -- copy rule (down)- _visitsOprefix =- _lhsIprefix- -- copy rule (down)- _visitsOsyn =- _lhsIsyn- -- copy rule (down)- _visitsOwith_sig =- _lhsIwith_sig- ( _visitsIallTpsFound,_visitsIcomments,_visitsIdecls,_visitsIerrors,_visitsIgatherInstVisitNrs,_visitsIintra,_visitsIintraVars,_visitsIisNil,_visitsIsemNames) =- (visits_ _visitsOallPragmas _visitsOchildren _visitsOcon _visitsOerrors _visitsOinh _visitsOinstVisitNrs _visitsOnr _visitsOnt _visitsOo_case _visitsOo_cata _visitsOo_costcentre _visitsOo_data _visitsOo_linePragmas _visitsOo_newtypes _visitsOo_pretty _visitsOo_rename _visitsOo_sem _visitsOo_sig _visitsOo_splitsems _visitsOo_strictwrap _visitsOo_traces _visitsOo_unbox _visitsOprefix _visitsOsyn _visitsOterminals _visitsOwith_sig )- in ( _lhsOallTpsFound,_lhsOcataAlt,_lhsOcomments,_lhsOdataAlt,_lhsOdecls,_lhsOerrors,_lhsOsemNames))) )--- CAlternatives ------------------------------------------------{-- visit 0:- inherited attributes:- allPragmas : PragmaMap- inh : Attributes- nt : Nonterminal- o_case : Bool- o_cata : Bool- o_costcentre : Bool- o_data : Maybe Bool- o_linePragmas : Bool- o_newtypes : Bool- o_pretty : Bool- o_rename : Bool- o_sem : Bool- o_sig : Bool- o_splitsems : Bool- o_strictwrap : Bool- o_traces : Bool- o_unbox : Bool- prefix : String- syn : Attributes- with_sig : Bool- chained attribute:- errors : Seq Error- synthesized attributes:- allTpsFound : Bool- cataAlts : Decls- comments : [String]- dataAlts : DataAlts- decls : Decls- semNames : [String]- alternatives:- alternative Cons:- child hd : CAlternative- child tl : CAlternatives- alternative Nil:--}--- cata-sem_CAlternatives :: CAlternatives ->- T_CAlternatives-sem_CAlternatives list =- (Prelude.foldr sem_CAlternatives_Cons sem_CAlternatives_Nil (Prelude.map sem_CAlternative list) )--- semantic domain-newtype T_CAlternatives = T_CAlternatives (PragmaMap ->- (Seq Error) ->- Attributes ->- Nonterminal ->- Bool ->- Bool ->- Bool ->- (Maybe Bool) ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- String ->- Attributes ->- Bool ->- ( Bool,Decls,([String]),DataAlts,Decls,(Seq Error),([String])))-data Inh_CAlternatives = Inh_CAlternatives {allPragmas_Inh_CAlternatives :: PragmaMap,errors_Inh_CAlternatives :: Seq Error,inh_Inh_CAlternatives :: Attributes,nt_Inh_CAlternatives :: Nonterminal,o_case_Inh_CAlternatives :: Bool,o_cata_Inh_CAlternatives :: Bool,o_costcentre_Inh_CAlternatives :: Bool,o_data_Inh_CAlternatives :: Maybe Bool,o_linePragmas_Inh_CAlternatives :: Bool,o_newtypes_Inh_CAlternatives :: Bool,o_pretty_Inh_CAlternatives :: Bool,o_rename_Inh_CAlternatives :: Bool,o_sem_Inh_CAlternatives :: Bool,o_sig_Inh_CAlternatives :: Bool,o_splitsems_Inh_CAlternatives :: Bool,o_strictwrap_Inh_CAlternatives :: Bool,o_traces_Inh_CAlternatives :: Bool,o_unbox_Inh_CAlternatives :: Bool,prefix_Inh_CAlternatives :: String,syn_Inh_CAlternatives :: Attributes,with_sig_Inh_CAlternatives :: Bool}-data Syn_CAlternatives = Syn_CAlternatives {allTpsFound_Syn_CAlternatives :: Bool,cataAlts_Syn_CAlternatives :: Decls,comments_Syn_CAlternatives :: [String],dataAlts_Syn_CAlternatives :: DataAlts,decls_Syn_CAlternatives :: Decls,errors_Syn_CAlternatives :: Seq Error,semNames_Syn_CAlternatives :: [String]}-wrap_CAlternatives (T_CAlternatives sem ) (Inh_CAlternatives _lhsIallPragmas _lhsIerrors _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn _lhsIwith_sig ) =- (let ( _lhsOallTpsFound,_lhsOcataAlts,_lhsOcomments,_lhsOdataAlts,_lhsOdecls,_lhsOerrors,_lhsOsemNames) =- (sem _lhsIallPragmas _lhsIerrors _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn _lhsIwith_sig )- in (Syn_CAlternatives _lhsOallTpsFound _lhsOcataAlts _lhsOcomments _lhsOdataAlts _lhsOdecls _lhsOerrors _lhsOsemNames ))-sem_CAlternatives_Cons :: T_CAlternative ->- T_CAlternatives ->- T_CAlternatives-sem_CAlternatives_Cons (T_CAlternative hd_ ) (T_CAlternatives tl_ ) =- (T_CAlternatives (\ _lhsIallPragmas- _lhsIerrors- _lhsIinh- _lhsInt- _lhsIo_case- _lhsIo_cata- _lhsIo_costcentre- _lhsIo_data- _lhsIo_linePragmas- _lhsIo_newtypes- _lhsIo_pretty- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_splitsems- _lhsIo_strictwrap- _lhsIo_traces- _lhsIo_unbox- _lhsIprefix- _lhsIsyn- _lhsIwith_sig ->- (let _lhsOdataAlts :: DataAlts- _lhsOcataAlts :: Decls- _lhsOallTpsFound :: Bool- _lhsOcomments :: ([String])- _lhsOdecls :: Decls- _lhsOerrors :: (Seq Error)- _lhsOsemNames :: ([String])- _hdOallPragmas :: PragmaMap- _hdOerrors :: (Seq Error)- _hdOinh :: Attributes- _hdOnt :: Nonterminal- _hdOo_case :: Bool- _hdOo_cata :: Bool- _hdOo_costcentre :: Bool- _hdOo_data :: (Maybe Bool)- _hdOo_linePragmas :: Bool- _hdOo_newtypes :: Bool- _hdOo_pretty :: Bool- _hdOo_rename :: Bool- _hdOo_sem :: Bool- _hdOo_sig :: Bool- _hdOo_splitsems :: Bool- _hdOo_strictwrap :: Bool- _hdOo_traces :: Bool- _hdOo_unbox :: Bool- _hdOprefix :: String- _hdOsyn :: Attributes- _hdOwith_sig :: Bool- _tlOallPragmas :: PragmaMap- _tlOerrors :: (Seq Error)- _tlOinh :: Attributes- _tlOnt :: Nonterminal- _tlOo_case :: Bool- _tlOo_cata :: Bool- _tlOo_costcentre :: Bool- _tlOo_data :: (Maybe Bool)- _tlOo_linePragmas :: Bool- _tlOo_newtypes :: Bool- _tlOo_pretty :: Bool- _tlOo_rename :: Bool- _tlOo_sem :: Bool- _tlOo_sig :: Bool- _tlOo_splitsems :: Bool- _tlOo_strictwrap :: Bool- _tlOo_traces :: Bool- _tlOo_unbox :: Bool- _tlOprefix :: String- _tlOsyn :: Attributes- _tlOwith_sig :: Bool- _hdIallTpsFound :: Bool- _hdIcataAlt :: Decl- _hdIcomments :: ([String])- _hdIdataAlt :: DataAlt- _hdIdecls :: Decls- _hdIerrors :: (Seq Error)- _hdIsemNames :: ([String])- _tlIallTpsFound :: Bool- _tlIcataAlts :: Decls- _tlIcomments :: ([String])- _tlIdataAlts :: DataAlts- _tlIdecls :: Decls- _tlIerrors :: (Seq Error)- _tlIsemNames :: ([String])- -- "GenerateCode.ag"(line 700, column 17)- _lhsOdataAlts =- _hdIdataAlt : _tlIdataAlts- -- "GenerateCode.ag"(line 755, column 10)- _lhsOcataAlts =- _hdIcataAlt : _tlIcataAlts- -- use rule "GenerateCode.ag"(line 551, column 39)- _lhsOallTpsFound =- _hdIallTpsFound && _tlIallTpsFound- -- use rule "GenerateCode.ag"(line 583, column 52)- _lhsOcomments =- _hdIcomments ++ _tlIcomments- -- use rule "GenerateCode.ag"(line 626, column 46)- _lhsOdecls =- _hdIdecls ++ _tlIdecls- -- use rule "GenerateCode.ag"(line 564, column 32)- _lhsOerrors =- _hdIerrors Seq.<> _tlIerrors- -- use rule "GenerateCode.ag"(line 774, column 63)- _lhsOsemNames =- _hdIsemNames ++ _tlIsemNames- -- copy rule (down)- _hdOallPragmas =- _lhsIallPragmas- -- copy rule (down)- _hdOerrors =- _lhsIerrors- -- copy rule (down)- _hdOinh =- _lhsIinh- -- copy rule (down)- _hdOnt =- _lhsInt- -- copy rule (down)- _hdOo_case =- _lhsIo_case- -- copy rule (down)- _hdOo_cata =- _lhsIo_cata- -- copy rule (down)- _hdOo_costcentre =- _lhsIo_costcentre- -- copy rule (down)- _hdOo_data =- _lhsIo_data- -- copy rule (down)- _hdOo_linePragmas =- _lhsIo_linePragmas- -- copy rule (down)- _hdOo_newtypes =- _lhsIo_newtypes- -- copy rule (down)- _hdOo_pretty =- _lhsIo_pretty- -- copy rule (down)- _hdOo_rename =- _lhsIo_rename- -- copy rule (down)- _hdOo_sem =- _lhsIo_sem- -- copy rule (down)- _hdOo_sig =- _lhsIo_sig- -- copy rule (down)- _hdOo_splitsems =- _lhsIo_splitsems- -- copy rule (down)- _hdOo_strictwrap =- _lhsIo_strictwrap- -- copy rule (down)- _hdOo_traces =- _lhsIo_traces- -- copy rule (down)- _hdOo_unbox =- _lhsIo_unbox- -- copy rule (down)- _hdOprefix =- _lhsIprefix- -- copy rule (down)- _hdOsyn =- _lhsIsyn- -- copy rule (down)- _hdOwith_sig =- _lhsIwith_sig- -- copy rule (down)- _tlOallPragmas =- _lhsIallPragmas- -- copy rule (chain)- _tlOerrors =- _hdIerrors- -- copy rule (down)- _tlOinh =- _lhsIinh- -- copy rule (down)- _tlOnt =- _lhsInt- -- copy rule (down)- _tlOo_case =- _lhsIo_case- -- copy rule (down)- _tlOo_cata =- _lhsIo_cata- -- copy rule (down)- _tlOo_costcentre =- _lhsIo_costcentre- -- copy rule (down)- _tlOo_data =- _lhsIo_data- -- copy rule (down)- _tlOo_linePragmas =- _lhsIo_linePragmas- -- copy rule (down)- _tlOo_newtypes =- _lhsIo_newtypes- -- copy rule (down)- _tlOo_pretty =- _lhsIo_pretty- -- copy rule (down)- _tlOo_rename =- _lhsIo_rename- -- copy rule (down)- _tlOo_sem =- _lhsIo_sem- -- copy rule (down)- _tlOo_sig =- _lhsIo_sig- -- copy rule (down)- _tlOo_splitsems =- _lhsIo_splitsems- -- copy rule (down)- _tlOo_strictwrap =- _lhsIo_strictwrap- -- copy rule (down)- _tlOo_traces =- _lhsIo_traces- -- copy rule (down)- _tlOo_unbox =- _lhsIo_unbox- -- copy rule (down)- _tlOprefix =- _lhsIprefix- -- copy rule (down)- _tlOsyn =- _lhsIsyn- -- copy rule (down)- _tlOwith_sig =- _lhsIwith_sig- ( _hdIallTpsFound,_hdIcataAlt,_hdIcomments,_hdIdataAlt,_hdIdecls,_hdIerrors,_hdIsemNames) =- (hd_ _hdOallPragmas _hdOerrors _hdOinh _hdOnt _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOprefix _hdOsyn _hdOwith_sig )- ( _tlIallTpsFound,_tlIcataAlts,_tlIcomments,_tlIdataAlts,_tlIdecls,_tlIerrors,_tlIsemNames) =- (tl_ _tlOallPragmas _tlOerrors _tlOinh _tlOnt _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOprefix _tlOsyn _tlOwith_sig )- in ( _lhsOallTpsFound,_lhsOcataAlts,_lhsOcomments,_lhsOdataAlts,_lhsOdecls,_lhsOerrors,_lhsOsemNames))) )-sem_CAlternatives_Nil :: T_CAlternatives-sem_CAlternatives_Nil =- (T_CAlternatives (\ _lhsIallPragmas- _lhsIerrors- _lhsIinh- _lhsInt- _lhsIo_case- _lhsIo_cata- _lhsIo_costcentre- _lhsIo_data- _lhsIo_linePragmas- _lhsIo_newtypes- _lhsIo_pretty- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_splitsems- _lhsIo_strictwrap- _lhsIo_traces- _lhsIo_unbox- _lhsIprefix- _lhsIsyn- _lhsIwith_sig ->- (let _lhsOdataAlts :: DataAlts- _lhsOcataAlts :: Decls- _lhsOallTpsFound :: Bool- _lhsOcomments :: ([String])- _lhsOdecls :: Decls- _lhsOerrors :: (Seq Error)- _lhsOsemNames :: ([String])- -- "GenerateCode.ag"(line 701, column 17)- _lhsOdataAlts =- []- -- "GenerateCode.ag"(line 756, column 10)- _lhsOcataAlts =- []- -- use rule "GenerateCode.ag"(line 551, column 39)- _lhsOallTpsFound =- True- -- use rule "GenerateCode.ag"(line 583, column 52)- _lhsOcomments =- []- -- use rule "GenerateCode.ag"(line 626, column 46)- _lhsOdecls =- []- -- use rule "GenerateCode.ag"(line 564, column 32)- _lhsOerrors =- Seq.empty- -- use rule "GenerateCode.ag"(line 774, column 63)- _lhsOsemNames =- []- in ( _lhsOallTpsFound,_lhsOcataAlts,_lhsOcomments,_lhsOdataAlts,_lhsOdecls,_lhsOerrors,_lhsOsemNames))) )--- CGrammar -----------------------------------------------------{-- visit 0:- inherited attribute:- options : Options- synthesized attributes:- errors : Seq Error- output : Program- alternatives:- alternative CGrammar:- child typeSyns : {TypeSyns}- child derivings : {Derivings}- child wrappers : {Set Nonterminal}- child prods : CProductions- child pragmas : {PragmaMap}--}--- cata-sem_CGrammar :: CGrammar ->- T_CGrammar-sem_CGrammar (CGrammar _typeSyns _derivings _wrappers _prods _pragmas ) =- (sem_CGrammar_CGrammar _typeSyns _derivings _wrappers (sem_CProductions _prods ) _pragmas )--- semantic domain-newtype T_CGrammar = T_CGrammar (Options ->- ( (Seq Error),Program))-data Inh_CGrammar = Inh_CGrammar {options_Inh_CGrammar :: Options}-data Syn_CGrammar = Syn_CGrammar {errors_Syn_CGrammar :: Seq Error,output_Syn_CGrammar :: Program}-wrap_CGrammar (T_CGrammar sem ) (Inh_CGrammar _lhsIoptions ) =- (let ( _lhsOerrors,_lhsOoutput) =- (sem _lhsIoptions )- in (Syn_CGrammar _lhsOerrors _lhsOoutput ))-sem_CGrammar_CGrammar :: TypeSyns ->- Derivings ->- (Set Nonterminal) ->- T_CProductions ->- PragmaMap ->- T_CGrammar-sem_CGrammar_CGrammar typeSyns_ derivings_ wrappers_ (T_CProductions prods_ ) pragmas_ =- (T_CGrammar (\ _lhsIoptions ->- (let _prodsOo_sig :: Bool- _prodsOo_cata :: Bool- _prodsOo_sem :: Bool- _prodsOo_newtypes :: Bool- _prodsOo_unbox :: Bool- _prodsOo_case :: Bool- _prodsOo_pretty :: Bool- _prodsOo_rename :: Bool- _prodsOo_strictwrap :: Bool- _prodsOo_splitsems :: Bool- _prodsOo_data :: (Maybe Bool)- _prodsOprefix :: String- _prodsOo_traces :: Bool- _prodsOo_costcentre :: Bool- _prodsOo_linePragmas :: Bool- _prodsOallPragmas :: PragmaMap- _prodsOwith_sig :: Bool- _prodsOerrors :: (Seq Error)- _lhsOoutput :: Program- _prodsOtypeSyns :: TypeSyns- _prodsOderivings :: Derivings- _prodsOwrappers :: (Set Nonterminal)- _lhsOerrors :: (Seq Error)- _prodsIallTpsFound :: Bool- _prodsIchunks :: Chunks- _prodsIerrors :: (Seq Error)- -- "GenerateCode.ag"(line 43, column 17)- _prodsOo_sig =- typeSigs _lhsIoptions- -- "GenerateCode.ag"(line 43, column 17)- _prodsOo_cata =- folds _lhsIoptions- -- "GenerateCode.ag"(line 43, column 17)- _prodsOo_sem =- semfuns _lhsIoptions- -- "GenerateCode.ag"(line 43, column 17)- _prodsOo_newtypes =- newtypes _lhsIoptions- -- "GenerateCode.ag"(line 43, column 17)- _prodsOo_unbox =- unbox _lhsIoptions- -- "GenerateCode.ag"(line 43, column 17)- _prodsOo_case =- cases _lhsIoptions- -- "GenerateCode.ag"(line 43, column 17)- _prodsOo_pretty =- attrInfo _lhsIoptions- -- "GenerateCode.ag"(line 43, column 17)- _prodsOo_rename =- rename _lhsIoptions- -- "GenerateCode.ag"(line 43, column 17)- _prodsOo_strictwrap =- strictWrap _lhsIoptions- -- "GenerateCode.ag"(line 43, column 17)- _prodsOo_splitsems =- splitSems _lhsIoptions- -- "GenerateCode.ag"(line 43, column 17)- _prodsOo_data =- if dataTypes _lhsIoptions then Just (strictData _lhsIoptions) else Nothing- -- "GenerateCode.ag"(line 43, column 17)- _prodsOprefix =- prefix _lhsIoptions- -- "GenerateCode.ag"(line 43, column 17)- _prodsOo_traces =- genTraces _lhsIoptions- -- "GenerateCode.ag"(line 43, column 17)- _prodsOo_costcentre =- genCostCentres _lhsIoptions- -- "GenerateCode.ag"(line 43, column 17)- _prodsOo_linePragmas =- genLinePragmas _lhsIoptions- -- "GenerateCode.ag"(line 62, column 15)- _prodsOallPragmas =- pragmas_- -- "GenerateCode.ag"(line 559, column 14)- _prodsOwith_sig =- typeSigs _lhsIoptions && _prodsIallTpsFound- -- "GenerateCode.ag"(line 566, column 15)- _prodsOerrors =- Seq.empty- -- "GenerateCode.ag"(line 630, column 17)- _lhsOoutput =- Program _prodsIchunks- -- "GenerateCode.ag"(line 679, column 14)- _prodsOtypeSyns =- typeSyns_- -- "GenerateCode.ag"(line 679, column 14)- _prodsOderivings =- derivings_- -- "GenerateCode.ag"(line 679, column 14)- _prodsOwrappers =- wrappers_- -- copy rule (up)- _lhsOerrors =- _prodsIerrors- ( _prodsIallTpsFound,_prodsIchunks,_prodsIerrors) =- (prods_ _prodsOallPragmas _prodsOderivings _prodsOerrors _prodsOo_case _prodsOo_cata _prodsOo_costcentre _prodsOo_data _prodsOo_linePragmas _prodsOo_newtypes _prodsOo_pretty _prodsOo_rename _prodsOo_sem _prodsOo_sig _prodsOo_splitsems _prodsOo_strictwrap _prodsOo_traces _prodsOo_unbox _prodsOprefix _prodsOtypeSyns _prodsOwith_sig _prodsOwrappers )- in ( _lhsOerrors,_lhsOoutput))) )--- CInterface ---------------------------------------------------{-- visit 0:- inherited attributes:- inh : Attributes- nt : Nonterminal- o_case : Bool- o_cata : Bool- o_costcentre : Bool- o_data : Maybe Bool- o_linePragmas : Bool- o_newtypes : Bool- o_pretty : Bool- o_rename : Bool- o_sem : Bool- o_sig : Bool- o_splitsems : Bool- o_strictwrap : Bool- o_traces : Bool- o_unbox : Bool- prefix : String- syn : Attributes- synthesized attributes:- comments : [String]- semDom : [Decl]- wrapDecls : Decls- alternatives:- alternative CInterface:- child seg : CSegments--}--- cata-sem_CInterface :: CInterface ->- T_CInterface-sem_CInterface (CInterface _seg ) =- (sem_CInterface_CInterface (sem_CSegments _seg ) )--- semantic domain-newtype T_CInterface = T_CInterface (Attributes ->- Nonterminal ->- Bool ->- Bool ->- Bool ->- (Maybe Bool) ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- String ->- Attributes ->- ( ([String]),([Decl]),Decls))-data Inh_CInterface = Inh_CInterface {inh_Inh_CInterface :: Attributes,nt_Inh_CInterface :: Nonterminal,o_case_Inh_CInterface :: Bool,o_cata_Inh_CInterface :: Bool,o_costcentre_Inh_CInterface :: Bool,o_data_Inh_CInterface :: Maybe Bool,o_linePragmas_Inh_CInterface :: Bool,o_newtypes_Inh_CInterface :: Bool,o_pretty_Inh_CInterface :: Bool,o_rename_Inh_CInterface :: Bool,o_sem_Inh_CInterface :: Bool,o_sig_Inh_CInterface :: Bool,o_splitsems_Inh_CInterface :: Bool,o_strictwrap_Inh_CInterface :: Bool,o_traces_Inh_CInterface :: Bool,o_unbox_Inh_CInterface :: Bool,prefix_Inh_CInterface :: String,syn_Inh_CInterface :: Attributes}-data Syn_CInterface = Syn_CInterface {comments_Syn_CInterface :: [String],semDom_Syn_CInterface :: [Decl],wrapDecls_Syn_CInterface :: Decls}-wrap_CInterface (T_CInterface sem ) (Inh_CInterface _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn ) =- (let ( _lhsOcomments,_lhsOsemDom,_lhsOwrapDecls) =- (sem _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn )- in (Syn_CInterface _lhsOcomments _lhsOsemDom _lhsOwrapDecls ))-sem_CInterface_CInterface :: T_CSegments ->- T_CInterface-sem_CInterface_CInterface (T_CSegments seg_ ) =- (T_CInterface (\ _lhsIinh- _lhsInt- _lhsIo_case- _lhsIo_cata- _lhsIo_costcentre- _lhsIo_data- _lhsIo_linePragmas- _lhsIo_newtypes- _lhsIo_pretty- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_splitsems- _lhsIo_strictwrap- _lhsIo_traces- _lhsIo_unbox- _lhsIprefix- _lhsIsyn ->- (let _segOnr :: Int- _lhsOsemDom :: ([Decl])- _lhsOcomments :: ([String])- _lhsOwrapDecls :: Decls- _segOinh :: Attributes- _segOnt :: Nonterminal- _segOo_case :: Bool- _segOo_cata :: Bool- _segOo_costcentre :: Bool- _segOo_data :: (Maybe Bool)- _segOo_linePragmas :: Bool- _segOo_newtypes :: Bool- _segOo_pretty :: Bool- _segOo_rename :: Bool- _segOo_sem :: Bool- _segOo_sig :: Bool- _segOo_splitsems :: Bool- _segOo_strictwrap :: Bool- _segOo_traces :: Bool- _segOo_unbox :: Bool- _segOprefix :: String- _segOsyn :: Attributes- _segIcomments :: ([String])- _segIisNil :: Bool- _segIsemDom :: ([Decl])- _segIwrapDecls :: Decls- -- "GenerateCode.ag"(line 163, column 17)- _segOnr =- 0- -- "GenerateCode.ag"(line 493, column 18)- _lhsOsemDom =- Comment "semantic domain" : _segIsemDom- -- use rule "GenerateCode.ag"(line 583, column 52)- _lhsOcomments =- _segIcomments- -- use rule "GenerateCode.ag"(line 532, column 52)- _lhsOwrapDecls =- _segIwrapDecls- -- copy rule (down)- _segOinh =- _lhsIinh- -- copy rule (down)- _segOnt =- _lhsInt- -- copy rule (down)- _segOo_case =- _lhsIo_case- -- copy rule (down)- _segOo_cata =- _lhsIo_cata- -- copy rule (down)- _segOo_costcentre =- _lhsIo_costcentre- -- copy rule (down)- _segOo_data =- _lhsIo_data- -- copy rule (down)- _segOo_linePragmas =- _lhsIo_linePragmas- -- copy rule (down)- _segOo_newtypes =- _lhsIo_newtypes- -- copy rule (down)- _segOo_pretty =- _lhsIo_pretty- -- copy rule (down)- _segOo_rename =- _lhsIo_rename- -- copy rule (down)- _segOo_sem =- _lhsIo_sem- -- copy rule (down)- _segOo_sig =- _lhsIo_sig- -- copy rule (down)- _segOo_splitsems =- _lhsIo_splitsems- -- copy rule (down)- _segOo_strictwrap =- _lhsIo_strictwrap- -- copy rule (down)- _segOo_traces =- _lhsIo_traces- -- copy rule (down)- _segOo_unbox =- _lhsIo_unbox- -- copy rule (down)- _segOprefix =- _lhsIprefix- -- copy rule (down)- _segOsyn =- _lhsIsyn- ( _segIcomments,_segIisNil,_segIsemDom,_segIwrapDecls) =- (seg_ _segOinh _segOnr _segOnt _segOo_case _segOo_cata _segOo_costcentre _segOo_data _segOo_linePragmas _segOo_newtypes _segOo_pretty _segOo_rename _segOo_sem _segOo_sig _segOo_splitsems _segOo_strictwrap _segOo_traces _segOo_unbox _segOprefix _segOsyn )- in ( _lhsOcomments,_lhsOsemDom,_lhsOwrapDecls))) )--- CProduction --------------------------------------------------{-- visit 0:- inherited attributes:- allPragmas : PragmaMap- derivings : Derivings- o_case : Bool- o_cata : Bool- o_costcentre : Bool- o_data : Maybe Bool- o_linePragmas : Bool- o_newtypes : Bool- o_pretty : Bool- o_rename : Bool- o_sem : Bool- o_sig : Bool- o_splitsems : Bool- o_strictwrap : Bool- o_traces : Bool- o_unbox : Bool- prefix : String- typeSyns : TypeSyns- with_sig : Bool- wrappers : Set Nonterminal- chained attribute:- errors : Seq Error- synthesized attributes:- allTpsFound : Bool- chunks : Chunks- alternatives:- alternative CProduction:- child nt : {Nonterminal}- child inh : {Attributes}- child syn : {Attributes}- child alts : CAlternatives- child inter : CInterface- visit 0:- local _tup1 : {(Attributes,Attributes,Nonterminal)}- local _tup2 : {(Attributes,Attributes,Nonterminal)}- local semWrapper : _- local comment : _- local dataDef : _- local cataFun : _--}--- cata-sem_CProduction :: CProduction ->- T_CProduction-sem_CProduction (CProduction _nt _inh _syn _alts _inter ) =- (sem_CProduction_CProduction _nt _inh _syn (sem_CAlternatives _alts ) (sem_CInterface _inter ) )--- semantic domain-newtype T_CProduction = T_CProduction (PragmaMap ->- Derivings ->- (Seq Error) ->- Bool ->- Bool ->- Bool ->- (Maybe Bool) ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- String ->- TypeSyns ->- Bool ->- (Set Nonterminal) ->- ( Bool,Chunks,(Seq Error)))-data Inh_CProduction = Inh_CProduction {allPragmas_Inh_CProduction :: PragmaMap,derivings_Inh_CProduction :: Derivings,errors_Inh_CProduction :: Seq Error,o_case_Inh_CProduction :: Bool,o_cata_Inh_CProduction :: Bool,o_costcentre_Inh_CProduction :: Bool,o_data_Inh_CProduction :: Maybe Bool,o_linePragmas_Inh_CProduction :: Bool,o_newtypes_Inh_CProduction :: Bool,o_pretty_Inh_CProduction :: Bool,o_rename_Inh_CProduction :: Bool,o_sem_Inh_CProduction :: Bool,o_sig_Inh_CProduction :: Bool,o_splitsems_Inh_CProduction :: Bool,o_strictwrap_Inh_CProduction :: Bool,o_traces_Inh_CProduction :: Bool,o_unbox_Inh_CProduction :: Bool,prefix_Inh_CProduction :: String,typeSyns_Inh_CProduction :: TypeSyns,with_sig_Inh_CProduction :: Bool,wrappers_Inh_CProduction :: Set Nonterminal}-data Syn_CProduction = Syn_CProduction {allTpsFound_Syn_CProduction :: Bool,chunks_Syn_CProduction :: Chunks,errors_Syn_CProduction :: Seq Error}-wrap_CProduction (T_CProduction sem ) (Inh_CProduction _lhsIallPragmas _lhsIderivings _lhsIerrors _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsItypeSyns _lhsIwith_sig _lhsIwrappers ) =- (let ( _lhsOallTpsFound,_lhsOchunks,_lhsOerrors) =- (sem _lhsIallPragmas _lhsIderivings _lhsIerrors _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsItypeSyns _lhsIwith_sig _lhsIwrappers )- in (Syn_CProduction _lhsOallTpsFound _lhsOchunks _lhsOerrors ))-sem_CProduction_CProduction :: Nonterminal ->- Attributes ->- Attributes ->- T_CAlternatives ->- T_CInterface ->- T_CProduction-sem_CProduction_CProduction nt_ inh_ syn_ (T_CAlternatives alts_ ) (T_CInterface inter_ ) =- (T_CProduction (\ _lhsIallPragmas- _lhsIderivings- _lhsIerrors- _lhsIo_case- _lhsIo_cata- _lhsIo_costcentre- _lhsIo_data- _lhsIo_linePragmas- _lhsIo_newtypes- _lhsIo_pretty- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_splitsems- _lhsIo_strictwrap- _lhsIo_traces- _lhsIo_unbox- _lhsIprefix- _lhsItypeSyns- _lhsIwith_sig- _lhsIwrappers ->- (let __tup1 :: ((Attributes,Attributes,Nonterminal))- _interOinh :: Attributes- _interOsyn :: Attributes- _interOnt :: Nonterminal- __tup2 :: ((Attributes,Attributes,Nonterminal))- _altsOinh :: Attributes- _altsOsyn :: Attributes- _altsOnt :: Nonterminal- _lhsOchunks :: Chunks- _lhsOallTpsFound :: Bool- _lhsOerrors :: (Seq Error)- _altsOallPragmas :: PragmaMap- _altsOerrors :: (Seq Error)- _altsOo_case :: Bool- _altsOo_cata :: Bool- _altsOo_costcentre :: Bool- _altsOo_data :: (Maybe Bool)- _altsOo_linePragmas :: Bool- _altsOo_newtypes :: Bool- _altsOo_pretty :: Bool- _altsOo_rename :: Bool- _altsOo_sem :: Bool- _altsOo_sig :: Bool- _altsOo_splitsems :: Bool- _altsOo_strictwrap :: Bool- _altsOo_traces :: Bool- _altsOo_unbox :: Bool- _altsOprefix :: String- _altsOwith_sig :: Bool- _interOo_case :: Bool- _interOo_cata :: Bool- _interOo_costcentre :: Bool- _interOo_data :: (Maybe Bool)- _interOo_linePragmas :: Bool- _interOo_newtypes :: Bool- _interOo_pretty :: Bool- _interOo_rename :: Bool- _interOo_sem :: Bool- _interOo_sig :: Bool- _interOo_splitsems :: Bool- _interOo_strictwrap :: Bool- _interOo_traces :: Bool- _interOo_unbox :: Bool- _interOprefix :: String- _altsIallTpsFound :: Bool- _altsIcataAlts :: Decls- _altsIcomments :: ([String])- _altsIdataAlts :: DataAlts- _altsIdecls :: Decls- _altsIerrors :: (Seq Error)- _altsIsemNames :: ([String])- _interIcomments :: ([String])- _interIsemDom :: ([Decl])- _interIwrapDecls :: Decls- -- "GenerateCode.ag"(line 72, column 25)- __tup1 =- (inh_,syn_,nt_)- -- "GenerateCode.ag"(line 72, column 25)- (_interOinh,_,_) =- __tup1- -- "GenerateCode.ag"(line 72, column 25)- (_,_interOsyn,_) =- __tup1- -- "GenerateCode.ag"(line 72, column 25)- (_,_,_interOnt) =- __tup1- -- "GenerateCode.ag"(line 73, column 24)- __tup2 =- (inh_,syn_,nt_)- -- "GenerateCode.ag"(line 73, column 24)- (_altsOinh,_,_) =- __tup2- -- "GenerateCode.ag"(line 73, column 24)- (_,_altsOsyn,_) =- __tup2- -- "GenerateCode.ag"(line 73, column 24)- (_,_,_altsOnt) =- __tup2- -- "GenerateCode.ag"(line 512, column 17)- _semWrapper =- let inhAttrs = Map.toList inh_- synAttrs = Map.toList syn_- inhVars = [ SimpleExpr (attrname True _LHS a) | (a,_) <- inhAttrs ]- synVars = [ SimpleExpr (attrname False _LHS a) | (a,_) <- synAttrs ]- var = "sem"- wrapNT = "wrap" ++ "_" ++ getName nt_- inhNT = "Inh" ++ "_" ++ getName nt_- synNT = "Syn" ++ "_" ++ getName nt_- varPat = if _lhsIo_newtypes- then App (sdtype nt_) [SimpleExpr var]- else SimpleExpr var- typeSig = TSig wrapNT (SimpleType (sdtype nt_) `Arr` (SimpleType inhNT `Arr` SimpleType synNT))- mkstrict = if _lhsIo_strictwrap then (\x -> "!(" ++ x ++ ")") else id- mkdata n attrs = Data n [Record n [(getName f++"_"++n,mkstrict $ typeToString nt_ t) | (f,t) <- attrs]] False []- datas = [mkdata inhNT inhAttrs, mkdata synNT synAttrs]- in datas ++ [ Decl (Fun wrapNT [varPat, App inhNT inhVars])- (Let _interIwrapDecls (App synNT synVars))- Set.empty Set.empty- ]- -- "GenerateCode.ag"(line 579, column 17)- _comment =- Comment . unlines . map ind $ ( _interIcomments ++ ("alternatives:" : map ind _altsIcomments) )- -- "GenerateCode.ag"(line 633, column 18)- _lhsOchunks =- [ Chunk (getName nt_)- (Comment (getName nt_ ++ " " ++ replicate (60 - length (getName nt_)) '-'))- (if _lhsIo_pretty then [_comment ] else [])- (if isJust _lhsIo_data then [_dataDef ] else [])- (if _lhsIo_cata then _cataFun else [])- (if _lhsIo_sig then _interIsemDom else [])- (if nt_ `Set.member` _lhsIwrappers then _semWrapper else [])- (if _lhsIo_sem then _altsIdecls else [])- (if _lhsIo_sem then _altsIsemNames else [])- ]- -- "GenerateCode.ag"(line 684, column 17)- _dataDef =- let typeSyn tp = let theType =- case tp of- CommonTypes.Maybe t -> SimpleType ("Maybe (" ++ typeToString nt_ t ++")")- CommonTypes.List t -> Code.List $ SimpleType (typeToString nt_ t)- CommonTypes.Tuple ts -> Code.TupleType [SimpleType (typeToString nt_ t)- | (_,t) <- ts- ]- in Code.Type (getName nt_) theType- derivings = maybe [] (map getName . Set.toList) (Map.lookup nt_ _lhsIderivings)- dataDef = Data (getName nt_) _altsIdataAlts (maybe False id _lhsIo_data) derivings- in maybe dataDef typeSyn $ lookup nt_ _lhsItypeSyns- -- "GenerateCode.ag"(line 711, column 17)- _cataFun =- let tSig = TSig (cataname _lhsIprefix nt_)- (SimpleType (getName nt_) `Arr` SimpleType (sdtype nt_))- special typ = case typ of- CommonTypes.List tp ->- let cons = SimpleExpr (semname _lhsIprefix nt_ (identifier "Cons"))- nil = SimpleExpr (semname _lhsIprefix nt_ (identifier "Nil" ))- arg = SimpleExpr "list"- rarg = case tp of- NT t -> SimpleExpr ("(Prelude.map " ++ (cataname _lhsIprefix t) ++ " list)")- _ -> arg- lhs = Fun (cataname _lhsIprefix nt_) [arg]- rhs = (App "Prelude.foldr" [cons,nil,rarg])- in [Decl lhs rhs Set.empty Set.empty]- CommonTypes.Maybe tp ->- let just = semname _lhsIprefix nt_ (identifier "Just")- nothing = semname _lhsIprefix nt_ (identifier "Nothing" )- arg = SimpleExpr "x"- rarg = case tp of- NT t -> App (cataname _lhsIprefix t) [arg]- _ -> arg- lhs a = Fun (cataname _lhsIprefix nt_) [a]- in [Decl (lhs (App "Prelude.Just" [arg])) (App just [rarg]) Set.empty Set.empty- ,Decl (lhs (SimpleExpr "Prelude.Nothing")) (SimpleExpr nothing) Set.empty Set.empty- ]- CommonTypes.Tuple tps ->- let con = semname _lhsIprefix nt_ (identifier "Tuple")- tps' = [ (SimpleExpr (getName x),y) | (x,y) <- tps]- rargs = map rarg tps'- rarg (n, tp) = case tp of- NT t -> App (cataname _lhsIprefix t) [n]- _ -> n- lhs = Fun (cataname _lhsIprefix nt_) [TupleExpr (map fst tps')]- rhs = App con rargs- in [Decl lhs rhs Set.empty Set.empty]- in Comment "cata" :- (if _lhsIo_sig then [tSig] else []) ++- maybe _altsIcataAlts special (lookup nt_ _lhsItypeSyns)- -- use rule "GenerateCode.ag"(line 551, column 39)- _lhsOallTpsFound =- _altsIallTpsFound- -- use rule "GenerateCode.ag"(line 564, column 32)- _lhsOerrors =- _altsIerrors- -- copy rule (down)- _altsOallPragmas =- _lhsIallPragmas- -- copy rule (down)- _altsOerrors =- _lhsIerrors- -- copy rule (down)- _altsOo_case =- _lhsIo_case- -- copy rule (down)- _altsOo_cata =- _lhsIo_cata- -- copy rule (down)- _altsOo_costcentre =- _lhsIo_costcentre- -- copy rule (down)- _altsOo_data =- _lhsIo_data- -- copy rule (down)- _altsOo_linePragmas =- _lhsIo_linePragmas- -- copy rule (down)- _altsOo_newtypes =- _lhsIo_newtypes- -- copy rule (down)- _altsOo_pretty =- _lhsIo_pretty- -- copy rule (down)- _altsOo_rename =- _lhsIo_rename- -- copy rule (down)- _altsOo_sem =- _lhsIo_sem- -- copy rule (down)- _altsOo_sig =- _lhsIo_sig- -- copy rule (down)- _altsOo_splitsems =- _lhsIo_splitsems- -- copy rule (down)- _altsOo_strictwrap =- _lhsIo_strictwrap- -- copy rule (down)- _altsOo_traces =- _lhsIo_traces- -- copy rule (down)- _altsOo_unbox =- _lhsIo_unbox- -- copy rule (down)- _altsOprefix =- _lhsIprefix- -- copy rule (down)- _altsOwith_sig =- _lhsIwith_sig- -- copy rule (down)- _interOo_case =- _lhsIo_case- -- copy rule (down)- _interOo_cata =- _lhsIo_cata- -- copy rule (down)- _interOo_costcentre =- _lhsIo_costcentre- -- copy rule (down)- _interOo_data =- _lhsIo_data- -- copy rule (down)- _interOo_linePragmas =- _lhsIo_linePragmas- -- copy rule (down)- _interOo_newtypes =- _lhsIo_newtypes- -- copy rule (down)- _interOo_pretty =- _lhsIo_pretty- -- copy rule (down)- _interOo_rename =- _lhsIo_rename- -- copy rule (down)- _interOo_sem =- _lhsIo_sem- -- copy rule (down)- _interOo_sig =- _lhsIo_sig- -- copy rule (down)- _interOo_splitsems =- _lhsIo_splitsems- -- copy rule (down)- _interOo_strictwrap =- _lhsIo_strictwrap- -- copy rule (down)- _interOo_traces =- _lhsIo_traces- -- copy rule (down)- _interOo_unbox =- _lhsIo_unbox- -- copy rule (down)- _interOprefix =- _lhsIprefix- ( _altsIallTpsFound,_altsIcataAlts,_altsIcomments,_altsIdataAlts,_altsIdecls,_altsIerrors,_altsIsemNames) =- (alts_ _altsOallPragmas _altsOerrors _altsOinh _altsOnt _altsOo_case _altsOo_cata _altsOo_costcentre _altsOo_data _altsOo_linePragmas _altsOo_newtypes _altsOo_pretty _altsOo_rename _altsOo_sem _altsOo_sig _altsOo_splitsems _altsOo_strictwrap _altsOo_traces _altsOo_unbox _altsOprefix _altsOsyn _altsOwith_sig )- ( _interIcomments,_interIsemDom,_interIwrapDecls) =- (inter_ _interOinh _interOnt _interOo_case _interOo_cata _interOo_costcentre _interOo_data _interOo_linePragmas _interOo_newtypes _interOo_pretty _interOo_rename _interOo_sem _interOo_sig _interOo_splitsems _interOo_strictwrap _interOo_traces _interOo_unbox _interOprefix _interOsyn )- in ( _lhsOallTpsFound,_lhsOchunks,_lhsOerrors))) )--- CProductions -------------------------------------------------{-- visit 0:- inherited attributes:- allPragmas : PragmaMap- derivings : Derivings- o_case : Bool- o_cata : Bool- o_costcentre : Bool- o_data : Maybe Bool- o_linePragmas : Bool- o_newtypes : Bool- o_pretty : Bool- o_rename : Bool- o_sem : Bool- o_sig : Bool- o_splitsems : Bool- o_strictwrap : Bool- o_traces : Bool- o_unbox : Bool- prefix : String- typeSyns : TypeSyns- with_sig : Bool- wrappers : Set Nonterminal- chained attribute:- errors : Seq Error- synthesized attributes:- allTpsFound : Bool- chunks : Chunks- alternatives:- alternative Cons:- child hd : CProduction- child tl : CProductions- alternative Nil:--}--- cata-sem_CProductions :: CProductions ->- T_CProductions-sem_CProductions list =- (Prelude.foldr sem_CProductions_Cons sem_CProductions_Nil (Prelude.map sem_CProduction list) )--- semantic domain-newtype T_CProductions = T_CProductions (PragmaMap ->- Derivings ->- (Seq Error) ->- Bool ->- Bool ->- Bool ->- (Maybe Bool) ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- String ->- TypeSyns ->- Bool ->- (Set Nonterminal) ->- ( Bool,Chunks,(Seq Error)))-data Inh_CProductions = Inh_CProductions {allPragmas_Inh_CProductions :: PragmaMap,derivings_Inh_CProductions :: Derivings,errors_Inh_CProductions :: Seq Error,o_case_Inh_CProductions :: Bool,o_cata_Inh_CProductions :: Bool,o_costcentre_Inh_CProductions :: Bool,o_data_Inh_CProductions :: Maybe Bool,o_linePragmas_Inh_CProductions :: Bool,o_newtypes_Inh_CProductions :: Bool,o_pretty_Inh_CProductions :: Bool,o_rename_Inh_CProductions :: Bool,o_sem_Inh_CProductions :: Bool,o_sig_Inh_CProductions :: Bool,o_splitsems_Inh_CProductions :: Bool,o_strictwrap_Inh_CProductions :: Bool,o_traces_Inh_CProductions :: Bool,o_unbox_Inh_CProductions :: Bool,prefix_Inh_CProductions :: String,typeSyns_Inh_CProductions :: TypeSyns,with_sig_Inh_CProductions :: Bool,wrappers_Inh_CProductions :: Set Nonterminal}-data Syn_CProductions = Syn_CProductions {allTpsFound_Syn_CProductions :: Bool,chunks_Syn_CProductions :: Chunks,errors_Syn_CProductions :: Seq Error}-wrap_CProductions (T_CProductions sem ) (Inh_CProductions _lhsIallPragmas _lhsIderivings _lhsIerrors _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsItypeSyns _lhsIwith_sig _lhsIwrappers ) =- (let ( _lhsOallTpsFound,_lhsOchunks,_lhsOerrors) =- (sem _lhsIallPragmas _lhsIderivings _lhsIerrors _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsItypeSyns _lhsIwith_sig _lhsIwrappers )- in (Syn_CProductions _lhsOallTpsFound _lhsOchunks _lhsOerrors ))-sem_CProductions_Cons :: T_CProduction ->- T_CProductions ->- T_CProductions-sem_CProductions_Cons (T_CProduction hd_ ) (T_CProductions tl_ ) =- (T_CProductions (\ _lhsIallPragmas- _lhsIderivings- _lhsIerrors- _lhsIo_case- _lhsIo_cata- _lhsIo_costcentre- _lhsIo_data- _lhsIo_linePragmas- _lhsIo_newtypes- _lhsIo_pretty- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_splitsems- _lhsIo_strictwrap- _lhsIo_traces- _lhsIo_unbox- _lhsIprefix- _lhsItypeSyns- _lhsIwith_sig- _lhsIwrappers ->- (let _lhsOallTpsFound :: Bool- _lhsOchunks :: Chunks- _lhsOerrors :: (Seq Error)- _hdOallPragmas :: PragmaMap- _hdOderivings :: Derivings- _hdOerrors :: (Seq Error)- _hdOo_case :: Bool- _hdOo_cata :: Bool- _hdOo_costcentre :: Bool- _hdOo_data :: (Maybe Bool)- _hdOo_linePragmas :: Bool- _hdOo_newtypes :: Bool- _hdOo_pretty :: Bool- _hdOo_rename :: Bool- _hdOo_sem :: Bool- _hdOo_sig :: Bool- _hdOo_splitsems :: Bool- _hdOo_strictwrap :: Bool- _hdOo_traces :: Bool- _hdOo_unbox :: Bool- _hdOprefix :: String- _hdOtypeSyns :: TypeSyns- _hdOwith_sig :: Bool- _hdOwrappers :: (Set Nonterminal)- _tlOallPragmas :: PragmaMap- _tlOderivings :: Derivings- _tlOerrors :: (Seq Error)- _tlOo_case :: Bool- _tlOo_cata :: Bool- _tlOo_costcentre :: Bool- _tlOo_data :: (Maybe Bool)- _tlOo_linePragmas :: Bool- _tlOo_newtypes :: Bool- _tlOo_pretty :: Bool- _tlOo_rename :: Bool- _tlOo_sem :: Bool- _tlOo_sig :: Bool- _tlOo_splitsems :: Bool- _tlOo_strictwrap :: Bool- _tlOo_traces :: Bool- _tlOo_unbox :: Bool- _tlOprefix :: String- _tlOtypeSyns :: TypeSyns- _tlOwith_sig :: Bool- _tlOwrappers :: (Set Nonterminal)- _hdIallTpsFound :: Bool- _hdIchunks :: Chunks- _hdIerrors :: (Seq Error)- _tlIallTpsFound :: Bool- _tlIchunks :: Chunks- _tlIerrors :: (Seq Error)- -- use rule "GenerateCode.ag"(line 551, column 39)- _lhsOallTpsFound =- _hdIallTpsFound && _tlIallTpsFound- -- use rule "GenerateCode.ag"(line 625, column 47)- _lhsOchunks =- _hdIchunks ++ _tlIchunks- -- use rule "GenerateCode.ag"(line 564, column 32)- _lhsOerrors =- _hdIerrors Seq.<> _tlIerrors- -- copy rule (down)- _hdOallPragmas =- _lhsIallPragmas- -- copy rule (down)- _hdOderivings =- _lhsIderivings- -- copy rule (down)- _hdOerrors =- _lhsIerrors- -- copy rule (down)- _hdOo_case =- _lhsIo_case- -- copy rule (down)- _hdOo_cata =- _lhsIo_cata- -- copy rule (down)- _hdOo_costcentre =- _lhsIo_costcentre- -- copy rule (down)- _hdOo_data =- _lhsIo_data- -- copy rule (down)- _hdOo_linePragmas =- _lhsIo_linePragmas- -- copy rule (down)- _hdOo_newtypes =- _lhsIo_newtypes- -- copy rule (down)- _hdOo_pretty =- _lhsIo_pretty- -- copy rule (down)- _hdOo_rename =- _lhsIo_rename- -- copy rule (down)- _hdOo_sem =- _lhsIo_sem- -- copy rule (down)- _hdOo_sig =- _lhsIo_sig- -- copy rule (down)- _hdOo_splitsems =- _lhsIo_splitsems- -- copy rule (down)- _hdOo_strictwrap =- _lhsIo_strictwrap- -- copy rule (down)- _hdOo_traces =- _lhsIo_traces- -- copy rule (down)- _hdOo_unbox =- _lhsIo_unbox- -- copy rule (down)- _hdOprefix =- _lhsIprefix- -- copy rule (down)- _hdOtypeSyns =- _lhsItypeSyns- -- copy rule (down)- _hdOwith_sig =- _lhsIwith_sig- -- copy rule (down)- _hdOwrappers =- _lhsIwrappers- -- copy rule (down)- _tlOallPragmas =- _lhsIallPragmas- -- copy rule (down)- _tlOderivings =- _lhsIderivings- -- copy rule (chain)- _tlOerrors =- _hdIerrors- -- copy rule (down)- _tlOo_case =- _lhsIo_case- -- copy rule (down)- _tlOo_cata =- _lhsIo_cata- -- copy rule (down)- _tlOo_costcentre =- _lhsIo_costcentre- -- copy rule (down)- _tlOo_data =- _lhsIo_data- -- copy rule (down)- _tlOo_linePragmas =- _lhsIo_linePragmas- -- copy rule (down)- _tlOo_newtypes =- _lhsIo_newtypes- -- copy rule (down)- _tlOo_pretty =- _lhsIo_pretty- -- copy rule (down)- _tlOo_rename =- _lhsIo_rename- -- copy rule (down)- _tlOo_sem =- _lhsIo_sem- -- copy rule (down)- _tlOo_sig =- _lhsIo_sig- -- copy rule (down)- _tlOo_splitsems =- _lhsIo_splitsems- -- copy rule (down)- _tlOo_strictwrap =- _lhsIo_strictwrap- -- copy rule (down)- _tlOo_traces =- _lhsIo_traces- -- copy rule (down)- _tlOo_unbox =- _lhsIo_unbox- -- copy rule (down)- _tlOprefix =- _lhsIprefix- -- copy rule (down)- _tlOtypeSyns =- _lhsItypeSyns- -- copy rule (down)- _tlOwith_sig =- _lhsIwith_sig- -- copy rule (down)- _tlOwrappers =- _lhsIwrappers- ( _hdIallTpsFound,_hdIchunks,_hdIerrors) =- (hd_ _hdOallPragmas _hdOderivings _hdOerrors _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOprefix _hdOtypeSyns _hdOwith_sig _hdOwrappers )- ( _tlIallTpsFound,_tlIchunks,_tlIerrors) =- (tl_ _tlOallPragmas _tlOderivings _tlOerrors _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOprefix _tlOtypeSyns _tlOwith_sig _tlOwrappers )- in ( _lhsOallTpsFound,_lhsOchunks,_lhsOerrors))) )-sem_CProductions_Nil :: T_CProductions-sem_CProductions_Nil =- (T_CProductions (\ _lhsIallPragmas- _lhsIderivings- _lhsIerrors- _lhsIo_case- _lhsIo_cata- _lhsIo_costcentre- _lhsIo_data- _lhsIo_linePragmas- _lhsIo_newtypes- _lhsIo_pretty- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_splitsems- _lhsIo_strictwrap- _lhsIo_traces- _lhsIo_unbox- _lhsIprefix- _lhsItypeSyns- _lhsIwith_sig- _lhsIwrappers ->- (let _lhsOallTpsFound :: Bool- _lhsOchunks :: Chunks- _lhsOerrors :: (Seq Error)- -- use rule "GenerateCode.ag"(line 551, column 39)- _lhsOallTpsFound =- True- -- use rule "GenerateCode.ag"(line 625, column 47)- _lhsOchunks =- []- -- use rule "GenerateCode.ag"(line 564, column 32)- _lhsOerrors =- Seq.empty- in ( _lhsOallTpsFound,_lhsOchunks,_lhsOerrors))) )--- CRule --------------------------------------------------------{-- visit 0:- inherited attributes:- children : [(Name,Type,Bool)]- con : Constructor- higherOrderChildren : [(Name,Type,Bool)]- inh : Attributes- instVisitNrs : Map Identifier Int- nr : Int- nt : Nonterminal- o_case : Bool- o_cata : Bool- o_costcentre : Bool- o_data : Maybe Bool- o_linePragmas : Bool- o_newtypes : Bool- o_pretty : Bool- o_rename : Bool- o_sem : Bool- o_sig : Bool- o_splitsems : Bool- o_strictwrap : Bool- o_traces : Bool- o_unbox : Bool- prefix : String- syn : Attributes- terminals : [Name]- what : String- chained attributes:- declsAbove : [Decl]- errors : Seq Error- synthesized attributes:- allTpsFound : Bool- bldBlocksFun : DeclBlocks -> DeclBlocks- comments : [String]- decls : Decls- definedInsts : [Identifier]- exprs : Exprs- tSigs : [Decl]- tps : [Type]- usedVars : Set String- alternatives:- alternative CChildVisit:- child name : {Name}- child nt : {Nonterminal}- child nr : {Int}- child inh : {Attributes}- child syn : {Attributes}- child isLast : {Bool}- visit 0:- local costCentreDescr : _- local addCostCentre : _- local decls : _- local isSuperfluousHigherOrderIntra : _- local names : _- local mkTp : _- local definedTps : _- local nextTp : _- alternative CRule:- child name : {Name}- child isIn : {Bool}- child hasCode : {Bool}- child nt : {Nonterminal}- child con : {Constructor}- child field : {Name}- child childnt : {Maybe Nonterminal}- child tp : {Maybe Type}- child pattern : Pattern- child rhs : {[String]}- child defines : {Map Int (Name,Name,Maybe Type)}- child owrt : {Bool}- child origin : {String}- child uses : {Set (Name, Name)}- visit 0:- local instTypes : _- local originComment : _- local instDecls : _- local patDescr : _- local traceDescr : _- local addTrace : _- local costCentreDescr : _- local addCostCentre : _- local addLinePragma : _- local decls : _- local definedInsts : _- local name : _- local mkTp : _- local _tup3 : {([Type],Bool)}--}--- cata-sem_CRule :: CRule ->- T_CRule-sem_CRule (CChildVisit _name _nt _nr _inh _syn _isLast ) =- (sem_CRule_CChildVisit _name _nt _nr _inh _syn _isLast )-sem_CRule (CRule _name _isIn _hasCode _nt _con _field _childnt _tp _pattern _rhs _defines _owrt _origin _uses ) =- (sem_CRule_CRule _name _isIn _hasCode _nt _con _field _childnt _tp (sem_Pattern _pattern ) _rhs _defines _owrt _origin _uses )--- semantic domain-newtype T_CRule = T_CRule (([(Name,Type,Bool)]) ->- Constructor ->- ([Decl]) ->- (Seq Error) ->- ([(Name,Type,Bool)]) ->- Attributes ->- (Map Identifier Int) ->- Int ->- Nonterminal ->- Bool ->- Bool ->- Bool ->- (Maybe Bool) ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- String ->- Attributes ->- ([Name]) ->- String ->- ( Bool,(DeclBlocks -> DeclBlocks),([String]),Decls,([Decl]),([Identifier]),(Seq Error),Exprs,([Decl]),([Type]),(Set String)))-data Inh_CRule = Inh_CRule {children_Inh_CRule :: [(Name,Type,Bool)],con_Inh_CRule :: Constructor,declsAbove_Inh_CRule :: [Decl],errors_Inh_CRule :: Seq Error,higherOrderChildren_Inh_CRule :: [(Name,Type,Bool)],inh_Inh_CRule :: Attributes,instVisitNrs_Inh_CRule :: Map Identifier Int,nr_Inh_CRule :: Int,nt_Inh_CRule :: Nonterminal,o_case_Inh_CRule :: Bool,o_cata_Inh_CRule :: Bool,o_costcentre_Inh_CRule :: Bool,o_data_Inh_CRule :: Maybe Bool,o_linePragmas_Inh_CRule :: Bool,o_newtypes_Inh_CRule :: Bool,o_pretty_Inh_CRule :: Bool,o_rename_Inh_CRule :: Bool,o_sem_Inh_CRule :: Bool,o_sig_Inh_CRule :: Bool,o_splitsems_Inh_CRule :: Bool,o_strictwrap_Inh_CRule :: Bool,o_traces_Inh_CRule :: Bool,o_unbox_Inh_CRule :: Bool,prefix_Inh_CRule :: String,syn_Inh_CRule :: Attributes,terminals_Inh_CRule :: [Name],what_Inh_CRule :: String}-data Syn_CRule = Syn_CRule {allTpsFound_Syn_CRule :: Bool,bldBlocksFun_Syn_CRule :: DeclBlocks -> DeclBlocks,comments_Syn_CRule :: [String],decls_Syn_CRule :: Decls,declsAbove_Syn_CRule :: [Decl],definedInsts_Syn_CRule :: [Identifier],errors_Syn_CRule :: Seq Error,exprs_Syn_CRule :: Exprs,tSigs_Syn_CRule :: [Decl],tps_Syn_CRule :: [Type],usedVars_Syn_CRule :: Set String}-wrap_CRule (T_CRule sem ) (Inh_CRule _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIerrors _lhsIhigherOrderChildren _lhsIinh _lhsIinstVisitNrs _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn _lhsIterminals _lhsIwhat ) =- (let ( _lhsOallTpsFound,_lhsObldBlocksFun,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOerrors,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars) =- (sem _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIerrors _lhsIhigherOrderChildren _lhsIinh _lhsIinstVisitNrs _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn _lhsIterminals _lhsIwhat )- in (Syn_CRule _lhsOallTpsFound _lhsObldBlocksFun _lhsOcomments _lhsOdecls _lhsOdeclsAbove _lhsOdefinedInsts _lhsOerrors _lhsOexprs _lhsOtSigs _lhsOtps _lhsOusedVars ))-sem_CRule_CChildVisit :: Name ->- Nonterminal ->- Int ->- Attributes ->- Attributes ->- Bool ->- T_CRule-sem_CRule_CChildVisit name_ nt_ nr_ inh_ syn_ isLast_ =- (T_CRule (\ _lhsIchildren- _lhsIcon- _lhsIdeclsAbove- _lhsIerrors- _lhsIhigherOrderChildren- _lhsIinh- _lhsIinstVisitNrs- _lhsInr- _lhsInt- _lhsIo_case- _lhsIo_cata- _lhsIo_costcentre- _lhsIo_data- _lhsIo_linePragmas- _lhsIo_newtypes- _lhsIo_pretty- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_splitsems- _lhsIo_strictwrap- _lhsIo_traces- _lhsIo_unbox- _lhsIprefix- _lhsIsyn- _lhsIterminals- _lhsIwhat ->- (let _lhsOexprs :: Exprs- _lhsOusedVars :: (Set String)- _lhsOtSigs :: ([Decl])- _lhsOtps :: ([Type])- _lhsOdeclsAbove :: ([Decl])- _lhsObldBlocksFun :: (DeclBlocks -> DeclBlocks)- _lhsOallTpsFound :: Bool- _lhsOcomments :: ([String])- _lhsOdecls :: Decls- _lhsOdefinedInsts :: ([Identifier])- _lhsOerrors :: (Seq Error)- -- "GenerateCode.ag"(line 126, column 18)- _costCentreDescr =- show _lhsInt ++ ":" ++ show _lhsIcon ++ ":" ++ show name_ ++ ":" ++ show nt_ ++ ":" ++ show nr_- -- "GenerateCode.ag"(line 127, column 18)- _addCostCentre =- \v -> if _lhsIo_costcentre- then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v- else v- -- "GenerateCode.ag"(line 130, column 18)- _decls =- let lhsVars = map (attrname True name_) (Map.keys syn_)- ++ if isLast_ then [] else [unwrap ++ funname name_ (nr_+1)]- rhsVars = map (attrname False name_) (Map.keys inh_)- unwrap = if _lhsIo_newtypes then typeName nt_ (nr_ + 1) ++ " " else ""- tuple = mkTupleLhs _lhsIo_unbox (null $ Map.keys inh_) lhsVars- rhs = _addCostCentre $ App (funname name_ nr_) (map SimpleExpr rhsVars)- in [Decl tuple rhs (Set.fromList lhsVars) (Set.fromList (funname name_ nr_ : rhsVars))]- -- "GenerateCode.ag"(line 206, column 7)- _isSuperfluousHigherOrderIntra =- _lhsInr <= Map.findWithDefault (-1) name_ _lhsIinstVisitNrs- -- "GenerateCode.ag"(line 220, column 8)- _names =- if _isSuperfluousHigherOrderIntra- then []- else [funname name_ (nr_+1)]- -- "GenerateCode.ag"(line 224, column 8)- _lhsOexprs =- let wrap = if _lhsIo_newtypes then \x -> App (typeName nt_ (nr_ + 1)) [x] else id- in map (wrap . SimpleExpr) _names- -- "GenerateCode.ag"(line 232, column 7)- _lhsOusedVars =- Set.fromList _names- -- "GenerateCode.ag"(line 243, column 19)- _mkTp =- SimpleType . typeToString nt_- -- "GenerateCode.ag"(line 244, column 19)- _definedTps =- [ TSig (attrname True name_ a) (_mkTp tp) | (a,tp) <- Map.toList syn_ ]- -- "GenerateCode.ag"(line 245, column 19)- _nextTp =- typeName nt_ (nr_+1)- -- "GenerateCode.ag"(line 246, column 19)- _lhsOtSigs =- (if isLast_ then id else (TSig (funname name_ (nr_+1)) (SimpleType _nextTp) :)) _definedTps- -- "GenerateCode.ag"(line 268, column 19)- _lhsOtps =- if _isSuperfluousHigherOrderIntra- then []- else [Haskell _nextTp]- -- "GenerateCode.ag"(line 371, column 7)- _lhsOdeclsAbove =- []- -- "GenerateCode.ag"(line 384, column 7)- _lhsObldBlocksFun =- DeclBlock _lhsIdeclsAbove (head _decls )- -- use rule "GenerateCode.ag"(line 265, column 39)- _lhsOallTpsFound =- True- -- use rule "GenerateCode.ag"(line 583, column 52)- _lhsOcomments =- []- -- use rule "GenerateCode.ag"(line 87, column 34)- _lhsOdecls =- _decls- -- use rule "GenerateCode.ag"(line 140, column 55)- _lhsOdefinedInsts =- []- -- use rule "GenerateCode.ag"(line 564, column 32)- _lhsOerrors =- Seq.empty- in ( _lhsOallTpsFound,_lhsObldBlocksFun,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOerrors,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars))) )-sem_CRule_CRule :: Name ->- Bool ->- Bool ->- Nonterminal ->- Constructor ->- Name ->- (Maybe Nonterminal) ->- (Maybe Type) ->- T_Pattern ->- ([String]) ->- (Map Int (Name,Name,Maybe Type)) ->- Bool ->- String ->- (Set (Name, Name)) ->- T_CRule-sem_CRule_CRule name_ isIn_ hasCode_ nt_ con_ field_ childnt_ tp_ (T_Pattern pattern_ ) rhs_ defines_ owrt_ origin_ uses_ =- (T_CRule (\ _lhsIchildren- _lhsIcon- _lhsIdeclsAbove- _lhsIerrors- _lhsIhigherOrderChildren- _lhsIinh- _lhsIinstVisitNrs- _lhsInr- _lhsInt- _lhsIo_case- _lhsIo_cata- _lhsIo_costcentre- _lhsIo_data- _lhsIo_linePragmas- _lhsIo_newtypes- _lhsIo_pretty- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_splitsems- _lhsIo_strictwrap- _lhsIo_traces- _lhsIo_unbox- _lhsIprefix- _lhsIsyn- _lhsIterminals- _lhsIwhat ->- (let _lhsOexprs :: Exprs- _lhsOusedVars :: (Set String)- _lhsOtSigs :: ([Decl])- __tup3 :: (([Type],Bool))- _lhsOtps :: ([Type])- _lhsOallTpsFound :: Bool- _lhsOdeclsAbove :: ([Decl])- _lhsObldBlocksFun :: (DeclBlocks -> DeclBlocks)- _lhsOerrors :: (Seq Error)- _lhsOcomments :: ([String])- _lhsOdecls :: Decls- _lhsOdefinedInsts :: ([Identifier])- _patternIcopy :: Pattern- _patternIdefinedInsts :: ([Identifier])- _patternIpatternAttributes :: ([(Name, Name)])- -- "GenerateCode.ag"(line 89, column 12)- _instTypes =- map (\(n,NT t,_) -> (n,t)) _lhsIhigherOrderChildren- -- "GenerateCode.ag"(line 90, column 12)- _originComment =- if _lhsIo_pretty- then (Comment origin_:)- else id- -- "GenerateCode.ag"(line 93, column 12)- _instDecls =- [ Decl (Pattern3 (Alias _INST' inst (Underscore (getPos inst)) []))- (App (cataname _lhsIprefix (fromJust $ inst `lookup` _instTypes ))- [SimpleExpr instLocFieldName])- (Set.singleton instSemFieldName)- (Set.singleton instLocFieldName)- | inst <- _definedInsts- , let instLocFieldName = attrname True _INST inst- , let instSemFieldName = attrname False _INST' inst ]- -- "GenerateCode.ag"(line 101, column 12)- _patDescr =- if isIn_- then "_"- else concat $ intersperse "," (map (\(f,a) -> show f ++ "." ++ show a) _patternIpatternAttributes)- -- "GenerateCode.ag"(line 104, column 12)- _traceDescr =- show nt_ ++ " :: " ++ show con_ ++ " :: " ++ _patDescr- -- "GenerateCode.ag"(line 106, column 12)- _addTrace =- \v -> if _lhsIo_traces- then Trace _traceDescr v- else v- -- "GenerateCode.ag"(line 109, column 12)- _costCentreDescr =- show nt_ ++ ":" ++ show con_ ++ ":" ++ _patDescr- -- "GenerateCode.ag"(line 110, column 12)- _addCostCentre =- \v -> if _lhsIo_costcentre- then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v- else v- -- "GenerateCode.ag"(line 113, column 12)- _addLinePragma =- \v -> let p = getPos name_- hasPos = line p > 0 && column p >= 0 && not (null (file p))- in if _lhsIo_linePragmas && hasPos- then PragmaExpr True True ("LINE " ++ show (line p) ++ " " ++ show (file p))- $ LineExpr- $ v- else v- -- "GenerateCode.ag"(line 120, column 12)- _decls =- if hasCode_- then _originComment ( Decl (Pattern3 _patternIcopy) (_addTrace $ _addCostCentre $ _addLinePragma $ (TextExpr rhs_))- (Set.fromList [attrname False fld nm | (fld,nm,_) <- Map.elems defines_])- (Set.fromList [attrname True fld nm | (fld,nm) <- Set.toList uses_])- : _instDecls )- else _instDecls- -- "GenerateCode.ag"(line 145, column 12)- _definedInsts =- if isIn_ then [] else _patternIdefinedInsts- -- "GenerateCode.ag"(line 215, column 12)- _name =- if field_ == _LOC && name_ `elem` _lhsIterminals- then funname name_ 0- else attrname isIn_ field_ name_- -- "GenerateCode.ag"(line 218, column 12)- _lhsOexprs =- [SimpleExpr _name ]- -- "GenerateCode.ag"(line 230, column 7)- _lhsOusedVars =- Set.singleton _name- -- "GenerateCode.ag"(line 240, column 19)- _mkTp =- SimpleType . typeToString _lhsInt- -- "GenerateCode.ag"(line 241, column 19)- _lhsOtSigs =- [ TSig (attrname False field attr) (_mkTp (fromJust tp))- | (field,attr,tp) <- Map.elems defines_, isJust tp ]- -- "GenerateCode.ag"(line 267, column 23)- __tup3 =- maybe ([],False) (\tp -> ([substSelf (fromJust childnt_) tp],True)) tp_- -- "GenerateCode.ag"(line 267, column 23)- (_lhsOtps,_) =- __tup3- -- "GenerateCode.ag"(line 267, column 23)- (_,_lhsOallTpsFound) =- __tup3- -- "GenerateCode.ag"(line 369, column 7)- _lhsOdeclsAbove =- _lhsIdeclsAbove ++ _decls- -- "GenerateCode.ag"(line 382, column 7)- _lhsObldBlocksFun =- id- -- "GenerateCode.ag"(line 570, column 12)- _lhsOerrors =- let nameOf (Alias _ _ _ pats@(_:_)) = Ident (show (map (\(Alias _ a _ _)->a) pats)) (getPos name_)- nameOf _ = name_- in maybe (Seq.single (MissingTypeSig _lhsInt _lhsIcon (nameOf _patternIcopy))) (const Seq.empty) tp_- -- "GenerateCode.ag"(line 610, column 18)- _lhsOcomments =- [ makeLocalComment 11 _lhsIwhat name tp | (field,name,tp) <- Map.elems defines_, field == _LOC ]- ++ [ makeLocalComment 11 "inst " name tp | (field,name,tp) <- Map.elems defines_, field == _INST ]- -- use rule "GenerateCode.ag"(line 87, column 34)- _lhsOdecls =- _decls- -- use rule "GenerateCode.ag"(line 140, column 55)- _lhsOdefinedInsts =- _definedInsts- ( _patternIcopy,_patternIdefinedInsts,_patternIpatternAttributes) =- (pattern_ )- in ( _lhsOallTpsFound,_lhsObldBlocksFun,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOerrors,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars))) )--- CSegment -----------------------------------------------------{-- visit 0:- inherited attributes:- inh : Attributes- isLast : Bool- nr : Int- nt : Nonterminal- o_case : Bool- o_cata : Bool- o_costcentre : Bool- o_data : Maybe Bool- o_linePragmas : Bool- o_newtypes : Bool- o_pretty : Bool- o_rename : Bool- o_sem : Bool- o_sig : Bool- o_splitsems : Bool- o_strictwrap : Bool- o_traces : Bool- o_unbox : Bool- prefix : String- syn : Attributes- synthesized attributes:- comments : [String]- semDom : [Decl]- wrapDecls : Decls- alternatives:- alternative CSegment:- child inh : {Attributes}- child syn : {Attributes}--}--- cata-sem_CSegment :: CSegment ->- T_CSegment-sem_CSegment (CSegment _inh _syn ) =- (sem_CSegment_CSegment _inh _syn )--- semantic domain-newtype T_CSegment = T_CSegment (Attributes ->- Bool ->- Int ->- Nonterminal ->- Bool ->- Bool ->- Bool ->- (Maybe Bool) ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- String ->- Attributes ->- ( ([String]),([Decl]),Decls))-data Inh_CSegment = Inh_CSegment {inh_Inh_CSegment :: Attributes,isLast_Inh_CSegment :: Bool,nr_Inh_CSegment :: Int,nt_Inh_CSegment :: Nonterminal,o_case_Inh_CSegment :: Bool,o_cata_Inh_CSegment :: Bool,o_costcentre_Inh_CSegment :: Bool,o_data_Inh_CSegment :: Maybe Bool,o_linePragmas_Inh_CSegment :: Bool,o_newtypes_Inh_CSegment :: Bool,o_pretty_Inh_CSegment :: Bool,o_rename_Inh_CSegment :: Bool,o_sem_Inh_CSegment :: Bool,o_sig_Inh_CSegment :: Bool,o_splitsems_Inh_CSegment :: Bool,o_strictwrap_Inh_CSegment :: Bool,o_traces_Inh_CSegment :: Bool,o_unbox_Inh_CSegment :: Bool,prefix_Inh_CSegment :: String,syn_Inh_CSegment :: Attributes}-data Syn_CSegment = Syn_CSegment {comments_Syn_CSegment :: [String],semDom_Syn_CSegment :: [Decl],wrapDecls_Syn_CSegment :: Decls}-wrap_CSegment (T_CSegment sem ) (Inh_CSegment _lhsIinh _lhsIisLast _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn ) =- (let ( _lhsOcomments,_lhsOsemDom,_lhsOwrapDecls) =- (sem _lhsIinh _lhsIisLast _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn )- in (Syn_CSegment _lhsOcomments _lhsOsemDom _lhsOwrapDecls ))-sem_CSegment_CSegment :: Attributes ->- Attributes ->- T_CSegment-sem_CSegment_CSegment inh_ syn_ =- (T_CSegment (\ _lhsIinh- _lhsIisLast- _lhsInr- _lhsInt- _lhsIo_case- _lhsIo_cata- _lhsIo_costcentre- _lhsIo_data- _lhsIo_linePragmas- _lhsIo_newtypes- _lhsIo_pretty- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_splitsems- _lhsIo_strictwrap- _lhsIo_traces- _lhsIo_unbox- _lhsIprefix- _lhsIsyn ->- (let _lhsOsemDom :: ([Decl])- _lhsOwrapDecls :: Decls- _lhsOcomments :: ([String])- -- "GenerateCode.ag"(line 496, column 15)- _lhsOsemDom =- let name = typeName _lhsInt _lhsInr- tp = foldr Arr synTps inhTps- inhTps = [SimpleType (typeToString _lhsInt tp) | tp <- Map.elems inh_]- synTps = mkTupleType _lhsIo_unbox (null inhTps) ([SimpleType (typeToString _lhsInt tp) | tp <- Map.elems syn_] ++ continuation)- continuation = if _lhsIisLast- then []- else [SimpleType (typeName _lhsInt (_lhsInr + 1))]- in if _lhsIo_newtypes- then [ Code.NewType name name tp ]- else [ Code.Type name tp ]- -- "GenerateCode.ag"(line 534, column 15)- _lhsOwrapDecls =- let lhsVars = map (lhsname False) (Map.keys syn_)- ++ if _lhsIisLast then [] else [unwrap ++ sem (_lhsInr+1)]- rhsVars = map (lhsname True) (Map.keys inh_)- rhs = map SimpleExpr rhsVars- unwrap = if _lhsIo_newtypes then typeName _lhsInt (_lhsInr + 1) ++ " " else ""- var = "sem"- sem 0 = var- sem n = var ++ "_" ++ show n- in [ Decl (mkTupleLhs _lhsIo_unbox (null $ Map.keys inh_) lhsVars) (App (sem _lhsInr) rhs) (Set.fromList lhsVars) (Set.fromList rhsVars) ]- -- "GenerateCode.ag"(line 588, column 18)- _lhsOcomments =- let body = map ind (showsSegment (CSegment inh_ syn_))- in if null body- then []- else ("visit " ++ show _lhsInr ++ ":") : body- in ( _lhsOcomments,_lhsOsemDom,_lhsOwrapDecls))) )--- CSegments ----------------------------------------------------{-- visit 0:- inherited attributes:- inh : Attributes- nr : Int- nt : Nonterminal- o_case : Bool- o_cata : Bool- o_costcentre : Bool- o_data : Maybe Bool- o_linePragmas : Bool- o_newtypes : Bool- o_pretty : Bool- o_rename : Bool- o_sem : Bool- o_sig : Bool- o_splitsems : Bool- o_strictwrap : Bool- o_traces : Bool- o_unbox : Bool- prefix : String- syn : Attributes- synthesized attributes:- comments : [String]- isNil : Bool- semDom : [Decl]- wrapDecls : Decls- alternatives:- alternative Cons:- child hd : CSegment- child tl : CSegments- alternative Nil:--}--- cata-sem_CSegments :: CSegments ->- T_CSegments-sem_CSegments list =- (Prelude.foldr sem_CSegments_Cons sem_CSegments_Nil (Prelude.map sem_CSegment list) )--- semantic domain-newtype T_CSegments = T_CSegments (Attributes ->- Int ->- Nonterminal ->- Bool ->- Bool ->- Bool ->- (Maybe Bool) ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- String ->- Attributes ->- ( ([String]),Bool,([Decl]),Decls))-data Inh_CSegments = Inh_CSegments {inh_Inh_CSegments :: Attributes,nr_Inh_CSegments :: Int,nt_Inh_CSegments :: Nonterminal,o_case_Inh_CSegments :: Bool,o_cata_Inh_CSegments :: Bool,o_costcentre_Inh_CSegments :: Bool,o_data_Inh_CSegments :: Maybe Bool,o_linePragmas_Inh_CSegments :: Bool,o_newtypes_Inh_CSegments :: Bool,o_pretty_Inh_CSegments :: Bool,o_rename_Inh_CSegments :: Bool,o_sem_Inh_CSegments :: Bool,o_sig_Inh_CSegments :: Bool,o_splitsems_Inh_CSegments :: Bool,o_strictwrap_Inh_CSegments :: Bool,o_traces_Inh_CSegments :: Bool,o_unbox_Inh_CSegments :: Bool,prefix_Inh_CSegments :: String,syn_Inh_CSegments :: Attributes}-data Syn_CSegments = Syn_CSegments {comments_Syn_CSegments :: [String],isNil_Syn_CSegments :: Bool,semDom_Syn_CSegments :: [Decl],wrapDecls_Syn_CSegments :: Decls}-wrap_CSegments (T_CSegments sem ) (Inh_CSegments _lhsIinh _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn ) =- (let ( _lhsOcomments,_lhsOisNil,_lhsOsemDom,_lhsOwrapDecls) =- (sem _lhsIinh _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn )- in (Syn_CSegments _lhsOcomments _lhsOisNil _lhsOsemDom _lhsOwrapDecls ))-sem_CSegments_Cons :: T_CSegment ->- T_CSegments ->- T_CSegments-sem_CSegments_Cons (T_CSegment hd_ ) (T_CSegments tl_ ) =- (T_CSegments (\ _lhsIinh- _lhsInr- _lhsInt- _lhsIo_case- _lhsIo_cata- _lhsIo_costcentre- _lhsIo_data- _lhsIo_linePragmas- _lhsIo_newtypes- _lhsIo_pretty- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_splitsems- _lhsIo_strictwrap- _lhsIo_traces- _lhsIo_unbox- _lhsIprefix- _lhsIsyn ->- (let _tlOnr :: Int- _lhsOisNil :: Bool- _hdOisLast :: Bool- _lhsOcomments :: ([String])- _lhsOsemDom :: ([Decl])- _lhsOwrapDecls :: Decls- _hdOinh :: Attributes- _hdOnr :: Int- _hdOnt :: Nonterminal- _hdOo_case :: Bool- _hdOo_cata :: Bool- _hdOo_costcentre :: Bool- _hdOo_data :: (Maybe Bool)- _hdOo_linePragmas :: Bool- _hdOo_newtypes :: Bool- _hdOo_pretty :: Bool- _hdOo_rename :: Bool- _hdOo_sem :: Bool- _hdOo_sig :: Bool- _hdOo_splitsems :: Bool- _hdOo_strictwrap :: Bool- _hdOo_traces :: Bool- _hdOo_unbox :: Bool- _hdOprefix :: String- _hdOsyn :: Attributes- _tlOinh :: Attributes- _tlOnt :: Nonterminal- _tlOo_case :: Bool- _tlOo_cata :: Bool- _tlOo_costcentre :: Bool- _tlOo_data :: (Maybe Bool)- _tlOo_linePragmas :: Bool- _tlOo_newtypes :: Bool- _tlOo_pretty :: Bool- _tlOo_rename :: Bool- _tlOo_sem :: Bool- _tlOo_sig :: Bool- _tlOo_splitsems :: Bool- _tlOo_strictwrap :: Bool- _tlOo_traces :: Bool- _tlOo_unbox :: Bool- _tlOprefix :: String- _tlOsyn :: Attributes- _hdIcomments :: ([String])- _hdIsemDom :: ([Decl])- _hdIwrapDecls :: Decls- _tlIcomments :: ([String])- _tlIisNil :: Bool- _tlIsemDom :: ([Decl])- _tlIwrapDecls :: Decls- -- "GenerateCode.ag"(line 165, column 11)- _tlOnr =- _lhsInr + 1- -- "GenerateCode.ag"(line 178, column 12)- _lhsOisNil =- False- -- "GenerateCode.ag"(line 179, column 12)- _hdOisLast =- _tlIisNil- -- use rule "GenerateCode.ag"(line 583, column 52)- _lhsOcomments =- _hdIcomments ++ _tlIcomments- -- use rule "GenerateCode.ag"(line 491, column 50)- _lhsOsemDom =- _hdIsemDom ++ _tlIsemDom- -- use rule "GenerateCode.ag"(line 532, column 52)- _lhsOwrapDecls =- _hdIwrapDecls ++ _tlIwrapDecls- -- copy rule (down)- _hdOinh =- _lhsIinh- -- copy rule (down)- _hdOnr =- _lhsInr- -- copy rule (down)- _hdOnt =- _lhsInt- -- copy rule (down)- _hdOo_case =- _lhsIo_case- -- copy rule (down)- _hdOo_cata =- _lhsIo_cata- -- copy rule (down)- _hdOo_costcentre =- _lhsIo_costcentre- -- copy rule (down)- _hdOo_data =- _lhsIo_data- -- copy rule (down)- _hdOo_linePragmas =- _lhsIo_linePragmas- -- copy rule (down)- _hdOo_newtypes =- _lhsIo_newtypes- -- copy rule (down)- _hdOo_pretty =- _lhsIo_pretty- -- copy rule (down)- _hdOo_rename =- _lhsIo_rename- -- copy rule (down)- _hdOo_sem =- _lhsIo_sem- -- copy rule (down)- _hdOo_sig =- _lhsIo_sig- -- copy rule (down)- _hdOo_splitsems =- _lhsIo_splitsems- -- copy rule (down)- _hdOo_strictwrap =- _lhsIo_strictwrap- -- copy rule (down)- _hdOo_traces =- _lhsIo_traces- -- copy rule (down)- _hdOo_unbox =- _lhsIo_unbox- -- copy rule (down)- _hdOprefix =- _lhsIprefix- -- copy rule (down)- _hdOsyn =- _lhsIsyn- -- copy rule (down)- _tlOinh =- _lhsIinh- -- copy rule (down)- _tlOnt =- _lhsInt- -- copy rule (down)- _tlOo_case =- _lhsIo_case- -- copy rule (down)- _tlOo_cata =- _lhsIo_cata- -- copy rule (down)- _tlOo_costcentre =- _lhsIo_costcentre- -- copy rule (down)- _tlOo_data =- _lhsIo_data- -- copy rule (down)- _tlOo_linePragmas =- _lhsIo_linePragmas- -- copy rule (down)- _tlOo_newtypes =- _lhsIo_newtypes- -- copy rule (down)- _tlOo_pretty =- _lhsIo_pretty- -- copy rule (down)- _tlOo_rename =- _lhsIo_rename- -- copy rule (down)- _tlOo_sem =- _lhsIo_sem- -- copy rule (down)- _tlOo_sig =- _lhsIo_sig- -- copy rule (down)- _tlOo_splitsems =- _lhsIo_splitsems- -- copy rule (down)- _tlOo_strictwrap =- _lhsIo_strictwrap- -- copy rule (down)- _tlOo_traces =- _lhsIo_traces- -- copy rule (down)- _tlOo_unbox =- _lhsIo_unbox- -- copy rule (down)- _tlOprefix =- _lhsIprefix- -- copy rule (down)- _tlOsyn =- _lhsIsyn- ( _hdIcomments,_hdIsemDom,_hdIwrapDecls) =- (hd_ _hdOinh _hdOisLast _hdOnr _hdOnt _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOprefix _hdOsyn )- ( _tlIcomments,_tlIisNil,_tlIsemDom,_tlIwrapDecls) =- (tl_ _tlOinh _tlOnr _tlOnt _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOprefix _tlOsyn )- in ( _lhsOcomments,_lhsOisNil,_lhsOsemDom,_lhsOwrapDecls))) )-sem_CSegments_Nil :: T_CSegments-sem_CSegments_Nil =- (T_CSegments (\ _lhsIinh- _lhsInr- _lhsInt- _lhsIo_case- _lhsIo_cata- _lhsIo_costcentre- _lhsIo_data- _lhsIo_linePragmas- _lhsIo_newtypes- _lhsIo_pretty- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_splitsems- _lhsIo_strictwrap- _lhsIo_traces- _lhsIo_unbox- _lhsIprefix- _lhsIsyn ->- (let _lhsOisNil :: Bool- _lhsOcomments :: ([String])- _lhsOsemDom :: ([Decl])- _lhsOwrapDecls :: Decls- -- "GenerateCode.ag"(line 180, column 10)- _lhsOisNil =- True- -- use rule "GenerateCode.ag"(line 583, column 52)- _lhsOcomments =- []- -- use rule "GenerateCode.ag"(line 491, column 50)- _lhsOsemDom =- []- -- use rule "GenerateCode.ag"(line 532, column 52)- _lhsOwrapDecls =- []- in ( _lhsOcomments,_lhsOisNil,_lhsOsemDom,_lhsOwrapDecls))) )--- CVisit -------------------------------------------------------{-- visit 0:- inherited attributes:- allPragmas : PragmaMap- children : [(Name,Type,Bool)]- con : Constructor- inh : Attributes- instVisitNrs : Map Identifier Int- isLast : Bool- nextIntra : Exprs- nextIntraVars : Set String- nr : Int- nt : Nonterminal- o_case : Bool- o_cata : Bool- o_costcentre : Bool- o_data : Maybe Bool- o_linePragmas : Bool- o_newtypes : Bool- o_pretty : Bool- o_rename : Bool- o_sem : Bool- o_sig : Bool- o_splitsems : Bool- o_strictwrap : Bool- o_traces : Bool- o_unbox : Bool- prefix : String- syn : Attributes- terminals : [Name]- with_sig : Bool- chained attribute:- errors : Seq Error- synthesized attributes:- allTpsFound : Bool- comments : [String]- decls : Decls- gatherInstVisitNrs : Map Identifier Int- intra : Exprs- intraVars : Set String- semNames : [String]- alternatives:- alternative CVisit:- child inh : {Attributes}- child syn : {Attributes}- child vss : Sequence- child intra : Sequence- child ordered : {Bool}- visit 0:- local _tup4 : _- local higherOrderChildren : _- local firstOrderChildren : _- local funcname : _- local nextVisitName : _- local nextVisitDecl : _- local decls : _- local lastExprVars : _- local _tup5 : _- local blockFunDecls : _- local blockFirstFunCall : _- local costCentreDescr : _- local addCostCentre : _- local semFun : _- local tsig : _- local semType : _- local typeSigs : _- local o_case : _- local o_splitsems : _--}--- cata-sem_CVisit :: CVisit ->- T_CVisit-sem_CVisit (CVisit _inh _syn _vss _intra _ordered ) =- (sem_CVisit_CVisit _inh _syn (sem_Sequence _vss ) (sem_Sequence _intra ) _ordered )--- semantic domain-newtype T_CVisit = T_CVisit (PragmaMap ->- ([(Name,Type,Bool)]) ->- Constructor ->- (Seq Error) ->- Attributes ->- (Map Identifier Int) ->- Bool ->- Exprs ->- (Set String) ->- Int ->- Nonterminal ->- Bool ->- Bool ->- Bool ->- (Maybe Bool) ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- String ->- Attributes ->- ([Name]) ->- Bool ->- ( Bool,([String]),Decls,(Seq Error),(Map Identifier Int),Exprs,(Set String),([String])))-data Inh_CVisit = Inh_CVisit {allPragmas_Inh_CVisit :: PragmaMap,children_Inh_CVisit :: [(Name,Type,Bool)],con_Inh_CVisit :: Constructor,errors_Inh_CVisit :: Seq Error,inh_Inh_CVisit :: Attributes,instVisitNrs_Inh_CVisit :: Map Identifier Int,isLast_Inh_CVisit :: Bool,nextIntra_Inh_CVisit :: Exprs,nextIntraVars_Inh_CVisit :: Set String,nr_Inh_CVisit :: Int,nt_Inh_CVisit :: Nonterminal,o_case_Inh_CVisit :: Bool,o_cata_Inh_CVisit :: Bool,o_costcentre_Inh_CVisit :: Bool,o_data_Inh_CVisit :: Maybe Bool,o_linePragmas_Inh_CVisit :: Bool,o_newtypes_Inh_CVisit :: Bool,o_pretty_Inh_CVisit :: Bool,o_rename_Inh_CVisit :: Bool,o_sem_Inh_CVisit :: Bool,o_sig_Inh_CVisit :: Bool,o_splitsems_Inh_CVisit :: Bool,o_strictwrap_Inh_CVisit :: Bool,o_traces_Inh_CVisit :: Bool,o_unbox_Inh_CVisit :: Bool,prefix_Inh_CVisit :: String,syn_Inh_CVisit :: Attributes,terminals_Inh_CVisit :: [Name],with_sig_Inh_CVisit :: Bool}-data Syn_CVisit = Syn_CVisit {allTpsFound_Syn_CVisit :: Bool,comments_Syn_CVisit :: [String],decls_Syn_CVisit :: Decls,errors_Syn_CVisit :: Seq Error,gatherInstVisitNrs_Syn_CVisit :: Map Identifier Int,intra_Syn_CVisit :: Exprs,intraVars_Syn_CVisit :: Set String,semNames_Syn_CVisit :: [String]}-wrap_CVisit (T_CVisit sem ) (Inh_CVisit _lhsIallPragmas _lhsIchildren _lhsIcon _lhsIerrors _lhsIinh _lhsIinstVisitNrs _lhsIisLast _lhsInextIntra _lhsInextIntraVars _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn _lhsIterminals _lhsIwith_sig ) =- (let ( _lhsOallTpsFound,_lhsOcomments,_lhsOdecls,_lhsOerrors,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOsemNames) =- (sem _lhsIallPragmas _lhsIchildren _lhsIcon _lhsIerrors _lhsIinh _lhsIinstVisitNrs _lhsIisLast _lhsInextIntra _lhsInextIntraVars _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn _lhsIterminals _lhsIwith_sig )- in (Syn_CVisit _lhsOallTpsFound _lhsOcomments _lhsOdecls _lhsOerrors _lhsOgatherInstVisitNrs _lhsOintra _lhsOintraVars _lhsOsemNames ))-sem_CVisit_CVisit :: Attributes ->- Attributes ->- T_Sequence ->- T_Sequence ->- Bool ->- T_CVisit-sem_CVisit_CVisit inh_ syn_ (T_Sequence vss_ ) (T_Sequence intra_ ) ordered_ =- (T_CVisit (\ _lhsIallPragmas- _lhsIchildren- _lhsIcon- _lhsIerrors- _lhsIinh- _lhsIinstVisitNrs- _lhsIisLast- _lhsInextIntra- _lhsInextIntraVars- _lhsInr- _lhsInt- _lhsIo_case- _lhsIo_cata- _lhsIo_costcentre- _lhsIo_data- _lhsIo_linePragmas- _lhsIo_newtypes- _lhsIo_pretty- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_splitsems- _lhsIo_strictwrap- _lhsIo_traces- _lhsIo_unbox- _lhsIprefix- _lhsIsyn- _lhsIterminals- _lhsIwith_sig ->- (let _lhsOintra :: Exprs- _lhsOintraVars :: (Set String)- _vssOlastExpr :: Expr- _intraOlastExpr :: Expr- _lhsOdecls :: Decls- _lhsOgatherInstVisitNrs :: (Map Identifier Int)- _vssOdeclsAbove :: ([Decl])- _intraOdeclsAbove :: ([Decl])- _lhsOallTpsFound :: Bool- _lhsOerrors :: (Seq Error)- _lhsOcomments :: ([String])- _vssOwhat :: String- _intraOwhat :: String- _lhsOsemNames :: ([String])- _vssOchildren :: ([(Name,Type,Bool)])- _vssOcon :: Constructor- _vssOerrors :: (Seq Error)- _vssOhigherOrderChildren :: ([(Name,Type,Bool)])- _vssOinh :: Attributes- _vssOinstVisitNrs :: (Map Identifier Int)- _vssOnr :: Int- _vssOnt :: Nonterminal- _vssOo_case :: Bool- _vssOo_cata :: Bool- _vssOo_costcentre :: Bool- _vssOo_data :: (Maybe Bool)- _vssOo_linePragmas :: Bool- _vssOo_newtypes :: Bool- _vssOo_pretty :: Bool- _vssOo_rename :: Bool- _vssOo_sem :: Bool- _vssOo_sig :: Bool- _vssOo_splitsems :: Bool- _vssOo_strictwrap :: Bool- _vssOo_traces :: Bool- _vssOo_unbox :: Bool- _vssOprefix :: String- _vssOsyn :: Attributes- _vssOterminals :: ([Name])- _intraOchildren :: ([(Name,Type,Bool)])- _intraOcon :: Constructor- _intraOerrors :: (Seq Error)- _intraOhigherOrderChildren :: ([(Name,Type,Bool)])- _intraOinh :: Attributes- _intraOinstVisitNrs :: (Map Identifier Int)- _intraOnr :: Int- _intraOnt :: Nonterminal- _intraOo_case :: Bool- _intraOo_cata :: Bool- _intraOo_costcentre :: Bool- _intraOo_data :: (Maybe Bool)- _intraOo_linePragmas :: Bool- _intraOo_newtypes :: Bool- _intraOo_pretty :: Bool- _intraOo_rename :: Bool- _intraOo_sem :: Bool- _intraOo_sig :: Bool- _intraOo_splitsems :: Bool- _intraOo_strictwrap :: Bool- _intraOo_traces :: Bool- _intraOo_unbox :: Bool- _intraOprefix :: String- _intraOsyn :: Attributes- _intraOterminals :: ([Name])- _vssIallTpsFound :: Bool- _vssIblockDecls :: DeclBlocks- _vssIcomments :: ([String])- _vssIdecls :: Decls- _vssIdeclsAbove :: ([Decl])- _vssIdefinedInsts :: ([Identifier])- _vssIerrors :: (Seq Error)- _vssIexprs :: Exprs- _vssItSigs :: ([Decl])- _vssItps :: ([Type])- _vssIusedVars :: (Set String)- _intraIallTpsFound :: Bool- _intraIblockDecls :: DeclBlocks- _intraIcomments :: ([String])- _intraIdecls :: Decls- _intraIdeclsAbove :: ([Decl])- _intraIdefinedInsts :: ([Identifier])- _intraIerrors :: (Seq Error)- _intraIexprs :: Exprs- _intraItSigs :: ([Decl])- _intraItps :: ([Type])- _intraIusedVars :: (Set String)- -- "GenerateCode.ag"(line 189, column 13)- _lhsOintra =- _intraIexprs- -- "GenerateCode.ag"(line 190, column 13)- _lhsOintraVars =- _intraIusedVars- -- "GenerateCode.ag"(line 278, column 13)- __tup4 =- partition (\(_,_,ho) -> ho) _lhsIchildren- -- "GenerateCode.ag"(line 278, column 13)- (_higherOrderChildren,_) =- __tup4- -- "GenerateCode.ag"(line 278, column 13)- (_,_firstOrderChildren) =- __tup4- -- "GenerateCode.ag"(line 279, column 13)- _funcname =- seqSemname _lhsIprefix _lhsInt _lhsIcon _lhsInr- -- "GenerateCode.ag"(line 280, column 13)- _nextVisitName =- if _lhsIisLast then [] else [visitname _lhsIprefix _lhsInt (_lhsInr+1)]- -- "GenerateCode.ag"(line 281, column 13)- _nextVisitDecl =- let lhs = TupleLhs _nextVisitName- rhs = App fun _lhsInextIntra- fun = seqSemname _lhsIprefix _lhsInt _lhsIcon (_lhsInr+1)- in if _lhsIisLast- then []- else [Decl lhs rhs (Set.fromList _nextVisitName) _lhsInextIntraVars]- -- "GenerateCode.ag"(line 287, column 13)- _decls =- _typeSigs ++ _vssIdecls ++ _nextVisitDecl- -- "GenerateCode.ag"(line 288, column 13)- _vssOlastExpr =- mkTupleExpr _lhsIo_unbox (null $ Map.keys inh_) $ map (SimpleExpr . lhsname False) (Map.keys syn_) ++ map SimpleExpr _nextVisitName- -- "GenerateCode.ag"(line 289, column 13)- _intraOlastExpr =- error "lastExpr: not used here"- -- "GenerateCode.ag"(line 290, column 13)- _lastExprVars =- map (lhsname False) (Map.keys syn_) ++ _nextVisitName- -- "GenerateCode.ag"(line 291, column 13)- __tup5 =- mkPartitionedFunction _funcname _o_case _nextVisitDecl _lastExprVars _vssIblockDecls- -- "GenerateCode.ag"(line 291, column 13)- (_blockFunDecls,_) =- __tup5- -- "GenerateCode.ag"(line 291, column 13)- (_,_blockFirstFunCall) =- __tup5- -- "GenerateCode.ag"(line 293, column 13)- _costCentreDescr =- "b" ++ ":" ++ show _lhsInt ++ ":" ++ show _lhsIcon ++ ":" ++ show _lhsInr- -- "GenerateCode.ag"(line 294, column 13)- _addCostCentre =- \v -> if _lhsIo_costcentre- then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v- else v- -- "GenerateCode.ag"(line 298, column 13)- _semFun =- let lhs = Fun _funcname lhs_args- lhs_args = if _lhsInr == 0 then map field _firstOrderChildren else _intraIexprs- field (name,NT tp,_) = let unwrap | _lhsIo_newtypes = \x -> App (sdtype tp) [x]- | otherwise = id- in unwrap (SimpleExpr (funname name 0))- field (name,_,_) = SimpleExpr (funname name 0)- rhs = wrap- . mkLambda (map (lhsname True) (Map.keys inh_))- $ _addCostCentre- $ if ordered_ && _o_splitsems- then _blockFirstFunCall- else mkLet _o_case _decls- . mkTupleExpr _lhsIo_unbox (null $ Map.keys inh_)- $ map (SimpleExpr . lhsname False) (Map.keys syn_) ++ map SimpleExpr _nextVisitName- wrap = if _lhsIo_newtypes- then \x -> App (typeName _lhsInt _lhsInr) [x]- else id- in Decl lhs rhs Set.empty Set.empty- -- "GenerateCode.ag"(line 319, column 13)- _tsig =- TSig _funcname _semType- -- "GenerateCode.ag"(line 320, column 13)- _semType =- let argType (NT tp) rec | tp /= _SELF = SimpleType (sdtype tp) `Arr` rec- | tp == _SELF = error "GenerateCode: found an intra-type with type SELF, which should have been prevented by CRule.tps"- argType (Haskell tp) rec = SimpleType tp `Arr` rec- in if _lhsInr == 0- then foldr argType (SimpleType (sdtype _lhsInt )) (map (\(_,t,_) -> t) _firstOrderChildren )- else foldr argType (SimpleType (typeName _lhsInt _lhsInr)) _intraItps- -- "GenerateCode.ag"(line 326, column 13)- _lhsOdecls =- ( if _lhsIwith_sig- then [_tsig, _semFun]- else [_semFun]- ) ++- ( if ordered_ && _o_splitsems- then _blockFunDecls- else []- )- -- "GenerateCode.ag"(line 334, column 13)- _typeSigs =- if _lhsIo_sig && not _o_case- then _vssItSigs- else []- -- "GenerateCode.ag"(line 337, column 13)- _o_case =- _lhsIo_case && ordered_ && not (hasPragma _lhsIallPragmas _lhsInt _lhsIcon _NOCASE)- -- "GenerateCode.ag"(line 338, column 13)- _o_splitsems =- ordered_ && _lhsIo_splitsems- -- "GenerateCode.ag"(line 353, column 7)- _lhsOgatherInstVisitNrs =- Map.fromList [(i,_lhsInr) | i <- _vssIdefinedInsts]- -- "GenerateCode.ag"(line 364, column 7)- _vssOdeclsAbove =- []- -- "GenerateCode.ag"(line 365, column 7)- _intraOdeclsAbove =- error "declsAbove: not used here"- -- "GenerateCode.ag"(line 557, column 13)- _lhsOallTpsFound =- _intraIallTpsFound- -- "GenerateCode.ag"(line 568, column 13)- _lhsOerrors =- _intraIerrors- -- "GenerateCode.ag"(line 601, column 18)- _lhsOcomments =- let body = map ind (_vssIcomments ++ _intraIcomments)- in if null body- then []- else ("visit " ++ show _lhsInr ++ ":") : body- -- "GenerateCode.ag"(line 605, column 18)- _vssOwhat =- "local"- -- "GenerateCode.ag"(line 606, column 18)- _intraOwhat =- "intra"- -- "GenerateCode.ag"(line 784, column 7)- _lhsOsemNames =- [_funcname ]- -- copy rule (down)- _vssOchildren =- _lhsIchildren- -- copy rule (down)- _vssOcon =- _lhsIcon- -- copy rule (down)- _vssOerrors =- _lhsIerrors- -- copy rule (from local)- _vssOhigherOrderChildren =- _higherOrderChildren- -- copy rule (down)- _vssOinh =- _lhsIinh- -- copy rule (down)- _vssOinstVisitNrs =- _lhsIinstVisitNrs- -- copy rule (down)- _vssOnr =- _lhsInr- -- copy rule (down)- _vssOnt =- _lhsInt- -- copy rule (from local)- _vssOo_case =- _o_case- -- copy rule (down)- _vssOo_cata =- _lhsIo_cata- -- copy rule (down)- _vssOo_costcentre =- _lhsIo_costcentre- -- copy rule (down)- _vssOo_data =- _lhsIo_data- -- copy rule (down)- _vssOo_linePragmas =- _lhsIo_linePragmas- -- copy rule (down)- _vssOo_newtypes =- _lhsIo_newtypes- -- copy rule (down)- _vssOo_pretty =- _lhsIo_pretty- -- copy rule (down)- _vssOo_rename =- _lhsIo_rename- -- copy rule (down)- _vssOo_sem =- _lhsIo_sem- -- copy rule (down)- _vssOo_sig =- _lhsIo_sig- -- copy rule (from local)- _vssOo_splitsems =- _o_splitsems- -- copy rule (down)- _vssOo_strictwrap =- _lhsIo_strictwrap- -- copy rule (down)- _vssOo_traces =- _lhsIo_traces- -- copy rule (down)- _vssOo_unbox =- _lhsIo_unbox- -- copy rule (down)- _vssOprefix =- _lhsIprefix- -- copy rule (down)- _vssOsyn =- _lhsIsyn- -- copy rule (down)- _vssOterminals =- _lhsIterminals- -- copy rule (down)- _intraOchildren =- _lhsIchildren- -- copy rule (down)- _intraOcon =- _lhsIcon- -- copy rule (chain)- _intraOerrors =- _vssIerrors- -- copy rule (from local)- _intraOhigherOrderChildren =- _higherOrderChildren- -- copy rule (down)- _intraOinh =- _lhsIinh- -- copy rule (down)- _intraOinstVisitNrs =- _lhsIinstVisitNrs- -- copy rule (down)- _intraOnr =- _lhsInr- -- copy rule (down)- _intraOnt =- _lhsInt- -- copy rule (from local)- _intraOo_case =- _o_case- -- copy rule (down)- _intraOo_cata =- _lhsIo_cata- -- copy rule (down)- _intraOo_costcentre =- _lhsIo_costcentre- -- copy rule (down)- _intraOo_data =- _lhsIo_data- -- copy rule (down)- _intraOo_linePragmas =- _lhsIo_linePragmas- -- copy rule (down)- _intraOo_newtypes =- _lhsIo_newtypes- -- copy rule (down)- _intraOo_pretty =- _lhsIo_pretty- -- copy rule (down)- _intraOo_rename =- _lhsIo_rename- -- copy rule (down)- _intraOo_sem =- _lhsIo_sem- -- copy rule (down)- _intraOo_sig =- _lhsIo_sig- -- copy rule (from local)- _intraOo_splitsems =- _o_splitsems- -- copy rule (down)- _intraOo_strictwrap =- _lhsIo_strictwrap- -- copy rule (down)- _intraOo_traces =- _lhsIo_traces- -- copy rule (down)- _intraOo_unbox =- _lhsIo_unbox- -- copy rule (down)- _intraOprefix =- _lhsIprefix- -- copy rule (down)- _intraOsyn =- _lhsIsyn- -- copy rule (down)- _intraOterminals =- _lhsIterminals- ( _vssIallTpsFound,_vssIblockDecls,_vssIcomments,_vssIdecls,_vssIdeclsAbove,_vssIdefinedInsts,_vssIerrors,_vssIexprs,_vssItSigs,_vssItps,_vssIusedVars) =- (vss_ _vssOchildren _vssOcon _vssOdeclsAbove _vssOerrors _vssOhigherOrderChildren _vssOinh _vssOinstVisitNrs _vssOlastExpr _vssOnr _vssOnt _vssOo_case _vssOo_cata _vssOo_costcentre _vssOo_data _vssOo_linePragmas _vssOo_newtypes _vssOo_pretty _vssOo_rename _vssOo_sem _vssOo_sig _vssOo_splitsems _vssOo_strictwrap _vssOo_traces _vssOo_unbox _vssOprefix _vssOsyn _vssOterminals _vssOwhat )- ( _intraIallTpsFound,_intraIblockDecls,_intraIcomments,_intraIdecls,_intraIdeclsAbove,_intraIdefinedInsts,_intraIerrors,_intraIexprs,_intraItSigs,_intraItps,_intraIusedVars) =- (intra_ _intraOchildren _intraOcon _intraOdeclsAbove _intraOerrors _intraOhigherOrderChildren _intraOinh _intraOinstVisitNrs _intraOlastExpr _intraOnr _intraOnt _intraOo_case _intraOo_cata _intraOo_costcentre _intraOo_data _intraOo_linePragmas _intraOo_newtypes _intraOo_pretty _intraOo_rename _intraOo_sem _intraOo_sig _intraOo_splitsems _intraOo_strictwrap _intraOo_traces _intraOo_unbox _intraOprefix _intraOsyn _intraOterminals _intraOwhat )- in ( _lhsOallTpsFound,_lhsOcomments,_lhsOdecls,_lhsOerrors,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOsemNames))) )--- CVisits ------------------------------------------------------{-- visit 0:- inherited attributes:- allPragmas : PragmaMap- children : [(Name,Type,Bool)]- con : Constructor- inh : Attributes- instVisitNrs : Map Identifier Int- nr : Int- nt : Nonterminal- o_case : Bool- o_cata : Bool- o_costcentre : Bool- o_data : Maybe Bool- o_linePragmas : Bool- o_newtypes : Bool- o_pretty : Bool- o_rename : Bool- o_sem : Bool- o_sig : Bool- o_splitsems : Bool- o_strictwrap : Bool- o_traces : Bool- o_unbox : Bool- prefix : String- syn : Attributes- terminals : [Name]- with_sig : Bool- chained attribute:- errors : Seq Error- synthesized attributes:- allTpsFound : Bool- comments : [String]- decls : Decls- gatherInstVisitNrs : Map Identifier Int- intra : Exprs- intraVars : Set String- isNil : Bool- semNames : [String]- alternatives:- alternative Cons:- child hd : CVisit- child tl : CVisits- alternative Nil:--}--- cata-sem_CVisits :: CVisits ->- T_CVisits-sem_CVisits list =- (Prelude.foldr sem_CVisits_Cons sem_CVisits_Nil (Prelude.map sem_CVisit list) )--- semantic domain-newtype T_CVisits = T_CVisits (PragmaMap ->- ([(Name,Type,Bool)]) ->- Constructor ->- (Seq Error) ->- Attributes ->- (Map Identifier Int) ->- Int ->- Nonterminal ->- Bool ->- Bool ->- Bool ->- (Maybe Bool) ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- String ->- Attributes ->- ([Name]) ->- Bool ->- ( Bool,([String]),Decls,(Seq Error),(Map Identifier Int),Exprs,(Set String),Bool,([String])))-data Inh_CVisits = Inh_CVisits {allPragmas_Inh_CVisits :: PragmaMap,children_Inh_CVisits :: [(Name,Type,Bool)],con_Inh_CVisits :: Constructor,errors_Inh_CVisits :: Seq Error,inh_Inh_CVisits :: Attributes,instVisitNrs_Inh_CVisits :: Map Identifier Int,nr_Inh_CVisits :: Int,nt_Inh_CVisits :: Nonterminal,o_case_Inh_CVisits :: Bool,o_cata_Inh_CVisits :: Bool,o_costcentre_Inh_CVisits :: Bool,o_data_Inh_CVisits :: Maybe Bool,o_linePragmas_Inh_CVisits :: Bool,o_newtypes_Inh_CVisits :: Bool,o_pretty_Inh_CVisits :: Bool,o_rename_Inh_CVisits :: Bool,o_sem_Inh_CVisits :: Bool,o_sig_Inh_CVisits :: Bool,o_splitsems_Inh_CVisits :: Bool,o_strictwrap_Inh_CVisits :: Bool,o_traces_Inh_CVisits :: Bool,o_unbox_Inh_CVisits :: Bool,prefix_Inh_CVisits :: String,syn_Inh_CVisits :: Attributes,terminals_Inh_CVisits :: [Name],with_sig_Inh_CVisits :: Bool}-data Syn_CVisits = Syn_CVisits {allTpsFound_Syn_CVisits :: Bool,comments_Syn_CVisits :: [String],decls_Syn_CVisits :: Decls,errors_Syn_CVisits :: Seq Error,gatherInstVisitNrs_Syn_CVisits :: Map Identifier Int,intra_Syn_CVisits :: Exprs,intraVars_Syn_CVisits :: Set String,isNil_Syn_CVisits :: Bool,semNames_Syn_CVisits :: [String]}-wrap_CVisits (T_CVisits sem ) (Inh_CVisits _lhsIallPragmas _lhsIchildren _lhsIcon _lhsIerrors _lhsIinh _lhsIinstVisitNrs _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn _lhsIterminals _lhsIwith_sig ) =- (let ( _lhsOallTpsFound,_lhsOcomments,_lhsOdecls,_lhsOerrors,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOisNil,_lhsOsemNames) =- (sem _lhsIallPragmas _lhsIchildren _lhsIcon _lhsIerrors _lhsIinh _lhsIinstVisitNrs _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn _lhsIterminals _lhsIwith_sig )- in (Syn_CVisits _lhsOallTpsFound _lhsOcomments _lhsOdecls _lhsOerrors _lhsOgatherInstVisitNrs _lhsOintra _lhsOintraVars _lhsOisNil _lhsOsemNames ))-sem_CVisits_Cons :: T_CVisit ->- T_CVisits ->- T_CVisits-sem_CVisits_Cons (T_CVisit hd_ ) (T_CVisits tl_ ) =- (T_CVisits (\ _lhsIallPragmas- _lhsIchildren- _lhsIcon- _lhsIerrors- _lhsIinh- _lhsIinstVisitNrs- _lhsInr- _lhsInt- _lhsIo_case- _lhsIo_cata- _lhsIo_costcentre- _lhsIo_data- _lhsIo_linePragmas- _lhsIo_newtypes- _lhsIo_pretty- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_splitsems- _lhsIo_strictwrap- _lhsIo_traces- _lhsIo_unbox- _lhsIprefix- _lhsIsyn- _lhsIterminals- _lhsIwith_sig ->- (let _tlOnr :: Int- _lhsOisNil :: Bool- _hdOisLast :: Bool- _hdOnextIntra :: Exprs- _hdOnextIntraVars :: (Set String)- _lhsOintra :: Exprs- _lhsOintraVars :: (Set String)- _lhsOallTpsFound :: Bool- _lhsOcomments :: ([String])- _lhsOdecls :: Decls- _lhsOerrors :: (Seq Error)- _lhsOgatherInstVisitNrs :: (Map Identifier Int)- _lhsOsemNames :: ([String])- _hdOallPragmas :: PragmaMap- _hdOchildren :: ([(Name,Type,Bool)])- _hdOcon :: Constructor- _hdOerrors :: (Seq Error)- _hdOinh :: Attributes- _hdOinstVisitNrs :: (Map Identifier Int)- _hdOnr :: Int- _hdOnt :: Nonterminal- _hdOo_case :: Bool- _hdOo_cata :: Bool- _hdOo_costcentre :: Bool- _hdOo_data :: (Maybe Bool)- _hdOo_linePragmas :: Bool- _hdOo_newtypes :: Bool- _hdOo_pretty :: Bool- _hdOo_rename :: Bool- _hdOo_sem :: Bool- _hdOo_sig :: Bool- _hdOo_splitsems :: Bool- _hdOo_strictwrap :: Bool- _hdOo_traces :: Bool- _hdOo_unbox :: Bool- _hdOprefix :: String- _hdOsyn :: Attributes- _hdOterminals :: ([Name])- _hdOwith_sig :: Bool- _tlOallPragmas :: PragmaMap- _tlOchildren :: ([(Name,Type,Bool)])- _tlOcon :: Constructor- _tlOerrors :: (Seq Error)- _tlOinh :: Attributes- _tlOinstVisitNrs :: (Map Identifier Int)- _tlOnt :: Nonterminal- _tlOo_case :: Bool- _tlOo_cata :: Bool- _tlOo_costcentre :: Bool- _tlOo_data :: (Maybe Bool)- _tlOo_linePragmas :: Bool- _tlOo_newtypes :: Bool- _tlOo_pretty :: Bool- _tlOo_rename :: Bool- _tlOo_sem :: Bool- _tlOo_sig :: Bool- _tlOo_splitsems :: Bool- _tlOo_strictwrap :: Bool- _tlOo_traces :: Bool- _tlOo_unbox :: Bool- _tlOprefix :: String- _tlOsyn :: Attributes- _tlOterminals :: ([Name])- _tlOwith_sig :: Bool- _hdIallTpsFound :: Bool- _hdIcomments :: ([String])- _hdIdecls :: Decls- _hdIerrors :: (Seq Error)- _hdIgatherInstVisitNrs :: (Map Identifier Int)- _hdIintra :: Exprs- _hdIintraVars :: (Set String)- _hdIsemNames :: ([String])- _tlIallTpsFound :: Bool- _tlIcomments :: ([String])- _tlIdecls :: Decls- _tlIerrors :: (Seq Error)- _tlIgatherInstVisitNrs :: (Map Identifier Int)- _tlIintra :: Exprs- _tlIintraVars :: (Set String)- _tlIisNil :: Bool- _tlIsemNames :: ([String])- -- "GenerateCode.ag"(line 161, column 11)- _tlOnr =- _lhsInr + 1- -- "GenerateCode.ag"(line 174, column 12)- _lhsOisNil =- False- -- "GenerateCode.ag"(line 175, column 12)- _hdOisLast =- _tlIisNil- -- "GenerateCode.ag"(line 192, column 12)- _hdOnextIntra =- _tlIintra- -- "GenerateCode.ag"(line 193, column 12)- _hdOnextIntraVars =- _tlIintraVars- -- "GenerateCode.ag"(line 194, column 12)- _lhsOintra =- _hdIintra- -- "GenerateCode.ag"(line 195, column 12)- _lhsOintraVars =- _hdIintraVars- -- use rule "GenerateCode.ag"(line 551, column 39)- _lhsOallTpsFound =- _hdIallTpsFound && _tlIallTpsFound- -- use rule "GenerateCode.ag"(line 583, column 52)- _lhsOcomments =- _hdIcomments ++ _tlIcomments- -- use rule "GenerateCode.ag"(line 276, column 33)- _lhsOdecls =- _hdIdecls ++ _tlIdecls- -- use rule "GenerateCode.ag"(line 564, column 32)- _lhsOerrors =- _hdIerrors Seq.<> _tlIerrors- -- use rule "GenerateCode.ag"(line 346, column 44)- _lhsOgatherInstVisitNrs =- _hdIgatherInstVisitNrs `Map.union` _tlIgatherInstVisitNrs- -- use rule "GenerateCode.ag"(line 774, column 63)- _lhsOsemNames =- _hdIsemNames ++ _tlIsemNames- -- copy rule (down)- _hdOallPragmas =- _lhsIallPragmas- -- copy rule (down)- _hdOchildren =- _lhsIchildren- -- copy rule (down)- _hdOcon =- _lhsIcon- -- copy rule (down)- _hdOerrors =- _lhsIerrors- -- copy rule (down)- _hdOinh =- _lhsIinh- -- copy rule (down)- _hdOinstVisitNrs =- _lhsIinstVisitNrs- -- copy rule (down)- _hdOnr =- _lhsInr- -- copy rule (down)- _hdOnt =- _lhsInt- -- copy rule (down)- _hdOo_case =- _lhsIo_case- -- copy rule (down)- _hdOo_cata =- _lhsIo_cata- -- copy rule (down)- _hdOo_costcentre =- _lhsIo_costcentre- -- copy rule (down)- _hdOo_data =- _lhsIo_data- -- copy rule (down)- _hdOo_linePragmas =- _lhsIo_linePragmas- -- copy rule (down)- _hdOo_newtypes =- _lhsIo_newtypes- -- copy rule (down)- _hdOo_pretty =- _lhsIo_pretty- -- copy rule (down)- _hdOo_rename =- _lhsIo_rename- -- copy rule (down)- _hdOo_sem =- _lhsIo_sem- -- copy rule (down)- _hdOo_sig =- _lhsIo_sig- -- copy rule (down)- _hdOo_splitsems =- _lhsIo_splitsems- -- copy rule (down)- _hdOo_strictwrap =- _lhsIo_strictwrap- -- copy rule (down)- _hdOo_traces =- _lhsIo_traces- -- copy rule (down)- _hdOo_unbox =- _lhsIo_unbox- -- copy rule (down)- _hdOprefix =- _lhsIprefix- -- copy rule (down)- _hdOsyn =- _lhsIsyn- -- copy rule (down)- _hdOterminals =- _lhsIterminals- -- copy rule (down)- _hdOwith_sig =- _lhsIwith_sig- -- copy rule (down)- _tlOallPragmas =- _lhsIallPragmas- -- copy rule (down)- _tlOchildren =- _lhsIchildren- -- copy rule (down)- _tlOcon =- _lhsIcon- -- copy rule (chain)- _tlOerrors =- _hdIerrors- -- copy rule (down)- _tlOinh =- _lhsIinh- -- copy rule (down)- _tlOinstVisitNrs =- _lhsIinstVisitNrs- -- copy rule (down)- _tlOnt =- _lhsInt- -- copy rule (down)- _tlOo_case =- _lhsIo_case- -- copy rule (down)- _tlOo_cata =- _lhsIo_cata- -- copy rule (down)- _tlOo_costcentre =- _lhsIo_costcentre- -- copy rule (down)- _tlOo_data =- _lhsIo_data- -- copy rule (down)- _tlOo_linePragmas =- _lhsIo_linePragmas- -- copy rule (down)- _tlOo_newtypes =- _lhsIo_newtypes- -- copy rule (down)- _tlOo_pretty =- _lhsIo_pretty- -- copy rule (down)- _tlOo_rename =- _lhsIo_rename- -- copy rule (down)- _tlOo_sem =- _lhsIo_sem- -- copy rule (down)- _tlOo_sig =- _lhsIo_sig- -- copy rule (down)- _tlOo_splitsems =- _lhsIo_splitsems- -- copy rule (down)- _tlOo_strictwrap =- _lhsIo_strictwrap- -- copy rule (down)- _tlOo_traces =- _lhsIo_traces- -- copy rule (down)- _tlOo_unbox =- _lhsIo_unbox- -- copy rule (down)- _tlOprefix =- _lhsIprefix- -- copy rule (down)- _tlOsyn =- _lhsIsyn- -- copy rule (down)- _tlOterminals =- _lhsIterminals- -- copy rule (down)- _tlOwith_sig =- _lhsIwith_sig- ( _hdIallTpsFound,_hdIcomments,_hdIdecls,_hdIerrors,_hdIgatherInstVisitNrs,_hdIintra,_hdIintraVars,_hdIsemNames) =- (hd_ _hdOallPragmas _hdOchildren _hdOcon _hdOerrors _hdOinh _hdOinstVisitNrs _hdOisLast _hdOnextIntra _hdOnextIntraVars _hdOnr _hdOnt _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOprefix _hdOsyn _hdOterminals _hdOwith_sig )- ( _tlIallTpsFound,_tlIcomments,_tlIdecls,_tlIerrors,_tlIgatherInstVisitNrs,_tlIintra,_tlIintraVars,_tlIisNil,_tlIsemNames) =- (tl_ _tlOallPragmas _tlOchildren _tlOcon _tlOerrors _tlOinh _tlOinstVisitNrs _tlOnr _tlOnt _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOprefix _tlOsyn _tlOterminals _tlOwith_sig )- in ( _lhsOallTpsFound,_lhsOcomments,_lhsOdecls,_lhsOerrors,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOisNil,_lhsOsemNames))) )-sem_CVisits_Nil :: T_CVisits-sem_CVisits_Nil =- (T_CVisits (\ _lhsIallPragmas- _lhsIchildren- _lhsIcon- _lhsIerrors- _lhsIinh- _lhsIinstVisitNrs- _lhsInr- _lhsInt- _lhsIo_case- _lhsIo_cata- _lhsIo_costcentre- _lhsIo_data- _lhsIo_linePragmas- _lhsIo_newtypes- _lhsIo_pretty- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_splitsems- _lhsIo_strictwrap- _lhsIo_traces- _lhsIo_unbox- _lhsIprefix- _lhsIsyn- _lhsIterminals- _lhsIwith_sig ->- (let _lhsOisNil :: Bool- _lhsOintra :: Exprs- _lhsOintraVars :: (Set String)- _lhsOallTpsFound :: Bool- _lhsOcomments :: ([String])- _lhsOdecls :: Decls- _lhsOerrors :: (Seq Error)- _lhsOgatherInstVisitNrs :: (Map Identifier Int)- _lhsOsemNames :: ([String])- -- "GenerateCode.ag"(line 176, column 10)- _lhsOisNil =- True- -- "GenerateCode.ag"(line 196, column 10)- _lhsOintra =- []- -- "GenerateCode.ag"(line 197, column 10)- _lhsOintraVars =- Set.empty- -- use rule "GenerateCode.ag"(line 551, column 39)- _lhsOallTpsFound =- True- -- use rule "GenerateCode.ag"(line 583, column 52)- _lhsOcomments =- []- -- use rule "GenerateCode.ag"(line 276, column 33)- _lhsOdecls =- []- -- use rule "GenerateCode.ag"(line 564, column 32)- _lhsOerrors =- Seq.empty- -- use rule "GenerateCode.ag"(line 346, column 44)- _lhsOgatherInstVisitNrs =- Map.empty- -- use rule "GenerateCode.ag"(line 774, column 63)- _lhsOsemNames =- []- in ( _lhsOallTpsFound,_lhsOcomments,_lhsOdecls,_lhsOerrors,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOisNil,_lhsOsemNames))) )--- DeclBlocks ---------------------------------------------------{-- visit 0:- inherited attributes:- blockNr : Int- lastExprVars : [String]- nextVisitDecls : [Decl]- optCase : Bool- prefix : String- synthesized attributes:- callExpr : Expr- decls : [Decl]- freeVars : [String]- alternatives:- alternative DeclBlock:- child defs : {[Decl]}- child visit : {Decl}- child next : DeclBlocks- visit 0:- local lambdaName : _- local pragmaDecl : _- local freeVars : _- local decl : _- alternative DeclTerminator:- child defs : {[Decl]}- child result : {Expr}- visit 0:- local lambdaName : _- local pragmaDecl : _- local freeVars : _--}--- cata-sem_DeclBlocks :: DeclBlocks ->- T_DeclBlocks-sem_DeclBlocks (DeclBlock _defs _visit _next ) =- (sem_DeclBlocks_DeclBlock _defs _visit (sem_DeclBlocks _next ) )-sem_DeclBlocks (DeclTerminator _defs _result ) =- (sem_DeclBlocks_DeclTerminator _defs _result )--- semantic domain-newtype T_DeclBlocks = T_DeclBlocks (Int ->- ([String]) ->- ([Decl]) ->- Bool ->- String ->- ( Expr,([Decl]),([String])))-data Inh_DeclBlocks = Inh_DeclBlocks {blockNr_Inh_DeclBlocks :: Int,lastExprVars_Inh_DeclBlocks :: [String],nextVisitDecls_Inh_DeclBlocks :: [Decl],optCase_Inh_DeclBlocks :: Bool,prefix_Inh_DeclBlocks :: String}-data Syn_DeclBlocks = Syn_DeclBlocks {callExpr_Syn_DeclBlocks :: Expr,decls_Syn_DeclBlocks :: [Decl],freeVars_Syn_DeclBlocks :: [String]}-wrap_DeclBlocks (T_DeclBlocks sem ) (Inh_DeclBlocks _lhsIblockNr _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix ) =- (let ( _lhsOcallExpr,_lhsOdecls,_lhsOfreeVars) =- (sem _lhsIblockNr _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix )- in (Syn_DeclBlocks _lhsOcallExpr _lhsOdecls _lhsOfreeVars ))-sem_DeclBlocks_DeclBlock :: ([Decl]) ->- Decl ->- T_DeclBlocks ->- T_DeclBlocks-sem_DeclBlocks_DeclBlock defs_ visit_ (T_DeclBlocks next_ ) =- (T_DeclBlocks (\ _lhsIblockNr- _lhsIlastExprVars- _lhsInextVisitDecls- _lhsIoptCase- _lhsIprefix ->- (let _nextOblockNr :: Int- _lhsOcallExpr :: Expr- _lhsOdecls :: ([Decl])- _lhsOfreeVars :: ([String])- _nextOlastExprVars :: ([String])- _nextOnextVisitDecls :: ([Decl])- _nextOoptCase :: Bool- _nextOprefix :: String- _nextIcallExpr :: Expr- _nextIdecls :: ([Decl])- _nextIfreeVars :: ([String])- -- "GenerateCode.ag"(line 443, column 7)- _nextOblockNr =- _lhsIblockNr + 1- -- "GenerateCode.ag"(line 448, column 7)- _lambdaName =- _lhsIprefix ++ "_block" ++ show _lhsIblockNr- -- "GenerateCode.ag"(line 449, column 7)- _pragmaDecl =- PragmaDecl ("NOINLINE " ++ _lambdaName )- -- "GenerateCode.ag"(line 450, column 7)- _lhsOcallExpr =- App _lambdaName (map SimpleExpr _freeVars )- -- "GenerateCode.ag"(line 454, column 7)- _freeVars =- freevars _nextIfreeVars (visit_ : defs_)- -- "GenerateCode.ag"(line 461, column 7)- _decl =- mkBlockLambda _lhsIoptCase _lambdaName _freeVars (defs_ ++ [visit_]) _nextIcallExpr- -- "GenerateCode.ag"(line 462, column 7)- _lhsOdecls =- (if _lhsIblockNr > 1 then [_pragmaDecl ] else []) ++ [_decl ] ++ _nextIdecls- -- copy rule (from local)- _lhsOfreeVars =- _freeVars- -- copy rule (down)- _nextOlastExprVars =- _lhsIlastExprVars- -- copy rule (down)- _nextOnextVisitDecls =- _lhsInextVisitDecls- -- copy rule (down)- _nextOoptCase =- _lhsIoptCase- -- copy rule (down)- _nextOprefix =- _lhsIprefix- ( _nextIcallExpr,_nextIdecls,_nextIfreeVars) =- (next_ _nextOblockNr _nextOlastExprVars _nextOnextVisitDecls _nextOoptCase _nextOprefix )- in ( _lhsOcallExpr,_lhsOdecls,_lhsOfreeVars))) )-sem_DeclBlocks_DeclTerminator :: ([Decl]) ->- Expr ->- T_DeclBlocks-sem_DeclBlocks_DeclTerminator defs_ result_ =- (T_DeclBlocks (\ _lhsIblockNr- _lhsIlastExprVars- _lhsInextVisitDecls- _lhsIoptCase- _lhsIprefix ->- (let _lhsOcallExpr :: Expr- _lhsOdecls :: ([Decl])- _lhsOfreeVars :: ([String])- -- "GenerateCode.ag"(line 448, column 7)- _lambdaName =- _lhsIprefix ++ "_block" ++ show _lhsIblockNr- -- "GenerateCode.ag"(line 449, column 7)- _pragmaDecl =- PragmaDecl ("NOINLINE " ++ _lambdaName )- -- "GenerateCode.ag"(line 450, column 7)- _lhsOcallExpr =- App _lambdaName (map SimpleExpr _freeVars )- -- "GenerateCode.ag"(line 452, column 7)- _freeVars =- freevars _lhsIlastExprVars (defs_ ++ _lhsInextVisitDecls)- -- "GenerateCode.ag"(line 459, column 7)- _lhsOdecls =- [ mkBlockLambda _lhsIoptCase _lambdaName _freeVars (defs_ ++ _lhsInextVisitDecls) result_ ]- -- copy rule (from local)- _lhsOfreeVars =- _freeVars- in ( _lhsOcallExpr,_lhsOdecls,_lhsOfreeVars))) )--- DeclBlocksRoot -----------------------------------------------{-- visit 0:- inherited attributes:- lastExprVars : [String]- nextVisitDecls : [Decl]- optCase : Bool- prefix : String- synthesized attributes:- firstCall : Expr- lambdas : [Decl]- alternatives:- alternative DeclBlocksRoot:- child blocks : DeclBlocks--}--- cata-sem_DeclBlocksRoot :: DeclBlocksRoot ->- T_DeclBlocksRoot-sem_DeclBlocksRoot (DeclBlocksRoot _blocks ) =- (sem_DeclBlocksRoot_DeclBlocksRoot (sem_DeclBlocks _blocks ) )--- semantic domain-newtype T_DeclBlocksRoot = T_DeclBlocksRoot (([String]) ->- ([Decl]) ->- Bool ->- String ->- ( Expr,([Decl])))-data Inh_DeclBlocksRoot = Inh_DeclBlocksRoot {lastExprVars_Inh_DeclBlocksRoot :: [String],nextVisitDecls_Inh_DeclBlocksRoot :: [Decl],optCase_Inh_DeclBlocksRoot :: Bool,prefix_Inh_DeclBlocksRoot :: String}-data Syn_DeclBlocksRoot = Syn_DeclBlocksRoot {firstCall_Syn_DeclBlocksRoot :: Expr,lambdas_Syn_DeclBlocksRoot :: [Decl]}-wrap_DeclBlocksRoot (T_DeclBlocksRoot sem ) (Inh_DeclBlocksRoot _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix ) =- (let ( _lhsOfirstCall,_lhsOlambdas) =- (sem _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix )- in (Syn_DeclBlocksRoot _lhsOfirstCall _lhsOlambdas ))-sem_DeclBlocksRoot_DeclBlocksRoot :: T_DeclBlocks ->- T_DeclBlocksRoot-sem_DeclBlocksRoot_DeclBlocksRoot (T_DeclBlocks blocks_ ) =- (T_DeclBlocksRoot (\ _lhsIlastExprVars- _lhsInextVisitDecls- _lhsIoptCase- _lhsIprefix ->- (let _lhsOlambdas :: ([Decl])- _lhsOfirstCall :: Expr- _blocksOblockNr :: Int- _blocksOlastExprVars :: ([String])- _blocksOnextVisitDecls :: ([Decl])- _blocksOoptCase :: Bool- _blocksOprefix :: String- _blocksIcallExpr :: Expr- _blocksIdecls :: ([Decl])- _blocksIfreeVars :: ([String])- -- "GenerateCode.ag"(line 434, column 7)- _lhsOlambdas =- _blocksIdecls- -- "GenerateCode.ag"(line 435, column 7)- _lhsOfirstCall =- _blocksIcallExpr- -- "GenerateCode.ag"(line 440, column 7)- _blocksOblockNr =- 1- -- copy rule (down)- _blocksOlastExprVars =- _lhsIlastExprVars- -- copy rule (down)- _blocksOnextVisitDecls =- _lhsInextVisitDecls- -- copy rule (down)- _blocksOoptCase =- _lhsIoptCase- -- copy rule (down)- _blocksOprefix =- _lhsIprefix- ( _blocksIcallExpr,_blocksIdecls,_blocksIfreeVars) =- (blocks_ _blocksOblockNr _blocksOlastExprVars _blocksOnextVisitDecls _blocksOoptCase _blocksOprefix )- in ( _lhsOfirstCall,_lhsOlambdas))) )--- Pattern ------------------------------------------------------{-- visit 0:- synthesized attributes:- copy : SELF- definedInsts : [Identifier]- patternAttributes : [(Name, Name)]- alternatives:- alternative Alias:- child field : {Name}- child attr : {Name}- child pat : Pattern- child parts : Patterns- visit 0:- local copy : _- alternative Constr:- child name : {Constructor}- child pats : Patterns- 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 (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]),([(Name, Name)])))-data Inh_Pattern = Inh_Pattern {}-data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern,definedInsts_Syn_Pattern :: [Identifier],patternAttributes_Syn_Pattern :: [(Name, Name)]}-wrap_Pattern (T_Pattern sem ) (Inh_Pattern ) =- (let ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes) =- (sem )- in (Syn_Pattern _lhsOcopy _lhsOdefinedInsts _lhsOpatternAttributes ))-sem_Pattern_Alias :: Name ->- Name ->- T_Pattern ->- T_Patterns ->- T_Pattern-sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) =- (T_Pattern (let _lhsOdefinedInsts :: ([Identifier])- _lhsOpatternAttributes :: ([(Name, Name)])- _lhsOcopy :: Pattern- _patIcopy :: Pattern- _patIdefinedInsts :: ([Identifier])- _patIpatternAttributes :: ([(Name, Name)])- _partsIcopy :: Patterns- _partsIdefinedInsts :: ([Identifier])- _partsIpatternAttributes :: ([(Name, Name)])- -- "GenerateCode.ag"(line 142, column 11)- _lhsOdefinedInsts =- (if field_ == _INST then [attr_] else []) ++ _patIdefinedInsts- -- "GenerateCode.ag"(line 150, column 7)- _lhsOpatternAttributes =- (field_,attr_) : (_patIpatternAttributes ++ _partsIpatternAttributes)- -- self rule- _copy =- Alias field_ attr_ _patIcopy _partsIcopy- -- self rule- _lhsOcopy =- _copy- ( _patIcopy,_patIdefinedInsts,_patIpatternAttributes) =- (pat_ )- ( _partsIcopy,_partsIdefinedInsts,_partsIpatternAttributes) =- (parts_ )- in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)) )-sem_Pattern_Constr :: Constructor ->- T_Patterns ->- T_Pattern-sem_Pattern_Constr name_ (T_Patterns pats_ ) =- (T_Pattern (let _lhsOdefinedInsts :: ([Identifier])- _lhsOpatternAttributes :: ([(Name, Name)])- _lhsOcopy :: Pattern- _patsIcopy :: Patterns- _patsIdefinedInsts :: ([Identifier])- _patsIpatternAttributes :: ([(Name, Name)])- -- use rule "GenerateCode.ag"(line 140, column 55)- _lhsOdefinedInsts =- _patsIdefinedInsts- -- use rule "GenerateCode.ag"(line 147, column 47)- _lhsOpatternAttributes =- _patsIpatternAttributes- -- self rule- _copy =- Constr name_ _patsIcopy- -- self rule- _lhsOcopy =- _copy- ( _patsIcopy,_patsIdefinedInsts,_patsIpatternAttributes) =- (pats_ )- in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)) )-sem_Pattern_Product :: Pos ->- T_Patterns ->- T_Pattern-sem_Pattern_Product pos_ (T_Patterns pats_ ) =- (T_Pattern (let _lhsOdefinedInsts :: ([Identifier])- _lhsOpatternAttributes :: ([(Name, Name)])- _lhsOcopy :: Pattern- _patsIcopy :: Patterns- _patsIdefinedInsts :: ([Identifier])- _patsIpatternAttributes :: ([(Name, Name)])- -- use rule "GenerateCode.ag"(line 140, column 55)- _lhsOdefinedInsts =- _patsIdefinedInsts- -- use rule "GenerateCode.ag"(line 147, column 47)- _lhsOpatternAttributes =- _patsIpatternAttributes- -- self rule- _copy =- Product pos_ _patsIcopy- -- self rule- _lhsOcopy =- _copy- ( _patsIcopy,_patsIdefinedInsts,_patsIpatternAttributes) =- (pats_ )- in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)) )-sem_Pattern_Underscore :: Pos ->- T_Pattern-sem_Pattern_Underscore pos_ =- (T_Pattern (let _lhsOdefinedInsts :: ([Identifier])- _lhsOpatternAttributes :: ([(Name, Name)])- _lhsOcopy :: Pattern- -- use rule "GenerateCode.ag"(line 140, column 55)- _lhsOdefinedInsts =- []- -- use rule "GenerateCode.ag"(line 147, column 47)- _lhsOpatternAttributes =- []- -- self rule- _copy =- Underscore pos_- -- self rule- _lhsOcopy =- _copy- in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)) )--- Patterns -----------------------------------------------------{-- visit 0:- synthesized attributes:- copy : SELF- definedInsts : [Identifier]- patternAttributes : [(Name, Name)]- 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,([Identifier]),([(Name, Name)])))-data Inh_Patterns = Inh_Patterns {}-data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns,definedInsts_Syn_Patterns :: [Identifier],patternAttributes_Syn_Patterns :: [(Name, Name)]}-wrap_Patterns (T_Patterns sem ) (Inh_Patterns ) =- (let ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes) =- (sem )- in (Syn_Patterns _lhsOcopy _lhsOdefinedInsts _lhsOpatternAttributes ))-sem_Patterns_Cons :: T_Pattern ->- T_Patterns ->- T_Patterns-sem_Patterns_Cons (T_Pattern hd_ ) (T_Patterns tl_ ) =- (T_Patterns (let _lhsOdefinedInsts :: ([Identifier])- _lhsOpatternAttributes :: ([(Name, Name)])- _lhsOcopy :: Patterns- _hdIcopy :: Pattern- _hdIdefinedInsts :: ([Identifier])- _hdIpatternAttributes :: ([(Name, Name)])- _tlIcopy :: Patterns- _tlIdefinedInsts :: ([Identifier])- _tlIpatternAttributes :: ([(Name, Name)])- -- use rule "GenerateCode.ag"(line 140, column 55)- _lhsOdefinedInsts =- _hdIdefinedInsts ++ _tlIdefinedInsts- -- use rule "GenerateCode.ag"(line 147, column 47)- _lhsOpatternAttributes =- _hdIpatternAttributes ++ _tlIpatternAttributes- -- self rule- _copy =- (:) _hdIcopy _tlIcopy- -- self rule- _lhsOcopy =- _copy- ( _hdIcopy,_hdIdefinedInsts,_hdIpatternAttributes) =- (hd_ )- ( _tlIcopy,_tlIdefinedInsts,_tlIpatternAttributes) =- (tl_ )- in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)) )-sem_Patterns_Nil :: T_Patterns-sem_Patterns_Nil =- (T_Patterns (let _lhsOdefinedInsts :: ([Identifier])- _lhsOpatternAttributes :: ([(Name, Name)])- _lhsOcopy :: Patterns- -- use rule "GenerateCode.ag"(line 140, column 55)- _lhsOdefinedInsts =- []- -- use rule "GenerateCode.ag"(line 147, column 47)- _lhsOpatternAttributes =- []- -- self rule- _copy =- []- -- self rule- _lhsOcopy =- _copy- in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)) )--- Sequence -----------------------------------------------------{-- visit 0:- inherited attributes:- children : [(Name,Type,Bool)]- con : Constructor- higherOrderChildren : [(Name,Type,Bool)]- inh : Attributes- instVisitNrs : Map Identifier Int- lastExpr : Expr- nr : Int- nt : Nonterminal- o_case : Bool- o_cata : Bool- o_costcentre : Bool- o_data : Maybe Bool- o_linePragmas : Bool- o_newtypes : Bool- o_pretty : Bool- o_rename : Bool- o_sem : Bool- o_sig : Bool- o_splitsems : Bool- o_strictwrap : Bool- o_traces : Bool- o_unbox : Bool- prefix : String- syn : Attributes- terminals : [Name]- what : String- chained attributes:- declsAbove : [Decl]- errors : Seq Error- synthesized attributes:- allTpsFound : Bool- blockDecls : DeclBlocks- comments : [String]- decls : Decls- definedInsts : [Identifier]- exprs : Exprs- tSigs : [Decl]- tps : [Type]- usedVars : Set String- alternatives:- alternative Cons:- child hd : CRule- child tl : Sequence- alternative Nil:--}--- cata-sem_Sequence :: Sequence ->- T_Sequence-sem_Sequence list =- (Prelude.foldr sem_Sequence_Cons sem_Sequence_Nil (Prelude.map sem_CRule list) )--- semantic domain-newtype T_Sequence = T_Sequence (([(Name,Type,Bool)]) ->- Constructor ->- ([Decl]) ->- (Seq Error) ->- ([(Name,Type,Bool)]) ->- Attributes ->- (Map Identifier Int) ->- Expr ->- Int ->- Nonterminal ->- Bool ->- Bool ->- Bool ->- (Maybe Bool) ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- String ->- Attributes ->- ([Name]) ->- String ->- ( Bool,DeclBlocks,([String]),Decls,([Decl]),([Identifier]),(Seq Error),Exprs,([Decl]),([Type]),(Set String)))-data Inh_Sequence = Inh_Sequence {children_Inh_Sequence :: [(Name,Type,Bool)],con_Inh_Sequence :: Constructor,declsAbove_Inh_Sequence :: [Decl],errors_Inh_Sequence :: Seq Error,higherOrderChildren_Inh_Sequence :: [(Name,Type,Bool)],inh_Inh_Sequence :: Attributes,instVisitNrs_Inh_Sequence :: Map Identifier Int,lastExpr_Inh_Sequence :: Expr,nr_Inh_Sequence :: Int,nt_Inh_Sequence :: Nonterminal,o_case_Inh_Sequence :: Bool,o_cata_Inh_Sequence :: Bool,o_costcentre_Inh_Sequence :: Bool,o_data_Inh_Sequence :: Maybe Bool,o_linePragmas_Inh_Sequence :: Bool,o_newtypes_Inh_Sequence :: Bool,o_pretty_Inh_Sequence :: Bool,o_rename_Inh_Sequence :: Bool,o_sem_Inh_Sequence :: Bool,o_sig_Inh_Sequence :: Bool,o_splitsems_Inh_Sequence :: Bool,o_strictwrap_Inh_Sequence :: Bool,o_traces_Inh_Sequence :: Bool,o_unbox_Inh_Sequence :: Bool,prefix_Inh_Sequence :: String,syn_Inh_Sequence :: Attributes,terminals_Inh_Sequence :: [Name],what_Inh_Sequence :: String}-data Syn_Sequence = Syn_Sequence {allTpsFound_Syn_Sequence :: Bool,blockDecls_Syn_Sequence :: DeclBlocks,comments_Syn_Sequence :: [String],decls_Syn_Sequence :: Decls,declsAbove_Syn_Sequence :: [Decl],definedInsts_Syn_Sequence :: [Identifier],errors_Syn_Sequence :: Seq Error,exprs_Syn_Sequence :: Exprs,tSigs_Syn_Sequence :: [Decl],tps_Syn_Sequence :: [Type],usedVars_Syn_Sequence :: Set String}-wrap_Sequence (T_Sequence sem ) (Inh_Sequence _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIerrors _lhsIhigherOrderChildren _lhsIinh _lhsIinstVisitNrs _lhsIlastExpr _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn _lhsIterminals _lhsIwhat ) =- (let ( _lhsOallTpsFound,_lhsOblockDecls,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOerrors,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars) =- (sem _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIerrors _lhsIhigherOrderChildren _lhsIinh _lhsIinstVisitNrs _lhsIlastExpr _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIprefix _lhsIsyn _lhsIterminals _lhsIwhat )- in (Syn_Sequence _lhsOallTpsFound _lhsOblockDecls _lhsOcomments _lhsOdecls _lhsOdeclsAbove _lhsOdefinedInsts _lhsOerrors _lhsOexprs _lhsOtSigs _lhsOtps _lhsOusedVars ))-sem_Sequence_Cons :: T_CRule ->- T_Sequence ->- T_Sequence-sem_Sequence_Cons (T_CRule hd_ ) (T_Sequence tl_ ) =- (T_Sequence (\ _lhsIchildren- _lhsIcon- _lhsIdeclsAbove- _lhsIerrors- _lhsIhigherOrderChildren- _lhsIinh- _lhsIinstVisitNrs- _lhsIlastExpr- _lhsInr- _lhsInt- _lhsIo_case- _lhsIo_cata- _lhsIo_costcentre- _lhsIo_data- _lhsIo_linePragmas- _lhsIo_newtypes- _lhsIo_pretty- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_splitsems- _lhsIo_strictwrap- _lhsIo_traces- _lhsIo_unbox- _lhsIprefix- _lhsIsyn- _lhsIterminals- _lhsIwhat ->- (let _lhsOblockDecls :: DeclBlocks- _lhsOallTpsFound :: Bool- _lhsOcomments :: ([String])- _lhsOdecls :: Decls- _lhsOdefinedInsts :: ([Identifier])- _lhsOerrors :: (Seq Error)- _lhsOexprs :: Exprs- _lhsOtSigs :: ([Decl])- _lhsOtps :: ([Type])- _lhsOusedVars :: (Set String)- _lhsOdeclsAbove :: ([Decl])- _hdOchildren :: ([(Name,Type,Bool)])- _hdOcon :: Constructor- _hdOdeclsAbove :: ([Decl])- _hdOerrors :: (Seq Error)- _hdOhigherOrderChildren :: ([(Name,Type,Bool)])- _hdOinh :: Attributes- _hdOinstVisitNrs :: (Map Identifier Int)- _hdOnr :: Int- _hdOnt :: Nonterminal- _hdOo_case :: Bool- _hdOo_cata :: Bool- _hdOo_costcentre :: Bool- _hdOo_data :: (Maybe Bool)- _hdOo_linePragmas :: Bool- _hdOo_newtypes :: Bool- _hdOo_pretty :: Bool- _hdOo_rename :: Bool- _hdOo_sem :: Bool- _hdOo_sig :: Bool- _hdOo_splitsems :: Bool- _hdOo_strictwrap :: Bool- _hdOo_traces :: Bool- _hdOo_unbox :: Bool- _hdOprefix :: String- _hdOsyn :: Attributes- _hdOterminals :: ([Name])- _hdOwhat :: String- _tlOchildren :: ([(Name,Type,Bool)])- _tlOcon :: Constructor- _tlOdeclsAbove :: ([Decl])- _tlOerrors :: (Seq Error)- _tlOhigherOrderChildren :: ([(Name,Type,Bool)])- _tlOinh :: Attributes- _tlOinstVisitNrs :: (Map Identifier Int)- _tlOlastExpr :: Expr- _tlOnr :: Int- _tlOnt :: Nonterminal- _tlOo_case :: Bool- _tlOo_cata :: Bool- _tlOo_costcentre :: Bool- _tlOo_data :: (Maybe Bool)- _tlOo_linePragmas :: Bool- _tlOo_newtypes :: Bool- _tlOo_pretty :: Bool- _tlOo_rename :: Bool- _tlOo_sem :: Bool- _tlOo_sig :: Bool- _tlOo_splitsems :: Bool- _tlOo_strictwrap :: Bool- _tlOo_traces :: Bool- _tlOo_unbox :: Bool- _tlOprefix :: String- _tlOsyn :: Attributes- _tlOterminals :: ([Name])- _tlOwhat :: String- _hdIallTpsFound :: Bool- _hdIbldBlocksFun :: (DeclBlocks -> DeclBlocks)- _hdIcomments :: ([String])- _hdIdecls :: Decls- _hdIdeclsAbove :: ([Decl])- _hdIdefinedInsts :: ([Identifier])- _hdIerrors :: (Seq Error)- _hdIexprs :: Exprs- _hdItSigs :: ([Decl])- _hdItps :: ([Type])- _hdIusedVars :: (Set String)- _tlIallTpsFound :: Bool- _tlIblockDecls :: DeclBlocks- _tlIcomments :: ([String])- _tlIdecls :: Decls- _tlIdeclsAbove :: ([Decl])- _tlIdefinedInsts :: ([Identifier])- _tlIerrors :: (Seq Error)- _tlIexprs :: Exprs- _tlItSigs :: ([Decl])- _tlItps :: ([Type])- _tlIusedVars :: (Set String)- -- "GenerateCode.ag"(line 375, column 7)- _lhsOblockDecls =- _hdIbldBlocksFun _tlIblockDecls- -- use rule "GenerateCode.ag"(line 265, column 39)- _lhsOallTpsFound =- _hdIallTpsFound && _tlIallTpsFound- -- use rule "GenerateCode.ag"(line 583, column 52)- _lhsOcomments =- _hdIcomments ++ _tlIcomments- -- use rule "GenerateCode.ag"(line 87, column 34)- _lhsOdecls =- _hdIdecls ++ _tlIdecls- -- use rule "GenerateCode.ag"(line 140, column 55)- _lhsOdefinedInsts =- _hdIdefinedInsts ++ _tlIdefinedInsts- -- use rule "GenerateCode.ag"(line 564, column 32)- _lhsOerrors =- _hdIerrors Seq.<> _tlIerrors- -- use rule "GenerateCode.ag"(line 213, column 34)- _lhsOexprs =- _hdIexprs ++ _tlIexprs- -- use rule "GenerateCode.ag"(line 238, column 33)- _lhsOtSigs =- _hdItSigs ++ _tlItSigs- -- use rule "GenerateCode.ag"(line 264, column 31)- _lhsOtps =- _hdItps ++ _tlItps- -- use rule "GenerateCode.ag"(line 227, column 37)- _lhsOusedVars =- _hdIusedVars `Set.union` _tlIusedVars- -- copy rule (up)- _lhsOdeclsAbove =- _tlIdeclsAbove- -- copy rule (down)- _hdOchildren =- _lhsIchildren- -- copy rule (down)- _hdOcon =- _lhsIcon- -- copy rule (down)- _hdOdeclsAbove =- _lhsIdeclsAbove- -- copy rule (down)- _hdOerrors =- _lhsIerrors- -- copy rule (down)- _hdOhigherOrderChildren =- _lhsIhigherOrderChildren- -- copy rule (down)- _hdOinh =- _lhsIinh- -- copy rule (down)- _hdOinstVisitNrs =- _lhsIinstVisitNrs- -- copy rule (down)- _hdOnr =- _lhsInr- -- copy rule (down)- _hdOnt =- _lhsInt- -- copy rule (down)- _hdOo_case =- _lhsIo_case- -- copy rule (down)- _hdOo_cata =- _lhsIo_cata- -- copy rule (down)- _hdOo_costcentre =- _lhsIo_costcentre- -- copy rule (down)- _hdOo_data =- _lhsIo_data- -- copy rule (down)- _hdOo_linePragmas =- _lhsIo_linePragmas- -- copy rule (down)- _hdOo_newtypes =- _lhsIo_newtypes- -- copy rule (down)- _hdOo_pretty =- _lhsIo_pretty- -- copy rule (down)- _hdOo_rename =- _lhsIo_rename- -- copy rule (down)- _hdOo_sem =- _lhsIo_sem- -- copy rule (down)- _hdOo_sig =- _lhsIo_sig- -- copy rule (down)- _hdOo_splitsems =- _lhsIo_splitsems- -- copy rule (down)- _hdOo_strictwrap =- _lhsIo_strictwrap- -- copy rule (down)- _hdOo_traces =- _lhsIo_traces- -- copy rule (down)- _hdOo_unbox =- _lhsIo_unbox- -- copy rule (down)- _hdOprefix =- _lhsIprefix- -- copy rule (down)- _hdOsyn =- _lhsIsyn- -- copy rule (down)- _hdOterminals =- _lhsIterminals- -- copy rule (down)- _hdOwhat =- _lhsIwhat- -- copy rule (down)- _tlOchildren =- _lhsIchildren- -- copy rule (down)- _tlOcon =- _lhsIcon- -- copy rule (chain)- _tlOdeclsAbove =- _hdIdeclsAbove- -- copy rule (chain)- _tlOerrors =- _hdIerrors- -- copy rule (down)- _tlOhigherOrderChildren =- _lhsIhigherOrderChildren- -- copy rule (down)- _tlOinh =- _lhsIinh- -- copy rule (down)- _tlOinstVisitNrs =- _lhsIinstVisitNrs- -- copy rule (down)- _tlOlastExpr =- _lhsIlastExpr- -- copy rule (down)- _tlOnr =- _lhsInr- -- copy rule (down)- _tlOnt =- _lhsInt- -- copy rule (down)- _tlOo_case =- _lhsIo_case- -- copy rule (down)- _tlOo_cata =- _lhsIo_cata- -- copy rule (down)- _tlOo_costcentre =- _lhsIo_costcentre- -- copy rule (down)- _tlOo_data =- _lhsIo_data- -- copy rule (down)- _tlOo_linePragmas =- _lhsIo_linePragmas- -- copy rule (down)- _tlOo_newtypes =- _lhsIo_newtypes- -- copy rule (down)- _tlOo_pretty =- _lhsIo_pretty- -- copy rule (down)- _tlOo_rename =- _lhsIo_rename- -- copy rule (down)- _tlOo_sem =- _lhsIo_sem- -- copy rule (down)- _tlOo_sig =- _lhsIo_sig- -- copy rule (down)- _tlOo_splitsems =- _lhsIo_splitsems- -- copy rule (down)- _tlOo_strictwrap =- _lhsIo_strictwrap- -- copy rule (down)- _tlOo_traces =- _lhsIo_traces- -- copy rule (down)- _tlOo_unbox =- _lhsIo_unbox- -- copy rule (down)- _tlOprefix =- _lhsIprefix- -- copy rule (down)- _tlOsyn =- _lhsIsyn- -- copy rule (down)- _tlOterminals =- _lhsIterminals- -- copy rule (down)- _tlOwhat =- _lhsIwhat- ( _hdIallTpsFound,_hdIbldBlocksFun,_hdIcomments,_hdIdecls,_hdIdeclsAbove,_hdIdefinedInsts,_hdIerrors,_hdIexprs,_hdItSigs,_hdItps,_hdIusedVars) =- (hd_ _hdOchildren _hdOcon _hdOdeclsAbove _hdOerrors _hdOhigherOrderChildren _hdOinh _hdOinstVisitNrs _hdOnr _hdOnt _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOprefix _hdOsyn _hdOterminals _hdOwhat )- ( _tlIallTpsFound,_tlIblockDecls,_tlIcomments,_tlIdecls,_tlIdeclsAbove,_tlIdefinedInsts,_tlIerrors,_tlIexprs,_tlItSigs,_tlItps,_tlIusedVars) =- (tl_ _tlOchildren _tlOcon _tlOdeclsAbove _tlOerrors _tlOhigherOrderChildren _tlOinh _tlOinstVisitNrs _tlOlastExpr _tlOnr _tlOnt _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOprefix _tlOsyn _tlOterminals _tlOwhat )- in ( _lhsOallTpsFound,_lhsOblockDecls,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOerrors,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars))) )-sem_Sequence_Nil :: T_Sequence-sem_Sequence_Nil =- (T_Sequence (\ _lhsIchildren- _lhsIcon- _lhsIdeclsAbove- _lhsIerrors- _lhsIhigherOrderChildren- _lhsIinh- _lhsIinstVisitNrs- _lhsIlastExpr- _lhsInr- _lhsInt- _lhsIo_case- _lhsIo_cata- _lhsIo_costcentre- _lhsIo_data- _lhsIo_linePragmas- _lhsIo_newtypes- _lhsIo_pretty- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_splitsems- _lhsIo_strictwrap- _lhsIo_traces- _lhsIo_unbox- _lhsIprefix- _lhsIsyn- _lhsIterminals- _lhsIwhat ->- (let _lhsOblockDecls :: DeclBlocks- _lhsOallTpsFound :: Bool- _lhsOcomments :: ([String])- _lhsOdecls :: Decls- _lhsOdefinedInsts :: ([Identifier])- _lhsOerrors :: (Seq Error)- _lhsOexprs :: Exprs- _lhsOtSigs :: ([Decl])- _lhsOtps :: ([Type])- _lhsOusedVars :: (Set String)- _lhsOdeclsAbove :: ([Decl])- -- "GenerateCode.ag"(line 377, column 7)- _lhsOblockDecls =- DeclTerminator _lhsIdeclsAbove _lhsIlastExpr- -- use rule "GenerateCode.ag"(line 265, column 39)- _lhsOallTpsFound =- True- -- use rule "GenerateCode.ag"(line 583, column 52)- _lhsOcomments =- []- -- use rule "GenerateCode.ag"(line 87, column 34)- _lhsOdecls =- []- -- use rule "GenerateCode.ag"(line 140, column 55)- _lhsOdefinedInsts =- []- -- use rule "GenerateCode.ag"(line 564, column 32)- _lhsOerrors =- Seq.empty- -- use rule "GenerateCode.ag"(line 213, column 34)- _lhsOexprs =- []- -- use rule "GenerateCode.ag"(line 238, column 33)- _lhsOtSigs =- []- -- use rule "GenerateCode.ag"(line 264, column 31)- _lhsOtps =- []- -- use rule "GenerateCode.ag"(line 227, column 37)- _lhsOusedVars =- Set.empty- -- copy rule (chain)- _lhsOdeclsAbove =- _lhsIdeclsAbove- in ( _lhsOallTpsFound,_lhsOblockDecls,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOerrors,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars))) )+-- UUAGC 0.9.5 (GenerateCode.ag)+module GenerateCode where++import SequentialTypes+import Code hiding (Type)+import qualified Code+import Options+import CodeSyntax+import ErrorMessages+import GrammarInfo+import DeclBlocks++import qualified Data.Map as Map+import Data.Map(Map) +import qualified Data.Set as Set+import Data.Set(Set) +import qualified UU.DData.Seq as Seq+import UU.DData.Seq(Seq)+import UU.Scanner.Position+import TokenDef+import HsToken+import HsTokenScanner++import Data.List(partition,intersperse,intersect,(\\))+import Maybe(fromJust,isJust)++import Patterns+import CommonTypes+import Data.Map(Map)+import Data.Set(Set)++-- Patterns.ag imports+import UU.Scanner.Position(Pos)+import CommonTypes (ConstructorIdent,Identifier)++import Code (Decl,Expr)++-- remove possible @v references in the types of a data type.+cleanupArg :: String -> String+cleanupArg s+ = case idEvalType (SimpleType s) of+ SimpleType s' -> s'++appContext :: ContextMap -> NontermIdent -> Code.Type -> Code.Type+appContext mp nt tp+ = maybe tp (\ctx -> CtxApp (map (\(n,ns) -> (getName n, ns)) ctx) tp) $ Map.lookup nt mp++substSelf nt tp = case tp of+ NT t tps | t == _SELF -> Haskell (getName nt ++ " " ++ unwords tps)+ _ -> tp++mkLambdaArg :: String -> Maybe Code.Type -> Expr+mkLambdaArg nm Nothing = SimpleExpr nm+mkLambdaArg nm (Just tp) = TypedExpr (SimpleExpr nm) tp++mkLambda :: Exprs -> Expr -> Expr+mkLambda [] e = e+mkLambda xs e = Lambda xs e++typeAppStrs nm params = TypeApp (SimpleType nm) (map SimpleType params)++-- dead code - replaced by mkPartitionedFunction+{-+localCpsToExpr :: Bool -> [Decl] -> DeclBlocks -> Expr+localCpsToExpr o_case nextVisitDecl+ = rec+ where+ rec cps+ = case cps of+ DeclTerminator decls expr+ -> mkLet o_case (decls ++ nextVisitDecl) expr+ DeclBlock decls (Decl lhs rhs _ _) remainder+ -> let inDecls = [ PragmaDecl ("NOINLINE " ++ internalCpsName)+ , Decl (Fun internalCpsName [SimpleExpr internalCpsVarName])+ (mkLet o_case [Decl lhs (SimpleExpr internalCpsVarName) Set.empty Set.empty] (rec remainder))+ Set.empty Set.empty+ ]+ inBody = App "head" [App "(:)" [App internalCpsName [rhs], App "(:)" [App internalCpsName [rhs], SimpleExpr "[]"]]]+ outerBody = Let inDecls inBody+ block = mkLet o_case decls outerBody+ in block++internalCpsName :: String+internalCpsName = "internalCps_"++internalCpsVarName :: String+internalCpsVarName = "internalCps_var_"+-}++mkPartitionedFunction :: String -> Bool -> [Decl] -> [String] -> DeclBlocks -> ([Decl], Expr)+mkPartitionedFunction prefix optCase nextVisitDecls lastExprVars cpsTree+ = let inh = Inh_DeclBlocksRoot { prefix_Inh_DeclBlocksRoot = prefix+ , optCase_Inh_DeclBlocksRoot = optCase+ , nextVisitDecls_Inh_DeclBlocksRoot = nextVisitDecls+ , lastExprVars_Inh_DeclBlocksRoot = lastExprVars+ }+ sem = sem_DeclBlocksRoot (DeclBlocksRoot cpsTree)+ syn = wrap_DeclBlocksRoot sem inh+ in (lambdas_Syn_DeclBlocksRoot syn, firstCall_Syn_DeclBlocksRoot syn)++freevars :: [String] -> [Decl] -> [String]+freevars additional decls+ = Set.toList (allused `Set.difference` alldefined)+ where+ allused = Set.unions (Set.fromList additional : map usedvars decls)+ alldefined = Set.unions (map definedvars decls)+ + usedvars (Decl _ _ _ uses) = uses+ usedvars _ = Set.empty+ + definedvars (Decl _ _ defs _) = defs+ definedvars _ = Set.empty++mkBlockLambda :: Bool -> String -> [String] -> [Decl] -> Expr -> Decl+mkBlockLambda optCase name args decls expr+ = Decl lhs rhs Set.empty Set.empty+ where+ lhs = Fun name (map SimpleExpr args)+ rhs = mkLet optCase decls expr++evalType :: (String -> String) -> Code.Type -> Code.Type+evalType replf t+ = chase t+ where+ chase t+ = case t of+ Arr l r -> Arr (chase l) (chase r)+ TypeApp f as -> TypeApp (chase f) (map chase as)+ TupleType tps -> TupleType (map chase tps)+ UnboxedTupleType tps -> UnboxedTupleType (map chase tps)+ Code.List tp -> Code.List (chase tp)+ SimpleType txt -> let tks = lexTokens (initPos txt) txt+ tks' = map replaceTok tks+ txt' = unlines . showTokens . tokensToStrings $ tks'+ in SimpleType txt'++ replaceTok t+ = case t of+ AGLocal v p _ -> HsToken (replf $ getName v) p+ _ -> t++idEvalType :: Code.Type -> Code.Type+idEvalType = evalType id++makeLocalComment :: Int -> String -> Identifier -> Maybe Type -> String+makeLocalComment width what name tp = let x = getName name+ y = maybe "_" (\t -> case t of (NT nt tps) -> getName nt ++ " " ++ unwords tps; Haskell t -> '{':t++"}") tp+ in ( what ++ " " ++ x ++ replicate ((width - length x) `max` 0) ' ' ++ " : " ++ y )+++-- Lets or nested Cases?+mkLet :: Bool -> Decls -> Expr -> Expr+mkLet False decls body = Let decls body+mkLet True decls body = foldr oneCase body decls++oneCase :: Decl -> Expr -> Expr+oneCase (Decl left rhs _ _) exp = Case rhs [CaseAlt left exp]+oneCase _ exp = exp++-- Gives the name of the visit function+funname field 0 = show field ++ "_"+funname field nr = show field ++ "_" ++ show nr++-- Gives the name of a semantic function+seqSemname :: String -> NontermIdent -> ConstructorIdent -> Int -> String+seqSemname pre nt con 0 = semname pre nt con+seqSemname pre nt con nr = semname pre nt con ++ "_" ++ show nr++-- Gives the name of a type+typeName :: NontermIdent -> Int -> String+typeName nt 0 = "T_" ++ show nt+typeName nt n = "T_" ++ show nt ++ "_" ++ show n++-- Gives the name of a visit function+visitname :: String -> NontermIdent -> Int -> String+visitname pre nt n = pre ++ getName nt ++ "_" ++ show n+-- CGrammar ----------------------------------------------------+{-+ visit 0:+ inherited attribute:+ options : Options+ synthesized attributes:+ errors : Seq Error+ output : Program+ alternatives:+ alternative CGrammar:+ child typeSyns : {TypeSyns}+ child derivings : {Derivings}+ child wrappers : {Set NontermIdent}+ child nonts : CNonterminals+ child pragmas : {PragmaMap}+ child paramMap : {ParamMap}+ child contextMap : {ContextMap}+ visit 0:+ local unfoldSemDom : _+-}+-- cata+sem_CGrammar :: CGrammar ->+ T_CGrammar+sem_CGrammar (CGrammar _typeSyns _derivings _wrappers _nonts _pragmas _paramMap _contextMap) =+ (sem_CGrammar_CGrammar _typeSyns _derivings _wrappers (sem_CNonterminals _nonts) _pragmas _paramMap _contextMap)+-- semantic domain+newtype T_CGrammar = T_CGrammar (Options ->+ ( (Seq Error),Program))+data Inh_CGrammar = Inh_CGrammar {options_Inh_CGrammar :: Options}+data Syn_CGrammar = Syn_CGrammar {errors_Syn_CGrammar :: Seq Error,output_Syn_CGrammar :: Program}+wrap_CGrammar (T_CGrammar sem) (Inh_CGrammar _lhsIoptions) =+ (let ( _lhsOerrors,_lhsOoutput) =+ (sem _lhsIoptions)+ in (Syn_CGrammar _lhsOerrors _lhsOoutput))+sem_CGrammar_CGrammar :: TypeSyns ->+ Derivings ->+ (Set NontermIdent) ->+ T_CNonterminals ->+ PragmaMap ->+ ParamMap ->+ ContextMap ->+ T_CGrammar+sem_CGrammar_CGrammar typeSyns_ derivings_ wrappers_ (T_CNonterminals nonts_) pragmas_ paramMap_ contextMap_ =+ (T_CGrammar (\ _lhsIoptions ->+ (let _nontsOo_sig :: Bool+ _nontsOo_cata :: Bool+ _nontsOo_sem :: Bool+ _nontsOo_newtypes :: Bool+ _nontsOo_unbox :: Bool+ _nontsOo_case :: Bool+ _nontsOo_pretty :: Bool+ _nontsOo_rename :: Bool+ _nontsOo_strictwrap :: Bool+ _nontsOo_splitsems :: Bool+ _nontsOo_data :: (Maybe Bool)+ _nontsOprefix :: String+ _nontsOo_traces :: Bool+ _nontsOo_costcentre :: Bool+ _nontsOo_linePragmas :: Bool+ _nontsOallPragmas :: PragmaMap+ _nontsOparamMap :: ParamMap+ _nontsOcontextMap :: ContextMap+ _nontsOwith_sig :: Bool+ _nontsOerrors :: (Seq Error)+ _lhsOoutput :: Program+ _nontsOtypeSyns :: TypeSyns+ _nontsOderivings :: Derivings+ _nontsOwrappers :: (Set NontermIdent)+ _lhsOerrors :: (Seq Error)+ _nontsOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type)+ _nontsIallTpsFound :: Bool+ _nontsIchunks :: Chunks+ _nontsIerrors :: (Seq Error)+ _nontsIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type))+ -- "GenerateCode.ag"(line 46, column 17)+ _nontsOo_sig =+ typeSigs _lhsIoptions+ -- "GenerateCode.ag"(line 46, column 17)+ _nontsOo_cata =+ folds _lhsIoptions+ -- "GenerateCode.ag"(line 46, column 17)+ _nontsOo_sem =+ semfuns _lhsIoptions+ -- "GenerateCode.ag"(line 46, column 17)+ _nontsOo_newtypes =+ newtypes _lhsIoptions+ -- "GenerateCode.ag"(line 46, column 17)+ _nontsOo_unbox =+ unbox _lhsIoptions+ -- "GenerateCode.ag"(line 46, column 17)+ _nontsOo_case =+ cases _lhsIoptions+ -- "GenerateCode.ag"(line 46, column 17)+ _nontsOo_pretty =+ attrInfo _lhsIoptions+ -- "GenerateCode.ag"(line 46, column 17)+ _nontsOo_rename =+ rename _lhsIoptions+ -- "GenerateCode.ag"(line 46, column 17)+ _nontsOo_strictwrap =+ strictWrap _lhsIoptions+ -- "GenerateCode.ag"(line 46, column 17)+ _nontsOo_splitsems =+ splitSems _lhsIoptions+ -- "GenerateCode.ag"(line 46, column 17)+ _nontsOo_data =+ if dataTypes _lhsIoptions then Just (strictData _lhsIoptions) else Nothing+ -- "GenerateCode.ag"(line 46, column 17)+ _nontsOprefix =+ prefix _lhsIoptions+ -- "GenerateCode.ag"(line 46, column 17)+ _nontsOo_traces =+ genTraces _lhsIoptions+ -- "GenerateCode.ag"(line 46, column 17)+ _nontsOo_costcentre =+ genCostCentres _lhsIoptions+ -- "GenerateCode.ag"(line 46, column 17)+ _nontsOo_linePragmas =+ genLinePragmas _lhsIoptions+ -- "GenerateCode.ag"(line 65, column 15)+ _nontsOallPragmas =+ pragmas_+ -- "GenerateCode.ag"(line 87, column 14)+ _nontsOparamMap =+ paramMap_+ -- "GenerateCode.ag"(line 108, column 7)+ _nontsOcontextMap =+ contextMap_+ -- "GenerateCode.ag"(line 597, column 7)+ _unfoldSemDom =+ \nt nr repl ->+ let (params, tp) = Map.findWithDefault (error "No such semantic domain") (nt, nr) _nontsIsemDomUnfoldGath+ replMap = Map.fromList (zip params repl)+ replace k = Map.findWithDefault k k replMap+ in evalType replace tp+ -- "GenerateCode.ag"(line 690, column 14)+ _nontsOwith_sig =+ typeSigs _lhsIoptions && _nontsIallTpsFound+ -- "GenerateCode.ag"(line 697, column 15)+ _nontsOerrors =+ Seq.empty+ -- "GenerateCode.ag"(line 761, column 17)+ _lhsOoutput =+ Program _nontsIchunks+ -- "GenerateCode.ag"(line 810, column 14)+ _nontsOtypeSyns =+ typeSyns_+ -- "GenerateCode.ag"(line 810, column 14)+ _nontsOderivings =+ derivings_+ -- "GenerateCode.ag"(line 810, column 14)+ _nontsOwrappers =+ wrappers_+ -- copy rule (up)+ _lhsOerrors =+ _nontsIerrors+ -- copy rule (from local)+ _nontsOunfoldSemDom =+ _unfoldSemDom+ ( _nontsIallTpsFound,_nontsIchunks,_nontsIerrors,_nontsIsemDomUnfoldGath) =+ (nonts_ _nontsOallPragmas _nontsOcontextMap _nontsOderivings _nontsOerrors _nontsOo_case _nontsOo_cata _nontsOo_costcentre _nontsOo_data _nontsOo_linePragmas _nontsOo_newtypes _nontsOo_pretty _nontsOo_rename _nontsOo_sem _nontsOo_sig _nontsOo_splitsems _nontsOo_strictwrap _nontsOo_traces _nontsOo_unbox _nontsOparamMap _nontsOprefix _nontsOtypeSyns _nontsOunfoldSemDom _nontsOwith_sig _nontsOwrappers)+ in ( _lhsOerrors,_lhsOoutput))))+-- CInterface --------------------------------------------------+{-+ visit 0:+ inherited attributes:+ inh : Attributes+ nt : NontermIdent+ o_case : Bool+ o_cata : Bool+ o_costcentre : Bool+ o_data : Maybe Bool+ o_linePragmas : Bool+ o_newtypes : Bool+ o_pretty : Bool+ o_rename : Bool+ o_sem : Bool+ o_sig : Bool+ o_splitsems : Bool+ o_strictwrap : Bool+ o_traces : Bool+ o_unbox : Bool+ paramMap : ParamMap+ prefix : String+ syn : Attributes+ synthesized attributes:+ comments : [String]+ semDom : [Decl]+ semDomUnfoldGath : Map (NontermIdent, Int) ([String], Code.Type)+ wrapDecls : Decls+ alternatives:+ alternative CInterface:+ child seg : CSegments+-}+-- cata+sem_CInterface :: CInterface ->+ T_CInterface+sem_CInterface (CInterface _seg) =+ (sem_CInterface_CInterface (sem_CSegments _seg))+-- semantic domain+newtype T_CInterface = T_CInterface (Attributes ->+ NontermIdent ->+ Bool ->+ Bool ->+ Bool ->+ (Maybe Bool) ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ ParamMap ->+ String ->+ Attributes ->+ ( ([String]),([Decl]),(Map (NontermIdent, Int) ([String], Code.Type)),Decls))+data Inh_CInterface = Inh_CInterface {inh_Inh_CInterface :: Attributes,nt_Inh_CInterface :: NontermIdent,o_case_Inh_CInterface :: Bool,o_cata_Inh_CInterface :: Bool,o_costcentre_Inh_CInterface :: Bool,o_data_Inh_CInterface :: Maybe Bool,o_linePragmas_Inh_CInterface :: Bool,o_newtypes_Inh_CInterface :: Bool,o_pretty_Inh_CInterface :: Bool,o_rename_Inh_CInterface :: Bool,o_sem_Inh_CInterface :: Bool,o_sig_Inh_CInterface :: Bool,o_splitsems_Inh_CInterface :: Bool,o_strictwrap_Inh_CInterface :: Bool,o_traces_Inh_CInterface :: Bool,o_unbox_Inh_CInterface :: Bool,paramMap_Inh_CInterface :: ParamMap,prefix_Inh_CInterface :: String,syn_Inh_CInterface :: Attributes}+data Syn_CInterface = Syn_CInterface {comments_Syn_CInterface :: [String],semDom_Syn_CInterface :: [Decl],semDomUnfoldGath_Syn_CInterface :: Map (NontermIdent, Int) ([String], Code.Type),wrapDecls_Syn_CInterface :: Decls}+wrap_CInterface (T_CInterface sem) (Inh_CInterface _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsIsyn) =+ (let ( _lhsOcomments,_lhsOsemDom,_lhsOsemDomUnfoldGath,_lhsOwrapDecls) =+ (sem _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsIsyn)+ in (Syn_CInterface _lhsOcomments _lhsOsemDom _lhsOsemDomUnfoldGath _lhsOwrapDecls))+sem_CInterface_CInterface :: T_CSegments ->+ T_CInterface+sem_CInterface_CInterface (T_CSegments seg_) =+ (T_CInterface (\ _lhsIinh+ _lhsInt+ _lhsIo_case+ _lhsIo_cata+ _lhsIo_costcentre+ _lhsIo_data+ _lhsIo_linePragmas+ _lhsIo_newtypes+ _lhsIo_pretty+ _lhsIo_rename+ _lhsIo_sem+ _lhsIo_sig+ _lhsIo_splitsems+ _lhsIo_strictwrap+ _lhsIo_traces+ _lhsIo_unbox+ _lhsIparamMap+ _lhsIprefix+ _lhsIsyn ->+ (let _segOnr :: Int+ _lhsOsemDom :: ([Decl])+ _lhsOcomments :: ([String])+ _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type))+ _lhsOwrapDecls :: Decls+ _segOinh :: Attributes+ _segOnt :: NontermIdent+ _segOo_case :: Bool+ _segOo_cata :: Bool+ _segOo_costcentre :: Bool+ _segOo_data :: (Maybe Bool)+ _segOo_linePragmas :: Bool+ _segOo_newtypes :: Bool+ _segOo_pretty :: Bool+ _segOo_rename :: Bool+ _segOo_sem :: Bool+ _segOo_sig :: Bool+ _segOo_splitsems :: Bool+ _segOo_strictwrap :: Bool+ _segOo_traces :: Bool+ _segOo_unbox :: Bool+ _segOparamMap :: ParamMap+ _segOprefix :: String+ _segOsyn :: Attributes+ _segIcomments :: ([String])+ _segIisNil :: Bool+ _segIsemDom :: ([Decl])+ _segIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type))+ _segIwrapDecls :: Decls+ -- "GenerateCode.ag"(line 198, column 17)+ _segOnr =+ 0+ -- "GenerateCode.ag"(line 570, column 18)+ _lhsOsemDom =+ Comment "semantic domain" : _segIsemDom+ -- use rule "GenerateCode.ag"(line 714, column 52)+ _lhsOcomments =+ _segIcomments+ -- use rule "GenerateCode.ag"(line 587, column 86)+ _lhsOsemDomUnfoldGath =+ _segIsemDomUnfoldGath+ -- use rule "GenerateCode.ag"(line 663, column 52)+ _lhsOwrapDecls =+ _segIwrapDecls+ -- copy rule (down)+ _segOinh =+ _lhsIinh+ -- copy rule (down)+ _segOnt =+ _lhsInt+ -- copy rule (down)+ _segOo_case =+ _lhsIo_case+ -- copy rule (down)+ _segOo_cata =+ _lhsIo_cata+ -- copy rule (down)+ _segOo_costcentre =+ _lhsIo_costcentre+ -- copy rule (down)+ _segOo_data =+ _lhsIo_data+ -- copy rule (down)+ _segOo_linePragmas =+ _lhsIo_linePragmas+ -- copy rule (down)+ _segOo_newtypes =+ _lhsIo_newtypes+ -- copy rule (down)+ _segOo_pretty =+ _lhsIo_pretty+ -- copy rule (down)+ _segOo_rename =+ _lhsIo_rename+ -- copy rule (down)+ _segOo_sem =+ _lhsIo_sem+ -- copy rule (down)+ _segOo_sig =+ _lhsIo_sig+ -- copy rule (down)+ _segOo_splitsems =+ _lhsIo_splitsems+ -- copy rule (down)+ _segOo_strictwrap =+ _lhsIo_strictwrap+ -- copy rule (down)+ _segOo_traces =+ _lhsIo_traces+ -- copy rule (down)+ _segOo_unbox =+ _lhsIo_unbox+ -- copy rule (down)+ _segOparamMap =+ _lhsIparamMap+ -- copy rule (down)+ _segOprefix =+ _lhsIprefix+ -- copy rule (down)+ _segOsyn =+ _lhsIsyn+ ( _segIcomments,_segIisNil,_segIsemDom,_segIsemDomUnfoldGath,_segIwrapDecls) =+ (seg_ _segOinh _segOnr _segOnt _segOo_case _segOo_cata _segOo_costcentre _segOo_data _segOo_linePragmas _segOo_newtypes _segOo_pretty _segOo_rename _segOo_sem _segOo_sig _segOo_splitsems _segOo_strictwrap _segOo_traces _segOo_unbox _segOparamMap _segOprefix _segOsyn)+ in ( _lhsOcomments,_lhsOsemDom,_lhsOsemDomUnfoldGath,_lhsOwrapDecls))))+-- CNonterminal ------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allPragmas : PragmaMap+ contextMap : ContextMap+ derivings : Derivings+ o_case : Bool+ o_cata : Bool+ o_costcentre : Bool+ o_data : Maybe Bool+ o_linePragmas : Bool+ o_newtypes : Bool+ o_pretty : Bool+ o_rename : Bool+ o_sem : Bool+ o_sig : Bool+ o_splitsems : Bool+ o_strictwrap : Bool+ o_traces : Bool+ o_unbox : Bool+ paramMap : ParamMap+ prefix : String+ typeSyns : TypeSyns+ unfoldSemDom : NontermIdent -> Int -> [String] -> Code.Type+ with_sig : Bool+ wrappers : Set NontermIdent+ chained attribute:+ errors : Seq Error+ synthesized attributes:+ allTpsFound : Bool+ chunks : Chunks+ semDomUnfoldGath : Map (NontermIdent, Int) ([String], Code.Type)+ alternatives:+ alternative CNonterminal:+ child nt : {NontermIdent}+ child params : {[Identifier]}+ child inh : {Attributes}+ child syn : {Attributes}+ child prods : CProductions+ child inter : CInterface+ visit 0:+ local _tup1 : {(Attributes,Attributes,NontermIdent)}+ local _tup2 : {(Attributes,Attributes,NontermIdent)}+ local semWrapper : _+ local comment : _+ local dataDef : _+ local cataFun : _+-}+-- cata+sem_CNonterminal :: CNonterminal ->+ T_CNonterminal+sem_CNonterminal (CNonterminal _nt _params _inh _syn _prods _inter) =+ (sem_CNonterminal_CNonterminal _nt _params _inh _syn (sem_CProductions _prods) (sem_CInterface _inter))+-- semantic domain+newtype T_CNonterminal = T_CNonterminal (PragmaMap ->+ ContextMap ->+ Derivings ->+ (Seq Error) ->+ Bool ->+ Bool ->+ Bool ->+ (Maybe Bool) ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ ParamMap ->+ String ->+ TypeSyns ->+ (NontermIdent -> Int -> [String] -> Code.Type) ->+ Bool ->+ (Set NontermIdent) ->+ ( Bool,Chunks,(Seq Error),(Map (NontermIdent, Int) ([String], Code.Type))))+data Inh_CNonterminal = Inh_CNonterminal {allPragmas_Inh_CNonterminal :: PragmaMap,contextMap_Inh_CNonterminal :: ContextMap,derivings_Inh_CNonterminal :: Derivings,errors_Inh_CNonterminal :: Seq Error,o_case_Inh_CNonterminal :: Bool,o_cata_Inh_CNonterminal :: Bool,o_costcentre_Inh_CNonterminal :: Bool,o_data_Inh_CNonterminal :: Maybe Bool,o_linePragmas_Inh_CNonterminal :: Bool,o_newtypes_Inh_CNonterminal :: Bool,o_pretty_Inh_CNonterminal :: Bool,o_rename_Inh_CNonterminal :: Bool,o_sem_Inh_CNonterminal :: Bool,o_sig_Inh_CNonterminal :: Bool,o_splitsems_Inh_CNonterminal :: Bool,o_strictwrap_Inh_CNonterminal :: Bool,o_traces_Inh_CNonterminal :: Bool,o_unbox_Inh_CNonterminal :: Bool,paramMap_Inh_CNonterminal :: ParamMap,prefix_Inh_CNonterminal :: String,typeSyns_Inh_CNonterminal :: TypeSyns,unfoldSemDom_Inh_CNonterminal :: NontermIdent -> Int -> [String] -> Code.Type,with_sig_Inh_CNonterminal :: Bool,wrappers_Inh_CNonterminal :: Set NontermIdent}+data Syn_CNonterminal = Syn_CNonterminal {allTpsFound_Syn_CNonterminal :: Bool,chunks_Syn_CNonterminal :: Chunks,errors_Syn_CNonterminal :: Seq Error,semDomUnfoldGath_Syn_CNonterminal :: Map (NontermIdent, Int) ([String], Code.Type)}+wrap_CNonterminal (T_CNonterminal sem) (Inh_CNonterminal _lhsIallPragmas _lhsIcontextMap _lhsIderivings _lhsIerrors _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsItypeSyns _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers) =+ (let ( _lhsOallTpsFound,_lhsOchunks,_lhsOerrors,_lhsOsemDomUnfoldGath) =+ (sem _lhsIallPragmas _lhsIcontextMap _lhsIderivings _lhsIerrors _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsItypeSyns _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers)+ in (Syn_CNonterminal _lhsOallTpsFound _lhsOchunks _lhsOerrors _lhsOsemDomUnfoldGath))+sem_CNonterminal_CNonterminal :: NontermIdent ->+ ([Identifier]) ->+ Attributes ->+ Attributes ->+ T_CProductions ->+ T_CInterface ->+ T_CNonterminal+sem_CNonterminal_CNonterminal nt_ params_ inh_ syn_ (T_CProductions prods_) (T_CInterface inter_) =+ (T_CNonterminal (\ _lhsIallPragmas+ _lhsIcontextMap+ _lhsIderivings+ _lhsIerrors+ _lhsIo_case+ _lhsIo_cata+ _lhsIo_costcentre+ _lhsIo_data+ _lhsIo_linePragmas+ _lhsIo_newtypes+ _lhsIo_pretty+ _lhsIo_rename+ _lhsIo_sem+ _lhsIo_sig+ _lhsIo_splitsems+ _lhsIo_strictwrap+ _lhsIo_traces+ _lhsIo_unbox+ _lhsIparamMap+ _lhsIprefix+ _lhsItypeSyns+ _lhsIunfoldSemDom+ _lhsIwith_sig+ _lhsIwrappers ->+ (let __tup1 :: ((Attributes,Attributes,NontermIdent))+ _interOinh :: Attributes+ _interOsyn :: Attributes+ _interOnt :: NontermIdent+ __tup2 :: ((Attributes,Attributes,NontermIdent))+ _prodsOinh :: Attributes+ _prodsOsyn :: Attributes+ _prodsOnt :: NontermIdent+ _lhsOchunks :: Chunks+ _lhsOallTpsFound :: Bool+ _lhsOerrors :: (Seq Error)+ _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type))+ _prodsOallPragmas :: PragmaMap+ _prodsOcontextMap :: ContextMap+ _prodsOerrors :: (Seq Error)+ _prodsOo_case :: Bool+ _prodsOo_cata :: Bool+ _prodsOo_costcentre :: Bool+ _prodsOo_data :: (Maybe Bool)+ _prodsOo_linePragmas :: Bool+ _prodsOo_newtypes :: Bool+ _prodsOo_pretty :: Bool+ _prodsOo_rename :: Bool+ _prodsOo_sem :: Bool+ _prodsOo_sig :: Bool+ _prodsOo_splitsems :: Bool+ _prodsOo_strictwrap :: Bool+ _prodsOo_traces :: Bool+ _prodsOo_unbox :: Bool+ _prodsOparamMap :: ParamMap+ _prodsOprefix :: String+ _prodsOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type)+ _prodsOwith_sig :: Bool+ _interOo_case :: Bool+ _interOo_cata :: Bool+ _interOo_costcentre :: Bool+ _interOo_data :: (Maybe Bool)+ _interOo_linePragmas :: Bool+ _interOo_newtypes :: Bool+ _interOo_pretty :: Bool+ _interOo_rename :: Bool+ _interOo_sem :: Bool+ _interOo_sig :: Bool+ _interOo_splitsems :: Bool+ _interOo_strictwrap :: Bool+ _interOo_traces :: Bool+ _interOo_unbox :: Bool+ _interOparamMap :: ParamMap+ _interOprefix :: String+ _prodsIallTpsFound :: Bool+ _prodsIcataAlts :: Decls+ _prodsIcomments :: ([String])+ _prodsIdataAlts :: DataAlts+ _prodsIdecls :: Decls+ _prodsIerrors :: (Seq Error)+ _prodsIsemNames :: ([String])+ _interIcomments :: ([String])+ _interIsemDom :: ([Decl])+ _interIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type))+ _interIwrapDecls :: Decls+ -- "GenerateCode.ag"(line 75, column 26)+ __tup1 =+ (inh_,syn_,nt_)+ -- "GenerateCode.ag"(line 75, column 26)+ (_interOinh,_,_) =+ __tup1+ -- "GenerateCode.ag"(line 75, column 26)+ (_,_interOsyn,_) =+ __tup1+ -- "GenerateCode.ag"(line 75, column 26)+ (_,_,_interOnt) =+ __tup1+ -- "GenerateCode.ag"(line 76, column 25)+ __tup2 =+ (inh_,syn_,nt_)+ -- "GenerateCode.ag"(line 76, column 25)+ (_prodsOinh,_,_) =+ __tup2+ -- "GenerateCode.ag"(line 76, column 25)+ (_,_prodsOsyn,_) =+ __tup2+ -- "GenerateCode.ag"(line 76, column 25)+ (_,_,_prodsOnt) =+ __tup2+ -- "GenerateCode.ag"(line 635, column 18)+ _semWrapper =+ let params' = map getName params_+ inhAttrs = Map.toList inh_+ synAttrs = Map.toList syn_+ inhVars = [ SimpleExpr (attrname True _LHS a) | (a,_) <- inhAttrs ]+ synVars = [ SimpleExpr (attrname False _LHS a) | (a,_) <- synAttrs ]+ var = "sem"+ wrapNT = "wrap" ++ "_" ++ getName nt_+ inhNT = "Inh" ++ "_" ++ getName nt_+ synNT = "Syn" ++ "_" ++ getName nt_+ varPat = if _lhsIo_newtypes+ then App (sdtype nt_) [SimpleExpr var]+ else SimpleExpr var+ evalTp | null params' = id+ | otherwise = idEvalType+ evalTpCommon t | null params' = t+ | otherwise = case (evalTp (SimpleType t)) of SimpleType t' -> t'+ appParams nm = TypeApp (SimpleType nm) (map SimpleType params')+ typeSig = TSig wrapNT (evalTp $ appParams (sdtype nt_) `Arr` (appParams inhNT `Arr` appParams synNT))+ mkstrict = if _lhsIo_strictwrap then (\x -> "!(" ++ x ++ ")") else id+ mkdata n attrs = Data n params' [Record n [(getName f++"_"++n,mkstrict $ evalTpCommon $ typeToHaskellString (Just nt_) params' t) | (f,t) <- attrs]] False []+ datas = [mkdata inhNT inhAttrs, mkdata synNT synAttrs]+ in datas ++ [ typeSig+ , Decl (Fun wrapNT [varPat, App inhNT inhVars])+ (Let _interIwrapDecls (App synNT synVars))+ Set.empty Set.empty+ ]+ -- "GenerateCode.ag"(line 710, column 18)+ _comment =+ Comment . unlines . map ind $ ( _interIcomments ++ ("alternatives:" : map ind _prodsIcomments) )+ -- "GenerateCode.ag"(line 764, column 19)+ _lhsOchunks =+ [ Chunk (getName nt_)+ (Comment (getName nt_ ++ " " ++ replicate (60 - length (getName nt_)) '-'))+ (if _lhsIo_pretty then [_comment ] else [])+ (if isJust _lhsIo_data then [_dataDef ] else [])+ (if _lhsIo_cata then _cataFun else [])+ (if _lhsIo_sig then _interIsemDom else [])+ (if nt_ `Set.member` _lhsIwrappers then _semWrapper else [])+ (if _lhsIo_sem then _prodsIdecls else [])+ (if _lhsIo_sem then _prodsIsemNames else [])+ ]+ -- "GenerateCode.ag"(line 815, column 18)+ _dataDef =+ let params' = map getName params_+ typeSyn tp = let theType =+ case tp of+ CommonTypes.Maybe t -> SimpleType ("Maybe (" ++ typeToHaskellString (Just nt_) params' t ++")")+ CommonTypes.List t -> Code.List $ SimpleType (typeToHaskellString (Just nt_) params' t)+ CommonTypes.Tuple ts -> Code.TupleType [SimpleType (typeToHaskellString (Just nt_) params' t)+ | (_,t) <- ts+ ]+ in Code.Type (getName nt_) params' theType+ derivings = maybe [] (map getName . Set.toList) (Map.lookup nt_ _lhsIderivings)+ dataDef = Data (getName nt_) (map getName params_) _prodsIdataAlts (maybe False id _lhsIo_data) derivings+ in maybe dataDef typeSyn $ lookup nt_ _lhsItypeSyns+ -- "GenerateCode.ag"(line 844, column 18)+ _cataFun =+ let appParams nm = TypeApp (SimpleType nm) (map SimpleType (map getName params_))+ evalTp | null params_ = id+ | otherwise = idEvalType+ tSig = TSig (cataname _lhsIprefix nt_)+ (appContext _lhsIcontextMap nt_ $ evalTp $ appParams (getName nt_) `Arr` appParams (sdtype nt_))+ special typ = case typ of+ CommonTypes.List tp ->+ let cons = SimpleExpr (semname _lhsIprefix nt_ (identifier "Cons"))+ nil = SimpleExpr (semname _lhsIprefix nt_ (identifier "Nil" ))+ arg = SimpleExpr "list"+ rarg = case tp of+ NT t _ -> SimpleExpr ("(Prelude.map " ++ (cataname _lhsIprefix t) ++ " list)")+ _ -> arg+ lhs = Fun (cataname _lhsIprefix nt_) [arg]+ rhs = (App "Prelude.foldr" [cons,nil,rarg])+ in [Decl lhs rhs Set.empty Set.empty]+ CommonTypes.Maybe tp ->+ let just = semname _lhsIprefix nt_ (identifier "Just")+ nothing = semname _lhsIprefix nt_ (identifier "Nothing" )+ arg = SimpleExpr "x"+ rarg = case tp of+ NT t _ -> App (cataname _lhsIprefix t) [arg]+ _ -> arg+ lhs a = Fun (cataname _lhsIprefix nt_) [a]+ in [Decl (lhs (App "Prelude.Just" [arg])) (App just [rarg]) Set.empty Set.empty+ ,Decl (lhs (SimpleExpr "Prelude.Nothing")) (SimpleExpr nothing) Set.empty Set.empty+ ]+ CommonTypes.Tuple tps ->+ let con = semname _lhsIprefix nt_ (identifier "Tuple")+ tps' = [ (SimpleExpr (getName x),y) | (x,y) <- tps]+ rargs = map rarg tps'+ rarg (n, tp) = case tp of+ NT t _ -> App (cataname _lhsIprefix t) [n]+ _ -> n+ lhs = Fun (cataname _lhsIprefix nt_) [TupleExpr (map fst tps')]+ rhs = App con rargs+ in [Decl lhs rhs Set.empty Set.empty]+ in Comment "cata" :+ (if _lhsIo_sig then [tSig] else []) +++ maybe _prodsIcataAlts special (lookup nt_ _lhsItypeSyns)+ -- use rule "GenerateCode.ag"(line 682, column 39)+ _lhsOallTpsFound =+ _prodsIallTpsFound+ -- use rule "GenerateCode.ag"(line 695, column 32)+ _lhsOerrors =+ _prodsIerrors+ -- use rule "GenerateCode.ag"(line 587, column 86)+ _lhsOsemDomUnfoldGath =+ _interIsemDomUnfoldGath+ -- copy rule (down)+ _prodsOallPragmas =+ _lhsIallPragmas+ -- copy rule (down)+ _prodsOcontextMap =+ _lhsIcontextMap+ -- copy rule (down)+ _prodsOerrors =+ _lhsIerrors+ -- copy rule (down)+ _prodsOo_case =+ _lhsIo_case+ -- copy rule (down)+ _prodsOo_cata =+ _lhsIo_cata+ -- copy rule (down)+ _prodsOo_costcentre =+ _lhsIo_costcentre+ -- copy rule (down)+ _prodsOo_data =+ _lhsIo_data+ -- copy rule (down)+ _prodsOo_linePragmas =+ _lhsIo_linePragmas+ -- copy rule (down)+ _prodsOo_newtypes =+ _lhsIo_newtypes+ -- copy rule (down)+ _prodsOo_pretty =+ _lhsIo_pretty+ -- copy rule (down)+ _prodsOo_rename =+ _lhsIo_rename+ -- copy rule (down)+ _prodsOo_sem =+ _lhsIo_sem+ -- copy rule (down)+ _prodsOo_sig =+ _lhsIo_sig+ -- copy rule (down)+ _prodsOo_splitsems =+ _lhsIo_splitsems+ -- copy rule (down)+ _prodsOo_strictwrap =+ _lhsIo_strictwrap+ -- copy rule (down)+ _prodsOo_traces =+ _lhsIo_traces+ -- copy rule (down)+ _prodsOo_unbox =+ _lhsIo_unbox+ -- copy rule (down)+ _prodsOparamMap =+ _lhsIparamMap+ -- copy rule (down)+ _prodsOprefix =+ _lhsIprefix+ -- copy rule (down)+ _prodsOunfoldSemDom =+ _lhsIunfoldSemDom+ -- copy rule (down)+ _prodsOwith_sig =+ _lhsIwith_sig+ -- copy rule (down)+ _interOo_case =+ _lhsIo_case+ -- copy rule (down)+ _interOo_cata =+ _lhsIo_cata+ -- copy rule (down)+ _interOo_costcentre =+ _lhsIo_costcentre+ -- copy rule (down)+ _interOo_data =+ _lhsIo_data+ -- copy rule (down)+ _interOo_linePragmas =+ _lhsIo_linePragmas+ -- copy rule (down)+ _interOo_newtypes =+ _lhsIo_newtypes+ -- copy rule (down)+ _interOo_pretty =+ _lhsIo_pretty+ -- copy rule (down)+ _interOo_rename =+ _lhsIo_rename+ -- copy rule (down)+ _interOo_sem =+ _lhsIo_sem+ -- copy rule (down)+ _interOo_sig =+ _lhsIo_sig+ -- copy rule (down)+ _interOo_splitsems =+ _lhsIo_splitsems+ -- copy rule (down)+ _interOo_strictwrap =+ _lhsIo_strictwrap+ -- copy rule (down)+ _interOo_traces =+ _lhsIo_traces+ -- copy rule (down)+ _interOo_unbox =+ _lhsIo_unbox+ -- copy rule (down)+ _interOparamMap =+ _lhsIparamMap+ -- copy rule (down)+ _interOprefix =+ _lhsIprefix+ ( _prodsIallTpsFound,_prodsIcataAlts,_prodsIcomments,_prodsIdataAlts,_prodsIdecls,_prodsIerrors,_prodsIsemNames) =+ (prods_ _prodsOallPragmas _prodsOcontextMap _prodsOerrors _prodsOinh _prodsOnt _prodsOo_case _prodsOo_cata _prodsOo_costcentre _prodsOo_data _prodsOo_linePragmas _prodsOo_newtypes _prodsOo_pretty _prodsOo_rename _prodsOo_sem _prodsOo_sig _prodsOo_splitsems _prodsOo_strictwrap _prodsOo_traces _prodsOo_unbox _prodsOparamMap _prodsOprefix _prodsOsyn _prodsOunfoldSemDom _prodsOwith_sig)+ ( _interIcomments,_interIsemDom,_interIsemDomUnfoldGath,_interIwrapDecls) =+ (inter_ _interOinh _interOnt _interOo_case _interOo_cata _interOo_costcentre _interOo_data _interOo_linePragmas _interOo_newtypes _interOo_pretty _interOo_rename _interOo_sem _interOo_sig _interOo_splitsems _interOo_strictwrap _interOo_traces _interOo_unbox _interOparamMap _interOprefix _interOsyn)+ in ( _lhsOallTpsFound,_lhsOchunks,_lhsOerrors,_lhsOsemDomUnfoldGath))))+-- CNonterminals -----------------------------------------------+{-+ visit 0:+ inherited attributes:+ allPragmas : PragmaMap+ contextMap : ContextMap+ derivings : Derivings+ o_case : Bool+ o_cata : Bool+ o_costcentre : Bool+ o_data : Maybe Bool+ o_linePragmas : Bool+ o_newtypes : Bool+ o_pretty : Bool+ o_rename : Bool+ o_sem : Bool+ o_sig : Bool+ o_splitsems : Bool+ o_strictwrap : Bool+ o_traces : Bool+ o_unbox : Bool+ paramMap : ParamMap+ prefix : String+ typeSyns : TypeSyns+ unfoldSemDom : NontermIdent -> Int -> [String] -> Code.Type+ with_sig : Bool+ wrappers : Set NontermIdent+ chained attribute:+ errors : Seq Error+ synthesized attributes:+ allTpsFound : Bool+ chunks : Chunks+ semDomUnfoldGath : Map (NontermIdent, Int) ([String], Code.Type)+ alternatives:+ alternative Cons:+ child hd : CNonterminal+ child tl : CNonterminals+ alternative Nil:+-}+-- cata+sem_CNonterminals :: CNonterminals ->+ T_CNonterminals+sem_CNonterminals list =+ (Prelude.foldr sem_CNonterminals_Cons sem_CNonterminals_Nil (Prelude.map sem_CNonterminal list))+-- semantic domain+newtype T_CNonterminals = T_CNonterminals (PragmaMap ->+ ContextMap ->+ Derivings ->+ (Seq Error) ->+ Bool ->+ Bool ->+ Bool ->+ (Maybe Bool) ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ ParamMap ->+ String ->+ TypeSyns ->+ (NontermIdent -> Int -> [String] -> Code.Type) ->+ Bool ->+ (Set NontermIdent) ->+ ( Bool,Chunks,(Seq Error),(Map (NontermIdent, Int) ([String], Code.Type))))+data Inh_CNonterminals = Inh_CNonterminals {allPragmas_Inh_CNonterminals :: PragmaMap,contextMap_Inh_CNonterminals :: ContextMap,derivings_Inh_CNonterminals :: Derivings,errors_Inh_CNonterminals :: Seq Error,o_case_Inh_CNonterminals :: Bool,o_cata_Inh_CNonterminals :: Bool,o_costcentre_Inh_CNonterminals :: Bool,o_data_Inh_CNonterminals :: Maybe Bool,o_linePragmas_Inh_CNonterminals :: Bool,o_newtypes_Inh_CNonterminals :: Bool,o_pretty_Inh_CNonterminals :: Bool,o_rename_Inh_CNonterminals :: Bool,o_sem_Inh_CNonterminals :: Bool,o_sig_Inh_CNonterminals :: Bool,o_splitsems_Inh_CNonterminals :: Bool,o_strictwrap_Inh_CNonterminals :: Bool,o_traces_Inh_CNonterminals :: Bool,o_unbox_Inh_CNonterminals :: Bool,paramMap_Inh_CNonterminals :: ParamMap,prefix_Inh_CNonterminals :: String,typeSyns_Inh_CNonterminals :: TypeSyns,unfoldSemDom_Inh_CNonterminals :: NontermIdent -> Int -> [String] -> Code.Type,with_sig_Inh_CNonterminals :: Bool,wrappers_Inh_CNonterminals :: Set NontermIdent}+data Syn_CNonterminals = Syn_CNonterminals {allTpsFound_Syn_CNonterminals :: Bool,chunks_Syn_CNonterminals :: Chunks,errors_Syn_CNonterminals :: Seq Error,semDomUnfoldGath_Syn_CNonterminals :: Map (NontermIdent, Int) ([String], Code.Type)}+wrap_CNonterminals (T_CNonterminals sem) (Inh_CNonterminals _lhsIallPragmas _lhsIcontextMap _lhsIderivings _lhsIerrors _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsItypeSyns _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers) =+ (let ( _lhsOallTpsFound,_lhsOchunks,_lhsOerrors,_lhsOsemDomUnfoldGath) =+ (sem _lhsIallPragmas _lhsIcontextMap _lhsIderivings _lhsIerrors _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsItypeSyns _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers)+ in (Syn_CNonterminals _lhsOallTpsFound _lhsOchunks _lhsOerrors _lhsOsemDomUnfoldGath))+sem_CNonterminals_Cons :: T_CNonterminal ->+ T_CNonterminals ->+ T_CNonterminals+sem_CNonterminals_Cons (T_CNonterminal hd_) (T_CNonterminals tl_) =+ (T_CNonterminals (\ _lhsIallPragmas+ _lhsIcontextMap+ _lhsIderivings+ _lhsIerrors+ _lhsIo_case+ _lhsIo_cata+ _lhsIo_costcentre+ _lhsIo_data+ _lhsIo_linePragmas+ _lhsIo_newtypes+ _lhsIo_pretty+ _lhsIo_rename+ _lhsIo_sem+ _lhsIo_sig+ _lhsIo_splitsems+ _lhsIo_strictwrap+ _lhsIo_traces+ _lhsIo_unbox+ _lhsIparamMap+ _lhsIprefix+ _lhsItypeSyns+ _lhsIunfoldSemDom+ _lhsIwith_sig+ _lhsIwrappers ->+ (let _lhsOallTpsFound :: Bool+ _lhsOchunks :: Chunks+ _lhsOerrors :: (Seq Error)+ _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type))+ _hdOallPragmas :: PragmaMap+ _hdOcontextMap :: ContextMap+ _hdOderivings :: Derivings+ _hdOerrors :: (Seq Error)+ _hdOo_case :: Bool+ _hdOo_cata :: Bool+ _hdOo_costcentre :: Bool+ _hdOo_data :: (Maybe Bool)+ _hdOo_linePragmas :: Bool+ _hdOo_newtypes :: Bool+ _hdOo_pretty :: Bool+ _hdOo_rename :: Bool+ _hdOo_sem :: Bool+ _hdOo_sig :: Bool+ _hdOo_splitsems :: Bool+ _hdOo_strictwrap :: Bool+ _hdOo_traces :: Bool+ _hdOo_unbox :: Bool+ _hdOparamMap :: ParamMap+ _hdOprefix :: String+ _hdOtypeSyns :: TypeSyns+ _hdOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type)+ _hdOwith_sig :: Bool+ _hdOwrappers :: (Set NontermIdent)+ _tlOallPragmas :: PragmaMap+ _tlOcontextMap :: ContextMap+ _tlOderivings :: Derivings+ _tlOerrors :: (Seq Error)+ _tlOo_case :: Bool+ _tlOo_cata :: Bool+ _tlOo_costcentre :: Bool+ _tlOo_data :: (Maybe Bool)+ _tlOo_linePragmas :: Bool+ _tlOo_newtypes :: Bool+ _tlOo_pretty :: Bool+ _tlOo_rename :: Bool+ _tlOo_sem :: Bool+ _tlOo_sig :: Bool+ _tlOo_splitsems :: Bool+ _tlOo_strictwrap :: Bool+ _tlOo_traces :: Bool+ _tlOo_unbox :: Bool+ _tlOparamMap :: ParamMap+ _tlOprefix :: String+ _tlOtypeSyns :: TypeSyns+ _tlOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type)+ _tlOwith_sig :: Bool+ _tlOwrappers :: (Set NontermIdent)+ _hdIallTpsFound :: Bool+ _hdIchunks :: Chunks+ _hdIerrors :: (Seq Error)+ _hdIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type))+ _tlIallTpsFound :: Bool+ _tlIchunks :: Chunks+ _tlIerrors :: (Seq Error)+ _tlIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type))+ -- use rule "GenerateCode.ag"(line 682, column 39)+ _lhsOallTpsFound =+ _hdIallTpsFound && _tlIallTpsFound+ -- use rule "GenerateCode.ag"(line 756, column 49)+ _lhsOchunks =+ _hdIchunks ++ _tlIchunks+ -- use rule "GenerateCode.ag"(line 695, column 32)+ _lhsOerrors =+ _hdIerrors Seq.<> _tlIerrors+ -- use rule "GenerateCode.ag"(line 587, column 86)+ _lhsOsemDomUnfoldGath =+ _hdIsemDomUnfoldGath `Map.union` _tlIsemDomUnfoldGath+ -- copy rule (down)+ _hdOallPragmas =+ _lhsIallPragmas+ -- copy rule (down)+ _hdOcontextMap =+ _lhsIcontextMap+ -- copy rule (down)+ _hdOderivings =+ _lhsIderivings+ -- copy rule (down)+ _hdOerrors =+ _lhsIerrors+ -- copy rule (down)+ _hdOo_case =+ _lhsIo_case+ -- copy rule (down)+ _hdOo_cata =+ _lhsIo_cata+ -- copy rule (down)+ _hdOo_costcentre =+ _lhsIo_costcentre+ -- copy rule (down)+ _hdOo_data =+ _lhsIo_data+ -- copy rule (down)+ _hdOo_linePragmas =+ _lhsIo_linePragmas+ -- copy rule (down)+ _hdOo_newtypes =+ _lhsIo_newtypes+ -- copy rule (down)+ _hdOo_pretty =+ _lhsIo_pretty+ -- copy rule (down)+ _hdOo_rename =+ _lhsIo_rename+ -- copy rule (down)+ _hdOo_sem =+ _lhsIo_sem+ -- copy rule (down)+ _hdOo_sig =+ _lhsIo_sig+ -- copy rule (down)+ _hdOo_splitsems =+ _lhsIo_splitsems+ -- copy rule (down)+ _hdOo_strictwrap =+ _lhsIo_strictwrap+ -- copy rule (down)+ _hdOo_traces =+ _lhsIo_traces+ -- copy rule (down)+ _hdOo_unbox =+ _lhsIo_unbox+ -- copy rule (down)+ _hdOparamMap =+ _lhsIparamMap+ -- copy rule (down)+ _hdOprefix =+ _lhsIprefix+ -- copy rule (down)+ _hdOtypeSyns =+ _lhsItypeSyns+ -- copy rule (down)+ _hdOunfoldSemDom =+ _lhsIunfoldSemDom+ -- copy rule (down)+ _hdOwith_sig =+ _lhsIwith_sig+ -- copy rule (down)+ _hdOwrappers =+ _lhsIwrappers+ -- copy rule (down)+ _tlOallPragmas =+ _lhsIallPragmas+ -- copy rule (down)+ _tlOcontextMap =+ _lhsIcontextMap+ -- copy rule (down)+ _tlOderivings =+ _lhsIderivings+ -- copy rule (chain)+ _tlOerrors =+ _hdIerrors+ -- copy rule (down)+ _tlOo_case =+ _lhsIo_case+ -- copy rule (down)+ _tlOo_cata =+ _lhsIo_cata+ -- copy rule (down)+ _tlOo_costcentre =+ _lhsIo_costcentre+ -- copy rule (down)+ _tlOo_data =+ _lhsIo_data+ -- copy rule (down)+ _tlOo_linePragmas =+ _lhsIo_linePragmas+ -- copy rule (down)+ _tlOo_newtypes =+ _lhsIo_newtypes+ -- copy rule (down)+ _tlOo_pretty =+ _lhsIo_pretty+ -- copy rule (down)+ _tlOo_rename =+ _lhsIo_rename+ -- copy rule (down)+ _tlOo_sem =+ _lhsIo_sem+ -- copy rule (down)+ _tlOo_sig =+ _lhsIo_sig+ -- copy rule (down)+ _tlOo_splitsems =+ _lhsIo_splitsems+ -- copy rule (down)+ _tlOo_strictwrap =+ _lhsIo_strictwrap+ -- copy rule (down)+ _tlOo_traces =+ _lhsIo_traces+ -- copy rule (down)+ _tlOo_unbox =+ _lhsIo_unbox+ -- copy rule (down)+ _tlOparamMap =+ _lhsIparamMap+ -- copy rule (down)+ _tlOprefix =+ _lhsIprefix+ -- copy rule (down)+ _tlOtypeSyns =+ _lhsItypeSyns+ -- copy rule (down)+ _tlOunfoldSemDom =+ _lhsIunfoldSemDom+ -- copy rule (down)+ _tlOwith_sig =+ _lhsIwith_sig+ -- copy rule (down)+ _tlOwrappers =+ _lhsIwrappers+ ( _hdIallTpsFound,_hdIchunks,_hdIerrors,_hdIsemDomUnfoldGath) =+ (hd_ _hdOallPragmas _hdOcontextMap _hdOderivings _hdOerrors _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOparamMap _hdOprefix _hdOtypeSyns _hdOunfoldSemDom _hdOwith_sig _hdOwrappers)+ ( _tlIallTpsFound,_tlIchunks,_tlIerrors,_tlIsemDomUnfoldGath) =+ (tl_ _tlOallPragmas _tlOcontextMap _tlOderivings _tlOerrors _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOparamMap _tlOprefix _tlOtypeSyns _tlOunfoldSemDom _tlOwith_sig _tlOwrappers)+ in ( _lhsOallTpsFound,_lhsOchunks,_lhsOerrors,_lhsOsemDomUnfoldGath))))+sem_CNonterminals_Nil :: T_CNonterminals+sem_CNonterminals_Nil =+ (T_CNonterminals (\ _lhsIallPragmas+ _lhsIcontextMap+ _lhsIderivings+ _lhsIerrors+ _lhsIo_case+ _lhsIo_cata+ _lhsIo_costcentre+ _lhsIo_data+ _lhsIo_linePragmas+ _lhsIo_newtypes+ _lhsIo_pretty+ _lhsIo_rename+ _lhsIo_sem+ _lhsIo_sig+ _lhsIo_splitsems+ _lhsIo_strictwrap+ _lhsIo_traces+ _lhsIo_unbox+ _lhsIparamMap+ _lhsIprefix+ _lhsItypeSyns+ _lhsIunfoldSemDom+ _lhsIwith_sig+ _lhsIwrappers ->+ (let _lhsOallTpsFound :: Bool+ _lhsOchunks :: Chunks+ _lhsOerrors :: (Seq Error)+ _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type))+ -- use rule "GenerateCode.ag"(line 682, column 39)+ _lhsOallTpsFound =+ True+ -- use rule "GenerateCode.ag"(line 756, column 49)+ _lhsOchunks =+ []+ -- use rule "GenerateCode.ag"(line 695, column 32)+ _lhsOerrors =+ Seq.empty+ -- use rule "GenerateCode.ag"(line 587, column 86)+ _lhsOsemDomUnfoldGath =+ Map.empty+ in ( _lhsOallTpsFound,_lhsOchunks,_lhsOerrors,_lhsOsemDomUnfoldGath))))+-- CProduction -------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allPragmas : PragmaMap+ contextMap : ContextMap+ inh : Attributes+ nt : NontermIdent+ o_case : Bool+ o_cata : Bool+ o_costcentre : Bool+ o_data : Maybe Bool+ o_linePragmas : Bool+ o_newtypes : Bool+ o_pretty : Bool+ o_rename : Bool+ o_sem : Bool+ o_sig : Bool+ o_splitsems : Bool+ o_strictwrap : Bool+ o_traces : Bool+ o_unbox : Bool+ paramMap : ParamMap+ prefix : String+ syn : Attributes+ unfoldSemDom : NontermIdent -> Int -> [String] -> Code.Type+ with_sig : Bool+ chained attribute:+ errors : Seq Error+ synthesized attributes:+ allTpsFound : Bool+ cataAlt : Decl+ comments : [String]+ dataAlt : DataAlt+ decls : Decls+ semNames : [String]+ alternatives:+ alternative CProduction:+ child con : {ConstructorIdent}+ child visits : CVisits+ child children : {[(Identifier,Type,Bool)]}+ child terminals : {[Identifier]}+ visit 0:+ local paramInstMap : _+ local firstOrderChildren : _+ local params : _+-}+-- cata+sem_CProduction :: CProduction ->+ T_CProduction+sem_CProduction (CProduction _con _visits _children _terminals) =+ (sem_CProduction_CProduction _con (sem_CVisits _visits) _children _terminals)+-- semantic domain+newtype T_CProduction = T_CProduction (PragmaMap ->+ ContextMap ->+ (Seq Error) ->+ Attributes ->+ NontermIdent ->+ Bool ->+ Bool ->+ Bool ->+ (Maybe Bool) ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ ParamMap ->+ String ->+ Attributes ->+ (NontermIdent -> Int -> [String] -> Code.Type) ->+ Bool ->+ ( Bool,Decl,([String]),DataAlt,Decls,(Seq Error),([String])))+data Inh_CProduction = Inh_CProduction {allPragmas_Inh_CProduction :: PragmaMap,contextMap_Inh_CProduction :: ContextMap,errors_Inh_CProduction :: Seq Error,inh_Inh_CProduction :: Attributes,nt_Inh_CProduction :: NontermIdent,o_case_Inh_CProduction :: Bool,o_cata_Inh_CProduction :: Bool,o_costcentre_Inh_CProduction :: Bool,o_data_Inh_CProduction :: Maybe Bool,o_linePragmas_Inh_CProduction :: Bool,o_newtypes_Inh_CProduction :: Bool,o_pretty_Inh_CProduction :: Bool,o_rename_Inh_CProduction :: Bool,o_sem_Inh_CProduction :: Bool,o_sig_Inh_CProduction :: Bool,o_splitsems_Inh_CProduction :: Bool,o_strictwrap_Inh_CProduction :: Bool,o_traces_Inh_CProduction :: Bool,o_unbox_Inh_CProduction :: Bool,paramMap_Inh_CProduction :: ParamMap,prefix_Inh_CProduction :: String,syn_Inh_CProduction :: Attributes,unfoldSemDom_Inh_CProduction :: NontermIdent -> Int -> [String] -> Code.Type,with_sig_Inh_CProduction :: Bool}+data Syn_CProduction = Syn_CProduction {allTpsFound_Syn_CProduction :: Bool,cataAlt_Syn_CProduction :: Decl,comments_Syn_CProduction :: [String],dataAlt_Syn_CProduction :: DataAlt,decls_Syn_CProduction :: Decls,errors_Syn_CProduction :: Seq Error,semNames_Syn_CProduction :: [String]}+wrap_CProduction (T_CProduction sem) (Inh_CProduction _lhsIallPragmas _lhsIcontextMap _lhsIerrors _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIunfoldSemDom _lhsIwith_sig) =+ (let ( _lhsOallTpsFound,_lhsOcataAlt,_lhsOcomments,_lhsOdataAlt,_lhsOdecls,_lhsOerrors,_lhsOsemNames) =+ (sem _lhsIallPragmas _lhsIcontextMap _lhsIerrors _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIunfoldSemDom _lhsIwith_sig)+ in (Syn_CProduction _lhsOallTpsFound _lhsOcataAlt _lhsOcomments _lhsOdataAlt _lhsOdecls _lhsOerrors _lhsOsemNames))+sem_CProduction_CProduction :: ConstructorIdent ->+ T_CVisits ->+ ([(Identifier,Type,Bool)]) ->+ ([Identifier]) ->+ T_CProduction+sem_CProduction_CProduction con_ (T_CVisits visits_) children_ terminals_ =+ (T_CProduction (\ _lhsIallPragmas+ _lhsIcontextMap+ _lhsIerrors+ _lhsIinh+ _lhsInt+ _lhsIo_case+ _lhsIo_cata+ _lhsIo_costcentre+ _lhsIo_data+ _lhsIo_linePragmas+ _lhsIo_newtypes+ _lhsIo_pretty+ _lhsIo_rename+ _lhsIo_sem+ _lhsIo_sig+ _lhsIo_splitsems+ _lhsIo_strictwrap+ _lhsIo_traces+ _lhsIo_unbox+ _lhsIparamMap+ _lhsIprefix+ _lhsIsyn+ _lhsIunfoldSemDom+ _lhsIwith_sig ->+ (let _visitsOcon :: ConstructorIdent+ _visitsOterminals :: ([Identifier])+ _visitsOnr :: Int+ _visitsOchildren :: ([(Identifier,Type,Bool)])+ _visitsOinstVisitNrs :: (Map Identifier Int)+ _lhsOcomments :: ([String])+ _lhsOdataAlt :: DataAlt+ _lhsOcataAlt :: Decl+ _lhsOallTpsFound :: Bool+ _lhsOdecls :: Decls+ _lhsOerrors :: (Seq Error)+ _lhsOsemNames :: ([String])+ _visitsOallPragmas :: PragmaMap+ _visitsOcontextMap :: ContextMap+ _visitsOerrors :: (Seq Error)+ _visitsOinh :: Attributes+ _visitsOnt :: NontermIdent+ _visitsOo_case :: Bool+ _visitsOo_cata :: Bool+ _visitsOo_costcentre :: Bool+ _visitsOo_data :: (Maybe Bool)+ _visitsOo_linePragmas :: Bool+ _visitsOo_newtypes :: Bool+ _visitsOo_pretty :: Bool+ _visitsOo_rename :: Bool+ _visitsOo_sem :: Bool+ _visitsOo_sig :: Bool+ _visitsOo_splitsems :: Bool+ _visitsOo_strictwrap :: Bool+ _visitsOo_traces :: Bool+ _visitsOo_unbox :: Bool+ _visitsOparamInstMap :: (Map Identifier (NontermIdent, [String]))+ _visitsOparamMap :: ParamMap+ _visitsOprefix :: String+ _visitsOsyn :: Attributes+ _visitsOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type)+ _visitsOwith_sig :: Bool+ _visitsIallTpsFound :: Bool+ _visitsIcomments :: ([String])+ _visitsIdecls :: Decls+ _visitsIerrors :: (Seq Error)+ _visitsIgatherInstVisitNrs :: (Map Identifier Int)+ _visitsIintra :: Exprs+ _visitsIintraVars :: (Set String)+ _visitsIisNil :: Bool+ _visitsIsemNames :: ([String])+ -- "GenerateCode.ag"(line 81, column 19)+ _visitsOcon =+ con_+ -- "GenerateCode.ag"(line 82, column 20)+ _visitsOterminals =+ terminals_+ -- "GenerateCode.ag"(line 94, column 7)+ _paramInstMap =+ Map.fromList [(nm, (extractNonterminal tp, tps)) | (nm,tp,_) <- children_, let tps = map cleanupArg $ nontermArgs tp, not (null tps) ]+ -- "GenerateCode.ag"(line 194, column 18)+ _visitsOnr =+ 0+ -- "GenerateCode.ag"(line 316, column 18)+ _visitsOchildren =+ children_+ -- "GenerateCode.ag"(line 426, column 7)+ _visitsOinstVisitNrs =+ _visitsIgatherInstVisitNrs+ -- "GenerateCode.ag"(line 725, column 17)+ _firstOrderChildren =+ filter (\(_,_,ho) -> not ho) children_+ -- "GenerateCode.ag"(line 726, column 18)+ _lhsOcomments =+ ("alternative " ++ getName con_ ++ ":")+ : map ind ( map (\(x,y,_) -> makeLocalComment 14 "child" x (Just y)) _firstOrderChildren+ ++ _visitsIcomments+ )+ -- "GenerateCode.ag"(line 836, column 17)+ _params =+ map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap+ -- "GenerateCode.ag"(line 837, column 17)+ _lhsOdataAlt =+ DataAlt (conname _lhsIo_rename _lhsInt con_) (map (\(_,t,_) -> typeToHaskellString (Just _lhsInt) _params t) _firstOrderChildren )+ -- "GenerateCode.ag"(line 895, column 17)+ _lhsOcataAlt =+ let lhs = Fun (cataname _lhsIprefix _lhsInt) [lhs_pat]+ lhs_pat = App (conname _lhsIo_rename _lhsInt con_)+ (map (\(n,_,_) -> SimpleExpr $ locname $ n) _firstOrderChildren )+ rhs = App (semname _lhsIprefix _lhsInt con_)+ (map argument _firstOrderChildren )+ argument (nm,NT tp _,_) = App (cataname _lhsIprefix tp)+ [SimpleExpr (locname nm)]+ argument (nm, _,_) = SimpleExpr (locname nm)+ in Decl lhs rhs Set.empty Set.empty+ -- use rule "GenerateCode.ag"(line 682, column 39)+ _lhsOallTpsFound =+ _visitsIallTpsFound+ -- use rule "GenerateCode.ag"(line 757, column 44)+ _lhsOdecls =+ _visitsIdecls+ -- use rule "GenerateCode.ag"(line 695, column 32)+ _lhsOerrors =+ _visitsIerrors+ -- use rule "GenerateCode.ag"(line 910, column 61)+ _lhsOsemNames =+ _visitsIsemNames+ -- copy rule (down)+ _visitsOallPragmas =+ _lhsIallPragmas+ -- copy rule (down)+ _visitsOcontextMap =+ _lhsIcontextMap+ -- copy rule (down)+ _visitsOerrors =+ _lhsIerrors+ -- copy rule (down)+ _visitsOinh =+ _lhsIinh+ -- copy rule (down)+ _visitsOnt =+ _lhsInt+ -- copy rule (down)+ _visitsOo_case =+ _lhsIo_case+ -- copy rule (down)+ _visitsOo_cata =+ _lhsIo_cata+ -- copy rule (down)+ _visitsOo_costcentre =+ _lhsIo_costcentre+ -- copy rule (down)+ _visitsOo_data =+ _lhsIo_data+ -- copy rule (down)+ _visitsOo_linePragmas =+ _lhsIo_linePragmas+ -- copy rule (down)+ _visitsOo_newtypes =+ _lhsIo_newtypes+ -- copy rule (down)+ _visitsOo_pretty =+ _lhsIo_pretty+ -- copy rule (down)+ _visitsOo_rename =+ _lhsIo_rename+ -- copy rule (down)+ _visitsOo_sem =+ _lhsIo_sem+ -- copy rule (down)+ _visitsOo_sig =+ _lhsIo_sig+ -- copy rule (down)+ _visitsOo_splitsems =+ _lhsIo_splitsems+ -- copy rule (down)+ _visitsOo_strictwrap =+ _lhsIo_strictwrap+ -- copy rule (down)+ _visitsOo_traces =+ _lhsIo_traces+ -- copy rule (down)+ _visitsOo_unbox =+ _lhsIo_unbox+ -- copy rule (from local)+ _visitsOparamInstMap =+ _paramInstMap+ -- copy rule (down)+ _visitsOparamMap =+ _lhsIparamMap+ -- copy rule (down)+ _visitsOprefix =+ _lhsIprefix+ -- copy rule (down)+ _visitsOsyn =+ _lhsIsyn+ -- copy rule (down)+ _visitsOunfoldSemDom =+ _lhsIunfoldSemDom+ -- copy rule (down)+ _visitsOwith_sig =+ _lhsIwith_sig+ ( _visitsIallTpsFound,_visitsIcomments,_visitsIdecls,_visitsIerrors,_visitsIgatherInstVisitNrs,_visitsIintra,_visitsIintraVars,_visitsIisNil,_visitsIsemNames) =+ (visits_ _visitsOallPragmas _visitsOchildren _visitsOcon _visitsOcontextMap _visitsOerrors _visitsOinh _visitsOinstVisitNrs _visitsOnr _visitsOnt _visitsOo_case _visitsOo_cata _visitsOo_costcentre _visitsOo_data _visitsOo_linePragmas _visitsOo_newtypes _visitsOo_pretty _visitsOo_rename _visitsOo_sem _visitsOo_sig _visitsOo_splitsems _visitsOo_strictwrap _visitsOo_traces _visitsOo_unbox _visitsOparamInstMap _visitsOparamMap _visitsOprefix _visitsOsyn _visitsOterminals _visitsOunfoldSemDom _visitsOwith_sig)+ in ( _lhsOallTpsFound,_lhsOcataAlt,_lhsOcomments,_lhsOdataAlt,_lhsOdecls,_lhsOerrors,_lhsOsemNames))))+-- CProductions ------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allPragmas : PragmaMap+ contextMap : ContextMap+ inh : Attributes+ nt : NontermIdent+ o_case : Bool+ o_cata : Bool+ o_costcentre : Bool+ o_data : Maybe Bool+ o_linePragmas : Bool+ o_newtypes : Bool+ o_pretty : Bool+ o_rename : Bool+ o_sem : Bool+ o_sig : Bool+ o_splitsems : Bool+ o_strictwrap : Bool+ o_traces : Bool+ o_unbox : Bool+ paramMap : ParamMap+ prefix : String+ syn : Attributes+ unfoldSemDom : NontermIdent -> Int -> [String] -> Code.Type+ with_sig : Bool+ chained attribute:+ errors : Seq Error+ synthesized attributes:+ allTpsFound : Bool+ cataAlts : Decls+ comments : [String]+ dataAlts : DataAlts+ decls : Decls+ semNames : [String]+ alternatives:+ alternative Cons:+ child hd : CProduction+ child tl : CProductions+ alternative Nil:+-}+-- cata+sem_CProductions :: CProductions ->+ T_CProductions+sem_CProductions list =+ (Prelude.foldr sem_CProductions_Cons sem_CProductions_Nil (Prelude.map sem_CProduction list))+-- semantic domain+newtype T_CProductions = T_CProductions (PragmaMap ->+ ContextMap ->+ (Seq Error) ->+ Attributes ->+ NontermIdent ->+ Bool ->+ Bool ->+ Bool ->+ (Maybe Bool) ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ ParamMap ->+ String ->+ Attributes ->+ (NontermIdent -> Int -> [String] -> Code.Type) ->+ Bool ->+ ( Bool,Decls,([String]),DataAlts,Decls,(Seq Error),([String])))+data Inh_CProductions = Inh_CProductions {allPragmas_Inh_CProductions :: PragmaMap,contextMap_Inh_CProductions :: ContextMap,errors_Inh_CProductions :: Seq Error,inh_Inh_CProductions :: Attributes,nt_Inh_CProductions :: NontermIdent,o_case_Inh_CProductions :: Bool,o_cata_Inh_CProductions :: Bool,o_costcentre_Inh_CProductions :: Bool,o_data_Inh_CProductions :: Maybe Bool,o_linePragmas_Inh_CProductions :: Bool,o_newtypes_Inh_CProductions :: Bool,o_pretty_Inh_CProductions :: Bool,o_rename_Inh_CProductions :: Bool,o_sem_Inh_CProductions :: Bool,o_sig_Inh_CProductions :: Bool,o_splitsems_Inh_CProductions :: Bool,o_strictwrap_Inh_CProductions :: Bool,o_traces_Inh_CProductions :: Bool,o_unbox_Inh_CProductions :: Bool,paramMap_Inh_CProductions :: ParamMap,prefix_Inh_CProductions :: String,syn_Inh_CProductions :: Attributes,unfoldSemDom_Inh_CProductions :: NontermIdent -> Int -> [String] -> Code.Type,with_sig_Inh_CProductions :: Bool}+data Syn_CProductions = Syn_CProductions {allTpsFound_Syn_CProductions :: Bool,cataAlts_Syn_CProductions :: Decls,comments_Syn_CProductions :: [String],dataAlts_Syn_CProductions :: DataAlts,decls_Syn_CProductions :: Decls,errors_Syn_CProductions :: Seq Error,semNames_Syn_CProductions :: [String]}+wrap_CProductions (T_CProductions sem) (Inh_CProductions _lhsIallPragmas _lhsIcontextMap _lhsIerrors _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIunfoldSemDom _lhsIwith_sig) =+ (let ( _lhsOallTpsFound,_lhsOcataAlts,_lhsOcomments,_lhsOdataAlts,_lhsOdecls,_lhsOerrors,_lhsOsemNames) =+ (sem _lhsIallPragmas _lhsIcontextMap _lhsIerrors _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIunfoldSemDom _lhsIwith_sig)+ in (Syn_CProductions _lhsOallTpsFound _lhsOcataAlts _lhsOcomments _lhsOdataAlts _lhsOdecls _lhsOerrors _lhsOsemNames))+sem_CProductions_Cons :: T_CProduction ->+ T_CProductions ->+ T_CProductions+sem_CProductions_Cons (T_CProduction hd_) (T_CProductions tl_) =+ (T_CProductions (\ _lhsIallPragmas+ _lhsIcontextMap+ _lhsIerrors+ _lhsIinh+ _lhsInt+ _lhsIo_case+ _lhsIo_cata+ _lhsIo_costcentre+ _lhsIo_data+ _lhsIo_linePragmas+ _lhsIo_newtypes+ _lhsIo_pretty+ _lhsIo_rename+ _lhsIo_sem+ _lhsIo_sig+ _lhsIo_splitsems+ _lhsIo_strictwrap+ _lhsIo_traces+ _lhsIo_unbox+ _lhsIparamMap+ _lhsIprefix+ _lhsIsyn+ _lhsIunfoldSemDom+ _lhsIwith_sig ->+ (let _lhsOdataAlts :: DataAlts+ _lhsOcataAlts :: Decls+ _lhsOallTpsFound :: Bool+ _lhsOcomments :: ([String])+ _lhsOdecls :: Decls+ _lhsOerrors :: (Seq Error)+ _lhsOsemNames :: ([String])+ _hdOallPragmas :: PragmaMap+ _hdOcontextMap :: ContextMap+ _hdOerrors :: (Seq Error)+ _hdOinh :: Attributes+ _hdOnt :: NontermIdent+ _hdOo_case :: Bool+ _hdOo_cata :: Bool+ _hdOo_costcentre :: Bool+ _hdOo_data :: (Maybe Bool)+ _hdOo_linePragmas :: Bool+ _hdOo_newtypes :: Bool+ _hdOo_pretty :: Bool+ _hdOo_rename :: Bool+ _hdOo_sem :: Bool+ _hdOo_sig :: Bool+ _hdOo_splitsems :: Bool+ _hdOo_strictwrap :: Bool+ _hdOo_traces :: Bool+ _hdOo_unbox :: Bool+ _hdOparamMap :: ParamMap+ _hdOprefix :: String+ _hdOsyn :: Attributes+ _hdOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type)+ _hdOwith_sig :: Bool+ _tlOallPragmas :: PragmaMap+ _tlOcontextMap :: ContextMap+ _tlOerrors :: (Seq Error)+ _tlOinh :: Attributes+ _tlOnt :: NontermIdent+ _tlOo_case :: Bool+ _tlOo_cata :: Bool+ _tlOo_costcentre :: Bool+ _tlOo_data :: (Maybe Bool)+ _tlOo_linePragmas :: Bool+ _tlOo_newtypes :: Bool+ _tlOo_pretty :: Bool+ _tlOo_rename :: Bool+ _tlOo_sem :: Bool+ _tlOo_sig :: Bool+ _tlOo_splitsems :: Bool+ _tlOo_strictwrap :: Bool+ _tlOo_traces :: Bool+ _tlOo_unbox :: Bool+ _tlOparamMap :: ParamMap+ _tlOprefix :: String+ _tlOsyn :: Attributes+ _tlOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type)+ _tlOwith_sig :: Bool+ _hdIallTpsFound :: Bool+ _hdIcataAlt :: Decl+ _hdIcomments :: ([String])+ _hdIdataAlt :: DataAlt+ _hdIdecls :: Decls+ _hdIerrors :: (Seq Error)+ _hdIsemNames :: ([String])+ _tlIallTpsFound :: Bool+ _tlIcataAlts :: Decls+ _tlIcomments :: ([String])+ _tlIdataAlts :: DataAlts+ _tlIdecls :: Decls+ _tlIerrors :: (Seq Error)+ _tlIsemNames :: ([String])+ -- "GenerateCode.ag"(line 832, column 17)+ _lhsOdataAlts =+ _hdIdataAlt : _tlIdataAlts+ -- "GenerateCode.ag"(line 891, column 10)+ _lhsOcataAlts =+ _hdIcataAlt : _tlIcataAlts+ -- use rule "GenerateCode.ag"(line 682, column 39)+ _lhsOallTpsFound =+ _hdIallTpsFound && _tlIallTpsFound+ -- use rule "GenerateCode.ag"(line 714, column 52)+ _lhsOcomments =+ _hdIcomments ++ _tlIcomments+ -- use rule "GenerateCode.ag"(line 757, column 44)+ _lhsOdecls =+ _hdIdecls ++ _tlIdecls+ -- use rule "GenerateCode.ag"(line 695, column 32)+ _lhsOerrors =+ _hdIerrors Seq.<> _tlIerrors+ -- use rule "GenerateCode.ag"(line 910, column 61)+ _lhsOsemNames =+ _hdIsemNames ++ _tlIsemNames+ -- copy rule (down)+ _hdOallPragmas =+ _lhsIallPragmas+ -- copy rule (down)+ _hdOcontextMap =+ _lhsIcontextMap+ -- copy rule (down)+ _hdOerrors =+ _lhsIerrors+ -- copy rule (down)+ _hdOinh =+ _lhsIinh+ -- copy rule (down)+ _hdOnt =+ _lhsInt+ -- copy rule (down)+ _hdOo_case =+ _lhsIo_case+ -- copy rule (down)+ _hdOo_cata =+ _lhsIo_cata+ -- copy rule (down)+ _hdOo_costcentre =+ _lhsIo_costcentre+ -- copy rule (down)+ _hdOo_data =+ _lhsIo_data+ -- copy rule (down)+ _hdOo_linePragmas =+ _lhsIo_linePragmas+ -- copy rule (down)+ _hdOo_newtypes =+ _lhsIo_newtypes+ -- copy rule (down)+ _hdOo_pretty =+ _lhsIo_pretty+ -- copy rule (down)+ _hdOo_rename =+ _lhsIo_rename+ -- copy rule (down)+ _hdOo_sem =+ _lhsIo_sem+ -- copy rule (down)+ _hdOo_sig =+ _lhsIo_sig+ -- copy rule (down)+ _hdOo_splitsems =+ _lhsIo_splitsems+ -- copy rule (down)+ _hdOo_strictwrap =+ _lhsIo_strictwrap+ -- copy rule (down)+ _hdOo_traces =+ _lhsIo_traces+ -- copy rule (down)+ _hdOo_unbox =+ _lhsIo_unbox+ -- copy rule (down)+ _hdOparamMap =+ _lhsIparamMap+ -- copy rule (down)+ _hdOprefix =+ _lhsIprefix+ -- copy rule (down)+ _hdOsyn =+ _lhsIsyn+ -- copy rule (down)+ _hdOunfoldSemDom =+ _lhsIunfoldSemDom+ -- copy rule (down)+ _hdOwith_sig =+ _lhsIwith_sig+ -- copy rule (down)+ _tlOallPragmas =+ _lhsIallPragmas+ -- copy rule (down)+ _tlOcontextMap =+ _lhsIcontextMap+ -- copy rule (chain)+ _tlOerrors =+ _hdIerrors+ -- copy rule (down)+ _tlOinh =+ _lhsIinh+ -- copy rule (down)+ _tlOnt =+ _lhsInt+ -- copy rule (down)+ _tlOo_case =+ _lhsIo_case+ -- copy rule (down)+ _tlOo_cata =+ _lhsIo_cata+ -- copy rule (down)+ _tlOo_costcentre =+ _lhsIo_costcentre+ -- copy rule (down)+ _tlOo_data =+ _lhsIo_data+ -- copy rule (down)+ _tlOo_linePragmas =+ _lhsIo_linePragmas+ -- copy rule (down)+ _tlOo_newtypes =+ _lhsIo_newtypes+ -- copy rule (down)+ _tlOo_pretty =+ _lhsIo_pretty+ -- copy rule (down)+ _tlOo_rename =+ _lhsIo_rename+ -- copy rule (down)+ _tlOo_sem =+ _lhsIo_sem+ -- copy rule (down)+ _tlOo_sig =+ _lhsIo_sig+ -- copy rule (down)+ _tlOo_splitsems =+ _lhsIo_splitsems+ -- copy rule (down)+ _tlOo_strictwrap =+ _lhsIo_strictwrap+ -- copy rule (down)+ _tlOo_traces =+ _lhsIo_traces+ -- copy rule (down)+ _tlOo_unbox =+ _lhsIo_unbox+ -- copy rule (down)+ _tlOparamMap =+ _lhsIparamMap+ -- copy rule (down)+ _tlOprefix =+ _lhsIprefix+ -- copy rule (down)+ _tlOsyn =+ _lhsIsyn+ -- copy rule (down)+ _tlOunfoldSemDom =+ _lhsIunfoldSemDom+ -- copy rule (down)+ _tlOwith_sig =+ _lhsIwith_sig+ ( _hdIallTpsFound,_hdIcataAlt,_hdIcomments,_hdIdataAlt,_hdIdecls,_hdIerrors,_hdIsemNames) =+ (hd_ _hdOallPragmas _hdOcontextMap _hdOerrors _hdOinh _hdOnt _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOparamMap _hdOprefix _hdOsyn _hdOunfoldSemDom _hdOwith_sig)+ ( _tlIallTpsFound,_tlIcataAlts,_tlIcomments,_tlIdataAlts,_tlIdecls,_tlIerrors,_tlIsemNames) =+ (tl_ _tlOallPragmas _tlOcontextMap _tlOerrors _tlOinh _tlOnt _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOparamMap _tlOprefix _tlOsyn _tlOunfoldSemDom _tlOwith_sig)+ in ( _lhsOallTpsFound,_lhsOcataAlts,_lhsOcomments,_lhsOdataAlts,_lhsOdecls,_lhsOerrors,_lhsOsemNames))))+sem_CProductions_Nil :: T_CProductions+sem_CProductions_Nil =+ (T_CProductions (\ _lhsIallPragmas+ _lhsIcontextMap+ _lhsIerrors+ _lhsIinh+ _lhsInt+ _lhsIo_case+ _lhsIo_cata+ _lhsIo_costcentre+ _lhsIo_data+ _lhsIo_linePragmas+ _lhsIo_newtypes+ _lhsIo_pretty+ _lhsIo_rename+ _lhsIo_sem+ _lhsIo_sig+ _lhsIo_splitsems+ _lhsIo_strictwrap+ _lhsIo_traces+ _lhsIo_unbox+ _lhsIparamMap+ _lhsIprefix+ _lhsIsyn+ _lhsIunfoldSemDom+ _lhsIwith_sig ->+ (let _lhsOdataAlts :: DataAlts+ _lhsOcataAlts :: Decls+ _lhsOallTpsFound :: Bool+ _lhsOcomments :: ([String])+ _lhsOdecls :: Decls+ _lhsOerrors :: (Seq Error)+ _lhsOsemNames :: ([String])+ -- "GenerateCode.ag"(line 833, column 17)+ _lhsOdataAlts =+ []+ -- "GenerateCode.ag"(line 892, column 10)+ _lhsOcataAlts =+ []+ -- use rule "GenerateCode.ag"(line 682, column 39)+ _lhsOallTpsFound =+ True+ -- use rule "GenerateCode.ag"(line 714, column 52)+ _lhsOcomments =+ []+ -- use rule "GenerateCode.ag"(line 757, column 44)+ _lhsOdecls =+ []+ -- use rule "GenerateCode.ag"(line 695, column 32)+ _lhsOerrors =+ Seq.empty+ -- use rule "GenerateCode.ag"(line 910, column 61)+ _lhsOsemNames =+ []+ in ( _lhsOallTpsFound,_lhsOcataAlts,_lhsOcomments,_lhsOdataAlts,_lhsOdecls,_lhsOerrors,_lhsOsemNames))))+-- CRule -------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ children : [(Identifier,Type,Bool)]+ con : ConstructorIdent+ higherOrderChildren : [(Identifier,Type,Bool)]+ inh : Attributes+ instVisitNrs : Map Identifier Int+ nr : Int+ nt : NontermIdent+ o_case : Bool+ o_cata : Bool+ o_costcentre : Bool+ o_data : Maybe Bool+ o_linePragmas : Bool+ o_newtypes : Bool+ o_pretty : Bool+ o_rename : Bool+ o_sem : Bool+ o_sig : Bool+ o_splitsems : Bool+ o_strictwrap : Bool+ o_traces : Bool+ o_unbox : Bool+ paramInstMap : Map Identifier (NontermIdent, [String])+ paramMap : ParamMap+ prefix : String+ syn : Attributes+ terminals : [Identifier]+ what : String+ chained attributes:+ declsAbove : [Decl]+ errors : Seq Error+ synthesized attributes:+ allTpsFound : Bool+ bldBlocksFun : DeclBlocks -> DeclBlocks+ comments : [String]+ decls : Decls+ definedInsts : [Identifier]+ exprs : Exprs+ tSigs : [Decl]+ tps : [Type]+ usedVars : Set String+ alternatives:+ alternative CChildVisit:+ child name : {Identifier}+ child nt : {NontermIdent}+ child nr : {Int}+ child inh : {Attributes}+ child syn : {Attributes}+ child isLast : {Bool}+ visit 0:+ local costCentreDescr : _+ local addCostCentre : _+ local decls : _+ local isSuperfluousHigherOrderIntra : _+ local names : _+ local mkTp : _+ local definedTps : _+ local nextTp : _+ local orgParams : _+ local instParams : _+ local replParamMap : _+ local replace : _+ local evalTp : _+ alternative CRule:+ child name : {Identifier}+ child isIn : {Bool}+ child hasCode : {Bool}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child field : {Identifier}+ child childnt : {Maybe NontermIdent}+ child tp : {Maybe Type}+ child pattern : Pattern+ child rhs : {[String]}+ child defines : {Map Int (Identifier,Identifier,Maybe Type)}+ child owrt : {Bool}+ child origin : {String}+ child uses : {Set (Identifier, Identifier)}+ visit 0:+ local instTypes : _+ local originComment : _+ local instDecls : _+ local patDescr : _+ local traceDescr : _+ local addTrace : _+ local costCentreDescr : _+ local addCostCentre : _+ local addLinePragma : _+ local decls : _+ local definedInsts : _+ local name : _+ local mkTp : _+ local orgParams : _+ local evalTp : _+ local _tup3 : {([Type],Bool)}+-}+-- cata+sem_CRule :: CRule ->+ T_CRule+sem_CRule (CChildVisit _name _nt _nr _inh _syn _isLast) =+ (sem_CRule_CChildVisit _name _nt _nr _inh _syn _isLast)+sem_CRule (CRule _name _isIn _hasCode _nt _con _field _childnt _tp _pattern _rhs _defines _owrt _origin _uses) =+ (sem_CRule_CRule _name _isIn _hasCode _nt _con _field _childnt _tp (sem_Pattern _pattern) _rhs _defines _owrt _origin _uses)+-- semantic domain+newtype T_CRule = T_CRule (([(Identifier,Type,Bool)]) ->+ ConstructorIdent ->+ ([Decl]) ->+ (Seq Error) ->+ ([(Identifier,Type,Bool)]) ->+ Attributes ->+ (Map Identifier Int) ->+ Int ->+ NontermIdent ->+ Bool ->+ Bool ->+ Bool ->+ (Maybe Bool) ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ (Map Identifier (NontermIdent, [String])) ->+ ParamMap ->+ String ->+ Attributes ->+ ([Identifier]) ->+ String ->+ ( Bool,(DeclBlocks -> DeclBlocks),([String]),Decls,([Decl]),([Identifier]),(Seq Error),Exprs,([Decl]),([Type]),(Set String)))+data Inh_CRule = Inh_CRule {children_Inh_CRule :: [(Identifier,Type,Bool)],con_Inh_CRule :: ConstructorIdent,declsAbove_Inh_CRule :: [Decl],errors_Inh_CRule :: Seq Error,higherOrderChildren_Inh_CRule :: [(Identifier,Type,Bool)],inh_Inh_CRule :: Attributes,instVisitNrs_Inh_CRule :: Map Identifier Int,nr_Inh_CRule :: Int,nt_Inh_CRule :: NontermIdent,o_case_Inh_CRule :: Bool,o_cata_Inh_CRule :: Bool,o_costcentre_Inh_CRule :: Bool,o_data_Inh_CRule :: Maybe Bool,o_linePragmas_Inh_CRule :: Bool,o_newtypes_Inh_CRule :: Bool,o_pretty_Inh_CRule :: Bool,o_rename_Inh_CRule :: Bool,o_sem_Inh_CRule :: Bool,o_sig_Inh_CRule :: Bool,o_splitsems_Inh_CRule :: Bool,o_strictwrap_Inh_CRule :: Bool,o_traces_Inh_CRule :: Bool,o_unbox_Inh_CRule :: Bool,paramInstMap_Inh_CRule :: Map Identifier (NontermIdent, [String]),paramMap_Inh_CRule :: ParamMap,prefix_Inh_CRule :: String,syn_Inh_CRule :: Attributes,terminals_Inh_CRule :: [Identifier],what_Inh_CRule :: String}+data Syn_CRule = Syn_CRule {allTpsFound_Syn_CRule :: Bool,bldBlocksFun_Syn_CRule :: DeclBlocks -> DeclBlocks,comments_Syn_CRule :: [String],decls_Syn_CRule :: Decls,declsAbove_Syn_CRule :: [Decl],definedInsts_Syn_CRule :: [Identifier],errors_Syn_CRule :: Seq Error,exprs_Syn_CRule :: Exprs,tSigs_Syn_CRule :: [Decl],tps_Syn_CRule :: [Type],usedVars_Syn_CRule :: Set String}+wrap_CRule (T_CRule sem) (Inh_CRule _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIerrors _lhsIhigherOrderChildren _lhsIinh _lhsIinstVisitNrs _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIwhat) =+ (let ( _lhsOallTpsFound,_lhsObldBlocksFun,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOerrors,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars) =+ (sem _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIerrors _lhsIhigherOrderChildren _lhsIinh _lhsIinstVisitNrs _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIwhat)+ in (Syn_CRule _lhsOallTpsFound _lhsObldBlocksFun _lhsOcomments _lhsOdecls _lhsOdeclsAbove _lhsOdefinedInsts _lhsOerrors _lhsOexprs _lhsOtSigs _lhsOtps _lhsOusedVars))+sem_CRule_CChildVisit :: Identifier ->+ NontermIdent ->+ Int ->+ Attributes ->+ Attributes ->+ Bool ->+ T_CRule+sem_CRule_CChildVisit name_ nt_ nr_ inh_ syn_ isLast_ =+ (T_CRule (\ _lhsIchildren+ _lhsIcon+ _lhsIdeclsAbove+ _lhsIerrors+ _lhsIhigherOrderChildren+ _lhsIinh+ _lhsIinstVisitNrs+ _lhsInr+ _lhsInt+ _lhsIo_case+ _lhsIo_cata+ _lhsIo_costcentre+ _lhsIo_data+ _lhsIo_linePragmas+ _lhsIo_newtypes+ _lhsIo_pretty+ _lhsIo_rename+ _lhsIo_sem+ _lhsIo_sig+ _lhsIo_splitsems+ _lhsIo_strictwrap+ _lhsIo_traces+ _lhsIo_unbox+ _lhsIparamInstMap+ _lhsIparamMap+ _lhsIprefix+ _lhsIsyn+ _lhsIterminals+ _lhsIwhat ->+ (let _lhsOexprs :: Exprs+ _lhsOusedVars :: (Set String)+ _lhsOtSigs :: ([Decl])+ _lhsOtps :: ([Type])+ _lhsOdeclsAbove :: ([Decl])+ _lhsObldBlocksFun :: (DeclBlocks -> DeclBlocks)+ _lhsOallTpsFound :: Bool+ _lhsOcomments :: ([String])+ _lhsOdecls :: Decls+ _lhsOdefinedInsts :: ([Identifier])+ _lhsOerrors :: (Seq Error)+ -- "GenerateCode.ag"(line 161, column 18)+ _costCentreDescr =+ show _lhsInt ++ ":" ++ show _lhsIcon ++ ":" ++ show name_ ++ ":" ++ show nt_ ++ ":" ++ show nr_+ -- "GenerateCode.ag"(line 162, column 18)+ _addCostCentre =+ \v -> if _lhsIo_costcentre+ then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v+ else v+ -- "GenerateCode.ag"(line 165, column 18)+ _decls =+ let lhsVars = map (attrname True name_) (Map.keys syn_)+ ++ if isLast_ then [] else [unwrap ++ funname name_ (nr_+1)]+ rhsVars = map (attrname False name_) (Map.keys inh_)+ unwrap = if _lhsIo_newtypes then typeName nt_ (nr_ + 1) ++ " " else ""+ tuple = mkTupleLhs _lhsIo_unbox (null $ Map.keys inh_) lhsVars+ rhs = _addCostCentre $ App (funname name_ nr_) (map SimpleExpr rhsVars)+ in [Decl tuple rhs (Set.fromList lhsVars) (Set.fromList (funname name_ nr_ : rhsVars))]+ -- "GenerateCode.ag"(line 241, column 7)+ _isSuperfluousHigherOrderIntra =+ _lhsInr <= Map.findWithDefault (-1) name_ _lhsIinstVisitNrs+ -- "GenerateCode.ag"(line 255, column 8)+ _names =+ if _isSuperfluousHigherOrderIntra+ then []+ else [funname name_ (nr_+1)]+ -- "GenerateCode.ag"(line 259, column 8)+ _lhsOexprs =+ let wrap = if _lhsIo_newtypes then \x -> App (typeName nt_ (nr_ + 1)) [x] else id+ in map (wrap . SimpleExpr) _names+ -- "GenerateCode.ag"(line 267, column 7)+ _lhsOusedVars =+ Set.fromList _names+ -- "GenerateCode.ag"(line 291, column 19)+ _mkTp =+ _evalTp . SimpleType . typeToHaskellString (Just nt_) _orgParams+ -- "GenerateCode.ag"(line 292, column 19)+ _definedTps =+ [ TSig (attrname True name_ a) (_mkTp tp) | (a,tp) <- Map.toList syn_ ]+ -- "GenerateCode.ag"(line 293, column 19)+ _nextTp =+ typeName nt_ (nr_+1)+ -- "GenerateCode.ag"(line 294, column 19)+ _lhsOtSigs =+ (if isLast_ then id else (TSig (funname name_ (nr_+1)) (TypeApp (SimpleType _nextTp) (map SimpleType _instParams )) :)) _definedTps+ -- "GenerateCode.ag"(line 296, column 19)+ _orgParams =+ map getName $ Map.findWithDefault [] nt_ _lhsIparamMap+ -- "GenerateCode.ag"(line 297, column 19)+ _instParams =+ snd $ Map.findWithDefault (nt_,[]) name_ _lhsIparamInstMap+ -- "GenerateCode.ag"(line 298, column 19)+ _replParamMap =+ Map.fromList (zip _orgParams _instParams )+ -- "GenerateCode.ag"(line 299, column 19)+ _replace =+ \k -> Map.findWithDefault k k _replParamMap+ -- "GenerateCode.ag"(line 300, column 19)+ _evalTp =+ if null _orgParams then id else evalType _replace+ -- "GenerateCode.ag"(line 323, column 19)+ _lhsOtps =+ if _isSuperfluousHigherOrderIntra+ then []+ else [Haskell _nextTp]+ -- "GenerateCode.ag"(line 448, column 7)+ _lhsOdeclsAbove =+ []+ -- "GenerateCode.ag"(line 461, column 7)+ _lhsObldBlocksFun =+ DeclBlock _lhsIdeclsAbove (head _decls )+ -- use rule "GenerateCode.ag"(line 320, column 39)+ _lhsOallTpsFound =+ True+ -- use rule "GenerateCode.ag"(line 714, column 52)+ _lhsOcomments =+ []+ -- use rule "GenerateCode.ag"(line 122, column 34)+ _lhsOdecls =+ _decls+ -- use rule "GenerateCode.ag"(line 175, column 55)+ _lhsOdefinedInsts =+ []+ -- use rule "GenerateCode.ag"(line 695, column 32)+ _lhsOerrors =+ Seq.empty+ in ( _lhsOallTpsFound,_lhsObldBlocksFun,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOerrors,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars))))+sem_CRule_CRule :: Identifier ->+ Bool ->+ Bool ->+ NontermIdent ->+ ConstructorIdent ->+ Identifier ->+ (Maybe NontermIdent) ->+ (Maybe Type) ->+ T_Pattern ->+ ([String]) ->+ (Map Int (Identifier,Identifier,Maybe Type)) ->+ Bool ->+ String ->+ (Set (Identifier, Identifier)) ->+ T_CRule+sem_CRule_CRule name_ isIn_ hasCode_ nt_ con_ field_ childnt_ tp_ (T_Pattern pattern_) rhs_ defines_ owrt_ origin_ uses_ =+ (T_CRule (\ _lhsIchildren+ _lhsIcon+ _lhsIdeclsAbove+ _lhsIerrors+ _lhsIhigherOrderChildren+ _lhsIinh+ _lhsIinstVisitNrs+ _lhsInr+ _lhsInt+ _lhsIo_case+ _lhsIo_cata+ _lhsIo_costcentre+ _lhsIo_data+ _lhsIo_linePragmas+ _lhsIo_newtypes+ _lhsIo_pretty+ _lhsIo_rename+ _lhsIo_sem+ _lhsIo_sig+ _lhsIo_splitsems+ _lhsIo_strictwrap+ _lhsIo_traces+ _lhsIo_unbox+ _lhsIparamInstMap+ _lhsIparamMap+ _lhsIprefix+ _lhsIsyn+ _lhsIterminals+ _lhsIwhat ->+ (let _lhsOexprs :: Exprs+ _lhsOusedVars :: (Set String)+ _lhsOtSigs :: ([Decl])+ __tup3 :: (([Type],Bool))+ _lhsOtps :: ([Type])+ _lhsOallTpsFound :: Bool+ _lhsOdeclsAbove :: ([Decl])+ _lhsObldBlocksFun :: (DeclBlocks -> DeclBlocks)+ _lhsOerrors :: (Seq Error)+ _lhsOcomments :: ([String])+ _lhsOdecls :: Decls+ _lhsOdefinedInsts :: ([Identifier])+ _patternIcopy :: Pattern+ _patternIdefinedInsts :: ([Identifier])+ _patternIpatternAttributes :: ([(Identifier, Identifier)])+ -- "GenerateCode.ag"(line 124, column 12)+ _instTypes =+ map (\(n,NT t _,_) -> (n,t)) _lhsIhigherOrderChildren+ -- "GenerateCode.ag"(line 125, column 12)+ _originComment =+ if _lhsIo_pretty+ then (Comment origin_:)+ else id+ -- "GenerateCode.ag"(line 128, column 12)+ _instDecls =+ [ Decl (Pattern3 (Alias _INST' inst (Underscore (getPos inst)) []))+ (App (cataname _lhsIprefix (fromJust $ inst `lookup` _instTypes ))+ [SimpleExpr instLocFieldName])+ (Set.singleton instSemFieldName)+ (Set.singleton instLocFieldName)+ | inst <- _definedInsts+ , let instLocFieldName = attrname True _INST inst+ , let instSemFieldName = attrname False _INST' inst ]+ -- "GenerateCode.ag"(line 136, column 12)+ _patDescr =+ if isIn_+ then "_"+ else concat $ intersperse "," (map (\(f,a) -> show f ++ "." ++ show a) _patternIpatternAttributes)+ -- "GenerateCode.ag"(line 139, column 12)+ _traceDescr =+ show nt_ ++ " :: " ++ show con_ ++ " :: " ++ _patDescr+ -- "GenerateCode.ag"(line 141, column 12)+ _addTrace =+ \v -> if _lhsIo_traces+ then Trace _traceDescr v+ else v+ -- "GenerateCode.ag"(line 144, column 12)+ _costCentreDescr =+ show nt_ ++ ":" ++ show con_ ++ ":" ++ _patDescr+ -- "GenerateCode.ag"(line 145, column 12)+ _addCostCentre =+ \v -> if _lhsIo_costcentre+ then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v+ else v+ -- "GenerateCode.ag"(line 148, column 12)+ _addLinePragma =+ \v -> let p = getPos name_+ hasPos = line p > 0 && column p >= 0 && not (null (file p))+ in if _lhsIo_linePragmas && hasPos+ then PragmaExpr True True ("LINE " ++ show (line p) ++ " " ++ show (file p))+ $ LineExpr+ $ v+ else v+ -- "GenerateCode.ag"(line 155, column 12)+ _decls =+ if hasCode_+ then _originComment ( Decl (Pattern3 _patternIcopy) (_addTrace $ _addCostCentre $ _addLinePragma $ (TextExpr rhs_))+ (Set.fromList [attrname False fld nm | (fld,nm,_) <- Map.elems defines_])+ (Set.fromList [attrname True fld nm | (fld,nm) <- Set.toList uses_])+ : _instDecls )+ else _instDecls+ -- "GenerateCode.ag"(line 180, column 12)+ _definedInsts =+ if isIn_ then [] else _patternIdefinedInsts+ -- "GenerateCode.ag"(line 250, column 12)+ _name =+ if field_ == _LOC && name_ `elem` _lhsIterminals+ then funname name_ 0+ else attrname isIn_ field_ name_+ -- "GenerateCode.ag"(line 253, column 12)+ _lhsOexprs =+ [SimpleExpr _name ]+ -- "GenerateCode.ag"(line 265, column 7)+ _lhsOusedVars =+ Set.singleton _name+ -- "GenerateCode.ag"(line 275, column 19)+ _mkTp =+ SimpleType . typeToHaskellString (Just _lhsInt) _orgParams+ -- "GenerateCode.ag"(line 276, column 19)+ _lhsOtSigs =+ [ TSig (attrname False field attr) (_evalTp field $ _mkTp (fromJust tp))+ | (field,attr,tp) <- Map.elems defines_, isJust tp ]+ -- "GenerateCode.ag"(line 279, column 19)+ _orgParams =+ map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap+ -- "GenerateCode.ag"(line 280, column 19)+ _evalTp =+ \field tp -> let orgFldParams = map getName $ Map.findWithDefault [] childNt _lhsIparamMap+ (childNt,instParams) = Map.findWithDefault (_lhsInt,[]) field _lhsIparamInstMap+ replMap = Map.fromList (zip orgFldParams instParams)+ replace k = Map.findWithDefault k k replMap+ in if null instParams+ then if null _orgParams+ then tp+ else idEvalType tp+ else evalType replace tp+ -- "GenerateCode.ag"(line 322, column 23)+ __tup3 =+ maybe ([],False) (\tp -> ([substSelf (fromJust childnt_) tp],True)) tp_+ -- "GenerateCode.ag"(line 322, column 23)+ (_lhsOtps,_) =+ __tup3+ -- "GenerateCode.ag"(line 322, column 23)+ (_,_lhsOallTpsFound) =+ __tup3+ -- "GenerateCode.ag"(line 446, column 7)+ _lhsOdeclsAbove =+ _lhsIdeclsAbove ++ _decls+ -- "GenerateCode.ag"(line 459, column 7)+ _lhsObldBlocksFun =+ id+ -- "GenerateCode.ag"(line 701, column 12)+ _lhsOerrors =+ let nameOf (Alias _ _ _ pats@(_:_)) = Ident (show (map (\(Alias _ a _ _)->a) pats)) (getPos name_)+ nameOf _ = name_+ in maybe (Seq.single (MissingTypeSig _lhsInt _lhsIcon (nameOf _patternIcopy))) (const Seq.empty) tp_+ -- "GenerateCode.ag"(line 741, column 18)+ _lhsOcomments =+ [ makeLocalComment 11 _lhsIwhat name tp | (field,name,tp) <- Map.elems defines_, field == _LOC ]+ ++ [ makeLocalComment 11 "inst " name tp | (field,name,tp) <- Map.elems defines_, field == _INST ]+ -- use rule "GenerateCode.ag"(line 122, column 34)+ _lhsOdecls =+ _decls+ -- use rule "GenerateCode.ag"(line 175, column 55)+ _lhsOdefinedInsts =+ _definedInsts+ ( _patternIcopy,_patternIdefinedInsts,_patternIpatternAttributes) =+ (pattern_ )+ in ( _lhsOallTpsFound,_lhsObldBlocksFun,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOerrors,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars))))+-- CSegment ----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ inh : Attributes+ isLast : Bool+ nr : Int+ nt : NontermIdent+ o_case : Bool+ o_cata : Bool+ o_costcentre : Bool+ o_data : Maybe Bool+ o_linePragmas : Bool+ o_newtypes : Bool+ o_pretty : Bool+ o_rename : Bool+ o_sem : Bool+ o_sig : Bool+ o_splitsems : Bool+ o_strictwrap : Bool+ o_traces : Bool+ o_unbox : Bool+ paramMap : ParamMap+ prefix : String+ syn : Attributes+ synthesized attributes:+ comments : [String]+ semDom : [Decl]+ semDomUnfoldGath : Map (NontermIdent, Int) ([String], Code.Type)+ wrapDecls : Decls+ alternatives:+ alternative CSegment:+ child inh : {Attributes}+ child syn : {Attributes}+ visit 0:+ local tp : _+ local inhTps : _+ local synTps : _+ local continuation : _+ local params : _+-}+-- cata+sem_CSegment :: CSegment ->+ T_CSegment+sem_CSegment (CSegment _inh _syn) =+ (sem_CSegment_CSegment _inh _syn)+-- semantic domain+newtype T_CSegment = T_CSegment (Attributes ->+ Bool ->+ Int ->+ NontermIdent ->+ Bool ->+ Bool ->+ Bool ->+ (Maybe Bool) ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ ParamMap ->+ String ->+ Attributes ->+ ( ([String]),([Decl]),(Map (NontermIdent, Int) ([String], Code.Type)),Decls))+data Inh_CSegment = Inh_CSegment {inh_Inh_CSegment :: Attributes,isLast_Inh_CSegment :: Bool,nr_Inh_CSegment :: Int,nt_Inh_CSegment :: NontermIdent,o_case_Inh_CSegment :: Bool,o_cata_Inh_CSegment :: Bool,o_costcentre_Inh_CSegment :: Bool,o_data_Inh_CSegment :: Maybe Bool,o_linePragmas_Inh_CSegment :: Bool,o_newtypes_Inh_CSegment :: Bool,o_pretty_Inh_CSegment :: Bool,o_rename_Inh_CSegment :: Bool,o_sem_Inh_CSegment :: Bool,o_sig_Inh_CSegment :: Bool,o_splitsems_Inh_CSegment :: Bool,o_strictwrap_Inh_CSegment :: Bool,o_traces_Inh_CSegment :: Bool,o_unbox_Inh_CSegment :: Bool,paramMap_Inh_CSegment :: ParamMap,prefix_Inh_CSegment :: String,syn_Inh_CSegment :: Attributes}+data Syn_CSegment = Syn_CSegment {comments_Syn_CSegment :: [String],semDom_Syn_CSegment :: [Decl],semDomUnfoldGath_Syn_CSegment :: Map (NontermIdent, Int) ([String], Code.Type),wrapDecls_Syn_CSegment :: Decls}+wrap_CSegment (T_CSegment sem) (Inh_CSegment _lhsIinh _lhsIisLast _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsIsyn) =+ (let ( _lhsOcomments,_lhsOsemDom,_lhsOsemDomUnfoldGath,_lhsOwrapDecls) =+ (sem _lhsIinh _lhsIisLast _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsIsyn)+ in (Syn_CSegment _lhsOcomments _lhsOsemDom _lhsOsemDomUnfoldGath _lhsOwrapDecls))+sem_CSegment_CSegment :: Attributes ->+ Attributes ->+ T_CSegment+sem_CSegment_CSegment inh_ syn_ =+ (T_CSegment (\ _lhsIinh+ _lhsIisLast+ _lhsInr+ _lhsInt+ _lhsIo_case+ _lhsIo_cata+ _lhsIo_costcentre+ _lhsIo_data+ _lhsIo_linePragmas+ _lhsIo_newtypes+ _lhsIo_pretty+ _lhsIo_rename+ _lhsIo_sem+ _lhsIo_sig+ _lhsIo_splitsems+ _lhsIo_strictwrap+ _lhsIo_traces+ _lhsIo_unbox+ _lhsIparamMap+ _lhsIprefix+ _lhsIsyn ->+ (let _lhsOsemDom :: ([Decl])+ _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type))+ _lhsOwrapDecls :: Decls+ _lhsOcomments :: ([String])+ -- "GenerateCode.ag"(line 573, column 15)+ _tp =+ foldr Arr _synTps _inhTps+ -- "GenerateCode.ag"(line 574, column 15)+ _inhTps =+ [SimpleType (typeToHaskellString (Just _lhsInt) _params tp) | tp <- Map.elems inh_]+ -- "GenerateCode.ag"(line 575, column 15)+ _synTps =+ mkTupleType _lhsIo_unbox (null _inhTps ) ([SimpleType (typeToHaskellString (Just _lhsInt) _params tp) | tp <- Map.elems syn_] ++ _continuation )+ -- "GenerateCode.ag"(line 576, column 15)+ _continuation =+ if _lhsIisLast+ then []+ else [TypeApp (SimpleType (typeName _lhsInt (_lhsInr + 1))) (map SimpleType _params )]+ -- "GenerateCode.ag"(line 579, column 15)+ _params =+ map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap+ -- "GenerateCode.ag"(line 580, column 15)+ _lhsOsemDom =+ let name = typeName _lhsInt _lhsInr+ evalTp | null _params = id+ | otherwise = idEvalType+ in if _lhsIo_newtypes+ then [ Code.NewType name _params name (evalTp _tp ) ]+ else [ Code.Type name _params (evalTp _tp ) ]+ -- "GenerateCode.ag"(line 591, column 7)+ _lhsOsemDomUnfoldGath =+ Map.singleton (_lhsInt, _lhsInr) (_params , _tp )+ -- "GenerateCode.ag"(line 665, column 15)+ _lhsOwrapDecls =+ let lhsVars = map (lhsname False) (Map.keys syn_)+ ++ if _lhsIisLast then [] else [unwrap ++ sem (_lhsInr+1)]+ rhsVars = map (lhsname True) (Map.keys inh_)+ rhs = map SimpleExpr rhsVars+ unwrap = if _lhsIo_newtypes then typeName _lhsInt (_lhsInr + 1) ++ " " else ""+ var = "sem"+ sem 0 = var+ sem n = var ++ "_" ++ show n+ in [ Decl (mkTupleLhs _lhsIo_unbox (null $ Map.keys inh_) lhsVars) (App (sem _lhsInr) rhs) (Set.fromList lhsVars) (Set.fromList rhsVars) ]+ -- "GenerateCode.ag"(line 719, column 18)+ _lhsOcomments =+ let body = map ind (showsSegment (CSegment inh_ syn_))+ in if null body+ then []+ else ("visit " ++ show _lhsInr ++ ":") : body+ in ( _lhsOcomments,_lhsOsemDom,_lhsOsemDomUnfoldGath,_lhsOwrapDecls))))+-- CSegments ---------------------------------------------------+{-+ visit 0:+ inherited attributes:+ inh : Attributes+ nr : Int+ nt : NontermIdent+ o_case : Bool+ o_cata : Bool+ o_costcentre : Bool+ o_data : Maybe Bool+ o_linePragmas : Bool+ o_newtypes : Bool+ o_pretty : Bool+ o_rename : Bool+ o_sem : Bool+ o_sig : Bool+ o_splitsems : Bool+ o_strictwrap : Bool+ o_traces : Bool+ o_unbox : Bool+ paramMap : ParamMap+ prefix : String+ syn : Attributes+ synthesized attributes:+ comments : [String]+ isNil : Bool+ semDom : [Decl]+ semDomUnfoldGath : Map (NontermIdent, Int) ([String], Code.Type)+ wrapDecls : Decls+ alternatives:+ alternative Cons:+ child hd : CSegment+ child tl : CSegments+ alternative Nil:+-}+-- cata+sem_CSegments :: CSegments ->+ T_CSegments+sem_CSegments list =+ (Prelude.foldr sem_CSegments_Cons sem_CSegments_Nil (Prelude.map sem_CSegment list))+-- semantic domain+newtype T_CSegments = T_CSegments (Attributes ->+ Int ->+ NontermIdent ->+ Bool ->+ Bool ->+ Bool ->+ (Maybe Bool) ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ ParamMap ->+ String ->+ Attributes ->+ ( ([String]),Bool,([Decl]),(Map (NontermIdent, Int) ([String], Code.Type)),Decls))+data Inh_CSegments = Inh_CSegments {inh_Inh_CSegments :: Attributes,nr_Inh_CSegments :: Int,nt_Inh_CSegments :: NontermIdent,o_case_Inh_CSegments :: Bool,o_cata_Inh_CSegments :: Bool,o_costcentre_Inh_CSegments :: Bool,o_data_Inh_CSegments :: Maybe Bool,o_linePragmas_Inh_CSegments :: Bool,o_newtypes_Inh_CSegments :: Bool,o_pretty_Inh_CSegments :: Bool,o_rename_Inh_CSegments :: Bool,o_sem_Inh_CSegments :: Bool,o_sig_Inh_CSegments :: Bool,o_splitsems_Inh_CSegments :: Bool,o_strictwrap_Inh_CSegments :: Bool,o_traces_Inh_CSegments :: Bool,o_unbox_Inh_CSegments :: Bool,paramMap_Inh_CSegments :: ParamMap,prefix_Inh_CSegments :: String,syn_Inh_CSegments :: Attributes}+data Syn_CSegments = Syn_CSegments {comments_Syn_CSegments :: [String],isNil_Syn_CSegments :: Bool,semDom_Syn_CSegments :: [Decl],semDomUnfoldGath_Syn_CSegments :: Map (NontermIdent, Int) ([String], Code.Type),wrapDecls_Syn_CSegments :: Decls}+wrap_CSegments (T_CSegments sem) (Inh_CSegments _lhsIinh _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsIsyn) =+ (let ( _lhsOcomments,_lhsOisNil,_lhsOsemDom,_lhsOsemDomUnfoldGath,_lhsOwrapDecls) =+ (sem _lhsIinh _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsIsyn)+ in (Syn_CSegments _lhsOcomments _lhsOisNil _lhsOsemDom _lhsOsemDomUnfoldGath _lhsOwrapDecls))+sem_CSegments_Cons :: T_CSegment ->+ T_CSegments ->+ T_CSegments+sem_CSegments_Cons (T_CSegment hd_) (T_CSegments tl_) =+ (T_CSegments (\ _lhsIinh+ _lhsInr+ _lhsInt+ _lhsIo_case+ _lhsIo_cata+ _lhsIo_costcentre+ _lhsIo_data+ _lhsIo_linePragmas+ _lhsIo_newtypes+ _lhsIo_pretty+ _lhsIo_rename+ _lhsIo_sem+ _lhsIo_sig+ _lhsIo_splitsems+ _lhsIo_strictwrap+ _lhsIo_traces+ _lhsIo_unbox+ _lhsIparamMap+ _lhsIprefix+ _lhsIsyn ->+ (let _tlOnr :: Int+ _lhsOisNil :: Bool+ _hdOisLast :: Bool+ _lhsOcomments :: ([String])+ _lhsOsemDom :: ([Decl])+ _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type))+ _lhsOwrapDecls :: Decls+ _hdOinh :: Attributes+ _hdOnr :: Int+ _hdOnt :: NontermIdent+ _hdOo_case :: Bool+ _hdOo_cata :: Bool+ _hdOo_costcentre :: Bool+ _hdOo_data :: (Maybe Bool)+ _hdOo_linePragmas :: Bool+ _hdOo_newtypes :: Bool+ _hdOo_pretty :: Bool+ _hdOo_rename :: Bool+ _hdOo_sem :: Bool+ _hdOo_sig :: Bool+ _hdOo_splitsems :: Bool+ _hdOo_strictwrap :: Bool+ _hdOo_traces :: Bool+ _hdOo_unbox :: Bool+ _hdOparamMap :: ParamMap+ _hdOprefix :: String+ _hdOsyn :: Attributes+ _tlOinh :: Attributes+ _tlOnt :: NontermIdent+ _tlOo_case :: Bool+ _tlOo_cata :: Bool+ _tlOo_costcentre :: Bool+ _tlOo_data :: (Maybe Bool)+ _tlOo_linePragmas :: Bool+ _tlOo_newtypes :: Bool+ _tlOo_pretty :: Bool+ _tlOo_rename :: Bool+ _tlOo_sem :: Bool+ _tlOo_sig :: Bool+ _tlOo_splitsems :: Bool+ _tlOo_strictwrap :: Bool+ _tlOo_traces :: Bool+ _tlOo_unbox :: Bool+ _tlOparamMap :: ParamMap+ _tlOprefix :: String+ _tlOsyn :: Attributes+ _hdIcomments :: ([String])+ _hdIsemDom :: ([Decl])+ _hdIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type))+ _hdIwrapDecls :: Decls+ _tlIcomments :: ([String])+ _tlIisNil :: Bool+ _tlIsemDom :: ([Decl])+ _tlIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type))+ _tlIwrapDecls :: Decls+ -- "GenerateCode.ag"(line 200, column 11)+ _tlOnr =+ _lhsInr + 1+ -- "GenerateCode.ag"(line 213, column 12)+ _lhsOisNil =+ False+ -- "GenerateCode.ag"(line 214, column 12)+ _hdOisLast =+ _tlIisNil+ -- use rule "GenerateCode.ag"(line 714, column 52)+ _lhsOcomments =+ _hdIcomments ++ _tlIcomments+ -- use rule "GenerateCode.ag"(line 568, column 50)+ _lhsOsemDom =+ _hdIsemDom ++ _tlIsemDom+ -- use rule "GenerateCode.ag"(line 587, column 86)+ _lhsOsemDomUnfoldGath =+ _hdIsemDomUnfoldGath `Map.union` _tlIsemDomUnfoldGath+ -- use rule "GenerateCode.ag"(line 663, column 52)+ _lhsOwrapDecls =+ _hdIwrapDecls ++ _tlIwrapDecls+ -- copy rule (down)+ _hdOinh =+ _lhsIinh+ -- copy rule (down)+ _hdOnr =+ _lhsInr+ -- copy rule (down)+ _hdOnt =+ _lhsInt+ -- copy rule (down)+ _hdOo_case =+ _lhsIo_case+ -- copy rule (down)+ _hdOo_cata =+ _lhsIo_cata+ -- copy rule (down)+ _hdOo_costcentre =+ _lhsIo_costcentre+ -- copy rule (down)+ _hdOo_data =+ _lhsIo_data+ -- copy rule (down)+ _hdOo_linePragmas =+ _lhsIo_linePragmas+ -- copy rule (down)+ _hdOo_newtypes =+ _lhsIo_newtypes+ -- copy rule (down)+ _hdOo_pretty =+ _lhsIo_pretty+ -- copy rule (down)+ _hdOo_rename =+ _lhsIo_rename+ -- copy rule (down)+ _hdOo_sem =+ _lhsIo_sem+ -- copy rule (down)+ _hdOo_sig =+ _lhsIo_sig+ -- copy rule (down)+ _hdOo_splitsems =+ _lhsIo_splitsems+ -- copy rule (down)+ _hdOo_strictwrap =+ _lhsIo_strictwrap+ -- copy rule (down)+ _hdOo_traces =+ _lhsIo_traces+ -- copy rule (down)+ _hdOo_unbox =+ _lhsIo_unbox+ -- copy rule (down)+ _hdOparamMap =+ _lhsIparamMap+ -- copy rule (down)+ _hdOprefix =+ _lhsIprefix+ -- copy rule (down)+ _hdOsyn =+ _lhsIsyn+ -- copy rule (down)+ _tlOinh =+ _lhsIinh+ -- copy rule (down)+ _tlOnt =+ _lhsInt+ -- copy rule (down)+ _tlOo_case =+ _lhsIo_case+ -- copy rule (down)+ _tlOo_cata =+ _lhsIo_cata+ -- copy rule (down)+ _tlOo_costcentre =+ _lhsIo_costcentre+ -- copy rule (down)+ _tlOo_data =+ _lhsIo_data+ -- copy rule (down)+ _tlOo_linePragmas =+ _lhsIo_linePragmas+ -- copy rule (down)+ _tlOo_newtypes =+ _lhsIo_newtypes+ -- copy rule (down)+ _tlOo_pretty =+ _lhsIo_pretty+ -- copy rule (down)+ _tlOo_rename =+ _lhsIo_rename+ -- copy rule (down)+ _tlOo_sem =+ _lhsIo_sem+ -- copy rule (down)+ _tlOo_sig =+ _lhsIo_sig+ -- copy rule (down)+ _tlOo_splitsems =+ _lhsIo_splitsems+ -- copy rule (down)+ _tlOo_strictwrap =+ _lhsIo_strictwrap+ -- copy rule (down)+ _tlOo_traces =+ _lhsIo_traces+ -- copy rule (down)+ _tlOo_unbox =+ _lhsIo_unbox+ -- copy rule (down)+ _tlOparamMap =+ _lhsIparamMap+ -- copy rule (down)+ _tlOprefix =+ _lhsIprefix+ -- copy rule (down)+ _tlOsyn =+ _lhsIsyn+ ( _hdIcomments,_hdIsemDom,_hdIsemDomUnfoldGath,_hdIwrapDecls) =+ (hd_ _hdOinh _hdOisLast _hdOnr _hdOnt _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOparamMap _hdOprefix _hdOsyn)+ ( _tlIcomments,_tlIisNil,_tlIsemDom,_tlIsemDomUnfoldGath,_tlIwrapDecls) =+ (tl_ _tlOinh _tlOnr _tlOnt _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOparamMap _tlOprefix _tlOsyn)+ in ( _lhsOcomments,_lhsOisNil,_lhsOsemDom,_lhsOsemDomUnfoldGath,_lhsOwrapDecls))))+sem_CSegments_Nil :: T_CSegments+sem_CSegments_Nil =+ (T_CSegments (\ _lhsIinh+ _lhsInr+ _lhsInt+ _lhsIo_case+ _lhsIo_cata+ _lhsIo_costcentre+ _lhsIo_data+ _lhsIo_linePragmas+ _lhsIo_newtypes+ _lhsIo_pretty+ _lhsIo_rename+ _lhsIo_sem+ _lhsIo_sig+ _lhsIo_splitsems+ _lhsIo_strictwrap+ _lhsIo_traces+ _lhsIo_unbox+ _lhsIparamMap+ _lhsIprefix+ _lhsIsyn ->+ (let _lhsOisNil :: Bool+ _lhsOcomments :: ([String])+ _lhsOsemDom :: ([Decl])+ _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type))+ _lhsOwrapDecls :: Decls+ -- "GenerateCode.ag"(line 215, column 10)+ _lhsOisNil =+ True+ -- use rule "GenerateCode.ag"(line 714, column 52)+ _lhsOcomments =+ []+ -- use rule "GenerateCode.ag"(line 568, column 50)+ _lhsOsemDom =+ []+ -- use rule "GenerateCode.ag"(line 587, column 86)+ _lhsOsemDomUnfoldGath =+ Map.empty+ -- use rule "GenerateCode.ag"(line 663, column 52)+ _lhsOwrapDecls =+ []+ in ( _lhsOcomments,_lhsOisNil,_lhsOsemDom,_lhsOsemDomUnfoldGath,_lhsOwrapDecls))))+-- CVisit ------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allPragmas : PragmaMap+ children : [(Identifier,Type,Bool)]+ con : ConstructorIdent+ contextMap : ContextMap+ inh : Attributes+ instVisitNrs : Map Identifier Int+ isLast : Bool+ nextIntra : Exprs+ nextIntraVars : Set String+ nr : Int+ nt : NontermIdent+ o_case : Bool+ o_cata : Bool+ o_costcentre : Bool+ o_data : Maybe Bool+ o_linePragmas : Bool+ o_newtypes : Bool+ o_pretty : Bool+ o_rename : Bool+ o_sem : Bool+ o_sig : Bool+ o_splitsems : Bool+ o_strictwrap : Bool+ o_traces : Bool+ o_unbox : Bool+ paramInstMap : Map Identifier (NontermIdent, [String])+ paramMap : ParamMap+ prefix : String+ syn : Attributes+ terminals : [Identifier]+ unfoldSemDom : NontermIdent -> Int -> [String] -> Code.Type+ with_sig : Bool+ chained attribute:+ errors : Seq Error+ synthesized attributes:+ allTpsFound : Bool+ comments : [String]+ decls : Decls+ gatherInstVisitNrs : Map Identifier Int+ intra : Exprs+ intraVars : Set String+ semNames : [String]+ alternatives:+ alternative CVisit:+ child inh : {Attributes}+ child syn : {Attributes}+ child vss : Sequence+ child intra : Sequence+ child ordered : {Bool}+ visit 0:+ local _tup4 : _+ local higherOrderChildren : _+ local firstOrderChildren : _+ local funcname : _+ local nextVisitName : _+ local nextVisitDecl : _+ local decls : _+ local lastExprVars : _+ local _tup5 : _+ local blockFunDecls : _+ local blockFirstFunCall : _+ local costCentreDescr : _+ local addCostCentre : _+ local params : _+ local semFun : _+ local tsig : _+ local semType : _+ local typeSigs : _+ local o_case : _+ local o_splitsems : _+-}+-- cata+sem_CVisit :: CVisit ->+ T_CVisit+sem_CVisit (CVisit _inh _syn _vss _intra _ordered) =+ (sem_CVisit_CVisit _inh _syn (sem_Sequence _vss) (sem_Sequence _intra) _ordered)+-- semantic domain+newtype T_CVisit = T_CVisit (PragmaMap ->+ ([(Identifier,Type,Bool)]) ->+ ConstructorIdent ->+ ContextMap ->+ (Seq Error) ->+ Attributes ->+ (Map Identifier Int) ->+ Bool ->+ Exprs ->+ (Set String) ->+ Int ->+ NontermIdent ->+ Bool ->+ Bool ->+ Bool ->+ (Maybe Bool) ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ (Map Identifier (NontermIdent, [String])) ->+ ParamMap ->+ String ->+ Attributes ->+ ([Identifier]) ->+ (NontermIdent -> Int -> [String] -> Code.Type) ->+ Bool ->+ ( Bool,([String]),Decls,(Seq Error),(Map Identifier Int),Exprs,(Set String),([String])))+data Inh_CVisit = Inh_CVisit {allPragmas_Inh_CVisit :: PragmaMap,children_Inh_CVisit :: [(Identifier,Type,Bool)],con_Inh_CVisit :: ConstructorIdent,contextMap_Inh_CVisit :: ContextMap,errors_Inh_CVisit :: Seq Error,inh_Inh_CVisit :: Attributes,instVisitNrs_Inh_CVisit :: Map Identifier Int,isLast_Inh_CVisit :: Bool,nextIntra_Inh_CVisit :: Exprs,nextIntraVars_Inh_CVisit :: Set String,nr_Inh_CVisit :: Int,nt_Inh_CVisit :: NontermIdent,o_case_Inh_CVisit :: Bool,o_cata_Inh_CVisit :: Bool,o_costcentre_Inh_CVisit :: Bool,o_data_Inh_CVisit :: Maybe Bool,o_linePragmas_Inh_CVisit :: Bool,o_newtypes_Inh_CVisit :: Bool,o_pretty_Inh_CVisit :: Bool,o_rename_Inh_CVisit :: Bool,o_sem_Inh_CVisit :: Bool,o_sig_Inh_CVisit :: Bool,o_splitsems_Inh_CVisit :: Bool,o_strictwrap_Inh_CVisit :: Bool,o_traces_Inh_CVisit :: Bool,o_unbox_Inh_CVisit :: Bool,paramInstMap_Inh_CVisit :: Map Identifier (NontermIdent, [String]),paramMap_Inh_CVisit :: ParamMap,prefix_Inh_CVisit :: String,syn_Inh_CVisit :: Attributes,terminals_Inh_CVisit :: [Identifier],unfoldSemDom_Inh_CVisit :: NontermIdent -> Int -> [String] -> Code.Type,with_sig_Inh_CVisit :: Bool}+data Syn_CVisit = Syn_CVisit {allTpsFound_Syn_CVisit :: Bool,comments_Syn_CVisit :: [String],decls_Syn_CVisit :: Decls,errors_Syn_CVisit :: Seq Error,gatherInstVisitNrs_Syn_CVisit :: Map Identifier Int,intra_Syn_CVisit :: Exprs,intraVars_Syn_CVisit :: Set String,semNames_Syn_CVisit :: [String]}+wrap_CVisit (T_CVisit sem) (Inh_CVisit _lhsIallPragmas _lhsIchildren _lhsIcon _lhsIcontextMap _lhsIerrors _lhsIinh _lhsIinstVisitNrs _lhsIisLast _lhsInextIntra _lhsInextIntraVars _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIwith_sig) =+ (let ( _lhsOallTpsFound,_lhsOcomments,_lhsOdecls,_lhsOerrors,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOsemNames) =+ (sem _lhsIallPragmas _lhsIchildren _lhsIcon _lhsIcontextMap _lhsIerrors _lhsIinh _lhsIinstVisitNrs _lhsIisLast _lhsInextIntra _lhsInextIntraVars _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIwith_sig)+ in (Syn_CVisit _lhsOallTpsFound _lhsOcomments _lhsOdecls _lhsOerrors _lhsOgatherInstVisitNrs _lhsOintra _lhsOintraVars _lhsOsemNames))+sem_CVisit_CVisit :: Attributes ->+ Attributes ->+ T_Sequence ->+ T_Sequence ->+ Bool ->+ T_CVisit+sem_CVisit_CVisit inh_ syn_ (T_Sequence vss_) (T_Sequence intra_) ordered_ =+ (T_CVisit (\ _lhsIallPragmas+ _lhsIchildren+ _lhsIcon+ _lhsIcontextMap+ _lhsIerrors+ _lhsIinh+ _lhsIinstVisitNrs+ _lhsIisLast+ _lhsInextIntra+ _lhsInextIntraVars+ _lhsInr+ _lhsInt+ _lhsIo_case+ _lhsIo_cata+ _lhsIo_costcentre+ _lhsIo_data+ _lhsIo_linePragmas+ _lhsIo_newtypes+ _lhsIo_pretty+ _lhsIo_rename+ _lhsIo_sem+ _lhsIo_sig+ _lhsIo_splitsems+ _lhsIo_strictwrap+ _lhsIo_traces+ _lhsIo_unbox+ _lhsIparamInstMap+ _lhsIparamMap+ _lhsIprefix+ _lhsIsyn+ _lhsIterminals+ _lhsIunfoldSemDom+ _lhsIwith_sig ->+ (let _lhsOintra :: Exprs+ _lhsOintraVars :: (Set String)+ _vssOlastExpr :: Expr+ _intraOlastExpr :: Expr+ _lhsOdecls :: Decls+ _lhsOgatherInstVisitNrs :: (Map Identifier Int)+ _vssOdeclsAbove :: ([Decl])+ _intraOdeclsAbove :: ([Decl])+ _lhsOallTpsFound :: Bool+ _lhsOerrors :: (Seq Error)+ _lhsOcomments :: ([String])+ _vssOwhat :: String+ _intraOwhat :: String+ _lhsOsemNames :: ([String])+ _vssOchildren :: ([(Identifier,Type,Bool)])+ _vssOcon :: ConstructorIdent+ _vssOerrors :: (Seq Error)+ _vssOhigherOrderChildren :: ([(Identifier,Type,Bool)])+ _vssOinh :: Attributes+ _vssOinstVisitNrs :: (Map Identifier Int)+ _vssOnr :: Int+ _vssOnt :: NontermIdent+ _vssOo_case :: Bool+ _vssOo_cata :: Bool+ _vssOo_costcentre :: Bool+ _vssOo_data :: (Maybe Bool)+ _vssOo_linePragmas :: Bool+ _vssOo_newtypes :: Bool+ _vssOo_pretty :: Bool+ _vssOo_rename :: Bool+ _vssOo_sem :: Bool+ _vssOo_sig :: Bool+ _vssOo_splitsems :: Bool+ _vssOo_strictwrap :: Bool+ _vssOo_traces :: Bool+ _vssOo_unbox :: Bool+ _vssOparamInstMap :: (Map Identifier (NontermIdent, [String]))+ _vssOparamMap :: ParamMap+ _vssOprefix :: String+ _vssOsyn :: Attributes+ _vssOterminals :: ([Identifier])+ _intraOchildren :: ([(Identifier,Type,Bool)])+ _intraOcon :: ConstructorIdent+ _intraOerrors :: (Seq Error)+ _intraOhigherOrderChildren :: ([(Identifier,Type,Bool)])+ _intraOinh :: Attributes+ _intraOinstVisitNrs :: (Map Identifier Int)+ _intraOnr :: Int+ _intraOnt :: NontermIdent+ _intraOo_case :: Bool+ _intraOo_cata :: Bool+ _intraOo_costcentre :: Bool+ _intraOo_data :: (Maybe Bool)+ _intraOo_linePragmas :: Bool+ _intraOo_newtypes :: Bool+ _intraOo_pretty :: Bool+ _intraOo_rename :: Bool+ _intraOo_sem :: Bool+ _intraOo_sig :: Bool+ _intraOo_splitsems :: Bool+ _intraOo_strictwrap :: Bool+ _intraOo_traces :: Bool+ _intraOo_unbox :: Bool+ _intraOparamInstMap :: (Map Identifier (NontermIdent, [String]))+ _intraOparamMap :: ParamMap+ _intraOprefix :: String+ _intraOsyn :: Attributes+ _intraOterminals :: ([Identifier])+ _vssIallTpsFound :: Bool+ _vssIblockDecls :: DeclBlocks+ _vssIcomments :: ([String])+ _vssIdecls :: Decls+ _vssIdeclsAbove :: ([Decl])+ _vssIdefinedInsts :: ([Identifier])+ _vssIerrors :: (Seq Error)+ _vssIexprs :: Exprs+ _vssItSigs :: ([Decl])+ _vssItps :: ([Type])+ _vssIusedVars :: (Set String)+ _intraIallTpsFound :: Bool+ _intraIblockDecls :: DeclBlocks+ _intraIcomments :: ([String])+ _intraIdecls :: Decls+ _intraIdeclsAbove :: ([Decl])+ _intraIdefinedInsts :: ([Identifier])+ _intraIerrors :: (Seq Error)+ _intraIexprs :: Exprs+ _intraItSigs :: ([Decl])+ _intraItps :: ([Type])+ _intraIusedVars :: (Set String)+ -- "GenerateCode.ag"(line 224, column 13)+ _lhsOintra =+ _intraIexprs+ -- "GenerateCode.ag"(line 225, column 13)+ _lhsOintraVars =+ _intraIusedVars+ -- "GenerateCode.ag"(line 333, column 13)+ __tup4 =+ partition (\(_,_,ho) -> ho) _lhsIchildren+ -- "GenerateCode.ag"(line 333, column 13)+ (_higherOrderChildren,_) =+ __tup4+ -- "GenerateCode.ag"(line 333, column 13)+ (_,_firstOrderChildren) =+ __tup4+ -- "GenerateCode.ag"(line 334, column 13)+ _funcname =+ seqSemname _lhsIprefix _lhsInt _lhsIcon _lhsInr+ -- "GenerateCode.ag"(line 335, column 13)+ _nextVisitName =+ if _lhsIisLast then [] else [visitname _lhsIprefix _lhsInt (_lhsInr+1)]+ -- "GenerateCode.ag"(line 336, column 13)+ _nextVisitDecl =+ let lhs = TupleLhs _nextVisitName+ rhs = App fun _lhsInextIntra+ fun = seqSemname _lhsIprefix _lhsInt _lhsIcon (_lhsInr+1)+ in if _lhsIisLast+ then []+ else [Decl lhs rhs (Set.fromList _nextVisitName) _lhsInextIntraVars]+ -- "GenerateCode.ag"(line 342, column 13)+ _decls =+ _typeSigs ++ _vssIdecls ++ _nextVisitDecl+ -- "GenerateCode.ag"(line 343, column 13)+ _vssOlastExpr =+ mkTupleExpr _lhsIo_unbox (null $ Map.keys inh_) $ map (SimpleExpr . lhsname False) (Map.keys syn_) ++ map SimpleExpr _nextVisitName+ -- "GenerateCode.ag"(line 344, column 13)+ _intraOlastExpr =+ error "lastExpr: not used here"+ -- "GenerateCode.ag"(line 345, column 13)+ _lastExprVars =+ map (lhsname False) (Map.keys syn_) ++ _nextVisitName+ -- "GenerateCode.ag"(line 346, column 13)+ __tup5 =+ mkPartitionedFunction _funcname _o_case _nextVisitDecl _lastExprVars _vssIblockDecls+ -- "GenerateCode.ag"(line 346, column 13)+ (_blockFunDecls,_) =+ __tup5+ -- "GenerateCode.ag"(line 346, column 13)+ (_,_blockFirstFunCall) =+ __tup5+ -- "GenerateCode.ag"(line 348, column 13)+ _costCentreDescr =+ "b" ++ ":" ++ show _lhsInt ++ ":" ++ show _lhsIcon ++ ":" ++ show _lhsInr+ -- "GenerateCode.ag"(line 349, column 13)+ _addCostCentre =+ \v -> if _lhsIo_costcentre+ then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v+ else v+ -- "GenerateCode.ag"(line 353, column 13)+ _params =+ map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap+ -- "GenerateCode.ag"(line 354, column 13)+ _semFun =+ let lhs = Fun _funcname lhs_args+ lhs_args = if _lhsInr == 0 then map field _firstOrderChildren else _intraIexprs+ field (name,NT tp tps,_) = let unwrap | _lhsIo_newtypes = \x -> App (sdtype tp) [x]+ | otherwise = id+ addType expr | null tps = expr+ | otherwise = TypedExpr expr (_lhsIunfoldSemDom tp 0 tps)+ in unwrap $ addType $ SimpleExpr $ funname name 0+ field (name,tp,_) = let expr = SimpleExpr (funname name 0)+ in if null _params+ then expr+ else TypedExpr expr (SimpleType (typeToHaskellString (Just _lhsInt) _params tp))+ mbEvalTp | null _params = const Nothing+ | otherwise = Just . idEvalType+ rhs = wrap+ . mkLambda [mkLambdaArg (lhsname True nm) (mbEvalTp $ SimpleType $ typeToHaskellString (Just _lhsInt) _params tp) | (nm,tp) <- Map.assocs inh_]+ $ _addCostCentre+ $ if ordered_ && _o_splitsems+ then _blockFirstFunCall+ else mkLet _o_case _decls+ . mkTupleExpr _lhsIo_unbox (null $ Map.keys inh_)+ $ map (SimpleExpr . lhsname False) (Map.keys syn_) ++ map SimpleExpr _nextVisitName+ wrap = if _lhsIo_newtypes+ then \x -> App (typeName _lhsInt _lhsInr) [x]+ else id+ in Decl lhs rhs Set.empty Set.empty+ -- "GenerateCode.ag"(line 384, column 13)+ _tsig =+ TSig _funcname _semType+ -- "GenerateCode.ag"(line 385, column 13)+ _semType =+ let argType (NT tp tps) rec | tp /= _SELF = typeAppStrs (sdtype tp) tps `Arr` rec+ | tp == _SELF = error "GenerateCode: found an intra-type with type SELF, which should have been prevented by CRule.tps"+ argType (Haskell tp) rec = SimpleType tp `Arr` rec+ evalTp | null _params = id+ | otherwise = idEvalType+ in appContext _lhsIcontextMap _lhsInt $ evalTp $+ if _lhsInr == 0+ then foldr argType (typeAppStrs (sdtype _lhsInt ) _params ) (map (\(_,t,_) -> t) _firstOrderChildren )+ else foldr argType (typeAppStrs (typeName _lhsInt _lhsInr) _params ) _intraItps+ -- "GenerateCode.ag"(line 396, column 13)+ _lhsOdecls =+ ( if _lhsIwith_sig+ then [_tsig, _semFun]+ else [_semFun]+ ) +++ ( if ordered_ && _o_splitsems+ then _blockFunDecls+ else []+ )+ -- "GenerateCode.ag"(line 404, column 13)+ _typeSigs =+ if _lhsIo_sig && not _o_case+ then _vssItSigs+ else []+ -- "GenerateCode.ag"(line 407, column 13)+ _o_case =+ _lhsIo_case && ordered_ && not (hasPragma _lhsIallPragmas _lhsInt _lhsIcon _NOCASE)+ -- "GenerateCode.ag"(line 408, column 13)+ _o_splitsems =+ ordered_ && _lhsIo_splitsems+ -- "GenerateCode.ag"(line 430, column 7)+ _lhsOgatherInstVisitNrs =+ Map.fromList [(i,_lhsInr) | i <- _vssIdefinedInsts]+ -- "GenerateCode.ag"(line 441, column 7)+ _vssOdeclsAbove =+ []+ -- "GenerateCode.ag"(line 442, column 7)+ _intraOdeclsAbove =+ error "declsAbove: not used here"+ -- "GenerateCode.ag"(line 688, column 13)+ _lhsOallTpsFound =+ _intraIallTpsFound+ -- "GenerateCode.ag"(line 699, column 13)+ _lhsOerrors =+ _intraIerrors+ -- "GenerateCode.ag"(line 732, column 18)+ _lhsOcomments =+ let body = map ind (_vssIcomments ++ _intraIcomments)+ in if null body+ then []+ else ("visit " ++ show _lhsInr ++ ":") : body+ -- "GenerateCode.ag"(line 736, column 18)+ _vssOwhat =+ "local"+ -- "GenerateCode.ag"(line 737, column 18)+ _intraOwhat =+ "intra"+ -- "GenerateCode.ag"(line 920, column 7)+ _lhsOsemNames =+ [_funcname ]+ -- copy rule (down)+ _vssOchildren =+ _lhsIchildren+ -- copy rule (down)+ _vssOcon =+ _lhsIcon+ -- copy rule (down)+ _vssOerrors =+ _lhsIerrors+ -- copy rule (from local)+ _vssOhigherOrderChildren =+ _higherOrderChildren+ -- copy rule (down)+ _vssOinh =+ _lhsIinh+ -- copy rule (down)+ _vssOinstVisitNrs =+ _lhsIinstVisitNrs+ -- copy rule (down)+ _vssOnr =+ _lhsInr+ -- copy rule (down)+ _vssOnt =+ _lhsInt+ -- copy rule (from local)+ _vssOo_case =+ _o_case+ -- copy rule (down)+ _vssOo_cata =+ _lhsIo_cata+ -- copy rule (down)+ _vssOo_costcentre =+ _lhsIo_costcentre+ -- copy rule (down)+ _vssOo_data =+ _lhsIo_data+ -- copy rule (down)+ _vssOo_linePragmas =+ _lhsIo_linePragmas+ -- copy rule (down)+ _vssOo_newtypes =+ _lhsIo_newtypes+ -- copy rule (down)+ _vssOo_pretty =+ _lhsIo_pretty+ -- copy rule (down)+ _vssOo_rename =+ _lhsIo_rename+ -- copy rule (down)+ _vssOo_sem =+ _lhsIo_sem+ -- copy rule (down)+ _vssOo_sig =+ _lhsIo_sig+ -- copy rule (from local)+ _vssOo_splitsems =+ _o_splitsems+ -- copy rule (down)+ _vssOo_strictwrap =+ _lhsIo_strictwrap+ -- copy rule (down)+ _vssOo_traces =+ _lhsIo_traces+ -- copy rule (down)+ _vssOo_unbox =+ _lhsIo_unbox+ -- copy rule (down)+ _vssOparamInstMap =+ _lhsIparamInstMap+ -- copy rule (down)+ _vssOparamMap =+ _lhsIparamMap+ -- copy rule (down)+ _vssOprefix =+ _lhsIprefix+ -- copy rule (down)+ _vssOsyn =+ _lhsIsyn+ -- copy rule (down)+ _vssOterminals =+ _lhsIterminals+ -- copy rule (down)+ _intraOchildren =+ _lhsIchildren+ -- copy rule (down)+ _intraOcon =+ _lhsIcon+ -- copy rule (chain)+ _intraOerrors =+ _vssIerrors+ -- copy rule (from local)+ _intraOhigherOrderChildren =+ _higherOrderChildren+ -- copy rule (down)+ _intraOinh =+ _lhsIinh+ -- copy rule (down)+ _intraOinstVisitNrs =+ _lhsIinstVisitNrs+ -- copy rule (down)+ _intraOnr =+ _lhsInr+ -- copy rule (down)+ _intraOnt =+ _lhsInt+ -- copy rule (from local)+ _intraOo_case =+ _o_case+ -- copy rule (down)+ _intraOo_cata =+ _lhsIo_cata+ -- copy rule (down)+ _intraOo_costcentre =+ _lhsIo_costcentre+ -- copy rule (down)+ _intraOo_data =+ _lhsIo_data+ -- copy rule (down)+ _intraOo_linePragmas =+ _lhsIo_linePragmas+ -- copy rule (down)+ _intraOo_newtypes =+ _lhsIo_newtypes+ -- copy rule (down)+ _intraOo_pretty =+ _lhsIo_pretty+ -- copy rule (down)+ _intraOo_rename =+ _lhsIo_rename+ -- copy rule (down)+ _intraOo_sem =+ _lhsIo_sem+ -- copy rule (down)+ _intraOo_sig =+ _lhsIo_sig+ -- copy rule (from local)+ _intraOo_splitsems =+ _o_splitsems+ -- copy rule (down)+ _intraOo_strictwrap =+ _lhsIo_strictwrap+ -- copy rule (down)+ _intraOo_traces =+ _lhsIo_traces+ -- copy rule (down)+ _intraOo_unbox =+ _lhsIo_unbox+ -- copy rule (down)+ _intraOparamInstMap =+ _lhsIparamInstMap+ -- copy rule (down)+ _intraOparamMap =+ _lhsIparamMap+ -- copy rule (down)+ _intraOprefix =+ _lhsIprefix+ -- copy rule (down)+ _intraOsyn =+ _lhsIsyn+ -- copy rule (down)+ _intraOterminals =+ _lhsIterminals+ ( _vssIallTpsFound,_vssIblockDecls,_vssIcomments,_vssIdecls,_vssIdeclsAbove,_vssIdefinedInsts,_vssIerrors,_vssIexprs,_vssItSigs,_vssItps,_vssIusedVars) =+ (vss_ _vssOchildren _vssOcon _vssOdeclsAbove _vssOerrors _vssOhigherOrderChildren _vssOinh _vssOinstVisitNrs _vssOlastExpr _vssOnr _vssOnt _vssOo_case _vssOo_cata _vssOo_costcentre _vssOo_data _vssOo_linePragmas _vssOo_newtypes _vssOo_pretty _vssOo_rename _vssOo_sem _vssOo_sig _vssOo_splitsems _vssOo_strictwrap _vssOo_traces _vssOo_unbox _vssOparamInstMap _vssOparamMap _vssOprefix _vssOsyn _vssOterminals _vssOwhat)+ ( _intraIallTpsFound,_intraIblockDecls,_intraIcomments,_intraIdecls,_intraIdeclsAbove,_intraIdefinedInsts,_intraIerrors,_intraIexprs,_intraItSigs,_intraItps,_intraIusedVars) =+ (intra_ _intraOchildren _intraOcon _intraOdeclsAbove _intraOerrors _intraOhigherOrderChildren _intraOinh _intraOinstVisitNrs _intraOlastExpr _intraOnr _intraOnt _intraOo_case _intraOo_cata _intraOo_costcentre _intraOo_data _intraOo_linePragmas _intraOo_newtypes _intraOo_pretty _intraOo_rename _intraOo_sem _intraOo_sig _intraOo_splitsems _intraOo_strictwrap _intraOo_traces _intraOo_unbox _intraOparamInstMap _intraOparamMap _intraOprefix _intraOsyn _intraOterminals _intraOwhat)+ in ( _lhsOallTpsFound,_lhsOcomments,_lhsOdecls,_lhsOerrors,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOsemNames))))+-- CVisits -----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allPragmas : PragmaMap+ children : [(Identifier,Type,Bool)]+ con : ConstructorIdent+ contextMap : ContextMap+ inh : Attributes+ instVisitNrs : Map Identifier Int+ nr : Int+ nt : NontermIdent+ o_case : Bool+ o_cata : Bool+ o_costcentre : Bool+ o_data : Maybe Bool+ o_linePragmas : Bool+ o_newtypes : Bool+ o_pretty : Bool+ o_rename : Bool+ o_sem : Bool+ o_sig : Bool+ o_splitsems : Bool+ o_strictwrap : Bool+ o_traces : Bool+ o_unbox : Bool+ paramInstMap : Map Identifier (NontermIdent, [String])+ paramMap : ParamMap+ prefix : String+ syn : Attributes+ terminals : [Identifier]+ unfoldSemDom : NontermIdent -> Int -> [String] -> Code.Type+ with_sig : Bool+ chained attribute:+ errors : Seq Error+ synthesized attributes:+ allTpsFound : Bool+ comments : [String]+ decls : Decls+ gatherInstVisitNrs : Map Identifier Int+ intra : Exprs+ intraVars : Set String+ isNil : Bool+ semNames : [String]+ alternatives:+ alternative Cons:+ child hd : CVisit+ child tl : CVisits+ alternative Nil:+-}+-- cata+sem_CVisits :: CVisits ->+ T_CVisits+sem_CVisits list =+ (Prelude.foldr sem_CVisits_Cons sem_CVisits_Nil (Prelude.map sem_CVisit list))+-- semantic domain+newtype T_CVisits = T_CVisits (PragmaMap ->+ ([(Identifier,Type,Bool)]) ->+ ConstructorIdent ->+ ContextMap ->+ (Seq Error) ->+ Attributes ->+ (Map Identifier Int) ->+ Int ->+ NontermIdent ->+ Bool ->+ Bool ->+ Bool ->+ (Maybe Bool) ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ (Map Identifier (NontermIdent, [String])) ->+ ParamMap ->+ String ->+ Attributes ->+ ([Identifier]) ->+ (NontermIdent -> Int -> [String] -> Code.Type) ->+ Bool ->+ ( Bool,([String]),Decls,(Seq Error),(Map Identifier Int),Exprs,(Set String),Bool,([String])))+data Inh_CVisits = Inh_CVisits {allPragmas_Inh_CVisits :: PragmaMap,children_Inh_CVisits :: [(Identifier,Type,Bool)],con_Inh_CVisits :: ConstructorIdent,contextMap_Inh_CVisits :: ContextMap,errors_Inh_CVisits :: Seq Error,inh_Inh_CVisits :: Attributes,instVisitNrs_Inh_CVisits :: Map Identifier Int,nr_Inh_CVisits :: Int,nt_Inh_CVisits :: NontermIdent,o_case_Inh_CVisits :: Bool,o_cata_Inh_CVisits :: Bool,o_costcentre_Inh_CVisits :: Bool,o_data_Inh_CVisits :: Maybe Bool,o_linePragmas_Inh_CVisits :: Bool,o_newtypes_Inh_CVisits :: Bool,o_pretty_Inh_CVisits :: Bool,o_rename_Inh_CVisits :: Bool,o_sem_Inh_CVisits :: Bool,o_sig_Inh_CVisits :: Bool,o_splitsems_Inh_CVisits :: Bool,o_strictwrap_Inh_CVisits :: Bool,o_traces_Inh_CVisits :: Bool,o_unbox_Inh_CVisits :: Bool,paramInstMap_Inh_CVisits :: Map Identifier (NontermIdent, [String]),paramMap_Inh_CVisits :: ParamMap,prefix_Inh_CVisits :: String,syn_Inh_CVisits :: Attributes,terminals_Inh_CVisits :: [Identifier],unfoldSemDom_Inh_CVisits :: NontermIdent -> Int -> [String] -> Code.Type,with_sig_Inh_CVisits :: Bool}+data Syn_CVisits = Syn_CVisits {allTpsFound_Syn_CVisits :: Bool,comments_Syn_CVisits :: [String],decls_Syn_CVisits :: Decls,errors_Syn_CVisits :: Seq Error,gatherInstVisitNrs_Syn_CVisits :: Map Identifier Int,intra_Syn_CVisits :: Exprs,intraVars_Syn_CVisits :: Set String,isNil_Syn_CVisits :: Bool,semNames_Syn_CVisits :: [String]}+wrap_CVisits (T_CVisits sem) (Inh_CVisits _lhsIallPragmas _lhsIchildren _lhsIcon _lhsIcontextMap _lhsIerrors _lhsIinh _lhsIinstVisitNrs _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIwith_sig) =+ (let ( _lhsOallTpsFound,_lhsOcomments,_lhsOdecls,_lhsOerrors,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOisNil,_lhsOsemNames) =+ (sem _lhsIallPragmas _lhsIchildren _lhsIcon _lhsIcontextMap _lhsIerrors _lhsIinh _lhsIinstVisitNrs _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIwith_sig)+ in (Syn_CVisits _lhsOallTpsFound _lhsOcomments _lhsOdecls _lhsOerrors _lhsOgatherInstVisitNrs _lhsOintra _lhsOintraVars _lhsOisNil _lhsOsemNames))+sem_CVisits_Cons :: T_CVisit ->+ T_CVisits ->+ T_CVisits+sem_CVisits_Cons (T_CVisit hd_) (T_CVisits tl_) =+ (T_CVisits (\ _lhsIallPragmas+ _lhsIchildren+ _lhsIcon+ _lhsIcontextMap+ _lhsIerrors+ _lhsIinh+ _lhsIinstVisitNrs+ _lhsInr+ _lhsInt+ _lhsIo_case+ _lhsIo_cata+ _lhsIo_costcentre+ _lhsIo_data+ _lhsIo_linePragmas+ _lhsIo_newtypes+ _lhsIo_pretty+ _lhsIo_rename+ _lhsIo_sem+ _lhsIo_sig+ _lhsIo_splitsems+ _lhsIo_strictwrap+ _lhsIo_traces+ _lhsIo_unbox+ _lhsIparamInstMap+ _lhsIparamMap+ _lhsIprefix+ _lhsIsyn+ _lhsIterminals+ _lhsIunfoldSemDom+ _lhsIwith_sig ->+ (let _tlOnr :: Int+ _lhsOisNil :: Bool+ _hdOisLast :: Bool+ _hdOnextIntra :: Exprs+ _hdOnextIntraVars :: (Set String)+ _lhsOintra :: Exprs+ _lhsOintraVars :: (Set String)+ _lhsOallTpsFound :: Bool+ _lhsOcomments :: ([String])+ _lhsOdecls :: Decls+ _lhsOerrors :: (Seq Error)+ _lhsOgatherInstVisitNrs :: (Map Identifier Int)+ _lhsOsemNames :: ([String])+ _hdOallPragmas :: PragmaMap+ _hdOchildren :: ([(Identifier,Type,Bool)])+ _hdOcon :: ConstructorIdent+ _hdOcontextMap :: ContextMap+ _hdOerrors :: (Seq Error)+ _hdOinh :: Attributes+ _hdOinstVisitNrs :: (Map Identifier Int)+ _hdOnr :: Int+ _hdOnt :: NontermIdent+ _hdOo_case :: Bool+ _hdOo_cata :: Bool+ _hdOo_costcentre :: Bool+ _hdOo_data :: (Maybe Bool)+ _hdOo_linePragmas :: Bool+ _hdOo_newtypes :: Bool+ _hdOo_pretty :: Bool+ _hdOo_rename :: Bool+ _hdOo_sem :: Bool+ _hdOo_sig :: Bool+ _hdOo_splitsems :: Bool+ _hdOo_strictwrap :: Bool+ _hdOo_traces :: Bool+ _hdOo_unbox :: Bool+ _hdOparamInstMap :: (Map Identifier (NontermIdent, [String]))+ _hdOparamMap :: ParamMap+ _hdOprefix :: String+ _hdOsyn :: Attributes+ _hdOterminals :: ([Identifier])+ _hdOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type)+ _hdOwith_sig :: Bool+ _tlOallPragmas :: PragmaMap+ _tlOchildren :: ([(Identifier,Type,Bool)])+ _tlOcon :: ConstructorIdent+ _tlOcontextMap :: ContextMap+ _tlOerrors :: (Seq Error)+ _tlOinh :: Attributes+ _tlOinstVisitNrs :: (Map Identifier Int)+ _tlOnt :: NontermIdent+ _tlOo_case :: Bool+ _tlOo_cata :: Bool+ _tlOo_costcentre :: Bool+ _tlOo_data :: (Maybe Bool)+ _tlOo_linePragmas :: Bool+ _tlOo_newtypes :: Bool+ _tlOo_pretty :: Bool+ _tlOo_rename :: Bool+ _tlOo_sem :: Bool+ _tlOo_sig :: Bool+ _tlOo_splitsems :: Bool+ _tlOo_strictwrap :: Bool+ _tlOo_traces :: Bool+ _tlOo_unbox :: Bool+ _tlOparamInstMap :: (Map Identifier (NontermIdent, [String]))+ _tlOparamMap :: ParamMap+ _tlOprefix :: String+ _tlOsyn :: Attributes+ _tlOterminals :: ([Identifier])+ _tlOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type)+ _tlOwith_sig :: Bool+ _hdIallTpsFound :: Bool+ _hdIcomments :: ([String])+ _hdIdecls :: Decls+ _hdIerrors :: (Seq Error)+ _hdIgatherInstVisitNrs :: (Map Identifier Int)+ _hdIintra :: Exprs+ _hdIintraVars :: (Set String)+ _hdIsemNames :: ([String])+ _tlIallTpsFound :: Bool+ _tlIcomments :: ([String])+ _tlIdecls :: Decls+ _tlIerrors :: (Seq Error)+ _tlIgatherInstVisitNrs :: (Map Identifier Int)+ _tlIintra :: Exprs+ _tlIintraVars :: (Set String)+ _tlIisNil :: Bool+ _tlIsemNames :: ([String])+ -- "GenerateCode.ag"(line 196, column 11)+ _tlOnr =+ _lhsInr + 1+ -- "GenerateCode.ag"(line 209, column 12)+ _lhsOisNil =+ False+ -- "GenerateCode.ag"(line 210, column 12)+ _hdOisLast =+ _tlIisNil+ -- "GenerateCode.ag"(line 227, column 12)+ _hdOnextIntra =+ _tlIintra+ -- "GenerateCode.ag"(line 228, column 12)+ _hdOnextIntraVars =+ _tlIintraVars+ -- "GenerateCode.ag"(line 229, column 12)+ _lhsOintra =+ _hdIintra+ -- "GenerateCode.ag"(line 230, column 12)+ _lhsOintraVars =+ _hdIintraVars+ -- use rule "GenerateCode.ag"(line 682, column 39)+ _lhsOallTpsFound =+ _hdIallTpsFound && _tlIallTpsFound+ -- use rule "GenerateCode.ag"(line 714, column 52)+ _lhsOcomments =+ _hdIcomments ++ _tlIcomments+ -- use rule "GenerateCode.ag"(line 331, column 33)+ _lhsOdecls =+ _hdIdecls ++ _tlIdecls+ -- use rule "GenerateCode.ag"(line 695, column 32)+ _lhsOerrors =+ _hdIerrors Seq.<> _tlIerrors+ -- use rule "GenerateCode.ag"(line 423, column 44)+ _lhsOgatherInstVisitNrs =+ _hdIgatherInstVisitNrs `Map.union` _tlIgatherInstVisitNrs+ -- use rule "GenerateCode.ag"(line 910, column 61)+ _lhsOsemNames =+ _hdIsemNames ++ _tlIsemNames+ -- copy rule (down)+ _hdOallPragmas =+ _lhsIallPragmas+ -- copy rule (down)+ _hdOchildren =+ _lhsIchildren+ -- copy rule (down)+ _hdOcon =+ _lhsIcon+ -- copy rule (down)+ _hdOcontextMap =+ _lhsIcontextMap+ -- copy rule (down)+ _hdOerrors =+ _lhsIerrors+ -- copy rule (down)+ _hdOinh =+ _lhsIinh+ -- copy rule (down)+ _hdOinstVisitNrs =+ _lhsIinstVisitNrs+ -- copy rule (down)+ _hdOnr =+ _lhsInr+ -- copy rule (down)+ _hdOnt =+ _lhsInt+ -- copy rule (down)+ _hdOo_case =+ _lhsIo_case+ -- copy rule (down)+ _hdOo_cata =+ _lhsIo_cata+ -- copy rule (down)+ _hdOo_costcentre =+ _lhsIo_costcentre+ -- copy rule (down)+ _hdOo_data =+ _lhsIo_data+ -- copy rule (down)+ _hdOo_linePragmas =+ _lhsIo_linePragmas+ -- copy rule (down)+ _hdOo_newtypes =+ _lhsIo_newtypes+ -- copy rule (down)+ _hdOo_pretty =+ _lhsIo_pretty+ -- copy rule (down)+ _hdOo_rename =+ _lhsIo_rename+ -- copy rule (down)+ _hdOo_sem =+ _lhsIo_sem+ -- copy rule (down)+ _hdOo_sig =+ _lhsIo_sig+ -- copy rule (down)+ _hdOo_splitsems =+ _lhsIo_splitsems+ -- copy rule (down)+ _hdOo_strictwrap =+ _lhsIo_strictwrap+ -- copy rule (down)+ _hdOo_traces =+ _lhsIo_traces+ -- copy rule (down)+ _hdOo_unbox =+ _lhsIo_unbox+ -- copy rule (down)+ _hdOparamInstMap =+ _lhsIparamInstMap+ -- copy rule (down)+ _hdOparamMap =+ _lhsIparamMap+ -- copy rule (down)+ _hdOprefix =+ _lhsIprefix+ -- copy rule (down)+ _hdOsyn =+ _lhsIsyn+ -- copy rule (down)+ _hdOterminals =+ _lhsIterminals+ -- copy rule (down)+ _hdOunfoldSemDom =+ _lhsIunfoldSemDom+ -- copy rule (down)+ _hdOwith_sig =+ _lhsIwith_sig+ -- copy rule (down)+ _tlOallPragmas =+ _lhsIallPragmas+ -- copy rule (down)+ _tlOchildren =+ _lhsIchildren+ -- copy rule (down)+ _tlOcon =+ _lhsIcon+ -- copy rule (down)+ _tlOcontextMap =+ _lhsIcontextMap+ -- copy rule (chain)+ _tlOerrors =+ _hdIerrors+ -- copy rule (down)+ _tlOinh =+ _lhsIinh+ -- copy rule (down)+ _tlOinstVisitNrs =+ _lhsIinstVisitNrs+ -- copy rule (down)+ _tlOnt =+ _lhsInt+ -- copy rule (down)+ _tlOo_case =+ _lhsIo_case+ -- copy rule (down)+ _tlOo_cata =+ _lhsIo_cata+ -- copy rule (down)+ _tlOo_costcentre =+ _lhsIo_costcentre+ -- copy rule (down)+ _tlOo_data =+ _lhsIo_data+ -- copy rule (down)+ _tlOo_linePragmas =+ _lhsIo_linePragmas+ -- copy rule (down)+ _tlOo_newtypes =+ _lhsIo_newtypes+ -- copy rule (down)+ _tlOo_pretty =+ _lhsIo_pretty+ -- copy rule (down)+ _tlOo_rename =+ _lhsIo_rename+ -- copy rule (down)+ _tlOo_sem =+ _lhsIo_sem+ -- copy rule (down)+ _tlOo_sig =+ _lhsIo_sig+ -- copy rule (down)+ _tlOo_splitsems =+ _lhsIo_splitsems+ -- copy rule (down)+ _tlOo_strictwrap =+ _lhsIo_strictwrap+ -- copy rule (down)+ _tlOo_traces =+ _lhsIo_traces+ -- copy rule (down)+ _tlOo_unbox =+ _lhsIo_unbox+ -- copy rule (down)+ _tlOparamInstMap =+ _lhsIparamInstMap+ -- copy rule (down)+ _tlOparamMap =+ _lhsIparamMap+ -- copy rule (down)+ _tlOprefix =+ _lhsIprefix+ -- copy rule (down)+ _tlOsyn =+ _lhsIsyn+ -- copy rule (down)+ _tlOterminals =+ _lhsIterminals+ -- copy rule (down)+ _tlOunfoldSemDom =+ _lhsIunfoldSemDom+ -- copy rule (down)+ _tlOwith_sig =+ _lhsIwith_sig+ ( _hdIallTpsFound,_hdIcomments,_hdIdecls,_hdIerrors,_hdIgatherInstVisitNrs,_hdIintra,_hdIintraVars,_hdIsemNames) =+ (hd_ _hdOallPragmas _hdOchildren _hdOcon _hdOcontextMap _hdOerrors _hdOinh _hdOinstVisitNrs _hdOisLast _hdOnextIntra _hdOnextIntraVars _hdOnr _hdOnt _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOparamInstMap _hdOparamMap _hdOprefix _hdOsyn _hdOterminals _hdOunfoldSemDom _hdOwith_sig)+ ( _tlIallTpsFound,_tlIcomments,_tlIdecls,_tlIerrors,_tlIgatherInstVisitNrs,_tlIintra,_tlIintraVars,_tlIisNil,_tlIsemNames) =+ (tl_ _tlOallPragmas _tlOchildren _tlOcon _tlOcontextMap _tlOerrors _tlOinh _tlOinstVisitNrs _tlOnr _tlOnt _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOparamInstMap _tlOparamMap _tlOprefix _tlOsyn _tlOterminals _tlOunfoldSemDom _tlOwith_sig)+ in ( _lhsOallTpsFound,_lhsOcomments,_lhsOdecls,_lhsOerrors,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOisNil,_lhsOsemNames))))+sem_CVisits_Nil :: T_CVisits+sem_CVisits_Nil =+ (T_CVisits (\ _lhsIallPragmas+ _lhsIchildren+ _lhsIcon+ _lhsIcontextMap+ _lhsIerrors+ _lhsIinh+ _lhsIinstVisitNrs+ _lhsInr+ _lhsInt+ _lhsIo_case+ _lhsIo_cata+ _lhsIo_costcentre+ _lhsIo_data+ _lhsIo_linePragmas+ _lhsIo_newtypes+ _lhsIo_pretty+ _lhsIo_rename+ _lhsIo_sem+ _lhsIo_sig+ _lhsIo_splitsems+ _lhsIo_strictwrap+ _lhsIo_traces+ _lhsIo_unbox+ _lhsIparamInstMap+ _lhsIparamMap+ _lhsIprefix+ _lhsIsyn+ _lhsIterminals+ _lhsIunfoldSemDom+ _lhsIwith_sig ->+ (let _lhsOisNil :: Bool+ _lhsOintra :: Exprs+ _lhsOintraVars :: (Set String)+ _lhsOallTpsFound :: Bool+ _lhsOcomments :: ([String])+ _lhsOdecls :: Decls+ _lhsOerrors :: (Seq Error)+ _lhsOgatherInstVisitNrs :: (Map Identifier Int)+ _lhsOsemNames :: ([String])+ -- "GenerateCode.ag"(line 211, column 10)+ _lhsOisNil =+ True+ -- "GenerateCode.ag"(line 231, column 10)+ _lhsOintra =+ []+ -- "GenerateCode.ag"(line 232, column 10)+ _lhsOintraVars =+ Set.empty+ -- use rule "GenerateCode.ag"(line 682, column 39)+ _lhsOallTpsFound =+ True+ -- use rule "GenerateCode.ag"(line 714, column 52)+ _lhsOcomments =+ []+ -- use rule "GenerateCode.ag"(line 331, column 33)+ _lhsOdecls =+ []+ -- use rule "GenerateCode.ag"(line 695, column 32)+ _lhsOerrors =+ Seq.empty+ -- use rule "GenerateCode.ag"(line 423, column 44)+ _lhsOgatherInstVisitNrs =+ Map.empty+ -- use rule "GenerateCode.ag"(line 910, column 61)+ _lhsOsemNames =+ []+ in ( _lhsOallTpsFound,_lhsOcomments,_lhsOdecls,_lhsOerrors,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOisNil,_lhsOsemNames))))+-- DeclBlocks --------------------------------------------------+{-+ visit 0:+ inherited attributes:+ blockNr : Int+ lastExprVars : [String]+ nextVisitDecls : [Decl]+ optCase : Bool+ prefix : String+ synthesized attributes:+ callExpr : Expr+ decls : [Decl]+ freeVars : [String]+ alternatives:+ alternative DeclBlock:+ child defs : {[Decl]}+ child visit : {Decl}+ child next : DeclBlocks+ visit 0:+ local lambdaName : _+ local pragmaDecl : _+ local freeVars : _+ local decl : _+ alternative DeclTerminator:+ child defs : {[Decl]}+ child result : {Expr}+ visit 0:+ local lambdaName : _+ local pragmaDecl : _+ local freeVars : _+-}+-- cata+sem_DeclBlocks :: DeclBlocks ->+ T_DeclBlocks+sem_DeclBlocks (DeclBlock _defs _visit _next) =+ (sem_DeclBlocks_DeclBlock _defs _visit (sem_DeclBlocks _next))+sem_DeclBlocks (DeclTerminator _defs _result) =+ (sem_DeclBlocks_DeclTerminator _defs _result)+-- semantic domain+newtype T_DeclBlocks = T_DeclBlocks (Int ->+ ([String]) ->+ ([Decl]) ->+ Bool ->+ String ->+ ( Expr,([Decl]),([String])))+data Inh_DeclBlocks = Inh_DeclBlocks {blockNr_Inh_DeclBlocks :: Int,lastExprVars_Inh_DeclBlocks :: [String],nextVisitDecls_Inh_DeclBlocks :: [Decl],optCase_Inh_DeclBlocks :: Bool,prefix_Inh_DeclBlocks :: String}+data Syn_DeclBlocks = Syn_DeclBlocks {callExpr_Syn_DeclBlocks :: Expr,decls_Syn_DeclBlocks :: [Decl],freeVars_Syn_DeclBlocks :: [String]}+wrap_DeclBlocks (T_DeclBlocks sem) (Inh_DeclBlocks _lhsIblockNr _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix) =+ (let ( _lhsOcallExpr,_lhsOdecls,_lhsOfreeVars) =+ (sem _lhsIblockNr _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix)+ in (Syn_DeclBlocks _lhsOcallExpr _lhsOdecls _lhsOfreeVars))+sem_DeclBlocks_DeclBlock :: ([Decl]) ->+ Decl ->+ T_DeclBlocks ->+ T_DeclBlocks+sem_DeclBlocks_DeclBlock defs_ visit_ (T_DeclBlocks next_) =+ (T_DeclBlocks (\ _lhsIblockNr+ _lhsIlastExprVars+ _lhsInextVisitDecls+ _lhsIoptCase+ _lhsIprefix ->+ (let _nextOblockNr :: Int+ _lhsOcallExpr :: Expr+ _lhsOdecls :: ([Decl])+ _lhsOfreeVars :: ([String])+ _nextOlastExprVars :: ([String])+ _nextOnextVisitDecls :: ([Decl])+ _nextOoptCase :: Bool+ _nextOprefix :: String+ _nextIcallExpr :: Expr+ _nextIdecls :: ([Decl])+ _nextIfreeVars :: ([String])+ -- "GenerateCode.ag"(line 520, column 7)+ _nextOblockNr =+ _lhsIblockNr + 1+ -- "GenerateCode.ag"(line 525, column 7)+ _lambdaName =+ _lhsIprefix ++ "_block" ++ show _lhsIblockNr+ -- "GenerateCode.ag"(line 526, column 7)+ _pragmaDecl =+ PragmaDecl ("NOINLINE " ++ _lambdaName )+ -- "GenerateCode.ag"(line 527, column 7)+ _lhsOcallExpr =+ App _lambdaName (map SimpleExpr _freeVars )+ -- "GenerateCode.ag"(line 531, column 7)+ _freeVars =+ freevars _nextIfreeVars (visit_ : defs_)+ -- "GenerateCode.ag"(line 538, column 7)+ _decl =+ mkBlockLambda _lhsIoptCase _lambdaName _freeVars (defs_ ++ [visit_]) _nextIcallExpr+ -- "GenerateCode.ag"(line 539, column 7)+ _lhsOdecls =+ (if _lhsIblockNr > 1 then [_pragmaDecl ] else []) ++ [_decl ] ++ _nextIdecls+ -- copy rule (from local)+ _lhsOfreeVars =+ _freeVars+ -- copy rule (down)+ _nextOlastExprVars =+ _lhsIlastExprVars+ -- copy rule (down)+ _nextOnextVisitDecls =+ _lhsInextVisitDecls+ -- copy rule (down)+ _nextOoptCase =+ _lhsIoptCase+ -- copy rule (down)+ _nextOprefix =+ _lhsIprefix+ ( _nextIcallExpr,_nextIdecls,_nextIfreeVars) =+ (next_ _nextOblockNr _nextOlastExprVars _nextOnextVisitDecls _nextOoptCase _nextOprefix)+ in ( _lhsOcallExpr,_lhsOdecls,_lhsOfreeVars))))+sem_DeclBlocks_DeclTerminator :: ([Decl]) ->+ Expr ->+ T_DeclBlocks+sem_DeclBlocks_DeclTerminator defs_ result_ =+ (T_DeclBlocks (\ _lhsIblockNr+ _lhsIlastExprVars+ _lhsInextVisitDecls+ _lhsIoptCase+ _lhsIprefix ->+ (let _lhsOcallExpr :: Expr+ _lhsOdecls :: ([Decl])+ _lhsOfreeVars :: ([String])+ -- "GenerateCode.ag"(line 525, column 7)+ _lambdaName =+ _lhsIprefix ++ "_block" ++ show _lhsIblockNr+ -- "GenerateCode.ag"(line 526, column 7)+ _pragmaDecl =+ PragmaDecl ("NOINLINE " ++ _lambdaName )+ -- "GenerateCode.ag"(line 527, column 7)+ _lhsOcallExpr =+ App _lambdaName (map SimpleExpr _freeVars )+ -- "GenerateCode.ag"(line 529, column 7)+ _freeVars =+ freevars _lhsIlastExprVars (defs_ ++ _lhsInextVisitDecls)+ -- "GenerateCode.ag"(line 536, column 7)+ _lhsOdecls =+ [ mkBlockLambda _lhsIoptCase _lambdaName _freeVars (defs_ ++ _lhsInextVisitDecls) result_ ]+ -- copy rule (from local)+ _lhsOfreeVars =+ _freeVars+ in ( _lhsOcallExpr,_lhsOdecls,_lhsOfreeVars))))+-- DeclBlocksRoot ----------------------------------------------+{-+ visit 0:+ inherited attributes:+ lastExprVars : [String]+ nextVisitDecls : [Decl]+ optCase : Bool+ prefix : String+ synthesized attributes:+ firstCall : Expr+ lambdas : [Decl]+ alternatives:+ alternative DeclBlocksRoot:+ child blocks : DeclBlocks+-}+-- cata+sem_DeclBlocksRoot :: DeclBlocksRoot ->+ T_DeclBlocksRoot+sem_DeclBlocksRoot (DeclBlocksRoot _blocks) =+ (sem_DeclBlocksRoot_DeclBlocksRoot (sem_DeclBlocks _blocks))+-- semantic domain+newtype T_DeclBlocksRoot = T_DeclBlocksRoot (([String]) ->+ ([Decl]) ->+ Bool ->+ String ->+ ( Expr,([Decl])))+data Inh_DeclBlocksRoot = Inh_DeclBlocksRoot {lastExprVars_Inh_DeclBlocksRoot :: [String],nextVisitDecls_Inh_DeclBlocksRoot :: [Decl],optCase_Inh_DeclBlocksRoot :: Bool,prefix_Inh_DeclBlocksRoot :: String}+data Syn_DeclBlocksRoot = Syn_DeclBlocksRoot {firstCall_Syn_DeclBlocksRoot :: Expr,lambdas_Syn_DeclBlocksRoot :: [Decl]}+wrap_DeclBlocksRoot (T_DeclBlocksRoot sem) (Inh_DeclBlocksRoot _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix) =+ (let ( _lhsOfirstCall,_lhsOlambdas) =+ (sem _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix)+ in (Syn_DeclBlocksRoot _lhsOfirstCall _lhsOlambdas))+sem_DeclBlocksRoot_DeclBlocksRoot :: T_DeclBlocks ->+ T_DeclBlocksRoot+sem_DeclBlocksRoot_DeclBlocksRoot (T_DeclBlocks blocks_) =+ (T_DeclBlocksRoot (\ _lhsIlastExprVars+ _lhsInextVisitDecls+ _lhsIoptCase+ _lhsIprefix ->+ (let _lhsOlambdas :: ([Decl])+ _lhsOfirstCall :: Expr+ _blocksOblockNr :: Int+ _blocksOlastExprVars :: ([String])+ _blocksOnextVisitDecls :: ([Decl])+ _blocksOoptCase :: Bool+ _blocksOprefix :: String+ _blocksIcallExpr :: Expr+ _blocksIdecls :: ([Decl])+ _blocksIfreeVars :: ([String])+ -- "GenerateCode.ag"(line 511, column 7)+ _lhsOlambdas =+ _blocksIdecls+ -- "GenerateCode.ag"(line 512, column 7)+ _lhsOfirstCall =+ _blocksIcallExpr+ -- "GenerateCode.ag"(line 517, column 7)+ _blocksOblockNr =+ 1+ -- copy rule (down)+ _blocksOlastExprVars =+ _lhsIlastExprVars+ -- copy rule (down)+ _blocksOnextVisitDecls =+ _lhsInextVisitDecls+ -- copy rule (down)+ _blocksOoptCase =+ _lhsIoptCase+ -- copy rule (down)+ _blocksOprefix =+ _lhsIprefix+ ( _blocksIcallExpr,_blocksIdecls,_blocksIfreeVars) =+ (blocks_ _blocksOblockNr _blocksOlastExprVars _blocksOnextVisitDecls _blocksOoptCase _blocksOprefix)+ in ( _lhsOfirstCall,_lhsOlambdas))))+-- Pattern -----------------------------------------------------+{-+ visit 0:+ synthesized attributes:+ copy : SELF+ definedInsts : [Identifier]+ patternAttributes : [(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, Identifier)])))+data Inh_Pattern = Inh_Pattern {}+data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern,definedInsts_Syn_Pattern :: [Identifier],patternAttributes_Syn_Pattern :: [(Identifier, Identifier)]}+wrap_Pattern (T_Pattern sem) (Inh_Pattern ) =+ (let ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes) =+ (sem )+ in (Syn_Pattern _lhsOcopy _lhsOdefinedInsts _lhsOpatternAttributes))+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 _lhsOdefinedInsts :: ([Identifier])+ _lhsOpatternAttributes :: ([(Identifier, Identifier)])+ _lhsOcopy :: Pattern+ _patIcopy :: Pattern+ _patIdefinedInsts :: ([Identifier])+ _patIpatternAttributes :: ([(Identifier, Identifier)])+ _partsIcopy :: Patterns+ _partsIdefinedInsts :: ([Identifier])+ _partsIpatternAttributes :: ([(Identifier, Identifier)])+ -- "GenerateCode.ag"(line 177, column 11)+ _lhsOdefinedInsts =+ (if field_ == _INST then [attr_] else []) ++ _patIdefinedInsts+ -- "GenerateCode.ag"(line 185, column 7)+ _lhsOpatternAttributes =+ (field_,attr_) : (_patIpatternAttributes ++ _partsIpatternAttributes)+ -- self rule+ _copy =+ Alias field_ attr_ _patIcopy _partsIcopy+ -- self rule+ _lhsOcopy =+ _copy+ ( _patIcopy,_patIdefinedInsts,_patIpatternAttributes) =+ (pat_ )+ ( _partsIcopy,_partsIdefinedInsts,_partsIpatternAttributes) =+ (parts_ )+ in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)))+sem_Pattern_Constr :: ConstructorIdent ->+ T_Patterns ->+ T_Pattern+sem_Pattern_Constr name_ (T_Patterns pats_) =+ (T_Pattern (let _lhsOdefinedInsts :: ([Identifier])+ _lhsOpatternAttributes :: ([(Identifier, Identifier)])+ _lhsOcopy :: Pattern+ _patsIcopy :: Patterns+ _patsIdefinedInsts :: ([Identifier])+ _patsIpatternAttributes :: ([(Identifier, Identifier)])+ -- use rule "GenerateCode.ag"(line 175, column 55)+ _lhsOdefinedInsts =+ _patsIdefinedInsts+ -- use rule "GenerateCode.ag"(line 182, column 47)+ _lhsOpatternAttributes =+ _patsIpatternAttributes+ -- self rule+ _copy =+ Constr name_ _patsIcopy+ -- self rule+ _lhsOcopy =+ _copy+ ( _patsIcopy,_patsIdefinedInsts,_patsIpatternAttributes) =+ (pats_ )+ in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)))+sem_Pattern_Irrefutable :: T_Pattern ->+ T_Pattern+sem_Pattern_Irrefutable (T_Pattern pat_) =+ (T_Pattern (let _lhsOdefinedInsts :: ([Identifier])+ _lhsOpatternAttributes :: ([(Identifier, Identifier)])+ _lhsOcopy :: Pattern+ _patIcopy :: Pattern+ _patIdefinedInsts :: ([Identifier])+ _patIpatternAttributes :: ([(Identifier, Identifier)])+ -- use rule "GenerateCode.ag"(line 175, column 55)+ _lhsOdefinedInsts =+ _patIdefinedInsts+ -- use rule "GenerateCode.ag"(line 182, column 47)+ _lhsOpatternAttributes =+ _patIpatternAttributes+ -- self rule+ _copy =+ Irrefutable _patIcopy+ -- self rule+ _lhsOcopy =+ _copy+ ( _patIcopy,_patIdefinedInsts,_patIpatternAttributes) =+ (pat_ )+ in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)))+sem_Pattern_Product :: Pos ->+ T_Patterns ->+ T_Pattern+sem_Pattern_Product pos_ (T_Patterns pats_) =+ (T_Pattern (let _lhsOdefinedInsts :: ([Identifier])+ _lhsOpatternAttributes :: ([(Identifier, Identifier)])+ _lhsOcopy :: Pattern+ _patsIcopy :: Patterns+ _patsIdefinedInsts :: ([Identifier])+ _patsIpatternAttributes :: ([(Identifier, Identifier)])+ -- use rule "GenerateCode.ag"(line 175, column 55)+ _lhsOdefinedInsts =+ _patsIdefinedInsts+ -- use rule "GenerateCode.ag"(line 182, column 47)+ _lhsOpatternAttributes =+ _patsIpatternAttributes+ -- self rule+ _copy =+ Product pos_ _patsIcopy+ -- self rule+ _lhsOcopy =+ _copy+ ( _patsIcopy,_patsIdefinedInsts,_patsIpatternAttributes) =+ (pats_ )+ in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)))+sem_Pattern_Underscore :: Pos ->+ T_Pattern+sem_Pattern_Underscore pos_ =+ (T_Pattern (let _lhsOdefinedInsts :: ([Identifier])+ _lhsOpatternAttributes :: ([(Identifier, Identifier)])+ _lhsOcopy :: Pattern+ -- use rule "GenerateCode.ag"(line 175, column 55)+ _lhsOdefinedInsts =+ []+ -- use rule "GenerateCode.ag"(line 182, column 47)+ _lhsOpatternAttributes =+ []+ -- self rule+ _copy =+ Underscore pos_+ -- self rule+ _lhsOcopy =+ _copy+ in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)))+-- Patterns ----------------------------------------------------+{-+ visit 0:+ synthesized attributes:+ copy : SELF+ definedInsts : [Identifier]+ patternAttributes : [(Identifier, Identifier)]+ 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,([Identifier]),([(Identifier, Identifier)])))+data Inh_Patterns = Inh_Patterns {}+data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns,definedInsts_Syn_Patterns :: [Identifier],patternAttributes_Syn_Patterns :: [(Identifier, Identifier)]}+wrap_Patterns (T_Patterns sem) (Inh_Patterns ) =+ (let ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes) =+ (sem )+ in (Syn_Patterns _lhsOcopy _lhsOdefinedInsts _lhsOpatternAttributes))+sem_Patterns_Cons :: T_Pattern ->+ T_Patterns ->+ T_Patterns+sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) =+ (T_Patterns (let _lhsOdefinedInsts :: ([Identifier])+ _lhsOpatternAttributes :: ([(Identifier, Identifier)])+ _lhsOcopy :: Patterns+ _hdIcopy :: Pattern+ _hdIdefinedInsts :: ([Identifier])+ _hdIpatternAttributes :: ([(Identifier, Identifier)])+ _tlIcopy :: Patterns+ _tlIdefinedInsts :: ([Identifier])+ _tlIpatternAttributes :: ([(Identifier, Identifier)])+ -- use rule "GenerateCode.ag"(line 175, column 55)+ _lhsOdefinedInsts =+ _hdIdefinedInsts ++ _tlIdefinedInsts+ -- use rule "GenerateCode.ag"(line 182, column 47)+ _lhsOpatternAttributes =+ _hdIpatternAttributes ++ _tlIpatternAttributes+ -- self rule+ _copy =+ (:) _hdIcopy _tlIcopy+ -- self rule+ _lhsOcopy =+ _copy+ ( _hdIcopy,_hdIdefinedInsts,_hdIpatternAttributes) =+ (hd_ )+ ( _tlIcopy,_tlIdefinedInsts,_tlIpatternAttributes) =+ (tl_ )+ in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)))+sem_Patterns_Nil :: T_Patterns+sem_Patterns_Nil =+ (T_Patterns (let _lhsOdefinedInsts :: ([Identifier])+ _lhsOpatternAttributes :: ([(Identifier, Identifier)])+ _lhsOcopy :: Patterns+ -- use rule "GenerateCode.ag"(line 175, column 55)+ _lhsOdefinedInsts =+ []+ -- use rule "GenerateCode.ag"(line 182, column 47)+ _lhsOpatternAttributes =+ []+ -- self rule+ _copy =+ []+ -- self rule+ _lhsOcopy =+ _copy+ in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)))+-- Sequence ----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ children : [(Identifier,Type,Bool)]+ con : ConstructorIdent+ higherOrderChildren : [(Identifier,Type,Bool)]+ inh : Attributes+ instVisitNrs : Map Identifier Int+ lastExpr : Expr+ nr : Int+ nt : NontermIdent+ o_case : Bool+ o_cata : Bool+ o_costcentre : Bool+ o_data : Maybe Bool+ o_linePragmas : Bool+ o_newtypes : Bool+ o_pretty : Bool+ o_rename : Bool+ o_sem : Bool+ o_sig : Bool+ o_splitsems : Bool+ o_strictwrap : Bool+ o_traces : Bool+ o_unbox : Bool+ paramInstMap : Map Identifier (NontermIdent, [String])+ paramMap : ParamMap+ prefix : String+ syn : Attributes+ terminals : [Identifier]+ what : String+ chained attributes:+ declsAbove : [Decl]+ errors : Seq Error+ synthesized attributes:+ allTpsFound : Bool+ blockDecls : DeclBlocks+ comments : [String]+ decls : Decls+ definedInsts : [Identifier]+ exprs : Exprs+ tSigs : [Decl]+ tps : [Type]+ usedVars : Set String+ alternatives:+ alternative Cons:+ child hd : CRule+ child tl : Sequence+ alternative Nil:+-}+-- cata+sem_Sequence :: Sequence ->+ T_Sequence+sem_Sequence list =+ (Prelude.foldr sem_Sequence_Cons sem_Sequence_Nil (Prelude.map sem_CRule list))+-- semantic domain+newtype T_Sequence = T_Sequence (([(Identifier,Type,Bool)]) ->+ ConstructorIdent ->+ ([Decl]) ->+ (Seq Error) ->+ ([(Identifier,Type,Bool)]) ->+ Attributes ->+ (Map Identifier Int) ->+ Expr ->+ Int ->+ NontermIdent ->+ Bool ->+ Bool ->+ Bool ->+ (Maybe Bool) ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ (Map Identifier (NontermIdent, [String])) ->+ ParamMap ->+ String ->+ Attributes ->+ ([Identifier]) ->+ String ->+ ( Bool,DeclBlocks,([String]),Decls,([Decl]),([Identifier]),(Seq Error),Exprs,([Decl]),([Type]),(Set String)))+data Inh_Sequence = Inh_Sequence {children_Inh_Sequence :: [(Identifier,Type,Bool)],con_Inh_Sequence :: ConstructorIdent,declsAbove_Inh_Sequence :: [Decl],errors_Inh_Sequence :: Seq Error,higherOrderChildren_Inh_Sequence :: [(Identifier,Type,Bool)],inh_Inh_Sequence :: Attributes,instVisitNrs_Inh_Sequence :: Map Identifier Int,lastExpr_Inh_Sequence :: Expr,nr_Inh_Sequence :: Int,nt_Inh_Sequence :: NontermIdent,o_case_Inh_Sequence :: Bool,o_cata_Inh_Sequence :: Bool,o_costcentre_Inh_Sequence :: Bool,o_data_Inh_Sequence :: Maybe Bool,o_linePragmas_Inh_Sequence :: Bool,o_newtypes_Inh_Sequence :: Bool,o_pretty_Inh_Sequence :: Bool,o_rename_Inh_Sequence :: Bool,o_sem_Inh_Sequence :: Bool,o_sig_Inh_Sequence :: Bool,o_splitsems_Inh_Sequence :: Bool,o_strictwrap_Inh_Sequence :: Bool,o_traces_Inh_Sequence :: Bool,o_unbox_Inh_Sequence :: Bool,paramInstMap_Inh_Sequence :: Map Identifier (NontermIdent, [String]),paramMap_Inh_Sequence :: ParamMap,prefix_Inh_Sequence :: String,syn_Inh_Sequence :: Attributes,terminals_Inh_Sequence :: [Identifier],what_Inh_Sequence :: String}+data Syn_Sequence = Syn_Sequence {allTpsFound_Syn_Sequence :: Bool,blockDecls_Syn_Sequence :: DeclBlocks,comments_Syn_Sequence :: [String],decls_Syn_Sequence :: Decls,declsAbove_Syn_Sequence :: [Decl],definedInsts_Syn_Sequence :: [Identifier],errors_Syn_Sequence :: Seq Error,exprs_Syn_Sequence :: Exprs,tSigs_Syn_Sequence :: [Decl],tps_Syn_Sequence :: [Type],usedVars_Syn_Sequence :: Set String}+wrap_Sequence (T_Sequence sem) (Inh_Sequence _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIerrors _lhsIhigherOrderChildren _lhsIinh _lhsIinstVisitNrs _lhsIlastExpr _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIwhat) =+ (let ( _lhsOallTpsFound,_lhsOblockDecls,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOerrors,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars) =+ (sem _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIerrors _lhsIhigherOrderChildren _lhsIinh _lhsIinstVisitNrs _lhsIlastExpr _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIwhat)+ in (Syn_Sequence _lhsOallTpsFound _lhsOblockDecls _lhsOcomments _lhsOdecls _lhsOdeclsAbove _lhsOdefinedInsts _lhsOerrors _lhsOexprs _lhsOtSigs _lhsOtps _lhsOusedVars))+sem_Sequence_Cons :: T_CRule ->+ T_Sequence ->+ T_Sequence+sem_Sequence_Cons (T_CRule hd_) (T_Sequence tl_) =+ (T_Sequence (\ _lhsIchildren+ _lhsIcon+ _lhsIdeclsAbove+ _lhsIerrors+ _lhsIhigherOrderChildren+ _lhsIinh+ _lhsIinstVisitNrs+ _lhsIlastExpr+ _lhsInr+ _lhsInt+ _lhsIo_case+ _lhsIo_cata+ _lhsIo_costcentre+ _lhsIo_data+ _lhsIo_linePragmas+ _lhsIo_newtypes+ _lhsIo_pretty+ _lhsIo_rename+ _lhsIo_sem+ _lhsIo_sig+ _lhsIo_splitsems+ _lhsIo_strictwrap+ _lhsIo_traces+ _lhsIo_unbox+ _lhsIparamInstMap+ _lhsIparamMap+ _lhsIprefix+ _lhsIsyn+ _lhsIterminals+ _lhsIwhat ->+ (let _lhsOblockDecls :: DeclBlocks+ _lhsOallTpsFound :: Bool+ _lhsOcomments :: ([String])+ _lhsOdecls :: Decls+ _lhsOdefinedInsts :: ([Identifier])+ _lhsOerrors :: (Seq Error)+ _lhsOexprs :: Exprs+ _lhsOtSigs :: ([Decl])+ _lhsOtps :: ([Type])+ _lhsOusedVars :: (Set String)+ _lhsOdeclsAbove :: ([Decl])+ _hdOchildren :: ([(Identifier,Type,Bool)])+ _hdOcon :: ConstructorIdent+ _hdOdeclsAbove :: ([Decl])+ _hdOerrors :: (Seq Error)+ _hdOhigherOrderChildren :: ([(Identifier,Type,Bool)])+ _hdOinh :: Attributes+ _hdOinstVisitNrs :: (Map Identifier Int)+ _hdOnr :: Int+ _hdOnt :: NontermIdent+ _hdOo_case :: Bool+ _hdOo_cata :: Bool+ _hdOo_costcentre :: Bool+ _hdOo_data :: (Maybe Bool)+ _hdOo_linePragmas :: Bool+ _hdOo_newtypes :: Bool+ _hdOo_pretty :: Bool+ _hdOo_rename :: Bool+ _hdOo_sem :: Bool+ _hdOo_sig :: Bool+ _hdOo_splitsems :: Bool+ _hdOo_strictwrap :: Bool+ _hdOo_traces :: Bool+ _hdOo_unbox :: Bool+ _hdOparamInstMap :: (Map Identifier (NontermIdent, [String]))+ _hdOparamMap :: ParamMap+ _hdOprefix :: String+ _hdOsyn :: Attributes+ _hdOterminals :: ([Identifier])+ _hdOwhat :: String+ _tlOchildren :: ([(Identifier,Type,Bool)])+ _tlOcon :: ConstructorIdent+ _tlOdeclsAbove :: ([Decl])+ _tlOerrors :: (Seq Error)+ _tlOhigherOrderChildren :: ([(Identifier,Type,Bool)])+ _tlOinh :: Attributes+ _tlOinstVisitNrs :: (Map Identifier Int)+ _tlOlastExpr :: Expr+ _tlOnr :: Int+ _tlOnt :: NontermIdent+ _tlOo_case :: Bool+ _tlOo_cata :: Bool+ _tlOo_costcentre :: Bool+ _tlOo_data :: (Maybe Bool)+ _tlOo_linePragmas :: Bool+ _tlOo_newtypes :: Bool+ _tlOo_pretty :: Bool+ _tlOo_rename :: Bool+ _tlOo_sem :: Bool+ _tlOo_sig :: Bool+ _tlOo_splitsems :: Bool+ _tlOo_strictwrap :: Bool+ _tlOo_traces :: Bool+ _tlOo_unbox :: Bool+ _tlOparamInstMap :: (Map Identifier (NontermIdent, [String]))+ _tlOparamMap :: ParamMap+ _tlOprefix :: String+ _tlOsyn :: Attributes+ _tlOterminals :: ([Identifier])+ _tlOwhat :: String+ _hdIallTpsFound :: Bool+ _hdIbldBlocksFun :: (DeclBlocks -> DeclBlocks)+ _hdIcomments :: ([String])+ _hdIdecls :: Decls+ _hdIdeclsAbove :: ([Decl])+ _hdIdefinedInsts :: ([Identifier])+ _hdIerrors :: (Seq Error)+ _hdIexprs :: Exprs+ _hdItSigs :: ([Decl])+ _hdItps :: ([Type])+ _hdIusedVars :: (Set String)+ _tlIallTpsFound :: Bool+ _tlIblockDecls :: DeclBlocks+ _tlIcomments :: ([String])+ _tlIdecls :: Decls+ _tlIdeclsAbove :: ([Decl])+ _tlIdefinedInsts :: ([Identifier])+ _tlIerrors :: (Seq Error)+ _tlIexprs :: Exprs+ _tlItSigs :: ([Decl])+ _tlItps :: ([Type])+ _tlIusedVars :: (Set String)+ -- "GenerateCode.ag"(line 452, column 7)+ _lhsOblockDecls =+ _hdIbldBlocksFun _tlIblockDecls+ -- use rule "GenerateCode.ag"(line 320, column 39)+ _lhsOallTpsFound =+ _hdIallTpsFound && _tlIallTpsFound+ -- use rule "GenerateCode.ag"(line 714, column 52)+ _lhsOcomments =+ _hdIcomments ++ _tlIcomments+ -- use rule "GenerateCode.ag"(line 122, column 34)+ _lhsOdecls =+ _hdIdecls ++ _tlIdecls+ -- use rule "GenerateCode.ag"(line 175, column 55)+ _lhsOdefinedInsts =+ _hdIdefinedInsts ++ _tlIdefinedInsts+ -- use rule "GenerateCode.ag"(line 695, column 32)+ _lhsOerrors =+ _hdIerrors Seq.<> _tlIerrors+ -- use rule "GenerateCode.ag"(line 248, column 34)+ _lhsOexprs =+ _hdIexprs ++ _tlIexprs+ -- use rule "GenerateCode.ag"(line 273, column 33)+ _lhsOtSigs =+ _hdItSigs ++ _tlItSigs+ -- use rule "GenerateCode.ag"(line 319, column 31)+ _lhsOtps =+ _hdItps ++ _tlItps+ -- use rule "GenerateCode.ag"(line 262, column 37)+ _lhsOusedVars =+ _hdIusedVars `Set.union` _tlIusedVars+ -- copy rule (up)+ _lhsOdeclsAbove =+ _tlIdeclsAbove+ -- copy rule (down)+ _hdOchildren =+ _lhsIchildren+ -- copy rule (down)+ _hdOcon =+ _lhsIcon+ -- copy rule (down)+ _hdOdeclsAbove =+ _lhsIdeclsAbove+ -- copy rule (down)+ _hdOerrors =+ _lhsIerrors+ -- copy rule (down)+ _hdOhigherOrderChildren =+ _lhsIhigherOrderChildren+ -- copy rule (down)+ _hdOinh =+ _lhsIinh+ -- copy rule (down)+ _hdOinstVisitNrs =+ _lhsIinstVisitNrs+ -- copy rule (down)+ _hdOnr =+ _lhsInr+ -- copy rule (down)+ _hdOnt =+ _lhsInt+ -- copy rule (down)+ _hdOo_case =+ _lhsIo_case+ -- copy rule (down)+ _hdOo_cata =+ _lhsIo_cata+ -- copy rule (down)+ _hdOo_costcentre =+ _lhsIo_costcentre+ -- copy rule (down)+ _hdOo_data =+ _lhsIo_data+ -- copy rule (down)+ _hdOo_linePragmas =+ _lhsIo_linePragmas+ -- copy rule (down)+ _hdOo_newtypes =+ _lhsIo_newtypes+ -- copy rule (down)+ _hdOo_pretty =+ _lhsIo_pretty+ -- copy rule (down)+ _hdOo_rename =+ _lhsIo_rename+ -- copy rule (down)+ _hdOo_sem =+ _lhsIo_sem+ -- copy rule (down)+ _hdOo_sig =+ _lhsIo_sig+ -- copy rule (down)+ _hdOo_splitsems =+ _lhsIo_splitsems+ -- copy rule (down)+ _hdOo_strictwrap =+ _lhsIo_strictwrap+ -- copy rule (down)+ _hdOo_traces =+ _lhsIo_traces+ -- copy rule (down)+ _hdOo_unbox =+ _lhsIo_unbox+ -- copy rule (down)+ _hdOparamInstMap =+ _lhsIparamInstMap+ -- copy rule (down)+ _hdOparamMap =+ _lhsIparamMap+ -- copy rule (down)+ _hdOprefix =+ _lhsIprefix+ -- copy rule (down)+ _hdOsyn =+ _lhsIsyn+ -- copy rule (down)+ _hdOterminals =+ _lhsIterminals+ -- copy rule (down)+ _hdOwhat =+ _lhsIwhat+ -- copy rule (down)+ _tlOchildren =+ _lhsIchildren+ -- copy rule (down)+ _tlOcon =+ _lhsIcon+ -- copy rule (chain)+ _tlOdeclsAbove =+ _hdIdeclsAbove+ -- copy rule (chain)+ _tlOerrors =+ _hdIerrors+ -- copy rule (down)+ _tlOhigherOrderChildren =+ _lhsIhigherOrderChildren+ -- copy rule (down)+ _tlOinh =+ _lhsIinh+ -- copy rule (down)+ _tlOinstVisitNrs =+ _lhsIinstVisitNrs+ -- copy rule (down)+ _tlOlastExpr =+ _lhsIlastExpr+ -- copy rule (down)+ _tlOnr =+ _lhsInr+ -- copy rule (down)+ _tlOnt =+ _lhsInt+ -- copy rule (down)+ _tlOo_case =+ _lhsIo_case+ -- copy rule (down)+ _tlOo_cata =+ _lhsIo_cata+ -- copy rule (down)+ _tlOo_costcentre =+ _lhsIo_costcentre+ -- copy rule (down)+ _tlOo_data =+ _lhsIo_data+ -- copy rule (down)+ _tlOo_linePragmas =+ _lhsIo_linePragmas+ -- copy rule (down)+ _tlOo_newtypes =+ _lhsIo_newtypes+ -- copy rule (down)+ _tlOo_pretty =+ _lhsIo_pretty+ -- copy rule (down)+ _tlOo_rename =+ _lhsIo_rename+ -- copy rule (down)+ _tlOo_sem =+ _lhsIo_sem+ -- copy rule (down)+ _tlOo_sig =+ _lhsIo_sig+ -- copy rule (down)+ _tlOo_splitsems =+ _lhsIo_splitsems+ -- copy rule (down)+ _tlOo_strictwrap =+ _lhsIo_strictwrap+ -- copy rule (down)+ _tlOo_traces =+ _lhsIo_traces+ -- copy rule (down)+ _tlOo_unbox =+ _lhsIo_unbox+ -- copy rule (down)+ _tlOparamInstMap =+ _lhsIparamInstMap+ -- copy rule (down)+ _tlOparamMap =+ _lhsIparamMap+ -- copy rule (down)+ _tlOprefix =+ _lhsIprefix+ -- copy rule (down)+ _tlOsyn =+ _lhsIsyn+ -- copy rule (down)+ _tlOterminals =+ _lhsIterminals+ -- copy rule (down)+ _tlOwhat =+ _lhsIwhat+ ( _hdIallTpsFound,_hdIbldBlocksFun,_hdIcomments,_hdIdecls,_hdIdeclsAbove,_hdIdefinedInsts,_hdIerrors,_hdIexprs,_hdItSigs,_hdItps,_hdIusedVars) =+ (hd_ _hdOchildren _hdOcon _hdOdeclsAbove _hdOerrors _hdOhigherOrderChildren _hdOinh _hdOinstVisitNrs _hdOnr _hdOnt _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOparamInstMap _hdOparamMap _hdOprefix _hdOsyn _hdOterminals _hdOwhat)+ ( _tlIallTpsFound,_tlIblockDecls,_tlIcomments,_tlIdecls,_tlIdeclsAbove,_tlIdefinedInsts,_tlIerrors,_tlIexprs,_tlItSigs,_tlItps,_tlIusedVars) =+ (tl_ _tlOchildren _tlOcon _tlOdeclsAbove _tlOerrors _tlOhigherOrderChildren _tlOinh _tlOinstVisitNrs _tlOlastExpr _tlOnr _tlOnt _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOparamInstMap _tlOparamMap _tlOprefix _tlOsyn _tlOterminals _tlOwhat)+ in ( _lhsOallTpsFound,_lhsOblockDecls,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOerrors,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars))))+sem_Sequence_Nil :: T_Sequence+sem_Sequence_Nil =+ (T_Sequence (\ _lhsIchildren+ _lhsIcon+ _lhsIdeclsAbove+ _lhsIerrors+ _lhsIhigherOrderChildren+ _lhsIinh+ _lhsIinstVisitNrs+ _lhsIlastExpr+ _lhsInr+ _lhsInt+ _lhsIo_case+ _lhsIo_cata+ _lhsIo_costcentre+ _lhsIo_data+ _lhsIo_linePragmas+ _lhsIo_newtypes+ _lhsIo_pretty+ _lhsIo_rename+ _lhsIo_sem+ _lhsIo_sig+ _lhsIo_splitsems+ _lhsIo_strictwrap+ _lhsIo_traces+ _lhsIo_unbox+ _lhsIparamInstMap+ _lhsIparamMap+ _lhsIprefix+ _lhsIsyn+ _lhsIterminals+ _lhsIwhat ->+ (let _lhsOblockDecls :: DeclBlocks+ _lhsOallTpsFound :: Bool+ _lhsOcomments :: ([String])+ _lhsOdecls :: Decls+ _lhsOdefinedInsts :: ([Identifier])+ _lhsOerrors :: (Seq Error)+ _lhsOexprs :: Exprs+ _lhsOtSigs :: ([Decl])+ _lhsOtps :: ([Type])+ _lhsOusedVars :: (Set String)+ _lhsOdeclsAbove :: ([Decl])+ -- "GenerateCode.ag"(line 454, column 7)+ _lhsOblockDecls =+ DeclTerminator _lhsIdeclsAbove _lhsIlastExpr+ -- use rule "GenerateCode.ag"(line 320, column 39)+ _lhsOallTpsFound =+ True+ -- use rule "GenerateCode.ag"(line 714, column 52)+ _lhsOcomments =+ []+ -- use rule "GenerateCode.ag"(line 122, column 34)+ _lhsOdecls =+ []+ -- use rule "GenerateCode.ag"(line 175, column 55)+ _lhsOdefinedInsts =+ []+ -- use rule "GenerateCode.ag"(line 695, column 32)+ _lhsOerrors =+ Seq.empty+ -- use rule "GenerateCode.ag"(line 248, column 34)+ _lhsOexprs =+ []+ -- use rule "GenerateCode.ag"(line 273, column 33)+ _lhsOtSigs =+ []+ -- use rule "GenerateCode.ag"(line 319, column 31)+ _lhsOtps =+ []+ -- use rule "GenerateCode.ag"(line 262, column 37)+ _lhsOusedVars =+ Set.empty+ -- copy rule (chain)+ _lhsOdeclsAbove =+ _lhsIdeclsAbove+ in ( _lhsOallTpsFound,_lhsOblockDecls,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOerrors,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars))))
src-derived/HsToken.hs view
@@ -1,4 +1,3 @@- -- UUAGC 0.9.5 (HsToken.ag) module HsToken where @@ -8,12 +7,14 @@ {- alternatives: alternative AGField:- child field : {Name}- child attr : {Name}+ child field : {Identifier}+ child attr : {Identifier} child pos : {Pos}+ child rdesc : {Maybe String} alternative AGLocal:- child var : {Name}+ child var : {Identifier} child pos : {Pos}+ child rdesc : {Maybe String} alternative CharToken: child value : {String} child pos : {Pos}@@ -27,12 +28,12 @@ child value : {String} child pos : {Pos} -}-data HsToken = AGField (Name) (Name) (Pos) - | AGLocal (Name) (Pos) - | CharToken (String) (Pos) - | Err (String) (Pos) - | HsToken (String) (Pos) - | StrToken (String) (Pos) +data HsToken = AGField (Identifier) (Identifier) (Pos) (Maybe String)+ | AGLocal (Identifier) (Pos) (Maybe String)+ | CharToken (String) (Pos)+ | Err (String) (Pos)+ | HsToken (String) (Pos)+ | StrToken (String) (Pos) -- HsTokens ---------------------------------------------------- {- alternatives:@@ -48,4 +49,4 @@ alternative HsTokensRoot: child tokens : HsTokens -}-data HsTokensRoot = HsTokensRoot (HsTokens) +data HsTokensRoot = HsTokensRoot (HsTokens)
src-derived/Interfaces.hs view
@@ -8,24 +8,24 @@ {- alternatives: alternative IRoot:- child inters : Interfaces+ child inters : Interfaces -} data IRoot = IRoot (Interfaces) -- Interface --------------------------------------------------- {- alternatives: alternative Interface:- child nt : {Nonterminal}- child cons : {[Constructor]}- child seg : Segments+ child nt : {NontermIdent}+ child cons : {[ConstructorIdent]}+ child seg : Segments -}-data Interface = Interface (Nonterminal) ([Constructor]) (Segments) +data Interface = Interface (NontermIdent) ([ConstructorIdent]) (Segments) -- Interfaces -------------------------------------------------- {- alternatives: alternative Cons:- child hd : Interface- child tl : Interfaces+ child hd : Interface + child tl : Interfaces alternative Nil: -} type Interfaces = [Interface]@@ -41,8 +41,8 @@ {- alternatives: alternative Cons:- child hd : Segment- child tl : Segments+ child hd : Segment + child tl : Segments alternative Nil: -} type Segments = [Segment]
src-derived/InterfacesRules.hs view
@@ -15,20 +15,23 @@ import Data.Tree(Tree(Node)) import Data.Graph(Graph, dfs, edges, buildG, transposeG) import Data.Maybe (fromJust)-import Data.List (partition,transpose,(\\),nub,intersect)+import Data.List (partition,transpose,(\\),nub,intersect, findIndex) import Data.Array ((!),inRange,bounds,assocs) import Debug.Trace(trace) + import CommonTypes import SequentialTypes type VisitSS = [Vertex] + gather :: Info -> [Vertex] -> [[Vertex]] gather info = eqClasses comp where comp a b = isEqualField (ruleTable info ! a) (ruleTable info ! b) + -- Only non-empty syn will ever be forced, because visits with empty syn are never performed -- Right hand side synthesized attributes always have a field cv :: (Vertex -> CRule) -> Int -> Vertex -> ([Vertex],[Vertex]) -> (Vertex,ChildVisit)@@ -37,18 +40,23 @@ d = ChildVisit fld rnt n inh syn in (v,d) + ed v (inh,syn) = map (\i -> (i,v)) inh ++ map (\s -> (v,s)) syn + postorder (Node a ts) = postorderF ts ++ [a] postorderF = concatMap postorder postOrd g = postorderF . dfs g topSort' g = postOrd g + type IntraVisit = [Vertex] + swap (a,b) = (b,a) -ccv :: Name -> Nonterminal -> Int -> CInterfaceMap -> CRule++ccv :: Identifier -> NontermIdent -> Int -> CInterfaceMap -> CRule ccv name nt n table = CChildVisit name nt n inh syn last where CInterface segs = Map.findWithDefault (error ("InterfacesRules::ccv::interfaces not in table for nt: " ++ show nt)) nt table@@ -68,7 +76,7 @@ visits : CVisitsMap alternatives: alternative IRoot:- child inters : Interfaces+ child inters : Interfaces visit 0: local newedges : _ local visitssGraph : _@@ -137,13 +145,13 @@ _intersOprev = let terminals = [ v | (v,cr) <- assocs (ruleTable _lhsIinfo), not (getHasCode cr), isLocal cr ] in _intersIfirstvisitvertices ++ terminals- -- "InterfacesRules.lag"(line 325, column 12)+ -- "InterfacesRules.lag"(line 328, column 12) _intersOddp = buildG (0,_intersIv-1) (map swap (_lhsIdpr ++ _newedges))- -- "InterfacesRules.lag"(line 362, column 13)+ -- "InterfacesRules.lag"(line 365, column 13) _intersOallInters = _intersIinters- -- "InterfacesRules.lag"(line 422, column 13)+ -- "InterfacesRules.lag"(line 425, column 13) _lhsOedp = Seq.toList _intersIedp -- copy rule (up)@@ -176,13 +184,13 @@ firstvisitvertices : [Vertex] inter : CInterface newedges : Seq Edge - nt : Nonterminal- visits : Map Constructor CVisits+ nt : NontermIdent+ visits : Map ConstructorIdent CVisits alternatives: alternative Interface:- child nt : {Nonterminal}- child cons : {[Constructor]}- child seg : Segments+ child nt : {NontermIdent}+ child cons : {[ConstructorIdent]}+ child seg : Segments visit 0: local v : _ local firstvisitvertices : _@@ -203,15 +211,15 @@ Vertex -> (Map Vertex ChildVisit) -> Graph ->- ( (Seq (Vertex,ChildVisit)),(Seq Edge),([Vertex]),CInterface,(Seq Edge ),Nonterminal,Vertex,(Map Constructor CVisits)))+ ( (Seq (Vertex,ChildVisit)),(Seq Edge),([Vertex]),CInterface,(Seq Edge ),NontermIdent,Vertex,(Map ConstructorIdent CVisits))) data Inh_Interface = Inh_Interface {allInters_Inh_Interface :: CInterfaceMap,ddp_Inh_Interface :: Graph,info_Inh_Interface :: Info,prev_Inh_Interface :: [Vertex],v_Inh_Interface :: Vertex,visitDescr_Inh_Interface :: Map Vertex ChildVisit,vssGraph_Inh_Interface :: Graph}-data Syn_Interface = Syn_Interface {descr_Syn_Interface :: Seq (Vertex,ChildVisit),edp_Syn_Interface :: Seq Edge,firstvisitvertices_Syn_Interface :: [Vertex],inter_Syn_Interface :: CInterface,newedges_Syn_Interface :: Seq Edge ,nt_Syn_Interface :: Nonterminal,v_Syn_Interface :: Vertex,visits_Syn_Interface :: Map Constructor CVisits}+data Syn_Interface = Syn_Interface {descr_Syn_Interface :: Seq (Vertex,ChildVisit),edp_Syn_Interface :: Seq Edge,firstvisitvertices_Syn_Interface :: [Vertex],inter_Syn_Interface :: CInterface,newedges_Syn_Interface :: Seq Edge ,nt_Syn_Interface :: NontermIdent,v_Syn_Interface :: Vertex,visits_Syn_Interface :: Map ConstructorIdent CVisits} wrap_Interface (T_Interface sem ) (Inh_Interface _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) = (let ( _lhsOdescr,_lhsOedp,_lhsOfirstvisitvertices,_lhsOinter,_lhsOnewedges,_lhsOnt,_lhsOv,_lhsOvisits) = (sem _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) in (Syn_Interface _lhsOdescr _lhsOedp _lhsOfirstvisitvertices _lhsOinter _lhsOnewedges _lhsOnt _lhsOv _lhsOvisits ))-sem_Interface_Interface :: Nonterminal ->- ([Constructor]) ->+sem_Interface_Interface :: NontermIdent ->+ ([ConstructorIdent]) -> T_Segments -> T_Interface sem_Interface_Interface nt_ cons_ (T_Segments seg_ ) =@@ -227,12 +235,12 @@ _lhsOnewedges :: (Seq Edge ) _lhsOdescr :: (Seq (Vertex,ChildVisit)) _segOn :: Int- _segOcons :: ([Constructor])+ _segOcons :: ([ConstructorIdent]) _segOisFirst :: Bool _segOfromLhs :: ([Vertex])- _lhsOnt :: Nonterminal+ _lhsOnt :: NontermIdent _lhsOinter :: CInterface- _lhsOvisits :: (Map Constructor CVisits)+ _lhsOvisits :: (Map ConstructorIdent CVisits) _lhsOedp :: (Seq Edge) _lhsOfirstvisitvertices :: ([Vertex]) _segOallInters :: CInterfaceMap@@ -285,22 +293,22 @@ -- "InterfacesRules.lag"(line 223, column 16) _segOcons = cons_- -- "InterfacesRules.lag"(line 296, column 16)+ -- "InterfacesRules.lag"(line 299, column 16) _segOisFirst = True- -- "InterfacesRules.lag"(line 333, column 16)+ -- "InterfacesRules.lag"(line 336, column 16) _segOfromLhs = _lhsIprev- -- "InterfacesRules.lag"(line 373, column 16)+ -- "InterfacesRules.lag"(line 376, column 16) _lhsOnt = nt_- -- "InterfacesRules.lag"(line 377, column 17)+ -- "InterfacesRules.lag"(line 380, column 17) _lhsOinter = CInterface _segIsegs- -- "InterfacesRules.lag"(line 378, column 17)+ -- "InterfacesRules.lag"(line 381, column 17) _lhsOvisits = Map.fromList (zip cons_ (transpose _segIcvisits))- -- use rule "InterfacesRules.lag"(line 417, column 54)+ -- use rule "InterfacesRules.lag"(line 420, column 54) _lhsOedp = _segIedp -- use rule "InterfacesRules.lag"(line 244, column 70)@@ -348,8 +356,8 @@ visits : CVisitsMap alternatives: alternative Cons:- child hd : Interface- child tl : Interfaces+ child hd : Interface + child tl : Interfaces alternative Nil: -} -- cata@@ -409,9 +417,9 @@ _hdIfirstvisitvertices :: ([Vertex]) _hdIinter :: CInterface _hdInewedges :: (Seq Edge )- _hdInt :: Nonterminal+ _hdInt :: NontermIdent _hdIv :: Vertex- _hdIvisits :: (Map Constructor CVisits)+ _hdIvisits :: (Map ConstructorIdent CVisits) _tlIdescr :: (Seq (Vertex,ChildVisit)) _tlIedp :: (Seq Edge) _tlIfirstvisitvertices :: ([Vertex])@@ -419,16 +427,16 @@ _tlInewedges :: (Seq Edge ) _tlIv :: Vertex _tlIvisits :: CVisitsMap- -- "InterfacesRules.lag"(line 367, column 12)+ -- "InterfacesRules.lag"(line 370, column 12) _lhsOinters = Map.insert _hdInt _hdIinter _tlIinters- -- "InterfacesRules.lag"(line 368, column 12)+ -- "InterfacesRules.lag"(line 371, column 12) _lhsOvisits = Map.insert _hdInt _hdIvisits _tlIvisits -- use rule "InterfacesRules.lag"(line 118, column 20) _lhsOdescr = _hdIdescr Seq.<> _tlIdescr- -- use rule "InterfacesRules.lag"(line 417, column 54)+ -- use rule "InterfacesRules.lag"(line 420, column 54) _lhsOedp = _hdIedp Seq.<> _tlIedp -- use rule "InterfacesRules.lag"(line 244, column 70)@@ -503,16 +511,16 @@ _lhsOfirstvisitvertices :: ([Vertex]) _lhsOnewedges :: (Seq Edge ) _lhsOv :: Vertex- -- "InterfacesRules.lag"(line 369, column 12)+ -- "InterfacesRules.lag"(line 372, column 12) _lhsOinters = Map.empty- -- "InterfacesRules.lag"(line 370, column 12)+ -- "InterfacesRules.lag"(line 373, column 12) _lhsOvisits = Map.empty -- use rule "InterfacesRules.lag"(line 118, column 20) _lhsOdescr = Seq.empty- -- use rule "InterfacesRules.lag"(line 417, column 54)+ -- use rule "InterfacesRules.lag"(line 420, column 54) _lhsOedp = Seq.empty -- use rule "InterfacesRules.lag"(line 244, column 70)@@ -530,7 +538,7 @@ visit 0: inherited attributes: allInters : CInterfaceMap- cons : [Constructor]+ cons : [ConstructorIdent] ddp : Graph fromLhs : [Vertex] info : Info@@ -587,7 +595,7 @@ (sem_Segment_Segment _inh _syn ) -- semantic domain newtype T_Segment = T_Segment (CInterfaceMap ->- ([Constructor]) ->+ ([ConstructorIdent]) -> Graph -> ([Vertex]) -> Info ->@@ -601,7 +609,7 @@ (Map Vertex ChildVisit) -> Graph -> ( ([CVisit]),(Seq (Vertex,ChildVisit)),(Seq Edge),([([Vertex],[Vertex])]),([Vertex]),([IntraVisit]),(Seq Edge ),([Vertex]),([Vertex]),CSegment,Vertex,([VisitSS])))-data Inh_Segment = Inh_Segment {allInters_Inh_Segment :: CInterfaceMap,cons_Inh_Segment :: [Constructor],ddp_Inh_Segment :: Graph,fromLhs_Inh_Segment :: [Vertex],info_Inh_Segment :: Info,isFirst_Inh_Segment :: Bool,n_Inh_Segment :: Int,nextInh_Inh_Segment :: [Vertex],nextIntravisits_Inh_Segment :: [IntraVisit],nextNewvertices_Inh_Segment :: [Vertex],prev_Inh_Segment :: [Vertex],v_Inh_Segment :: Vertex,visitDescr_Inh_Segment :: Map Vertex ChildVisit,vssGraph_Inh_Segment :: Graph}+data Inh_Segment = Inh_Segment {allInters_Inh_Segment :: CInterfaceMap,cons_Inh_Segment :: [ConstructorIdent],ddp_Inh_Segment :: Graph,fromLhs_Inh_Segment :: [Vertex],info_Inh_Segment :: Info,isFirst_Inh_Segment :: Bool,n_Inh_Segment :: Int,nextInh_Inh_Segment :: [Vertex],nextIntravisits_Inh_Segment :: [IntraVisit],nextNewvertices_Inh_Segment :: [Vertex],prev_Inh_Segment :: [Vertex],v_Inh_Segment :: Vertex,visitDescr_Inh_Segment :: Map Vertex ChildVisit,vssGraph_Inh_Segment :: Graph} data Syn_Segment = Syn_Segment {cvisits_Syn_Segment :: [CVisit],descr_Syn_Segment :: Seq (Vertex,ChildVisit),edp_Syn_Segment :: Seq Edge,groups_Syn_Segment :: [([Vertex],[Vertex])],inh_Syn_Segment :: [Vertex],intravisits_Syn_Segment :: [IntraVisit],newedges_Syn_Segment :: Seq Edge ,newvertices_Syn_Segment :: [Vertex],prev_Syn_Segment :: [Vertex],seg_Syn_Segment :: CSegment,v_Syn_Segment :: Vertex,visitss_Syn_Segment :: [VisitSS]} wrap_Segment (T_Segment sem ) (Inh_Segment _lhsIallInters _lhsIcons _lhsIddp _lhsIfromLhs _lhsIinfo _lhsIisFirst _lhsIn _lhsInextInh _lhsInextIntravisits _lhsInextNewvertices _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) = (let ( _lhsOcvisits,_lhsOdescr,_lhsOedp,_lhsOgroups,_lhsOinh,_lhsOintravisits,_lhsOnewedges,_lhsOnewvertices,_lhsOprev,_lhsOseg,_lhsOv,_lhsOvisitss) =@@ -691,51 +699,54 @@ _lhsIprev ++ _defined -- "InterfacesRules.lag"(line 269, column 15) _visitss =- let rem :: [(Name,Name,Maybe Type)] -> [Vertex] -> [Vertex]+ let rem :: [(Identifier,Identifier,Maybe Type)] -> [Vertex] -> [Vertex] rem prev [] = [] rem prev (v:vs) | inRange (bounds table) v = let cr = table ! v- addV = if (getField cr,getAttr cr,getType cr) `elem` prev- then id- else (v:)+ addV = case findIndex cmp prev of+ Just _ -> id+ _ -> (v:)+ cmp (fld,attr,tp) = getField cr == fld && getAttr cr == attr && sameNT (getType cr) tp+ sameNT (Just (NT ntA _)) (Just (NT ntB _)) = ntA == ntB+ sameNT _ _ = False def = Map.elems (getDefines cr) in addV (rem (def ++ prev) vs) | otherwise = v:rem prev vs table = ruleTable _lhsIinfo in map (rem []) _visitss'- -- "InterfacesRules.lag"(line 338, column 15)+ -- "InterfacesRules.lag"(line 341, column 15) _fromLhs = _occurAs isLhs inh_ ++ _lhsIfromLhs- -- "InterfacesRules.lag"(line 339, column 15)+ -- "InterfacesRules.lag"(line 342, column 15) _computed = let computes v = case Map.lookup v _lhsIvisitDescr of Nothing -> Map.keys (getDefines (ruleTable _lhsIinfo ! v)) Just (ChildVisit _ _ _ _ syn) -> v:syn in concatMap (concatMap computes) _visitss- -- "InterfacesRules.lag"(line 343, column 15)+ -- "InterfacesRules.lag"(line 346, column 15) _intravisits = zipWith _iv _visitss _lhsInextIntravisits- -- "InterfacesRules.lag"(line 344, column 15)+ -- "InterfacesRules.lag"(line 347, column 15) _iv = \vs next -> let needed = concatMap (_lhsIddp !) vs in nub (needed ++ next) \\ (_fromLhs ++ _computed)- -- "InterfacesRules.lag"(line 387, column 15)+ -- "InterfacesRules.lag"(line 390, column 15) _lhsOseg = if False then undefined _lhsIvssGraph _lhsIvisitDescr _lhsIprev else CSegment _inhmap _synmap- -- "InterfacesRules.lag"(line 389, column 19)+ -- "InterfacesRules.lag"(line 392, column 19) __tup1 = let makemap = Map.fromList . map findType findType v = getNtaNameType (attrTable _lhsIinfo ! v) in (makemap inh_,makemap syn_)- -- "InterfacesRules.lag"(line 389, column 19)+ -- "InterfacesRules.lag"(line 392, column 19) (_inhmap,_) = __tup1- -- "InterfacesRules.lag"(line 389, column 19)+ -- "InterfacesRules.lag"(line 392, column 19) (_,_synmap) = __tup1- -- "InterfacesRules.lag"(line 392, column 15)+ -- "InterfacesRules.lag"(line 395, column 15) _lhsOcvisits = let mkVisit vss intra = CVisit _inhmap _synmap (mkSequence vss) (mkSequence intra) True mkSequence = map mkRule@@ -743,11 +754,11 @@ Nothing -> ruleTable _lhsIinfo ! v Just (ChildVisit name nt n _ _) -> ccv name nt n _lhsIallInters in zipWith mkVisit _visitss _intravisits- -- "InterfacesRules.lag"(line 419, column 14)+ -- "InterfacesRules.lag"(line 422, column 14) _lhsOedp = Seq.fromList [(i,s) | i <- inh_, s <- syn_] Seq.<> Seq.fromList [(s,i) | s <- syn_, i <- _lhsInextInh ]- -- "InterfacesRules.lag"(line 424, column 14)+ -- "InterfacesRules.lag"(line 427, column 14) _lhsOinh = inh_ -- copy rule (from local)@@ -771,7 +782,7 @@ visit 0: inherited attributes: allInters : CInterfaceMap- cons : [Constructor]+ cons : [ConstructorIdent] ddp : Graph fromLhs : [Vertex] info : Info@@ -794,8 +805,8 @@ segs : CSegments alternatives: alternative Cons:- child hd : Segment- child tl : Segments+ child hd : Segment + child tl : Segments alternative Nil: -} -- cata@@ -805,7 +816,7 @@ (Prelude.foldr sem_Segments_Cons sem_Segments_Nil (Prelude.map sem_Segment list) ) -- semantic domain newtype T_Segments = T_Segments (CInterfaceMap ->- ([Constructor]) ->+ ([ConstructorIdent]) -> Graph -> ([Vertex]) -> Info ->@@ -816,7 +827,7 @@ (Map Vertex ChildVisit) -> Graph -> ( ([[CVisit]]),(Seq (Vertex,ChildVisit)),(Seq Edge),([Vertex]),([([Vertex],[Vertex])]),([IntraVisit]),(Seq Edge ),([Vertex]),([Vertex]),CSegments,Vertex))-data Inh_Segments = Inh_Segments {allInters_Inh_Segments :: CInterfaceMap,cons_Inh_Segments :: [Constructor],ddp_Inh_Segments :: Graph,fromLhs_Inh_Segments :: [Vertex],info_Inh_Segments :: Info,isFirst_Inh_Segments :: Bool,n_Inh_Segments :: Int,prev_Inh_Segments :: [Vertex],v_Inh_Segments :: Vertex,visitDescr_Inh_Segments :: Map Vertex ChildVisit,vssGraph_Inh_Segments :: Graph}+data Inh_Segments = Inh_Segments {allInters_Inh_Segments :: CInterfaceMap,cons_Inh_Segments :: [ConstructorIdent],ddp_Inh_Segments :: Graph,fromLhs_Inh_Segments :: [Vertex],info_Inh_Segments :: Info,isFirst_Inh_Segments :: Bool,n_Inh_Segments :: Int,prev_Inh_Segments :: [Vertex],v_Inh_Segments :: Vertex,visitDescr_Inh_Segments :: Map Vertex ChildVisit,vssGraph_Inh_Segments :: Graph} data Syn_Segments = Syn_Segments {cvisits_Syn_Segments :: [[CVisit]],descr_Syn_Segments :: Seq (Vertex,ChildVisit),edp_Syn_Segments :: Seq Edge,firstInh_Syn_Segments :: [Vertex],groups_Syn_Segments :: [([Vertex],[Vertex])],hdIntravisits_Syn_Segments :: [IntraVisit],newedges_Syn_Segments :: Seq Edge ,newvertices_Syn_Segments :: [Vertex],prev_Syn_Segments :: [Vertex],segs_Syn_Segments :: CSegments,v_Syn_Segments :: Vertex} wrap_Segments (T_Segments sem ) (Inh_Segments _lhsIallInters _lhsIcons _lhsIddp _lhsIfromLhs _lhsIinfo _lhsIisFirst _lhsIn _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) = (let ( _lhsOcvisits,_lhsOdescr,_lhsOedp,_lhsOfirstInh,_lhsOgroups,_lhsOhdIntravisits,_lhsOnewedges,_lhsOnewvertices,_lhsOprev,_lhsOsegs,_lhsOv) =@@ -856,7 +867,7 @@ _lhsOprev :: ([Vertex]) _lhsOv :: Vertex _hdOallInters :: CInterfaceMap- _hdOcons :: ([Constructor])+ _hdOcons :: ([ConstructorIdent]) _hdOddp :: Graph _hdOinfo :: Info _hdOisFirst :: Bool@@ -866,7 +877,7 @@ _hdOvisitDescr :: (Map Vertex ChildVisit) _hdOvssGraph :: Graph _tlOallInters :: CInterfaceMap- _tlOcons :: ([Constructor])+ _tlOcons :: ([ConstructorIdent]) _tlOddp :: Graph _tlOinfo :: Info _tlOprev :: ([Vertex])@@ -908,37 +919,37 @@ -- "InterfacesRules.lag"(line 193, column 11) _tlOn = _lhsIn + 1- -- "InterfacesRules.lag"(line 298, column 11)+ -- "InterfacesRules.lag"(line 301, column 11) _tlOisFirst = False- -- "InterfacesRules.lag"(line 311, column 12)+ -- "InterfacesRules.lag"(line 314, column 12) _hdOnextIntravisits = _tlIhdIntravisits- -- "InterfacesRules.lag"(line 312, column 12)+ -- "InterfacesRules.lag"(line 315, column 12) _lhsOhdIntravisits = _hdIintravisits- -- "InterfacesRules.lag"(line 335, column 12)+ -- "InterfacesRules.lag"(line 338, column 12) _hdOfromLhs = _lhsIfromLhs- -- "InterfacesRules.lag"(line 336, column 12)+ -- "InterfacesRules.lag"(line 339, column 12) _tlOfromLhs = []- -- "InterfacesRules.lag"(line 382, column 12)+ -- "InterfacesRules.lag"(line 385, column 12) _lhsOsegs = _hdIseg : _tlIsegs- -- "InterfacesRules.lag"(line 426, column 12)+ -- "InterfacesRules.lag"(line 429, column 12) _hdOnextInh = _tlIfirstInh- -- "InterfacesRules.lag"(line 427, column 12)+ -- "InterfacesRules.lag"(line 430, column 12) _lhsOfirstInh = _hdIinh- -- use rule "InterfacesRules.lag"(line 381, column 29)+ -- use rule "InterfacesRules.lag"(line 384, column 29) _lhsOcvisits = _hdIcvisits : _tlIcvisits -- use rule "InterfacesRules.lag"(line 118, column 20) _lhsOdescr = _hdIdescr Seq.<> _tlIdescr- -- use rule "InterfacesRules.lag"(line 417, column 54)+ -- use rule "InterfacesRules.lag"(line 420, column 54) _lhsOedp = _hdIedp Seq.<> _tlIedp -- use rule "InterfacesRules.lag"(line 117, column 23)@@ -1039,22 +1050,22 @@ -- "InterfacesRules.lag"(line 173, column 11) _lhsOgroups = []- -- "InterfacesRules.lag"(line 313, column 10)+ -- "InterfacesRules.lag"(line 316, column 10) _lhsOhdIntravisits = repeat []- -- "InterfacesRules.lag"(line 383, column 12)+ -- "InterfacesRules.lag"(line 386, column 12) _lhsOsegs = []- -- "InterfacesRules.lag"(line 428, column 11)+ -- "InterfacesRules.lag"(line 431, column 11) _lhsOfirstInh = []- -- use rule "InterfacesRules.lag"(line 381, column 29)+ -- use rule "InterfacesRules.lag"(line 384, column 29) _lhsOcvisits = [] -- use rule "InterfacesRules.lag"(line 118, column 20) _lhsOdescr = Seq.empty- -- use rule "InterfacesRules.lag"(line 417, column 54)+ -- use rule "InterfacesRules.lag"(line 420, column 54) _lhsOedp = Seq.empty -- use rule "InterfacesRules.lag"(line 117, column 23)
src-derived/Order.hs view
@@ -1,3399 +1,3481 @@---- UUAGC 0.9.5 (Order.ag)-module Order where---- From uuagc-import CommonTypes-import Patterns-import ErrorMessages-import AbstractSyntax-import Code hiding (Type)-import qualified Code-import Expression-import Options-import SequentialComputation-import SequentialTypes-import CodeSyntax-import GrammarInfo-import HsToken(HsTokensRoot(HsTokensRoot))-import HsTokenScanner(lexTokens)-import SemHsTokens(sem_HsTokensRoot,wrap_HsTokensRoot, Syn_HsTokensRoot(..),Inh_HsTokensRoot(..))--- From uulib-import qualified Data.Map as Map-import qualified Data.Set as Set-import qualified UU.DData.Seq as Seq-import Data.Map(Map) -import Data.Set(Set)-import UU.DData.Seq(Seq, (<>)) -import UU.Util.Utils-import UU.Scanner.Position(Pos(..),initPos)---- From haskell libraries-import Control.Monad(liftM)-import qualified Data.Array as Array-import Data.Array((!),bounds,inRange)-import Data.List(elemIndex,partition,sort,mapAccumL,find,nubBy,intersperse,groupBy,transpose)-import qualified Data.Tree as Tree-import Maybe---- Patterns.ag imports-import UU.Scanner.Position(Pos)-import CommonTypes (Constructor,Name)--import UU.Scanner.Position(Pos)---- AbstractSyntax.ag imports-import Data.Set(Set)-import Data.Map(Map)-import Patterns (Pattern(..),Patterns)-import Expression (Expression(..))-import CommonTypes---- Terminates with an error if the key is not in the map-findWithErr1 :: (Ord k, Show k) => String -> k -> Map k a -> a-findWithErr1 s k- = Map.findWithDefault (error ("findWithErr1 " ++ s ++ ": key " ++ show k ++ " not in map.")) k--findWithErr2 :: (Ord k, Show k, Show a) => k -> Map k a -> a-findWithErr2 k m- = Map.findWithDefault (error ("findWithErr2: key " ++ show k ++ " not in map: " ++ show m)) k m--getNtName :: Type -> Nonterminal-getNtName (NT nt) = nt-getNtName _ = nullIdent--data AltAttr = AltAttr Name Name Bool - deriving (Eq, Ord, Show)--substSelf nt tp = if tp==NT _SELF - then Haskell (getName nt)- else tp- -haskellTupel :: [Type] -> Maybe Type-haskellTupel ts = Just ( Haskell ( '(' : (concat (intersperse "," (map show ts))) ++ ")" ))--lookupVertices :: Identifier -> Identifier -> Map AltAttr Int -> [Int]-lookupVertices fld nm attrs- = catMaybes ( [Map.lookup (AltAttr fld nm True) attrs]- ++ [Map.lookup (AltAttr fld nm False) attrs]- )--swap (a,b) = (b,a)--showPath :: Table CRule -> [Vertex] -> [String]-showPath ruleTable path- = let look a | inRange (bounds ruleTable) a = [showOrigin (ruleTable ! a)]- | otherwise = ["Vertex " ++ show a]- showOrigin cr | getHasCode cr && getName (getAttr cr) /= "self" = prettyCRule cr ++ " (" ++ show (getPos (getAttr cr)) ++ ")"- | otherwise = prettyCRule cr- in concatMap look path---showPathLocal :: Table CRule -> [Vertex] -> [String]-showPathLocal _ [] = []-showPathLocal ruleTable xs = showP (xs++[-1])- where showP [] = []- showP (v1:v2:vs) = let line = step v1 v2- lines = showP vs- in line:lines- step v1 v2 = " - " ++ a1- where r1 = ruleTable ! v1- a1 = show (getAttr r1)---limitTo :: Int -> [String] -> [String]-limitTo _ [] = [] -limitTo 0 _ = ["....etcetera, etcetera...."]-limitTo n (x:xs) = x : limitTo (n-1) xs--showPathNice :: Table CRule -> [Vertex] -> [String]-showPathNice _ [] = []-showPathNice ruleTable xs = limitTo 100 (showP ((-1):xs++[-1]))- where [maxf, maxa, maxn, maxc] = maxWidths ruleTable (take 100 xs)- showP [] = []- showP (v1:v2:vs) = let line = step v1 v2- lines = showP vs- in if null line then lines else line:lines- step v1 v2 | last && first = induced- | last && isSyn r1 = "pass up " ++ alignR maxf "" ++ " " ++ alignL maxa a1 ++ " in " ++ alignR maxn n1 ++ "|" ++ c1 ++ induced- | first&& not(isSyn r2) = "get from above " ++ alignR maxf "" ++ " " ++ alignL maxa a2 ++ " in " ++ alignR maxn n2 ++ "|" ++ c2- | last = "pass down " ++ alignR maxf f1 ++ "." ++ a1 ++ induced- | isSyn r2 = "get from below " ++ alignR maxf f2 ++ "." ++ alignL maxa a2 ++ " in " ++ alignR maxn n2 ++ "|" ++ c2- | isLocal r1 = if head a1 == '_' - then ""- else "calculate " ++ alignR maxf "loc" ++ "." ++ a1- | otherwise = "pass down " ++ alignR maxf f1 ++ "." ++ alignL maxa a1 ++ " to " ++ alignR maxn n2 ++ "|" ++ c2- where- first = v1<0- last = v2<0- r1 = ruleTable ! v1- r2 = ruleTable ! v2- a1 = show (getAttr r1)- a2 = show (getAttr r2)- f1 = show (getField r1)- f2 = show (getField r2)- n1 = show (getLhsNt r1)- n2 = show (getLhsNt r2)- c1 = show (getCon r1)- c2 = show (getCon r2)- induced | v2== -2 = " INDUCED dependency to "- | otherwise = ""---maxWidths ruleTable vs- = map maximum (transpose (map getWidth vs))- where getWidth v | v<0 = [0,0,0,0]- | otherwise = map (length . show . ($ (ruleTable!v))) [getField, getAttr, getLhsNt, getCon]--alignL n xs | k<n = xs ++ replicate (n-k) ' '- | otherwise = xs- where k = length xs--alignR n xs | k<n = replicate (n-k) ' ' ++ xs- | otherwise = xs- where k = length xs--localCycleErr :: Table CRule -> Bool -> Route -> Error-localCycleErr ruleTable o_visit (s:path)- = let cr = ruleTable ! s- attr = getAttr cr- nt = getLhsNt cr- con = getCon cr- in LocalCirc nt con attr o_visit (showPathLocal ruleTable path)--instCycleErr :: Table CRule -> Bool -> Route -> Error-instCycleErr ruleTable o_visit (s:path)- = let cr = ruleTable ! s- attr = getAttr cr- nt = getLhsNt cr- con = getCon cr- in InstCirc nt con attr o_visit (showPathLocal ruleTable path)--directCycleErrs :: Table NTAttr -> Table CRule -> Bool -> [EdgeRoutes] -> [Error]-directCycleErrs attrTable ruleTable o_visit xs- = let getNont v = case attrTable ! v of- NTASyn nt _ _ -> nt- NTAInh nt _ _ -> nt- getAttr v = case attrTable ! v of- NTASyn _ a _ -> a- NTAInh _ a _ -> a- sameNont ((v1,_),_,_) ((v2,_),_,_) = getNont v1 == getNont v2- procCycle ((v1,v2),p1,p2) = ((getAttr v1, getAttr v2), showPathNice ruleTable p1, showPathNice ruleTable p2)- wrapGroup gr@(((v1,_),_,_):_) = DirectCirc (getNont v1) o_visit (map procCycle gr)- in map wrapGroup (groupBy sameNont xs)--inducedCycleErrs :: Table NTAttr -> Table CRule -> CInterfaceMap -> [EdgeRoutes] -> [Error]-inducedCycleErrs attrTable ruleTable cim xs- = let getNont v = case attrTable ! v of- NTASyn nt _ _ -> nt- NTAInh nt _ _ -> nt- getAttr v = case attrTable ! v of- NTASyn _ a _ -> a- NTAInh _ a _ -> a- sameNont ((v1,_),_,_) ((v2,_),_,_) = getNont v1 == getNont v2- procCycle ((v1,v2),p1,p2) = ((getAttr v1, getAttr v2), showPathNice ruleTable p1, showPathNice ruleTable p2)- wrapGroup gr@(((v1,_),_,_):_) = InducedCirc (getNont v1) (findWithErr1 "inducedCycleErr.cinter" (getNont v1) cim) (map procCycle gr)- in map wrapGroup (groupBy sameNont xs)--- Alternative --------------------------------------------------{-- visit 0:- inherited attributes:- allnts : [Name]- cVisitsMap : CVisitsMap- inh : Attributes- manualAttrDepMap : AttrOrderMap- nt : Identifier- o_case : Bool- o_cata : Bool- o_dovisit : Bool- o_newtypes : Bool- o_rename : Bool- o_sem : Bool- o_sig : Bool- o_unbox : Bool- o_wantvisit : Bool- prefix : String- syn : Attributes- chained attribute:- vcount : Int- synthesized attributes:- additionalDep : Seq Edge- cAlternative : CAlternative- cons : [Constructor]- directDep : Seq Edge- errors : Seq Error- instDep : Seq Edge- rules : Seq (Vertex,CRule)- alternatives:- alternative Alternative:- child con : {Constructor}- child children : Children- child rules : Rules- child typeSigs : TypeSigs- visit 0:- local gathAltAttrs : _- local inhRules : _- local gathRules : _- local cVisits : _- local allfields : _- local attrs : _- local inhnames : _- local synnames : _--}--- cata-sem_Alternative :: Alternative ->- T_Alternative-sem_Alternative (Alternative _con _children _rules _typeSigs ) =- (sem_Alternative_Alternative _con (sem_Children _children ) (sem_Rules _rules ) (sem_TypeSigs _typeSigs ) )--- semantic domain-newtype T_Alternative = T_Alternative (([Name]) ->- CVisitsMap ->- Attributes ->- AttrOrderMap ->- Identifier ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- String ->- Attributes ->- Int ->- ( (Seq Edge),CAlternative,([Constructor]),(Seq Edge),(Seq Error),(Seq Edge),(Seq (Vertex,CRule)),Int))-data Inh_Alternative = Inh_Alternative {allnts_Inh_Alternative :: [Name],cVisitsMap_Inh_Alternative :: CVisitsMap,inh_Inh_Alternative :: Attributes,manualAttrDepMap_Inh_Alternative :: AttrOrderMap,nt_Inh_Alternative :: Identifier,o_case_Inh_Alternative :: Bool,o_cata_Inh_Alternative :: Bool,o_dovisit_Inh_Alternative :: Bool,o_newtypes_Inh_Alternative :: Bool,o_rename_Inh_Alternative :: Bool,o_sem_Inh_Alternative :: Bool,o_sig_Inh_Alternative :: Bool,o_unbox_Inh_Alternative :: Bool,o_wantvisit_Inh_Alternative :: Bool,prefix_Inh_Alternative :: String,syn_Inh_Alternative :: Attributes,vcount_Inh_Alternative :: Int}-data Syn_Alternative = Syn_Alternative {additionalDep_Syn_Alternative :: Seq Edge,cAlternative_Syn_Alternative :: CAlternative,cons_Syn_Alternative :: [Constructor],directDep_Syn_Alternative :: Seq Edge,errors_Syn_Alternative :: Seq Error,instDep_Syn_Alternative :: Seq Edge,rules_Syn_Alternative :: Seq (Vertex,CRule),vcount_Syn_Alternative :: Int}-wrap_Alternative (T_Alternative sem ) (Inh_Alternative _lhsIallnts _lhsIcVisitsMap _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIvcount ) =- (let ( _lhsOadditionalDep,_lhsOcAlternative,_lhsOcons,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOrules,_lhsOvcount) =- (sem _lhsIallnts _lhsIcVisitsMap _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIvcount )- in (Syn_Alternative _lhsOadditionalDep _lhsOcAlternative _lhsOcons _lhsOdirectDep _lhsOerrors _lhsOinstDep _lhsOrules _lhsOvcount ))-sem_Alternative_Alternative :: Constructor ->- T_Children ->- T_Rules ->- T_TypeSigs ->- T_Alternative-sem_Alternative_Alternative con_ (T_Children children_ ) (T_Rules rules_ ) (T_TypeSigs typeSigs_ ) =- (T_Alternative (\ _lhsIallnts- _lhsIcVisitsMap- _lhsIinh- _lhsImanualAttrDepMap- _lhsInt- _lhsIo_case- _lhsIo_cata- _lhsIo_dovisit- _lhsIo_newtypes- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_unbox- _lhsIo_wantvisit- _lhsIprefix- _lhsIsyn- _lhsIvcount ->- (let _childrenOcon :: Identifier- _rulesOcon :: Identifier- _rulesOaltAttrs :: (Map AltAttr Vertex)- _rulesOchildNts :: (Map Name Nonterminal)- _rulesOchildInhs :: (Map Name Attributes)- _lhsOrules :: (Seq (Vertex,CRule))- _lhsOvcount :: Int- _rulesOsynsOfChildren :: (Map Name Attributes)- _lhsOcons :: ([Constructor])- _typeSigsOtypeSigs :: (Map Name Type)- _rulesOallTypeSigs :: (Map Name Type)- _lhsOcAlternative :: CAlternative- _lhsOadditionalDep :: (Seq Edge)- _lhsOdirectDep :: (Seq Edge)- _lhsOerrors :: (Seq Error)- _lhsOinstDep :: (Seq Edge)- _childrenOallfields :: ([(Name,Type,Bool)])- _childrenOallnts :: ([Name])- _childrenOattrs :: ([(Name,Name)])- _childrenOinh :: Attributes- _childrenOnt :: Identifier- _childrenOo_unbox :: Bool- _childrenOsyn :: Attributes- _rulesOallfields :: ([(Name,Type,Bool)])- _rulesOallnts :: ([Name])- _rulesOattrs :: ([(Name,Name)])- _rulesOinh :: Attributes- _rulesOmanualAttrDepMap :: AttrOrderMap- _rulesOnt :: Identifier- _rulesOo_case :: Bool- _rulesOo_cata :: Bool- _rulesOo_dovisit :: Bool- _rulesOo_newtypes :: Bool- _rulesOo_rename :: Bool- _rulesOo_sem :: Bool- _rulesOo_sig :: Bool- _rulesOo_wantvisit :: Bool- _rulesOprefix :: String- _rulesOsyn :: Attributes- _childrenIattributes :: ([(Name,Attributes,Attributes)])- _childrenIcollectChildrenSyns :: (Map Name Attributes )- _childrenIerrors :: (Seq Error)- _childrenIfields :: ([(Name,Type,Bool)])- _childrenIgathAltAttrs :: ([AltAttr])- _childrenIgathRules :: (Seq CRule)- _childrenIinhs :: (Seq (Name,Attributes))- _childrenInts :: (Seq (Name,Nonterminal))- _childrenIsinglevisits :: ([CRule])- _childrenIterminals :: ([Name])- _rulesIadditionalDep :: (Seq Edge)- _rulesIdirectDep :: (Seq Edge)- _rulesIerrors :: (Seq Error)- _rulesIgathAltAttrs :: ([AltAttr])- _rulesIgathRules :: (Seq CRule)- _rulesIinstDep :: (Seq Edge)- _rulesIinstVars :: ([Name])- _rulesIlocVars :: ([Name])- _typeSigsItypeSigs :: (Map Name Type)- -- "Order.ag"(line 69, column 17)- _childrenOcon =- con_- -- "Order.ag"(line 71, column 17)- _rulesOcon =- con_- -- "Order.ag"(line 148, column 19)- _gathAltAttrs =- [ AltAttr _LHS inh True | inh <- Map.keys _lhsIinh ]- ++ _childrenIgathAltAttrs- ++ _rulesIgathAltAttrs- -- "Order.ag"(line 164, column 18)- _rulesOaltAttrs =- Map.fromList (zip _gathAltAttrs [_lhsIvcount..])- -- "Order.ag"(line 177, column 19)- _rulesOchildNts =- Map.fromList (Seq.toList _childrenInts)- -- "Order.ag"(line 178, column 19)- _rulesOchildInhs =- Map.fromList (Seq.toList _childrenIinhs)- -- "Order.ag"(line 184, column 19)- _inhRules =- [ cRuleLhsInh inh _lhsInt con_ tp | (inh,tp) <- Map.assocs _lhsIinh ]- -- "Order.ag"(line 185, column 19)- _gathRules =- _inhRules ++ Seq.toList (_childrenIgathRules Seq.<> _rulesIgathRules)- -- "Order.ag"(line 238, column 19)- _lhsOrules =- Seq.fromList (zip [_lhsIvcount..] _gathRules)- -- "Order.ag"(line 239, column 19)- _lhsOvcount =- _lhsIvcount + length _gathRules- -- "Order.ag"(line 306, column 18)- _rulesOsynsOfChildren =- _childrenIcollectChildrenSyns- -- "Order.ag"(line 384, column 19)- _lhsOcons =- [con_]- -- "Order.ag"(line 391, column 17)- _typeSigsOtypeSigs =- Map.empty- -- "Order.ag"(line 397, column 18)- _rulesOallTypeSigs =- _typeSigsItypeSigs- -- "Order.ag"(line 463, column 18)- _cVisits =- if _lhsIo_dovisit- then let altsVisitsMap = findWithErr1 "Alternative.cVisits.nt" _lhsInt _lhsIcVisitsMap- visits = findWithErr1 "Alternative.cVisits.con" con_ altsVisitsMap- in visits- else let vss = nubBy eqCRuleDefines _gathRules ++ _childrenIsinglevisits- in [CVisit _lhsIinh _lhsIsyn vss [] False]- -- "Order.ag"(line 489, column 19)- _lhsOcAlternative =- CAlternative con_ _cVisits _childrenIfields _childrenIterminals- -- "Order.ag"(line 513, column 17)- _allfields =- _childrenIfields- -- "Order.ag"(line 513, column 17)- _attrs =- map ((,) _LOC) _rulesIlocVars ++- map ((,) _INST) _rulesIinstVars ++- map ((,) _LHS) _inhnames ++- concat [map ((,) nm) (Map.keys as) | (nm,_,as) <- _childrenIattributes]- -- "Order.ag"(line 513, column 17)- _inhnames =- Map.keys _lhsIinh- -- "Order.ag"(line 513, column 17)- _synnames =- Map.keys _lhsIsyn- -- use rule "Order.ag"(line 258, column 71)- _lhsOadditionalDep =- _rulesIadditionalDep- -- use rule "Order.ag"(line 244, column 33)- _lhsOdirectDep =- _rulesIdirectDep- -- use rule "Order.ag"(line 60, column 70)- _lhsOerrors =- _childrenIerrors Seq.<> _rulesIerrors- -- use rule "Order.ag"(line 289, column 31)- _lhsOinstDep =- _rulesIinstDep- -- copy rule (from local)- _childrenOallfields =- _allfields- -- copy rule (down)- _childrenOallnts =- _lhsIallnts- -- copy rule (from local)- _childrenOattrs =- _attrs- -- copy rule (down)- _childrenOinh =- _lhsIinh- -- copy rule (down)- _childrenOnt =- _lhsInt- -- copy rule (down)- _childrenOo_unbox =- _lhsIo_unbox- -- copy rule (down)- _childrenOsyn =- _lhsIsyn- -- copy rule (from local)- _rulesOallfields =- _allfields- -- copy rule (down)- _rulesOallnts =- _lhsIallnts- -- copy rule (from local)- _rulesOattrs =- _attrs- -- copy rule (down)- _rulesOinh =- _lhsIinh- -- copy rule (down)- _rulesOmanualAttrDepMap =- _lhsImanualAttrDepMap- -- copy rule (down)- _rulesOnt =- _lhsInt- -- copy rule (down)- _rulesOo_case =- _lhsIo_case- -- copy rule (down)- _rulesOo_cata =- _lhsIo_cata- -- copy rule (down)- _rulesOo_dovisit =- _lhsIo_dovisit- -- copy rule (down)- _rulesOo_newtypes =- _lhsIo_newtypes- -- copy rule (down)- _rulesOo_rename =- _lhsIo_rename- -- copy rule (down)- _rulesOo_sem =- _lhsIo_sem- -- copy rule (down)- _rulesOo_sig =- _lhsIo_sig- -- copy rule (down)- _rulesOo_wantvisit =- _lhsIo_wantvisit- -- copy rule (down)- _rulesOprefix =- _lhsIprefix- -- copy rule (down)- _rulesOsyn =- _lhsIsyn- ( _childrenIattributes,_childrenIcollectChildrenSyns,_childrenIerrors,_childrenIfields,_childrenIgathAltAttrs,_childrenIgathRules,_childrenIinhs,_childrenInts,_childrenIsinglevisits,_childrenIterminals) =- (children_ _childrenOallfields _childrenOallnts _childrenOattrs _childrenOcon _childrenOinh _childrenOnt _childrenOo_unbox _childrenOsyn )- ( _rulesIadditionalDep,_rulesIdirectDep,_rulesIerrors,_rulesIgathAltAttrs,_rulesIgathRules,_rulesIinstDep,_rulesIinstVars,_rulesIlocVars) =- (rules_ _rulesOallTypeSigs _rulesOallfields _rulesOallnts _rulesOaltAttrs _rulesOattrs _rulesOchildInhs _rulesOchildNts _rulesOcon _rulesOinh _rulesOmanualAttrDepMap _rulesOnt _rulesOo_case _rulesOo_cata _rulesOo_dovisit _rulesOo_newtypes _rulesOo_rename _rulesOo_sem _rulesOo_sig _rulesOo_wantvisit _rulesOprefix _rulesOsyn _rulesOsynsOfChildren )- ( _typeSigsItypeSigs) =- (typeSigs_ _typeSigsOtypeSigs )- in ( _lhsOadditionalDep,_lhsOcAlternative,_lhsOcons,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOrules,_lhsOvcount))) )--- Alternatives -------------------------------------------------{-- visit 0:- inherited attributes:- allnts : [Name]- cVisitsMap : CVisitsMap- inh : Attributes- manualAttrDepMap : AttrOrderMap- nt : Identifier- o_case : Bool- o_cata : Bool- o_dovisit : Bool- o_newtypes : Bool- o_rename : Bool- o_sem : Bool- o_sig : Bool- o_unbox : Bool- o_wantvisit : Bool- prefix : String- syn : Attributes- chained attribute:- vcount : Int- synthesized attributes:- additionalDep : Seq Edge- cAlternatives : CAlternatives- cons : [Constructor]- directDep : Seq Edge- errors : Seq Error- instDep : Seq Edge- rules : Seq (Vertex,CRule)- alternatives:- alternative Cons:- child hd : Alternative- child tl : Alternatives- alternative Nil:--}--- cata-sem_Alternatives :: Alternatives ->- T_Alternatives-sem_Alternatives list =- (Prelude.foldr sem_Alternatives_Cons sem_Alternatives_Nil (Prelude.map sem_Alternative list) )--- semantic domain-newtype T_Alternatives = T_Alternatives (([Name]) ->- CVisitsMap ->- Attributes ->- AttrOrderMap ->- Identifier ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- String ->- Attributes ->- Int ->- ( (Seq Edge),CAlternatives,([Constructor]),(Seq Edge),(Seq Error),(Seq Edge),(Seq (Vertex,CRule)),Int))-data Inh_Alternatives = Inh_Alternatives {allnts_Inh_Alternatives :: [Name],cVisitsMap_Inh_Alternatives :: CVisitsMap,inh_Inh_Alternatives :: Attributes,manualAttrDepMap_Inh_Alternatives :: AttrOrderMap,nt_Inh_Alternatives :: Identifier,o_case_Inh_Alternatives :: Bool,o_cata_Inh_Alternatives :: Bool,o_dovisit_Inh_Alternatives :: Bool,o_newtypes_Inh_Alternatives :: Bool,o_rename_Inh_Alternatives :: Bool,o_sem_Inh_Alternatives :: Bool,o_sig_Inh_Alternatives :: Bool,o_unbox_Inh_Alternatives :: Bool,o_wantvisit_Inh_Alternatives :: Bool,prefix_Inh_Alternatives :: String,syn_Inh_Alternatives :: Attributes,vcount_Inh_Alternatives :: Int}-data Syn_Alternatives = Syn_Alternatives {additionalDep_Syn_Alternatives :: Seq Edge,cAlternatives_Syn_Alternatives :: CAlternatives,cons_Syn_Alternatives :: [Constructor],directDep_Syn_Alternatives :: Seq Edge,errors_Syn_Alternatives :: Seq Error,instDep_Syn_Alternatives :: Seq Edge,rules_Syn_Alternatives :: Seq (Vertex,CRule),vcount_Syn_Alternatives :: Int}-wrap_Alternatives (T_Alternatives sem ) (Inh_Alternatives _lhsIallnts _lhsIcVisitsMap _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIvcount ) =- (let ( _lhsOadditionalDep,_lhsOcAlternatives,_lhsOcons,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOrules,_lhsOvcount) =- (sem _lhsIallnts _lhsIcVisitsMap _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIvcount )- in (Syn_Alternatives _lhsOadditionalDep _lhsOcAlternatives _lhsOcons _lhsOdirectDep _lhsOerrors _lhsOinstDep _lhsOrules _lhsOvcount ))-sem_Alternatives_Cons :: T_Alternative ->- T_Alternatives ->- T_Alternatives-sem_Alternatives_Cons (T_Alternative hd_ ) (T_Alternatives tl_ ) =- (T_Alternatives (\ _lhsIallnts- _lhsIcVisitsMap- _lhsIinh- _lhsImanualAttrDepMap- _lhsInt- _lhsIo_case- _lhsIo_cata- _lhsIo_dovisit- _lhsIo_newtypes- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_unbox- _lhsIo_wantvisit- _lhsIprefix- _lhsIsyn- _lhsIvcount ->- (let _lhsOcAlternatives :: CAlternatives- _lhsOadditionalDep :: (Seq Edge)- _lhsOcons :: ([Constructor])- _lhsOdirectDep :: (Seq Edge)- _lhsOerrors :: (Seq Error)- _lhsOinstDep :: (Seq Edge)- _lhsOrules :: (Seq (Vertex,CRule))- _lhsOvcount :: Int- _hdOallnts :: ([Name])- _hdOcVisitsMap :: CVisitsMap- _hdOinh :: Attributes- _hdOmanualAttrDepMap :: AttrOrderMap- _hdOnt :: Identifier- _hdOo_case :: Bool- _hdOo_cata :: Bool- _hdOo_dovisit :: Bool- _hdOo_newtypes :: Bool- _hdOo_rename :: Bool- _hdOo_sem :: Bool- _hdOo_sig :: Bool- _hdOo_unbox :: Bool- _hdOo_wantvisit :: Bool- _hdOprefix :: String- _hdOsyn :: Attributes- _hdOvcount :: Int- _tlOallnts :: ([Name])- _tlOcVisitsMap :: CVisitsMap- _tlOinh :: Attributes- _tlOmanualAttrDepMap :: AttrOrderMap- _tlOnt :: Identifier- _tlOo_case :: Bool- _tlOo_cata :: Bool- _tlOo_dovisit :: Bool- _tlOo_newtypes :: Bool- _tlOo_rename :: Bool- _tlOo_sem :: Bool- _tlOo_sig :: Bool- _tlOo_unbox :: Bool- _tlOo_wantvisit :: Bool- _tlOprefix :: String- _tlOsyn :: Attributes- _tlOvcount :: Int- _hdIadditionalDep :: (Seq Edge)- _hdIcAlternative :: CAlternative- _hdIcons :: ([Constructor])- _hdIdirectDep :: (Seq Edge)- _hdIerrors :: (Seq Error)- _hdIinstDep :: (Seq Edge)- _hdIrules :: (Seq (Vertex,CRule))- _hdIvcount :: Int- _tlIadditionalDep :: (Seq Edge)- _tlIcAlternatives :: CAlternatives- _tlIcons :: ([Constructor])- _tlIdirectDep :: (Seq Edge)- _tlIerrors :: (Seq Error)- _tlIinstDep :: (Seq Edge)- _tlIrules :: (Seq (Vertex,CRule))- _tlIvcount :: Int- -- "Order.ag"(line 486, column 12)- _lhsOcAlternatives =- _hdIcAlternative : _tlIcAlternatives- -- use rule "Order.ag"(line 258, column 71)- _lhsOadditionalDep =- _hdIadditionalDep Seq.<> _tlIadditionalDep- -- use rule "Order.ag"(line 382, column 42)- _lhsOcons =- _hdIcons ++ _tlIcons- -- use rule "Order.ag"(line 244, column 33)- _lhsOdirectDep =- _hdIdirectDep Seq.<> _tlIdirectDep- -- use rule "Order.ag"(line 60, column 70)- _lhsOerrors =- _hdIerrors Seq.<> _tlIerrors- -- use rule "Order.ag"(line 289, column 31)- _lhsOinstDep =- _hdIinstDep Seq.<> _tlIinstDep- -- use rule "Order.ag"(line 234, column 18)- _lhsOrules =- _hdIrules Seq.<> _tlIrules- -- copy rule (up)- _lhsOvcount =- _tlIvcount- -- copy rule (down)- _hdOallnts =- _lhsIallnts- -- copy rule (down)- _hdOcVisitsMap =- _lhsIcVisitsMap- -- copy rule (down)- _hdOinh =- _lhsIinh- -- copy rule (down)- _hdOmanualAttrDepMap =- _lhsImanualAttrDepMap- -- copy rule (down)- _hdOnt =- _lhsInt- -- copy rule (down)- _hdOo_case =- _lhsIo_case- -- copy rule (down)- _hdOo_cata =- _lhsIo_cata- -- copy rule (down)- _hdOo_dovisit =- _lhsIo_dovisit- -- copy rule (down)- _hdOo_newtypes =- _lhsIo_newtypes- -- copy rule (down)- _hdOo_rename =- _lhsIo_rename- -- copy rule (down)- _hdOo_sem =- _lhsIo_sem- -- copy rule (down)- _hdOo_sig =- _lhsIo_sig- -- copy rule (down)- _hdOo_unbox =- _lhsIo_unbox- -- copy rule (down)- _hdOo_wantvisit =- _lhsIo_wantvisit- -- copy rule (down)- _hdOprefix =- _lhsIprefix- -- copy rule (down)- _hdOsyn =- _lhsIsyn- -- copy rule (down)- _hdOvcount =- _lhsIvcount- -- copy rule (down)- _tlOallnts =- _lhsIallnts- -- copy rule (down)- _tlOcVisitsMap =- _lhsIcVisitsMap- -- copy rule (down)- _tlOinh =- _lhsIinh- -- copy rule (down)- _tlOmanualAttrDepMap =- _lhsImanualAttrDepMap- -- copy rule (down)- _tlOnt =- _lhsInt- -- copy rule (down)- _tlOo_case =- _lhsIo_case- -- copy rule (down)- _tlOo_cata =- _lhsIo_cata- -- copy rule (down)- _tlOo_dovisit =- _lhsIo_dovisit- -- copy rule (down)- _tlOo_newtypes =- _lhsIo_newtypes- -- copy rule (down)- _tlOo_rename =- _lhsIo_rename- -- copy rule (down)- _tlOo_sem =- _lhsIo_sem- -- copy rule (down)- _tlOo_sig =- _lhsIo_sig- -- copy rule (down)- _tlOo_unbox =- _lhsIo_unbox- -- copy rule (down)- _tlOo_wantvisit =- _lhsIo_wantvisit- -- copy rule (down)- _tlOprefix =- _lhsIprefix- -- copy rule (down)- _tlOsyn =- _lhsIsyn- -- copy rule (chain)- _tlOvcount =- _hdIvcount- ( _hdIadditionalDep,_hdIcAlternative,_hdIcons,_hdIdirectDep,_hdIerrors,_hdIinstDep,_hdIrules,_hdIvcount) =- (hd_ _hdOallnts _hdOcVisitsMap _hdOinh _hdOmanualAttrDepMap _hdOnt _hdOo_case _hdOo_cata _hdOo_dovisit _hdOo_newtypes _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_unbox _hdOo_wantvisit _hdOprefix _hdOsyn _hdOvcount )- ( _tlIadditionalDep,_tlIcAlternatives,_tlIcons,_tlIdirectDep,_tlIerrors,_tlIinstDep,_tlIrules,_tlIvcount) =- (tl_ _tlOallnts _tlOcVisitsMap _tlOinh _tlOmanualAttrDepMap _tlOnt _tlOo_case _tlOo_cata _tlOo_dovisit _tlOo_newtypes _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_unbox _tlOo_wantvisit _tlOprefix _tlOsyn _tlOvcount )- in ( _lhsOadditionalDep,_lhsOcAlternatives,_lhsOcons,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOrules,_lhsOvcount))) )-sem_Alternatives_Nil :: T_Alternatives-sem_Alternatives_Nil =- (T_Alternatives (\ _lhsIallnts- _lhsIcVisitsMap- _lhsIinh- _lhsImanualAttrDepMap- _lhsInt- _lhsIo_case- _lhsIo_cata- _lhsIo_dovisit- _lhsIo_newtypes- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_unbox- _lhsIo_wantvisit- _lhsIprefix- _lhsIsyn- _lhsIvcount ->- (let _lhsOcAlternatives :: CAlternatives- _lhsOadditionalDep :: (Seq Edge)- _lhsOcons :: ([Constructor])- _lhsOdirectDep :: (Seq Edge)- _lhsOerrors :: (Seq Error)- _lhsOinstDep :: (Seq Edge)- _lhsOrules :: (Seq (Vertex,CRule))- _lhsOvcount :: Int- -- "Order.ag"(line 487, column 12)- _lhsOcAlternatives =- []- -- use rule "Order.ag"(line 258, column 71)- _lhsOadditionalDep =- Seq.empty- -- use rule "Order.ag"(line 382, column 42)- _lhsOcons =- []- -- use rule "Order.ag"(line 244, column 33)- _lhsOdirectDep =- Seq.empty- -- use rule "Order.ag"(line 60, column 70)- _lhsOerrors =- Seq.empty- -- use rule "Order.ag"(line 289, column 31)- _lhsOinstDep =- Seq.empty- -- use rule "Order.ag"(line 234, column 18)- _lhsOrules =- Seq.empty- -- copy rule (chain)- _lhsOvcount =- _lhsIvcount- in ( _lhsOadditionalDep,_lhsOcAlternatives,_lhsOcons,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOrules,_lhsOvcount))) )--- Child --------------------------------------------------------{-- visit 0:- inherited attributes:- allfields : [(Name,Type,Bool)]- allnts : [Name]- attrs : [(Name,Name)]- con : Identifier- inh : Attributes- nt : Identifier- o_unbox : Bool- syn : Attributes- synthesized attributes:- attributes : [(Name,Attributes,Attributes)]- collectChildrenSyns : Map Name Attributes - errors : Seq Error- field : (Name,Type,Bool)- gathAltAttrs : [AltAttr]- gathRules : Seq CRule- inhs : Seq (Name,Attributes)- nts : Seq (Name,Nonterminal)- singlevisits : [CRule]- terminals : [Name]- alternatives:- alternative Child:- child name : {Name}- child tp : {Type}- child inh : {Attributes}- child syn : {Attributes}- child higherOrder : {Bool}- visit 0:- local maptolocal : _- local gathRules : _--}--- cata-sem_Child :: Child ->- T_Child-sem_Child (Child _name _tp _inh _syn _higherOrder ) =- (sem_Child_Child _name _tp _inh _syn _higherOrder )--- semantic domain-newtype T_Child = T_Child (([(Name,Type,Bool)]) ->- ([Name]) ->- ([(Name,Name)]) ->- Identifier ->- Attributes ->- Identifier ->- Bool ->- Attributes ->- ( ([(Name,Attributes,Attributes)]),(Map Name Attributes ),(Seq Error),((Name,Type,Bool)),([AltAttr]),(Seq CRule),(Seq (Name,Attributes)),(Seq (Name,Nonterminal)),([CRule]),([Name])))-data Inh_Child = Inh_Child {allfields_Inh_Child :: [(Name,Type,Bool)],allnts_Inh_Child :: [Name],attrs_Inh_Child :: [(Name,Name)],con_Inh_Child :: Identifier,inh_Inh_Child :: Attributes,nt_Inh_Child :: Identifier,o_unbox_Inh_Child :: Bool,syn_Inh_Child :: Attributes}-data Syn_Child = Syn_Child {attributes_Syn_Child :: [(Name,Attributes,Attributes)],collectChildrenSyns_Syn_Child :: Map Name Attributes ,errors_Syn_Child :: Seq Error,field_Syn_Child :: (Name,Type,Bool),gathAltAttrs_Syn_Child :: [AltAttr],gathRules_Syn_Child :: Seq CRule,inhs_Syn_Child :: Seq (Name,Attributes),nts_Syn_Child :: Seq (Name,Nonterminal),singlevisits_Syn_Child :: [CRule],terminals_Syn_Child :: [Name]}-wrap_Child (T_Child sem ) (Inh_Child _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsInt _lhsIo_unbox _lhsIsyn ) =- (let ( _lhsOattributes,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfield,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals) =- (sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsInt _lhsIo_unbox _lhsIsyn )- in (Syn_Child _lhsOattributes _lhsOcollectChildrenSyns _lhsOerrors _lhsOfield _lhsOgathAltAttrs _lhsOgathRules _lhsOinhs _lhsOnts _lhsOsinglevisits _lhsOterminals ))-sem_Child_Child :: Name ->- Type ->- Attributes ->- Attributes ->- Bool ->- T_Child-sem_Child_Child name_ tp_ inh_ syn_ higherOrder_ =- (T_Child (\ _lhsIallfields- _lhsIallnts- _lhsIattrs- _lhsIcon- _lhsIinh- _lhsInt- _lhsIo_unbox- _lhsIsyn ->- (let _lhsOgathAltAttrs :: ([AltAttr])- _lhsOnts :: (Seq (Name,Nonterminal))- _lhsOinhs :: (Seq (Name,Attributes))- _lhsOcollectChildrenSyns :: (Map Name Attributes )- _lhsOsinglevisits :: ([CRule])- _lhsOterminals :: ([Name])- _lhsOattributes :: ([(Name,Attributes,Attributes)])- _lhsOfield :: ((Name,Type,Bool))- _lhsOerrors :: (Seq Error)- _lhsOgathRules :: (Seq CRule)- -- "Order.ag"(line 153, column 13)- _maptolocal =- case tp_ of- NT nt -> Map.null syn_- _ -> True- -- "Order.ag"(line 156, column 13)- _lhsOgathAltAttrs =- if _maptolocal- then [ AltAttr _LOC name_ True ]- else [ AltAttr name_ syn True | syn <- Map.keys syn_ ]- -- "Order.ag"(line 171, column 13)- _lhsOnts =- Seq.single (name_,getNtName tp_)- -- "Order.ag"(line 172, column 13)- _lhsOinhs =- Seq.single (name_,inh_)- -- "Order.ag"(line 188, column 13)- _gathRules =- if _maptolocal- then Seq.single (cRuleTerminal name_ _lhsInt _lhsIcon tp_)- else Seq.fromList [ cRuleRhsSyn syn _lhsInt _lhsIcon tp name_ (getNtName tp_) | (syn,tp) <- Map.assocs syn_]- -- "Order.ag"(line 310, column 12)- _lhsOcollectChildrenSyns =- Map.singleton name_ syn_- -- "Order.ag"(line 473, column 11)- _lhsOsinglevisits =- if _maptolocal- then []- else [CChildVisit name_ (getNtName tp_) 0 inh_ syn_ True]- -- "Order.ag"(line 494, column 11)- _lhsOterminals =- if _maptolocal- then [name_]- else []- -- "Order.ag"(line 523, column 11)- _lhsOattributes =- [(name_, inh_, syn_)]- -- "Order.ag"(line 527, column 11)- _lhsOfield =- (name_, tp_, higherOrder_)- -- use rule "Order.ag"(line 60, column 70)- _lhsOerrors =- Seq.empty- -- use rule "Order.ag"(line 182, column 23)- _lhsOgathRules =- _gathRules- in ( _lhsOattributes,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfield,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals))) )--- Children -----------------------------------------------------{-- visit 0:- inherited attributes:- allfields : [(Name,Type,Bool)]- allnts : [Name]- attrs : [(Name,Name)]- con : Identifier- inh : Attributes- nt : Identifier- o_unbox : Bool- syn : Attributes- synthesized attributes:- attributes : [(Name,Attributes,Attributes)]- collectChildrenSyns : Map Name Attributes - errors : Seq Error- fields : [(Name,Type,Bool)]- gathAltAttrs : [AltAttr]- gathRules : Seq CRule- inhs : Seq (Name,Attributes)- nts : Seq (Name,Nonterminal)- singlevisits : [CRule]- terminals : [Name]- 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 (([(Name,Type,Bool)]) ->- ([Name]) ->- ([(Name,Name)]) ->- Identifier ->- Attributes ->- Identifier ->- Bool ->- Attributes ->- ( ([(Name,Attributes,Attributes)]),(Map Name Attributes ),(Seq Error),([(Name,Type,Bool)]),([AltAttr]),(Seq CRule),(Seq (Name,Attributes)),(Seq (Name,Nonterminal)),([CRule]),([Name])))-data Inh_Children = Inh_Children {allfields_Inh_Children :: [(Name,Type,Bool)],allnts_Inh_Children :: [Name],attrs_Inh_Children :: [(Name,Name)],con_Inh_Children :: Identifier,inh_Inh_Children :: Attributes,nt_Inh_Children :: Identifier,o_unbox_Inh_Children :: Bool,syn_Inh_Children :: Attributes}-data Syn_Children = Syn_Children {attributes_Syn_Children :: [(Name,Attributes,Attributes)],collectChildrenSyns_Syn_Children :: Map Name Attributes ,errors_Syn_Children :: Seq Error,fields_Syn_Children :: [(Name,Type,Bool)],gathAltAttrs_Syn_Children :: [AltAttr],gathRules_Syn_Children :: Seq CRule,inhs_Syn_Children :: Seq (Name,Attributes),nts_Syn_Children :: Seq (Name,Nonterminal),singlevisits_Syn_Children :: [CRule],terminals_Syn_Children :: [Name]}-wrap_Children (T_Children sem ) (Inh_Children _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsInt _lhsIo_unbox _lhsIsyn ) =- (let ( _lhsOattributes,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfields,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals) =- (sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsInt _lhsIo_unbox _lhsIsyn )- in (Syn_Children _lhsOattributes _lhsOcollectChildrenSyns _lhsOerrors _lhsOfields _lhsOgathAltAttrs _lhsOgathRules _lhsOinhs _lhsOnts _lhsOsinglevisits _lhsOterminals ))-sem_Children_Cons :: T_Child ->- T_Children ->- T_Children-sem_Children_Cons (T_Child hd_ ) (T_Children tl_ ) =- (T_Children (\ _lhsIallfields- _lhsIallnts- _lhsIattrs- _lhsIcon- _lhsIinh- _lhsInt- _lhsIo_unbox- _lhsIsyn ->- (let _lhsOfields :: ([(Name,Type,Bool)])- _lhsOattributes :: ([(Name,Attributes,Attributes)])- _lhsOcollectChildrenSyns :: (Map Name Attributes )- _lhsOerrors :: (Seq Error)- _lhsOgathAltAttrs :: ([AltAttr])- _lhsOgathRules :: (Seq CRule)- _lhsOinhs :: (Seq (Name,Attributes))- _lhsOnts :: (Seq (Name,Nonterminal))- _lhsOsinglevisits :: ([CRule])- _lhsOterminals :: ([Name])- _hdOallfields :: ([(Name,Type,Bool)])- _hdOallnts :: ([Name])- _hdOattrs :: ([(Name,Name)])- _hdOcon :: Identifier- _hdOinh :: Attributes- _hdOnt :: Identifier- _hdOo_unbox :: Bool- _hdOsyn :: Attributes- _tlOallfields :: ([(Name,Type,Bool)])- _tlOallnts :: ([Name])- _tlOattrs :: ([(Name,Name)])- _tlOcon :: Identifier- _tlOinh :: Attributes- _tlOnt :: Identifier- _tlOo_unbox :: Bool- _tlOsyn :: Attributes- _hdIattributes :: ([(Name,Attributes,Attributes)])- _hdIcollectChildrenSyns :: (Map Name Attributes )- _hdIerrors :: (Seq Error)- _hdIfield :: ((Name,Type,Bool))- _hdIgathAltAttrs :: ([AltAttr])- _hdIgathRules :: (Seq CRule)- _hdIinhs :: (Seq (Name,Attributes))- _hdInts :: (Seq (Name,Nonterminal))- _hdIsinglevisits :: ([CRule])- _hdIterminals :: ([Name])- _tlIattributes :: ([(Name,Attributes,Attributes)])- _tlIcollectChildrenSyns :: (Map Name Attributes )- _tlIerrors :: (Seq Error)- _tlIfields :: ([(Name,Type,Bool)])- _tlIgathAltAttrs :: ([AltAttr])- _tlIgathRules :: (Seq CRule)- _tlIinhs :: (Seq (Name,Attributes))- _tlInts :: (Seq (Name,Nonterminal))- _tlIsinglevisits :: ([CRule])- _tlIterminals :: ([Name])- -- "Order.ag"(line 530, column 11)- _lhsOfields =- _hdIfield : _tlIfields- -- use rule "Order.ag"(line 521, column 32)- _lhsOattributes =- _hdIattributes ++ _tlIattributes- -- use rule "Order.ag"(line 308, column 47)- _lhsOcollectChildrenSyns =- _hdIcollectChildrenSyns `Map.union` _tlIcollectChildrenSyns- -- use rule "Order.ag"(line 60, column 70)- _lhsOerrors =- _hdIerrors Seq.<> _tlIerrors- -- use rule "Order.ag"(line 146, column 68)- _lhsOgathAltAttrs =- _hdIgathAltAttrs ++ _tlIgathAltAttrs- -- use rule "Order.ag"(line 182, column 23)- _lhsOgathRules =- _hdIgathRules Seq.<> _tlIgathRules- -- use rule "Order.ag"(line 169, column 20)- _lhsOinhs =- _hdIinhs Seq.<> _tlIinhs- -- use rule "Order.ag"(line 168, column 19)- _lhsOnts =- _hdInts Seq.<> _tlInts- -- use rule "Order.ag"(line 471, column 40)- _lhsOsinglevisits =- _hdIsinglevisits ++ _tlIsinglevisits- -- use rule "Order.ag"(line 492, column 38)- _lhsOterminals =- _hdIterminals ++ _tlIterminals- -- copy rule (down)- _hdOallfields =- _lhsIallfields- -- copy rule (down)- _hdOallnts =- _lhsIallnts- -- copy rule (down)- _hdOattrs =- _lhsIattrs- -- copy rule (down)- _hdOcon =- _lhsIcon- -- copy rule (down)- _hdOinh =- _lhsIinh- -- copy rule (down)- _hdOnt =- _lhsInt- -- copy rule (down)- _hdOo_unbox =- _lhsIo_unbox- -- copy rule (down)- _hdOsyn =- _lhsIsyn- -- copy rule (down)- _tlOallfields =- _lhsIallfields- -- copy rule (down)- _tlOallnts =- _lhsIallnts- -- copy rule (down)- _tlOattrs =- _lhsIattrs- -- copy rule (down)- _tlOcon =- _lhsIcon- -- copy rule (down)- _tlOinh =- _lhsIinh- -- copy rule (down)- _tlOnt =- _lhsInt- -- copy rule (down)- _tlOo_unbox =- _lhsIo_unbox- -- copy rule (down)- _tlOsyn =- _lhsIsyn- ( _hdIattributes,_hdIcollectChildrenSyns,_hdIerrors,_hdIfield,_hdIgathAltAttrs,_hdIgathRules,_hdIinhs,_hdInts,_hdIsinglevisits,_hdIterminals) =- (hd_ _hdOallfields _hdOallnts _hdOattrs _hdOcon _hdOinh _hdOnt _hdOo_unbox _hdOsyn )- ( _tlIattributes,_tlIcollectChildrenSyns,_tlIerrors,_tlIfields,_tlIgathAltAttrs,_tlIgathRules,_tlIinhs,_tlInts,_tlIsinglevisits,_tlIterminals) =- (tl_ _tlOallfields _tlOallnts _tlOattrs _tlOcon _tlOinh _tlOnt _tlOo_unbox _tlOsyn )- in ( _lhsOattributes,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfields,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals))) )-sem_Children_Nil :: T_Children-sem_Children_Nil =- (T_Children (\ _lhsIallfields- _lhsIallnts- _lhsIattrs- _lhsIcon- _lhsIinh- _lhsInt- _lhsIo_unbox- _lhsIsyn ->- (let _lhsOfields :: ([(Name,Type,Bool)])- _lhsOattributes :: ([(Name,Attributes,Attributes)])- _lhsOcollectChildrenSyns :: (Map Name Attributes )- _lhsOerrors :: (Seq Error)- _lhsOgathAltAttrs :: ([AltAttr])- _lhsOgathRules :: (Seq CRule)- _lhsOinhs :: (Seq (Name,Attributes))- _lhsOnts :: (Seq (Name,Nonterminal))- _lhsOsinglevisits :: ([CRule])- _lhsOterminals :: ([Name])- -- "Order.ag"(line 531, column 11)- _lhsOfields =- []- -- use rule "Order.ag"(line 521, column 32)- _lhsOattributes =- []- -- use rule "Order.ag"(line 308, column 47)- _lhsOcollectChildrenSyns =- Map.empty- -- use rule "Order.ag"(line 60, column 70)- _lhsOerrors =- Seq.empty- -- use rule "Order.ag"(line 146, column 68)- _lhsOgathAltAttrs =- []- -- use rule "Order.ag"(line 182, column 23)- _lhsOgathRules =- Seq.empty- -- use rule "Order.ag"(line 169, column 20)- _lhsOinhs =- Seq.empty- -- use rule "Order.ag"(line 168, column 19)- _lhsOnts =- Seq.empty- -- use rule "Order.ag"(line 471, column 40)- _lhsOsinglevisits =- []- -- use rule "Order.ag"(line 492, column 38)- _lhsOterminals =- []- in ( _lhsOattributes,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfields,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals))) )--- Expression ---------------------------------------------------{-- visit 0:- inherited attributes:- allfields : [(Name,Type,Bool)]- allnts : [Name]- attrs : [(Name,Name)]- con : Name- nt : Name- synthesized attributes:- allRhsVars : Set (Name,Name)- copy : SELF- errors : Seq Error- textLines : [String]- usedAttrs : [(Name,Name)]- usedFields : [Name]- usedLocals : [Name]- alternatives:- alternative Expression:- child pos : {Pos}- child txt : {String}- visit 0:- local _tup1 : _- local errors : _- local textLines : _- local usedAttrs : _- local usedLocals : _- local usedFields : _- local copy : _--}--- cata-sem_Expression :: Expression ->- T_Expression-sem_Expression (Expression _pos _txt ) =- (sem_Expression_Expression _pos _txt )--- semantic domain-newtype T_Expression = T_Expression (([(Name,Type,Bool)]) ->- ([Name]) ->- ([(Name,Name)]) ->- Name ->- Name ->- ( (Set (Name,Name)),Expression,(Seq Error),([String]),([(Name,Name)]),([Name]),([Name])))-data Inh_Expression = Inh_Expression {allfields_Inh_Expression :: [(Name,Type,Bool)],allnts_Inh_Expression :: [Name],attrs_Inh_Expression :: [(Name,Name)],con_Inh_Expression :: Name,nt_Inh_Expression :: Name}-data Syn_Expression = Syn_Expression {allRhsVars_Syn_Expression :: Set (Name,Name),copy_Syn_Expression :: Expression,errors_Syn_Expression :: Seq Error,textLines_Syn_Expression :: [String],usedAttrs_Syn_Expression :: [(Name,Name)],usedFields_Syn_Expression :: [Name],usedLocals_Syn_Expression :: [Name]}-wrap_Expression (T_Expression sem ) (Inh_Expression _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsInt ) =- (let ( _lhsOallRhsVars,_lhsOcopy,_lhsOerrors,_lhsOtextLines,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals) =- (sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsInt )- in (Syn_Expression _lhsOallRhsVars _lhsOcopy _lhsOerrors _lhsOtextLines _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals ))-sem_Expression_Expression :: Pos ->- String ->- T_Expression-sem_Expression_Expression pos_ txt_ =- (T_Expression (\ _lhsIallfields- _lhsIallnts- _lhsIattrs- _lhsIcon- _lhsInt ->- (let _lhsOallRhsVars :: (Set (Name,Name))- _lhsOcopy :: Expression- _lhsOerrors :: (Seq Error)- _lhsOtextLines :: ([String])- _lhsOusedAttrs :: ([(Name,Name)])- _lhsOusedFields :: ([Name])- _lhsOusedLocals :: ([Name])- -- "Order.ag"(line 330, column 21)- __tup1 =- let inherited = Inh_HsTokensRoot- { attrs_Inh_HsTokensRoot = _lhsIattrs- , con_Inh_HsTokensRoot = _lhsIcon- , allfields_Inh_HsTokensRoot = _lhsIallfields- , allnts_Inh_HsTokensRoot = _lhsIallnts- , nt_Inh_HsTokensRoot = _lhsInt- }- pos' = case pos_ of- Pos l k f -> Pos l 1 f- synthesized = wrap_HsTokensRoot (sem_HsTokensRoot (HsTokensRoot $ lexTokens pos' txt_)) inherited- in case synthesized of- Syn_HsTokensRoot- { errors_Syn_HsTokensRoot = errors- , textLines_Syn_HsTokensRoot = textLines- , usedAttrs_Syn_HsTokensRoot = usedAttrs- , usedLocals_Syn_HsTokensRoot = usedLocals- , usedFields_Syn_HsTokensRoot = usedFields- } -> (errors,textLines,usedAttrs,usedLocals,usedFields)- -- "Order.ag"(line 330, column 21)- (_errors,_,_,_,_) =- __tup1- -- "Order.ag"(line 330, column 21)- (_,_textLines,_,_,_) =- __tup1- -- "Order.ag"(line 330, column 21)- (_,_,_usedAttrs,_,_) =- __tup1- -- "Order.ag"(line 330, column 21)- (_,_,_,_usedLocals,_) =- __tup1- -- "Order.ag"(line 330, column 21)- (_,_,_,_,_usedFields) =- __tup1- -- "Order.ag"(line 351, column 17)- _lhsOallRhsVars =- Set.fromList _usedAttrs- `Set.union`- Set.fromList [ (_LOC, l) | l <- _usedLocals ]- `Set.union`- Set.fromList [ (_FIELD, fld) | fld <- _usedFields ]- -- self rule- _copy =- Expression pos_ txt_- -- self rule- _lhsOcopy =- _copy- -- copy rule (from local)- _lhsOerrors =- _errors- -- copy rule (from local)- _lhsOtextLines =- _textLines- -- copy rule (from local)- _lhsOusedAttrs =- _usedAttrs- -- copy rule (from local)- _lhsOusedFields =- _usedFields- -- copy rule (from local)- _lhsOusedLocals =- _usedLocals- in ( _lhsOallRhsVars,_lhsOcopy,_lhsOerrors,_lhsOtextLines,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) )--- Grammar ------------------------------------------------------{-- visit 0:- inherited attribute:- options : Options- synthesized attributes:- errors : Seq Error- output : CGrammar- alternatives:- alternative Grammar:- child typeSyns : {TypeSyns}- child useMap : {UseMap}- child derivings : {Derivings}- child wrappers : {Set Nonterminal}- child prods : Productions- child pragmas : {PragmaMap}- child manualAttrOrderMap : {AttrOrderMap}- visit 0:- local ruleTable : _- local attrTable : _- local attrVertex : _- local tdpToTds : _- local tdsToTdp : _- local directDep : _- local instDep : _- local info : _- local _tup2 : _- local cInterfaceMap : _- local cVisitsMap : _- local cyclesErrors : _--}--- cata-sem_Grammar :: Grammar ->- T_Grammar-sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _prods _pragmas _manualAttrOrderMap ) =- (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Productions _prods ) _pragmas _manualAttrOrderMap )--- semantic domain-newtype T_Grammar = T_Grammar (Options ->- ( (Seq Error),CGrammar))-data Inh_Grammar = Inh_Grammar {options_Inh_Grammar :: Options}-data Syn_Grammar = Syn_Grammar {errors_Syn_Grammar :: Seq Error,output_Syn_Grammar :: CGrammar}-wrap_Grammar (T_Grammar sem ) (Inh_Grammar _lhsIoptions ) =- (let ( _lhsOerrors,_lhsOoutput) =- (sem _lhsIoptions )- in (Syn_Grammar _lhsOerrors _lhsOoutput ))-sem_Grammar_Grammar :: TypeSyns ->- UseMap ->- Derivings ->- (Set Nonterminal) ->- T_Productions ->- PragmaMap ->- AttrOrderMap ->- T_Grammar-sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Productions prods_ ) pragmas_ manualAttrOrderMap_ =- (T_Grammar (\ _lhsIoptions ->- (let _prodsOo_cata :: Bool- _prodsOo_data :: Bool- _prodsOo_sig :: Bool- _prodsOo_sem :: Bool- _prodsOo_rename :: Bool- _prodsOo_newtypes :: Bool- _prodsOo_wantvisit :: Bool- _prodsOo_dovisit :: Bool- _prodsOo_unbox :: Bool- _prodsOo_case :: Bool- _prodsOprefix :: String- _prodsOvcount :: Int- _prodsOmanualAttrDepMap :: AttrOrderMap- _prodsOacount :: Int- _lhsOerrors :: (Seq Error)- _lhsOoutput :: CGrammar- _prodsOallnts :: ([Name])- _prodsOcInterfaceMap :: CInterfaceMap- _prodsOcVisitsMap :: CVisitsMap- _prodsIacount :: Int- _prodsIadditionalDep :: (Seq Edge)- _prodsIaranges :: (Seq (Int,Int,Int))- _prodsIcProductions :: CProductions- _prodsIdirectDep :: (Seq Edge)- _prodsIerrors :: (Seq Error)- _prodsIinstDep :: (Seq Edge)- _prodsIntattrs :: (Seq (Vertex,NTAttr))- _prodsIprods :: ([(Nonterminal,[Constructor])])- _prodsIrules :: (Seq (Vertex,CRule))- _prodsIvcount :: Int- -- "Order.ag"(line 99, column 17)- _prodsOo_cata =- folds _lhsIoptions- -- "Order.ag"(line 99, column 17)- _prodsOo_data =- dataTypes _lhsIoptions- -- "Order.ag"(line 99, column 17)- _prodsOo_sig =- typeSigs _lhsIoptions- -- "Order.ag"(line 99, column 17)- _prodsOo_sem =- semfuns _lhsIoptions- -- "Order.ag"(line 99, column 17)- _prodsOo_rename =- rename _lhsIoptions- -- "Order.ag"(line 99, column 17)- _prodsOo_newtypes =- newtypes _lhsIoptions- -- "Order.ag"(line 99, column 17)- _prodsOo_wantvisit =- visit _lhsIoptions- -- "Order.ag"(line 99, column 17)- _prodsOo_dovisit =- visit _lhsIoptions && null _cyclesErrors- -- "Order.ag"(line 99, column 17)- _prodsOo_unbox =- unbox _lhsIoptions- -- "Order.ag"(line 99, column 17)- _prodsOo_case =- cases _lhsIoptions- -- "Order.ag"(line 99, column 17)- _prodsOprefix =- prefix _lhsIoptions- -- "Order.ag"(line 236, column 15)- _prodsOvcount =- 0- -- "Order.ag"(line 261, column 7)- _prodsOmanualAttrDepMap =- manualAttrOrderMap_- -- "Order.ag"(line 365, column 13)- _prodsOacount =- 0- -- "Order.ag"(line 403, column 13)- _ruleTable =- Array.array (0,_prodsIvcount-1) (Seq.toList _prodsIrules)- -- "Order.ag"(line 404, column 13)- _attrTable =- Array.array (0,_prodsIacount-1) (Seq.toList _prodsIntattrs)- -- "Order.ag"(line 405, column 13)- _attrVertex =- Map.fromList (map swap (Seq.toList _prodsIntattrs))- -- "Order.ag"(line 406, column 13)- _tdpToTds =- [ (s, maybe (-1) (\v -> findWithErr1 "Grammar.tdpToTds" v _attrVertex) (ntattr cr))- | (s,cr) <- Seq.toList _prodsIrules]- -- "Order.ag"(line 408, column 13)- _tdsToTdp =- let eq (_,v) (_,v') = v == v'- conv ((s,v):svs) | v == -1 = Nothing- | otherwise = Just (v,s:map fst svs)- in mapMaybe conv (eqClasses eq _tdpToTds)- -- "Order.ag"(line 412, column 13)- _directDep =- Seq.toList (_prodsIdirectDep Seq.<> _prodsIadditionalDep)- -- "Order.ag"(line 413, column 13)- _instDep =- Seq.toList _prodsIinstDep- -- "Order.ag"(line 414, column 13)- _info =- let def [] = -1- def (v:vs) = v- in Info { tdsToTdp = Array.array (0,_prodsIacount-1) _tdsToTdp- , tdpToTds = Array.array (0,_prodsIvcount-1) _tdpToTds- , attrTable = _attrTable- , ruleTable = _ruleTable- , lmh = Seq.toList _prodsIaranges- , prods = _prodsIprods- , wraps = wrappers_- }- -- "Order.ag"(line 425, column 17)- __tup2 =- case computeSequential _info _directDep _instDep of- CycleFree cim cvm -> ( cim- , cvm- , []- )- LocalCycle errs -> ( error "No interfaces for AG with local cycles"- , error "No visit sub-sequences for AG with local cycles"- , map (localCycleErr _ruleTable (visit _lhsIoptions)) errs- )- InstCycle errs -> ( error "No interfaces for AG with cycles through insts"- , error "No visit sub-sequences for AG with cycles through insts"- , map (instCycleErr _ruleTable (visit _lhsIoptions)) errs- )- DirectCycle errs -> ( error "No interfaces for AG with direct cycles"- , error "No visit sub-sequences for AG with direct cycles"- , directCycleErrs _attrTable _ruleTable (visit _lhsIoptions) errs- )- InducedCycle cim errs -> ( cim- , error "No visit sub-sequences for AG with induced cycles"- , inducedCycleErrs _attrTable _ruleTable cim errs- )- -- "Order.ag"(line 425, column 17)- (_cInterfaceMap,_,_) =- __tup2- -- "Order.ag"(line 425, column 17)- (_,_cVisitsMap,_) =- __tup2- -- "Order.ag"(line 425, column 17)- (_,_,_cyclesErrors) =- __tup2- -- "Order.ag"(line 447, column 13)- _lhsOerrors =- (if withCycle _lhsIoptions then Seq.fromList _cyclesErrors else Seq.empty)- Seq.<> _prodsIerrors- -- "Order.ag"(line 479, column 15)- _lhsOoutput =- CGrammar typeSyns_ derivings_ wrappers_ _prodsIcProductions pragmas_- -- "Order.ag"(line 506, column 13)- _prodsOallnts =- map fst (_prodsIprods)- -- copy rule (from local)- _prodsOcInterfaceMap =- _cInterfaceMap- -- copy rule (from local)- _prodsOcVisitsMap =- _cVisitsMap- ( _prodsIacount,_prodsIadditionalDep,_prodsIaranges,_prodsIcProductions,_prodsIdirectDep,_prodsIerrors,_prodsIinstDep,_prodsIntattrs,_prodsIprods,_prodsIrules,_prodsIvcount) =- (prods_ _prodsOacount _prodsOallnts _prodsOcInterfaceMap _prodsOcVisitsMap _prodsOmanualAttrDepMap _prodsOo_case _prodsOo_cata _prodsOo_data _prodsOo_dovisit _prodsOo_newtypes _prodsOo_rename _prodsOo_sem _prodsOo_sig _prodsOo_unbox _prodsOo_wantvisit _prodsOprefix _prodsOvcount )- in ( _lhsOerrors,_lhsOoutput))) )--- Pattern ------------------------------------------------------{-- visit 0:- inherited attributes:- allTypeSigs : Map Name Type- altAttrs : Map AltAttr Vertex- con : Identifier- inh : Attributes- nt : Identifier- syn : Attributes- synthesized attributes:- copy : SELF- errors : Seq Error- gathAltAttrs : [AltAttr]- instVars : [Name]- locVars : [Name]- patternAttrs : [(Name,Name,Bool,Patterns)]- alternatives:- alternative Alias:- child field : {Name}- child attr : {Name}- child pat : Pattern- child parts : Patterns- visit 0:- local copy : _- alternative Constr:- child name : {Constructor}- child pats : Patterns- 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 (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 ((Map Name Type) ->- (Map AltAttr Vertex) ->- Identifier ->- Attributes ->- Identifier ->- Attributes ->- ( Pattern,(Seq Error),([AltAttr]),([Name]),([Name]),([(Name,Name,Bool,Patterns)])))-data Inh_Pattern = Inh_Pattern {allTypeSigs_Inh_Pattern :: Map Name Type,altAttrs_Inh_Pattern :: Map AltAttr Vertex,con_Inh_Pattern :: Identifier,inh_Inh_Pattern :: Attributes,nt_Inh_Pattern :: Identifier,syn_Inh_Pattern :: Attributes}-data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern,errors_Syn_Pattern :: Seq Error,gathAltAttrs_Syn_Pattern :: [AltAttr],instVars_Syn_Pattern :: [Name],locVars_Syn_Pattern :: [Name],patternAttrs_Syn_Pattern :: [(Name,Name,Bool,Patterns)]}-wrap_Pattern (T_Pattern sem ) (Inh_Pattern _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn ) =- (let ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs) =- (sem _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn )- in (Syn_Pattern _lhsOcopy _lhsOerrors _lhsOgathAltAttrs _lhsOinstVars _lhsOlocVars _lhsOpatternAttrs ))-sem_Pattern_Alias :: Name ->- Name ->- T_Pattern ->- T_Patterns ->- T_Pattern-sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) =- (T_Pattern (\ _lhsIallTypeSigs- _lhsIaltAttrs- _lhsIcon- _lhsIinh- _lhsInt- _lhsIsyn ->- (let _lhsOgathAltAttrs :: ([AltAttr])- _lhsOpatternAttrs :: ([(Name,Name,Bool,Patterns)])- _lhsOlocVars :: ([Name])- _lhsOinstVars :: ([Name])- _lhsOerrors :: (Seq Error)- _lhsOcopy :: Pattern- _patOallTypeSigs :: (Map Name Type)- _patOaltAttrs :: (Map AltAttr Vertex)- _patOcon :: Identifier- _patOinh :: Attributes- _patOnt :: Identifier- _patOsyn :: Attributes- _partsOallTypeSigs :: (Map Name Type)- _partsOaltAttrs :: (Map AltAttr Vertex)- _partsOcon :: Identifier- _partsOinh :: Attributes- _partsOnt :: Identifier- _partsOsyn :: Attributes- _patIcopy :: Pattern- _patIerrors :: (Seq Error)- _patIgathAltAttrs :: ([AltAttr])- _patIinstVars :: ([Name])- _patIlocVars :: ([Name])- _patIpatternAttrs :: ([(Name,Name,Bool,Patterns)])- _partsIcopy :: Patterns- _partsIerrors :: (Seq Error)- _partsIgathAltAttrs :: ([AltAttr])- _partsIinstVars :: ([Name])- _partsIlocVars :: ([Name])- _partsIpatternAttrs :: ([(Name,Name,Bool,Patterns)])- -- "Order.ag"(line 160, column 12)- _lhsOgathAltAttrs =- [AltAttr field_ attr_ (field_ == _LOC || field_ == _INST)]- -- "Order.ag"(line 227, column 12)- _lhsOpatternAttrs =- [(field_,attr_,(field_ == _LOC || field_ == _INST),_partsIcopy)]- -- "Order.ag"(line 536, column 14)- _lhsOlocVars =- if field_ == _LOC- then [attr_]- else []- -- "Order.ag"(line 539, column 14)- _lhsOinstVars =- if field_ == _INST- then [attr_]- else []- -- use rule "Order.ag"(line 60, column 70)- _lhsOerrors =- _patIerrors Seq.<> _partsIerrors- -- self rule- _copy =- Alias field_ attr_ _patIcopy _partsIcopy- -- self rule- _lhsOcopy =- _copy- -- copy rule (down)- _patOallTypeSigs =- _lhsIallTypeSigs- -- copy rule (down)- _patOaltAttrs =- _lhsIaltAttrs- -- copy rule (down)- _patOcon =- _lhsIcon- -- copy rule (down)- _patOinh =- _lhsIinh- -- copy rule (down)- _patOnt =- _lhsInt- -- copy rule (down)- _patOsyn =- _lhsIsyn- -- copy rule (down)- _partsOallTypeSigs =- _lhsIallTypeSigs- -- copy rule (down)- _partsOaltAttrs =- _lhsIaltAttrs- -- copy rule (down)- _partsOcon =- _lhsIcon- -- copy rule (down)- _partsOinh =- _lhsIinh- -- copy rule (down)- _partsOnt =- _lhsInt- -- copy rule (down)- _partsOsyn =- _lhsIsyn- ( _patIcopy,_patIerrors,_patIgathAltAttrs,_patIinstVars,_patIlocVars,_patIpatternAttrs) =- (pat_ _patOallTypeSigs _patOaltAttrs _patOcon _patOinh _patOnt _patOsyn )- ( _partsIcopy,_partsIerrors,_partsIgathAltAttrs,_partsIinstVars,_partsIlocVars,_partsIpatternAttrs) =- (parts_ _partsOallTypeSigs _partsOaltAttrs _partsOcon _partsOinh _partsOnt _partsOsyn )- in ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs))) )-sem_Pattern_Constr :: Constructor ->- T_Patterns ->- T_Pattern-sem_Pattern_Constr name_ (T_Patterns pats_ ) =- (T_Pattern (\ _lhsIallTypeSigs- _lhsIaltAttrs- _lhsIcon- _lhsIinh- _lhsInt- _lhsIsyn ->- (let _lhsOerrors :: (Seq Error)- _lhsOgathAltAttrs :: ([AltAttr])- _lhsOinstVars :: ([Name])- _lhsOlocVars :: ([Name])- _lhsOpatternAttrs :: ([(Name,Name,Bool,Patterns)])- _lhsOcopy :: Pattern- _patsOallTypeSigs :: (Map Name Type)- _patsOaltAttrs :: (Map AltAttr Vertex)- _patsOcon :: Identifier- _patsOinh :: Attributes- _patsOnt :: Identifier- _patsOsyn :: Attributes- _patsIcopy :: Patterns- _patsIerrors :: (Seq Error)- _patsIgathAltAttrs :: ([AltAttr])- _patsIinstVars :: ([Name])- _patsIlocVars :: ([Name])- _patsIpatternAttrs :: ([(Name,Name,Bool,Patterns)])- -- use rule "Order.ag"(line 60, column 70)- _lhsOerrors =- _patsIerrors- -- use rule "Order.ag"(line 146, column 68)- _lhsOgathAltAttrs =- _patsIgathAltAttrs- -- use rule "Order.ag"(line 533, column 80)- _lhsOinstVars =- _patsIinstVars- -- use rule "Order.ag"(line 533, column 48)- _lhsOlocVars =- _patsIlocVars- -- use rule "Order.ag"(line 224, column 42)- _lhsOpatternAttrs =- _patsIpatternAttrs- -- self rule- _copy =- Constr name_ _patsIcopy- -- self rule- _lhsOcopy =- _copy- -- copy rule (down)- _patsOallTypeSigs =- _lhsIallTypeSigs- -- copy rule (down)- _patsOaltAttrs =- _lhsIaltAttrs- -- copy rule (down)- _patsOcon =- _lhsIcon- -- copy rule (down)- _patsOinh =- _lhsIinh- -- copy rule (down)- _patsOnt =- _lhsInt- -- copy rule (down)- _patsOsyn =- _lhsIsyn- ( _patsIcopy,_patsIerrors,_patsIgathAltAttrs,_patsIinstVars,_patsIlocVars,_patsIpatternAttrs) =- (pats_ _patsOallTypeSigs _patsOaltAttrs _patsOcon _patsOinh _patsOnt _patsOsyn )- in ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs))) )-sem_Pattern_Product :: Pos ->- T_Patterns ->- T_Pattern-sem_Pattern_Product pos_ (T_Patterns pats_ ) =- (T_Pattern (\ _lhsIallTypeSigs- _lhsIaltAttrs- _lhsIcon- _lhsIinh- _lhsInt- _lhsIsyn ->- (let _lhsOerrors :: (Seq Error)- _lhsOgathAltAttrs :: ([AltAttr])- _lhsOinstVars :: ([Name])- _lhsOlocVars :: ([Name])- _lhsOpatternAttrs :: ([(Name,Name,Bool,Patterns)])- _lhsOcopy :: Pattern- _patsOallTypeSigs :: (Map Name Type)- _patsOaltAttrs :: (Map AltAttr Vertex)- _patsOcon :: Identifier- _patsOinh :: Attributes- _patsOnt :: Identifier- _patsOsyn :: Attributes- _patsIcopy :: Patterns- _patsIerrors :: (Seq Error)- _patsIgathAltAttrs :: ([AltAttr])- _patsIinstVars :: ([Name])- _patsIlocVars :: ([Name])- _patsIpatternAttrs :: ([(Name,Name,Bool,Patterns)])- -- use rule "Order.ag"(line 60, column 70)- _lhsOerrors =- _patsIerrors- -- use rule "Order.ag"(line 146, column 68)- _lhsOgathAltAttrs =- _patsIgathAltAttrs- -- use rule "Order.ag"(line 533, column 80)- _lhsOinstVars =- _patsIinstVars- -- use rule "Order.ag"(line 533, column 48)- _lhsOlocVars =- _patsIlocVars- -- use rule "Order.ag"(line 224, column 42)- _lhsOpatternAttrs =- _patsIpatternAttrs- -- self rule- _copy =- Product pos_ _patsIcopy- -- self rule- _lhsOcopy =- _copy- -- copy rule (down)- _patsOallTypeSigs =- _lhsIallTypeSigs- -- copy rule (down)- _patsOaltAttrs =- _lhsIaltAttrs- -- copy rule (down)- _patsOcon =- _lhsIcon- -- copy rule (down)- _patsOinh =- _lhsIinh- -- copy rule (down)- _patsOnt =- _lhsInt- -- copy rule (down)- _patsOsyn =- _lhsIsyn- ( _patsIcopy,_patsIerrors,_patsIgathAltAttrs,_patsIinstVars,_patsIlocVars,_patsIpatternAttrs) =- (pats_ _patsOallTypeSigs _patsOaltAttrs _patsOcon _patsOinh _patsOnt _patsOsyn )- in ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs))) )-sem_Pattern_Underscore :: Pos ->- T_Pattern-sem_Pattern_Underscore pos_ =- (T_Pattern (\ _lhsIallTypeSigs- _lhsIaltAttrs- _lhsIcon- _lhsIinh- _lhsInt- _lhsIsyn ->- (let _lhsOerrors :: (Seq Error)- _lhsOgathAltAttrs :: ([AltAttr])- _lhsOinstVars :: ([Name])- _lhsOlocVars :: ([Name])- _lhsOpatternAttrs :: ([(Name,Name,Bool,Patterns)])- _lhsOcopy :: Pattern- -- use rule "Order.ag"(line 60, column 70)- _lhsOerrors =- Seq.empty- -- use rule "Order.ag"(line 146, column 68)- _lhsOgathAltAttrs =- []- -- use rule "Order.ag"(line 533, column 80)- _lhsOinstVars =- []- -- use rule "Order.ag"(line 533, column 48)- _lhsOlocVars =- []- -- use rule "Order.ag"(line 224, column 42)- _lhsOpatternAttrs =- []- -- self rule- _copy =- Underscore pos_- -- self rule- _lhsOcopy =- _copy- in ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs))) )--- Patterns -----------------------------------------------------{-- visit 0:- inherited attributes:- allTypeSigs : Map Name Type- altAttrs : Map AltAttr Vertex- con : Identifier- inh : Attributes- nt : Identifier- syn : Attributes- synthesized attributes:- copy : SELF- errors : Seq Error- gathAltAttrs : [AltAttr]- instVars : [Name]- locVars : [Name]- patternAttrs : [(Name,Name,Bool,Patterns)]- 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 ((Map Name Type) ->- (Map AltAttr Vertex) ->- Identifier ->- Attributes ->- Identifier ->- Attributes ->- ( Patterns,(Seq Error),([AltAttr]),([Name]),([Name]),([(Name,Name,Bool,Patterns)])))-data Inh_Patterns = Inh_Patterns {allTypeSigs_Inh_Patterns :: Map Name Type,altAttrs_Inh_Patterns :: Map AltAttr Vertex,con_Inh_Patterns :: Identifier,inh_Inh_Patterns :: Attributes,nt_Inh_Patterns :: Identifier,syn_Inh_Patterns :: Attributes}-data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns,errors_Syn_Patterns :: Seq Error,gathAltAttrs_Syn_Patterns :: [AltAttr],instVars_Syn_Patterns :: [Name],locVars_Syn_Patterns :: [Name],patternAttrs_Syn_Patterns :: [(Name,Name,Bool,Patterns)]}-wrap_Patterns (T_Patterns sem ) (Inh_Patterns _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn ) =- (let ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs) =- (sem _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn )- in (Syn_Patterns _lhsOcopy _lhsOerrors _lhsOgathAltAttrs _lhsOinstVars _lhsOlocVars _lhsOpatternAttrs ))-sem_Patterns_Cons :: T_Pattern ->- T_Patterns ->- T_Patterns-sem_Patterns_Cons (T_Pattern hd_ ) (T_Patterns tl_ ) =- (T_Patterns (\ _lhsIallTypeSigs- _lhsIaltAttrs- _lhsIcon- _lhsIinh- _lhsInt- _lhsIsyn ->- (let _lhsOerrors :: (Seq Error)- _lhsOgathAltAttrs :: ([AltAttr])- _lhsOinstVars :: ([Name])- _lhsOlocVars :: ([Name])- _lhsOpatternAttrs :: ([(Name,Name,Bool,Patterns)])- _lhsOcopy :: Patterns- _hdOallTypeSigs :: (Map Name Type)- _hdOaltAttrs :: (Map AltAttr Vertex)- _hdOcon :: Identifier- _hdOinh :: Attributes- _hdOnt :: Identifier- _hdOsyn :: Attributes- _tlOallTypeSigs :: (Map Name Type)- _tlOaltAttrs :: (Map AltAttr Vertex)- _tlOcon :: Identifier- _tlOinh :: Attributes- _tlOnt :: Identifier- _tlOsyn :: Attributes- _hdIcopy :: Pattern- _hdIerrors :: (Seq Error)- _hdIgathAltAttrs :: ([AltAttr])- _hdIinstVars :: ([Name])- _hdIlocVars :: ([Name])- _hdIpatternAttrs :: ([(Name,Name,Bool,Patterns)])- _tlIcopy :: Patterns- _tlIerrors :: (Seq Error)- _tlIgathAltAttrs :: ([AltAttr])- _tlIinstVars :: ([Name])- _tlIlocVars :: ([Name])- _tlIpatternAttrs :: ([(Name,Name,Bool,Patterns)])- -- use rule "Order.ag"(line 60, column 70)- _lhsOerrors =- _hdIerrors Seq.<> _tlIerrors- -- use rule "Order.ag"(line 146, column 68)- _lhsOgathAltAttrs =- _hdIgathAltAttrs ++ _tlIgathAltAttrs- -- use rule "Order.ag"(line 533, column 80)- _lhsOinstVars =- _hdIinstVars ++ _tlIinstVars- -- use rule "Order.ag"(line 533, column 48)- _lhsOlocVars =- _hdIlocVars ++ _tlIlocVars- -- use rule "Order.ag"(line 224, column 42)- _lhsOpatternAttrs =- _hdIpatternAttrs ++ _tlIpatternAttrs- -- self rule- _copy =- (:) _hdIcopy _tlIcopy- -- self rule- _lhsOcopy =- _copy- -- copy rule (down)- _hdOallTypeSigs =- _lhsIallTypeSigs- -- copy rule (down)- _hdOaltAttrs =- _lhsIaltAttrs- -- copy rule (down)- _hdOcon =- _lhsIcon- -- copy rule (down)- _hdOinh =- _lhsIinh- -- copy rule (down)- _hdOnt =- _lhsInt- -- copy rule (down)- _hdOsyn =- _lhsIsyn- -- copy rule (down)- _tlOallTypeSigs =- _lhsIallTypeSigs- -- copy rule (down)- _tlOaltAttrs =- _lhsIaltAttrs- -- copy rule (down)- _tlOcon =- _lhsIcon- -- copy rule (down)- _tlOinh =- _lhsIinh- -- copy rule (down)- _tlOnt =- _lhsInt- -- copy rule (down)- _tlOsyn =- _lhsIsyn- ( _hdIcopy,_hdIerrors,_hdIgathAltAttrs,_hdIinstVars,_hdIlocVars,_hdIpatternAttrs) =- (hd_ _hdOallTypeSigs _hdOaltAttrs _hdOcon _hdOinh _hdOnt _hdOsyn )- ( _tlIcopy,_tlIerrors,_tlIgathAltAttrs,_tlIinstVars,_tlIlocVars,_tlIpatternAttrs) =- (tl_ _tlOallTypeSigs _tlOaltAttrs _tlOcon _tlOinh _tlOnt _tlOsyn )- in ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs))) )-sem_Patterns_Nil :: T_Patterns-sem_Patterns_Nil =- (T_Patterns (\ _lhsIallTypeSigs- _lhsIaltAttrs- _lhsIcon- _lhsIinh- _lhsInt- _lhsIsyn ->- (let _lhsOerrors :: (Seq Error)- _lhsOgathAltAttrs :: ([AltAttr])- _lhsOinstVars :: ([Name])- _lhsOlocVars :: ([Name])- _lhsOpatternAttrs :: ([(Name,Name,Bool,Patterns)])- _lhsOcopy :: Patterns- -- use rule "Order.ag"(line 60, column 70)- _lhsOerrors =- Seq.empty- -- use rule "Order.ag"(line 146, column 68)- _lhsOgathAltAttrs =- []- -- use rule "Order.ag"(line 533, column 80)- _lhsOinstVars =- []- -- use rule "Order.ag"(line 533, column 48)- _lhsOlocVars =- []- -- use rule "Order.ag"(line 224, column 42)- _lhsOpatternAttrs =- []- -- self rule- _copy =- []- -- self rule- _lhsOcopy =- _copy- in ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs))) )--- Production ---------------------------------------------------{-- visit 0:- inherited attributes:- allnts : [Name]- cInterfaceMap : CInterfaceMap- cVisitsMap : CVisitsMap- manualAttrDepMap : AttrOrderMap- o_case : Bool- o_cata : Bool- o_data : Bool- o_dovisit : Bool- o_newtypes : Bool- o_rename : Bool- o_sem : Bool- o_sig : Bool- o_unbox : Bool- o_wantvisit : Bool- prefix : String- chained attributes:- acount : Int- vcount : Int- synthesized attributes:- additionalDep : Seq Edge- aranges : Seq (Int,Int,Int)- cProduction : CProduction- directDep : Seq Edge- errors : Seq Error- instDep : Seq Edge- ntattrs : Seq (Vertex,NTAttr)- prods : [(Nonterminal,[Constructor])]- rules : Seq (Vertex,CRule)- alternatives:- alternative Production:- child nt : {Nonterminal}- child inh : {Attributes}- child syn : {Attributes}- child alts : Alternatives- visit 0:- local ntattrs : _- local cInter : _--}--- cata-sem_Production :: Production ->- T_Production-sem_Production (Production _nt _inh _syn _alts ) =- (sem_Production_Production _nt _inh _syn (sem_Alternatives _alts ) )--- semantic domain-newtype T_Production = T_Production (Int ->- ([Name]) ->- CInterfaceMap ->- CVisitsMap ->- AttrOrderMap ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- String ->- Int ->- ( Int,(Seq Edge),(Seq (Int,Int,Int)),CProduction,(Seq Edge),(Seq Error),(Seq Edge),(Seq (Vertex,NTAttr)),([(Nonterminal,[Constructor])]),(Seq (Vertex,CRule)),Int))-data Inh_Production = Inh_Production {acount_Inh_Production :: Int,allnts_Inh_Production :: [Name],cInterfaceMap_Inh_Production :: CInterfaceMap,cVisitsMap_Inh_Production :: CVisitsMap,manualAttrDepMap_Inh_Production :: AttrOrderMap,o_case_Inh_Production :: Bool,o_cata_Inh_Production :: Bool,o_data_Inh_Production :: Bool,o_dovisit_Inh_Production :: Bool,o_newtypes_Inh_Production :: Bool,o_rename_Inh_Production :: Bool,o_sem_Inh_Production :: Bool,o_sig_Inh_Production :: Bool,o_unbox_Inh_Production :: Bool,o_wantvisit_Inh_Production :: Bool,prefix_Inh_Production :: String,vcount_Inh_Production :: Int}-data Syn_Production = Syn_Production {acount_Syn_Production :: Int,additionalDep_Syn_Production :: Seq Edge,aranges_Syn_Production :: Seq (Int,Int,Int),cProduction_Syn_Production :: CProduction,directDep_Syn_Production :: Seq Edge,errors_Syn_Production :: Seq Error,instDep_Syn_Production :: Seq Edge,ntattrs_Syn_Production :: Seq (Vertex,NTAttr),prods_Syn_Production :: [(Nonterminal,[Constructor])],rules_Syn_Production :: Seq (Vertex,CRule),vcount_Syn_Production :: Int}-wrap_Production (T_Production sem ) (Inh_Production _lhsIacount _lhsIallnts _lhsIcInterfaceMap _lhsIcVisitsMap _lhsImanualAttrDepMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIvcount ) =- (let ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOcProduction,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOntattrs,_lhsOprods,_lhsOrules,_lhsOvcount) =- (sem _lhsIacount _lhsIallnts _lhsIcInterfaceMap _lhsIcVisitsMap _lhsImanualAttrDepMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIvcount )- in (Syn_Production _lhsOacount _lhsOadditionalDep _lhsOaranges _lhsOcProduction _lhsOdirectDep _lhsOerrors _lhsOinstDep _lhsOntattrs _lhsOprods _lhsOrules _lhsOvcount ))-sem_Production_Production :: Nonterminal ->- Attributes ->- Attributes ->- T_Alternatives ->- T_Production-sem_Production_Production nt_ inh_ syn_ (T_Alternatives alts_ ) =- (T_Production (\ _lhsIacount- _lhsIallnts- _lhsIcInterfaceMap- _lhsIcVisitsMap- _lhsImanualAttrDepMap- _lhsIo_case- _lhsIo_cata- _lhsIo_data- _lhsIo_dovisit- _lhsIo_newtypes- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_unbox- _lhsIo_wantvisit- _lhsIprefix- _lhsIvcount ->- (let _altsOnt :: Identifier- _altsOinh :: Attributes- _altsOsyn :: Attributes- _lhsOntattrs :: (Seq (Vertex,NTAttr))- _lhsOacount :: Int- _lhsOaranges :: (Seq (Int,Int,Int))- _lhsOprods :: ([(Nonterminal,[Constructor])])- _lhsOcProduction :: CProduction- _lhsOadditionalDep :: (Seq Edge)- _lhsOdirectDep :: (Seq Edge)- _lhsOerrors :: (Seq Error)- _lhsOinstDep :: (Seq Edge)- _lhsOrules :: (Seq (Vertex,CRule))- _lhsOvcount :: Int- _altsOallnts :: ([Name])- _altsOcVisitsMap :: CVisitsMap- _altsOmanualAttrDepMap :: AttrOrderMap- _altsOo_case :: Bool- _altsOo_cata :: Bool- _altsOo_dovisit :: Bool- _altsOo_newtypes :: Bool- _altsOo_rename :: Bool- _altsOo_sem :: Bool- _altsOo_sig :: Bool- _altsOo_unbox :: Bool- _altsOo_wantvisit :: Bool- _altsOprefix :: String- _altsOvcount :: Int- _altsIadditionalDep :: (Seq Edge)- _altsIcAlternatives :: CAlternatives- _altsIcons :: ([Constructor])- _altsIdirectDep :: (Seq Edge)- _altsIerrors :: (Seq Error)- _altsIinstDep :: (Seq Edge)- _altsIrules :: (Seq (Vertex,CRule))- _altsIvcount :: Int- -- "Order.ag"(line 73, column 16)- _altsOnt =- nt_- -- "Order.ag"(line 76, column 16)- _altsOinh =- inh_- -- "Order.ag"(line 77, column 16)- _altsOsyn =- syn_- -- "Order.ag"(line 368, column 16)- _ntattrs =- [ NTAInh nt_ inh tp | (inh,tp) <- Map.assocs inh_ ]- ++ [NTASyn nt_ syn tp | (syn,tp) <- Map.assocs syn_ ]- -- "Order.ag"(line 370, column 16)- _lhsOntattrs =- Seq.fromList (zip [_lhsIacount ..] _ntattrs)- -- "Order.ag"(line 371, column 16)- _lhsOacount =- _lhsIacount + Map.size inh_ + Map.size syn_- -- "Order.ag"(line 372, column 16)- _lhsOaranges =- Seq.single- (_lhsIacount- ,_lhsIacount + Map.size inh_- ,_lhsIacount + Map.size syn_ + Map.size inh_ - 1)- -- "Order.ag"(line 381, column 18)- _lhsOprods =- [(nt_,_altsIcons)]- -- "Order.ag"(line 456, column 18)- _cInter =- if _lhsIo_dovisit- then findWithErr1 "Production.cInter" nt_ _lhsIcInterfaceMap- else CInterface [CSegment inh_ syn_]- -- "Order.ag"(line 484, column 18)- _lhsOcProduction =- CProduction nt_ inh_ syn_ _altsIcAlternatives _cInter- -- use rule "Order.ag"(line 258, column 71)- _lhsOadditionalDep =- _altsIadditionalDep- -- use rule "Order.ag"(line 244, column 33)- _lhsOdirectDep =- _altsIdirectDep- -- use rule "Order.ag"(line 60, column 70)- _lhsOerrors =- _altsIerrors- -- use rule "Order.ag"(line 289, column 31)- _lhsOinstDep =- _altsIinstDep- -- use rule "Order.ag"(line 234, column 18)- _lhsOrules =- _altsIrules- -- copy rule (up)- _lhsOvcount =- _altsIvcount- -- copy rule (down)- _altsOallnts =- _lhsIallnts- -- copy rule (down)- _altsOcVisitsMap =- _lhsIcVisitsMap- -- copy rule (down)- _altsOmanualAttrDepMap =- _lhsImanualAttrDepMap- -- copy rule (down)- _altsOo_case =- _lhsIo_case- -- copy rule (down)- _altsOo_cata =- _lhsIo_cata- -- copy rule (down)- _altsOo_dovisit =- _lhsIo_dovisit- -- copy rule (down)- _altsOo_newtypes =- _lhsIo_newtypes- -- copy rule (down)- _altsOo_rename =- _lhsIo_rename- -- copy rule (down)- _altsOo_sem =- _lhsIo_sem- -- copy rule (down)- _altsOo_sig =- _lhsIo_sig- -- copy rule (down)- _altsOo_unbox =- _lhsIo_unbox- -- copy rule (down)- _altsOo_wantvisit =- _lhsIo_wantvisit- -- copy rule (down)- _altsOprefix =- _lhsIprefix- -- copy rule (down)- _altsOvcount =- _lhsIvcount- ( _altsIadditionalDep,_altsIcAlternatives,_altsIcons,_altsIdirectDep,_altsIerrors,_altsIinstDep,_altsIrules,_altsIvcount) =- (alts_ _altsOallnts _altsOcVisitsMap _altsOinh _altsOmanualAttrDepMap _altsOnt _altsOo_case _altsOo_cata _altsOo_dovisit _altsOo_newtypes _altsOo_rename _altsOo_sem _altsOo_sig _altsOo_unbox _altsOo_wantvisit _altsOprefix _altsOsyn _altsOvcount )- in ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOcProduction,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOntattrs,_lhsOprods,_lhsOrules,_lhsOvcount))) )--- Productions --------------------------------------------------{-- visit 0:- inherited attributes:- allnts : [Name]- cInterfaceMap : CInterfaceMap- cVisitsMap : CVisitsMap- manualAttrDepMap : AttrOrderMap- o_case : Bool- o_cata : Bool- o_data : Bool- o_dovisit : Bool- o_newtypes : Bool- o_rename : Bool- o_sem : Bool- o_sig : Bool- o_unbox : Bool- o_wantvisit : Bool- prefix : String- chained attributes:- acount : Int- vcount : Int- synthesized attributes:- additionalDep : Seq Edge- aranges : Seq (Int,Int,Int)- cProductions : CProductions- directDep : Seq Edge- errors : Seq Error- instDep : Seq Edge- ntattrs : Seq (Vertex,NTAttr)- prods : [(Nonterminal,[Constructor])]- rules : Seq (Vertex,CRule)- 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 (Int ->- ([Name]) ->- CInterfaceMap ->- CVisitsMap ->- AttrOrderMap ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- String ->- Int ->- ( Int,(Seq Edge),(Seq (Int,Int,Int)),CProductions,(Seq Edge),(Seq Error),(Seq Edge),(Seq (Vertex,NTAttr)),([(Nonterminal,[Constructor])]),(Seq (Vertex,CRule)),Int))-data Inh_Productions = Inh_Productions {acount_Inh_Productions :: Int,allnts_Inh_Productions :: [Name],cInterfaceMap_Inh_Productions :: CInterfaceMap,cVisitsMap_Inh_Productions :: CVisitsMap,manualAttrDepMap_Inh_Productions :: AttrOrderMap,o_case_Inh_Productions :: Bool,o_cata_Inh_Productions :: Bool,o_data_Inh_Productions :: Bool,o_dovisit_Inh_Productions :: Bool,o_newtypes_Inh_Productions :: Bool,o_rename_Inh_Productions :: Bool,o_sem_Inh_Productions :: Bool,o_sig_Inh_Productions :: Bool,o_unbox_Inh_Productions :: Bool,o_wantvisit_Inh_Productions :: Bool,prefix_Inh_Productions :: String,vcount_Inh_Productions :: Int}-data Syn_Productions = Syn_Productions {acount_Syn_Productions :: Int,additionalDep_Syn_Productions :: Seq Edge,aranges_Syn_Productions :: Seq (Int,Int,Int),cProductions_Syn_Productions :: CProductions,directDep_Syn_Productions :: Seq Edge,errors_Syn_Productions :: Seq Error,instDep_Syn_Productions :: Seq Edge,ntattrs_Syn_Productions :: Seq (Vertex,NTAttr),prods_Syn_Productions :: [(Nonterminal,[Constructor])],rules_Syn_Productions :: Seq (Vertex,CRule),vcount_Syn_Productions :: Int}-wrap_Productions (T_Productions sem ) (Inh_Productions _lhsIacount _lhsIallnts _lhsIcInterfaceMap _lhsIcVisitsMap _lhsImanualAttrDepMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIvcount ) =- (let ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOcProductions,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOntattrs,_lhsOprods,_lhsOrules,_lhsOvcount) =- (sem _lhsIacount _lhsIallnts _lhsIcInterfaceMap _lhsIcVisitsMap _lhsImanualAttrDepMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIvcount )- in (Syn_Productions _lhsOacount _lhsOadditionalDep _lhsOaranges _lhsOcProductions _lhsOdirectDep _lhsOerrors _lhsOinstDep _lhsOntattrs _lhsOprods _lhsOrules _lhsOvcount ))-sem_Productions_Cons :: T_Production ->- T_Productions ->- T_Productions-sem_Productions_Cons (T_Production hd_ ) (T_Productions tl_ ) =- (T_Productions (\ _lhsIacount- _lhsIallnts- _lhsIcInterfaceMap- _lhsIcVisitsMap- _lhsImanualAttrDepMap- _lhsIo_case- _lhsIo_cata- _lhsIo_data- _lhsIo_dovisit- _lhsIo_newtypes- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_unbox- _lhsIo_wantvisit- _lhsIprefix- _lhsIvcount ->- (let _lhsOcProductions :: CProductions- _lhsOadditionalDep :: (Seq Edge)- _lhsOaranges :: (Seq (Int,Int,Int))- _lhsOdirectDep :: (Seq Edge)- _lhsOerrors :: (Seq Error)- _lhsOinstDep :: (Seq Edge)- _lhsOntattrs :: (Seq (Vertex,NTAttr))- _lhsOprods :: ([(Nonterminal,[Constructor])])- _lhsOrules :: (Seq (Vertex,CRule))- _lhsOacount :: Int- _lhsOvcount :: Int- _hdOacount :: Int- _hdOallnts :: ([Name])- _hdOcInterfaceMap :: CInterfaceMap- _hdOcVisitsMap :: CVisitsMap- _hdOmanualAttrDepMap :: AttrOrderMap- _hdOo_case :: Bool- _hdOo_cata :: Bool- _hdOo_data :: Bool- _hdOo_dovisit :: Bool- _hdOo_newtypes :: Bool- _hdOo_rename :: Bool- _hdOo_sem :: Bool- _hdOo_sig :: Bool- _hdOo_unbox :: Bool- _hdOo_wantvisit :: Bool- _hdOprefix :: String- _hdOvcount :: Int- _tlOacount :: Int- _tlOallnts :: ([Name])- _tlOcInterfaceMap :: CInterfaceMap- _tlOcVisitsMap :: CVisitsMap- _tlOmanualAttrDepMap :: AttrOrderMap- _tlOo_case :: Bool- _tlOo_cata :: Bool- _tlOo_data :: Bool- _tlOo_dovisit :: Bool- _tlOo_newtypes :: Bool- _tlOo_rename :: Bool- _tlOo_sem :: Bool- _tlOo_sig :: Bool- _tlOo_unbox :: Bool- _tlOo_wantvisit :: Bool- _tlOprefix :: String- _tlOvcount :: Int- _hdIacount :: Int- _hdIadditionalDep :: (Seq Edge)- _hdIaranges :: (Seq (Int,Int,Int))- _hdIcProduction :: CProduction- _hdIdirectDep :: (Seq Edge)- _hdIerrors :: (Seq Error)- _hdIinstDep :: (Seq Edge)- _hdIntattrs :: (Seq (Vertex,NTAttr))- _hdIprods :: ([(Nonterminal,[Constructor])])- _hdIrules :: (Seq (Vertex,CRule))- _hdIvcount :: Int- _tlIacount :: Int- _tlIadditionalDep :: (Seq Edge)- _tlIaranges :: (Seq (Int,Int,Int))- _tlIcProductions :: CProductions- _tlIdirectDep :: (Seq Edge)- _tlIerrors :: (Seq Error)- _tlIinstDep :: (Seq Edge)- _tlIntattrs :: (Seq (Vertex,NTAttr))- _tlIprods :: ([(Nonterminal,[Constructor])])- _tlIrules :: (Seq (Vertex,CRule))- _tlIvcount :: Int- -- "Order.ag"(line 481, column 12)- _lhsOcProductions =- _hdIcProduction : _tlIcProductions- -- use rule "Order.ag"(line 258, column 71)- _lhsOadditionalDep =- _hdIadditionalDep Seq.<> _tlIadditionalDep- -- use rule "Order.ag"(line 362, column 36)- _lhsOaranges =- _hdIaranges Seq.<> _tlIaranges- -- use rule "Order.ag"(line 244, column 33)- _lhsOdirectDep =- _hdIdirectDep Seq.<> _tlIdirectDep- -- use rule "Order.ag"(line 60, column 70)- _lhsOerrors =- _hdIerrors Seq.<> _tlIerrors- -- use rule "Order.ag"(line 289, column 31)- _lhsOinstDep =- _hdIinstDep Seq.<> _tlIinstDep- -- use rule "Order.ag"(line 361, column 35)- _lhsOntattrs =- _hdIntattrs Seq.<> _tlIntattrs- -- use rule "Order.ag"(line 379, column 41)- _lhsOprods =- _hdIprods ++ _tlIprods- -- use rule "Order.ag"(line 234, column 18)- _lhsOrules =- _hdIrules Seq.<> _tlIrules- -- copy rule (up)- _lhsOacount =- _tlIacount- -- copy rule (up)- _lhsOvcount =- _tlIvcount- -- copy rule (down)- _hdOacount =- _lhsIacount- -- copy rule (down)- _hdOallnts =- _lhsIallnts- -- copy rule (down)- _hdOcInterfaceMap =- _lhsIcInterfaceMap- -- copy rule (down)- _hdOcVisitsMap =- _lhsIcVisitsMap- -- copy rule (down)- _hdOmanualAttrDepMap =- _lhsImanualAttrDepMap- -- copy rule (down)- _hdOo_case =- _lhsIo_case- -- copy rule (down)- _hdOo_cata =- _lhsIo_cata- -- copy rule (down)- _hdOo_data =- _lhsIo_data- -- copy rule (down)- _hdOo_dovisit =- _lhsIo_dovisit- -- copy rule (down)- _hdOo_newtypes =- _lhsIo_newtypes- -- copy rule (down)- _hdOo_rename =- _lhsIo_rename- -- copy rule (down)- _hdOo_sem =- _lhsIo_sem- -- copy rule (down)- _hdOo_sig =- _lhsIo_sig- -- copy rule (down)- _hdOo_unbox =- _lhsIo_unbox- -- copy rule (down)- _hdOo_wantvisit =- _lhsIo_wantvisit- -- copy rule (down)- _hdOprefix =- _lhsIprefix- -- copy rule (down)- _hdOvcount =- _lhsIvcount- -- copy rule (chain)- _tlOacount =- _hdIacount- -- copy rule (down)- _tlOallnts =- _lhsIallnts- -- copy rule (down)- _tlOcInterfaceMap =- _lhsIcInterfaceMap- -- copy rule (down)- _tlOcVisitsMap =- _lhsIcVisitsMap- -- copy rule (down)- _tlOmanualAttrDepMap =- _lhsImanualAttrDepMap- -- copy rule (down)- _tlOo_case =- _lhsIo_case- -- copy rule (down)- _tlOo_cata =- _lhsIo_cata- -- copy rule (down)- _tlOo_data =- _lhsIo_data- -- copy rule (down)- _tlOo_dovisit =- _lhsIo_dovisit- -- copy rule (down)- _tlOo_newtypes =- _lhsIo_newtypes- -- copy rule (down)- _tlOo_rename =- _lhsIo_rename- -- copy rule (down)- _tlOo_sem =- _lhsIo_sem- -- copy rule (down)- _tlOo_sig =- _lhsIo_sig- -- copy rule (down)- _tlOo_unbox =- _lhsIo_unbox- -- copy rule (down)- _tlOo_wantvisit =- _lhsIo_wantvisit- -- copy rule (down)- _tlOprefix =- _lhsIprefix- -- copy rule (chain)- _tlOvcount =- _hdIvcount- ( _hdIacount,_hdIadditionalDep,_hdIaranges,_hdIcProduction,_hdIdirectDep,_hdIerrors,_hdIinstDep,_hdIntattrs,_hdIprods,_hdIrules,_hdIvcount) =- (hd_ _hdOacount _hdOallnts _hdOcInterfaceMap _hdOcVisitsMap _hdOmanualAttrDepMap _hdOo_case _hdOo_cata _hdOo_data _hdOo_dovisit _hdOo_newtypes _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_unbox _hdOo_wantvisit _hdOprefix _hdOvcount )- ( _tlIacount,_tlIadditionalDep,_tlIaranges,_tlIcProductions,_tlIdirectDep,_tlIerrors,_tlIinstDep,_tlIntattrs,_tlIprods,_tlIrules,_tlIvcount) =- (tl_ _tlOacount _tlOallnts _tlOcInterfaceMap _tlOcVisitsMap _tlOmanualAttrDepMap _tlOo_case _tlOo_cata _tlOo_data _tlOo_dovisit _tlOo_newtypes _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_unbox _tlOo_wantvisit _tlOprefix _tlOvcount )- in ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOcProductions,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOntattrs,_lhsOprods,_lhsOrules,_lhsOvcount))) )-sem_Productions_Nil :: T_Productions-sem_Productions_Nil =- (T_Productions (\ _lhsIacount- _lhsIallnts- _lhsIcInterfaceMap- _lhsIcVisitsMap- _lhsImanualAttrDepMap- _lhsIo_case- _lhsIo_cata- _lhsIo_data- _lhsIo_dovisit- _lhsIo_newtypes- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_unbox- _lhsIo_wantvisit- _lhsIprefix- _lhsIvcount ->- (let _lhsOcProductions :: CProductions- _lhsOadditionalDep :: (Seq Edge)- _lhsOaranges :: (Seq (Int,Int,Int))- _lhsOdirectDep :: (Seq Edge)- _lhsOerrors :: (Seq Error)- _lhsOinstDep :: (Seq Edge)- _lhsOntattrs :: (Seq (Vertex,NTAttr))- _lhsOprods :: ([(Nonterminal,[Constructor])])- _lhsOrules :: (Seq (Vertex,CRule))- _lhsOacount :: Int- _lhsOvcount :: Int- -- "Order.ag"(line 482, column 12)- _lhsOcProductions =- []- -- use rule "Order.ag"(line 258, column 71)- _lhsOadditionalDep =- Seq.empty- -- use rule "Order.ag"(line 362, column 36)- _lhsOaranges =- Seq.empty- -- use rule "Order.ag"(line 244, column 33)- _lhsOdirectDep =- Seq.empty- -- use rule "Order.ag"(line 60, column 70)- _lhsOerrors =- Seq.empty- -- use rule "Order.ag"(line 289, column 31)- _lhsOinstDep =- Seq.empty- -- use rule "Order.ag"(line 361, column 35)- _lhsOntattrs =- Seq.empty- -- use rule "Order.ag"(line 379, column 41)- _lhsOprods =- []- -- use rule "Order.ag"(line 234, column 18)- _lhsOrules =- Seq.empty- -- copy rule (chain)- _lhsOacount =- _lhsIacount- -- copy rule (chain)- _lhsOvcount =- _lhsIvcount- in ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOcProductions,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOntattrs,_lhsOprods,_lhsOrules,_lhsOvcount))) )--- Rule ---------------------------------------------------------{-- visit 0:- inherited attributes:- allTypeSigs : Map Name Type- allfields : [(Name,Type,Bool)]- allnts : [Name]- altAttrs : Map AltAttr Vertex- attrs : [(Name,Name)]- childInhs : Map Name Attributes- childNts : Map Name Nonterminal- con : Identifier- inh : Attributes- manualAttrDepMap : AttrOrderMap- nt : Identifier- o_case : Bool- o_cata : Bool- o_dovisit : Bool- o_newtypes : Bool- o_rename : Bool- o_sem : Bool- o_sig : Bool- o_wantvisit : Bool- prefix : String- syn : Attributes- synsOfChildren : Map Name Attributes- synthesized attributes:- additionalDep : Seq Edge- directDep : Seq Edge- errors : Seq Error- gathAltAttrs : [AltAttr]- gathRules : Seq CRule- instDep : Seq Edge- instVars : [Name]- locVars : [Name]- alternatives:- alternative Rule:- child pattern : Pattern- child rhs : Expression- child owrt : {Bool}- child origin : {String}- visit 0:- local defines : _- local gathRules : _- local manualDeps : _--}--- cata-sem_Rule :: Rule ->- T_Rule-sem_Rule (Rule _pattern _rhs _owrt _origin ) =- (sem_Rule_Rule (sem_Pattern _pattern ) (sem_Expression _rhs ) _owrt _origin )--- semantic domain-newtype T_Rule = T_Rule ((Map Name Type) ->- ([(Name,Type,Bool)]) ->- ([Name]) ->- (Map AltAttr Vertex) ->- ([(Name,Name)]) ->- (Map Name Attributes) ->- (Map Name Nonterminal) ->- Identifier ->- Attributes ->- AttrOrderMap ->- Identifier ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- String ->- Attributes ->- (Map Name Attributes) ->- ( (Seq Edge),(Seq Edge),(Seq Error),([AltAttr]),(Seq CRule),(Seq Edge),([Name]),([Name])))-data Inh_Rule = Inh_Rule {allTypeSigs_Inh_Rule :: Map Name Type,allfields_Inh_Rule :: [(Name,Type,Bool)],allnts_Inh_Rule :: [Name],altAttrs_Inh_Rule :: Map AltAttr Vertex,attrs_Inh_Rule :: [(Name,Name)],childInhs_Inh_Rule :: Map Name Attributes,childNts_Inh_Rule :: Map Name Nonterminal,con_Inh_Rule :: Identifier,inh_Inh_Rule :: Attributes,manualAttrDepMap_Inh_Rule :: AttrOrderMap,nt_Inh_Rule :: Identifier,o_case_Inh_Rule :: Bool,o_cata_Inh_Rule :: Bool,o_dovisit_Inh_Rule :: Bool,o_newtypes_Inh_Rule :: Bool,o_rename_Inh_Rule :: Bool,o_sem_Inh_Rule :: Bool,o_sig_Inh_Rule :: Bool,o_wantvisit_Inh_Rule :: Bool,prefix_Inh_Rule :: String,syn_Inh_Rule :: Attributes,synsOfChildren_Inh_Rule :: Map Name Attributes}-data Syn_Rule = Syn_Rule {additionalDep_Syn_Rule :: Seq Edge,directDep_Syn_Rule :: Seq Edge,errors_Syn_Rule :: Seq Error,gathAltAttrs_Syn_Rule :: [AltAttr],gathRules_Syn_Rule :: Seq CRule,instDep_Syn_Rule :: Seq Edge,instVars_Syn_Rule :: [Name],locVars_Syn_Rule :: [Name]}-wrap_Rule (T_Rule sem ) (Inh_Rule _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIsynsOfChildren ) =- (let ( _lhsOadditionalDep,_lhsOdirectDep,_lhsOerrors,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinstDep,_lhsOinstVars,_lhsOlocVars) =- (sem _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIsynsOfChildren )- in (Syn_Rule _lhsOadditionalDep _lhsOdirectDep _lhsOerrors _lhsOgathAltAttrs _lhsOgathRules _lhsOinstDep _lhsOinstVars _lhsOlocVars ))-sem_Rule_Rule :: T_Pattern ->- T_Expression ->- Bool ->- String ->- T_Rule-sem_Rule_Rule (T_Pattern pattern_ ) (T_Expression rhs_ ) owrt_ origin_ =- (T_Rule (\ _lhsIallTypeSigs- _lhsIallfields- _lhsIallnts- _lhsIaltAttrs- _lhsIattrs- _lhsIchildInhs- _lhsIchildNts- _lhsIcon- _lhsIinh- _lhsImanualAttrDepMap- _lhsInt- _lhsIo_case- _lhsIo_cata- _lhsIo_dovisit- _lhsIo_newtypes- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_wantvisit- _lhsIprefix- _lhsIsyn- _lhsIsynsOfChildren ->- (let _lhsOdirectDep :: (Seq Edge)- _lhsOadditionalDep :: (Seq Edge)- _lhsOinstDep :: (Seq Edge)- _lhsOerrors :: (Seq Error)- _lhsOgathAltAttrs :: ([AltAttr])- _lhsOgathRules :: (Seq CRule)- _lhsOinstVars :: ([Name])- _lhsOlocVars :: ([Name])- _patternOallTypeSigs :: (Map Name Type)- _patternOaltAttrs :: (Map AltAttr Vertex)- _patternOcon :: Identifier- _patternOinh :: Attributes- _patternOnt :: Identifier- _patternOsyn :: Attributes- _rhsOallfields :: ([(Name,Type,Bool)])- _rhsOallnts :: ([Name])- _rhsOattrs :: ([(Name,Name)])- _rhsOcon :: Name- _rhsOnt :: Name- _patternIcopy :: Pattern- _patternIerrors :: (Seq Error)- _patternIgathAltAttrs :: ([AltAttr])- _patternIinstVars :: ([Name])- _patternIlocVars :: ([Name])- _patternIpatternAttrs :: ([(Name,Name,Bool,Patterns)])- _rhsIallRhsVars :: (Set (Name,Name))- _rhsIcopy :: Expression- _rhsIerrors :: (Seq Error)- _rhsItextLines :: ([String])- _rhsIusedAttrs :: ([(Name,Name)])- _rhsIusedFields :: ([Name])- _rhsIusedLocals :: ([Name])- -- "Order.ag"(line 193, column 12)- _defines =- let tp field attr parts | field == _LOC || field == _INST- = case parts of- [] -> Map.lookup attr _lhsIallTypeSigs- _ -> (sequence (map typ parts)) >>= (haskellTupel . map (substSelf _lhsInt))- | field == _LHS = Map.lookup attr _lhsIsyn- | otherwise = Map.lookup attr (findWithErr1 "Rule.defines.tp" field _lhsIchildInhs)- typ :: Pattern -> Maybe Type- typ (Alias field attr _ parts) = tp field attr parts- typ (Underscore _) = Nothing- typ (Product _ pats) = tp _LOC undefined pats- typ _ = Nothing- in Map.fromList [ (findWithErr1 "Rule.defines" aa _lhsIaltAttrs, (field,attr,(tp field attr parts)))- | (field,attr,isLocalOrInst,parts) <- _patternIpatternAttrs- , let aa = AltAttr field attr isLocalOrInst- ]- -- "Order.ag"(line 209, column 12)- _gathRules =- let childnt field = Map.lookup field _lhsIchildNts- in Seq.fromList [ CRule attr False True _lhsInt _lhsIcon field (childnt field) tp _patternIcopy _rhsItextLines _defines owrt_ origin_ _rhsIallRhsVars- | (field,attr,tp) <- Map.elems _defines- ]- -- "Order.ag"(line 246, column 12)- _lhsOdirectDep =- let defined = Map.keys _defines- used = [ Map.lookup (AltAttr field attr True) _lhsIaltAttrs | (field,attr) <- _rhsIusedAttrs]- ++ [ Map.lookup (AltAttr _LOC attr True) _lhsIaltAttrs | attr <- _rhsIusedLocals ++ _rhsIusedFields ]- in Seq.fromList [ (x,y) | Just x <- used, y <- defined ]- -- "Order.ag"(line 264, column 7)- _manualDeps =- Set.toList $ Map.findWithDefault Set.empty _lhsIcon $ Map.findWithDefault Map.empty _lhsInt _lhsImanualAttrDepMap- -- "Order.ag"(line 266, column 7)- _lhsOadditionalDep =- Seq.fromList [ (vertexA, vertexB)- | Dependency (fldA,nmA) (fldB,nmB) <- _manualDeps- , let vertexA = findWithErr2 (AltAttr fldA nmA True) _lhsIaltAttrs- , vertexB <- lookupVertices fldB nmB _lhsIaltAttrs- ]- -- "Order.ag"(line 292, column 7)- _lhsOinstDep =- Seq.fromList $- [ (instVert, synVert)- | (field,instNm,_) <- Map.elems _defines- , field == _INST- , synNm <- Map.keys (findWithErr2 instNm _lhsIsynsOfChildren)- , let instAttr = AltAttr _INST instNm True- synAttr = AltAttr instNm synNm True- instVert = findWithErr2 instAttr _lhsIaltAttrs- synVert = findWithErr2 synAttr _lhsIaltAttrs- ]- -- use rule "Order.ag"(line 60, column 70)- _lhsOerrors =- _patternIerrors Seq.<> _rhsIerrors- -- use rule "Order.ag"(line 146, column 68)- _lhsOgathAltAttrs =- _patternIgathAltAttrs- -- use rule "Order.ag"(line 182, column 23)- _lhsOgathRules =- _gathRules- -- use rule "Order.ag"(line 533, column 80)- _lhsOinstVars =- _patternIinstVars- -- use rule "Order.ag"(line 533, column 48)- _lhsOlocVars =- _patternIlocVars- -- copy rule (down)- _patternOallTypeSigs =- _lhsIallTypeSigs- -- copy rule (down)- _patternOaltAttrs =- _lhsIaltAttrs- -- copy rule (down)- _patternOcon =- _lhsIcon- -- copy rule (down)- _patternOinh =- _lhsIinh- -- copy rule (down)- _patternOnt =- _lhsInt- -- copy rule (down)- _patternOsyn =- _lhsIsyn- -- copy rule (down)- _rhsOallfields =- _lhsIallfields- -- copy rule (down)- _rhsOallnts =- _lhsIallnts- -- copy rule (down)- _rhsOattrs =- _lhsIattrs- -- copy rule (down)- _rhsOcon =- _lhsIcon- -- copy rule (down)- _rhsOnt =- _lhsInt- ( _patternIcopy,_patternIerrors,_patternIgathAltAttrs,_patternIinstVars,_patternIlocVars,_patternIpatternAttrs) =- (pattern_ _patternOallTypeSigs _patternOaltAttrs _patternOcon _patternOinh _patternOnt _patternOsyn )- ( _rhsIallRhsVars,_rhsIcopy,_rhsIerrors,_rhsItextLines,_rhsIusedAttrs,_rhsIusedFields,_rhsIusedLocals) =- (rhs_ _rhsOallfields _rhsOallnts _rhsOattrs _rhsOcon _rhsOnt )- in ( _lhsOadditionalDep,_lhsOdirectDep,_lhsOerrors,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinstDep,_lhsOinstVars,_lhsOlocVars))) )--- Rules --------------------------------------------------------{-- visit 0:- inherited attributes:- allTypeSigs : Map Name Type- allfields : [(Name,Type,Bool)]- allnts : [Name]- altAttrs : Map AltAttr Vertex- attrs : [(Name,Name)]- childInhs : Map Name Attributes- childNts : Map Name Nonterminal- con : Identifier- inh : Attributes- manualAttrDepMap : AttrOrderMap- nt : Identifier- o_case : Bool- o_cata : Bool- o_dovisit : Bool- o_newtypes : Bool- o_rename : Bool- o_sem : Bool- o_sig : Bool- o_wantvisit : Bool- prefix : String- syn : Attributes- synsOfChildren : Map Name Attributes- synthesized attributes:- additionalDep : Seq Edge- directDep : Seq Edge- errors : Seq Error- gathAltAttrs : [AltAttr]- gathRules : Seq CRule- instDep : Seq Edge- instVars : [Name]- locVars : [Name]- 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 ((Map Name Type) ->- ([(Name,Type,Bool)]) ->- ([Name]) ->- (Map AltAttr Vertex) ->- ([(Name,Name)]) ->- (Map Name Attributes) ->- (Map Name Nonterminal) ->- Identifier ->- Attributes ->- AttrOrderMap ->- Identifier ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- String ->- Attributes ->- (Map Name Attributes) ->- ( (Seq Edge),(Seq Edge),(Seq Error),([AltAttr]),(Seq CRule),(Seq Edge),([Name]),([Name])))-data Inh_Rules = Inh_Rules {allTypeSigs_Inh_Rules :: Map Name Type,allfields_Inh_Rules :: [(Name,Type,Bool)],allnts_Inh_Rules :: [Name],altAttrs_Inh_Rules :: Map AltAttr Vertex,attrs_Inh_Rules :: [(Name,Name)],childInhs_Inh_Rules :: Map Name Attributes,childNts_Inh_Rules :: Map Name Nonterminal,con_Inh_Rules :: Identifier,inh_Inh_Rules :: Attributes,manualAttrDepMap_Inh_Rules :: AttrOrderMap,nt_Inh_Rules :: Identifier,o_case_Inh_Rules :: Bool,o_cata_Inh_Rules :: Bool,o_dovisit_Inh_Rules :: Bool,o_newtypes_Inh_Rules :: Bool,o_rename_Inh_Rules :: Bool,o_sem_Inh_Rules :: Bool,o_sig_Inh_Rules :: Bool,o_wantvisit_Inh_Rules :: Bool,prefix_Inh_Rules :: String,syn_Inh_Rules :: Attributes,synsOfChildren_Inh_Rules :: Map Name Attributes}-data Syn_Rules = Syn_Rules {additionalDep_Syn_Rules :: Seq Edge,directDep_Syn_Rules :: Seq Edge,errors_Syn_Rules :: Seq Error,gathAltAttrs_Syn_Rules :: [AltAttr],gathRules_Syn_Rules :: Seq CRule,instDep_Syn_Rules :: Seq Edge,instVars_Syn_Rules :: [Name],locVars_Syn_Rules :: [Name]}-wrap_Rules (T_Rules sem ) (Inh_Rules _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIsynsOfChildren ) =- (let ( _lhsOadditionalDep,_lhsOdirectDep,_lhsOerrors,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinstDep,_lhsOinstVars,_lhsOlocVars) =- (sem _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIsynsOfChildren )- in (Syn_Rules _lhsOadditionalDep _lhsOdirectDep _lhsOerrors _lhsOgathAltAttrs _lhsOgathRules _lhsOinstDep _lhsOinstVars _lhsOlocVars ))-sem_Rules_Cons :: T_Rule ->- T_Rules ->- T_Rules-sem_Rules_Cons (T_Rule hd_ ) (T_Rules tl_ ) =- (T_Rules (\ _lhsIallTypeSigs- _lhsIallfields- _lhsIallnts- _lhsIaltAttrs- _lhsIattrs- _lhsIchildInhs- _lhsIchildNts- _lhsIcon- _lhsIinh- _lhsImanualAttrDepMap- _lhsInt- _lhsIo_case- _lhsIo_cata- _lhsIo_dovisit- _lhsIo_newtypes- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_wantvisit- _lhsIprefix- _lhsIsyn- _lhsIsynsOfChildren ->- (let _lhsOadditionalDep :: (Seq Edge)- _lhsOdirectDep :: (Seq Edge)- _lhsOerrors :: (Seq Error)- _lhsOgathAltAttrs :: ([AltAttr])- _lhsOgathRules :: (Seq CRule)- _lhsOinstDep :: (Seq Edge)- _lhsOinstVars :: ([Name])- _lhsOlocVars :: ([Name])- _hdOallTypeSigs :: (Map Name Type)- _hdOallfields :: ([(Name,Type,Bool)])- _hdOallnts :: ([Name])- _hdOaltAttrs :: (Map AltAttr Vertex)- _hdOattrs :: ([(Name,Name)])- _hdOchildInhs :: (Map Name Attributes)- _hdOchildNts :: (Map Name Nonterminal)- _hdOcon :: Identifier- _hdOinh :: Attributes- _hdOmanualAttrDepMap :: AttrOrderMap- _hdOnt :: Identifier- _hdOo_case :: Bool- _hdOo_cata :: Bool- _hdOo_dovisit :: Bool- _hdOo_newtypes :: Bool- _hdOo_rename :: Bool- _hdOo_sem :: Bool- _hdOo_sig :: Bool- _hdOo_wantvisit :: Bool- _hdOprefix :: String- _hdOsyn :: Attributes- _hdOsynsOfChildren :: (Map Name Attributes)- _tlOallTypeSigs :: (Map Name Type)- _tlOallfields :: ([(Name,Type,Bool)])- _tlOallnts :: ([Name])- _tlOaltAttrs :: (Map AltAttr Vertex)- _tlOattrs :: ([(Name,Name)])- _tlOchildInhs :: (Map Name Attributes)- _tlOchildNts :: (Map Name Nonterminal)- _tlOcon :: Identifier- _tlOinh :: Attributes- _tlOmanualAttrDepMap :: AttrOrderMap- _tlOnt :: Identifier- _tlOo_case :: Bool- _tlOo_cata :: Bool- _tlOo_dovisit :: Bool- _tlOo_newtypes :: Bool- _tlOo_rename :: Bool- _tlOo_sem :: Bool- _tlOo_sig :: Bool- _tlOo_wantvisit :: Bool- _tlOprefix :: String- _tlOsyn :: Attributes- _tlOsynsOfChildren :: (Map Name Attributes)- _hdIadditionalDep :: (Seq Edge)- _hdIdirectDep :: (Seq Edge)- _hdIerrors :: (Seq Error)- _hdIgathAltAttrs :: ([AltAttr])- _hdIgathRules :: (Seq CRule)- _hdIinstDep :: (Seq Edge)- _hdIinstVars :: ([Name])- _hdIlocVars :: ([Name])- _tlIadditionalDep :: (Seq Edge)- _tlIdirectDep :: (Seq Edge)- _tlIerrors :: (Seq Error)- _tlIgathAltAttrs :: ([AltAttr])- _tlIgathRules :: (Seq CRule)- _tlIinstDep :: (Seq Edge)- _tlIinstVars :: ([Name])- _tlIlocVars :: ([Name])- -- use rule "Order.ag"(line 258, column 71)- _lhsOadditionalDep =- _hdIadditionalDep Seq.<> _tlIadditionalDep- -- use rule "Order.ag"(line 244, column 33)- _lhsOdirectDep =- _hdIdirectDep Seq.<> _tlIdirectDep- -- use rule "Order.ag"(line 60, column 70)- _lhsOerrors =- _hdIerrors Seq.<> _tlIerrors- -- use rule "Order.ag"(line 146, column 68)- _lhsOgathAltAttrs =- _hdIgathAltAttrs ++ _tlIgathAltAttrs- -- use rule "Order.ag"(line 182, column 23)- _lhsOgathRules =- _hdIgathRules Seq.<> _tlIgathRules- -- use rule "Order.ag"(line 289, column 31)- _lhsOinstDep =- _hdIinstDep Seq.<> _tlIinstDep- -- use rule "Order.ag"(line 533, column 80)- _lhsOinstVars =- _hdIinstVars ++ _tlIinstVars- -- use rule "Order.ag"(line 533, column 48)- _lhsOlocVars =- _hdIlocVars ++ _tlIlocVars- -- copy rule (down)- _hdOallTypeSigs =- _lhsIallTypeSigs- -- copy rule (down)- _hdOallfields =- _lhsIallfields- -- copy rule (down)- _hdOallnts =- _lhsIallnts- -- copy rule (down)- _hdOaltAttrs =- _lhsIaltAttrs- -- copy rule (down)- _hdOattrs =- _lhsIattrs- -- copy rule (down)- _hdOchildInhs =- _lhsIchildInhs- -- copy rule (down)- _hdOchildNts =- _lhsIchildNts- -- copy rule (down)- _hdOcon =- _lhsIcon- -- copy rule (down)- _hdOinh =- _lhsIinh- -- copy rule (down)- _hdOmanualAttrDepMap =- _lhsImanualAttrDepMap- -- copy rule (down)- _hdOnt =- _lhsInt- -- copy rule (down)- _hdOo_case =- _lhsIo_case- -- copy rule (down)- _hdOo_cata =- _lhsIo_cata- -- copy rule (down)- _hdOo_dovisit =- _lhsIo_dovisit- -- copy rule (down)- _hdOo_newtypes =- _lhsIo_newtypes- -- copy rule (down)- _hdOo_rename =- _lhsIo_rename- -- copy rule (down)- _hdOo_sem =- _lhsIo_sem- -- copy rule (down)- _hdOo_sig =- _lhsIo_sig- -- copy rule (down)- _hdOo_wantvisit =- _lhsIo_wantvisit- -- copy rule (down)- _hdOprefix =- _lhsIprefix- -- copy rule (down)- _hdOsyn =- _lhsIsyn- -- copy rule (down)- _hdOsynsOfChildren =- _lhsIsynsOfChildren- -- copy rule (down)- _tlOallTypeSigs =- _lhsIallTypeSigs- -- copy rule (down)- _tlOallfields =- _lhsIallfields- -- copy rule (down)- _tlOallnts =- _lhsIallnts- -- copy rule (down)- _tlOaltAttrs =- _lhsIaltAttrs- -- copy rule (down)- _tlOattrs =- _lhsIattrs- -- copy rule (down)- _tlOchildInhs =- _lhsIchildInhs- -- copy rule (down)- _tlOchildNts =- _lhsIchildNts- -- copy rule (down)- _tlOcon =- _lhsIcon- -- copy rule (down)- _tlOinh =- _lhsIinh- -- copy rule (down)- _tlOmanualAttrDepMap =- _lhsImanualAttrDepMap- -- copy rule (down)- _tlOnt =- _lhsInt- -- copy rule (down)- _tlOo_case =- _lhsIo_case- -- copy rule (down)- _tlOo_cata =- _lhsIo_cata- -- copy rule (down)- _tlOo_dovisit =- _lhsIo_dovisit- -- copy rule (down)- _tlOo_newtypes =- _lhsIo_newtypes- -- copy rule (down)- _tlOo_rename =- _lhsIo_rename- -- copy rule (down)- _tlOo_sem =- _lhsIo_sem- -- copy rule (down)- _tlOo_sig =- _lhsIo_sig- -- copy rule (down)- _tlOo_wantvisit =- _lhsIo_wantvisit- -- copy rule (down)- _tlOprefix =- _lhsIprefix- -- copy rule (down)- _tlOsyn =- _lhsIsyn- -- copy rule (down)- _tlOsynsOfChildren =- _lhsIsynsOfChildren- ( _hdIadditionalDep,_hdIdirectDep,_hdIerrors,_hdIgathAltAttrs,_hdIgathRules,_hdIinstDep,_hdIinstVars,_hdIlocVars) =- (hd_ _hdOallTypeSigs _hdOallfields _hdOallnts _hdOaltAttrs _hdOattrs _hdOchildInhs _hdOchildNts _hdOcon _hdOinh _hdOmanualAttrDepMap _hdOnt _hdOo_case _hdOo_cata _hdOo_dovisit _hdOo_newtypes _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_wantvisit _hdOprefix _hdOsyn _hdOsynsOfChildren )- ( _tlIadditionalDep,_tlIdirectDep,_tlIerrors,_tlIgathAltAttrs,_tlIgathRules,_tlIinstDep,_tlIinstVars,_tlIlocVars) =- (tl_ _tlOallTypeSigs _tlOallfields _tlOallnts _tlOaltAttrs _tlOattrs _tlOchildInhs _tlOchildNts _tlOcon _tlOinh _tlOmanualAttrDepMap _tlOnt _tlOo_case _tlOo_cata _tlOo_dovisit _tlOo_newtypes _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_wantvisit _tlOprefix _tlOsyn _tlOsynsOfChildren )- in ( _lhsOadditionalDep,_lhsOdirectDep,_lhsOerrors,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinstDep,_lhsOinstVars,_lhsOlocVars))) )-sem_Rules_Nil :: T_Rules-sem_Rules_Nil =- (T_Rules (\ _lhsIallTypeSigs- _lhsIallfields- _lhsIallnts- _lhsIaltAttrs- _lhsIattrs- _lhsIchildInhs- _lhsIchildNts- _lhsIcon- _lhsIinh- _lhsImanualAttrDepMap- _lhsInt- _lhsIo_case- _lhsIo_cata- _lhsIo_dovisit- _lhsIo_newtypes- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_wantvisit- _lhsIprefix- _lhsIsyn- _lhsIsynsOfChildren ->- (let _lhsOadditionalDep :: (Seq Edge)- _lhsOdirectDep :: (Seq Edge)- _lhsOerrors :: (Seq Error)- _lhsOgathAltAttrs :: ([AltAttr])- _lhsOgathRules :: (Seq CRule)- _lhsOinstDep :: (Seq Edge)- _lhsOinstVars :: ([Name])- _lhsOlocVars :: ([Name])- -- use rule "Order.ag"(line 258, column 71)- _lhsOadditionalDep =- Seq.empty- -- use rule "Order.ag"(line 244, column 33)- _lhsOdirectDep =- Seq.empty- -- use rule "Order.ag"(line 60, column 70)- _lhsOerrors =- Seq.empty- -- use rule "Order.ag"(line 146, column 68)- _lhsOgathAltAttrs =- []- -- use rule "Order.ag"(line 182, column 23)- _lhsOgathRules =- Seq.empty- -- use rule "Order.ag"(line 289, column 31)- _lhsOinstDep =- Seq.empty- -- use rule "Order.ag"(line 533, column 80)- _lhsOinstVars =- []- -- use rule "Order.ag"(line 533, column 48)- _lhsOlocVars =- []- in ( _lhsOadditionalDep,_lhsOdirectDep,_lhsOerrors,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinstDep,_lhsOinstVars,_lhsOlocVars))) )--- TypeSig ------------------------------------------------------{-- visit 0:- chained attribute:- typeSigs : Map Name Type- alternatives:- alternative TypeSig:- child name : {Name}- 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 ((Map Name Type) ->- ( (Map Name Type)))-data Inh_TypeSig = Inh_TypeSig {typeSigs_Inh_TypeSig :: Map Name Type}-data Syn_TypeSig = Syn_TypeSig {typeSigs_Syn_TypeSig :: Map Name Type}-wrap_TypeSig (T_TypeSig sem ) (Inh_TypeSig _lhsItypeSigs ) =- (let ( _lhsOtypeSigs) =- (sem _lhsItypeSigs )- in (Syn_TypeSig _lhsOtypeSigs ))-sem_TypeSig_TypeSig :: Name ->- Type ->- T_TypeSig-sem_TypeSig_TypeSig name_ tp_ =- (T_TypeSig (\ _lhsItypeSigs ->- (let _lhsOtypeSigs :: (Map Name Type)- -- "Order.ag"(line 393, column 13)- _lhsOtypeSigs =- Map.insert name_ tp_ _lhsItypeSigs- in ( _lhsOtypeSigs))) )--- TypeSigs -----------------------------------------------------{-- visit 0:- chained attribute:- typeSigs : Map Name Type- 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 ((Map Name Type) ->- ( (Map Name Type)))-data Inh_TypeSigs = Inh_TypeSigs {typeSigs_Inh_TypeSigs :: Map Name Type}-data Syn_TypeSigs = Syn_TypeSigs {typeSigs_Syn_TypeSigs :: Map Name Type}-wrap_TypeSigs (T_TypeSigs sem ) (Inh_TypeSigs _lhsItypeSigs ) =- (let ( _lhsOtypeSigs) =- (sem _lhsItypeSigs )- in (Syn_TypeSigs _lhsOtypeSigs ))-sem_TypeSigs_Cons :: T_TypeSig ->- T_TypeSigs ->- T_TypeSigs-sem_TypeSigs_Cons (T_TypeSig hd_ ) (T_TypeSigs tl_ ) =- (T_TypeSigs (\ _lhsItypeSigs ->- (let _lhsOtypeSigs :: (Map Name Type)- _hdOtypeSigs :: (Map Name Type)- _tlOtypeSigs :: (Map Name Type)- _hdItypeSigs :: (Map Name Type)- _tlItypeSigs :: (Map Name Type)- -- copy rule (up)- _lhsOtypeSigs =- _tlItypeSigs- -- copy rule (down)- _hdOtypeSigs =- _lhsItypeSigs- -- copy rule (chain)- _tlOtypeSigs =- _hdItypeSigs- ( _hdItypeSigs) =- (hd_ _hdOtypeSigs )- ( _tlItypeSigs) =- (tl_ _tlOtypeSigs )- in ( _lhsOtypeSigs))) )-sem_TypeSigs_Nil :: T_TypeSigs-sem_TypeSigs_Nil =- (T_TypeSigs (\ _lhsItypeSigs ->- (let _lhsOtypeSigs :: (Map Name Type)- -- copy rule (chain)- _lhsOtypeSigs =- _lhsItypeSigs- in ( _lhsOtypeSigs))) )+-- UUAGC 0.9.5 (Order.ag)+module Order where++-- From uuagc+import CommonTypes+import Patterns+import ErrorMessages+import AbstractSyntax+import Code hiding (Type)+import qualified Code+import Expression+import Options+import SequentialComputation+import SequentialTypes+import CodeSyntax+import GrammarInfo+import HsToken(HsTokensRoot(HsTokensRoot))+import HsTokenScanner(lexTokens)+import SemHsTokens(sem_HsTokensRoot,wrap_HsTokensRoot, Syn_HsTokensRoot(..),Inh_HsTokensRoot(..))+-- From uulib+import qualified Data.Map as Map+import qualified Data.Set as Set+import qualified UU.DData.Seq as Seq+import Data.Map(Map) +import Data.Set(Set)+import UU.DData.Seq(Seq, (<>)) +import UU.Util.Utils+import UU.Scanner.Position(Pos(..),initPos)++-- From haskell libraries+import Control.Monad(liftM)+import qualified Data.Array as Array+import Data.Array((!),bounds,inRange)+import Data.List(elemIndex,partition,sort,mapAccumL,find,nubBy,intersperse,groupBy,transpose)+import qualified Data.Tree as Tree+import Maybe++-- Patterns.ag imports+import UU.Scanner.Position(Pos)+import CommonTypes (ConstructorIdent,Identifier)++import UU.Scanner.Position(Pos)+import HsToken++-- AbstractSyntax.ag imports+import Data.Set(Set)+import Data.Map(Map)+import Patterns (Pattern(..),Patterns)+import Expression (Expression(..))+import CommonTypes++-- Terminates with an error if the key is not in the map+findWithErr1 :: (Ord k, Show k) => String -> k -> Map k a -> a+findWithErr1 s k+ = Map.findWithDefault (error ("findWithErr1 " ++ s ++ ": key " ++ show k ++ " not in map.")) k++findWithErr2 :: (Ord k, Show k, Show a) => k -> Map k a -> a+findWithErr2 k m+ = Map.findWithDefault (error ("findWithErr2: key " ++ show k ++ " not in map: " ++ show m)) k m++getNtName :: Type -> NontermIdent+getNtName (NT nt _) = nt+getNtName _ = nullIdent++data AltAttr = AltAttr Identifier Identifier Bool + deriving (Eq, Ord, Show)++substSelf nt tp+ = case tp of+ NT n tps | n == _SELF -> NT nt tps+ _ -> tp+ +haskellTupel :: [Type] -> Maybe Type+haskellTupel ts = Just ( Haskell ( '(' : (concat (intersperse "," (map show ts))) ++ ")" ))++lookupVertices :: Identifier -> Identifier -> Map AltAttr Int -> [Int]+lookupVertices fld nm attrs+ = catMaybes ( [Map.lookup (AltAttr fld nm False) attrs] -- look for all "out" attributes+ ++ if fld == _LOC+ then [Map.lookup (AltAttr fld nm True) attrs]+ else []+ )++swap (a,b) = (b,a)++showPath :: Table CRule -> [Vertex] -> [String]+showPath ruleTable path+ = let look a | inRange (bounds ruleTable) a = [showOrigin (ruleTable ! a)]+ | otherwise = ["Vertex " ++ show a]+ showOrigin cr | getHasCode cr && getName (getAttr cr) /= "self" = prettyCRule cr ++ " (" ++ show (getPos (getAttr cr)) ++ ")"+ | otherwise = prettyCRule cr+ in concatMap look path+++showPathLocal :: Table CRule -> [Vertex] -> [String]+showPathLocal _ [] = []+showPathLocal ruleTable xs = showP (xs++[-1])+ where showP [] = []+ showP (v1:v2:vs) = let line = step v1 v2+ lines = showP vs+ in line:lines+ step v1 v2 = " - " ++ a1+ where r1 = ruleTable ! v1+ a1 = show (getAttr r1)+++limitTo :: Int -> [String] -> [String]+limitTo _ [] = [] +limitTo 0 _ = ["....etcetera, etcetera...."]+limitTo n (x:xs) = x : limitTo (n-1) xs++showPathNice :: Table CRule -> [Vertex] -> [String]+showPathNice _ [] = []+showPathNice ruleTable xs = limitTo 100 (showP ((-1):xs++[-1]))+ where [maxf, maxa, maxn, maxc] = maxWidths ruleTable (take 100 xs)+ showP [] = []+ showP (v1:v2:vs) = let line = step v1 v2+ lines = showP vs+ in if null line then lines else line:lines+ step v1 v2 | last && first = induced+ | last && isSyn r1 = "pass up " ++ alignR maxf "" ++ " " ++ alignL maxa a1 ++ " in " ++ alignR maxn n1 ++ "|" ++ c1 ++ induced+ | first&& not(isSyn r2) = "get from above " ++ alignR maxf "" ++ " " ++ alignL maxa a2 ++ " in " ++ alignR maxn n2 ++ "|" ++ c2+ | last = "pass down " ++ alignR maxf f1 ++ "." ++ a1 ++ induced+ | isSyn r2 = "get from below " ++ alignR maxf f2 ++ "." ++ alignL maxa a2 ++ " in " ++ alignR maxn n2 ++ "|" ++ c2+ | isLocal r1 = if head a1 == '_' + then ""+ else "calculate " ++ alignR maxf "loc" ++ "." ++ a1+ | otherwise = "pass down " ++ alignR maxf f1 ++ "." ++ alignL maxa a1 ++ " to " ++ alignR maxn n2 ++ "|" ++ c2+ where+ first = v1<0+ last = v2<0+ r1 = ruleTable ! v1+ r2 = ruleTable ! v2+ a1 = show (getAttr r1)+ a2 = show (getAttr r2)+ f1 = show (getField r1)+ f2 = show (getField r2)+ n1 = show (getLhsNt r1)+ n2 = show (getLhsNt r2)+ c1 = show (getCon r1)+ c2 = show (getCon r2)+ induced | v2== -2 = " INDUCED dependency to "+ | otherwise = ""+++maxWidths ruleTable vs+ = map maximum (transpose (map getWidth vs))+ where getWidth v | v<0 = [0,0,0,0]+ | otherwise = map (length . show . ($ (ruleTable!v))) [getField, getAttr, getLhsNt, getCon]++alignL n xs | k<n = xs ++ replicate (n-k) ' '+ | otherwise = xs+ where k = length xs++alignR n xs | k<n = replicate (n-k) ' ' ++ xs+ | otherwise = xs+ where k = length xs++localCycleErr :: Table CRule -> Bool -> Route -> Error+localCycleErr ruleTable o_visit (s:path)+ = let cr = ruleTable ! s+ attr = getAttr cr+ nt = getLhsNt cr+ con = getCon cr+ in LocalCirc nt con attr o_visit (showPathLocal ruleTable path)++instCycleErr :: Table CRule -> Bool -> Route -> Error+instCycleErr ruleTable o_visit (s:path)+ = let cr = ruleTable ! s+ attr = getAttr cr+ nt = getLhsNt cr+ con = getCon cr+ in InstCirc nt con attr o_visit (showPathLocal ruleTable path)++directCycleErrs :: Table NTAttr -> Table CRule -> Bool -> [EdgeRoutes] -> [Error]+directCycleErrs attrTable ruleTable o_visit xs+ = let getNont v = case attrTable ! v of+ NTASyn nt _ _ -> nt+ NTAInh nt _ _ -> nt+ getAttr v = case attrTable ! v of+ NTASyn _ a _ -> a+ NTAInh _ a _ -> a+ sameNont ((v1,_),_,_) ((v2,_),_,_) = getNont v1 == getNont v2+ procCycle ((v1,v2),p1,p2) = ((getAttr v1, getAttr v2), showPathNice ruleTable p1, showPathNice ruleTable p2)+ wrapGroup gr@(((v1,_),_,_):_) = DirectCirc (getNont v1) o_visit (map procCycle gr)+ in map wrapGroup (groupBy sameNont xs)++inducedCycleErrs :: Table NTAttr -> Table CRule -> CInterfaceMap -> [EdgeRoutes] -> [Error]+inducedCycleErrs attrTable ruleTable cim xs+ = let getNont v = case attrTable ! v of+ NTASyn nt _ _ -> nt+ NTAInh nt _ _ -> nt+ getAttr v = case attrTable ! v of+ NTASyn _ a _ -> a+ NTAInh _ a _ -> a+ sameNont ((v1,_),_,_) ((v2,_),_,_) = getNont v1 == getNont v2+ procCycle ((v1,v2),p1,p2) = ((getAttr v1, getAttr v2), showPathNice ruleTable p1, showPathNice ruleTable p2)+ wrapGroup gr@(((v1,_),_,_):_) = InducedCirc (getNont v1) (findWithErr1 "inducedCycleErr.cinter" (getNont v1) cim) (map procCycle gr)+ in map wrapGroup (groupBy sameNont xs)+-- Child -------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allfields : [(Identifier,Type,Bool)]+ allnts : [Identifier]+ attrs : [(Identifier,Identifier)]+ con : Identifier+ inh : Attributes+ nt : Identifier+ o_unbox : Bool+ syn : Attributes+ synthesized attributes:+ attributes : [(Identifier,Attributes,Attributes)]+ collectChildrenSyns : Map Identifier Attributes + errors : Seq Error+ field : (Identifier,Type,Bool)+ gathAltAttrs : [AltAttr]+ gathRules : Seq CRule+ inhs : Seq (Identifier,Attributes)+ nts : Seq (Identifier,NontermIdent)+ singlevisits : [CRule]+ terminals : [Identifier]+ alternatives:+ alternative Child:+ child name : {Identifier}+ child tp : {Type}+ child inh : {Attributes}+ child syn : {Attributes}+ child higherOrder : {Bool}+ visit 0:+ local maptolocal : _+ local gathRules : _+-}+-- cata+sem_Child :: Child ->+ T_Child+sem_Child (Child _name _tp _inh _syn _higherOrder) =+ (sem_Child_Child _name _tp _inh _syn _higherOrder)+-- semantic domain+newtype T_Child = T_Child (([(Identifier,Type,Bool)]) ->+ ([Identifier]) ->+ ([(Identifier,Identifier)]) ->+ Identifier ->+ Attributes ->+ Identifier ->+ Bool ->+ Attributes ->+ ( ([(Identifier,Attributes,Attributes)]),(Map Identifier Attributes ),(Seq Error),((Identifier,Type,Bool)),([AltAttr]),(Seq CRule),(Seq (Identifier,Attributes)),(Seq (Identifier,NontermIdent)),([CRule]),([Identifier])))+data Inh_Child = Inh_Child {allfields_Inh_Child :: [(Identifier,Type,Bool)],allnts_Inh_Child :: [Identifier],attrs_Inh_Child :: [(Identifier,Identifier)],con_Inh_Child :: Identifier,inh_Inh_Child :: Attributes,nt_Inh_Child :: Identifier,o_unbox_Inh_Child :: Bool,syn_Inh_Child :: Attributes}+data Syn_Child = Syn_Child {attributes_Syn_Child :: [(Identifier,Attributes,Attributes)],collectChildrenSyns_Syn_Child :: Map Identifier Attributes ,errors_Syn_Child :: Seq Error,field_Syn_Child :: (Identifier,Type,Bool),gathAltAttrs_Syn_Child :: [AltAttr],gathRules_Syn_Child :: Seq CRule,inhs_Syn_Child :: Seq (Identifier,Attributes),nts_Syn_Child :: Seq (Identifier,NontermIdent),singlevisits_Syn_Child :: [CRule],terminals_Syn_Child :: [Identifier]}+wrap_Child (T_Child sem) (Inh_Child _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsInt _lhsIo_unbox _lhsIsyn) =+ (let ( _lhsOattributes,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfield,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals) =+ (sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsInt _lhsIo_unbox _lhsIsyn)+ in (Syn_Child _lhsOattributes _lhsOcollectChildrenSyns _lhsOerrors _lhsOfield _lhsOgathAltAttrs _lhsOgathRules _lhsOinhs _lhsOnts _lhsOsinglevisits _lhsOterminals))+sem_Child_Child :: Identifier ->+ Type ->+ Attributes ->+ Attributes ->+ Bool ->+ T_Child+sem_Child_Child name_ tp_ inh_ syn_ higherOrder_ =+ (T_Child (\ _lhsIallfields+ _lhsIallnts+ _lhsIattrs+ _lhsIcon+ _lhsIinh+ _lhsInt+ _lhsIo_unbox+ _lhsIsyn ->+ (let _lhsOgathAltAttrs :: ([AltAttr])+ _lhsOnts :: (Seq (Identifier,NontermIdent))+ _lhsOinhs :: (Seq (Identifier,Attributes))+ _lhsOcollectChildrenSyns :: (Map Identifier Attributes )+ _lhsOsinglevisits :: ([CRule])+ _lhsOterminals :: ([Identifier])+ _lhsOattributes :: ([(Identifier,Attributes,Attributes)])+ _lhsOfield :: ((Identifier,Type,Bool))+ _lhsOerrors :: (Seq Error)+ _lhsOgathRules :: (Seq CRule)+ -- "Order.ag"(line 153, column 13)+ _maptolocal =+ case tp_ of+ NT nt _ -> Map.null syn_+ _ -> True+ -- "Order.ag"(line 156, column 13)+ _lhsOgathAltAttrs =+ if _maptolocal+ then [ AltAttr _LOC name_ True ]+ else [ AltAttr name_ syn True | syn <- Map.keys syn_ ]+ -- "Order.ag"(line 171, column 13)+ _lhsOnts =+ Seq.single (name_,getNtName tp_)+ -- "Order.ag"(line 172, column 13)+ _lhsOinhs =+ Seq.single (name_,inh_)+ -- "Order.ag"(line 188, column 13)+ _gathRules =+ if _maptolocal+ then Seq.single (cRuleTerminal name_ _lhsInt _lhsIcon tp_)+ else Seq.fromList [ cRuleRhsSyn syn _lhsInt _lhsIcon tp name_ (getNtName tp_) | (syn,tp) <- Map.assocs syn_]+ -- "Order.ag"(line 313, column 12)+ _lhsOcollectChildrenSyns =+ Map.singleton name_ syn_+ -- "Order.ag"(line 473, column 11)+ _lhsOsinglevisits =+ if _maptolocal+ then []+ else [CChildVisit name_ (getNtName tp_) 0 inh_ syn_ True]+ -- "Order.ag"(line 494, column 11)+ _lhsOterminals =+ if _maptolocal+ then [name_]+ else []+ -- "Order.ag"(line 523, column 11)+ _lhsOattributes =+ [(name_, inh_, syn_)]+ -- "Order.ag"(line 527, column 11)+ _lhsOfield =+ (name_, tp_, higherOrder_)+ -- use rule "Order.ag"(line 60, column 70)+ _lhsOerrors =+ Seq.empty+ -- use rule "Order.ag"(line 182, column 23)+ _lhsOgathRules =+ _gathRules+ in ( _lhsOattributes,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfield,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals))))+-- Children ----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allfields : [(Identifier,Type,Bool)]+ allnts : [Identifier]+ attrs : [(Identifier,Identifier)]+ con : Identifier+ inh : Attributes+ nt : Identifier+ o_unbox : Bool+ syn : Attributes+ synthesized attributes:+ attributes : [(Identifier,Attributes,Attributes)]+ collectChildrenSyns : Map Identifier Attributes + errors : Seq Error+ fields : [(Identifier,Type,Bool)]+ gathAltAttrs : [AltAttr]+ gathRules : Seq CRule+ inhs : Seq (Identifier,Attributes)+ nts : Seq (Identifier,NontermIdent)+ singlevisits : [CRule]+ terminals : [Identifier]+ 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 (([(Identifier,Type,Bool)]) ->+ ([Identifier]) ->+ ([(Identifier,Identifier)]) ->+ Identifier ->+ Attributes ->+ Identifier ->+ Bool ->+ Attributes ->+ ( ([(Identifier,Attributes,Attributes)]),(Map Identifier Attributes ),(Seq Error),([(Identifier,Type,Bool)]),([AltAttr]),(Seq CRule),(Seq (Identifier,Attributes)),(Seq (Identifier,NontermIdent)),([CRule]),([Identifier])))+data Inh_Children = Inh_Children {allfields_Inh_Children :: [(Identifier,Type,Bool)],allnts_Inh_Children :: [Identifier],attrs_Inh_Children :: [(Identifier,Identifier)],con_Inh_Children :: Identifier,inh_Inh_Children :: Attributes,nt_Inh_Children :: Identifier,o_unbox_Inh_Children :: Bool,syn_Inh_Children :: Attributes}+data Syn_Children = Syn_Children {attributes_Syn_Children :: [(Identifier,Attributes,Attributes)],collectChildrenSyns_Syn_Children :: Map Identifier Attributes ,errors_Syn_Children :: Seq Error,fields_Syn_Children :: [(Identifier,Type,Bool)],gathAltAttrs_Syn_Children :: [AltAttr],gathRules_Syn_Children :: Seq CRule,inhs_Syn_Children :: Seq (Identifier,Attributes),nts_Syn_Children :: Seq (Identifier,NontermIdent),singlevisits_Syn_Children :: [CRule],terminals_Syn_Children :: [Identifier]}+wrap_Children (T_Children sem) (Inh_Children _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsInt _lhsIo_unbox _lhsIsyn) =+ (let ( _lhsOattributes,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfields,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals) =+ (sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsInt _lhsIo_unbox _lhsIsyn)+ in (Syn_Children _lhsOattributes _lhsOcollectChildrenSyns _lhsOerrors _lhsOfields _lhsOgathAltAttrs _lhsOgathRules _lhsOinhs _lhsOnts _lhsOsinglevisits _lhsOterminals))+sem_Children_Cons :: T_Child ->+ T_Children ->+ T_Children+sem_Children_Cons (T_Child hd_) (T_Children tl_) =+ (T_Children (\ _lhsIallfields+ _lhsIallnts+ _lhsIattrs+ _lhsIcon+ _lhsIinh+ _lhsInt+ _lhsIo_unbox+ _lhsIsyn ->+ (let _lhsOfields :: ([(Identifier,Type,Bool)])+ _lhsOattributes :: ([(Identifier,Attributes,Attributes)])+ _lhsOcollectChildrenSyns :: (Map Identifier Attributes )+ _lhsOerrors :: (Seq Error)+ _lhsOgathAltAttrs :: ([AltAttr])+ _lhsOgathRules :: (Seq CRule)+ _lhsOinhs :: (Seq (Identifier,Attributes))+ _lhsOnts :: (Seq (Identifier,NontermIdent))+ _lhsOsinglevisits :: ([CRule])+ _lhsOterminals :: ([Identifier])+ _hdOallfields :: ([(Identifier,Type,Bool)])+ _hdOallnts :: ([Identifier])+ _hdOattrs :: ([(Identifier,Identifier)])+ _hdOcon :: Identifier+ _hdOinh :: Attributes+ _hdOnt :: Identifier+ _hdOo_unbox :: Bool+ _hdOsyn :: Attributes+ _tlOallfields :: ([(Identifier,Type,Bool)])+ _tlOallnts :: ([Identifier])+ _tlOattrs :: ([(Identifier,Identifier)])+ _tlOcon :: Identifier+ _tlOinh :: Attributes+ _tlOnt :: Identifier+ _tlOo_unbox :: Bool+ _tlOsyn :: Attributes+ _hdIattributes :: ([(Identifier,Attributes,Attributes)])+ _hdIcollectChildrenSyns :: (Map Identifier Attributes )+ _hdIerrors :: (Seq Error)+ _hdIfield :: ((Identifier,Type,Bool))+ _hdIgathAltAttrs :: ([AltAttr])+ _hdIgathRules :: (Seq CRule)+ _hdIinhs :: (Seq (Identifier,Attributes))+ _hdInts :: (Seq (Identifier,NontermIdent))+ _hdIsinglevisits :: ([CRule])+ _hdIterminals :: ([Identifier])+ _tlIattributes :: ([(Identifier,Attributes,Attributes)])+ _tlIcollectChildrenSyns :: (Map Identifier Attributes )+ _tlIerrors :: (Seq Error)+ _tlIfields :: ([(Identifier,Type,Bool)])+ _tlIgathAltAttrs :: ([AltAttr])+ _tlIgathRules :: (Seq CRule)+ _tlIinhs :: (Seq (Identifier,Attributes))+ _tlInts :: (Seq (Identifier,NontermIdent))+ _tlIsinglevisits :: ([CRule])+ _tlIterminals :: ([Identifier])+ -- "Order.ag"(line 530, column 11)+ _lhsOfields =+ _hdIfield : _tlIfields+ -- use rule "Order.ag"(line 521, column 32)+ _lhsOattributes =+ _hdIattributes ++ _tlIattributes+ -- use rule "Order.ag"(line 311, column 47)+ _lhsOcollectChildrenSyns =+ _hdIcollectChildrenSyns `Map.union` _tlIcollectChildrenSyns+ -- use rule "Order.ag"(line 60, column 70)+ _lhsOerrors =+ _hdIerrors Seq.<> _tlIerrors+ -- use rule "Order.ag"(line 146, column 68)+ _lhsOgathAltAttrs =+ _hdIgathAltAttrs ++ _tlIgathAltAttrs+ -- use rule "Order.ag"(line 182, column 23)+ _lhsOgathRules =+ _hdIgathRules Seq.<> _tlIgathRules+ -- use rule "Order.ag"(line 169, column 20)+ _lhsOinhs =+ _hdIinhs Seq.<> _tlIinhs+ -- use rule "Order.ag"(line 168, column 19)+ _lhsOnts =+ _hdInts Seq.<> _tlInts+ -- use rule "Order.ag"(line 471, column 40)+ _lhsOsinglevisits =+ _hdIsinglevisits ++ _tlIsinglevisits+ -- use rule "Order.ag"(line 492, column 38)+ _lhsOterminals =+ _hdIterminals ++ _tlIterminals+ -- copy rule (down)+ _hdOallfields =+ _lhsIallfields+ -- copy rule (down)+ _hdOallnts =+ _lhsIallnts+ -- copy rule (down)+ _hdOattrs =+ _lhsIattrs+ -- copy rule (down)+ _hdOcon =+ _lhsIcon+ -- copy rule (down)+ _hdOinh =+ _lhsIinh+ -- copy rule (down)+ _hdOnt =+ _lhsInt+ -- copy rule (down)+ _hdOo_unbox =+ _lhsIo_unbox+ -- copy rule (down)+ _hdOsyn =+ _lhsIsyn+ -- copy rule (down)+ _tlOallfields =+ _lhsIallfields+ -- copy rule (down)+ _tlOallnts =+ _lhsIallnts+ -- copy rule (down)+ _tlOattrs =+ _lhsIattrs+ -- copy rule (down)+ _tlOcon =+ _lhsIcon+ -- copy rule (down)+ _tlOinh =+ _lhsIinh+ -- copy rule (down)+ _tlOnt =+ _lhsInt+ -- copy rule (down)+ _tlOo_unbox =+ _lhsIo_unbox+ -- copy rule (down)+ _tlOsyn =+ _lhsIsyn+ ( _hdIattributes,_hdIcollectChildrenSyns,_hdIerrors,_hdIfield,_hdIgathAltAttrs,_hdIgathRules,_hdIinhs,_hdInts,_hdIsinglevisits,_hdIterminals) =+ (hd_ _hdOallfields _hdOallnts _hdOattrs _hdOcon _hdOinh _hdOnt _hdOo_unbox _hdOsyn)+ ( _tlIattributes,_tlIcollectChildrenSyns,_tlIerrors,_tlIfields,_tlIgathAltAttrs,_tlIgathRules,_tlIinhs,_tlInts,_tlIsinglevisits,_tlIterminals) =+ (tl_ _tlOallfields _tlOallnts _tlOattrs _tlOcon _tlOinh _tlOnt _tlOo_unbox _tlOsyn)+ in ( _lhsOattributes,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfields,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals))))+sem_Children_Nil :: T_Children+sem_Children_Nil =+ (T_Children (\ _lhsIallfields+ _lhsIallnts+ _lhsIattrs+ _lhsIcon+ _lhsIinh+ _lhsInt+ _lhsIo_unbox+ _lhsIsyn ->+ (let _lhsOfields :: ([(Identifier,Type,Bool)])+ _lhsOattributes :: ([(Identifier,Attributes,Attributes)])+ _lhsOcollectChildrenSyns :: (Map Identifier Attributes )+ _lhsOerrors :: (Seq Error)+ _lhsOgathAltAttrs :: ([AltAttr])+ _lhsOgathRules :: (Seq CRule)+ _lhsOinhs :: (Seq (Identifier,Attributes))+ _lhsOnts :: (Seq (Identifier,NontermIdent))+ _lhsOsinglevisits :: ([CRule])+ _lhsOterminals :: ([Identifier])+ -- "Order.ag"(line 531, column 11)+ _lhsOfields =+ []+ -- use rule "Order.ag"(line 521, column 32)+ _lhsOattributes =+ []+ -- use rule "Order.ag"(line 311, column 47)+ _lhsOcollectChildrenSyns =+ Map.empty+ -- use rule "Order.ag"(line 60, column 70)+ _lhsOerrors =+ Seq.empty+ -- use rule "Order.ag"(line 146, column 68)+ _lhsOgathAltAttrs =+ []+ -- use rule "Order.ag"(line 182, column 23)+ _lhsOgathRules =+ Seq.empty+ -- use rule "Order.ag"(line 169, column 20)+ _lhsOinhs =+ Seq.empty+ -- use rule "Order.ag"(line 168, column 19)+ _lhsOnts =+ Seq.empty+ -- use rule "Order.ag"(line 471, column 40)+ _lhsOsinglevisits =+ []+ -- use rule "Order.ag"(line 492, column 38)+ _lhsOterminals =+ []+ in ( _lhsOattributes,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfields,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals))))+-- Expression --------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allfields : [(Identifier,Type,Bool)]+ allnts : [Identifier]+ attrs : [(Identifier,Identifier)]+ con : Identifier+ nt : Identifier+ synthesized attributes:+ allRhsVars : Set (Identifier,Identifier)+ copy : SELF+ errors : Seq Error+ textLines : [String]+ usedAttrs : [(Identifier,Identifier)]+ usedFields : [Identifier]+ usedLocals : [Identifier]+ alternatives:+ alternative Expression:+ child pos : {Pos}+ child tks : {[HsToken]}+ visit 0:+ local _tup1 : _+ local errors : _+ local textLines : _+ local usedAttrs : _+ local usedLocals : _+ local usedFields : _+ local copy : _+-}+-- cata+sem_Expression :: Expression ->+ T_Expression+sem_Expression (Expression _pos _tks) =+ (sem_Expression_Expression _pos _tks)+-- semantic domain+newtype T_Expression = T_Expression (([(Identifier,Type,Bool)]) ->+ ([Identifier]) ->+ ([(Identifier,Identifier)]) ->+ Identifier ->+ Identifier ->+ ( (Set (Identifier,Identifier)),Expression,(Seq Error),([String]),([(Identifier,Identifier)]),([Identifier]),([Identifier])))+data Inh_Expression = Inh_Expression {allfields_Inh_Expression :: [(Identifier,Type,Bool)],allnts_Inh_Expression :: [Identifier],attrs_Inh_Expression :: [(Identifier,Identifier)],con_Inh_Expression :: Identifier,nt_Inh_Expression :: Identifier}+data Syn_Expression = Syn_Expression {allRhsVars_Syn_Expression :: Set (Identifier,Identifier),copy_Syn_Expression :: Expression,errors_Syn_Expression :: Seq Error,textLines_Syn_Expression :: [String],usedAttrs_Syn_Expression :: [(Identifier,Identifier)],usedFields_Syn_Expression :: [Identifier],usedLocals_Syn_Expression :: [Identifier]}+wrap_Expression (T_Expression sem) (Inh_Expression _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsInt) =+ (let ( _lhsOallRhsVars,_lhsOcopy,_lhsOerrors,_lhsOtextLines,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals) =+ (sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsInt)+ in (Syn_Expression _lhsOallRhsVars _lhsOcopy _lhsOerrors _lhsOtextLines _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals))+sem_Expression_Expression :: Pos ->+ ([HsToken]) ->+ T_Expression+sem_Expression_Expression pos_ tks_ =+ (T_Expression (\ _lhsIallfields+ _lhsIallnts+ _lhsIattrs+ _lhsIcon+ _lhsInt ->+ (let _lhsOallRhsVars :: (Set (Identifier,Identifier))+ _lhsOcopy :: Expression+ _lhsOerrors :: (Seq Error)+ _lhsOtextLines :: ([String])+ _lhsOusedAttrs :: ([(Identifier,Identifier)])+ _lhsOusedFields :: ([Identifier])+ _lhsOusedLocals :: ([Identifier])+ -- "Order.ag"(line 333, column 21)+ __tup1 =+ let inherited = Inh_HsTokensRoot+ { attrs_Inh_HsTokensRoot = _lhsIattrs+ , con_Inh_HsTokensRoot = _lhsIcon+ , allfields_Inh_HsTokensRoot = _lhsIallfields+ , allnts_Inh_HsTokensRoot = _lhsIallnts+ , nt_Inh_HsTokensRoot = _lhsInt+ }+ synthesized = wrap_HsTokensRoot (sem_HsTokensRoot (HsTokensRoot tks_)) inherited+ in case synthesized of+ Syn_HsTokensRoot+ { errors_Syn_HsTokensRoot = errors+ , textLines_Syn_HsTokensRoot = textLines+ , usedAttrs_Syn_HsTokensRoot = usedAttrs+ , usedLocals_Syn_HsTokensRoot = usedLocals+ , usedFields_Syn_HsTokensRoot = usedFields+ } -> (errors,textLines,usedAttrs,usedLocals,usedFields)+ -- "Order.ag"(line 333, column 21)+ (_errors,_,_,_,_) =+ __tup1+ -- "Order.ag"(line 333, column 21)+ (_,_textLines,_,_,_) =+ __tup1+ -- "Order.ag"(line 333, column 21)+ (_,_,_usedAttrs,_,_) =+ __tup1+ -- "Order.ag"(line 333, column 21)+ (_,_,_,_usedLocals,_) =+ __tup1+ -- "Order.ag"(line 333, column 21)+ (_,_,_,_,_usedFields) =+ __tup1+ -- "Order.ag"(line 351, column 17)+ _lhsOallRhsVars =+ Set.fromList _usedAttrs+ `Set.union`+ Set.fromList [ (_LOC, l) | l <- _usedLocals ]+ `Set.union`+ Set.fromList [ (_FIELD, fld) | fld <- _usedFields ]+ -- self rule+ _copy =+ Expression pos_ tks_+ -- self rule+ _lhsOcopy =+ _copy+ -- copy rule (from local)+ _lhsOerrors =+ _errors+ -- copy rule (from local)+ _lhsOtextLines =+ _textLines+ -- copy rule (from local)+ _lhsOusedAttrs =+ _usedAttrs+ -- copy rule (from local)+ _lhsOusedFields =+ _usedFields+ -- copy rule (from local)+ _lhsOusedLocals =+ _usedLocals+ in ( _lhsOallRhsVars,_lhsOcopy,_lhsOerrors,_lhsOtextLines,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))))+-- Grammar -----------------------------------------------------+{-+ visit 0:+ inherited attribute:+ options : Options+ synthesized attributes:+ errors : Seq Error+ output : CGrammar+ 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}+ visit 0:+ local ruleTable : _+ local attrTable : _+ local attrVertex : _+ local tdpToTds : _+ local tdsToTdp : _+ local directDep : _+ local instDep : _+ local info : _+ local _tup2 : _+ local cInterfaceMap : _+ local cVisitsMap : _+ local cyclesErrors : _+-}+-- cata+sem_Grammar :: Grammar ->+ T_Grammar+sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap) =+ (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts) _pragmas _manualAttrOrderMap _paramMap _contextMap)+-- semantic domain+newtype T_Grammar = T_Grammar (Options ->+ ( (Seq Error),CGrammar))+data Inh_Grammar = Inh_Grammar {options_Inh_Grammar :: Options}+data Syn_Grammar = Syn_Grammar {errors_Syn_Grammar :: Seq Error,output_Syn_Grammar :: CGrammar}+wrap_Grammar (T_Grammar sem) (Inh_Grammar _lhsIoptions) =+ (let ( _lhsOerrors,_lhsOoutput) =+ (sem _lhsIoptions)+ in (Syn_Grammar _lhsOerrors _lhsOoutput))+sem_Grammar_Grammar :: TypeSyns ->+ UseMap ->+ Derivings ->+ (Set NontermIdent) ->+ T_Nonterminals ->+ PragmaMap ->+ AttrOrderMap ->+ ParamMap ->+ ContextMap ->+ T_Grammar+sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ =+ (T_Grammar (\ _lhsIoptions ->+ (let _nontsOo_cata :: Bool+ _nontsOo_data :: Bool+ _nontsOo_sig :: Bool+ _nontsOo_sem :: Bool+ _nontsOo_rename :: Bool+ _nontsOo_newtypes :: Bool+ _nontsOo_wantvisit :: Bool+ _nontsOo_dovisit :: Bool+ _nontsOo_unbox :: Bool+ _nontsOo_case :: Bool+ _nontsOprefix :: String+ _nontsOvcount :: Int+ _nontsOmanualAttrDepMap :: AttrOrderMap+ _nontsOacount :: Int+ _lhsOerrors :: (Seq Error)+ _lhsOoutput :: CGrammar+ _nontsOallnts :: ([Identifier])+ _nontsOcInterfaceMap :: CInterfaceMap+ _nontsOcVisitsMap :: CVisitsMap+ _nontsIacount :: Int+ _nontsIadditionalDep :: (Seq Edge)+ _nontsIaranges :: (Seq (Int,Int,Int))+ _nontsIcNonterminals :: CNonterminals+ _nontsIdirectDep :: (Seq Edge)+ _nontsIerrors :: (Seq Error)+ _nontsIinstDep :: (Seq Edge)+ _nontsInonts :: ([(NontermIdent,[ConstructorIdent])])+ _nontsIntattrs :: (Seq (Vertex,NTAttr))+ _nontsIrules :: (Seq (Vertex,CRule))+ _nontsIvcount :: Int+ -- "Order.ag"(line 99, column 17)+ _nontsOo_cata =+ folds _lhsIoptions+ -- "Order.ag"(line 99, column 17)+ _nontsOo_data =+ dataTypes _lhsIoptions+ -- "Order.ag"(line 99, column 17)+ _nontsOo_sig =+ typeSigs _lhsIoptions+ -- "Order.ag"(line 99, column 17)+ _nontsOo_sem =+ semfuns _lhsIoptions+ -- "Order.ag"(line 99, column 17)+ _nontsOo_rename =+ rename _lhsIoptions+ -- "Order.ag"(line 99, column 17)+ _nontsOo_newtypes =+ newtypes _lhsIoptions+ -- "Order.ag"(line 99, column 17)+ _nontsOo_wantvisit =+ visit _lhsIoptions+ -- "Order.ag"(line 99, column 17)+ _nontsOo_dovisit =+ visit _lhsIoptions && null _cyclesErrors+ -- "Order.ag"(line 99, column 17)+ _nontsOo_unbox =+ unbox _lhsIoptions+ -- "Order.ag"(line 99, column 17)+ _nontsOo_case =+ cases _lhsIoptions+ -- "Order.ag"(line 99, column 17)+ _nontsOprefix =+ prefix _lhsIoptions+ -- "Order.ag"(line 237, column 15)+ _nontsOvcount =+ 0+ -- "Order.ag"(line 262, column 7)+ _nontsOmanualAttrDepMap =+ manualAttrOrderMap_+ -- "Order.ag"(line 365, column 13)+ _nontsOacount =+ 0+ -- "Order.ag"(line 403, column 13)+ _ruleTable =+ Array.array (0,_nontsIvcount-1) (Seq.toList _nontsIrules)+ -- "Order.ag"(line 404, column 13)+ _attrTable =+ Array.array (0,_nontsIacount-1) (Seq.toList _nontsIntattrs)+ -- "Order.ag"(line 405, column 13)+ _attrVertex =+ Map.fromList (map swap (Seq.toList _nontsIntattrs))+ -- "Order.ag"(line 406, column 13)+ _tdpToTds =+ [ (s, maybe (-1) (\v -> findWithErr1 "Grammar.tdpToTds" v _attrVertex) (ntattr cr))+ | (s,cr) <- Seq.toList _nontsIrules]+ -- "Order.ag"(line 408, column 13)+ _tdsToTdp =+ let eq (_,v) (_,v') = v == v'+ conv ((s,v):svs) | v == -1 = Nothing+ | otherwise = Just (v,s:map fst svs)+ in mapMaybe conv (eqClasses eq _tdpToTds)+ -- "Order.ag"(line 412, column 13)+ _directDep =+ Seq.toList (_nontsIdirectDep Seq.<> _nontsIadditionalDep)+ -- "Order.ag"(line 413, column 13)+ _instDep =+ Seq.toList _nontsIinstDep+ -- "Order.ag"(line 414, column 13)+ _info =+ let def [] = -1+ def (v:vs) = v+ in Info { tdsToTdp = Array.array (0,_nontsIacount-1) _tdsToTdp+ , tdpToTds = Array.array (0,_nontsIvcount-1) _tdpToTds+ , attrTable = _attrTable+ , ruleTable = _ruleTable+ , lmh = Seq.toList _nontsIaranges+ , nonts = _nontsInonts+ , wraps = wrappers_+ }+ -- "Order.ag"(line 425, column 17)+ __tup2 =+ case computeSequential _info _directDep _instDep of+ CycleFree cim cvm -> ( cim+ , cvm+ , []+ )+ LocalCycle errs -> ( error "No interfaces for AG with local cycles"+ , error "No visit sub-sequences for AG with local cycles"+ , map (localCycleErr _ruleTable (visit _lhsIoptions)) errs+ )+ InstCycle errs -> ( error "No interfaces for AG with cycles through insts"+ , error "No visit sub-sequences for AG with cycles through insts"+ , map (instCycleErr _ruleTable (visit _lhsIoptions)) errs+ )+ DirectCycle errs -> ( error "No interfaces for AG with direct cycles"+ , error "No visit sub-sequences for AG with direct cycles"+ , directCycleErrs _attrTable _ruleTable (visit _lhsIoptions) errs+ )+ InducedCycle cim errs -> ( cim+ , error "No visit sub-sequences for AG with induced cycles"+ , inducedCycleErrs _attrTable _ruleTable cim errs+ )+ -- "Order.ag"(line 425, column 17)+ (_cInterfaceMap,_,_) =+ __tup2+ -- "Order.ag"(line 425, column 17)+ (_,_cVisitsMap,_) =+ __tup2+ -- "Order.ag"(line 425, column 17)+ (_,_,_cyclesErrors) =+ __tup2+ -- "Order.ag"(line 447, column 13)+ _lhsOerrors =+ (if withCycle _lhsIoptions then Seq.fromList _cyclesErrors else Seq.empty)+ Seq.<> _nontsIerrors+ -- "Order.ag"(line 479, column 15)+ _lhsOoutput =+ CGrammar typeSyns_ derivings_ wrappers_ _nontsIcNonterminals pragmas_ paramMap_ contextMap_+ -- "Order.ag"(line 506, column 13)+ _nontsOallnts =+ map fst (_nontsInonts)+ -- copy rule (from local)+ _nontsOcInterfaceMap =+ _cInterfaceMap+ -- copy rule (from local)+ _nontsOcVisitsMap =+ _cVisitsMap+ ( _nontsIacount,_nontsIadditionalDep,_nontsIaranges,_nontsIcNonterminals,_nontsIdirectDep,_nontsIerrors,_nontsIinstDep,_nontsInonts,_nontsIntattrs,_nontsIrules,_nontsIvcount) =+ (nonts_ _nontsOacount _nontsOallnts _nontsOcInterfaceMap _nontsOcVisitsMap _nontsOmanualAttrDepMap _nontsOo_case _nontsOo_cata _nontsOo_data _nontsOo_dovisit _nontsOo_newtypes _nontsOo_rename _nontsOo_sem _nontsOo_sig _nontsOo_unbox _nontsOo_wantvisit _nontsOprefix _nontsOvcount)+ in ( _lhsOerrors,_lhsOoutput))))+-- Nonterminal -------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allnts : [Identifier]+ cInterfaceMap : CInterfaceMap+ cVisitsMap : CVisitsMap+ manualAttrDepMap : AttrOrderMap+ o_case : Bool+ o_cata : Bool+ o_data : Bool+ o_dovisit : Bool+ o_newtypes : Bool+ o_rename : Bool+ o_sem : Bool+ o_sig : Bool+ o_unbox : Bool+ o_wantvisit : Bool+ prefix : String+ chained attributes:+ acount : Int+ vcount : Int+ synthesized attributes:+ additionalDep : Seq Edge+ aranges : Seq (Int,Int,Int)+ cNonterminal : CNonterminal+ directDep : Seq Edge+ errors : Seq Error+ instDep : Seq Edge+ nonts : [(NontermIdent,[ConstructorIdent])]+ ntattrs : Seq (Vertex,NTAttr)+ rules : Seq (Vertex,CRule)+ alternatives:+ alternative Nonterminal:+ child nt : {NontermIdent}+ child params : {[Identifier]}+ child inh : {Attributes}+ child syn : {Attributes}+ child prods : Productions+ visit 0:+ local ntattrs : _+ local cInter : _+-}+-- 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 (Int ->+ ([Identifier]) ->+ CInterfaceMap ->+ CVisitsMap ->+ AttrOrderMap ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ String ->+ Int ->+ ( Int,(Seq Edge),(Seq (Int,Int,Int)),CNonterminal,(Seq Edge),(Seq Error),(Seq Edge),([(NontermIdent,[ConstructorIdent])]),(Seq (Vertex,NTAttr)),(Seq (Vertex,CRule)),Int))+data Inh_Nonterminal = Inh_Nonterminal {acount_Inh_Nonterminal :: Int,allnts_Inh_Nonterminal :: [Identifier],cInterfaceMap_Inh_Nonterminal :: CInterfaceMap,cVisitsMap_Inh_Nonterminal :: CVisitsMap,manualAttrDepMap_Inh_Nonterminal :: AttrOrderMap,o_case_Inh_Nonterminal :: Bool,o_cata_Inh_Nonterminal :: Bool,o_data_Inh_Nonterminal :: Bool,o_dovisit_Inh_Nonterminal :: Bool,o_newtypes_Inh_Nonterminal :: Bool,o_rename_Inh_Nonterminal :: Bool,o_sem_Inh_Nonterminal :: Bool,o_sig_Inh_Nonterminal :: Bool,o_unbox_Inh_Nonterminal :: Bool,o_wantvisit_Inh_Nonterminal :: Bool,prefix_Inh_Nonterminal :: String,vcount_Inh_Nonterminal :: Int}+data Syn_Nonterminal = Syn_Nonterminal {acount_Syn_Nonterminal :: Int,additionalDep_Syn_Nonterminal :: Seq Edge,aranges_Syn_Nonterminal :: Seq (Int,Int,Int),cNonterminal_Syn_Nonterminal :: CNonterminal,directDep_Syn_Nonterminal :: Seq Edge,errors_Syn_Nonterminal :: Seq Error,instDep_Syn_Nonterminal :: Seq Edge,nonts_Syn_Nonterminal :: [(NontermIdent,[ConstructorIdent])],ntattrs_Syn_Nonterminal :: Seq (Vertex,NTAttr),rules_Syn_Nonterminal :: Seq (Vertex,CRule),vcount_Syn_Nonterminal :: Int}+wrap_Nonterminal (T_Nonterminal sem) (Inh_Nonterminal _lhsIacount _lhsIallnts _lhsIcInterfaceMap _lhsIcVisitsMap _lhsImanualAttrDepMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIvcount) =+ (let ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOcNonterminal,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOnonts,_lhsOntattrs,_lhsOrules,_lhsOvcount) =+ (sem _lhsIacount _lhsIallnts _lhsIcInterfaceMap _lhsIcVisitsMap _lhsImanualAttrDepMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIvcount)+ in (Syn_Nonterminal _lhsOacount _lhsOadditionalDep _lhsOaranges _lhsOcNonterminal _lhsOdirectDep _lhsOerrors _lhsOinstDep _lhsOnonts _lhsOntattrs _lhsOrules _lhsOvcount))+sem_Nonterminal_Nonterminal :: NontermIdent ->+ ([Identifier]) ->+ Attributes ->+ Attributes ->+ T_Productions ->+ T_Nonterminal+sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ (T_Productions prods_) =+ (T_Nonterminal (\ _lhsIacount+ _lhsIallnts+ _lhsIcInterfaceMap+ _lhsIcVisitsMap+ _lhsImanualAttrDepMap+ _lhsIo_case+ _lhsIo_cata+ _lhsIo_data+ _lhsIo_dovisit+ _lhsIo_newtypes+ _lhsIo_rename+ _lhsIo_sem+ _lhsIo_sig+ _lhsIo_unbox+ _lhsIo_wantvisit+ _lhsIprefix+ _lhsIvcount ->+ (let _prodsOnt :: Identifier+ _prodsOinh :: Attributes+ _prodsOsyn :: Attributes+ _lhsOntattrs :: (Seq (Vertex,NTAttr))+ _lhsOacount :: Int+ _lhsOaranges :: (Seq (Int,Int,Int))+ _lhsOnonts :: ([(NontermIdent,[ConstructorIdent])])+ _lhsOcNonterminal :: CNonterminal+ _lhsOadditionalDep :: (Seq Edge)+ _lhsOdirectDep :: (Seq Edge)+ _lhsOerrors :: (Seq Error)+ _lhsOinstDep :: (Seq Edge)+ _lhsOrules :: (Seq (Vertex,CRule))+ _lhsOvcount :: Int+ _prodsOallnts :: ([Identifier])+ _prodsOcVisitsMap :: CVisitsMap+ _prodsOmanualAttrDepMap :: AttrOrderMap+ _prodsOo_case :: Bool+ _prodsOo_cata :: Bool+ _prodsOo_dovisit :: Bool+ _prodsOo_newtypes :: Bool+ _prodsOo_rename :: Bool+ _prodsOo_sem :: Bool+ _prodsOo_sig :: Bool+ _prodsOo_unbox :: Bool+ _prodsOo_wantvisit :: Bool+ _prodsOprefix :: String+ _prodsOvcount :: Int+ _prodsIadditionalDep :: (Seq Edge)+ _prodsIcProductions :: CProductions+ _prodsIcons :: ([ConstructorIdent])+ _prodsIdirectDep :: (Seq Edge)+ _prodsIerrors :: (Seq Error)+ _prodsIinstDep :: (Seq Edge)+ _prodsIrules :: (Seq (Vertex,CRule))+ _prodsIvcount :: Int+ -- "Order.ag"(line 73, column 17)+ _prodsOnt =+ nt_+ -- "Order.ag"(line 76, column 17)+ _prodsOinh =+ inh_+ -- "Order.ag"(line 77, column 17)+ _prodsOsyn =+ syn_+ -- "Order.ag"(line 368, column 17)+ _ntattrs =+ [ NTAInh nt_ inh tp | (inh,tp) <- Map.assocs inh_ ]+ ++ [NTASyn nt_ syn tp | (syn,tp) <- Map.assocs syn_ ]+ -- "Order.ag"(line 370, column 17)+ _lhsOntattrs =+ Seq.fromList (zip [_lhsIacount ..] _ntattrs)+ -- "Order.ag"(line 371, column 17)+ _lhsOacount =+ _lhsIacount + Map.size inh_ + Map.size syn_+ -- "Order.ag"(line 372, column 17)+ _lhsOaranges =+ Seq.single+ (_lhsIacount+ ,_lhsIacount + Map.size inh_+ ,_lhsIacount + Map.size syn_ + Map.size inh_ - 1)+ -- "Order.ag"(line 381, column 19)+ _lhsOnonts =+ [(nt_,_prodsIcons)]+ -- "Order.ag"(line 456, column 19)+ _cInter =+ if _lhsIo_dovisit+ then findWithErr1 "Nonterminal.cInter" nt_ _lhsIcInterfaceMap+ else CInterface [CSegment inh_ syn_]+ -- "Order.ag"(line 484, column 19)+ _lhsOcNonterminal =+ CNonterminal nt_ params_ inh_ syn_ _prodsIcProductions _cInter+ -- use rule "Order.ag"(line 259, column 71)+ _lhsOadditionalDep =+ _prodsIadditionalDep+ -- use rule "Order.ag"(line 245, column 33)+ _lhsOdirectDep =+ _prodsIdirectDep+ -- use rule "Order.ag"(line 60, column 70)+ _lhsOerrors =+ _prodsIerrors+ -- use rule "Order.ag"(line 292, column 31)+ _lhsOinstDep =+ _prodsIinstDep+ -- use rule "Order.ag"(line 235, column 18)+ _lhsOrules =+ _prodsIrules+ -- copy rule (up)+ _lhsOvcount =+ _prodsIvcount+ -- copy rule (down)+ _prodsOallnts =+ _lhsIallnts+ -- copy rule (down)+ _prodsOcVisitsMap =+ _lhsIcVisitsMap+ -- copy rule (down)+ _prodsOmanualAttrDepMap =+ _lhsImanualAttrDepMap+ -- copy rule (down)+ _prodsOo_case =+ _lhsIo_case+ -- copy rule (down)+ _prodsOo_cata =+ _lhsIo_cata+ -- copy rule (down)+ _prodsOo_dovisit =+ _lhsIo_dovisit+ -- copy rule (down)+ _prodsOo_newtypes =+ _lhsIo_newtypes+ -- copy rule (down)+ _prodsOo_rename =+ _lhsIo_rename+ -- copy rule (down)+ _prodsOo_sem =+ _lhsIo_sem+ -- copy rule (down)+ _prodsOo_sig =+ _lhsIo_sig+ -- copy rule (down)+ _prodsOo_unbox =+ _lhsIo_unbox+ -- copy rule (down)+ _prodsOo_wantvisit =+ _lhsIo_wantvisit+ -- copy rule (down)+ _prodsOprefix =+ _lhsIprefix+ -- copy rule (down)+ _prodsOvcount =+ _lhsIvcount+ ( _prodsIadditionalDep,_prodsIcProductions,_prodsIcons,_prodsIdirectDep,_prodsIerrors,_prodsIinstDep,_prodsIrules,_prodsIvcount) =+ (prods_ _prodsOallnts _prodsOcVisitsMap _prodsOinh _prodsOmanualAttrDepMap _prodsOnt _prodsOo_case _prodsOo_cata _prodsOo_dovisit _prodsOo_newtypes _prodsOo_rename _prodsOo_sem _prodsOo_sig _prodsOo_unbox _prodsOo_wantvisit _prodsOprefix _prodsOsyn _prodsOvcount)+ in ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOcNonterminal,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOnonts,_lhsOntattrs,_lhsOrules,_lhsOvcount))))+-- Nonterminals ------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allnts : [Identifier]+ cInterfaceMap : CInterfaceMap+ cVisitsMap : CVisitsMap+ manualAttrDepMap : AttrOrderMap+ o_case : Bool+ o_cata : Bool+ o_data : Bool+ o_dovisit : Bool+ o_newtypes : Bool+ o_rename : Bool+ o_sem : Bool+ o_sig : Bool+ o_unbox : Bool+ o_wantvisit : Bool+ prefix : String+ chained attributes:+ acount : Int+ vcount : Int+ synthesized attributes:+ additionalDep : Seq Edge+ aranges : Seq (Int,Int,Int)+ cNonterminals : CNonterminals+ directDep : Seq Edge+ errors : Seq Error+ instDep : Seq Edge+ nonts : [(NontermIdent,[ConstructorIdent])]+ ntattrs : Seq (Vertex,NTAttr)+ rules : Seq (Vertex,CRule)+ 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 (Int ->+ ([Identifier]) ->+ CInterfaceMap ->+ CVisitsMap ->+ AttrOrderMap ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ String ->+ Int ->+ ( Int,(Seq Edge),(Seq (Int,Int,Int)),CNonterminals,(Seq Edge),(Seq Error),(Seq Edge),([(NontermIdent,[ConstructorIdent])]),(Seq (Vertex,NTAttr)),(Seq (Vertex,CRule)),Int))+data Inh_Nonterminals = Inh_Nonterminals {acount_Inh_Nonterminals :: Int,allnts_Inh_Nonterminals :: [Identifier],cInterfaceMap_Inh_Nonterminals :: CInterfaceMap,cVisitsMap_Inh_Nonterminals :: CVisitsMap,manualAttrDepMap_Inh_Nonterminals :: AttrOrderMap,o_case_Inh_Nonterminals :: Bool,o_cata_Inh_Nonterminals :: Bool,o_data_Inh_Nonterminals :: Bool,o_dovisit_Inh_Nonterminals :: Bool,o_newtypes_Inh_Nonterminals :: Bool,o_rename_Inh_Nonterminals :: Bool,o_sem_Inh_Nonterminals :: Bool,o_sig_Inh_Nonterminals :: Bool,o_unbox_Inh_Nonterminals :: Bool,o_wantvisit_Inh_Nonterminals :: Bool,prefix_Inh_Nonterminals :: String,vcount_Inh_Nonterminals :: Int}+data Syn_Nonterminals = Syn_Nonterminals {acount_Syn_Nonterminals :: Int,additionalDep_Syn_Nonterminals :: Seq Edge,aranges_Syn_Nonterminals :: Seq (Int,Int,Int),cNonterminals_Syn_Nonterminals :: CNonterminals,directDep_Syn_Nonterminals :: Seq Edge,errors_Syn_Nonterminals :: Seq Error,instDep_Syn_Nonterminals :: Seq Edge,nonts_Syn_Nonterminals :: [(NontermIdent,[ConstructorIdent])],ntattrs_Syn_Nonterminals :: Seq (Vertex,NTAttr),rules_Syn_Nonterminals :: Seq (Vertex,CRule),vcount_Syn_Nonterminals :: Int}+wrap_Nonterminals (T_Nonterminals sem) (Inh_Nonterminals _lhsIacount _lhsIallnts _lhsIcInterfaceMap _lhsIcVisitsMap _lhsImanualAttrDepMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIvcount) =+ (let ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOcNonterminals,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOnonts,_lhsOntattrs,_lhsOrules,_lhsOvcount) =+ (sem _lhsIacount _lhsIallnts _lhsIcInterfaceMap _lhsIcVisitsMap _lhsImanualAttrDepMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIvcount)+ in (Syn_Nonterminals _lhsOacount _lhsOadditionalDep _lhsOaranges _lhsOcNonterminals _lhsOdirectDep _lhsOerrors _lhsOinstDep _lhsOnonts _lhsOntattrs _lhsOrules _lhsOvcount))+sem_Nonterminals_Cons :: T_Nonterminal ->+ T_Nonterminals ->+ T_Nonterminals+sem_Nonterminals_Cons (T_Nonterminal hd_) (T_Nonterminals tl_) =+ (T_Nonterminals (\ _lhsIacount+ _lhsIallnts+ _lhsIcInterfaceMap+ _lhsIcVisitsMap+ _lhsImanualAttrDepMap+ _lhsIo_case+ _lhsIo_cata+ _lhsIo_data+ _lhsIo_dovisit+ _lhsIo_newtypes+ _lhsIo_rename+ _lhsIo_sem+ _lhsIo_sig+ _lhsIo_unbox+ _lhsIo_wantvisit+ _lhsIprefix+ _lhsIvcount ->+ (let _lhsOcNonterminals :: CNonterminals+ _lhsOadditionalDep :: (Seq Edge)+ _lhsOaranges :: (Seq (Int,Int,Int))+ _lhsOdirectDep :: (Seq Edge)+ _lhsOerrors :: (Seq Error)+ _lhsOinstDep :: (Seq Edge)+ _lhsOnonts :: ([(NontermIdent,[ConstructorIdent])])+ _lhsOntattrs :: (Seq (Vertex,NTAttr))+ _lhsOrules :: (Seq (Vertex,CRule))+ _lhsOacount :: Int+ _lhsOvcount :: Int+ _hdOacount :: Int+ _hdOallnts :: ([Identifier])+ _hdOcInterfaceMap :: CInterfaceMap+ _hdOcVisitsMap :: CVisitsMap+ _hdOmanualAttrDepMap :: AttrOrderMap+ _hdOo_case :: Bool+ _hdOo_cata :: Bool+ _hdOo_data :: Bool+ _hdOo_dovisit :: Bool+ _hdOo_newtypes :: Bool+ _hdOo_rename :: Bool+ _hdOo_sem :: Bool+ _hdOo_sig :: Bool+ _hdOo_unbox :: Bool+ _hdOo_wantvisit :: Bool+ _hdOprefix :: String+ _hdOvcount :: Int+ _tlOacount :: Int+ _tlOallnts :: ([Identifier])+ _tlOcInterfaceMap :: CInterfaceMap+ _tlOcVisitsMap :: CVisitsMap+ _tlOmanualAttrDepMap :: AttrOrderMap+ _tlOo_case :: Bool+ _tlOo_cata :: Bool+ _tlOo_data :: Bool+ _tlOo_dovisit :: Bool+ _tlOo_newtypes :: Bool+ _tlOo_rename :: Bool+ _tlOo_sem :: Bool+ _tlOo_sig :: Bool+ _tlOo_unbox :: Bool+ _tlOo_wantvisit :: Bool+ _tlOprefix :: String+ _tlOvcount :: Int+ _hdIacount :: Int+ _hdIadditionalDep :: (Seq Edge)+ _hdIaranges :: (Seq (Int,Int,Int))+ _hdIcNonterminal :: CNonterminal+ _hdIdirectDep :: (Seq Edge)+ _hdIerrors :: (Seq Error)+ _hdIinstDep :: (Seq Edge)+ _hdInonts :: ([(NontermIdent,[ConstructorIdent])])+ _hdIntattrs :: (Seq (Vertex,NTAttr))+ _hdIrules :: (Seq (Vertex,CRule))+ _hdIvcount :: Int+ _tlIacount :: Int+ _tlIadditionalDep :: (Seq Edge)+ _tlIaranges :: (Seq (Int,Int,Int))+ _tlIcNonterminals :: CNonterminals+ _tlIdirectDep :: (Seq Edge)+ _tlIerrors :: (Seq Error)+ _tlIinstDep :: (Seq Edge)+ _tlInonts :: ([(NontermIdent,[ConstructorIdent])])+ _tlIntattrs :: (Seq (Vertex,NTAttr))+ _tlIrules :: (Seq (Vertex,CRule))+ _tlIvcount :: Int+ -- "Order.ag"(line 481, column 12)+ _lhsOcNonterminals =+ _hdIcNonterminal : _tlIcNonterminals+ -- use rule "Order.ag"(line 259, column 71)+ _lhsOadditionalDep =+ _hdIadditionalDep Seq.<> _tlIadditionalDep+ -- use rule "Order.ag"(line 362, column 36)+ _lhsOaranges =+ _hdIaranges Seq.<> _tlIaranges+ -- use rule "Order.ag"(line 245, column 33)+ _lhsOdirectDep =+ _hdIdirectDep Seq.<> _tlIdirectDep+ -- use rule "Order.ag"(line 60, column 70)+ _lhsOerrors =+ _hdIerrors Seq.<> _tlIerrors+ -- use rule "Order.ag"(line 292, column 31)+ _lhsOinstDep =+ _hdIinstDep Seq.<> _tlIinstDep+ -- use rule "Order.ag"(line 379, column 43)+ _lhsOnonts =+ _hdInonts ++ _tlInonts+ -- use rule "Order.ag"(line 361, column 35)+ _lhsOntattrs =+ _hdIntattrs Seq.<> _tlIntattrs+ -- use rule "Order.ag"(line 235, column 18)+ _lhsOrules =+ _hdIrules Seq.<> _tlIrules+ -- copy rule (up)+ _lhsOacount =+ _tlIacount+ -- copy rule (up)+ _lhsOvcount =+ _tlIvcount+ -- copy rule (down)+ _hdOacount =+ _lhsIacount+ -- copy rule (down)+ _hdOallnts =+ _lhsIallnts+ -- copy rule (down)+ _hdOcInterfaceMap =+ _lhsIcInterfaceMap+ -- copy rule (down)+ _hdOcVisitsMap =+ _lhsIcVisitsMap+ -- copy rule (down)+ _hdOmanualAttrDepMap =+ _lhsImanualAttrDepMap+ -- copy rule (down)+ _hdOo_case =+ _lhsIo_case+ -- copy rule (down)+ _hdOo_cata =+ _lhsIo_cata+ -- copy rule (down)+ _hdOo_data =+ _lhsIo_data+ -- copy rule (down)+ _hdOo_dovisit =+ _lhsIo_dovisit+ -- copy rule (down)+ _hdOo_newtypes =+ _lhsIo_newtypes+ -- copy rule (down)+ _hdOo_rename =+ _lhsIo_rename+ -- copy rule (down)+ _hdOo_sem =+ _lhsIo_sem+ -- copy rule (down)+ _hdOo_sig =+ _lhsIo_sig+ -- copy rule (down)+ _hdOo_unbox =+ _lhsIo_unbox+ -- copy rule (down)+ _hdOo_wantvisit =+ _lhsIo_wantvisit+ -- copy rule (down)+ _hdOprefix =+ _lhsIprefix+ -- copy rule (down)+ _hdOvcount =+ _lhsIvcount+ -- copy rule (chain)+ _tlOacount =+ _hdIacount+ -- copy rule (down)+ _tlOallnts =+ _lhsIallnts+ -- copy rule (down)+ _tlOcInterfaceMap =+ _lhsIcInterfaceMap+ -- copy rule (down)+ _tlOcVisitsMap =+ _lhsIcVisitsMap+ -- copy rule (down)+ _tlOmanualAttrDepMap =+ _lhsImanualAttrDepMap+ -- copy rule (down)+ _tlOo_case =+ _lhsIo_case+ -- copy rule (down)+ _tlOo_cata =+ _lhsIo_cata+ -- copy rule (down)+ _tlOo_data =+ _lhsIo_data+ -- copy rule (down)+ _tlOo_dovisit =+ _lhsIo_dovisit+ -- copy rule (down)+ _tlOo_newtypes =+ _lhsIo_newtypes+ -- copy rule (down)+ _tlOo_rename =+ _lhsIo_rename+ -- copy rule (down)+ _tlOo_sem =+ _lhsIo_sem+ -- copy rule (down)+ _tlOo_sig =+ _lhsIo_sig+ -- copy rule (down)+ _tlOo_unbox =+ _lhsIo_unbox+ -- copy rule (down)+ _tlOo_wantvisit =+ _lhsIo_wantvisit+ -- copy rule (down)+ _tlOprefix =+ _lhsIprefix+ -- copy rule (chain)+ _tlOvcount =+ _hdIvcount+ ( _hdIacount,_hdIadditionalDep,_hdIaranges,_hdIcNonterminal,_hdIdirectDep,_hdIerrors,_hdIinstDep,_hdInonts,_hdIntattrs,_hdIrules,_hdIvcount) =+ (hd_ _hdOacount _hdOallnts _hdOcInterfaceMap _hdOcVisitsMap _hdOmanualAttrDepMap _hdOo_case _hdOo_cata _hdOo_data _hdOo_dovisit _hdOo_newtypes _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_unbox _hdOo_wantvisit _hdOprefix _hdOvcount)+ ( _tlIacount,_tlIadditionalDep,_tlIaranges,_tlIcNonterminals,_tlIdirectDep,_tlIerrors,_tlIinstDep,_tlInonts,_tlIntattrs,_tlIrules,_tlIvcount) =+ (tl_ _tlOacount _tlOallnts _tlOcInterfaceMap _tlOcVisitsMap _tlOmanualAttrDepMap _tlOo_case _tlOo_cata _tlOo_data _tlOo_dovisit _tlOo_newtypes _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_unbox _tlOo_wantvisit _tlOprefix _tlOvcount)+ in ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOcNonterminals,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOnonts,_lhsOntattrs,_lhsOrules,_lhsOvcount))))+sem_Nonterminals_Nil :: T_Nonterminals+sem_Nonterminals_Nil =+ (T_Nonterminals (\ _lhsIacount+ _lhsIallnts+ _lhsIcInterfaceMap+ _lhsIcVisitsMap+ _lhsImanualAttrDepMap+ _lhsIo_case+ _lhsIo_cata+ _lhsIo_data+ _lhsIo_dovisit+ _lhsIo_newtypes+ _lhsIo_rename+ _lhsIo_sem+ _lhsIo_sig+ _lhsIo_unbox+ _lhsIo_wantvisit+ _lhsIprefix+ _lhsIvcount ->+ (let _lhsOcNonterminals :: CNonterminals+ _lhsOadditionalDep :: (Seq Edge)+ _lhsOaranges :: (Seq (Int,Int,Int))+ _lhsOdirectDep :: (Seq Edge)+ _lhsOerrors :: (Seq Error)+ _lhsOinstDep :: (Seq Edge)+ _lhsOnonts :: ([(NontermIdent,[ConstructorIdent])])+ _lhsOntattrs :: (Seq (Vertex,NTAttr))+ _lhsOrules :: (Seq (Vertex,CRule))+ _lhsOacount :: Int+ _lhsOvcount :: Int+ -- "Order.ag"(line 482, column 12)+ _lhsOcNonterminals =+ []+ -- use rule "Order.ag"(line 259, column 71)+ _lhsOadditionalDep =+ Seq.empty+ -- use rule "Order.ag"(line 362, column 36)+ _lhsOaranges =+ Seq.empty+ -- use rule "Order.ag"(line 245, column 33)+ _lhsOdirectDep =+ Seq.empty+ -- use rule "Order.ag"(line 60, column 70)+ _lhsOerrors =+ Seq.empty+ -- use rule "Order.ag"(line 292, column 31)+ _lhsOinstDep =+ Seq.empty+ -- use rule "Order.ag"(line 379, column 43)+ _lhsOnonts =+ []+ -- use rule "Order.ag"(line 361, column 35)+ _lhsOntattrs =+ Seq.empty+ -- use rule "Order.ag"(line 235, column 18)+ _lhsOrules =+ Seq.empty+ -- copy rule (chain)+ _lhsOacount =+ _lhsIacount+ -- copy rule (chain)+ _lhsOvcount =+ _lhsIvcount+ in ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOcNonterminals,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOnonts,_lhsOntattrs,_lhsOrules,_lhsOvcount))))+-- Pattern -----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allTypeSigs : Map Identifier Type+ altAttrs : Map AltAttr Vertex+ con : Identifier+ inh : Attributes+ nt : Identifier+ syn : Attributes+ synthesized attributes:+ copy : SELF+ errors : Seq Error+ gathAltAttrs : [AltAttr]+ instVars : [Identifier]+ locVars : [Identifier]+ patternAttrs : [(Identifier,Identifier,Bool,Patterns)]+ 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 ((Map Identifier Type) ->+ (Map AltAttr Vertex) ->+ Identifier ->+ Attributes ->+ Identifier ->+ Attributes ->+ ( Pattern,(Seq Error),([AltAttr]),([Identifier]),([Identifier]),([(Identifier,Identifier,Bool,Patterns)])))+data Inh_Pattern = Inh_Pattern {allTypeSigs_Inh_Pattern :: Map Identifier Type,altAttrs_Inh_Pattern :: Map AltAttr Vertex,con_Inh_Pattern :: Identifier,inh_Inh_Pattern :: Attributes,nt_Inh_Pattern :: Identifier,syn_Inh_Pattern :: Attributes}+data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern,errors_Syn_Pattern :: Seq Error,gathAltAttrs_Syn_Pattern :: [AltAttr],instVars_Syn_Pattern :: [Identifier],locVars_Syn_Pattern :: [Identifier],patternAttrs_Syn_Pattern :: [(Identifier,Identifier,Bool,Patterns)]}+wrap_Pattern (T_Pattern sem) (Inh_Pattern _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn) =+ (let ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs) =+ (sem _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn)+ in (Syn_Pattern _lhsOcopy _lhsOerrors _lhsOgathAltAttrs _lhsOinstVars _lhsOlocVars _lhsOpatternAttrs))+sem_Pattern_Alias :: Identifier ->+ Identifier ->+ T_Pattern ->+ T_Patterns ->+ T_Pattern+sem_Pattern_Alias field_ attr_ (T_Pattern pat_) (T_Patterns parts_) =+ (T_Pattern (\ _lhsIallTypeSigs+ _lhsIaltAttrs+ _lhsIcon+ _lhsIinh+ _lhsInt+ _lhsIsyn ->+ (let _lhsOgathAltAttrs :: ([AltAttr])+ _lhsOpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)])+ _lhsOlocVars :: ([Identifier])+ _lhsOinstVars :: ([Identifier])+ _lhsOerrors :: (Seq Error)+ _lhsOcopy :: Pattern+ _patOallTypeSigs :: (Map Identifier Type)+ _patOaltAttrs :: (Map AltAttr Vertex)+ _patOcon :: Identifier+ _patOinh :: Attributes+ _patOnt :: Identifier+ _patOsyn :: Attributes+ _partsOallTypeSigs :: (Map Identifier Type)+ _partsOaltAttrs :: (Map AltAttr Vertex)+ _partsOcon :: Identifier+ _partsOinh :: Attributes+ _partsOnt :: Identifier+ _partsOsyn :: Attributes+ _patIcopy :: Pattern+ _patIerrors :: (Seq Error)+ _patIgathAltAttrs :: ([AltAttr])+ _patIinstVars :: ([Identifier])+ _patIlocVars :: ([Identifier])+ _patIpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)])+ _partsIcopy :: Patterns+ _partsIerrors :: (Seq Error)+ _partsIgathAltAttrs :: ([AltAttr])+ _partsIinstVars :: ([Identifier])+ _partsIlocVars :: ([Identifier])+ _partsIpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)])+ -- "Order.ag"(line 160, column 12)+ _lhsOgathAltAttrs =+ [AltAttr field_ attr_ (field_ == _LOC || field_ == _INST)]+ -- "Order.ag"(line 228, column 12)+ _lhsOpatternAttrs =+ [(field_,attr_,(field_ == _LOC || field_ == _INST),_partsIcopy)]+ -- "Order.ag"(line 536, column 14)+ _lhsOlocVars =+ if field_ == _LOC+ then [attr_]+ else []+ -- "Order.ag"(line 539, column 14)+ _lhsOinstVars =+ if field_ == _INST+ then [attr_]+ else []+ -- use rule "Order.ag"(line 60, column 70)+ _lhsOerrors =+ _patIerrors Seq.<> _partsIerrors+ -- self rule+ _copy =+ Alias field_ attr_ _patIcopy _partsIcopy+ -- self rule+ _lhsOcopy =+ _copy+ -- copy rule (down)+ _patOallTypeSigs =+ _lhsIallTypeSigs+ -- copy rule (down)+ _patOaltAttrs =+ _lhsIaltAttrs+ -- copy rule (down)+ _patOcon =+ _lhsIcon+ -- copy rule (down)+ _patOinh =+ _lhsIinh+ -- copy rule (down)+ _patOnt =+ _lhsInt+ -- copy rule (down)+ _patOsyn =+ _lhsIsyn+ -- copy rule (down)+ _partsOallTypeSigs =+ _lhsIallTypeSigs+ -- copy rule (down)+ _partsOaltAttrs =+ _lhsIaltAttrs+ -- copy rule (down)+ _partsOcon =+ _lhsIcon+ -- copy rule (down)+ _partsOinh =+ _lhsIinh+ -- copy rule (down)+ _partsOnt =+ _lhsInt+ -- copy rule (down)+ _partsOsyn =+ _lhsIsyn+ ( _patIcopy,_patIerrors,_patIgathAltAttrs,_patIinstVars,_patIlocVars,_patIpatternAttrs) =+ (pat_ _patOallTypeSigs _patOaltAttrs _patOcon _patOinh _patOnt _patOsyn)+ ( _partsIcopy,_partsIerrors,_partsIgathAltAttrs,_partsIinstVars,_partsIlocVars,_partsIpatternAttrs) =+ (parts_ _partsOallTypeSigs _partsOaltAttrs _partsOcon _partsOinh _partsOnt _partsOsyn)+ in ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs))))+sem_Pattern_Constr :: ConstructorIdent ->+ T_Patterns ->+ T_Pattern+sem_Pattern_Constr name_ (T_Patterns pats_) =+ (T_Pattern (\ _lhsIallTypeSigs+ _lhsIaltAttrs+ _lhsIcon+ _lhsIinh+ _lhsInt+ _lhsIsyn ->+ (let _lhsOerrors :: (Seq Error)+ _lhsOgathAltAttrs :: ([AltAttr])+ _lhsOinstVars :: ([Identifier])+ _lhsOlocVars :: ([Identifier])+ _lhsOpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)])+ _lhsOcopy :: Pattern+ _patsOallTypeSigs :: (Map Identifier Type)+ _patsOaltAttrs :: (Map AltAttr Vertex)+ _patsOcon :: Identifier+ _patsOinh :: Attributes+ _patsOnt :: Identifier+ _patsOsyn :: Attributes+ _patsIcopy :: Patterns+ _patsIerrors :: (Seq Error)+ _patsIgathAltAttrs :: ([AltAttr])+ _patsIinstVars :: ([Identifier])+ _patsIlocVars :: ([Identifier])+ _patsIpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)])+ -- use rule "Order.ag"(line 60, column 70)+ _lhsOerrors =+ _patsIerrors+ -- use rule "Order.ag"(line 146, column 68)+ _lhsOgathAltAttrs =+ _patsIgathAltAttrs+ -- use rule "Order.ag"(line 533, column 86)+ _lhsOinstVars =+ _patsIinstVars+ -- use rule "Order.ag"(line 533, column 48)+ _lhsOlocVars =+ _patsIlocVars+ -- use rule "Order.ag"(line 225, column 42)+ _lhsOpatternAttrs =+ _patsIpatternAttrs+ -- self rule+ _copy =+ Constr name_ _patsIcopy+ -- self rule+ _lhsOcopy =+ _copy+ -- copy rule (down)+ _patsOallTypeSigs =+ _lhsIallTypeSigs+ -- copy rule (down)+ _patsOaltAttrs =+ _lhsIaltAttrs+ -- copy rule (down)+ _patsOcon =+ _lhsIcon+ -- copy rule (down)+ _patsOinh =+ _lhsIinh+ -- copy rule (down)+ _patsOnt =+ _lhsInt+ -- copy rule (down)+ _patsOsyn =+ _lhsIsyn+ ( _patsIcopy,_patsIerrors,_patsIgathAltAttrs,_patsIinstVars,_patsIlocVars,_patsIpatternAttrs) =+ (pats_ _patsOallTypeSigs _patsOaltAttrs _patsOcon _patsOinh _patsOnt _patsOsyn)+ in ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs))))+sem_Pattern_Irrefutable :: T_Pattern ->+ T_Pattern+sem_Pattern_Irrefutable (T_Pattern pat_) =+ (T_Pattern (\ _lhsIallTypeSigs+ _lhsIaltAttrs+ _lhsIcon+ _lhsIinh+ _lhsInt+ _lhsIsyn ->+ (let _lhsOerrors :: (Seq Error)+ _lhsOgathAltAttrs :: ([AltAttr])+ _lhsOinstVars :: ([Identifier])+ _lhsOlocVars :: ([Identifier])+ _lhsOpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)])+ _lhsOcopy :: Pattern+ _patOallTypeSigs :: (Map Identifier Type)+ _patOaltAttrs :: (Map AltAttr Vertex)+ _patOcon :: Identifier+ _patOinh :: Attributes+ _patOnt :: Identifier+ _patOsyn :: Attributes+ _patIcopy :: Pattern+ _patIerrors :: (Seq Error)+ _patIgathAltAttrs :: ([AltAttr])+ _patIinstVars :: ([Identifier])+ _patIlocVars :: ([Identifier])+ _patIpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)])+ -- use rule "Order.ag"(line 60, column 70)+ _lhsOerrors =+ _patIerrors+ -- use rule "Order.ag"(line 146, column 68)+ _lhsOgathAltAttrs =+ _patIgathAltAttrs+ -- use rule "Order.ag"(line 533, column 86)+ _lhsOinstVars =+ _patIinstVars+ -- use rule "Order.ag"(line 533, column 48)+ _lhsOlocVars =+ _patIlocVars+ -- use rule "Order.ag"(line 225, column 42)+ _lhsOpatternAttrs =+ _patIpatternAttrs+ -- self rule+ _copy =+ Irrefutable _patIcopy+ -- self rule+ _lhsOcopy =+ _copy+ -- copy rule (down)+ _patOallTypeSigs =+ _lhsIallTypeSigs+ -- copy rule (down)+ _patOaltAttrs =+ _lhsIaltAttrs+ -- copy rule (down)+ _patOcon =+ _lhsIcon+ -- copy rule (down)+ _patOinh =+ _lhsIinh+ -- copy rule (down)+ _patOnt =+ _lhsInt+ -- copy rule (down)+ _patOsyn =+ _lhsIsyn+ ( _patIcopy,_patIerrors,_patIgathAltAttrs,_patIinstVars,_patIlocVars,_patIpatternAttrs) =+ (pat_ _patOallTypeSigs _patOaltAttrs _patOcon _patOinh _patOnt _patOsyn)+ in ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs))))+sem_Pattern_Product :: Pos ->+ T_Patterns ->+ T_Pattern+sem_Pattern_Product pos_ (T_Patterns pats_) =+ (T_Pattern (\ _lhsIallTypeSigs+ _lhsIaltAttrs+ _lhsIcon+ _lhsIinh+ _lhsInt+ _lhsIsyn ->+ (let _lhsOerrors :: (Seq Error)+ _lhsOgathAltAttrs :: ([AltAttr])+ _lhsOinstVars :: ([Identifier])+ _lhsOlocVars :: ([Identifier])+ _lhsOpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)])+ _lhsOcopy :: Pattern+ _patsOallTypeSigs :: (Map Identifier Type)+ _patsOaltAttrs :: (Map AltAttr Vertex)+ _patsOcon :: Identifier+ _patsOinh :: Attributes+ _patsOnt :: Identifier+ _patsOsyn :: Attributes+ _patsIcopy :: Patterns+ _patsIerrors :: (Seq Error)+ _patsIgathAltAttrs :: ([AltAttr])+ _patsIinstVars :: ([Identifier])+ _patsIlocVars :: ([Identifier])+ _patsIpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)])+ -- use rule "Order.ag"(line 60, column 70)+ _lhsOerrors =+ _patsIerrors+ -- use rule "Order.ag"(line 146, column 68)+ _lhsOgathAltAttrs =+ _patsIgathAltAttrs+ -- use rule "Order.ag"(line 533, column 86)+ _lhsOinstVars =+ _patsIinstVars+ -- use rule "Order.ag"(line 533, column 48)+ _lhsOlocVars =+ _patsIlocVars+ -- use rule "Order.ag"(line 225, column 42)+ _lhsOpatternAttrs =+ _patsIpatternAttrs+ -- self rule+ _copy =+ Product pos_ _patsIcopy+ -- self rule+ _lhsOcopy =+ _copy+ -- copy rule (down)+ _patsOallTypeSigs =+ _lhsIallTypeSigs+ -- copy rule (down)+ _patsOaltAttrs =+ _lhsIaltAttrs+ -- copy rule (down)+ _patsOcon =+ _lhsIcon+ -- copy rule (down)+ _patsOinh =+ _lhsIinh+ -- copy rule (down)+ _patsOnt =+ _lhsInt+ -- copy rule (down)+ _patsOsyn =+ _lhsIsyn+ ( _patsIcopy,_patsIerrors,_patsIgathAltAttrs,_patsIinstVars,_patsIlocVars,_patsIpatternAttrs) =+ (pats_ _patsOallTypeSigs _patsOaltAttrs _patsOcon _patsOinh _patsOnt _patsOsyn)+ in ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs))))+sem_Pattern_Underscore :: Pos ->+ T_Pattern+sem_Pattern_Underscore pos_ =+ (T_Pattern (\ _lhsIallTypeSigs+ _lhsIaltAttrs+ _lhsIcon+ _lhsIinh+ _lhsInt+ _lhsIsyn ->+ (let _lhsOerrors :: (Seq Error)+ _lhsOgathAltAttrs :: ([AltAttr])+ _lhsOinstVars :: ([Identifier])+ _lhsOlocVars :: ([Identifier])+ _lhsOpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)])+ _lhsOcopy :: Pattern+ -- use rule "Order.ag"(line 60, column 70)+ _lhsOerrors =+ Seq.empty+ -- use rule "Order.ag"(line 146, column 68)+ _lhsOgathAltAttrs =+ []+ -- use rule "Order.ag"(line 533, column 86)+ _lhsOinstVars =+ []+ -- use rule "Order.ag"(line 533, column 48)+ _lhsOlocVars =+ []+ -- use rule "Order.ag"(line 225, column 42)+ _lhsOpatternAttrs =+ []+ -- self rule+ _copy =+ Underscore pos_+ -- self rule+ _lhsOcopy =+ _copy+ in ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs))))+-- Patterns ----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allTypeSigs : Map Identifier Type+ altAttrs : Map AltAttr Vertex+ con : Identifier+ inh : Attributes+ nt : Identifier+ syn : Attributes+ synthesized attributes:+ copy : SELF+ errors : Seq Error+ gathAltAttrs : [AltAttr]+ instVars : [Identifier]+ locVars : [Identifier]+ patternAttrs : [(Identifier,Identifier,Bool,Patterns)]+ 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 ((Map Identifier Type) ->+ (Map AltAttr Vertex) ->+ Identifier ->+ Attributes ->+ Identifier ->+ Attributes ->+ ( Patterns,(Seq Error),([AltAttr]),([Identifier]),([Identifier]),([(Identifier,Identifier,Bool,Patterns)])))+data Inh_Patterns = Inh_Patterns {allTypeSigs_Inh_Patterns :: Map Identifier Type,altAttrs_Inh_Patterns :: Map AltAttr Vertex,con_Inh_Patterns :: Identifier,inh_Inh_Patterns :: Attributes,nt_Inh_Patterns :: Identifier,syn_Inh_Patterns :: Attributes}+data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns,errors_Syn_Patterns :: Seq Error,gathAltAttrs_Syn_Patterns :: [AltAttr],instVars_Syn_Patterns :: [Identifier],locVars_Syn_Patterns :: [Identifier],patternAttrs_Syn_Patterns :: [(Identifier,Identifier,Bool,Patterns)]}+wrap_Patterns (T_Patterns sem) (Inh_Patterns _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn) =+ (let ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs) =+ (sem _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn)+ in (Syn_Patterns _lhsOcopy _lhsOerrors _lhsOgathAltAttrs _lhsOinstVars _lhsOlocVars _lhsOpatternAttrs))+sem_Patterns_Cons :: T_Pattern ->+ T_Patterns ->+ T_Patterns+sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) =+ (T_Patterns (\ _lhsIallTypeSigs+ _lhsIaltAttrs+ _lhsIcon+ _lhsIinh+ _lhsInt+ _lhsIsyn ->+ (let _lhsOerrors :: (Seq Error)+ _lhsOgathAltAttrs :: ([AltAttr])+ _lhsOinstVars :: ([Identifier])+ _lhsOlocVars :: ([Identifier])+ _lhsOpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)])+ _lhsOcopy :: Patterns+ _hdOallTypeSigs :: (Map Identifier Type)+ _hdOaltAttrs :: (Map AltAttr Vertex)+ _hdOcon :: Identifier+ _hdOinh :: Attributes+ _hdOnt :: Identifier+ _hdOsyn :: Attributes+ _tlOallTypeSigs :: (Map Identifier Type)+ _tlOaltAttrs :: (Map AltAttr Vertex)+ _tlOcon :: Identifier+ _tlOinh :: Attributes+ _tlOnt :: Identifier+ _tlOsyn :: Attributes+ _hdIcopy :: Pattern+ _hdIerrors :: (Seq Error)+ _hdIgathAltAttrs :: ([AltAttr])+ _hdIinstVars :: ([Identifier])+ _hdIlocVars :: ([Identifier])+ _hdIpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)])+ _tlIcopy :: Patterns+ _tlIerrors :: (Seq Error)+ _tlIgathAltAttrs :: ([AltAttr])+ _tlIinstVars :: ([Identifier])+ _tlIlocVars :: ([Identifier])+ _tlIpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)])+ -- use rule "Order.ag"(line 60, column 70)+ _lhsOerrors =+ _hdIerrors Seq.<> _tlIerrors+ -- use rule "Order.ag"(line 146, column 68)+ _lhsOgathAltAttrs =+ _hdIgathAltAttrs ++ _tlIgathAltAttrs+ -- use rule "Order.ag"(line 533, column 86)+ _lhsOinstVars =+ _hdIinstVars ++ _tlIinstVars+ -- use rule "Order.ag"(line 533, column 48)+ _lhsOlocVars =+ _hdIlocVars ++ _tlIlocVars+ -- use rule "Order.ag"(line 225, column 42)+ _lhsOpatternAttrs =+ _hdIpatternAttrs ++ _tlIpatternAttrs+ -- self rule+ _copy =+ (:) _hdIcopy _tlIcopy+ -- self rule+ _lhsOcopy =+ _copy+ -- copy rule (down)+ _hdOallTypeSigs =+ _lhsIallTypeSigs+ -- copy rule (down)+ _hdOaltAttrs =+ _lhsIaltAttrs+ -- copy rule (down)+ _hdOcon =+ _lhsIcon+ -- copy rule (down)+ _hdOinh =+ _lhsIinh+ -- copy rule (down)+ _hdOnt =+ _lhsInt+ -- copy rule (down)+ _hdOsyn =+ _lhsIsyn+ -- copy rule (down)+ _tlOallTypeSigs =+ _lhsIallTypeSigs+ -- copy rule (down)+ _tlOaltAttrs =+ _lhsIaltAttrs+ -- copy rule (down)+ _tlOcon =+ _lhsIcon+ -- copy rule (down)+ _tlOinh =+ _lhsIinh+ -- copy rule (down)+ _tlOnt =+ _lhsInt+ -- copy rule (down)+ _tlOsyn =+ _lhsIsyn+ ( _hdIcopy,_hdIerrors,_hdIgathAltAttrs,_hdIinstVars,_hdIlocVars,_hdIpatternAttrs) =+ (hd_ _hdOallTypeSigs _hdOaltAttrs _hdOcon _hdOinh _hdOnt _hdOsyn)+ ( _tlIcopy,_tlIerrors,_tlIgathAltAttrs,_tlIinstVars,_tlIlocVars,_tlIpatternAttrs) =+ (tl_ _tlOallTypeSigs _tlOaltAttrs _tlOcon _tlOinh _tlOnt _tlOsyn)+ in ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs))))+sem_Patterns_Nil :: T_Patterns+sem_Patterns_Nil =+ (T_Patterns (\ _lhsIallTypeSigs+ _lhsIaltAttrs+ _lhsIcon+ _lhsIinh+ _lhsInt+ _lhsIsyn ->+ (let _lhsOerrors :: (Seq Error)+ _lhsOgathAltAttrs :: ([AltAttr])+ _lhsOinstVars :: ([Identifier])+ _lhsOlocVars :: ([Identifier])+ _lhsOpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)])+ _lhsOcopy :: Patterns+ -- use rule "Order.ag"(line 60, column 70)+ _lhsOerrors =+ Seq.empty+ -- use rule "Order.ag"(line 146, column 68)+ _lhsOgathAltAttrs =+ []+ -- use rule "Order.ag"(line 533, column 86)+ _lhsOinstVars =+ []+ -- use rule "Order.ag"(line 533, column 48)+ _lhsOlocVars =+ []+ -- use rule "Order.ag"(line 225, column 42)+ _lhsOpatternAttrs =+ []+ -- self rule+ _copy =+ []+ -- self rule+ _lhsOcopy =+ _copy+ in ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs))))+-- Production --------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allnts : [Identifier]+ cVisitsMap : CVisitsMap+ inh : Attributes+ manualAttrDepMap : AttrOrderMap+ nt : Identifier+ o_case : Bool+ o_cata : Bool+ o_dovisit : Bool+ o_newtypes : Bool+ o_rename : Bool+ o_sem : Bool+ o_sig : Bool+ o_unbox : Bool+ o_wantvisit : Bool+ prefix : String+ syn : Attributes+ chained attribute:+ vcount : Int+ synthesized attributes:+ additionalDep : Seq Edge+ cProduction : CProduction+ cons : [ConstructorIdent]+ directDep : Seq Edge+ errors : Seq Error+ instDep : Seq Edge+ rules : Seq (Vertex,CRule)+ alternatives:+ alternative Production:+ child con : {ConstructorIdent}+ child children : Children+ child rules : Rules+ child typeSigs : TypeSigs+ visit 0:+ local gathAltAttrs : _+ local inhRules : _+ local gathRules : _+ local cVisits : _+ local allfields : _+ local attrs : _+ local inhnames : _+ local synnames : _+-}+-- 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 (([Identifier]) ->+ CVisitsMap ->+ Attributes ->+ AttrOrderMap ->+ Identifier ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ String ->+ Attributes ->+ Int ->+ ( (Seq Edge),CProduction,([ConstructorIdent]),(Seq Edge),(Seq Error),(Seq Edge),(Seq (Vertex,CRule)),Int))+data Inh_Production = Inh_Production {allnts_Inh_Production :: [Identifier],cVisitsMap_Inh_Production :: CVisitsMap,inh_Inh_Production :: Attributes,manualAttrDepMap_Inh_Production :: AttrOrderMap,nt_Inh_Production :: Identifier,o_case_Inh_Production :: Bool,o_cata_Inh_Production :: Bool,o_dovisit_Inh_Production :: Bool,o_newtypes_Inh_Production :: Bool,o_rename_Inh_Production :: Bool,o_sem_Inh_Production :: Bool,o_sig_Inh_Production :: Bool,o_unbox_Inh_Production :: Bool,o_wantvisit_Inh_Production :: Bool,prefix_Inh_Production :: String,syn_Inh_Production :: Attributes,vcount_Inh_Production :: Int}+data Syn_Production = Syn_Production {additionalDep_Syn_Production :: Seq Edge,cProduction_Syn_Production :: CProduction,cons_Syn_Production :: [ConstructorIdent],directDep_Syn_Production :: Seq Edge,errors_Syn_Production :: Seq Error,instDep_Syn_Production :: Seq Edge,rules_Syn_Production :: Seq (Vertex,CRule),vcount_Syn_Production :: Int}+wrap_Production (T_Production sem) (Inh_Production _lhsIallnts _lhsIcVisitsMap _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIvcount) =+ (let ( _lhsOadditionalDep,_lhsOcProduction,_lhsOcons,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOrules,_lhsOvcount) =+ (sem _lhsIallnts _lhsIcVisitsMap _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIvcount)+ in (Syn_Production _lhsOadditionalDep _lhsOcProduction _lhsOcons _lhsOdirectDep _lhsOerrors _lhsOinstDep _lhsOrules _lhsOvcount))+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 (\ _lhsIallnts+ _lhsIcVisitsMap+ _lhsIinh+ _lhsImanualAttrDepMap+ _lhsInt+ _lhsIo_case+ _lhsIo_cata+ _lhsIo_dovisit+ _lhsIo_newtypes+ _lhsIo_rename+ _lhsIo_sem+ _lhsIo_sig+ _lhsIo_unbox+ _lhsIo_wantvisit+ _lhsIprefix+ _lhsIsyn+ _lhsIvcount ->+ (let _childrenOcon :: Identifier+ _rulesOcon :: Identifier+ _rulesOaltAttrs :: (Map AltAttr Vertex)+ _rulesOchildNts :: (Map Identifier NontermIdent)+ _rulesOchildInhs :: (Map Identifier Attributes)+ _lhsOrules :: (Seq (Vertex,CRule))+ _lhsOvcount :: Int+ _rulesOsynsOfChildren :: (Map Identifier Attributes)+ _lhsOcons :: ([ConstructorIdent])+ _typeSigsOtypeSigs :: (Map Identifier Type)+ _rulesOallTypeSigs :: (Map Identifier Type)+ _lhsOcProduction :: CProduction+ _lhsOadditionalDep :: (Seq Edge)+ _lhsOdirectDep :: (Seq Edge)+ _lhsOerrors :: (Seq Error)+ _lhsOinstDep :: (Seq Edge)+ _childrenOallfields :: ([(Identifier,Type,Bool)])+ _childrenOallnts :: ([Identifier])+ _childrenOattrs :: ([(Identifier,Identifier)])+ _childrenOinh :: Attributes+ _childrenOnt :: Identifier+ _childrenOo_unbox :: Bool+ _childrenOsyn :: Attributes+ _rulesOallfields :: ([(Identifier,Type,Bool)])+ _rulesOallnts :: ([Identifier])+ _rulesOattrs :: ([(Identifier,Identifier)])+ _rulesOinh :: Attributes+ _rulesOmanualAttrDepMap :: AttrOrderMap+ _rulesOnt :: Identifier+ _rulesOo_case :: Bool+ _rulesOo_cata :: Bool+ _rulesOo_dovisit :: Bool+ _rulesOo_newtypes :: Bool+ _rulesOo_rename :: Bool+ _rulesOo_sem :: Bool+ _rulesOo_sig :: Bool+ _rulesOo_wantvisit :: Bool+ _rulesOprefix :: String+ _rulesOsyn :: Attributes+ _childrenIattributes :: ([(Identifier,Attributes,Attributes)])+ _childrenIcollectChildrenSyns :: (Map Identifier Attributes )+ _childrenIerrors :: (Seq Error)+ _childrenIfields :: ([(Identifier,Type,Bool)])+ _childrenIgathAltAttrs :: ([AltAttr])+ _childrenIgathRules :: (Seq CRule)+ _childrenIinhs :: (Seq (Identifier,Attributes))+ _childrenInts :: (Seq (Identifier,NontermIdent))+ _childrenIsinglevisits :: ([CRule])+ _childrenIterminals :: ([Identifier])+ _rulesIadditionalDep :: (Seq Edge)+ _rulesIdirectDep :: (Seq Edge)+ _rulesIerrors :: (Seq Error)+ _rulesIgathAltAttrs :: ([AltAttr])+ _rulesIgathRules :: (Seq CRule)+ _rulesIinstDep :: (Seq Edge)+ _rulesIinstVars :: ([Identifier])+ _rulesIlocVars :: ([Identifier])+ _typeSigsItypeSigs :: (Map Identifier Type)+ -- "Order.ag"(line 69, column 16)+ _childrenOcon =+ con_+ -- "Order.ag"(line 71, column 16)+ _rulesOcon =+ con_+ -- "Order.ag"(line 148, column 18)+ _gathAltAttrs =+ [ AltAttr _LHS inh True | inh <- Map.keys _lhsIinh ]+ ++ _childrenIgathAltAttrs+ ++ _rulesIgathAltAttrs+ -- "Order.ag"(line 164, column 17)+ _rulesOaltAttrs =+ Map.fromList (zip _gathAltAttrs [_lhsIvcount..])+ -- "Order.ag"(line 177, column 18)+ _rulesOchildNts =+ Map.fromList (Seq.toList _childrenInts)+ -- "Order.ag"(line 178, column 19)+ _rulesOchildInhs =+ Map.fromList (Seq.toList _childrenIinhs)+ -- "Order.ag"(line 184, column 18)+ _inhRules =+ [ cRuleLhsInh inh _lhsInt con_ tp | (inh,tp) <- Map.assocs _lhsIinh ]+ -- "Order.ag"(line 185, column 19)+ _gathRules =+ _inhRules ++ Seq.toList (_childrenIgathRules Seq.<> _rulesIgathRules)+ -- "Order.ag"(line 239, column 18)+ _lhsOrules =+ Seq.fromList (zip [_lhsIvcount..] _gathRules)+ -- "Order.ag"(line 240, column 19)+ _lhsOvcount =+ _lhsIvcount + length _gathRules+ -- "Order.ag"(line 309, column 17)+ _rulesOsynsOfChildren =+ _childrenIcollectChildrenSyns+ -- "Order.ag"(line 384, column 18)+ _lhsOcons =+ [con_]+ -- "Order.ag"(line 391, column 16)+ _typeSigsOtypeSigs =+ Map.empty+ -- "Order.ag"(line 397, column 17)+ _rulesOallTypeSigs =+ _typeSigsItypeSigs+ -- "Order.ag"(line 463, column 17)+ _cVisits =+ if _lhsIo_dovisit+ then let prodsVisitsMap = findWithErr1 "Production.cVisits.nt" _lhsInt _lhsIcVisitsMap+ visits = findWithErr1 "Production.cVisits.con" con_ prodsVisitsMap+ in visits+ else let vss = nubBy eqCRuleDefines _gathRules ++ _childrenIsinglevisits+ in [CVisit _lhsIinh _lhsIsyn vss [] False]+ -- "Order.ag"(line 489, column 18)+ _lhsOcProduction =+ CProduction con_ _cVisits _childrenIfields _childrenIterminals+ -- "Order.ag"(line 513, column 16)+ _allfields =+ _childrenIfields+ -- "Order.ag"(line 513, column 16)+ _attrs =+ map ((,) _LOC) _rulesIlocVars +++ map ((,) _INST) _rulesIinstVars +++ map ((,) _LHS) _inhnames +++ concat [map ((,) nm) (Map.keys as) | (nm,_,as) <- _childrenIattributes]+ -- "Order.ag"(line 513, column 16)+ _inhnames =+ Map.keys _lhsIinh+ -- "Order.ag"(line 513, column 16)+ _synnames =+ Map.keys _lhsIsyn+ -- use rule "Order.ag"(line 259, column 71)+ _lhsOadditionalDep =+ _rulesIadditionalDep+ -- use rule "Order.ag"(line 245, column 33)+ _lhsOdirectDep =+ _rulesIdirectDep+ -- use rule "Order.ag"(line 60, column 70)+ _lhsOerrors =+ _childrenIerrors Seq.<> _rulesIerrors+ -- use rule "Order.ag"(line 292, column 31)+ _lhsOinstDep =+ _rulesIinstDep+ -- copy rule (from local)+ _childrenOallfields =+ _allfields+ -- copy rule (down)+ _childrenOallnts =+ _lhsIallnts+ -- copy rule (from local)+ _childrenOattrs =+ _attrs+ -- copy rule (down)+ _childrenOinh =+ _lhsIinh+ -- copy rule (down)+ _childrenOnt =+ _lhsInt+ -- copy rule (down)+ _childrenOo_unbox =+ _lhsIo_unbox+ -- copy rule (down)+ _childrenOsyn =+ _lhsIsyn+ -- copy rule (from local)+ _rulesOallfields =+ _allfields+ -- copy rule (down)+ _rulesOallnts =+ _lhsIallnts+ -- copy rule (from local)+ _rulesOattrs =+ _attrs+ -- copy rule (down)+ _rulesOinh =+ _lhsIinh+ -- copy rule (down)+ _rulesOmanualAttrDepMap =+ _lhsImanualAttrDepMap+ -- copy rule (down)+ _rulesOnt =+ _lhsInt+ -- copy rule (down)+ _rulesOo_case =+ _lhsIo_case+ -- copy rule (down)+ _rulesOo_cata =+ _lhsIo_cata+ -- copy rule (down)+ _rulesOo_dovisit =+ _lhsIo_dovisit+ -- copy rule (down)+ _rulesOo_newtypes =+ _lhsIo_newtypes+ -- copy rule (down)+ _rulesOo_rename =+ _lhsIo_rename+ -- copy rule (down)+ _rulesOo_sem =+ _lhsIo_sem+ -- copy rule (down)+ _rulesOo_sig =+ _lhsIo_sig+ -- copy rule (down)+ _rulesOo_wantvisit =+ _lhsIo_wantvisit+ -- copy rule (down)+ _rulesOprefix =+ _lhsIprefix+ -- copy rule (down)+ _rulesOsyn =+ _lhsIsyn+ ( _childrenIattributes,_childrenIcollectChildrenSyns,_childrenIerrors,_childrenIfields,_childrenIgathAltAttrs,_childrenIgathRules,_childrenIinhs,_childrenInts,_childrenIsinglevisits,_childrenIterminals) =+ (children_ _childrenOallfields _childrenOallnts _childrenOattrs _childrenOcon _childrenOinh _childrenOnt _childrenOo_unbox _childrenOsyn)+ ( _rulesIadditionalDep,_rulesIdirectDep,_rulesIerrors,_rulesIgathAltAttrs,_rulesIgathRules,_rulesIinstDep,_rulesIinstVars,_rulesIlocVars) =+ (rules_ _rulesOallTypeSigs _rulesOallfields _rulesOallnts _rulesOaltAttrs _rulesOattrs _rulesOchildInhs _rulesOchildNts _rulesOcon _rulesOinh _rulesOmanualAttrDepMap _rulesOnt _rulesOo_case _rulesOo_cata _rulesOo_dovisit _rulesOo_newtypes _rulesOo_rename _rulesOo_sem _rulesOo_sig _rulesOo_wantvisit _rulesOprefix _rulesOsyn _rulesOsynsOfChildren)+ ( _typeSigsItypeSigs) =+ (typeSigs_ _typeSigsOtypeSigs)+ in ( _lhsOadditionalDep,_lhsOcProduction,_lhsOcons,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOrules,_lhsOvcount))))+-- Productions -------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allnts : [Identifier]+ cVisitsMap : CVisitsMap+ inh : Attributes+ manualAttrDepMap : AttrOrderMap+ nt : Identifier+ o_case : Bool+ o_cata : Bool+ o_dovisit : Bool+ o_newtypes : Bool+ o_rename : Bool+ o_sem : Bool+ o_sig : Bool+ o_unbox : Bool+ o_wantvisit : Bool+ prefix : String+ syn : Attributes+ chained attribute:+ vcount : Int+ synthesized attributes:+ additionalDep : Seq Edge+ cProductions : CProductions+ cons : [ConstructorIdent]+ directDep : Seq Edge+ errors : Seq Error+ instDep : Seq Edge+ rules : Seq (Vertex,CRule)+ 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 (([Identifier]) ->+ CVisitsMap ->+ Attributes ->+ AttrOrderMap ->+ Identifier ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ String ->+ Attributes ->+ Int ->+ ( (Seq Edge),CProductions,([ConstructorIdent]),(Seq Edge),(Seq Error),(Seq Edge),(Seq (Vertex,CRule)),Int))+data Inh_Productions = Inh_Productions {allnts_Inh_Productions :: [Identifier],cVisitsMap_Inh_Productions :: CVisitsMap,inh_Inh_Productions :: Attributes,manualAttrDepMap_Inh_Productions :: AttrOrderMap,nt_Inh_Productions :: Identifier,o_case_Inh_Productions :: Bool,o_cata_Inh_Productions :: Bool,o_dovisit_Inh_Productions :: Bool,o_newtypes_Inh_Productions :: Bool,o_rename_Inh_Productions :: Bool,o_sem_Inh_Productions :: Bool,o_sig_Inh_Productions :: Bool,o_unbox_Inh_Productions :: Bool,o_wantvisit_Inh_Productions :: Bool,prefix_Inh_Productions :: String,syn_Inh_Productions :: Attributes,vcount_Inh_Productions :: Int}+data Syn_Productions = Syn_Productions {additionalDep_Syn_Productions :: Seq Edge,cProductions_Syn_Productions :: CProductions,cons_Syn_Productions :: [ConstructorIdent],directDep_Syn_Productions :: Seq Edge,errors_Syn_Productions :: Seq Error,instDep_Syn_Productions :: Seq Edge,rules_Syn_Productions :: Seq (Vertex,CRule),vcount_Syn_Productions :: Int}+wrap_Productions (T_Productions sem) (Inh_Productions _lhsIallnts _lhsIcVisitsMap _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIvcount) =+ (let ( _lhsOadditionalDep,_lhsOcProductions,_lhsOcons,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOrules,_lhsOvcount) =+ (sem _lhsIallnts _lhsIcVisitsMap _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIvcount)+ in (Syn_Productions _lhsOadditionalDep _lhsOcProductions _lhsOcons _lhsOdirectDep _lhsOerrors _lhsOinstDep _lhsOrules _lhsOvcount))+sem_Productions_Cons :: T_Production ->+ T_Productions ->+ T_Productions+sem_Productions_Cons (T_Production hd_) (T_Productions tl_) =+ (T_Productions (\ _lhsIallnts+ _lhsIcVisitsMap+ _lhsIinh+ _lhsImanualAttrDepMap+ _lhsInt+ _lhsIo_case+ _lhsIo_cata+ _lhsIo_dovisit+ _lhsIo_newtypes+ _lhsIo_rename+ _lhsIo_sem+ _lhsIo_sig+ _lhsIo_unbox+ _lhsIo_wantvisit+ _lhsIprefix+ _lhsIsyn+ _lhsIvcount ->+ (let _lhsOcProductions :: CProductions+ _lhsOadditionalDep :: (Seq Edge)+ _lhsOcons :: ([ConstructorIdent])+ _lhsOdirectDep :: (Seq Edge)+ _lhsOerrors :: (Seq Error)+ _lhsOinstDep :: (Seq Edge)+ _lhsOrules :: (Seq (Vertex,CRule))+ _lhsOvcount :: Int+ _hdOallnts :: ([Identifier])+ _hdOcVisitsMap :: CVisitsMap+ _hdOinh :: Attributes+ _hdOmanualAttrDepMap :: AttrOrderMap+ _hdOnt :: Identifier+ _hdOo_case :: Bool+ _hdOo_cata :: Bool+ _hdOo_dovisit :: Bool+ _hdOo_newtypes :: Bool+ _hdOo_rename :: Bool+ _hdOo_sem :: Bool+ _hdOo_sig :: Bool+ _hdOo_unbox :: Bool+ _hdOo_wantvisit :: Bool+ _hdOprefix :: String+ _hdOsyn :: Attributes+ _hdOvcount :: Int+ _tlOallnts :: ([Identifier])+ _tlOcVisitsMap :: CVisitsMap+ _tlOinh :: Attributes+ _tlOmanualAttrDepMap :: AttrOrderMap+ _tlOnt :: Identifier+ _tlOo_case :: Bool+ _tlOo_cata :: Bool+ _tlOo_dovisit :: Bool+ _tlOo_newtypes :: Bool+ _tlOo_rename :: Bool+ _tlOo_sem :: Bool+ _tlOo_sig :: Bool+ _tlOo_unbox :: Bool+ _tlOo_wantvisit :: Bool+ _tlOprefix :: String+ _tlOsyn :: Attributes+ _tlOvcount :: Int+ _hdIadditionalDep :: (Seq Edge)+ _hdIcProduction :: CProduction+ _hdIcons :: ([ConstructorIdent])+ _hdIdirectDep :: (Seq Edge)+ _hdIerrors :: (Seq Error)+ _hdIinstDep :: (Seq Edge)+ _hdIrules :: (Seq (Vertex,CRule))+ _hdIvcount :: Int+ _tlIadditionalDep :: (Seq Edge)+ _tlIcProductions :: CProductions+ _tlIcons :: ([ConstructorIdent])+ _tlIdirectDep :: (Seq Edge)+ _tlIerrors :: (Seq Error)+ _tlIinstDep :: (Seq Edge)+ _tlIrules :: (Seq (Vertex,CRule))+ _tlIvcount :: Int+ -- "Order.ag"(line 486, column 12)+ _lhsOcProductions =+ _hdIcProduction : _tlIcProductions+ -- use rule "Order.ag"(line 259, column 71)+ _lhsOadditionalDep =+ _hdIadditionalDep Seq.<> _tlIadditionalDep+ -- use rule "Order.ag"(line 382, column 40)+ _lhsOcons =+ _hdIcons ++ _tlIcons+ -- use rule "Order.ag"(line 245, column 33)+ _lhsOdirectDep =+ _hdIdirectDep Seq.<> _tlIdirectDep+ -- use rule "Order.ag"(line 60, column 70)+ _lhsOerrors =+ _hdIerrors Seq.<> _tlIerrors+ -- use rule "Order.ag"(line 292, column 31)+ _lhsOinstDep =+ _hdIinstDep Seq.<> _tlIinstDep+ -- use rule "Order.ag"(line 235, column 18)+ _lhsOrules =+ _hdIrules Seq.<> _tlIrules+ -- copy rule (up)+ _lhsOvcount =+ _tlIvcount+ -- copy rule (down)+ _hdOallnts =+ _lhsIallnts+ -- copy rule (down)+ _hdOcVisitsMap =+ _lhsIcVisitsMap+ -- copy rule (down)+ _hdOinh =+ _lhsIinh+ -- copy rule (down)+ _hdOmanualAttrDepMap =+ _lhsImanualAttrDepMap+ -- copy rule (down)+ _hdOnt =+ _lhsInt+ -- copy rule (down)+ _hdOo_case =+ _lhsIo_case+ -- copy rule (down)+ _hdOo_cata =+ _lhsIo_cata+ -- copy rule (down)+ _hdOo_dovisit =+ _lhsIo_dovisit+ -- copy rule (down)+ _hdOo_newtypes =+ _lhsIo_newtypes+ -- copy rule (down)+ _hdOo_rename =+ _lhsIo_rename+ -- copy rule (down)+ _hdOo_sem =+ _lhsIo_sem+ -- copy rule (down)+ _hdOo_sig =+ _lhsIo_sig+ -- copy rule (down)+ _hdOo_unbox =+ _lhsIo_unbox+ -- copy rule (down)+ _hdOo_wantvisit =+ _lhsIo_wantvisit+ -- copy rule (down)+ _hdOprefix =+ _lhsIprefix+ -- copy rule (down)+ _hdOsyn =+ _lhsIsyn+ -- copy rule (down)+ _hdOvcount =+ _lhsIvcount+ -- copy rule (down)+ _tlOallnts =+ _lhsIallnts+ -- copy rule (down)+ _tlOcVisitsMap =+ _lhsIcVisitsMap+ -- copy rule (down)+ _tlOinh =+ _lhsIinh+ -- copy rule (down)+ _tlOmanualAttrDepMap =+ _lhsImanualAttrDepMap+ -- copy rule (down)+ _tlOnt =+ _lhsInt+ -- copy rule (down)+ _tlOo_case =+ _lhsIo_case+ -- copy rule (down)+ _tlOo_cata =+ _lhsIo_cata+ -- copy rule (down)+ _tlOo_dovisit =+ _lhsIo_dovisit+ -- copy rule (down)+ _tlOo_newtypes =+ _lhsIo_newtypes+ -- copy rule (down)+ _tlOo_rename =+ _lhsIo_rename+ -- copy rule (down)+ _tlOo_sem =+ _lhsIo_sem+ -- copy rule (down)+ _tlOo_sig =+ _lhsIo_sig+ -- copy rule (down)+ _tlOo_unbox =+ _lhsIo_unbox+ -- copy rule (down)+ _tlOo_wantvisit =+ _lhsIo_wantvisit+ -- copy rule (down)+ _tlOprefix =+ _lhsIprefix+ -- copy rule (down)+ _tlOsyn =+ _lhsIsyn+ -- copy rule (chain)+ _tlOvcount =+ _hdIvcount+ ( _hdIadditionalDep,_hdIcProduction,_hdIcons,_hdIdirectDep,_hdIerrors,_hdIinstDep,_hdIrules,_hdIvcount) =+ (hd_ _hdOallnts _hdOcVisitsMap _hdOinh _hdOmanualAttrDepMap _hdOnt _hdOo_case _hdOo_cata _hdOo_dovisit _hdOo_newtypes _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_unbox _hdOo_wantvisit _hdOprefix _hdOsyn _hdOvcount)+ ( _tlIadditionalDep,_tlIcProductions,_tlIcons,_tlIdirectDep,_tlIerrors,_tlIinstDep,_tlIrules,_tlIvcount) =+ (tl_ _tlOallnts _tlOcVisitsMap _tlOinh _tlOmanualAttrDepMap _tlOnt _tlOo_case _tlOo_cata _tlOo_dovisit _tlOo_newtypes _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_unbox _tlOo_wantvisit _tlOprefix _tlOsyn _tlOvcount)+ in ( _lhsOadditionalDep,_lhsOcProductions,_lhsOcons,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOrules,_lhsOvcount))))+sem_Productions_Nil :: T_Productions+sem_Productions_Nil =+ (T_Productions (\ _lhsIallnts+ _lhsIcVisitsMap+ _lhsIinh+ _lhsImanualAttrDepMap+ _lhsInt+ _lhsIo_case+ _lhsIo_cata+ _lhsIo_dovisit+ _lhsIo_newtypes+ _lhsIo_rename+ _lhsIo_sem+ _lhsIo_sig+ _lhsIo_unbox+ _lhsIo_wantvisit+ _lhsIprefix+ _lhsIsyn+ _lhsIvcount ->+ (let _lhsOcProductions :: CProductions+ _lhsOadditionalDep :: (Seq Edge)+ _lhsOcons :: ([ConstructorIdent])+ _lhsOdirectDep :: (Seq Edge)+ _lhsOerrors :: (Seq Error)+ _lhsOinstDep :: (Seq Edge)+ _lhsOrules :: (Seq (Vertex,CRule))+ _lhsOvcount :: Int+ -- "Order.ag"(line 487, column 12)+ _lhsOcProductions =+ []+ -- use rule "Order.ag"(line 259, column 71)+ _lhsOadditionalDep =+ Seq.empty+ -- use rule "Order.ag"(line 382, column 40)+ _lhsOcons =+ []+ -- use rule "Order.ag"(line 245, column 33)+ _lhsOdirectDep =+ Seq.empty+ -- use rule "Order.ag"(line 60, column 70)+ _lhsOerrors =+ Seq.empty+ -- use rule "Order.ag"(line 292, column 31)+ _lhsOinstDep =+ Seq.empty+ -- use rule "Order.ag"(line 235, column 18)+ _lhsOrules =+ Seq.empty+ -- copy rule (chain)+ _lhsOvcount =+ _lhsIvcount+ in ( _lhsOadditionalDep,_lhsOcProductions,_lhsOcons,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOrules,_lhsOvcount))))+-- Rule --------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allTypeSigs : Map Identifier Type+ allfields : [(Identifier,Type,Bool)]+ allnts : [Identifier]+ altAttrs : Map AltAttr Vertex+ attrs : [(Identifier,Identifier)]+ childInhs : Map Identifier Attributes+ childNts : Map Identifier NontermIdent+ con : Identifier+ inh : Attributes+ manualAttrDepMap : AttrOrderMap+ nt : Identifier+ o_case : Bool+ o_cata : Bool+ o_dovisit : Bool+ o_newtypes : Bool+ o_rename : Bool+ o_sem : Bool+ o_sig : Bool+ o_wantvisit : Bool+ prefix : String+ syn : Attributes+ synsOfChildren : Map Identifier Attributes+ synthesized attributes:+ additionalDep : Seq Edge+ directDep : Seq Edge+ errors : Seq Error+ gathAltAttrs : [AltAttr]+ gathRules : Seq CRule+ instDep : Seq Edge+ instVars : [Identifier]+ locVars : [Identifier]+ alternatives:+ alternative Rule:+ child pattern : Pattern+ child rhs : Expression+ child owrt : {Bool}+ child origin : {String}+ visit 0:+ local defines : _+ local gathRules : _+ local manualDeps : _+-}+-- cata+sem_Rule :: Rule ->+ T_Rule+sem_Rule (Rule _pattern _rhs _owrt _origin) =+ (sem_Rule_Rule (sem_Pattern _pattern) (sem_Expression _rhs) _owrt _origin)+-- semantic domain+newtype T_Rule = T_Rule ((Map Identifier Type) ->+ ([(Identifier,Type,Bool)]) ->+ ([Identifier]) ->+ (Map AltAttr Vertex) ->+ ([(Identifier,Identifier)]) ->+ (Map Identifier Attributes) ->+ (Map Identifier NontermIdent) ->+ Identifier ->+ Attributes ->+ AttrOrderMap ->+ Identifier ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ String ->+ Attributes ->+ (Map Identifier Attributes) ->+ ( (Seq Edge),(Seq Edge),(Seq Error),([AltAttr]),(Seq CRule),(Seq Edge),([Identifier]),([Identifier])))+data Inh_Rule = Inh_Rule {allTypeSigs_Inh_Rule :: Map Identifier Type,allfields_Inh_Rule :: [(Identifier,Type,Bool)],allnts_Inh_Rule :: [Identifier],altAttrs_Inh_Rule :: Map AltAttr Vertex,attrs_Inh_Rule :: [(Identifier,Identifier)],childInhs_Inh_Rule :: Map Identifier Attributes,childNts_Inh_Rule :: Map Identifier NontermIdent,con_Inh_Rule :: Identifier,inh_Inh_Rule :: Attributes,manualAttrDepMap_Inh_Rule :: AttrOrderMap,nt_Inh_Rule :: Identifier,o_case_Inh_Rule :: Bool,o_cata_Inh_Rule :: Bool,o_dovisit_Inh_Rule :: Bool,o_newtypes_Inh_Rule :: Bool,o_rename_Inh_Rule :: Bool,o_sem_Inh_Rule :: Bool,o_sig_Inh_Rule :: Bool,o_wantvisit_Inh_Rule :: Bool,prefix_Inh_Rule :: String,syn_Inh_Rule :: Attributes,synsOfChildren_Inh_Rule :: Map Identifier Attributes}+data Syn_Rule = Syn_Rule {additionalDep_Syn_Rule :: Seq Edge,directDep_Syn_Rule :: Seq Edge,errors_Syn_Rule :: Seq Error,gathAltAttrs_Syn_Rule :: [AltAttr],gathRules_Syn_Rule :: Seq CRule,instDep_Syn_Rule :: Seq Edge,instVars_Syn_Rule :: [Identifier],locVars_Syn_Rule :: [Identifier]}+wrap_Rule (T_Rule sem) (Inh_Rule _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIsynsOfChildren) =+ (let ( _lhsOadditionalDep,_lhsOdirectDep,_lhsOerrors,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinstDep,_lhsOinstVars,_lhsOlocVars) =+ (sem _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIsynsOfChildren)+ in (Syn_Rule _lhsOadditionalDep _lhsOdirectDep _lhsOerrors _lhsOgathAltAttrs _lhsOgathRules _lhsOinstDep _lhsOinstVars _lhsOlocVars))+sem_Rule_Rule :: T_Pattern ->+ T_Expression ->+ Bool ->+ String ->+ T_Rule+sem_Rule_Rule (T_Pattern pattern_) (T_Expression rhs_) owrt_ origin_ =+ (T_Rule (\ _lhsIallTypeSigs+ _lhsIallfields+ _lhsIallnts+ _lhsIaltAttrs+ _lhsIattrs+ _lhsIchildInhs+ _lhsIchildNts+ _lhsIcon+ _lhsIinh+ _lhsImanualAttrDepMap+ _lhsInt+ _lhsIo_case+ _lhsIo_cata+ _lhsIo_dovisit+ _lhsIo_newtypes+ _lhsIo_rename+ _lhsIo_sem+ _lhsIo_sig+ _lhsIo_wantvisit+ _lhsIprefix+ _lhsIsyn+ _lhsIsynsOfChildren ->+ (let _lhsOdirectDep :: (Seq Edge)+ _lhsOadditionalDep :: (Seq Edge)+ _lhsOinstDep :: (Seq Edge)+ _lhsOerrors :: (Seq Error)+ _lhsOgathAltAttrs :: ([AltAttr])+ _lhsOgathRules :: (Seq CRule)+ _lhsOinstVars :: ([Identifier])+ _lhsOlocVars :: ([Identifier])+ _patternOallTypeSigs :: (Map Identifier Type)+ _patternOaltAttrs :: (Map AltAttr Vertex)+ _patternOcon :: Identifier+ _patternOinh :: Attributes+ _patternOnt :: Identifier+ _patternOsyn :: Attributes+ _rhsOallfields :: ([(Identifier,Type,Bool)])+ _rhsOallnts :: ([Identifier])+ _rhsOattrs :: ([(Identifier,Identifier)])+ _rhsOcon :: Identifier+ _rhsOnt :: Identifier+ _patternIcopy :: Pattern+ _patternIerrors :: (Seq Error)+ _patternIgathAltAttrs :: ([AltAttr])+ _patternIinstVars :: ([Identifier])+ _patternIlocVars :: ([Identifier])+ _patternIpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)])+ _rhsIallRhsVars :: (Set (Identifier,Identifier))+ _rhsIcopy :: Expression+ _rhsIerrors :: (Seq Error)+ _rhsItextLines :: ([String])+ _rhsIusedAttrs :: ([(Identifier,Identifier)])+ _rhsIusedFields :: ([Identifier])+ _rhsIusedLocals :: ([Identifier])+ -- "Order.ag"(line 193, column 12)+ _defines =+ let tp field attr parts | field == _LOC || field == _INST+ = case parts of+ [] -> Map.lookup attr _lhsIallTypeSigs+ _ -> (sequence (map typ parts)) >>= (haskellTupel . map (substSelf _lhsInt))+ | field == _LHS = Map.lookup attr _lhsIsyn+ | otherwise = Map.lookup attr (findWithErr1 "Rule.defines.tp" field _lhsIchildInhs)+ typ :: Pattern -> Maybe Type+ typ (Alias field attr _ parts) = tp field attr parts+ typ (Underscore _) = Nothing+ typ (Product _ pats) = tp _LOC undefined pats+ typ _ = Nothing+ in Map.fromList [ (findWithErr1 "Rule.defines" aa _lhsIaltAttrs, (field,attr,(tp field attr parts)))+ | (field,attr,isLocalOrInst,parts) <- _patternIpatternAttrs+ , let aa = AltAttr field attr isLocalOrInst+ ]+ -- "Order.ag"(line 209, column 12)+ _gathRules =+ let childnt field = Map.lookup field _lhsIchildNts+ in Seq.fromList [ CRule attr False True _lhsInt _lhsIcon field (childnt field) tp _patternIcopy _rhsItextLines _defines owrt_ origin_ _rhsIallRhsVars+ | (field,attr,tp) <- Map.elems _defines+ ]+ -- "Order.ag"(line 247, column 12)+ _lhsOdirectDep =+ let defined = Map.keys _defines+ used = [ Map.lookup (AltAttr field attr True) _lhsIaltAttrs | (field,attr) <- _rhsIusedAttrs]+ ++ [ Map.lookup (AltAttr _LOC attr True) _lhsIaltAttrs | attr <- _rhsIusedLocals ++ _rhsIusedFields ]+ in Seq.fromList [ (x,y) | Just x <- used, y <- defined ]+ -- "Order.ag"(line 265, column 7)+ _manualDeps =+ Set.toList $ Map.findWithDefault Set.empty _lhsIcon $ Map.findWithDefault Map.empty _lhsInt _lhsImanualAttrDepMap+ -- "Order.ag"(line 267, column 7)+ _lhsOadditionalDep =+ Seq.fromList [ (vertexA, vertexB)+ | Dependency (fldA,nmA) (fldB,nmB) <- _manualDeps+ , let vertexA = findWithErr2 (AltAttr fldA nmA True) _lhsIaltAttrs+ , vertexB <- lookupVertices fldB nmB _lhsIaltAttrs+ ]+ -- "Order.ag"(line 295, column 7)+ _lhsOinstDep =+ Seq.fromList $+ [ (instVert, synVert)+ | (field,instNm,_) <- Map.elems _defines+ , field == _INST+ , synNm <- Map.keys (findWithErr2 instNm _lhsIsynsOfChildren)+ , let instAttr = AltAttr _INST instNm True+ synAttr = AltAttr instNm synNm True+ instVert = findWithErr2 instAttr _lhsIaltAttrs+ synVert = findWithErr2 synAttr _lhsIaltAttrs+ ]+ -- use rule "Order.ag"(line 60, column 70)+ _lhsOerrors =+ _patternIerrors Seq.<> _rhsIerrors+ -- use rule "Order.ag"(line 146, column 68)+ _lhsOgathAltAttrs =+ _patternIgathAltAttrs+ -- use rule "Order.ag"(line 182, column 23)+ _lhsOgathRules =+ _gathRules+ -- use rule "Order.ag"(line 533, column 86)+ _lhsOinstVars =+ _patternIinstVars+ -- use rule "Order.ag"(line 533, column 48)+ _lhsOlocVars =+ _patternIlocVars+ -- copy rule (down)+ _patternOallTypeSigs =+ _lhsIallTypeSigs+ -- copy rule (down)+ _patternOaltAttrs =+ _lhsIaltAttrs+ -- copy rule (down)+ _patternOcon =+ _lhsIcon+ -- copy rule (down)+ _patternOinh =+ _lhsIinh+ -- copy rule (down)+ _patternOnt =+ _lhsInt+ -- copy rule (down)+ _patternOsyn =+ _lhsIsyn+ -- copy rule (down)+ _rhsOallfields =+ _lhsIallfields+ -- copy rule (down)+ _rhsOallnts =+ _lhsIallnts+ -- copy rule (down)+ _rhsOattrs =+ _lhsIattrs+ -- copy rule (down)+ _rhsOcon =+ _lhsIcon+ -- copy rule (down)+ _rhsOnt =+ _lhsInt+ ( _patternIcopy,_patternIerrors,_patternIgathAltAttrs,_patternIinstVars,_patternIlocVars,_patternIpatternAttrs) =+ (pattern_ _patternOallTypeSigs _patternOaltAttrs _patternOcon _patternOinh _patternOnt _patternOsyn)+ ( _rhsIallRhsVars,_rhsIcopy,_rhsIerrors,_rhsItextLines,_rhsIusedAttrs,_rhsIusedFields,_rhsIusedLocals) =+ (rhs_ _rhsOallfields _rhsOallnts _rhsOattrs _rhsOcon _rhsOnt)+ in ( _lhsOadditionalDep,_lhsOdirectDep,_lhsOerrors,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinstDep,_lhsOinstVars,_lhsOlocVars))))+-- Rules -------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allTypeSigs : Map Identifier Type+ allfields : [(Identifier,Type,Bool)]+ allnts : [Identifier]+ altAttrs : Map AltAttr Vertex+ attrs : [(Identifier,Identifier)]+ childInhs : Map Identifier Attributes+ childNts : Map Identifier NontermIdent+ con : Identifier+ inh : Attributes+ manualAttrDepMap : AttrOrderMap+ nt : Identifier+ o_case : Bool+ o_cata : Bool+ o_dovisit : Bool+ o_newtypes : Bool+ o_rename : Bool+ o_sem : Bool+ o_sig : Bool+ o_wantvisit : Bool+ prefix : String+ syn : Attributes+ synsOfChildren : Map Identifier Attributes+ synthesized attributes:+ additionalDep : Seq Edge+ directDep : Seq Edge+ errors : Seq Error+ gathAltAttrs : [AltAttr]+ gathRules : Seq CRule+ instDep : Seq Edge+ instVars : [Identifier]+ locVars : [Identifier]+ 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 ((Map Identifier Type) ->+ ([(Identifier,Type,Bool)]) ->+ ([Identifier]) ->+ (Map AltAttr Vertex) ->+ ([(Identifier,Identifier)]) ->+ (Map Identifier Attributes) ->+ (Map Identifier NontermIdent) ->+ Identifier ->+ Attributes ->+ AttrOrderMap ->+ Identifier ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ Bool ->+ String ->+ Attributes ->+ (Map Identifier Attributes) ->+ ( (Seq Edge),(Seq Edge),(Seq Error),([AltAttr]),(Seq CRule),(Seq Edge),([Identifier]),([Identifier])))+data Inh_Rules = Inh_Rules {allTypeSigs_Inh_Rules :: Map Identifier Type,allfields_Inh_Rules :: [(Identifier,Type,Bool)],allnts_Inh_Rules :: [Identifier],altAttrs_Inh_Rules :: Map AltAttr Vertex,attrs_Inh_Rules :: [(Identifier,Identifier)],childInhs_Inh_Rules :: Map Identifier Attributes,childNts_Inh_Rules :: Map Identifier NontermIdent,con_Inh_Rules :: Identifier,inh_Inh_Rules :: Attributes,manualAttrDepMap_Inh_Rules :: AttrOrderMap,nt_Inh_Rules :: Identifier,o_case_Inh_Rules :: Bool,o_cata_Inh_Rules :: Bool,o_dovisit_Inh_Rules :: Bool,o_newtypes_Inh_Rules :: Bool,o_rename_Inh_Rules :: Bool,o_sem_Inh_Rules :: Bool,o_sig_Inh_Rules :: Bool,o_wantvisit_Inh_Rules :: Bool,prefix_Inh_Rules :: String,syn_Inh_Rules :: Attributes,synsOfChildren_Inh_Rules :: Map Identifier Attributes}+data Syn_Rules = Syn_Rules {additionalDep_Syn_Rules :: Seq Edge,directDep_Syn_Rules :: Seq Edge,errors_Syn_Rules :: Seq Error,gathAltAttrs_Syn_Rules :: [AltAttr],gathRules_Syn_Rules :: Seq CRule,instDep_Syn_Rules :: Seq Edge,instVars_Syn_Rules :: [Identifier],locVars_Syn_Rules :: [Identifier]}+wrap_Rules (T_Rules sem) (Inh_Rules _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIsynsOfChildren) =+ (let ( _lhsOadditionalDep,_lhsOdirectDep,_lhsOerrors,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinstDep,_lhsOinstVars,_lhsOlocVars) =+ (sem _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIsynsOfChildren)+ in (Syn_Rules _lhsOadditionalDep _lhsOdirectDep _lhsOerrors _lhsOgathAltAttrs _lhsOgathRules _lhsOinstDep _lhsOinstVars _lhsOlocVars))+sem_Rules_Cons :: T_Rule ->+ T_Rules ->+ T_Rules+sem_Rules_Cons (T_Rule hd_) (T_Rules tl_) =+ (T_Rules (\ _lhsIallTypeSigs+ _lhsIallfields+ _lhsIallnts+ _lhsIaltAttrs+ _lhsIattrs+ _lhsIchildInhs+ _lhsIchildNts+ _lhsIcon+ _lhsIinh+ _lhsImanualAttrDepMap+ _lhsInt+ _lhsIo_case+ _lhsIo_cata+ _lhsIo_dovisit+ _lhsIo_newtypes+ _lhsIo_rename+ _lhsIo_sem+ _lhsIo_sig+ _lhsIo_wantvisit+ _lhsIprefix+ _lhsIsyn+ _lhsIsynsOfChildren ->+ (let _lhsOadditionalDep :: (Seq Edge)+ _lhsOdirectDep :: (Seq Edge)+ _lhsOerrors :: (Seq Error)+ _lhsOgathAltAttrs :: ([AltAttr])+ _lhsOgathRules :: (Seq CRule)+ _lhsOinstDep :: (Seq Edge)+ _lhsOinstVars :: ([Identifier])+ _lhsOlocVars :: ([Identifier])+ _hdOallTypeSigs :: (Map Identifier Type)+ _hdOallfields :: ([(Identifier,Type,Bool)])+ _hdOallnts :: ([Identifier])+ _hdOaltAttrs :: (Map AltAttr Vertex)+ _hdOattrs :: ([(Identifier,Identifier)])+ _hdOchildInhs :: (Map Identifier Attributes)+ _hdOchildNts :: (Map Identifier NontermIdent)+ _hdOcon :: Identifier+ _hdOinh :: Attributes+ _hdOmanualAttrDepMap :: AttrOrderMap+ _hdOnt :: Identifier+ _hdOo_case :: Bool+ _hdOo_cata :: Bool+ _hdOo_dovisit :: Bool+ _hdOo_newtypes :: Bool+ _hdOo_rename :: Bool+ _hdOo_sem :: Bool+ _hdOo_sig :: Bool+ _hdOo_wantvisit :: Bool+ _hdOprefix :: String+ _hdOsyn :: Attributes+ _hdOsynsOfChildren :: (Map Identifier Attributes)+ _tlOallTypeSigs :: (Map Identifier Type)+ _tlOallfields :: ([(Identifier,Type,Bool)])+ _tlOallnts :: ([Identifier])+ _tlOaltAttrs :: (Map AltAttr Vertex)+ _tlOattrs :: ([(Identifier,Identifier)])+ _tlOchildInhs :: (Map Identifier Attributes)+ _tlOchildNts :: (Map Identifier NontermIdent)+ _tlOcon :: Identifier+ _tlOinh :: Attributes+ _tlOmanualAttrDepMap :: AttrOrderMap+ _tlOnt :: Identifier+ _tlOo_case :: Bool+ _tlOo_cata :: Bool+ _tlOo_dovisit :: Bool+ _tlOo_newtypes :: Bool+ _tlOo_rename :: Bool+ _tlOo_sem :: Bool+ _tlOo_sig :: Bool+ _tlOo_wantvisit :: Bool+ _tlOprefix :: String+ _tlOsyn :: Attributes+ _tlOsynsOfChildren :: (Map Identifier Attributes)+ _hdIadditionalDep :: (Seq Edge)+ _hdIdirectDep :: (Seq Edge)+ _hdIerrors :: (Seq Error)+ _hdIgathAltAttrs :: ([AltAttr])+ _hdIgathRules :: (Seq CRule)+ _hdIinstDep :: (Seq Edge)+ _hdIinstVars :: ([Identifier])+ _hdIlocVars :: ([Identifier])+ _tlIadditionalDep :: (Seq Edge)+ _tlIdirectDep :: (Seq Edge)+ _tlIerrors :: (Seq Error)+ _tlIgathAltAttrs :: ([AltAttr])+ _tlIgathRules :: (Seq CRule)+ _tlIinstDep :: (Seq Edge)+ _tlIinstVars :: ([Identifier])+ _tlIlocVars :: ([Identifier])+ -- use rule "Order.ag"(line 259, column 71)+ _lhsOadditionalDep =+ _hdIadditionalDep Seq.<> _tlIadditionalDep+ -- use rule "Order.ag"(line 245, column 33)+ _lhsOdirectDep =+ _hdIdirectDep Seq.<> _tlIdirectDep+ -- use rule "Order.ag"(line 60, column 70)+ _lhsOerrors =+ _hdIerrors Seq.<> _tlIerrors+ -- use rule "Order.ag"(line 146, column 68)+ _lhsOgathAltAttrs =+ _hdIgathAltAttrs ++ _tlIgathAltAttrs+ -- use rule "Order.ag"(line 182, column 23)+ _lhsOgathRules =+ _hdIgathRules Seq.<> _tlIgathRules+ -- use rule "Order.ag"(line 292, column 31)+ _lhsOinstDep =+ _hdIinstDep Seq.<> _tlIinstDep+ -- use rule "Order.ag"(line 533, column 86)+ _lhsOinstVars =+ _hdIinstVars ++ _tlIinstVars+ -- use rule "Order.ag"(line 533, column 48)+ _lhsOlocVars =+ _hdIlocVars ++ _tlIlocVars+ -- copy rule (down)+ _hdOallTypeSigs =+ _lhsIallTypeSigs+ -- copy rule (down)+ _hdOallfields =+ _lhsIallfields+ -- copy rule (down)+ _hdOallnts =+ _lhsIallnts+ -- copy rule (down)+ _hdOaltAttrs =+ _lhsIaltAttrs+ -- copy rule (down)+ _hdOattrs =+ _lhsIattrs+ -- copy rule (down)+ _hdOchildInhs =+ _lhsIchildInhs+ -- copy rule (down)+ _hdOchildNts =+ _lhsIchildNts+ -- copy rule (down)+ _hdOcon =+ _lhsIcon+ -- copy rule (down)+ _hdOinh =+ _lhsIinh+ -- copy rule (down)+ _hdOmanualAttrDepMap =+ _lhsImanualAttrDepMap+ -- copy rule (down)+ _hdOnt =+ _lhsInt+ -- copy rule (down)+ _hdOo_case =+ _lhsIo_case+ -- copy rule (down)+ _hdOo_cata =+ _lhsIo_cata+ -- copy rule (down)+ _hdOo_dovisit =+ _lhsIo_dovisit+ -- copy rule (down)+ _hdOo_newtypes =+ _lhsIo_newtypes+ -- copy rule (down)+ _hdOo_rename =+ _lhsIo_rename+ -- copy rule (down)+ _hdOo_sem =+ _lhsIo_sem+ -- copy rule (down)+ _hdOo_sig =+ _lhsIo_sig+ -- copy rule (down)+ _hdOo_wantvisit =+ _lhsIo_wantvisit+ -- copy rule (down)+ _hdOprefix =+ _lhsIprefix+ -- copy rule (down)+ _hdOsyn =+ _lhsIsyn+ -- copy rule (down)+ _hdOsynsOfChildren =+ _lhsIsynsOfChildren+ -- copy rule (down)+ _tlOallTypeSigs =+ _lhsIallTypeSigs+ -- copy rule (down)+ _tlOallfields =+ _lhsIallfields+ -- copy rule (down)+ _tlOallnts =+ _lhsIallnts+ -- copy rule (down)+ _tlOaltAttrs =+ _lhsIaltAttrs+ -- copy rule (down)+ _tlOattrs =+ _lhsIattrs+ -- copy rule (down)+ _tlOchildInhs =+ _lhsIchildInhs+ -- copy rule (down)+ _tlOchildNts =+ _lhsIchildNts+ -- copy rule (down)+ _tlOcon =+ _lhsIcon+ -- copy rule (down)+ _tlOinh =+ _lhsIinh+ -- copy rule (down)+ _tlOmanualAttrDepMap =+ _lhsImanualAttrDepMap+ -- copy rule (down)+ _tlOnt =+ _lhsInt+ -- copy rule (down)+ _tlOo_case =+ _lhsIo_case+ -- copy rule (down)+ _tlOo_cata =+ _lhsIo_cata+ -- copy rule (down)+ _tlOo_dovisit =+ _lhsIo_dovisit+ -- copy rule (down)+ _tlOo_newtypes =+ _lhsIo_newtypes+ -- copy rule (down)+ _tlOo_rename =+ _lhsIo_rename+ -- copy rule (down)+ _tlOo_sem =+ _lhsIo_sem+ -- copy rule (down)+ _tlOo_sig =+ _lhsIo_sig+ -- copy rule (down)+ _tlOo_wantvisit =+ _lhsIo_wantvisit+ -- copy rule (down)+ _tlOprefix =+ _lhsIprefix+ -- copy rule (down)+ _tlOsyn =+ _lhsIsyn+ -- copy rule (down)+ _tlOsynsOfChildren =+ _lhsIsynsOfChildren+ ( _hdIadditionalDep,_hdIdirectDep,_hdIerrors,_hdIgathAltAttrs,_hdIgathRules,_hdIinstDep,_hdIinstVars,_hdIlocVars) =+ (hd_ _hdOallTypeSigs _hdOallfields _hdOallnts _hdOaltAttrs _hdOattrs _hdOchildInhs _hdOchildNts _hdOcon _hdOinh _hdOmanualAttrDepMap _hdOnt _hdOo_case _hdOo_cata _hdOo_dovisit _hdOo_newtypes _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_wantvisit _hdOprefix _hdOsyn _hdOsynsOfChildren)+ ( _tlIadditionalDep,_tlIdirectDep,_tlIerrors,_tlIgathAltAttrs,_tlIgathRules,_tlIinstDep,_tlIinstVars,_tlIlocVars) =+ (tl_ _tlOallTypeSigs _tlOallfields _tlOallnts _tlOaltAttrs _tlOattrs _tlOchildInhs _tlOchildNts _tlOcon _tlOinh _tlOmanualAttrDepMap _tlOnt _tlOo_case _tlOo_cata _tlOo_dovisit _tlOo_newtypes _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_wantvisit _tlOprefix _tlOsyn _tlOsynsOfChildren)+ in ( _lhsOadditionalDep,_lhsOdirectDep,_lhsOerrors,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinstDep,_lhsOinstVars,_lhsOlocVars))))+sem_Rules_Nil :: T_Rules+sem_Rules_Nil =+ (T_Rules (\ _lhsIallTypeSigs+ _lhsIallfields+ _lhsIallnts+ _lhsIaltAttrs+ _lhsIattrs+ _lhsIchildInhs+ _lhsIchildNts+ _lhsIcon+ _lhsIinh+ _lhsImanualAttrDepMap+ _lhsInt+ _lhsIo_case+ _lhsIo_cata+ _lhsIo_dovisit+ _lhsIo_newtypes+ _lhsIo_rename+ _lhsIo_sem+ _lhsIo_sig+ _lhsIo_wantvisit+ _lhsIprefix+ _lhsIsyn+ _lhsIsynsOfChildren ->+ (let _lhsOadditionalDep :: (Seq Edge)+ _lhsOdirectDep :: (Seq Edge)+ _lhsOerrors :: (Seq Error)+ _lhsOgathAltAttrs :: ([AltAttr])+ _lhsOgathRules :: (Seq CRule)+ _lhsOinstDep :: (Seq Edge)+ _lhsOinstVars :: ([Identifier])+ _lhsOlocVars :: ([Identifier])+ -- use rule "Order.ag"(line 259, column 71)+ _lhsOadditionalDep =+ Seq.empty+ -- use rule "Order.ag"(line 245, column 33)+ _lhsOdirectDep =+ Seq.empty+ -- use rule "Order.ag"(line 60, column 70)+ _lhsOerrors =+ Seq.empty+ -- use rule "Order.ag"(line 146, column 68)+ _lhsOgathAltAttrs =+ []+ -- use rule "Order.ag"(line 182, column 23)+ _lhsOgathRules =+ Seq.empty+ -- use rule "Order.ag"(line 292, column 31)+ _lhsOinstDep =+ Seq.empty+ -- use rule "Order.ag"(line 533, column 86)+ _lhsOinstVars =+ []+ -- use rule "Order.ag"(line 533, column 48)+ _lhsOlocVars =+ []+ in ( _lhsOadditionalDep,_lhsOdirectDep,_lhsOerrors,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinstDep,_lhsOinstVars,_lhsOlocVars))))+-- TypeSig -----------------------------------------------------+{-+ visit 0:+ chained attribute:+ typeSigs : Map Identifier Type+ 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 ((Map Identifier Type) ->+ ( (Map Identifier Type)))+data Inh_TypeSig = Inh_TypeSig {typeSigs_Inh_TypeSig :: Map Identifier Type}+data Syn_TypeSig = Syn_TypeSig {typeSigs_Syn_TypeSig :: Map Identifier Type}+wrap_TypeSig (T_TypeSig sem) (Inh_TypeSig _lhsItypeSigs) =+ (let ( _lhsOtypeSigs) =+ (sem _lhsItypeSigs)+ in (Syn_TypeSig _lhsOtypeSigs))+sem_TypeSig_TypeSig :: Identifier ->+ Type ->+ T_TypeSig+sem_TypeSig_TypeSig name_ tp_ =+ (T_TypeSig (\ _lhsItypeSigs ->+ (let _lhsOtypeSigs :: (Map Identifier Type)+ -- "Order.ag"(line 393, column 13)+ _lhsOtypeSigs =+ Map.insert name_ tp_ _lhsItypeSigs+ in ( _lhsOtypeSigs))))+-- TypeSigs ----------------------------------------------------+{-+ visit 0:+ chained attribute:+ typeSigs : Map Identifier Type+ 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 ((Map Identifier Type) ->+ ( (Map Identifier Type)))+data Inh_TypeSigs = Inh_TypeSigs {typeSigs_Inh_TypeSigs :: Map Identifier Type}+data Syn_TypeSigs = Syn_TypeSigs {typeSigs_Syn_TypeSigs :: Map Identifier Type}+wrap_TypeSigs (T_TypeSigs sem) (Inh_TypeSigs _lhsItypeSigs) =+ (let ( _lhsOtypeSigs) =+ (sem _lhsItypeSigs)+ in (Syn_TypeSigs _lhsOtypeSigs))+sem_TypeSigs_Cons :: T_TypeSig ->+ T_TypeSigs ->+ T_TypeSigs+sem_TypeSigs_Cons (T_TypeSig hd_) (T_TypeSigs tl_) =+ (T_TypeSigs (\ _lhsItypeSigs ->+ (let _lhsOtypeSigs :: (Map Identifier Type)+ _hdOtypeSigs :: (Map Identifier Type)+ _tlOtypeSigs :: (Map Identifier Type)+ _hdItypeSigs :: (Map Identifier Type)+ _tlItypeSigs :: (Map Identifier Type)+ -- copy rule (up)+ _lhsOtypeSigs =+ _tlItypeSigs+ -- copy rule (down)+ _hdOtypeSigs =+ _lhsItypeSigs+ -- copy rule (chain)+ _tlOtypeSigs =+ _hdItypeSigs+ ( _hdItypeSigs) =+ (hd_ _hdOtypeSigs)+ ( _tlItypeSigs) =+ (tl_ _tlOtypeSigs)+ in ( _lhsOtypeSigs))))+sem_TypeSigs_Nil :: T_TypeSigs+sem_TypeSigs_Nil =+ (T_TypeSigs (\ _lhsItypeSigs ->+ (let _lhsOtypeSigs :: (Map Identifier Type)+ -- copy rule (chain)+ _lhsOtypeSigs =+ _lhsItypeSigs+ in ( _lhsOtypeSigs))))
src-derived/Patterns.hs view
@@ -1,10 +1,9 @@- -- UUAGC 0.9.5 (Patterns.ag) module Patterns where -- Patterns.ag imports import UU.Scanner.Position(Pos)-import CommonTypes (Constructor,Name)+import CommonTypes (ConstructorIdent,Identifier) -- Pattern ----------------------------------------------------- {- visit 0:@@ -12,17 +11,21 @@ copy : SELF alternatives: alternative Alias:- child field : {Name}- child attr : {Name}+ child field : {Identifier}+ child attr : {Identifier} child pat : Pattern child parts : Patterns visit 0: local copy : _ alternative Constr:- child name : {Constructor}+ 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@@ -33,10 +36,11 @@ visit 0: local copy : _ -}-data Pattern = Alias (Name) (Name) (Pattern) (Patterns) - | Constr (Constructor) (Patterns) - | Product (Pos) (Patterns) - | Underscore (Pos) +data Pattern = Alias (Identifier) (Identifier) (Pattern) (Patterns)+ | Constr (ConstructorIdent) (Patterns)+ | Irrefutable (Pattern)+ | Product (Pos) (Patterns)+ | Underscore (Pos) deriving ( Show) -- Patterns ---------------------------------------------------- {-
src-derived/PrintCode.hs view
@@ -1,2620 +1,2858 @@---- UUAGC 0.9.5 (PrintCode.ag)-module PrintCode where--import Char (isAlphaNum)-import Pretty-import Code-import Patterns-import Options-import CommonTypes (attrname, _LOC, getName, nullIdent)-import Data.List(intersperse)-import System.IO-import System.Directory--import Pretty-import Patterns-import Data.List(partition)-import Data.Set(Set)-import qualified UU.DData.Set as Set-import Data.Map(Map)-import qualified Data.Map as Map---- Patterns.ag imports-import UU.Scanner.Position(Pos)-import CommonTypes (Constructor,Name)--type PP_Docs = [PP_Doc]--ppMultiSeqH :: [PP_Doc] -> PP_Doc -> PP_Doc-ppMultiSeqH = ppMultiSeq' (>#<)--ppMultiSeqV :: [PP_Doc] -> PP_Doc -> PP_Doc-ppMultiSeqV = ppMultiSeq' (>-<)--ppMultiSeq' :: (PP_Doc -> PP_Doc -> PP_Doc) -> [PP_Doc] -> PP_Doc -> PP_Doc-ppMultiSeq' next strictArgs expr- = foldr (\v r -> (v >#< "`seq`") `next` pp_parens r) expr strictArgs---reallySimple :: String -> Bool-reallySimple = and . map (\x -> isAlphaNum x || x=='_')--ppTuple True pps = "(" >|< pp_block " " (replicate (length pps `max` 1) ')') ",(" pps-ppTuple False pps = "(" >|< pp_block " " ")" "," pps-ppUnboxedTuple True pps = "(# " >|< pp_block " " (concat $ replicate (length pps `max` 1) " #)") ",(# " pps-ppUnboxedTuple False pps = "(# " >|< pp_block " " " #)" "," pps---locname' n = "_loc_" ++ getName n--renderDocs :: [PP_Doc] -> String-renderDocs pps = foldr (.) id (map (\d -> (disp d 50000) . ( '\n':) ) pps) ""--writeModule :: FilePath -> [PP_Doc] -> IO ()-writeModule path docs- = do bExists <- doesFileExist path- if bExists- then do input <- readFile path- seq (length input) (return ())- if input /= output- then dumpIt- else return ()- else dumpIt- where- output = renderDocs docs- dumpIt = writeFile path output---- Unboxed tuples--- unbox Whether unboxed tuples are wanted or not--- inh The inherited attributes. --- If there are none, no unboxing can take place, --- because in that case the semantic function (a top-level identifier) would have an unboxed type.--- Of course we can't have an unboxed 1-tuple-mkTupleExpr :: Bool -> Bool -> Exprs -> Expr-mkTupleExpr unbox noInh exprs | not unbox || noInh || length exprs == 1 = TupleExpr exprs- | otherwise = UnboxedTupleExpr exprs-mkTupleType :: Bool -> Bool -> Types -> Type-mkTupleType unbox noInh tps | not unbox || noInh || length tps == 1 = TupleType tps- | otherwise = UnboxedTupleType tps-mkTupleLhs :: Bool -> Bool -> [String] -> Lhs-mkTupleLhs unbox noInh comps | not unbox || noInh || length comps == 1 = TupleLhs comps- | otherwise = UnboxedTupleLhs comps--- CaseAlt ------------------------------------------------------{-- visit 0:- inherited attributes:- nested : Bool- options : Options- outputfile : String- synthesized attribute:- pps : PP_Docs- alternatives:- alternative CaseAlt:- child left : Lhs- child expr : Expr--}--- cata-sem_CaseAlt :: CaseAlt ->- T_CaseAlt-sem_CaseAlt (CaseAlt _left _expr ) =- (sem_CaseAlt_CaseAlt (sem_Lhs _left ) (sem_Expr _expr ) )--- semantic domain-newtype T_CaseAlt = T_CaseAlt (Bool ->- Options ->- String ->- ( PP_Docs))-data Inh_CaseAlt = Inh_CaseAlt {nested_Inh_CaseAlt :: Bool,options_Inh_CaseAlt :: Options,outputfile_Inh_CaseAlt :: String}-data Syn_CaseAlt = Syn_CaseAlt {pps_Syn_CaseAlt :: PP_Docs}-wrap_CaseAlt (T_CaseAlt sem ) (Inh_CaseAlt _lhsInested _lhsIoptions _lhsIoutputfile ) =- (let ( _lhsOpps) =- (sem _lhsInested _lhsIoptions _lhsIoutputfile )- in (Syn_CaseAlt _lhsOpps ))-sem_CaseAlt_CaseAlt :: T_Lhs ->- T_Expr ->- T_CaseAlt-sem_CaseAlt_CaseAlt (T_Lhs left_ ) (T_Expr expr_ ) =- (T_CaseAlt (\ _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpps :: PP_Docs- _leftOisDeclOfLet :: Bool- _leftOnested :: Bool- _leftOoptions :: Options- _leftOoutputfile :: String- _exprOnested :: Bool- _exprOoptions :: Options- _exprOoutputfile :: String- _leftIpp :: PP_Doc- _exprIpp :: PP_Doc- -- "PrintCode.ag"(line 149, column 16)- _lhsOpps =- ["{" >#< _leftIpp >#< "->", _exprIpp >#< "}"]- -- "PrintCode.ag"(line 303, column 7)- _leftOisDeclOfLet =- False- -- copy rule (down)- _leftOnested =- _lhsInested- -- copy rule (down)- _leftOoptions =- _lhsIoptions- -- copy rule (down)- _leftOoutputfile =- _lhsIoutputfile- -- copy rule (down)- _exprOnested =- _lhsInested- -- copy rule (down)- _exprOoptions =- _lhsIoptions- -- copy rule (down)- _exprOoutputfile =- _lhsIoutputfile- ( _leftIpp) =- (left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile )- ( _exprIpp) =- (expr_ _exprOnested _exprOoptions _exprOoutputfile )- in ( _lhsOpps))) )--- CaseAlts -----------------------------------------------------{-- visit 0:- inherited attributes:- nested : Bool- options : Options- outputfile : String- synthesized attribute:- pps : PP_Docs- alternatives:- alternative Cons:- child hd : CaseAlt- child tl : CaseAlts- alternative Nil:--}--- cata-sem_CaseAlts :: CaseAlts ->- T_CaseAlts-sem_CaseAlts list =- (Prelude.foldr sem_CaseAlts_Cons sem_CaseAlts_Nil (Prelude.map sem_CaseAlt list) )--- semantic domain-newtype T_CaseAlts = T_CaseAlts (Bool ->- Options ->- String ->- ( PP_Docs))-data Inh_CaseAlts = Inh_CaseAlts {nested_Inh_CaseAlts :: Bool,options_Inh_CaseAlts :: Options,outputfile_Inh_CaseAlts :: String}-data Syn_CaseAlts = Syn_CaseAlts {pps_Syn_CaseAlts :: PP_Docs}-wrap_CaseAlts (T_CaseAlts sem ) (Inh_CaseAlts _lhsInested _lhsIoptions _lhsIoutputfile ) =- (let ( _lhsOpps) =- (sem _lhsInested _lhsIoptions _lhsIoutputfile )- in (Syn_CaseAlts _lhsOpps ))-sem_CaseAlts_Cons :: T_CaseAlt ->- T_CaseAlts ->- T_CaseAlts-sem_CaseAlts_Cons (T_CaseAlt hd_ ) (T_CaseAlts tl_ ) =- (T_CaseAlts (\ _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpps :: PP_Docs- _hdOnested :: Bool- _hdOoptions :: Options- _hdOoutputfile :: String- _tlOnested :: Bool- _tlOoptions :: Options- _tlOoutputfile :: String- _hdIpps :: PP_Docs- _tlIpps :: PP_Docs- -- "PrintCode.ag"(line 59, column 10)- _lhsOpps =- _hdIpps ++ _tlIpps- -- copy rule (down)- _hdOnested =- _lhsInested- -- copy rule (down)- _hdOoptions =- _lhsIoptions- -- copy rule (down)- _hdOoutputfile =- _lhsIoutputfile- -- copy rule (down)- _tlOnested =- _lhsInested- -- copy rule (down)- _tlOoptions =- _lhsIoptions- -- copy rule (down)- _tlOoutputfile =- _lhsIoutputfile- ( _hdIpps) =- (hd_ _hdOnested _hdOoptions _hdOoutputfile )- ( _tlIpps) =- (tl_ _tlOnested _tlOoptions _tlOoutputfile )- in ( _lhsOpps))) )-sem_CaseAlts_Nil :: T_CaseAlts-sem_CaseAlts_Nil =- (T_CaseAlts (\ _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpps :: PP_Docs- -- "PrintCode.ag"(line 60, column 10)- _lhsOpps =- []- in ( _lhsOpps))) )--- Chunk --------------------------------------------------------{-- visit 0:- inherited attributes:- importBlocks : PP_Doc- isDeclOfLet : Bool- mainFile : String- mainName : String- moduleHeader : String -> String -> String -> Bool -> String- nested : Bool- options : Options- optionsLine : String- pragmaBlocks : String- textBlocks : PP_Doc- synthesized attributes:- appendCommon : [[PP_Doc]]- appendMain : [[PP_Doc]]- genSems : IO ()- imports : [String]- pps : PP_Docs- alternatives:- alternative Chunk:- child name : {String}- child comment : Decl- child info : Decls- child dataDef : Decls- child cataFun : Decls- child semDom : Decls- child semWrapper : Decls- child semFunctions : Decls- child semNames : {[String]}- visit 0:- local outputfile : _- local exports : _--}--- cata-sem_Chunk :: Chunk ->- T_Chunk-sem_Chunk (Chunk _name _comment _info _dataDef _cataFun _semDom _semWrapper _semFunctions _semNames ) =- (sem_Chunk_Chunk _name (sem_Decl _comment ) (sem_Decls _info ) (sem_Decls _dataDef ) (sem_Decls _cataFun ) (sem_Decls _semDom ) (sem_Decls _semWrapper ) (sem_Decls _semFunctions ) _semNames )--- semantic domain-newtype T_Chunk = T_Chunk (PP_Doc ->- Bool ->- String ->- String ->- (String -> String -> String -> Bool -> String) ->- Bool ->- Options ->- String ->- String ->- PP_Doc ->- ( ([[PP_Doc]]),([[PP_Doc]]),(IO ()),([String]),PP_Docs))-data Inh_Chunk = Inh_Chunk {importBlocks_Inh_Chunk :: PP_Doc,isDeclOfLet_Inh_Chunk :: Bool,mainFile_Inh_Chunk :: String,mainName_Inh_Chunk :: String,moduleHeader_Inh_Chunk :: String -> String -> String -> Bool -> String,nested_Inh_Chunk :: Bool,options_Inh_Chunk :: Options,optionsLine_Inh_Chunk :: String,pragmaBlocks_Inh_Chunk :: String,textBlocks_Inh_Chunk :: PP_Doc}-data Syn_Chunk = Syn_Chunk {appendCommon_Syn_Chunk :: [[PP_Doc]],appendMain_Syn_Chunk :: [[PP_Doc]],genSems_Syn_Chunk :: IO (),imports_Syn_Chunk :: [String],pps_Syn_Chunk :: PP_Docs}-wrap_Chunk (T_Chunk sem ) (Inh_Chunk _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks ) =- (let ( _lhsOappendCommon,_lhsOappendMain,_lhsOgenSems,_lhsOimports,_lhsOpps) =- (sem _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks )- in (Syn_Chunk _lhsOappendCommon _lhsOappendMain _lhsOgenSems _lhsOimports _lhsOpps ))-sem_Chunk_Chunk :: String ->- T_Decl ->- T_Decls ->- T_Decls ->- T_Decls ->- T_Decls ->- T_Decls ->- T_Decls ->- ([String]) ->- T_Chunk-sem_Chunk_Chunk name_ (T_Decl comment_ ) (T_Decls info_ ) (T_Decls dataDef_ ) (T_Decls cataFun_ ) (T_Decls semDom_ ) (T_Decls semWrapper_ ) (T_Decls semFunctions_ ) semNames_ =- (T_Chunk (\ _lhsIimportBlocks- _lhsIisDeclOfLet- _lhsImainFile- _lhsImainName- _lhsImoduleHeader- _lhsInested- _lhsIoptions- _lhsIoptionsLine- _lhsIpragmaBlocks- _lhsItextBlocks ->- (let _lhsOpps :: PP_Docs- _lhsOimports :: ([String])- _lhsOappendCommon :: ([[PP_Doc]])- _lhsOappendMain :: ([[PP_Doc]])- _lhsOgenSems :: (IO ())- _commentOisDeclOfLet :: Bool- _commentOnested :: Bool- _commentOoptions :: Options- _commentOoutputfile :: String- _infoOisDeclOfLet :: Bool- _infoOnested :: Bool- _infoOoptions :: Options- _infoOoutputfile :: String- _dataDefOisDeclOfLet :: Bool- _dataDefOnested :: Bool- _dataDefOoptions :: Options- _dataDefOoutputfile :: String- _cataFunOisDeclOfLet :: Bool- _cataFunOnested :: Bool- _cataFunOoptions :: Options- _cataFunOoutputfile :: String- _semDomOisDeclOfLet :: Bool- _semDomOnested :: Bool- _semDomOoptions :: Options- _semDomOoutputfile :: String- _semWrapperOisDeclOfLet :: Bool- _semWrapperOnested :: Bool- _semWrapperOoptions :: Options- _semWrapperOoutputfile :: String- _semFunctionsOisDeclOfLet :: Bool- _semFunctionsOnested :: Bool- _semFunctionsOoptions :: Options- _semFunctionsOoutputfile :: String- _commentIpp :: PP_Doc- _infoIpps :: PP_Docs- _dataDefIpps :: PP_Docs- _cataFunIpps :: PP_Docs- _semDomIpps :: PP_Docs- _semWrapperIpps :: PP_Docs- _semFunctionsIpps :: PP_Docs- -- "PrintCode.ag"(line 37, column 7)- _outputfile =- if sepSemMods _lhsIoptions- then _lhsImainFile ++ "_" ++ name_ ++ ".hs"- else _lhsImainFile ++ ".hs"- -- "PrintCode.ag"(line 83, column 16)- _lhsOpps =- _commentIpp- : _infoIpps- ++ _dataDefIpps- ++ _cataFunIpps- ++ _semDomIpps- ++ _semWrapperIpps- ++ _semFunctionsIpps- -- "PrintCode.ag"(line 360, column 7)- _lhsOimports =- ["import " ++ _lhsImainName ++ "_" ++ name_ ++ "\n"]- -- "PrintCode.ag"(line 366, column 7)- _lhsOappendCommon =- [ [_commentIpp]- , _dataDefIpps- , _semDomIpps- ]- -- "PrintCode.ag"(line 371, column 7)- _lhsOappendMain =- [ [_commentIpp]- , _cataFunIpps- , _semWrapperIpps- ]- -- "PrintCode.ag"(line 381, column 7)- _lhsOgenSems =- writeModule _outputfile- [ pp $ _lhsIpragmaBlocks- , pp $ _lhsIoptionsLine- , pp $ _lhsImoduleHeader _lhsImainName ("_" ++ name_) _exports True- , pp $ ("import " ++ _lhsImainName ++ "_common\n")- , _commentIpp- , vlist_sep "" _infoIpps- , vlist_sep "" _semFunctionsIpps- ]- -- "PrintCode.ag"(line 394, column 7)- _exports =- concat $ intersperse "," semNames_- -- copy rule (down)- _commentOisDeclOfLet =- _lhsIisDeclOfLet- -- copy rule (down)- _commentOnested =- _lhsInested- -- copy rule (down)- _commentOoptions =- _lhsIoptions- -- copy rule (from local)- _commentOoutputfile =- _outputfile- -- copy rule (down)- _infoOisDeclOfLet =- _lhsIisDeclOfLet- -- copy rule (down)- _infoOnested =- _lhsInested- -- copy rule (down)- _infoOoptions =- _lhsIoptions- -- copy rule (from local)- _infoOoutputfile =- _outputfile- -- copy rule (down)- _dataDefOisDeclOfLet =- _lhsIisDeclOfLet- -- copy rule (down)- _dataDefOnested =- _lhsInested- -- copy rule (down)- _dataDefOoptions =- _lhsIoptions- -- copy rule (from local)- _dataDefOoutputfile =- _outputfile- -- copy rule (down)- _cataFunOisDeclOfLet =- _lhsIisDeclOfLet- -- copy rule (down)- _cataFunOnested =- _lhsInested- -- copy rule (down)- _cataFunOoptions =- _lhsIoptions- -- copy rule (from local)- _cataFunOoutputfile =- _outputfile- -- copy rule (down)- _semDomOisDeclOfLet =- _lhsIisDeclOfLet- -- copy rule (down)- _semDomOnested =- _lhsInested- -- copy rule (down)- _semDomOoptions =- _lhsIoptions- -- copy rule (from local)- _semDomOoutputfile =- _outputfile- -- copy rule (down)- _semWrapperOisDeclOfLet =- _lhsIisDeclOfLet- -- copy rule (down)- _semWrapperOnested =- _lhsInested- -- copy rule (down)- _semWrapperOoptions =- _lhsIoptions- -- copy rule (from local)- _semWrapperOoutputfile =- _outputfile- -- copy rule (down)- _semFunctionsOisDeclOfLet =- _lhsIisDeclOfLet- -- copy rule (down)- _semFunctionsOnested =- _lhsInested- -- copy rule (down)- _semFunctionsOoptions =- _lhsIoptions- -- copy rule (from local)- _semFunctionsOoutputfile =- _outputfile- ( _commentIpp) =- (comment_ _commentOisDeclOfLet _commentOnested _commentOoptions _commentOoutputfile )- ( _infoIpps) =- (info_ _infoOisDeclOfLet _infoOnested _infoOoptions _infoOoutputfile )- ( _dataDefIpps) =- (dataDef_ _dataDefOisDeclOfLet _dataDefOnested _dataDefOoptions _dataDefOoutputfile )- ( _cataFunIpps) =- (cataFun_ _cataFunOisDeclOfLet _cataFunOnested _cataFunOoptions _cataFunOoutputfile )- ( _semDomIpps) =- (semDom_ _semDomOisDeclOfLet _semDomOnested _semDomOoptions _semDomOoutputfile )- ( _semWrapperIpps) =- (semWrapper_ _semWrapperOisDeclOfLet _semWrapperOnested _semWrapperOoptions _semWrapperOoutputfile )- ( _semFunctionsIpps) =- (semFunctions_ _semFunctionsOisDeclOfLet _semFunctionsOnested _semFunctionsOoptions _semFunctionsOoutputfile )- in ( _lhsOappendCommon,_lhsOappendMain,_lhsOgenSems,_lhsOimports,_lhsOpps))) )--- Chunks -------------------------------------------------------{-- visit 0:- inherited attributes:- importBlocks : PP_Doc- isDeclOfLet : Bool- mainFile : String- mainName : String- moduleHeader : String -> String -> String -> Bool -> String- nested : Bool- options : Options- optionsLine : String- pragmaBlocks : String- textBlocks : PP_Doc- synthesized attributes:- appendCommon : [[PP_Doc]]- appendMain : [[PP_Doc]]- genSems : IO ()- imports : [String]- pps : PP_Docs- alternatives:- alternative Cons:- child hd : Chunk- child tl : Chunks- alternative Nil:--}--- cata-sem_Chunks :: Chunks ->- T_Chunks-sem_Chunks list =- (Prelude.foldr sem_Chunks_Cons sem_Chunks_Nil (Prelude.map sem_Chunk list) )--- semantic domain-newtype T_Chunks = T_Chunks (PP_Doc ->- Bool ->- String ->- String ->- (String -> String -> String -> Bool -> String) ->- Bool ->- Options ->- String ->- String ->- PP_Doc ->- ( ([[PP_Doc]]),([[PP_Doc]]),(IO ()),([String]),PP_Docs))-data Inh_Chunks = Inh_Chunks {importBlocks_Inh_Chunks :: PP_Doc,isDeclOfLet_Inh_Chunks :: Bool,mainFile_Inh_Chunks :: String,mainName_Inh_Chunks :: String,moduleHeader_Inh_Chunks :: String -> String -> String -> Bool -> String,nested_Inh_Chunks :: Bool,options_Inh_Chunks :: Options,optionsLine_Inh_Chunks :: String,pragmaBlocks_Inh_Chunks :: String,textBlocks_Inh_Chunks :: PP_Doc}-data Syn_Chunks = Syn_Chunks {appendCommon_Syn_Chunks :: [[PP_Doc]],appendMain_Syn_Chunks :: [[PP_Doc]],genSems_Syn_Chunks :: IO (),imports_Syn_Chunks :: [String],pps_Syn_Chunks :: PP_Docs}-wrap_Chunks (T_Chunks sem ) (Inh_Chunks _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks ) =- (let ( _lhsOappendCommon,_lhsOappendMain,_lhsOgenSems,_lhsOimports,_lhsOpps) =- (sem _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks )- in (Syn_Chunks _lhsOappendCommon _lhsOappendMain _lhsOgenSems _lhsOimports _lhsOpps ))-sem_Chunks_Cons :: T_Chunk ->- T_Chunks ->- T_Chunks-sem_Chunks_Cons (T_Chunk hd_ ) (T_Chunks tl_ ) =- (T_Chunks (\ _lhsIimportBlocks- _lhsIisDeclOfLet- _lhsImainFile- _lhsImainName- _lhsImoduleHeader- _lhsInested- _lhsIoptions- _lhsIoptionsLine- _lhsIpragmaBlocks- _lhsItextBlocks ->- (let _lhsOpps :: PP_Docs- _lhsOappendCommon :: ([[PP_Doc]])- _lhsOappendMain :: ([[PP_Doc]])- _lhsOgenSems :: (IO ())- _lhsOimports :: ([String])- _hdOimportBlocks :: PP_Doc- _hdOisDeclOfLet :: Bool- _hdOmainFile :: String- _hdOmainName :: String- _hdOmoduleHeader :: (String -> String -> String -> Bool -> String)- _hdOnested :: Bool- _hdOoptions :: Options- _hdOoptionsLine :: String- _hdOpragmaBlocks :: String- _hdOtextBlocks :: PP_Doc- _tlOimportBlocks :: PP_Doc- _tlOisDeclOfLet :: Bool- _tlOmainFile :: String- _tlOmainName :: String- _tlOmoduleHeader :: (String -> String -> String -> Bool -> String)- _tlOnested :: Bool- _tlOoptions :: Options- _tlOoptionsLine :: String- _tlOpragmaBlocks :: String- _tlOtextBlocks :: PP_Doc- _hdIappendCommon :: ([[PP_Doc]])- _hdIappendMain :: ([[PP_Doc]])- _hdIgenSems :: (IO ())- _hdIimports :: ([String])- _hdIpps :: PP_Docs- _tlIappendCommon :: ([[PP_Doc]])- _tlIappendMain :: ([[PP_Doc]])- _tlIgenSems :: (IO ())- _tlIimports :: ([String])- _tlIpps :: PP_Docs- -- "PrintCode.ag"(line 75, column 10)- _lhsOpps =- _hdIpps ++ _tlIpps- -- use rule "PrintCode.ag"(line 362, column 50)- _lhsOappendCommon =- _hdIappendCommon ++ _tlIappendCommon- -- use rule "PrintCode.ag"(line 362, column 50)- _lhsOappendMain =- _hdIappendMain ++ _tlIappendMain- -- use rule "PrintCode.ag"(line 377, column 33)- _lhsOgenSems =- _hdIgenSems >> _tlIgenSems- -- use rule "PrintCode.ag"(line 357, column 33)- _lhsOimports =- _hdIimports ++ _tlIimports- -- copy rule (down)- _hdOimportBlocks =- _lhsIimportBlocks- -- copy rule (down)- _hdOisDeclOfLet =- _lhsIisDeclOfLet- -- copy rule (down)- _hdOmainFile =- _lhsImainFile- -- copy rule (down)- _hdOmainName =- _lhsImainName- -- copy rule (down)- _hdOmoduleHeader =- _lhsImoduleHeader- -- copy rule (down)- _hdOnested =- _lhsInested- -- copy rule (down)- _hdOoptions =- _lhsIoptions- -- copy rule (down)- _hdOoptionsLine =- _lhsIoptionsLine- -- copy rule (down)- _hdOpragmaBlocks =- _lhsIpragmaBlocks- -- copy rule (down)- _hdOtextBlocks =- _lhsItextBlocks- -- copy rule (down)- _tlOimportBlocks =- _lhsIimportBlocks- -- copy rule (down)- _tlOisDeclOfLet =- _lhsIisDeclOfLet- -- copy rule (down)- _tlOmainFile =- _lhsImainFile- -- copy rule (down)- _tlOmainName =- _lhsImainName- -- copy rule (down)- _tlOmoduleHeader =- _lhsImoduleHeader- -- copy rule (down)- _tlOnested =- _lhsInested- -- copy rule (down)- _tlOoptions =- _lhsIoptions- -- copy rule (down)- _tlOoptionsLine =- _lhsIoptionsLine- -- copy rule (down)- _tlOpragmaBlocks =- _lhsIpragmaBlocks- -- copy rule (down)- _tlOtextBlocks =- _lhsItextBlocks- ( _hdIappendCommon,_hdIappendMain,_hdIgenSems,_hdIimports,_hdIpps) =- (hd_ _hdOimportBlocks _hdOisDeclOfLet _hdOmainFile _hdOmainName _hdOmoduleHeader _hdOnested _hdOoptions _hdOoptionsLine _hdOpragmaBlocks _hdOtextBlocks )- ( _tlIappendCommon,_tlIappendMain,_tlIgenSems,_tlIimports,_tlIpps) =- (tl_ _tlOimportBlocks _tlOisDeclOfLet _tlOmainFile _tlOmainName _tlOmoduleHeader _tlOnested _tlOoptions _tlOoptionsLine _tlOpragmaBlocks _tlOtextBlocks )- in ( _lhsOappendCommon,_lhsOappendMain,_lhsOgenSems,_lhsOimports,_lhsOpps))) )-sem_Chunks_Nil :: T_Chunks-sem_Chunks_Nil =- (T_Chunks (\ _lhsIimportBlocks- _lhsIisDeclOfLet- _lhsImainFile- _lhsImainName- _lhsImoduleHeader- _lhsInested- _lhsIoptions- _lhsIoptionsLine- _lhsIpragmaBlocks- _lhsItextBlocks ->- (let _lhsOpps :: PP_Docs- _lhsOappendCommon :: ([[PP_Doc]])- _lhsOappendMain :: ([[PP_Doc]])- _lhsOgenSems :: (IO ())- _lhsOimports :: ([String])- -- "PrintCode.ag"(line 76, column 10)- _lhsOpps =- []- -- use rule "PrintCode.ag"(line 362, column 50)- _lhsOappendCommon =- []- -- use rule "PrintCode.ag"(line 362, column 50)- _lhsOappendMain =- []- -- use rule "PrintCode.ag"(line 377, column 33)- _lhsOgenSems =- return ()- -- use rule "PrintCode.ag"(line 357, column 33)- _lhsOimports =- []- in ( _lhsOappendCommon,_lhsOappendMain,_lhsOgenSems,_lhsOimports,_lhsOpps))) )--- DataAlt ------------------------------------------------------{-- visit 0:- inherited attributes:- nested : Bool- strictPre : PP_Doc- synthesized attribute:- pp : PP_Doc- alternatives:- alternative DataAlt:- child name : {String}- child args : {[String]}- alternative Record:- child name : {String}- child args : {[(String,String)]}--}--- cata-sem_DataAlt :: DataAlt ->- T_DataAlt-sem_DataAlt (DataAlt _name _args ) =- (sem_DataAlt_DataAlt _name _args )-sem_DataAlt (Record _name _args ) =- (sem_DataAlt_Record _name _args )--- semantic domain-newtype T_DataAlt = T_DataAlt (Bool ->- PP_Doc ->- ( PP_Doc))-data Inh_DataAlt = Inh_DataAlt {nested_Inh_DataAlt :: Bool,strictPre_Inh_DataAlt :: PP_Doc}-data Syn_DataAlt = Syn_DataAlt {pp_Syn_DataAlt :: PP_Doc}-wrap_DataAlt (T_DataAlt sem ) (Inh_DataAlt _lhsInested _lhsIstrictPre ) =- (let ( _lhsOpp) =- (sem _lhsInested _lhsIstrictPre )- in (Syn_DataAlt _lhsOpp ))-sem_DataAlt_DataAlt :: String ->- ([String]) ->- T_DataAlt-sem_DataAlt_DataAlt name_ args_ =- (T_DataAlt (\ _lhsInested- _lhsIstrictPre ->- (let _lhsOpp :: PP_Doc- -- "PrintCode.ag"(line 152, column 16)- _lhsOpp =- name_ >#< hv_sp (map ((_lhsIstrictPre >|<) . pp_parens . text) args_)- in ( _lhsOpp))) )-sem_DataAlt_Record :: String ->- ([(String,String)]) ->- T_DataAlt-sem_DataAlt_Record name_ args_ =- (T_DataAlt (\ _lhsInested- _lhsIstrictPre ->- (let _lhsOpp :: PP_Doc- -- "PrintCode.ag"(line 153, column 16)- _lhsOpp =- name_ >#< pp_block "{" "}" ","- [ f >#< "::" >#< t | (f,t) <- args_ ]- in ( _lhsOpp))) )--- DataAlts -----------------------------------------------------{-- visit 0:- inherited attributes:- nested : Bool- strictPre : PP_Doc- synthesized attribute:- pps : PP_Docs- alternatives:- alternative Cons:- child hd : DataAlt- child tl : DataAlts- alternative Nil:--}--- cata-sem_DataAlts :: DataAlts ->- T_DataAlts-sem_DataAlts list =- (Prelude.foldr sem_DataAlts_Cons sem_DataAlts_Nil (Prelude.map sem_DataAlt list) )--- semantic domain-newtype T_DataAlts = T_DataAlts (Bool ->- PP_Doc ->- ( PP_Docs))-data Inh_DataAlts = Inh_DataAlts {nested_Inh_DataAlts :: Bool,strictPre_Inh_DataAlts :: PP_Doc}-data Syn_DataAlts = Syn_DataAlts {pps_Syn_DataAlts :: PP_Docs}-wrap_DataAlts (T_DataAlts sem ) (Inh_DataAlts _lhsInested _lhsIstrictPre ) =- (let ( _lhsOpps) =- (sem _lhsInested _lhsIstrictPre )- in (Syn_DataAlts _lhsOpps ))-sem_DataAlts_Cons :: T_DataAlt ->- T_DataAlts ->- T_DataAlts-sem_DataAlts_Cons (T_DataAlt hd_ ) (T_DataAlts tl_ ) =- (T_DataAlts (\ _lhsInested- _lhsIstrictPre ->- (let _lhsOpps :: PP_Docs- _hdOnested :: Bool- _hdOstrictPre :: PP_Doc- _tlOnested :: Bool- _tlOstrictPre :: PP_Doc- _hdIpp :: PP_Doc- _tlIpps :: PP_Docs- -- "PrintCode.ag"(line 63, column 10)- _lhsOpps =- _hdIpp : _tlIpps- -- copy rule (down)- _hdOnested =- _lhsInested- -- copy rule (down)- _hdOstrictPre =- _lhsIstrictPre- -- copy rule (down)- _tlOnested =- _lhsInested- -- copy rule (down)- _tlOstrictPre =- _lhsIstrictPre- ( _hdIpp) =- (hd_ _hdOnested _hdOstrictPre )- ( _tlIpps) =- (tl_ _tlOnested _tlOstrictPre )- in ( _lhsOpps))) )-sem_DataAlts_Nil :: T_DataAlts-sem_DataAlts_Nil =- (T_DataAlts (\ _lhsInested- _lhsIstrictPre ->- (let _lhsOpps :: PP_Docs- -- "PrintCode.ag"(line 64, column 10)- _lhsOpps =- []- in ( _lhsOpps))) )--- Decl ---------------------------------------------------------{-- visit 0:- inherited attributes:- isDeclOfLet : Bool- nested : Bool- options : Options- outputfile : String- synthesized attribute:- pp : PP_Doc- alternatives:- alternative Comment:- child txt : {String}- alternative Data:- child name : {String}- child alts : DataAlts- child strict : {Bool}- child derivings : {[String]}- alternative Decl:- child left : Lhs- child rhs : Expr- child binds : {Set String}- child uses : {Set String}- alternative NewType:- child name : {String}- child con : {String}- child tp : Type- alternative PragmaDecl:- child txt : {String}- alternative TSig:- child name : {String}- child tp : Type- alternative Type:- child name : {String}- child tp : Type--}--- cata-sem_Decl :: Decl ->- T_Decl-sem_Decl (Comment _txt ) =- (sem_Decl_Comment _txt )-sem_Decl (Data _name _alts _strict _derivings ) =- (sem_Decl_Data _name (sem_DataAlts _alts ) _strict _derivings )-sem_Decl (Decl _left _rhs _binds _uses ) =- (sem_Decl_Decl (sem_Lhs _left ) (sem_Expr _rhs ) _binds _uses )-sem_Decl (NewType _name _con _tp ) =- (sem_Decl_NewType _name _con (sem_Type _tp ) )-sem_Decl (PragmaDecl _txt ) =- (sem_Decl_PragmaDecl _txt )-sem_Decl (TSig _name _tp ) =- (sem_Decl_TSig _name (sem_Type _tp ) )-sem_Decl (Type _name _tp ) =- (sem_Decl_Type _name (sem_Type _tp ) )--- semantic domain-newtype T_Decl = T_Decl (Bool ->- Bool ->- Options ->- String ->- ( PP_Doc))-data Inh_Decl = Inh_Decl {isDeclOfLet_Inh_Decl :: Bool,nested_Inh_Decl :: Bool,options_Inh_Decl :: Options,outputfile_Inh_Decl :: String}-data Syn_Decl = Syn_Decl {pp_Syn_Decl :: PP_Doc}-wrap_Decl (T_Decl sem ) (Inh_Decl _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile ) =- (let ( _lhsOpp) =- (sem _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile )- in (Syn_Decl _lhsOpp ))-sem_Decl_Comment :: String ->- T_Decl-sem_Decl_Comment txt_ =- (T_Decl (\ _lhsIisDeclOfLet- _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpp :: PP_Doc- -- "PrintCode.ag"(line 106, column 16)- _lhsOpp =- if '\n' `elem` txt_- then "{-" >-< vlist (lines txt_) >-< "-}"- else "--" >#< txt_- in ( _lhsOpp))) )-sem_Decl_Data :: String ->- T_DataAlts ->- Bool ->- ([String]) ->- T_Decl-sem_Decl_Data name_ (T_DataAlts alts_ ) strict_ derivings_ =- (T_Decl (\ _lhsIisDeclOfLet- _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpp :: PP_Doc- _altsOstrictPre :: PP_Doc- _altsOnested :: Bool- _altsIpps :: PP_Docs- -- "PrintCode.ag"(line 94, column 16)- _lhsOpp =- "data" >#< name_- >#< ( case _altsIpps of- [] -> empty- (x:xs) -> "=" >#< x- >-< vlist (map ("|" >#<) xs)- >-< if null derivings_- then empty- else "deriving" >#< ppTuple False (map text derivings_)- )- -- "PrintCode.ag"(line 218, column 10)- _altsOstrictPre =- if strict_ then pp "!" else empty- -- copy rule (down)- _altsOnested =- _lhsInested- ( _altsIpps) =- (alts_ _altsOnested _altsOstrictPre )- in ( _lhsOpp))) )-sem_Decl_Decl :: T_Lhs ->- T_Expr ->- (Set String) ->- (Set String) ->- T_Decl-sem_Decl_Decl (T_Lhs left_ ) (T_Expr rhs_ ) binds_ uses_ =- (T_Decl (\ _lhsIisDeclOfLet- _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpp :: PP_Doc- _leftOisDeclOfLet :: Bool- _leftOnested :: Bool- _leftOoptions :: Options- _leftOoutputfile :: String- _rhsOnested :: Bool- _rhsOoptions :: Options- _rhsOoutputfile :: String- _leftIpp :: PP_Doc- _rhsIpp :: PP_Doc- -- "PrintCode.ag"(line 92, column 16)- _lhsOpp =- _leftIpp >#< "="- >-< indent 4 _rhsIpp- -- copy rule (down)- _leftOisDeclOfLet =- _lhsIisDeclOfLet- -- copy rule (down)- _leftOnested =- _lhsInested- -- copy rule (down)- _leftOoptions =- _lhsIoptions- -- copy rule (down)- _leftOoutputfile =- _lhsIoutputfile- -- copy rule (down)- _rhsOnested =- _lhsInested- -- copy rule (down)- _rhsOoptions =- _lhsIoptions- -- copy rule (down)- _rhsOoutputfile =- _lhsIoutputfile- ( _leftIpp) =- (left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile )- ( _rhsIpp) =- (rhs_ _rhsOnested _rhsOoptions _rhsOoutputfile )- in ( _lhsOpp))) )-sem_Decl_NewType :: String ->- String ->- T_Type ->- T_Decl-sem_Decl_NewType name_ con_ (T_Type tp_ ) =- (T_Decl (\ _lhsIisDeclOfLet- _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpp :: PP_Doc- _tpOnested :: Bool- _tpIpp :: PP_Doc- _tpIprec :: Int- -- "PrintCode.ag"(line 103, column 16)- _lhsOpp =- "newtype" >#< name_ >#< "=" >#< con_ >#< pp_parens _tpIpp- -- copy rule (down)- _tpOnested =- _lhsInested- ( _tpIpp,_tpIprec) =- (tp_ _tpOnested )- in ( _lhsOpp))) )-sem_Decl_PragmaDecl :: String ->- T_Decl-sem_Decl_PragmaDecl txt_ =- (T_Decl (\ _lhsIisDeclOfLet- _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpp :: PP_Doc- -- "PrintCode.ag"(line 109, column 16)- _lhsOpp =- "{-#" >#< text txt_ >#< "#-}"- in ( _lhsOpp))) )-sem_Decl_TSig :: String ->- T_Type ->- T_Decl-sem_Decl_TSig name_ (T_Type tp_ ) =- (T_Decl (\ _lhsIisDeclOfLet- _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpp :: PP_Doc- _tpOnested :: Bool- _tpIpp :: PP_Doc- _tpIprec :: Int- -- "PrintCode.ag"(line 105, column 16)- _lhsOpp =- name_ >#< "::" >#< _tpIpp- -- copy rule (down)- _tpOnested =- _lhsInested- ( _tpIpp,_tpIprec) =- (tp_ _tpOnested )- in ( _lhsOpp))) )-sem_Decl_Type :: String ->- T_Type ->- T_Decl-sem_Decl_Type name_ (T_Type tp_ ) =- (T_Decl (\ _lhsIisDeclOfLet- _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpp :: PP_Doc- _tpOnested :: Bool- _tpIpp :: PP_Doc- _tpIprec :: Int- -- "PrintCode.ag"(line 104, column 16)- _lhsOpp =- "type" >#< name_ >#< "=" >#< _tpIpp- -- copy rule (down)- _tpOnested =- _lhsInested- ( _tpIpp,_tpIprec) =- (tp_ _tpOnested )- in ( _lhsOpp))) )--- Decls --------------------------------------------------------{-- visit 0:- inherited attributes:- isDeclOfLet : Bool- nested : Bool- options : Options- outputfile : String- synthesized attribute:- pps : PP_Docs- alternatives:- alternative Cons:- child hd : Decl- child tl : Decls- alternative Nil:--}--- cata-sem_Decls :: Decls ->- T_Decls-sem_Decls list =- (Prelude.foldr sem_Decls_Cons sem_Decls_Nil (Prelude.map sem_Decl list) )--- semantic domain-newtype T_Decls = T_Decls (Bool ->- Bool ->- Options ->- String ->- ( PP_Docs))-data Inh_Decls = Inh_Decls {isDeclOfLet_Inh_Decls :: Bool,nested_Inh_Decls :: Bool,options_Inh_Decls :: Options,outputfile_Inh_Decls :: String}-data Syn_Decls = Syn_Decls {pps_Syn_Decls :: PP_Docs}-wrap_Decls (T_Decls sem ) (Inh_Decls _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile ) =- (let ( _lhsOpps) =- (sem _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile )- in (Syn_Decls _lhsOpps ))-sem_Decls_Cons :: T_Decl ->- T_Decls ->- T_Decls-sem_Decls_Cons (T_Decl hd_ ) (T_Decls tl_ ) =- (T_Decls (\ _lhsIisDeclOfLet- _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpps :: PP_Docs- _hdOisDeclOfLet :: Bool- _hdOnested :: Bool- _hdOoptions :: Options- _hdOoutputfile :: String- _tlOisDeclOfLet :: Bool- _tlOnested :: Bool- _tlOoptions :: Options- _tlOoutputfile :: String- _hdIpp :: PP_Doc- _tlIpps :: PP_Docs- -- "PrintCode.ag"(line 71, column 10)- _lhsOpps =- _hdIpp : _tlIpps- -- copy rule (down)- _hdOisDeclOfLet =- _lhsIisDeclOfLet- -- copy rule (down)- _hdOnested =- _lhsInested- -- copy rule (down)- _hdOoptions =- _lhsIoptions- -- copy rule (down)- _hdOoutputfile =- _lhsIoutputfile- -- copy rule (down)- _tlOisDeclOfLet =- _lhsIisDeclOfLet- -- copy rule (down)- _tlOnested =- _lhsInested- -- copy rule (down)- _tlOoptions =- _lhsIoptions- -- copy rule (down)- _tlOoutputfile =- _lhsIoutputfile- ( _hdIpp) =- (hd_ _hdOisDeclOfLet _hdOnested _hdOoptions _hdOoutputfile )- ( _tlIpps) =- (tl_ _tlOisDeclOfLet _tlOnested _tlOoptions _tlOoutputfile )- in ( _lhsOpps))) )-sem_Decls_Nil :: T_Decls-sem_Decls_Nil =- (T_Decls (\ _lhsIisDeclOfLet- _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpps :: PP_Docs- -- "PrintCode.ag"(line 72, column 10)- _lhsOpps =- []- in ( _lhsOpps))) )--- Expr ---------------------------------------------------------{-- visit 0:- inherited attributes:- nested : Bool- options : Options- outputfile : String- synthesized attribute:- pp : PP_Doc- alternatives:- alternative App:- child name : {String}- child args : Exprs- alternative Case:- child expr : Expr- child alts : CaseAlts- alternative Lambda:- child args : {[String]}- child body : Expr- visit 0:- local strictParams : _- local addBang : _- alternative Let:- child decls : Decls- child body : Expr- alternative LineExpr:- child expr : Expr- alternative PragmaExpr:- child onLeftSide : {Bool}- child onNewLine : {Bool}- child txt : {String}- child expr : Expr- alternative SimpleExpr:- child txt : {String}- alternative TextExpr:- child lns : {[String]}- alternative Trace:- child txt : {String}- child expr : Expr- alternative TupleExpr:- child exprs : Exprs- alternative UnboxedTupleExpr:- child exprs : Exprs--}--- cata-sem_Expr :: Expr ->- T_Expr-sem_Expr (App _name _args ) =- (sem_Expr_App _name (sem_Exprs _args ) )-sem_Expr (Case _expr _alts ) =- (sem_Expr_Case (sem_Expr _expr ) (sem_CaseAlts _alts ) )-sem_Expr (Lambda _args _body ) =- (sem_Expr_Lambda _args (sem_Expr _body ) )-sem_Expr (Let _decls _body ) =- (sem_Expr_Let (sem_Decls _decls ) (sem_Expr _body ) )-sem_Expr (LineExpr _expr ) =- (sem_Expr_LineExpr (sem_Expr _expr ) )-sem_Expr (PragmaExpr _onLeftSide _onNewLine _txt _expr ) =- (sem_Expr_PragmaExpr _onLeftSide _onNewLine _txt (sem_Expr _expr ) )-sem_Expr (SimpleExpr _txt ) =- (sem_Expr_SimpleExpr _txt )-sem_Expr (TextExpr _lns ) =- (sem_Expr_TextExpr _lns )-sem_Expr (Trace _txt _expr ) =- (sem_Expr_Trace _txt (sem_Expr _expr ) )-sem_Expr (TupleExpr _exprs ) =- (sem_Expr_TupleExpr (sem_Exprs _exprs ) )-sem_Expr (UnboxedTupleExpr _exprs ) =- (sem_Expr_UnboxedTupleExpr (sem_Exprs _exprs ) )--- semantic domain-newtype T_Expr = T_Expr (Bool ->- Options ->- String ->- ( PP_Doc))-data Inh_Expr = Inh_Expr {nested_Inh_Expr :: Bool,options_Inh_Expr :: Options,outputfile_Inh_Expr :: String}-data Syn_Expr = Syn_Expr {pp_Syn_Expr :: PP_Doc}-wrap_Expr (T_Expr sem ) (Inh_Expr _lhsInested _lhsIoptions _lhsIoutputfile ) =- (let ( _lhsOpp) =- (sem _lhsInested _lhsIoptions _lhsIoutputfile )- in (Syn_Expr _lhsOpp ))-sem_Expr_App :: String ->- T_Exprs ->- T_Expr-sem_Expr_App name_ (T_Exprs args_ ) =- (T_Expr (\ _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpp :: PP_Doc- _argsOnested :: Bool- _argsOoptions :: Options- _argsOoutputfile :: String- _argsIpps :: PP_Docs- -- "PrintCode.ag"(line 129, column 16)- _lhsOpp =- pp_parens $ name_ >#< hv_sp _argsIpps- -- copy rule (down)- _argsOnested =- _lhsInested- -- copy rule (down)- _argsOoptions =- _lhsIoptions- -- copy rule (down)- _argsOoutputfile =- _lhsIoutputfile- ( _argsIpps) =- (args_ _argsOnested _argsOoptions _argsOoutputfile )- in ( _lhsOpp))) )-sem_Expr_Case :: T_Expr ->- T_CaseAlts ->- T_Expr-sem_Expr_Case (T_Expr expr_ ) (T_CaseAlts alts_ ) =- (T_Expr (\ _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpp :: PP_Doc- _exprOnested :: Bool- _exprOoptions :: Options- _exprOoutputfile :: String- _altsOnested :: Bool- _altsOoptions :: Options- _altsOoutputfile :: String- _exprIpp :: PP_Doc- _altsIpps :: PP_Docs- -- "PrintCode.ag"(line 115, column 16)- _lhsOpp =- pp_parens ( "case" >#< pp_parens _exprIpp >#< "of"- >-< (vlist _altsIpps)- )- -- copy rule (down)- _exprOnested =- _lhsInested- -- copy rule (down)- _exprOoptions =- _lhsIoptions- -- copy rule (down)- _exprOoutputfile =- _lhsIoutputfile- -- copy rule (down)- _altsOnested =- _lhsInested- -- copy rule (down)- _altsOoptions =- _lhsIoptions- -- copy rule (down)- _altsOoutputfile =- _lhsIoutputfile- ( _exprIpp) =- (expr_ _exprOnested _exprOoptions _exprOoutputfile )- ( _altsIpps) =- (alts_ _altsOnested _altsOoptions _altsOoutputfile )- in ( _lhsOpp))) )-sem_Expr_Lambda :: ([String]) ->- T_Expr ->- T_Expr-sem_Expr_Lambda args_ (T_Expr body_ ) =- (T_Expr (\ _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpp :: PP_Doc- _bodyOnested :: Bool- _bodyOoptions :: Options- _bodyOoutputfile :: String- _bodyIpp :: PP_Doc- -- "PrintCode.ag"(line 118, column 16)- _strictParams =- if strictSems _lhsIoptions- then map text args_- else []- -- "PrintCode.ag"(line 121, column 16)- _addBang =- if bangpats _lhsIoptions- then \p -> pp_parens ("!" >|< p)- else id- -- "PrintCode.ag"(line 124, column 16)- _lhsOpp =- pp_parens ( "\\" >#< (vlist (map (_addBang . pp) args_)) >#< "->"- >-< indent 4 (_strictParams `ppMultiSeqV` _bodyIpp)- )- -- copy rule (down)- _bodyOnested =- _lhsInested- -- copy rule (down)- _bodyOoptions =- _lhsIoptions- -- copy rule (down)- _bodyOoutputfile =- _lhsIoutputfile- ( _bodyIpp) =- (body_ _bodyOnested _bodyOoptions _bodyOoutputfile )- in ( _lhsOpp))) )-sem_Expr_Let :: T_Decls ->- T_Expr ->- T_Expr-sem_Expr_Let (T_Decls decls_ ) (T_Expr body_ ) =- (T_Expr (\ _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpp :: PP_Doc- _declsOisDeclOfLet :: Bool- _declsOnested :: Bool- _declsOoptions :: Options- _declsOoutputfile :: String- _bodyOnested :: Bool- _bodyOoptions :: Options- _bodyOoutputfile :: String- _declsIpps :: PP_Docs- _bodyIpp :: PP_Doc- -- "PrintCode.ag"(line 112, column 16)- _lhsOpp =- pp_parens ( "let" >#< (vlist _declsIpps)- >-< "in " >#< _bodyIpp- )- -- "PrintCode.ag"(line 299, column 7)- _declsOisDeclOfLet =- True- -- copy rule (down)- _declsOnested =- _lhsInested- -- copy rule (down)- _declsOoptions =- _lhsIoptions- -- copy rule (down)- _declsOoutputfile =- _lhsIoutputfile- -- copy rule (down)- _bodyOnested =- _lhsInested- -- copy rule (down)- _bodyOoptions =- _lhsIoptions- -- copy rule (down)- _bodyOoutputfile =- _lhsIoutputfile- ( _declsIpps) =- (decls_ _declsOisDeclOfLet _declsOnested _declsOoptions _declsOoutputfile )- ( _bodyIpp) =- (body_ _bodyOnested _bodyOoptions _bodyOoutputfile )- in ( _lhsOpp))) )-sem_Expr_LineExpr :: T_Expr ->- T_Expr-sem_Expr_LineExpr (T_Expr expr_ ) =- (T_Expr (\ _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpp :: PP_Doc- _exprOnested :: Bool- _exprOoptions :: Options- _exprOoutputfile :: String- _exprIpp :: PP_Doc- -- "PrintCode.ag"(line 146, column 16)- _lhsOpp =- _exprIpp >-< "{-# LINE" >#< ppWithLineNr (\n -> pp $ show $ n + 1) >#< show _lhsIoutputfile >#< "#-}"- -- copy rule (down)- _exprOnested =- _lhsInested- -- copy rule (down)- _exprOoptions =- _lhsIoptions- -- copy rule (down)- _exprOoutputfile =- _lhsIoutputfile- ( _exprIpp) =- (expr_ _exprOnested _exprOoptions _exprOoutputfile )- in ( _lhsOpp))) )-sem_Expr_PragmaExpr :: Bool ->- Bool ->- String ->- T_Expr ->- T_Expr-sem_Expr_PragmaExpr onLeftSide_ onNewLine_ txt_ (T_Expr expr_ ) =- (T_Expr (\ _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpp :: PP_Doc- _exprOnested :: Bool- _exprOoptions :: Options- _exprOoutputfile :: String- _exprIpp :: PP_Doc- -- "PrintCode.ag"(line 135, column 16)- _lhsOpp =- let pragmaDoc = "{-#" >#< txt_ >#< "#-}"- op = if onNewLine_- then (>-<)- else (>#<)- leftOp x y = if onLeftSide_- then x `op` y- else y- rightOp x y = if onLeftSide_- then x- else x `op` y- in pragmaDoc `leftOp` _exprIpp `rightOp` pragmaDoc- -- copy rule (down)- _exprOnested =- _lhsInested- -- copy rule (down)- _exprOoptions =- _lhsIoptions- -- copy rule (down)- _exprOoutputfile =- _lhsIoutputfile- ( _exprIpp) =- (expr_ _exprOnested _exprOoptions _exprOoutputfile )- in ( _lhsOpp))) )-sem_Expr_SimpleExpr :: String ->- T_Expr-sem_Expr_SimpleExpr txt_ =- (T_Expr (\ _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpp :: PP_Doc- -- "PrintCode.ag"(line 130, column 16)- _lhsOpp =- text txt_- in ( _lhsOpp))) )-sem_Expr_TextExpr :: ([String]) ->- T_Expr-sem_Expr_TextExpr lns_ =- (T_Expr (\ _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpp :: PP_Doc- -- "PrintCode.ag"(line 131, column 16)- _lhsOpp =- vlist (map text lns_)- in ( _lhsOpp))) )-sem_Expr_Trace :: String ->- T_Expr ->- T_Expr-sem_Expr_Trace txt_ (T_Expr expr_ ) =- (T_Expr (\ _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpp :: PP_Doc- _exprOnested :: Bool- _exprOoptions :: Options- _exprOoutputfile :: String- _exprIpp :: PP_Doc- -- "PrintCode.ag"(line 132, column 16)- _lhsOpp =- "trace" >#< ( pp_parens ("\"" >|< text txt_ >|< "\"")- >-< pp_parens _exprIpp- )- -- copy rule (down)- _exprOnested =- _lhsInested- -- copy rule (down)- _exprOoptions =- _lhsIoptions- -- copy rule (down)- _exprOoutputfile =- _lhsIoutputfile- ( _exprIpp) =- (expr_ _exprOnested _exprOoptions _exprOoutputfile )- in ( _lhsOpp))) )-sem_Expr_TupleExpr :: T_Exprs ->- T_Expr-sem_Expr_TupleExpr (T_Exprs exprs_ ) =- (T_Expr (\ _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpp :: PP_Doc- _exprsOnested :: Bool- _exprsOoptions :: Options- _exprsOoutputfile :: String- _exprsIpps :: PP_Docs- -- "PrintCode.ag"(line 127, column 16)- _lhsOpp =- ppTuple _lhsInested _exprsIpps- -- copy rule (down)- _exprsOnested =- _lhsInested- -- copy rule (down)- _exprsOoptions =- _lhsIoptions- -- copy rule (down)- _exprsOoutputfile =- _lhsIoutputfile- ( _exprsIpps) =- (exprs_ _exprsOnested _exprsOoptions _exprsOoutputfile )- in ( _lhsOpp))) )-sem_Expr_UnboxedTupleExpr :: T_Exprs ->- T_Expr-sem_Expr_UnboxedTupleExpr (T_Exprs exprs_ ) =- (T_Expr (\ _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpp :: PP_Doc- _exprsOnested :: Bool- _exprsOoptions :: Options- _exprsOoutputfile :: String- _exprsIpps :: PP_Docs- -- "PrintCode.ag"(line 128, column 23)- _lhsOpp =- ppUnboxedTuple _lhsInested _exprsIpps- -- copy rule (down)- _exprsOnested =- _lhsInested- -- copy rule (down)- _exprsOoptions =- _lhsIoptions- -- copy rule (down)- _exprsOoutputfile =- _lhsIoutputfile- ( _exprsIpps) =- (exprs_ _exprsOnested _exprsOoptions _exprsOoutputfile )- in ( _lhsOpp))) )--- Exprs --------------------------------------------------------{-- visit 0:- inherited attributes:- nested : Bool- options : Options- outputfile : String- synthesized attribute:- pps : PP_Docs- alternatives:- alternative Cons:- child hd : Expr- child tl : Exprs- alternative Nil:--}--- cata-sem_Exprs :: Exprs ->- T_Exprs-sem_Exprs list =- (Prelude.foldr sem_Exprs_Cons sem_Exprs_Nil (Prelude.map sem_Expr list) )--- semantic domain-newtype T_Exprs = T_Exprs (Bool ->- Options ->- String ->- ( PP_Docs))-data Inh_Exprs = Inh_Exprs {nested_Inh_Exprs :: Bool,options_Inh_Exprs :: Options,outputfile_Inh_Exprs :: String}-data Syn_Exprs = Syn_Exprs {pps_Syn_Exprs :: PP_Docs}-wrap_Exprs (T_Exprs sem ) (Inh_Exprs _lhsInested _lhsIoptions _lhsIoutputfile ) =- (let ( _lhsOpps) =- (sem _lhsInested _lhsIoptions _lhsIoutputfile )- in (Syn_Exprs _lhsOpps ))-sem_Exprs_Cons :: T_Expr ->- T_Exprs ->- T_Exprs-sem_Exprs_Cons (T_Expr hd_ ) (T_Exprs tl_ ) =- (T_Exprs (\ _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpps :: PP_Docs- _hdOnested :: Bool- _hdOoptions :: Options- _hdOoutputfile :: String- _tlOnested :: Bool- _tlOoptions :: Options- _tlOoutputfile :: String- _hdIpp :: PP_Doc- _tlIpps :: PP_Docs- -- "PrintCode.ag"(line 55, column 10)- _lhsOpps =- _hdIpp : _tlIpps- -- copy rule (down)- _hdOnested =- _lhsInested- -- copy rule (down)- _hdOoptions =- _lhsIoptions- -- copy rule (down)- _hdOoutputfile =- _lhsIoutputfile- -- copy rule (down)- _tlOnested =- _lhsInested- -- copy rule (down)- _tlOoptions =- _lhsIoptions- -- copy rule (down)- _tlOoutputfile =- _lhsIoutputfile- ( _hdIpp) =- (hd_ _hdOnested _hdOoptions _hdOoutputfile )- ( _tlIpps) =- (tl_ _tlOnested _tlOoptions _tlOoutputfile )- in ( _lhsOpps))) )-sem_Exprs_Nil :: T_Exprs-sem_Exprs_Nil =- (T_Exprs (\ _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpps :: PP_Docs- -- "PrintCode.ag"(line 56, column 10)- _lhsOpps =- []- in ( _lhsOpps))) )--- Lhs ----------------------------------------------------------{-- visit 0:- inherited attributes:- isDeclOfLet : Bool- nested : Bool- options : Options- outputfile : String- synthesized attribute:- pp : PP_Doc- alternatives:- alternative Fun:- child name : {String}- child args : Exprs- visit 0:- local addStrictGuard : _- local strictGuard : _- local addBang : _- alternative Pattern3:- child pat3 : Pattern- visit 0:- local addStrictGuard : _- local strictGuard : _- alternative Pattern3SM:- child pat3 : Pattern- alternative TupleLhs:- child comps : {[String]}- visit 0:- local addStrictGuard : _- local strictGuard : _- local addBang : _- alternative UnboxedTupleLhs:- child comps : {[String]}- visit 0:- local addStrictGuard : _- local strictGuard : _- local addBang : _--}--- cata-sem_Lhs :: Lhs ->- T_Lhs-sem_Lhs (Fun _name _args ) =- (sem_Lhs_Fun _name (sem_Exprs _args ) )-sem_Lhs (Pattern3 _pat3 ) =- (sem_Lhs_Pattern3 (sem_Pattern _pat3 ) )-sem_Lhs (Pattern3SM _pat3 ) =- (sem_Lhs_Pattern3SM (sem_Pattern _pat3 ) )-sem_Lhs (TupleLhs _comps ) =- (sem_Lhs_TupleLhs _comps )-sem_Lhs (UnboxedTupleLhs _comps ) =- (sem_Lhs_UnboxedTupleLhs _comps )--- semantic domain-newtype T_Lhs = T_Lhs (Bool ->- Bool ->- Options ->- String ->- ( PP_Doc))-data Inh_Lhs = Inh_Lhs {isDeclOfLet_Inh_Lhs :: Bool,nested_Inh_Lhs :: Bool,options_Inh_Lhs :: Options,outputfile_Inh_Lhs :: String}-data Syn_Lhs = Syn_Lhs {pp_Syn_Lhs :: PP_Doc}-wrap_Lhs (T_Lhs sem ) (Inh_Lhs _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile ) =- (let ( _lhsOpp) =- (sem _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile )- in (Syn_Lhs _lhsOpp ))-sem_Lhs_Fun :: String ->- T_Exprs ->- T_Lhs-sem_Lhs_Fun name_ (T_Exprs args_ ) =- (T_Lhs (\ _lhsIisDeclOfLet- _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpp :: PP_Doc- _argsOnested :: Bool- _argsOoptions :: Options- _argsOoutputfile :: String- _argsIpps :: PP_Docs- -- "PrintCode.ag"(line 166, column 7)- _addStrictGuard =- if strictSems _lhsIoptions then \v -> v >#< "|" >#< _strictGuard else id- -- "PrintCode.ag"(line 167, column 7)- _strictGuard =- _argsIpps `ppMultiSeqH` (pp "True")- -- "PrintCode.ag"(line 170, column 7)- _addBang =- if bangpats _lhsIoptions- then \p -> "!" >|< p- else id- -- "PrintCode.ag"(line 178, column 16)- _lhsOpp =- _addStrictGuard (name_ >#< hv_sp (map _addBang _argsIpps))- -- copy rule (down)- _argsOnested =- _lhsInested- -- copy rule (down)- _argsOoptions =- _lhsIoptions- -- copy rule (down)- _argsOoutputfile =- _lhsIoutputfile- ( _argsIpps) =- (args_ _argsOnested _argsOoptions _argsOoutputfile )- in ( _lhsOpp))) )-sem_Lhs_Pattern3 :: T_Pattern ->- T_Lhs-sem_Lhs_Pattern3 (T_Pattern pat3_ ) =- (T_Lhs (\ _lhsIisDeclOfLet- _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpp :: PP_Doc- _pat3OisDeclOfLet :: Bool- _pat3Ooptions :: Options- _pat3Icopy :: Pattern- _pat3IisUnderscore :: Bool- _pat3Ipp :: PP_Doc- _pat3Ipp' :: PP_Doc- _pat3IstrictVars :: ([PP_Doc])- -- "PrintCode.ag"(line 157, column 7)- _addStrictGuard =- if strictCases _lhsIoptions then \v -> v >#< "|" >#< _strictGuard else id- -- "PrintCode.ag"(line 159, column 7)- _strictGuard =- _pat3IstrictVars `ppMultiSeqH` (pp "True")- -- "PrintCode.ag"(line 174, column 16)- _lhsOpp =- _addStrictGuard _pat3Ipp- -- copy rule (down)- _pat3OisDeclOfLet =- _lhsIisDeclOfLet- -- copy rule (down)- _pat3Ooptions =- _lhsIoptions- ( _pat3Icopy,_pat3IisUnderscore,_pat3Ipp,_pat3Ipp',_pat3IstrictVars) =- (pat3_ _pat3OisDeclOfLet _pat3Ooptions )- in ( _lhsOpp))) )-sem_Lhs_Pattern3SM :: T_Pattern ->- T_Lhs-sem_Lhs_Pattern3SM (T_Pattern pat3_ ) =- (T_Lhs (\ _lhsIisDeclOfLet- _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpp :: PP_Doc- _pat3OisDeclOfLet :: Bool- _pat3Ooptions :: Options- _pat3Icopy :: Pattern- _pat3IisUnderscore :: Bool- _pat3Ipp :: PP_Doc- _pat3Ipp' :: PP_Doc- _pat3IstrictVars :: ([PP_Doc])- -- "PrintCode.ag"(line 175, column 16)- _lhsOpp =- _pat3Ipp'- -- copy rule (down)- _pat3OisDeclOfLet =- _lhsIisDeclOfLet- -- copy rule (down)- _pat3Ooptions =- _lhsIoptions- ( _pat3Icopy,_pat3IisUnderscore,_pat3Ipp,_pat3Ipp',_pat3IstrictVars) =- (pat3_ _pat3OisDeclOfLet _pat3Ooptions )- in ( _lhsOpp))) )-sem_Lhs_TupleLhs :: ([String]) ->- T_Lhs-sem_Lhs_TupleLhs comps_ =- (T_Lhs (\ _lhsIisDeclOfLet- _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpp :: PP_Doc- -- "PrintCode.ag"(line 157, column 7)- _addStrictGuard =- if strictCases _lhsIoptions then \v -> v >#< "|" >#< _strictGuard else id- -- "PrintCode.ag"(line 161, column 7)- _strictGuard =- if stricterCases _lhsIoptions && not _lhsIisDeclOfLet- then map text comps_ `ppMultiSeqH` (pp "True")- else pp "True"- -- "PrintCode.ag"(line 170, column 7)- _addBang =- if bangpats _lhsIoptions- then \p -> "!" >|< p- else id- -- "PrintCode.ag"(line 176, column 16)- _lhsOpp =- _addStrictGuard $ ppTuple _lhsInested (map (_addBang . text) comps_)- in ( _lhsOpp))) )-sem_Lhs_UnboxedTupleLhs :: ([String]) ->- T_Lhs-sem_Lhs_UnboxedTupleLhs comps_ =- (T_Lhs (\ _lhsIisDeclOfLet- _lhsInested- _lhsIoptions- _lhsIoutputfile ->- (let _lhsOpp :: PP_Doc- -- "PrintCode.ag"(line 157, column 7)- _addStrictGuard =- if strictCases _lhsIoptions then \v -> v >#< "|" >#< _strictGuard else id- -- "PrintCode.ag"(line 161, column 7)- _strictGuard =- if stricterCases _lhsIoptions && not _lhsIisDeclOfLet- then map text comps_ `ppMultiSeqH` (pp "True")- else pp "True"- -- "PrintCode.ag"(line 170, column 7)- _addBang =- if bangpats _lhsIoptions- then \p -> "!" >|< p- else id- -- "PrintCode.ag"(line 177, column 23)- _lhsOpp =- _addStrictGuard $ ppUnboxedTuple _lhsInested (map (_addBang . text) comps_)- in ( _lhsOpp))) )--- Pattern ------------------------------------------------------{-- visit 0:- inherited attributes:- isDeclOfLet : Bool- options : Options- synthesized attributes:- copy : SELF- isUnderscore : Bool- pp : PP_Doc- pp' : PP_Doc- strictVars : [PP_Doc]- alternatives:- alternative Alias:- child field : {Name}- child attr : {Name}- child pat : Pattern- child parts : Patterns- visit 0:- local strictVar : _- local strictPatVars : _- local addBang : _- local ppVar : _- local copy : _- alternative Constr:- child name : {Constructor}- child pats : Patterns- visit 0:- local addBang : _- local copy : _- alternative Product:- child pos : {Pos}- child pats : Patterns- visit 0:- local addBang : _- 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 (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 (Bool ->- Options ->- ( Pattern,Bool,PP_Doc,PP_Doc,([PP_Doc])))-data Inh_Pattern = Inh_Pattern {isDeclOfLet_Inh_Pattern :: Bool,options_Inh_Pattern :: Options}-data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern,isUnderscore_Syn_Pattern :: Bool,pp_Syn_Pattern :: PP_Doc,pp'_Syn_Pattern :: PP_Doc,strictVars_Syn_Pattern :: [PP_Doc]}-wrap_Pattern (T_Pattern sem ) (Inh_Pattern _lhsIisDeclOfLet _lhsIoptions ) =- (let ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars) =- (sem _lhsIisDeclOfLet _lhsIoptions )- in (Syn_Pattern _lhsOcopy _lhsOisUnderscore _lhsOpp _lhsOpp' _lhsOstrictVars ))-sem_Pattern_Alias :: Name ->- Name ->- T_Pattern ->- T_Patterns ->- T_Pattern-sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) =- (T_Pattern (\ _lhsIisDeclOfLet- _lhsIoptions ->- (let _lhsOstrictVars :: ([PP_Doc])- _lhsOpp :: PP_Doc- _lhsOisUnderscore :: Bool- _lhsOpp' :: PP_Doc- _lhsOcopy :: Pattern- _patOisDeclOfLet :: Bool- _patOoptions :: Options- _partsOisDeclOfLet :: Bool- _partsOoptions :: Options- _patIcopy :: Pattern- _patIisUnderscore :: Bool- _patIpp :: PP_Doc- _patIpp' :: PP_Doc- _patIstrictVars :: ([PP_Doc])- _partsIcopy :: Patterns- _partsIpps :: ([PP_Doc])- _partsIpps' :: ([PP_Doc])- _partsIstrictVars :: ([PP_Doc])- -- "PrintCode.ag"(line 227, column 7)- _strictVar =- if strictCases _lhsIoptions && not _lhsIisDeclOfLet- then [_ppVar ]- else []- -- "PrintCode.ag"(line 231, column 7)- _strictPatVars =- if stricterCases _lhsIoptions && not _lhsIisDeclOfLet- then _patIstrictVars- else []- -- "PrintCode.ag"(line 235, column 7)- _lhsOstrictVars =- _strictVar ++ _strictPatVars- -- "PrintCode.ag"(line 249, column 7)- _addBang =- if bangpats _lhsIoptions && not _lhsIisDeclOfLet- then \p -> "!" >|< p- else id- -- "PrintCode.ag"(line 256, column 13)- _ppVar =- _addBang $ pp (attrname False field_ attr_)- -- "PrintCode.ag"(line 257, column 13)- _lhsOpp =- if _patIisUnderscore- then _ppVar- else _ppVar >|< "@" >|< _patIpp- -- "PrintCode.ag"(line 265, column 15)- _lhsOisUnderscore =- False- -- "PrintCode.ag"(line 279, column 13)- _lhsOpp' =- let attribute | field_ == _LOC || field_ == nullIdent = locname' attr_- | otherwise = attrname False field_ attr_- in attribute >|< "@" >|< _patIpp'- -- self rule- _copy =- Alias field_ attr_ _patIcopy _partsIcopy- -- self rule- _lhsOcopy =- _copy- -- copy rule (down)- _patOisDeclOfLet =- _lhsIisDeclOfLet- -- copy rule (down)- _patOoptions =- _lhsIoptions- -- copy rule (down)- _partsOisDeclOfLet =- _lhsIisDeclOfLet- -- copy rule (down)- _partsOoptions =- _lhsIoptions- ( _patIcopy,_patIisUnderscore,_patIpp,_patIpp',_patIstrictVars) =- (pat_ _patOisDeclOfLet _patOoptions )- ( _partsIcopy,_partsIpps,_partsIpps',_partsIstrictVars) =- (parts_ _partsOisDeclOfLet _partsOoptions )- in ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars))) )-sem_Pattern_Constr :: Constructor ->- T_Patterns ->- T_Pattern-sem_Pattern_Constr name_ (T_Patterns pats_ ) =- (T_Pattern (\ _lhsIisDeclOfLet- _lhsIoptions ->- (let _lhsOpp :: PP_Doc- _lhsOisUnderscore :: Bool- _lhsOpp' :: PP_Doc- _lhsOstrictVars :: ([PP_Doc])- _lhsOcopy :: Pattern- _patsOisDeclOfLet :: Bool- _patsOoptions :: Options- _patsIcopy :: Patterns- _patsIpps :: ([PP_Doc])- _patsIpps' :: ([PP_Doc])- _patsIstrictVars :: ([PP_Doc])- -- "PrintCode.ag"(line 249, column 7)- _addBang =- if bangpats _lhsIoptions && not _lhsIisDeclOfLet- then \p -> "!" >|< p- else id- -- "PrintCode.ag"(line 254, column 13)- _lhsOpp =- _addBang $ pp_parens $ name_ >#< hv_sp _patsIpps- -- "PrintCode.ag"(line 263, column 15)- _lhsOisUnderscore =- False- -- "PrintCode.ag"(line 277, column 13)- _lhsOpp' =- pp_parens $ name_ >#< hv_sp (map pp_parens _patsIpps')- -- use rule "PrintCode.ag"(line 224, column 40)- _lhsOstrictVars =- _patsIstrictVars- -- self rule- _copy =- Constr name_ _patsIcopy- -- self rule- _lhsOcopy =- _copy- -- copy rule (down)- _patsOisDeclOfLet =- _lhsIisDeclOfLet- -- copy rule (down)- _patsOoptions =- _lhsIoptions- ( _patsIcopy,_patsIpps,_patsIpps',_patsIstrictVars) =- (pats_ _patsOisDeclOfLet _patsOoptions )- in ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars))) )-sem_Pattern_Product :: Pos ->- T_Patterns ->- T_Pattern-sem_Pattern_Product pos_ (T_Patterns pats_ ) =- (T_Pattern (\ _lhsIisDeclOfLet- _lhsIoptions ->- (let _lhsOpp :: PP_Doc- _lhsOisUnderscore :: Bool- _lhsOpp' :: PP_Doc- _lhsOstrictVars :: ([PP_Doc])- _lhsOcopy :: Pattern- _patsOisDeclOfLet :: Bool- _patsOoptions :: Options- _patsIcopy :: Patterns- _patsIpps :: ([PP_Doc])- _patsIpps' :: ([PP_Doc])- _patsIstrictVars :: ([PP_Doc])- -- "PrintCode.ag"(line 249, column 7)- _addBang =- if bangpats _lhsIoptions && not _lhsIisDeclOfLet- then \p -> "!" >|< p- else id- -- "PrintCode.ag"(line 255, column 13)- _lhsOpp =- _addBang $ pp_block "(" ")" "," _patsIpps- -- "PrintCode.ag"(line 264, column 15)- _lhsOisUnderscore =- False- -- "PrintCode.ag"(line 278, column 13)- _lhsOpp' =- pp_block "(" ")" "," _patsIpps'- -- use rule "PrintCode.ag"(line 224, column 40)- _lhsOstrictVars =- _patsIstrictVars- -- self rule- _copy =- Product pos_ _patsIcopy- -- self rule- _lhsOcopy =- _copy- -- copy rule (down)- _patsOisDeclOfLet =- _lhsIisDeclOfLet- -- copy rule (down)- _patsOoptions =- _lhsIoptions- ( _patsIcopy,_patsIpps,_patsIpps',_patsIstrictVars) =- (pats_ _patsOisDeclOfLet _patsOoptions )- in ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars))) )-sem_Pattern_Underscore :: Pos ->- T_Pattern-sem_Pattern_Underscore pos_ =- (T_Pattern (\ _lhsIisDeclOfLet- _lhsIoptions ->- (let _lhsOpp :: PP_Doc- _lhsOisUnderscore :: Bool- _lhsOpp' :: PP_Doc- _lhsOstrictVars :: ([PP_Doc])- _lhsOcopy :: Pattern- -- "PrintCode.ag"(line 260, column 16)- _lhsOpp =- text "_"- -- "PrintCode.ag"(line 266, column 15)- _lhsOisUnderscore =- True- -- "PrintCode.ag"(line 282, column 16)- _lhsOpp' =- text "_"- -- use rule "PrintCode.ag"(line 224, column 40)- _lhsOstrictVars =- []- -- self rule- _copy =- Underscore pos_- -- self rule- _lhsOcopy =- _copy- in ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars))) )--- Patterns -----------------------------------------------------{-- visit 0:- inherited attributes:- isDeclOfLet : Bool- options : Options- synthesized attributes:- copy : SELF- pps : [PP_Doc]- pps' : [PP_Doc]- strictVars : [PP_Doc]- 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 (Bool ->- Options ->- ( Patterns,([PP_Doc]),([PP_Doc]),([PP_Doc])))-data Inh_Patterns = Inh_Patterns {isDeclOfLet_Inh_Patterns :: Bool,options_Inh_Patterns :: Options}-data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns,pps_Syn_Patterns :: [PP_Doc],pps'_Syn_Patterns :: [PP_Doc],strictVars_Syn_Patterns :: [PP_Doc]}-wrap_Patterns (T_Patterns sem ) (Inh_Patterns _lhsIisDeclOfLet _lhsIoptions ) =- (let ( _lhsOcopy,_lhsOpps,_lhsOpps',_lhsOstrictVars) =- (sem _lhsIisDeclOfLet _lhsIoptions )- in (Syn_Patterns _lhsOcopy _lhsOpps _lhsOpps' _lhsOstrictVars ))-sem_Patterns_Cons :: T_Pattern ->- T_Patterns ->- T_Patterns-sem_Patterns_Cons (T_Pattern hd_ ) (T_Patterns tl_ ) =- (T_Patterns (\ _lhsIisDeclOfLet- _lhsIoptions ->- (let _lhsOpps :: ([PP_Doc])- _lhsOpps' :: ([PP_Doc])- _lhsOstrictVars :: ([PP_Doc])- _lhsOcopy :: Patterns- _hdOisDeclOfLet :: Bool- _hdOoptions :: Options- _tlOisDeclOfLet :: Bool- _tlOoptions :: Options- _hdIcopy :: Pattern- _hdIisUnderscore :: Bool- _hdIpp :: PP_Doc- _hdIpp' :: PP_Doc- _hdIstrictVars :: ([PP_Doc])- _tlIcopy :: Patterns- _tlIpps :: ([PP_Doc])- _tlIpps' :: ([PP_Doc])- _tlIstrictVars :: ([PP_Doc])- -- "PrintCode.ag"(line 244, column 10)- _lhsOpps =- _hdIpp : _tlIpps- -- "PrintCode.ag"(line 273, column 10)- _lhsOpps' =- _hdIpp' : _tlIpps'- -- use rule "PrintCode.ag"(line 224, column 40)- _lhsOstrictVars =- _hdIstrictVars ++ _tlIstrictVars- -- self rule- _copy =- (:) _hdIcopy _tlIcopy- -- self rule- _lhsOcopy =- _copy- -- copy rule (down)- _hdOisDeclOfLet =- _lhsIisDeclOfLet- -- copy rule (down)- _hdOoptions =- _lhsIoptions- -- copy rule (down)- _tlOisDeclOfLet =- _lhsIisDeclOfLet- -- copy rule (down)- _tlOoptions =- _lhsIoptions- ( _hdIcopy,_hdIisUnderscore,_hdIpp,_hdIpp',_hdIstrictVars) =- (hd_ _hdOisDeclOfLet _hdOoptions )- ( _tlIcopy,_tlIpps,_tlIpps',_tlIstrictVars) =- (tl_ _tlOisDeclOfLet _tlOoptions )- in ( _lhsOcopy,_lhsOpps,_lhsOpps',_lhsOstrictVars))) )-sem_Patterns_Nil :: T_Patterns-sem_Patterns_Nil =- (T_Patterns (\ _lhsIisDeclOfLet- _lhsIoptions ->- (let _lhsOpps :: ([PP_Doc])- _lhsOpps' :: ([PP_Doc])- _lhsOstrictVars :: ([PP_Doc])- _lhsOcopy :: Patterns- -- "PrintCode.ag"(line 245, column 10)- _lhsOpps =- []- -- "PrintCode.ag"(line 274, column 10)- _lhsOpps' =- []- -- use rule "PrintCode.ag"(line 224, column 40)- _lhsOstrictVars =- []- -- self rule- _copy =- []- -- self rule- _lhsOcopy =- _copy- in ( _lhsOcopy,_lhsOpps,_lhsOpps',_lhsOstrictVars))) )--- Program ------------------------------------------------------{-- visit 0:- inherited attributes:- importBlocks : PP_Doc- mainFile : String- mainName : String- moduleHeader : String -> String -> String -> Bool -> String- options : Options- optionsLine : String- pragmaBlocks : String- textBlocks : PP_Doc- synthesized attributes:- genIO : IO ()- output : PP_Docs- alternatives:- alternative Program:- child chunks : Chunks- visit 0:- local mainModuleFile : _- local genMainModule : _- local commonFile : _- local genCommonModule : _--}--- cata-sem_Program :: Program ->- T_Program-sem_Program (Program _chunks ) =- (sem_Program_Program (sem_Chunks _chunks ) )--- semantic domain-newtype T_Program = T_Program (PP_Doc ->- String ->- String ->- (String -> String -> String -> Bool -> String) ->- Options ->- String ->- String ->- PP_Doc ->- ( (IO ()),PP_Docs))-data Inh_Program = Inh_Program {importBlocks_Inh_Program :: PP_Doc,mainFile_Inh_Program :: String,mainName_Inh_Program :: String,moduleHeader_Inh_Program :: String -> String -> String -> Bool -> String,options_Inh_Program :: Options,optionsLine_Inh_Program :: String,pragmaBlocks_Inh_Program :: String,textBlocks_Inh_Program :: PP_Doc}-data Syn_Program = Syn_Program {genIO_Syn_Program :: IO (),output_Syn_Program :: PP_Docs}-wrap_Program (T_Program sem ) (Inh_Program _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks ) =- (let ( _lhsOgenIO,_lhsOoutput) =- (sem _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks )- in (Syn_Program _lhsOgenIO _lhsOoutput ))-sem_Program_Program :: T_Chunks ->- T_Program-sem_Program_Program (T_Chunks chunks_ ) =- (T_Program (\ _lhsIimportBlocks- _lhsImainFile- _lhsImainName- _lhsImoduleHeader- _lhsIoptions- _lhsIoptionsLine- _lhsIpragmaBlocks- _lhsItextBlocks ->- (let _chunksOnested :: Bool- _lhsOoutput :: PP_Docs- _chunksOisDeclOfLet :: Bool- _lhsOgenIO :: (IO ())- _chunksOimportBlocks :: PP_Doc- _chunksOmainFile :: String- _chunksOmainName :: String- _chunksOmoduleHeader :: (String -> String -> String -> Bool -> String)- _chunksOoptions :: Options- _chunksOoptionsLine :: String- _chunksOpragmaBlocks :: String- _chunksOtextBlocks :: PP_Doc- _chunksIappendCommon :: ([[PP_Doc]])- _chunksIappendMain :: ([[PP_Doc]])- _chunksIgenSems :: (IO ())- _chunksIimports :: ([String])- _chunksIpps :: PP_Docs- -- "PrintCode.ag"(line 52, column 13)- _chunksOnested =- nest _lhsIoptions- -- "PrintCode.ag"(line 80, column 16)- _lhsOoutput =- _chunksIpps- -- "PrintCode.ag"(line 295, column 7)- _chunksOisDeclOfLet =- False- -- "PrintCode.ag"(line 324, column 7)- _mainModuleFile =- _lhsImainFile ++ ".hs"- -- "PrintCode.ag"(line 325, column 7)- _genMainModule =- writeModule _mainModuleFile- ( [ pp $ _lhsIpragmaBlocks- , pp $ _lhsIoptionsLine- , pp $ _lhsImoduleHeader _lhsImainName "" "" False- , pp $ ("import " ++ _lhsImainName ++ "_common\n")- ]- ++ map pp _chunksIimports- ++ map vlist _chunksIappendMain- )- -- "PrintCode.ag"(line 336, column 7)- _commonFile =- _lhsImainFile ++ "_common.hs"- -- "PrintCode.ag"(line 337, column 7)- _genCommonModule =- writeModule _commonFile- ( [ pp $ _lhsIpragmaBlocks- , pp $ _lhsIoptionsLine- , pp $ _lhsImoduleHeader _lhsImainName "_common" "" True- , _lhsIimportBlocks- , _lhsItextBlocks- ]- ++ map vlist _chunksIappendCommon- )- -- "PrintCode.ag"(line 348, column 7)- _lhsOgenIO =- do _genMainModule- _genCommonModule- _chunksIgenSems- -- copy rule (down)- _chunksOimportBlocks =- _lhsIimportBlocks- -- copy rule (down)- _chunksOmainFile =- _lhsImainFile- -- copy rule (down)- _chunksOmainName =- _lhsImainName- -- copy rule (down)- _chunksOmoduleHeader =- _lhsImoduleHeader- -- copy rule (down)- _chunksOoptions =- _lhsIoptions- -- copy rule (down)- _chunksOoptionsLine =- _lhsIoptionsLine- -- copy rule (down)- _chunksOpragmaBlocks =- _lhsIpragmaBlocks- -- copy rule (down)- _chunksOtextBlocks =- _lhsItextBlocks- ( _chunksIappendCommon,_chunksIappendMain,_chunksIgenSems,_chunksIimports,_chunksIpps) =- (chunks_ _chunksOimportBlocks _chunksOisDeclOfLet _chunksOmainFile _chunksOmainName _chunksOmoduleHeader _chunksOnested _chunksOoptions _chunksOoptionsLine _chunksOpragmaBlocks _chunksOtextBlocks )- in ( _lhsOgenIO,_lhsOoutput))) )--- Type ---------------------------------------------------------{-- visit 0:- inherited attribute:- nested : Bool- synthesized attributes:- pp : PP_Doc- prec : Int- alternatives:- alternative Arr:- child left : Type- child right : Type- visit 0:- local l : _- local r : _- alternative List:- child tp : Type- alternative SimpleType:- child txt : {String}- alternative TupleType:- child tps : Types- alternative UnboxedTupleType:- child tps : Types--}--- cata-sem_Type :: Type ->- T_Type-sem_Type (Arr _left _right ) =- (sem_Type_Arr (sem_Type _left ) (sem_Type _right ) )-sem_Type (List _tp ) =- (sem_Type_List (sem_Type _tp ) )-sem_Type (SimpleType _txt ) =- (sem_Type_SimpleType _txt )-sem_Type (TupleType _tps ) =- (sem_Type_TupleType (sem_Types _tps ) )-sem_Type (UnboxedTupleType _tps ) =- (sem_Type_UnboxedTupleType (sem_Types _tps ) )--- semantic domain-newtype T_Type = T_Type (Bool ->- ( PP_Doc,Int))-data Inh_Type = Inh_Type {nested_Inh_Type :: Bool}-data Syn_Type = Syn_Type {pp_Syn_Type :: PP_Doc,prec_Syn_Type :: Int}-wrap_Type (T_Type sem ) (Inh_Type _lhsInested ) =- (let ( _lhsOpp,_lhsOprec) =- (sem _lhsInested )- in (Syn_Type _lhsOpp _lhsOprec ))-sem_Type_Arr :: T_Type ->- T_Type ->- T_Type-sem_Type_Arr (T_Type left_ ) (T_Type right_ ) =- (T_Type (\ _lhsInested ->- (let _lhsOprec :: Int- _lhsOpp :: PP_Doc- _leftOnested :: Bool- _rightOnested :: Bool- _leftIpp :: PP_Doc- _leftIprec :: Int- _rightIpp :: PP_Doc- _rightIprec :: Int- -- "PrintCode.ag"(line 181, column 16)- _lhsOprec =- 2- -- "PrintCode.ag"(line 181, column 16)- _lhsOpp =- _l >#< "->" >-< _r- -- "PrintCode.ag"(line 183, column 16)- _l =- if _leftIprec <= 2 then pp_parens _leftIpp else _leftIpp- -- "PrintCode.ag"(line 183, column 16)- _r =- if _rightIprec < 2 then pp_parens _rightIpp else _rightIpp- -- copy rule (down)- _leftOnested =- _lhsInested- -- copy rule (down)- _rightOnested =- _lhsInested- ( _leftIpp,_leftIprec) =- (left_ _leftOnested )- ( _rightIpp,_rightIprec) =- (right_ _rightOnested )- in ( _lhsOpp,_lhsOprec))) )-sem_Type_List :: T_Type ->- T_Type-sem_Type_List (T_Type tp_ ) =- (T_Type (\ _lhsInested ->- (let _lhsOprec :: Int- _lhsOpp :: PP_Doc- _tpOnested :: Bool- _tpIpp :: PP_Doc- _tpIprec :: Int- -- "PrintCode.ag"(line 192, column 16)- _lhsOprec =- 5- -- "PrintCode.ag"(line 192, column 16)- _lhsOpp =- "[" >|< _tpIpp >|< "]"- -- copy rule (down)- _tpOnested =- _lhsInested- ( _tpIpp,_tpIprec) =- (tp_ _tpOnested )- in ( _lhsOpp,_lhsOprec))) )-sem_Type_SimpleType :: String ->- T_Type-sem_Type_SimpleType txt_ =- (T_Type (\ _lhsInested ->- (let _lhsOprec :: Int- _lhsOpp :: PP_Doc- -- "PrintCode.ag"(line 195, column 16)- _lhsOprec =- 5- -- "PrintCode.ag"(line 195, column 16)- _lhsOpp =- if reallySimple txt_ then text txt_ else pp_parens (text txt_)- in ( _lhsOpp,_lhsOprec))) )-sem_Type_TupleType :: T_Types ->- T_Type-sem_Type_TupleType (T_Types tps_ ) =- (T_Type (\ _lhsInested ->- (let _lhsOprec :: Int- _lhsOpp :: PP_Doc- _tpsOnested :: Bool- _tpsIpps :: PP_Docs- -- "PrintCode.ag"(line 186, column 16)- _lhsOprec =- 5- -- "PrintCode.ag"(line 186, column 16)- _lhsOpp =- ppTuple _lhsInested _tpsIpps- -- copy rule (down)- _tpsOnested =- _lhsInested- ( _tpsIpps) =- (tps_ _tpsOnested )- in ( _lhsOpp,_lhsOprec))) )-sem_Type_UnboxedTupleType :: T_Types ->- T_Type-sem_Type_UnboxedTupleType (T_Types tps_ ) =- (T_Type (\ _lhsInested ->- (let _lhsOprec :: Int- _lhsOpp :: PP_Doc- _tpsOnested :: Bool- _tpsIpps :: PP_Docs- -- "PrintCode.ag"(line 189, column 23)- _lhsOprec =- 5- -- "PrintCode.ag"(line 189, column 23)- _lhsOpp =- ppUnboxedTuple _lhsInested _tpsIpps- -- copy rule (down)- _tpsOnested =- _lhsInested- ( _tpsIpps) =- (tps_ _tpsOnested )- in ( _lhsOpp,_lhsOprec))) )--- Types --------------------------------------------------------{-- visit 0:- inherited attribute:- nested : Bool- synthesized attribute:- pps : PP_Docs- alternatives:- alternative Cons:- child hd : Type- child tl : Types- alternative Nil:--}--- cata-sem_Types :: Types ->- T_Types-sem_Types list =- (Prelude.foldr sem_Types_Cons sem_Types_Nil (Prelude.map sem_Type list) )--- semantic domain-newtype T_Types = T_Types (Bool ->- ( PP_Docs))-data Inh_Types = Inh_Types {nested_Inh_Types :: Bool}-data Syn_Types = Syn_Types {pps_Syn_Types :: PP_Docs}-wrap_Types (T_Types sem ) (Inh_Types _lhsInested ) =- (let ( _lhsOpps) =- (sem _lhsInested )- in (Syn_Types _lhsOpps ))-sem_Types_Cons :: T_Type ->- T_Types ->- T_Types-sem_Types_Cons (T_Type hd_ ) (T_Types tl_ ) =- (T_Types (\ _lhsInested ->- (let _lhsOpps :: PP_Docs- _hdOnested :: Bool- _tlOnested :: Bool- _hdIpp :: PP_Doc- _hdIprec :: Int- _tlIpps :: PP_Docs- -- "PrintCode.ag"(line 67, column 10)- _lhsOpps =- _hdIpp : _tlIpps- -- copy rule (down)- _hdOnested =- _lhsInested- -- copy rule (down)- _tlOnested =- _lhsInested- ( _hdIpp,_hdIprec) =- (hd_ _hdOnested )- ( _tlIpps) =- (tl_ _tlOnested )- in ( _lhsOpps))) )-sem_Types_Nil :: T_Types-sem_Types_Nil =- (T_Types (\ _lhsInested ->- (let _lhsOpps :: PP_Docs- -- "PrintCode.ag"(line 68, column 10)- _lhsOpps =- []- in ( _lhsOpps))) )+-- UUAGC 0.9.5 (PrintCode.ag)+module PrintCode where++import Char (isAlphaNum)+import Pretty+import Code+import Patterns+import Options+import CommonTypes (attrname, _LOC, getName, nullIdent)+import Data.List(intersperse)+import System.IO+import System.Directory++import Pretty+import Patterns+import Data.List(partition)+import Data.Set(Set)+import qualified UU.DData.Set as Set+import Data.Map(Map)+import qualified Data.Map as Map++-- Patterns.ag imports+import UU.Scanner.Position(Pos)+import CommonTypes (ConstructorIdent,Identifier)++type PP_Docs = [PP_Doc]++ppMultiSeqH :: [PP_Doc] -> PP_Doc -> PP_Doc+ppMultiSeqH = ppMultiSeq' (>#<)++ppMultiSeqV :: [PP_Doc] -> PP_Doc -> PP_Doc+ppMultiSeqV = ppMultiSeq' (>-<)++ppMultiSeq' :: (PP_Doc -> PP_Doc -> PP_Doc) -> [PP_Doc] -> PP_Doc -> PP_Doc+ppMultiSeq' next strictArgs expr+ = foldr (\v r -> (v >#< "`seq`") `next` pp_parens r) expr strictArgs+++reallySimple :: String -> Bool+reallySimple = and . map (\x -> isAlphaNum x || x=='_')++ppTuple True pps = "(" >|< pp_block " " (replicate (length pps `max` 1) ')') ",(" pps+ppTuple False pps = "(" >|< pp_block " " ")" "," pps+ppUnboxedTuple True pps = "(# " >|< pp_block " " (concat $ replicate (length pps `max` 1) " #)") ",(# " pps+ppUnboxedTuple False pps = "(# " >|< pp_block " " " #)" "," pps+++locname' n = "_loc_" ++ getName n++renderDocs :: [PP_Doc] -> String+renderDocs pps = foldr (.) id (map (\d -> (disp d 50000) . ( '\n':) ) pps) ""++writeModule :: FilePath -> [PP_Doc] -> IO ()+writeModule path docs+ = do bExists <- doesFileExist path+ if bExists+ then do input <- readFile path+ seq (length input) (return ())+ if input /= output+ then dumpIt+ else return ()+ else dumpIt+ where+ output = renderDocs docs+ dumpIt = writeFile path output++-- Unboxed tuples+-- unbox Whether unboxed tuples are wanted or not+-- inh The inherited attributes. +-- If there are none, no unboxing can take place, +-- because in that case the semantic function (a top-level identifier) would have an unboxed type.+-- Of course we can't have an unboxed 1-tuple+mkTupleExpr :: Bool -> Bool -> Exprs -> Expr+mkTupleExpr unbox noInh exprs | not unbox || noInh || length exprs == 1 = TupleExpr exprs+ | otherwise = UnboxedTupleExpr exprs+mkTupleType :: Bool -> Bool -> Types -> Type+mkTupleType unbox noInh tps | not unbox || noInh || length tps == 1 = TupleType tps+ | otherwise = UnboxedTupleType tps+mkTupleLhs :: Bool -> Bool -> [String] -> Lhs+mkTupleLhs unbox noInh comps | not unbox || noInh || length comps == 1 = TupleLhs comps+ | otherwise = UnboxedTupleLhs comps+-- CaseAlt -----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ nested : Bool+ options : Options+ outputfile : String+ synthesized attribute:+ pps : PP_Docs+ alternatives:+ alternative CaseAlt:+ child left : Lhs+ child expr : Expr+-}+-- cata+sem_CaseAlt :: CaseAlt ->+ T_CaseAlt+sem_CaseAlt (CaseAlt _left _expr) =+ (sem_CaseAlt_CaseAlt (sem_Lhs _left) (sem_Expr _expr))+-- semantic domain+newtype T_CaseAlt = T_CaseAlt (Bool ->+ Options ->+ String ->+ ( PP_Docs))+data Inh_CaseAlt = Inh_CaseAlt {nested_Inh_CaseAlt :: Bool,options_Inh_CaseAlt :: Options,outputfile_Inh_CaseAlt :: String}+data Syn_CaseAlt = Syn_CaseAlt {pps_Syn_CaseAlt :: PP_Docs}+wrap_CaseAlt (T_CaseAlt sem) (Inh_CaseAlt _lhsInested _lhsIoptions _lhsIoutputfile) =+ (let ( _lhsOpps) =+ (sem _lhsInested _lhsIoptions _lhsIoutputfile)+ in (Syn_CaseAlt _lhsOpps))+sem_CaseAlt_CaseAlt :: T_Lhs ->+ T_Expr ->+ T_CaseAlt+sem_CaseAlt_CaseAlt (T_Lhs left_) (T_Expr expr_) =+ (T_CaseAlt (\ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpps :: PP_Docs+ _leftOisDeclOfLet :: Bool+ _leftOnested :: Bool+ _leftOoptions :: Options+ _leftOoutputfile :: String+ _exprOnested :: Bool+ _exprOoptions :: Options+ _exprOoutputfile :: String+ _leftIpp :: PP_Doc+ _exprIpp :: PP_Doc+ -- "PrintCode.ag"(line 150, column 16)+ _lhsOpps =+ ["{" >#< _leftIpp >#< "->", _exprIpp >#< "}"]+ -- "PrintCode.ag"(line 326, column 7)+ _leftOisDeclOfLet =+ False+ -- copy rule (down)+ _leftOnested =+ _lhsInested+ -- copy rule (down)+ _leftOoptions =+ _lhsIoptions+ -- copy rule (down)+ _leftOoutputfile =+ _lhsIoutputfile+ -- copy rule (down)+ _exprOnested =+ _lhsInested+ -- copy rule (down)+ _exprOoptions =+ _lhsIoptions+ -- copy rule (down)+ _exprOoutputfile =+ _lhsIoutputfile+ ( _leftIpp) =+ (left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile)+ ( _exprIpp) =+ (expr_ _exprOnested _exprOoptions _exprOoutputfile)+ in ( _lhsOpps))))+-- CaseAlts ----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ nested : Bool+ options : Options+ outputfile : String+ synthesized attribute:+ pps : PP_Docs+ alternatives:+ alternative Cons:+ child hd : CaseAlt+ child tl : CaseAlts+ alternative Nil:+-}+-- cata+sem_CaseAlts :: CaseAlts ->+ T_CaseAlts+sem_CaseAlts list =+ (Prelude.foldr sem_CaseAlts_Cons sem_CaseAlts_Nil (Prelude.map sem_CaseAlt list))+-- semantic domain+newtype T_CaseAlts = T_CaseAlts (Bool ->+ Options ->+ String ->+ ( PP_Docs))+data Inh_CaseAlts = Inh_CaseAlts {nested_Inh_CaseAlts :: Bool,options_Inh_CaseAlts :: Options,outputfile_Inh_CaseAlts :: String}+data Syn_CaseAlts = Syn_CaseAlts {pps_Syn_CaseAlts :: PP_Docs}+wrap_CaseAlts (T_CaseAlts sem) (Inh_CaseAlts _lhsInested _lhsIoptions _lhsIoutputfile) =+ (let ( _lhsOpps) =+ (sem _lhsInested _lhsIoptions _lhsIoutputfile)+ in (Syn_CaseAlts _lhsOpps))+sem_CaseAlts_Cons :: T_CaseAlt ->+ T_CaseAlts ->+ T_CaseAlts+sem_CaseAlts_Cons (T_CaseAlt hd_) (T_CaseAlts tl_) =+ (T_CaseAlts (\ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpps :: PP_Docs+ _hdOnested :: Bool+ _hdOoptions :: Options+ _hdOoutputfile :: String+ _tlOnested :: Bool+ _tlOoptions :: Options+ _tlOoutputfile :: String+ _hdIpps :: PP_Docs+ _tlIpps :: PP_Docs+ -- "PrintCode.ag"(line 59, column 10)+ _lhsOpps =+ _hdIpps ++ _tlIpps+ -- copy rule (down)+ _hdOnested =+ _lhsInested+ -- copy rule (down)+ _hdOoptions =+ _lhsIoptions+ -- copy rule (down)+ _hdOoutputfile =+ _lhsIoutputfile+ -- copy rule (down)+ _tlOnested =+ _lhsInested+ -- copy rule (down)+ _tlOoptions =+ _lhsIoptions+ -- copy rule (down)+ _tlOoutputfile =+ _lhsIoutputfile+ ( _hdIpps) =+ (hd_ _hdOnested _hdOoptions _hdOoutputfile)+ ( _tlIpps) =+ (tl_ _tlOnested _tlOoptions _tlOoutputfile)+ in ( _lhsOpps))))+sem_CaseAlts_Nil :: T_CaseAlts+sem_CaseAlts_Nil =+ (T_CaseAlts (\ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpps :: PP_Docs+ -- "PrintCode.ag"(line 60, column 10)+ _lhsOpps =+ []+ in ( _lhsOpps))))+-- Chunk -------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ importBlocks : PP_Doc+ isDeclOfLet : Bool+ mainFile : String+ mainName : String+ moduleHeader : String -> String -> String -> Bool -> String+ nested : Bool+ options : Options+ optionsLine : String+ pragmaBlocks : String+ textBlocks : PP_Doc+ synthesized attributes:+ appendCommon : [[PP_Doc]]+ appendMain : [[PP_Doc]]+ genSems : IO ()+ imports : [String]+ pps : PP_Docs+ alternatives:+ alternative Chunk:+ child name : {String}+ child comment : Decl+ child info : Decls+ child dataDef : Decls+ child cataFun : Decls+ child semDom : Decls+ child semWrapper : Decls+ child semFunctions : Decls+ child semNames : {[String]}+ visit 0:+ local outputfile : _+ local exports : _+-}+-- cata+sem_Chunk :: Chunk ->+ T_Chunk+sem_Chunk (Chunk _name _comment _info _dataDef _cataFun _semDom _semWrapper _semFunctions _semNames) =+ (sem_Chunk_Chunk _name (sem_Decl _comment) (sem_Decls _info) (sem_Decls _dataDef) (sem_Decls _cataFun) (sem_Decls _semDom) (sem_Decls _semWrapper) (sem_Decls _semFunctions) _semNames)+-- semantic domain+newtype T_Chunk = T_Chunk (PP_Doc ->+ Bool ->+ String ->+ String ->+ (String -> String -> String -> Bool -> String) ->+ Bool ->+ Options ->+ String ->+ String ->+ PP_Doc ->+ ( ([[PP_Doc]]),([[PP_Doc]]),(IO ()),([String]),PP_Docs))+data Inh_Chunk = Inh_Chunk {importBlocks_Inh_Chunk :: PP_Doc,isDeclOfLet_Inh_Chunk :: Bool,mainFile_Inh_Chunk :: String,mainName_Inh_Chunk :: String,moduleHeader_Inh_Chunk :: String -> String -> String -> Bool -> String,nested_Inh_Chunk :: Bool,options_Inh_Chunk :: Options,optionsLine_Inh_Chunk :: String,pragmaBlocks_Inh_Chunk :: String,textBlocks_Inh_Chunk :: PP_Doc}+data Syn_Chunk = Syn_Chunk {appendCommon_Syn_Chunk :: [[PP_Doc]],appendMain_Syn_Chunk :: [[PP_Doc]],genSems_Syn_Chunk :: IO (),imports_Syn_Chunk :: [String],pps_Syn_Chunk :: PP_Docs}+wrap_Chunk (T_Chunk sem) (Inh_Chunk _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks) =+ (let ( _lhsOappendCommon,_lhsOappendMain,_lhsOgenSems,_lhsOimports,_lhsOpps) =+ (sem _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks)+ in (Syn_Chunk _lhsOappendCommon _lhsOappendMain _lhsOgenSems _lhsOimports _lhsOpps))+sem_Chunk_Chunk :: String ->+ T_Decl ->+ T_Decls ->+ T_Decls ->+ T_Decls ->+ T_Decls ->+ T_Decls ->+ T_Decls ->+ ([String]) ->+ T_Chunk+sem_Chunk_Chunk name_ (T_Decl comment_) (T_Decls info_) (T_Decls dataDef_) (T_Decls cataFun_) (T_Decls semDom_) (T_Decls semWrapper_) (T_Decls semFunctions_) semNames_ =+ (T_Chunk (\ _lhsIimportBlocks+ _lhsIisDeclOfLet+ _lhsImainFile+ _lhsImainName+ _lhsImoduleHeader+ _lhsInested+ _lhsIoptions+ _lhsIoptionsLine+ _lhsIpragmaBlocks+ _lhsItextBlocks ->+ (let _lhsOpps :: PP_Docs+ _lhsOimports :: ([String])+ _lhsOappendCommon :: ([[PP_Doc]])+ _lhsOappendMain :: ([[PP_Doc]])+ _lhsOgenSems :: (IO ())+ _commentOisDeclOfLet :: Bool+ _commentOnested :: Bool+ _commentOoptions :: Options+ _commentOoutputfile :: String+ _infoOisDeclOfLet :: Bool+ _infoOnested :: Bool+ _infoOoptions :: Options+ _infoOoutputfile :: String+ _dataDefOisDeclOfLet :: Bool+ _dataDefOnested :: Bool+ _dataDefOoptions :: Options+ _dataDefOoutputfile :: String+ _cataFunOisDeclOfLet :: Bool+ _cataFunOnested :: Bool+ _cataFunOoptions :: Options+ _cataFunOoutputfile :: String+ _semDomOisDeclOfLet :: Bool+ _semDomOnested :: Bool+ _semDomOoptions :: Options+ _semDomOoutputfile :: String+ _semWrapperOisDeclOfLet :: Bool+ _semWrapperOnested :: Bool+ _semWrapperOoptions :: Options+ _semWrapperOoutputfile :: String+ _semFunctionsOisDeclOfLet :: Bool+ _semFunctionsOnested :: Bool+ _semFunctionsOoptions :: Options+ _semFunctionsOoutputfile :: String+ _commentIpp :: PP_Doc+ _infoIpps :: PP_Docs+ _dataDefIpps :: PP_Docs+ _cataFunIpps :: PP_Docs+ _semDomIpps :: PP_Docs+ _semWrapperIpps :: PP_Docs+ _semFunctionsIpps :: PP_Docs+ -- "PrintCode.ag"(line 37, column 7)+ _outputfile =+ if sepSemMods _lhsIoptions+ then _lhsImainFile ++ "_" ++ name_ ++ ".hs"+ else _lhsImainFile ++ ".hs"+ -- "PrintCode.ag"(line 83, column 16)+ _lhsOpps =+ _commentIpp+ : _infoIpps+ ++ _dataDefIpps+ ++ _cataFunIpps+ ++ _semDomIpps+ ++ _semWrapperIpps+ ++ _semFunctionsIpps+ -- "PrintCode.ag"(line 383, column 7)+ _lhsOimports =+ ["import " ++ _lhsImainName ++ "_" ++ name_ ++ "\n"]+ -- "PrintCode.ag"(line 389, column 7)+ _lhsOappendCommon =+ [ [_commentIpp]+ , _dataDefIpps+ , _semDomIpps+ ]+ -- "PrintCode.ag"(line 394, column 7)+ _lhsOappendMain =+ [ [_commentIpp]+ , _cataFunIpps+ , _semWrapperIpps+ ]+ -- "PrintCode.ag"(line 404, column 7)+ _lhsOgenSems =+ writeModule _outputfile+ [ pp $ _lhsIpragmaBlocks+ , pp $ _lhsIoptionsLine+ , pp $ _lhsImoduleHeader _lhsImainName ("_" ++ name_) _exports True+ , pp $ ("import " ++ _lhsImainName ++ "_common\n")+ , _commentIpp+ , vlist_sep "" _infoIpps+ , vlist_sep "" _semFunctionsIpps+ ]+ -- "PrintCode.ag"(line 417, column 7)+ _exports =+ concat $ intersperse "," semNames_+ -- copy rule (down)+ _commentOisDeclOfLet =+ _lhsIisDeclOfLet+ -- copy rule (down)+ _commentOnested =+ _lhsInested+ -- copy rule (down)+ _commentOoptions =+ _lhsIoptions+ -- copy rule (from local)+ _commentOoutputfile =+ _outputfile+ -- copy rule (down)+ _infoOisDeclOfLet =+ _lhsIisDeclOfLet+ -- copy rule (down)+ _infoOnested =+ _lhsInested+ -- copy rule (down)+ _infoOoptions =+ _lhsIoptions+ -- copy rule (from local)+ _infoOoutputfile =+ _outputfile+ -- copy rule (down)+ _dataDefOisDeclOfLet =+ _lhsIisDeclOfLet+ -- copy rule (down)+ _dataDefOnested =+ _lhsInested+ -- copy rule (down)+ _dataDefOoptions =+ _lhsIoptions+ -- copy rule (from local)+ _dataDefOoutputfile =+ _outputfile+ -- copy rule (down)+ _cataFunOisDeclOfLet =+ _lhsIisDeclOfLet+ -- copy rule (down)+ _cataFunOnested =+ _lhsInested+ -- copy rule (down)+ _cataFunOoptions =+ _lhsIoptions+ -- copy rule (from local)+ _cataFunOoutputfile =+ _outputfile+ -- copy rule (down)+ _semDomOisDeclOfLet =+ _lhsIisDeclOfLet+ -- copy rule (down)+ _semDomOnested =+ _lhsInested+ -- copy rule (down)+ _semDomOoptions =+ _lhsIoptions+ -- copy rule (from local)+ _semDomOoutputfile =+ _outputfile+ -- copy rule (down)+ _semWrapperOisDeclOfLet =+ _lhsIisDeclOfLet+ -- copy rule (down)+ _semWrapperOnested =+ _lhsInested+ -- copy rule (down)+ _semWrapperOoptions =+ _lhsIoptions+ -- copy rule (from local)+ _semWrapperOoutputfile =+ _outputfile+ -- copy rule (down)+ _semFunctionsOisDeclOfLet =+ _lhsIisDeclOfLet+ -- copy rule (down)+ _semFunctionsOnested =+ _lhsInested+ -- copy rule (down)+ _semFunctionsOoptions =+ _lhsIoptions+ -- copy rule (from local)+ _semFunctionsOoutputfile =+ _outputfile+ ( _commentIpp) =+ (comment_ _commentOisDeclOfLet _commentOnested _commentOoptions _commentOoutputfile)+ ( _infoIpps) =+ (info_ _infoOisDeclOfLet _infoOnested _infoOoptions _infoOoutputfile)+ ( _dataDefIpps) =+ (dataDef_ _dataDefOisDeclOfLet _dataDefOnested _dataDefOoptions _dataDefOoutputfile)+ ( _cataFunIpps) =+ (cataFun_ _cataFunOisDeclOfLet _cataFunOnested _cataFunOoptions _cataFunOoutputfile)+ ( _semDomIpps) =+ (semDom_ _semDomOisDeclOfLet _semDomOnested _semDomOoptions _semDomOoutputfile)+ ( _semWrapperIpps) =+ (semWrapper_ _semWrapperOisDeclOfLet _semWrapperOnested _semWrapperOoptions _semWrapperOoutputfile)+ ( _semFunctionsIpps) =+ (semFunctions_ _semFunctionsOisDeclOfLet _semFunctionsOnested _semFunctionsOoptions _semFunctionsOoutputfile)+ in ( _lhsOappendCommon,_lhsOappendMain,_lhsOgenSems,_lhsOimports,_lhsOpps))))+-- Chunks ------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ importBlocks : PP_Doc+ isDeclOfLet : Bool+ mainFile : String+ mainName : String+ moduleHeader : String -> String -> String -> Bool -> String+ nested : Bool+ options : Options+ optionsLine : String+ pragmaBlocks : String+ textBlocks : PP_Doc+ synthesized attributes:+ appendCommon : [[PP_Doc]]+ appendMain : [[PP_Doc]]+ genSems : IO ()+ imports : [String]+ pps : PP_Docs+ alternatives:+ alternative Cons:+ child hd : Chunk+ child tl : Chunks+ alternative Nil:+-}+-- cata+sem_Chunks :: Chunks ->+ T_Chunks+sem_Chunks list =+ (Prelude.foldr sem_Chunks_Cons sem_Chunks_Nil (Prelude.map sem_Chunk list))+-- semantic domain+newtype T_Chunks = T_Chunks (PP_Doc ->+ Bool ->+ String ->+ String ->+ (String -> String -> String -> Bool -> String) ->+ Bool ->+ Options ->+ String ->+ String ->+ PP_Doc ->+ ( ([[PP_Doc]]),([[PP_Doc]]),(IO ()),([String]),PP_Docs))+data Inh_Chunks = Inh_Chunks {importBlocks_Inh_Chunks :: PP_Doc,isDeclOfLet_Inh_Chunks :: Bool,mainFile_Inh_Chunks :: String,mainName_Inh_Chunks :: String,moduleHeader_Inh_Chunks :: String -> String -> String -> Bool -> String,nested_Inh_Chunks :: Bool,options_Inh_Chunks :: Options,optionsLine_Inh_Chunks :: String,pragmaBlocks_Inh_Chunks :: String,textBlocks_Inh_Chunks :: PP_Doc}+data Syn_Chunks = Syn_Chunks {appendCommon_Syn_Chunks :: [[PP_Doc]],appendMain_Syn_Chunks :: [[PP_Doc]],genSems_Syn_Chunks :: IO (),imports_Syn_Chunks :: [String],pps_Syn_Chunks :: PP_Docs}+wrap_Chunks (T_Chunks sem) (Inh_Chunks _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks) =+ (let ( _lhsOappendCommon,_lhsOappendMain,_lhsOgenSems,_lhsOimports,_lhsOpps) =+ (sem _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks)+ in (Syn_Chunks _lhsOappendCommon _lhsOappendMain _lhsOgenSems _lhsOimports _lhsOpps))+sem_Chunks_Cons :: T_Chunk ->+ T_Chunks ->+ T_Chunks+sem_Chunks_Cons (T_Chunk hd_) (T_Chunks tl_) =+ (T_Chunks (\ _lhsIimportBlocks+ _lhsIisDeclOfLet+ _lhsImainFile+ _lhsImainName+ _lhsImoduleHeader+ _lhsInested+ _lhsIoptions+ _lhsIoptionsLine+ _lhsIpragmaBlocks+ _lhsItextBlocks ->+ (let _lhsOpps :: PP_Docs+ _lhsOappendCommon :: ([[PP_Doc]])+ _lhsOappendMain :: ([[PP_Doc]])+ _lhsOgenSems :: (IO ())+ _lhsOimports :: ([String])+ _hdOimportBlocks :: PP_Doc+ _hdOisDeclOfLet :: Bool+ _hdOmainFile :: String+ _hdOmainName :: String+ _hdOmoduleHeader :: (String -> String -> String -> Bool -> String)+ _hdOnested :: Bool+ _hdOoptions :: Options+ _hdOoptionsLine :: String+ _hdOpragmaBlocks :: String+ _hdOtextBlocks :: PP_Doc+ _tlOimportBlocks :: PP_Doc+ _tlOisDeclOfLet :: Bool+ _tlOmainFile :: String+ _tlOmainName :: String+ _tlOmoduleHeader :: (String -> String -> String -> Bool -> String)+ _tlOnested :: Bool+ _tlOoptions :: Options+ _tlOoptionsLine :: String+ _tlOpragmaBlocks :: String+ _tlOtextBlocks :: PP_Doc+ _hdIappendCommon :: ([[PP_Doc]])+ _hdIappendMain :: ([[PP_Doc]])+ _hdIgenSems :: (IO ())+ _hdIimports :: ([String])+ _hdIpps :: PP_Docs+ _tlIappendCommon :: ([[PP_Doc]])+ _tlIappendMain :: ([[PP_Doc]])+ _tlIgenSems :: (IO ())+ _tlIimports :: ([String])+ _tlIpps :: PP_Docs+ -- "PrintCode.ag"(line 75, column 10)+ _lhsOpps =+ _hdIpps ++ _tlIpps+ -- use rule "PrintCode.ag"(line 385, column 50)+ _lhsOappendCommon =+ _hdIappendCommon ++ _tlIappendCommon+ -- use rule "PrintCode.ag"(line 385, column 50)+ _lhsOappendMain =+ _hdIappendMain ++ _tlIappendMain+ -- use rule "PrintCode.ag"(line 400, column 33)+ _lhsOgenSems =+ _hdIgenSems >> _tlIgenSems+ -- use rule "PrintCode.ag"(line 380, column 33)+ _lhsOimports =+ _hdIimports ++ _tlIimports+ -- copy rule (down)+ _hdOimportBlocks =+ _lhsIimportBlocks+ -- copy rule (down)+ _hdOisDeclOfLet =+ _lhsIisDeclOfLet+ -- copy rule (down)+ _hdOmainFile =+ _lhsImainFile+ -- copy rule (down)+ _hdOmainName =+ _lhsImainName+ -- copy rule (down)+ _hdOmoduleHeader =+ _lhsImoduleHeader+ -- copy rule (down)+ _hdOnested =+ _lhsInested+ -- copy rule (down)+ _hdOoptions =+ _lhsIoptions+ -- copy rule (down)+ _hdOoptionsLine =+ _lhsIoptionsLine+ -- copy rule (down)+ _hdOpragmaBlocks =+ _lhsIpragmaBlocks+ -- copy rule (down)+ _hdOtextBlocks =+ _lhsItextBlocks+ -- copy rule (down)+ _tlOimportBlocks =+ _lhsIimportBlocks+ -- copy rule (down)+ _tlOisDeclOfLet =+ _lhsIisDeclOfLet+ -- copy rule (down)+ _tlOmainFile =+ _lhsImainFile+ -- copy rule (down)+ _tlOmainName =+ _lhsImainName+ -- copy rule (down)+ _tlOmoduleHeader =+ _lhsImoduleHeader+ -- copy rule (down)+ _tlOnested =+ _lhsInested+ -- copy rule (down)+ _tlOoptions =+ _lhsIoptions+ -- copy rule (down)+ _tlOoptionsLine =+ _lhsIoptionsLine+ -- copy rule (down)+ _tlOpragmaBlocks =+ _lhsIpragmaBlocks+ -- copy rule (down)+ _tlOtextBlocks =+ _lhsItextBlocks+ ( _hdIappendCommon,_hdIappendMain,_hdIgenSems,_hdIimports,_hdIpps) =+ (hd_ _hdOimportBlocks _hdOisDeclOfLet _hdOmainFile _hdOmainName _hdOmoduleHeader _hdOnested _hdOoptions _hdOoptionsLine _hdOpragmaBlocks _hdOtextBlocks)+ ( _tlIappendCommon,_tlIappendMain,_tlIgenSems,_tlIimports,_tlIpps) =+ (tl_ _tlOimportBlocks _tlOisDeclOfLet _tlOmainFile _tlOmainName _tlOmoduleHeader _tlOnested _tlOoptions _tlOoptionsLine _tlOpragmaBlocks _tlOtextBlocks)+ in ( _lhsOappendCommon,_lhsOappendMain,_lhsOgenSems,_lhsOimports,_lhsOpps))))+sem_Chunks_Nil :: T_Chunks+sem_Chunks_Nil =+ (T_Chunks (\ _lhsIimportBlocks+ _lhsIisDeclOfLet+ _lhsImainFile+ _lhsImainName+ _lhsImoduleHeader+ _lhsInested+ _lhsIoptions+ _lhsIoptionsLine+ _lhsIpragmaBlocks+ _lhsItextBlocks ->+ (let _lhsOpps :: PP_Docs+ _lhsOappendCommon :: ([[PP_Doc]])+ _lhsOappendMain :: ([[PP_Doc]])+ _lhsOgenSems :: (IO ())+ _lhsOimports :: ([String])+ -- "PrintCode.ag"(line 76, column 10)+ _lhsOpps =+ []+ -- use rule "PrintCode.ag"(line 385, column 50)+ _lhsOappendCommon =+ []+ -- use rule "PrintCode.ag"(line 385, column 50)+ _lhsOappendMain =+ []+ -- use rule "PrintCode.ag"(line 400, column 33)+ _lhsOgenSems =+ return ()+ -- use rule "PrintCode.ag"(line 380, column 33)+ _lhsOimports =+ []+ in ( _lhsOappendCommon,_lhsOappendMain,_lhsOgenSems,_lhsOimports,_lhsOpps))))+-- DataAlt -----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ nested : Bool+ strictPre : PP_Doc+ synthesized attribute:+ pp : PP_Doc+ alternatives:+ alternative DataAlt:+ child name : {String}+ child args : {[String]}+ alternative Record:+ child name : {String}+ child args : {[(String,String)]}+-}+-- cata+sem_DataAlt :: DataAlt ->+ T_DataAlt+sem_DataAlt (DataAlt _name _args) =+ (sem_DataAlt_DataAlt _name _args)+sem_DataAlt (Record _name _args) =+ (sem_DataAlt_Record _name _args)+-- semantic domain+newtype T_DataAlt = T_DataAlt (Bool ->+ PP_Doc ->+ ( PP_Doc))+data Inh_DataAlt = Inh_DataAlt {nested_Inh_DataAlt :: Bool,strictPre_Inh_DataAlt :: PP_Doc}+data Syn_DataAlt = Syn_DataAlt {pp_Syn_DataAlt :: PP_Doc}+wrap_DataAlt (T_DataAlt sem) (Inh_DataAlt _lhsInested _lhsIstrictPre) =+ (let ( _lhsOpp) =+ (sem _lhsInested _lhsIstrictPre)+ in (Syn_DataAlt _lhsOpp))+sem_DataAlt_DataAlt :: String ->+ ([String]) ->+ T_DataAlt+sem_DataAlt_DataAlt name_ args_ =+ (T_DataAlt (\ _lhsInested+ _lhsIstrictPre ->+ (let _lhsOpp :: PP_Doc+ -- "PrintCode.ag"(line 153, column 16)+ _lhsOpp =+ name_ >#< hv_sp (map ((_lhsIstrictPre >|<) . pp_parens . text) args_)+ in ( _lhsOpp))))+sem_DataAlt_Record :: String ->+ ([(String,String)]) ->+ T_DataAlt+sem_DataAlt_Record name_ args_ =+ (T_DataAlt (\ _lhsInested+ _lhsIstrictPre ->+ (let _lhsOpp :: PP_Doc+ -- "PrintCode.ag"(line 154, column 16)+ _lhsOpp =+ name_ >#< pp_block "{" "}" ","+ [ f >#< "::" >#< t | (f,t) <- args_ ]+ in ( _lhsOpp))))+-- DataAlts ----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ nested : Bool+ strictPre : PP_Doc+ synthesized attribute:+ pps : PP_Docs+ alternatives:+ alternative Cons:+ child hd : DataAlt+ child tl : DataAlts+ alternative Nil:+-}+-- cata+sem_DataAlts :: DataAlts ->+ T_DataAlts+sem_DataAlts list =+ (Prelude.foldr sem_DataAlts_Cons sem_DataAlts_Nil (Prelude.map sem_DataAlt list))+-- semantic domain+newtype T_DataAlts = T_DataAlts (Bool ->+ PP_Doc ->+ ( PP_Docs))+data Inh_DataAlts = Inh_DataAlts {nested_Inh_DataAlts :: Bool,strictPre_Inh_DataAlts :: PP_Doc}+data Syn_DataAlts = Syn_DataAlts {pps_Syn_DataAlts :: PP_Docs}+wrap_DataAlts (T_DataAlts sem) (Inh_DataAlts _lhsInested _lhsIstrictPre) =+ (let ( _lhsOpps) =+ (sem _lhsInested _lhsIstrictPre)+ in (Syn_DataAlts _lhsOpps))+sem_DataAlts_Cons :: T_DataAlt ->+ T_DataAlts ->+ T_DataAlts+sem_DataAlts_Cons (T_DataAlt hd_) (T_DataAlts tl_) =+ (T_DataAlts (\ _lhsInested+ _lhsIstrictPre ->+ (let _lhsOpps :: PP_Docs+ _hdOnested :: Bool+ _hdOstrictPre :: PP_Doc+ _tlOnested :: Bool+ _tlOstrictPre :: PP_Doc+ _hdIpp :: PP_Doc+ _tlIpps :: PP_Docs+ -- "PrintCode.ag"(line 63, column 10)+ _lhsOpps =+ _hdIpp : _tlIpps+ -- copy rule (down)+ _hdOnested =+ _lhsInested+ -- copy rule (down)+ _hdOstrictPre =+ _lhsIstrictPre+ -- copy rule (down)+ _tlOnested =+ _lhsInested+ -- copy rule (down)+ _tlOstrictPre =+ _lhsIstrictPre+ ( _hdIpp) =+ (hd_ _hdOnested _hdOstrictPre)+ ( _tlIpps) =+ (tl_ _tlOnested _tlOstrictPre)+ in ( _lhsOpps))))+sem_DataAlts_Nil :: T_DataAlts+sem_DataAlts_Nil =+ (T_DataAlts (\ _lhsInested+ _lhsIstrictPre ->+ (let _lhsOpps :: PP_Docs+ -- "PrintCode.ag"(line 64, column 10)+ _lhsOpps =+ []+ in ( _lhsOpps))))+-- Decl --------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ isDeclOfLet : Bool+ nested : Bool+ options : Options+ outputfile : String+ synthesized attribute:+ pp : PP_Doc+ alternatives:+ alternative Comment:+ child txt : {String}+ alternative Data:+ child name : {String}+ child params : {[String]}+ child alts : DataAlts+ child strict : {Bool}+ child derivings : {[String]}+ alternative Decl:+ child left : Lhs+ child rhs : Expr+ child binds : {Set String}+ child uses : {Set String}+ alternative NewType:+ child name : {String}+ child params : {[String]}+ child con : {String}+ child tp : Type+ alternative PragmaDecl:+ child txt : {String}+ alternative TSig:+ child name : {String}+ child tp : Type+ alternative Type:+ child name : {String}+ child params : {[String]}+ child tp : Type+-}+-- cata+sem_Decl :: Decl ->+ T_Decl+sem_Decl (Comment _txt) =+ (sem_Decl_Comment _txt)+sem_Decl (Data _name _params _alts _strict _derivings) =+ (sem_Decl_Data _name _params (sem_DataAlts _alts) _strict _derivings)+sem_Decl (Decl _left _rhs _binds _uses) =+ (sem_Decl_Decl (sem_Lhs _left) (sem_Expr _rhs) _binds _uses)+sem_Decl (NewType _name _params _con _tp) =+ (sem_Decl_NewType _name _params _con (sem_Type _tp))+sem_Decl (PragmaDecl _txt) =+ (sem_Decl_PragmaDecl _txt)+sem_Decl (TSig _name _tp) =+ (sem_Decl_TSig _name (sem_Type _tp))+sem_Decl (Type _name _params _tp) =+ (sem_Decl_Type _name _params (sem_Type _tp))+-- semantic domain+newtype T_Decl = T_Decl (Bool ->+ Bool ->+ Options ->+ String ->+ ( PP_Doc))+data Inh_Decl = Inh_Decl {isDeclOfLet_Inh_Decl :: Bool,nested_Inh_Decl :: Bool,options_Inh_Decl :: Options,outputfile_Inh_Decl :: String}+data Syn_Decl = Syn_Decl {pp_Syn_Decl :: PP_Doc}+wrap_Decl (T_Decl sem) (Inh_Decl _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) =+ (let ( _lhsOpp) =+ (sem _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile)+ in (Syn_Decl _lhsOpp))+sem_Decl_Comment :: String ->+ T_Decl+sem_Decl_Comment txt_ =+ (T_Decl (\ _lhsIisDeclOfLet+ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpp :: PP_Doc+ -- "PrintCode.ag"(line 106, column 16)+ _lhsOpp =+ if '\n' `elem` txt_+ then "{-" >-< vlist (lines txt_) >-< "-}"+ else "--" >#< txt_+ in ( _lhsOpp))))+sem_Decl_Data :: String ->+ ([String]) ->+ T_DataAlts ->+ Bool ->+ ([String]) ->+ T_Decl+sem_Decl_Data name_ params_ (T_DataAlts alts_) strict_ derivings_ =+ (T_Decl (\ _lhsIisDeclOfLet+ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpp :: PP_Doc+ _altsOstrictPre :: PP_Doc+ _altsOnested :: Bool+ _altsIpps :: PP_Docs+ -- "PrintCode.ag"(line 94, column 16)+ _lhsOpp =+ "data" >#< hv_sp (name_ : params_)+ >#< ( case _altsIpps of+ [] -> empty+ (x:xs) -> "=" >#< x+ >-< vlist (map ("|" >#<) xs)+ >-< if null derivings_+ then empty+ else "deriving" >#< ppTuple False (map text derivings_)+ )+ -- "PrintCode.ag"(line 228, column 10)+ _altsOstrictPre =+ if strict_ then pp "!" else empty+ -- copy rule (down)+ _altsOnested =+ _lhsInested+ ( _altsIpps) =+ (alts_ _altsOnested _altsOstrictPre)+ in ( _lhsOpp))))+sem_Decl_Decl :: T_Lhs ->+ T_Expr ->+ (Set String) ->+ (Set String) ->+ T_Decl+sem_Decl_Decl (T_Lhs left_) (T_Expr rhs_) binds_ uses_ =+ (T_Decl (\ _lhsIisDeclOfLet+ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpp :: PP_Doc+ _leftOisDeclOfLet :: Bool+ _leftOnested :: Bool+ _leftOoptions :: Options+ _leftOoutputfile :: String+ _rhsOnested :: Bool+ _rhsOoptions :: Options+ _rhsOoutputfile :: String+ _leftIpp :: PP_Doc+ _rhsIpp :: PP_Doc+ -- "PrintCode.ag"(line 92, column 16)+ _lhsOpp =+ _leftIpp >#< "="+ >-< indent 4 _rhsIpp+ -- copy rule (down)+ _leftOisDeclOfLet =+ _lhsIisDeclOfLet+ -- copy rule (down)+ _leftOnested =+ _lhsInested+ -- copy rule (down)+ _leftOoptions =+ _lhsIoptions+ -- copy rule (down)+ _leftOoutputfile =+ _lhsIoutputfile+ -- copy rule (down)+ _rhsOnested =+ _lhsInested+ -- copy rule (down)+ _rhsOoptions =+ _lhsIoptions+ -- copy rule (down)+ _rhsOoutputfile =+ _lhsIoutputfile+ ( _leftIpp) =+ (left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile)+ ( _rhsIpp) =+ (rhs_ _rhsOnested _rhsOoptions _rhsOoutputfile)+ in ( _lhsOpp))))+sem_Decl_NewType :: String ->+ ([String]) ->+ String ->+ T_Type ->+ T_Decl+sem_Decl_NewType name_ params_ con_ (T_Type tp_) =+ (T_Decl (\ _lhsIisDeclOfLet+ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpp :: PP_Doc+ _tpOnested :: Bool+ _tpIpp :: PP_Doc+ _tpIprec :: Int+ -- "PrintCode.ag"(line 103, column 16)+ _lhsOpp =+ "newtype" >#< hv_sp (name_ : params_) >#< "=" >#< con_ >#< pp_parens _tpIpp+ -- copy rule (down)+ _tpOnested =+ _lhsInested+ ( _tpIpp,_tpIprec) =+ (tp_ _tpOnested)+ in ( _lhsOpp))))+sem_Decl_PragmaDecl :: String ->+ T_Decl+sem_Decl_PragmaDecl txt_ =+ (T_Decl (\ _lhsIisDeclOfLet+ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpp :: PP_Doc+ -- "PrintCode.ag"(line 109, column 16)+ _lhsOpp =+ "{-#" >#< text txt_ >#< "#-}"+ in ( _lhsOpp))))+sem_Decl_TSig :: String ->+ T_Type ->+ T_Decl+sem_Decl_TSig name_ (T_Type tp_) =+ (T_Decl (\ _lhsIisDeclOfLet+ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpp :: PP_Doc+ _tpOnested :: Bool+ _tpIpp :: PP_Doc+ _tpIprec :: Int+ -- "PrintCode.ag"(line 105, column 16)+ _lhsOpp =+ name_ >#< "::" >#< _tpIpp+ -- copy rule (down)+ _tpOnested =+ _lhsInested+ ( _tpIpp,_tpIprec) =+ (tp_ _tpOnested)+ in ( _lhsOpp))))+sem_Decl_Type :: String ->+ ([String]) ->+ T_Type ->+ T_Decl+sem_Decl_Type name_ params_ (T_Type tp_) =+ (T_Decl (\ _lhsIisDeclOfLet+ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpp :: PP_Doc+ _tpOnested :: Bool+ _tpIpp :: PP_Doc+ _tpIprec :: Int+ -- "PrintCode.ag"(line 104, column 16)+ _lhsOpp =+ "type" >#< hv_sp (name_ : params_) >#< "=" >#< _tpIpp+ -- copy rule (down)+ _tpOnested =+ _lhsInested+ ( _tpIpp,_tpIprec) =+ (tp_ _tpOnested)+ in ( _lhsOpp))))+-- Decls -------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ isDeclOfLet : Bool+ nested : Bool+ options : Options+ outputfile : String+ synthesized attribute:+ pps : PP_Docs+ alternatives:+ alternative Cons:+ child hd : Decl+ child tl : Decls+ alternative Nil:+-}+-- cata+sem_Decls :: Decls ->+ T_Decls+sem_Decls list =+ (Prelude.foldr sem_Decls_Cons sem_Decls_Nil (Prelude.map sem_Decl list))+-- semantic domain+newtype T_Decls = T_Decls (Bool ->+ Bool ->+ Options ->+ String ->+ ( PP_Docs))+data Inh_Decls = Inh_Decls {isDeclOfLet_Inh_Decls :: Bool,nested_Inh_Decls :: Bool,options_Inh_Decls :: Options,outputfile_Inh_Decls :: String}+data Syn_Decls = Syn_Decls {pps_Syn_Decls :: PP_Docs}+wrap_Decls (T_Decls sem) (Inh_Decls _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) =+ (let ( _lhsOpps) =+ (sem _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile)+ in (Syn_Decls _lhsOpps))+sem_Decls_Cons :: T_Decl ->+ T_Decls ->+ T_Decls+sem_Decls_Cons (T_Decl hd_) (T_Decls tl_) =+ (T_Decls (\ _lhsIisDeclOfLet+ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpps :: PP_Docs+ _hdOisDeclOfLet :: Bool+ _hdOnested :: Bool+ _hdOoptions :: Options+ _hdOoutputfile :: String+ _tlOisDeclOfLet :: Bool+ _tlOnested :: Bool+ _tlOoptions :: Options+ _tlOoutputfile :: String+ _hdIpp :: PP_Doc+ _tlIpps :: PP_Docs+ -- "PrintCode.ag"(line 71, column 10)+ _lhsOpps =+ _hdIpp : _tlIpps+ -- copy rule (down)+ _hdOisDeclOfLet =+ _lhsIisDeclOfLet+ -- copy rule (down)+ _hdOnested =+ _lhsInested+ -- copy rule (down)+ _hdOoptions =+ _lhsIoptions+ -- copy rule (down)+ _hdOoutputfile =+ _lhsIoutputfile+ -- copy rule (down)+ _tlOisDeclOfLet =+ _lhsIisDeclOfLet+ -- copy rule (down)+ _tlOnested =+ _lhsInested+ -- copy rule (down)+ _tlOoptions =+ _lhsIoptions+ -- copy rule (down)+ _tlOoutputfile =+ _lhsIoutputfile+ ( _hdIpp) =+ (hd_ _hdOisDeclOfLet _hdOnested _hdOoptions _hdOoutputfile)+ ( _tlIpps) =+ (tl_ _tlOisDeclOfLet _tlOnested _tlOoptions _tlOoutputfile)+ in ( _lhsOpps))))+sem_Decls_Nil :: T_Decls+sem_Decls_Nil =+ (T_Decls (\ _lhsIisDeclOfLet+ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpps :: PP_Docs+ -- "PrintCode.ag"(line 72, column 10)+ _lhsOpps =+ []+ in ( _lhsOpps))))+-- Expr --------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ nested : Bool+ options : Options+ outputfile : String+ synthesized attribute:+ pp : PP_Doc+ alternatives:+ alternative App:+ child name : {String}+ child args : Exprs+ alternative Case:+ child expr : Expr+ child alts : CaseAlts+ alternative Lambda:+ child args : Exprs+ child body : Expr+ visit 0:+ local strictParams : _+ local addBang : _+ alternative Let:+ child decls : Decls+ child body : Expr+ alternative LineExpr:+ child expr : Expr+ alternative PragmaExpr:+ child onLeftSide : {Bool}+ child onNewLine : {Bool}+ child txt : {String}+ child expr : Expr+ alternative SimpleExpr:+ child txt : {String}+ alternative TextExpr:+ child lns : {[String]}+ alternative Trace:+ child txt : {String}+ child expr : Expr+ alternative TupleExpr:+ child exprs : Exprs+ alternative TypedExpr:+ child expr : Expr+ child tp : Type+ alternative UnboxedTupleExpr:+ child exprs : Exprs+-}+-- cata+sem_Expr :: Expr ->+ T_Expr+sem_Expr (App _name _args) =+ (sem_Expr_App _name (sem_Exprs _args))+sem_Expr (Case _expr _alts) =+ (sem_Expr_Case (sem_Expr _expr) (sem_CaseAlts _alts))+sem_Expr (Lambda _args _body) =+ (sem_Expr_Lambda (sem_Exprs _args) (sem_Expr _body))+sem_Expr (Let _decls _body) =+ (sem_Expr_Let (sem_Decls _decls) (sem_Expr _body))+sem_Expr (LineExpr _expr) =+ (sem_Expr_LineExpr (sem_Expr _expr))+sem_Expr (PragmaExpr _onLeftSide _onNewLine _txt _expr) =+ (sem_Expr_PragmaExpr _onLeftSide _onNewLine _txt (sem_Expr _expr))+sem_Expr (SimpleExpr _txt) =+ (sem_Expr_SimpleExpr _txt)+sem_Expr (TextExpr _lns) =+ (sem_Expr_TextExpr _lns)+sem_Expr (Trace _txt _expr) =+ (sem_Expr_Trace _txt (sem_Expr _expr))+sem_Expr (TupleExpr _exprs) =+ (sem_Expr_TupleExpr (sem_Exprs _exprs))+sem_Expr (TypedExpr _expr _tp) =+ (sem_Expr_TypedExpr (sem_Expr _expr) (sem_Type _tp))+sem_Expr (UnboxedTupleExpr _exprs) =+ (sem_Expr_UnboxedTupleExpr (sem_Exprs _exprs))+-- semantic domain+newtype T_Expr = T_Expr (Bool ->+ Options ->+ String ->+ ( PP_Doc))+data Inh_Expr = Inh_Expr {nested_Inh_Expr :: Bool,options_Inh_Expr :: Options,outputfile_Inh_Expr :: String}+data Syn_Expr = Syn_Expr {pp_Syn_Expr :: PP_Doc}+wrap_Expr (T_Expr sem) (Inh_Expr _lhsInested _lhsIoptions _lhsIoutputfile) =+ (let ( _lhsOpp) =+ (sem _lhsInested _lhsIoptions _lhsIoutputfile)+ in (Syn_Expr _lhsOpp))+sem_Expr_App :: String ->+ T_Exprs ->+ T_Expr+sem_Expr_App name_ (T_Exprs args_) =+ (T_Expr (\ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpp :: PP_Doc+ _argsOnested :: Bool+ _argsOoptions :: Options+ _argsOoutputfile :: String+ _argsIpps :: PP_Docs+ -- "PrintCode.ag"(line 129, column 16)+ _lhsOpp =+ pp_parens $ name_ >#< hv_sp _argsIpps+ -- copy rule (down)+ _argsOnested =+ _lhsInested+ -- copy rule (down)+ _argsOoptions =+ _lhsIoptions+ -- copy rule (down)+ _argsOoutputfile =+ _lhsIoutputfile+ ( _argsIpps) =+ (args_ _argsOnested _argsOoptions _argsOoutputfile)+ in ( _lhsOpp))))+sem_Expr_Case :: T_Expr ->+ T_CaseAlts ->+ T_Expr+sem_Expr_Case (T_Expr expr_) (T_CaseAlts alts_) =+ (T_Expr (\ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpp :: PP_Doc+ _exprOnested :: Bool+ _exprOoptions :: Options+ _exprOoutputfile :: String+ _altsOnested :: Bool+ _altsOoptions :: Options+ _altsOoutputfile :: String+ _exprIpp :: PP_Doc+ _altsIpps :: PP_Docs+ -- "PrintCode.ag"(line 115, column 16)+ _lhsOpp =+ pp_parens ( "case" >#< pp_parens _exprIpp >#< "of"+ >-< (vlist _altsIpps)+ )+ -- copy rule (down)+ _exprOnested =+ _lhsInested+ -- copy rule (down)+ _exprOoptions =+ _lhsIoptions+ -- copy rule (down)+ _exprOoutputfile =+ _lhsIoutputfile+ -- copy rule (down)+ _altsOnested =+ _lhsInested+ -- copy rule (down)+ _altsOoptions =+ _lhsIoptions+ -- copy rule (down)+ _altsOoutputfile =+ _lhsIoutputfile+ ( _exprIpp) =+ (expr_ _exprOnested _exprOoptions _exprOoutputfile)+ ( _altsIpps) =+ (alts_ _altsOnested _altsOoptions _altsOoutputfile)+ in ( _lhsOpp))))+sem_Expr_Lambda :: T_Exprs ->+ T_Expr ->+ T_Expr+sem_Expr_Lambda (T_Exprs args_) (T_Expr body_) =+ (T_Expr (\ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpp :: PP_Doc+ _argsOnested :: Bool+ _argsOoptions :: Options+ _argsOoutputfile :: String+ _bodyOnested :: Bool+ _bodyOoptions :: Options+ _bodyOoutputfile :: String+ _argsIpps :: PP_Docs+ _bodyIpp :: PP_Doc+ -- "PrintCode.ag"(line 118, column 16)+ _strictParams =+ if strictSems _lhsIoptions+ then _argsIpps+ else []+ -- "PrintCode.ag"(line 121, column 16)+ _addBang =+ if bangpats _lhsIoptions+ then \p -> pp_parens ("!" >|< p)+ else id+ -- "PrintCode.ag"(line 124, column 16)+ _lhsOpp =+ pp_parens ( "\\" >#< (vlist (map _addBang _argsIpps)) >#< "->"+ >-< indent 4 (_strictParams `ppMultiSeqV` _bodyIpp)+ )+ -- copy rule (down)+ _argsOnested =+ _lhsInested+ -- copy rule (down)+ _argsOoptions =+ _lhsIoptions+ -- copy rule (down)+ _argsOoutputfile =+ _lhsIoutputfile+ -- copy rule (down)+ _bodyOnested =+ _lhsInested+ -- copy rule (down)+ _bodyOoptions =+ _lhsIoptions+ -- copy rule (down)+ _bodyOoutputfile =+ _lhsIoutputfile+ ( _argsIpps) =+ (args_ _argsOnested _argsOoptions _argsOoutputfile)+ ( _bodyIpp) =+ (body_ _bodyOnested _bodyOoptions _bodyOoutputfile)+ in ( _lhsOpp))))+sem_Expr_Let :: T_Decls ->+ T_Expr ->+ T_Expr+sem_Expr_Let (T_Decls decls_) (T_Expr body_) =+ (T_Expr (\ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpp :: PP_Doc+ _declsOisDeclOfLet :: Bool+ _declsOnested :: Bool+ _declsOoptions :: Options+ _declsOoutputfile :: String+ _bodyOnested :: Bool+ _bodyOoptions :: Options+ _bodyOoutputfile :: String+ _declsIpps :: PP_Docs+ _bodyIpp :: PP_Doc+ -- "PrintCode.ag"(line 112, column 16)+ _lhsOpp =+ pp_parens ( "let" >#< (vlist _declsIpps)+ >-< "in " >#< _bodyIpp+ )+ -- "PrintCode.ag"(line 322, column 7)+ _declsOisDeclOfLet =+ True+ -- copy rule (down)+ _declsOnested =+ _lhsInested+ -- copy rule (down)+ _declsOoptions =+ _lhsIoptions+ -- copy rule (down)+ _declsOoutputfile =+ _lhsIoutputfile+ -- copy rule (down)+ _bodyOnested =+ _lhsInested+ -- copy rule (down)+ _bodyOoptions =+ _lhsIoptions+ -- copy rule (down)+ _bodyOoutputfile =+ _lhsIoutputfile+ ( _declsIpps) =+ (decls_ _declsOisDeclOfLet _declsOnested _declsOoptions _declsOoutputfile)+ ( _bodyIpp) =+ (body_ _bodyOnested _bodyOoptions _bodyOoutputfile)+ in ( _lhsOpp))))+sem_Expr_LineExpr :: T_Expr ->+ T_Expr+sem_Expr_LineExpr (T_Expr expr_) =+ (T_Expr (\ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpp :: PP_Doc+ _exprOnested :: Bool+ _exprOoptions :: Options+ _exprOoutputfile :: String+ _exprIpp :: PP_Doc+ -- "PrintCode.ag"(line 146, column 16)+ _lhsOpp =+ _exprIpp >-< "{-# LINE" >#< ppWithLineNr (\n -> pp $ show $ n + 1) >#< show _lhsIoutputfile >#< "#-}"+ -- copy rule (down)+ _exprOnested =+ _lhsInested+ -- copy rule (down)+ _exprOoptions =+ _lhsIoptions+ -- copy rule (down)+ _exprOoutputfile =+ _lhsIoutputfile+ ( _exprIpp) =+ (expr_ _exprOnested _exprOoptions _exprOoutputfile)+ in ( _lhsOpp))))+sem_Expr_PragmaExpr :: Bool ->+ Bool ->+ String ->+ T_Expr ->+ T_Expr+sem_Expr_PragmaExpr onLeftSide_ onNewLine_ txt_ (T_Expr expr_) =+ (T_Expr (\ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpp :: PP_Doc+ _exprOnested :: Bool+ _exprOoptions :: Options+ _exprOoutputfile :: String+ _exprIpp :: PP_Doc+ -- "PrintCode.ag"(line 135, column 16)+ _lhsOpp =+ let pragmaDoc = "{-#" >#< txt_ >#< "#-}"+ op = if onNewLine_+ then (>-<)+ else (>#<)+ leftOp x y = if onLeftSide_+ then x `op` y+ else y+ rightOp x y = if onLeftSide_+ then x+ else x `op` y+ in pragmaDoc `leftOp` _exprIpp `rightOp` pragmaDoc+ -- copy rule (down)+ _exprOnested =+ _lhsInested+ -- copy rule (down)+ _exprOoptions =+ _lhsIoptions+ -- copy rule (down)+ _exprOoutputfile =+ _lhsIoutputfile+ ( _exprIpp) =+ (expr_ _exprOnested _exprOoptions _exprOoutputfile)+ in ( _lhsOpp))))+sem_Expr_SimpleExpr :: String ->+ T_Expr+sem_Expr_SimpleExpr txt_ =+ (T_Expr (\ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpp :: PP_Doc+ -- "PrintCode.ag"(line 130, column 16)+ _lhsOpp =+ text txt_+ in ( _lhsOpp))))+sem_Expr_TextExpr :: ([String]) ->+ T_Expr+sem_Expr_TextExpr lns_ =+ (T_Expr (\ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpp :: PP_Doc+ -- "PrintCode.ag"(line 131, column 16)+ _lhsOpp =+ vlist (map text lns_)+ in ( _lhsOpp))))+sem_Expr_Trace :: String ->+ T_Expr ->+ T_Expr+sem_Expr_Trace txt_ (T_Expr expr_) =+ (T_Expr (\ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpp :: PP_Doc+ _exprOnested :: Bool+ _exprOoptions :: Options+ _exprOoutputfile :: String+ _exprIpp :: PP_Doc+ -- "PrintCode.ag"(line 132, column 16)+ _lhsOpp =+ "trace" >#< ( pp_parens ("\"" >|< text txt_ >|< "\"")+ >-< pp_parens _exprIpp+ )+ -- copy rule (down)+ _exprOnested =+ _lhsInested+ -- copy rule (down)+ _exprOoptions =+ _lhsIoptions+ -- copy rule (down)+ _exprOoutputfile =+ _lhsIoutputfile+ ( _exprIpp) =+ (expr_ _exprOnested _exprOoptions _exprOoutputfile)+ in ( _lhsOpp))))+sem_Expr_TupleExpr :: T_Exprs ->+ T_Expr+sem_Expr_TupleExpr (T_Exprs exprs_) =+ (T_Expr (\ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpp :: PP_Doc+ _exprsOnested :: Bool+ _exprsOoptions :: Options+ _exprsOoutputfile :: String+ _exprsIpps :: PP_Docs+ -- "PrintCode.ag"(line 127, column 16)+ _lhsOpp =+ ppTuple _lhsInested _exprsIpps+ -- copy rule (down)+ _exprsOnested =+ _lhsInested+ -- copy rule (down)+ _exprsOoptions =+ _lhsIoptions+ -- copy rule (down)+ _exprsOoutputfile =+ _lhsIoutputfile+ ( _exprsIpps) =+ (exprs_ _exprsOnested _exprsOoptions _exprsOoutputfile)+ in ( _lhsOpp))))+sem_Expr_TypedExpr :: T_Expr ->+ T_Type ->+ T_Expr+sem_Expr_TypedExpr (T_Expr expr_) (T_Type tp_) =+ (T_Expr (\ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpp :: PP_Doc+ _exprOnested :: Bool+ _exprOoptions :: Options+ _exprOoutputfile :: String+ _tpOnested :: Bool+ _exprIpp :: PP_Doc+ _tpIpp :: PP_Doc+ _tpIprec :: Int+ -- "PrintCode.ag"(line 147, column 16)+ _lhsOpp =+ pp_parens (_exprIpp >#< "::" >#< _tpIpp)+ -- copy rule (down)+ _exprOnested =+ _lhsInested+ -- copy rule (down)+ _exprOoptions =+ _lhsIoptions+ -- copy rule (down)+ _exprOoutputfile =+ _lhsIoutputfile+ -- copy rule (down)+ _tpOnested =+ _lhsInested+ ( _exprIpp) =+ (expr_ _exprOnested _exprOoptions _exprOoutputfile)+ ( _tpIpp,_tpIprec) =+ (tp_ _tpOnested)+ in ( _lhsOpp))))+sem_Expr_UnboxedTupleExpr :: T_Exprs ->+ T_Expr+sem_Expr_UnboxedTupleExpr (T_Exprs exprs_) =+ (T_Expr (\ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpp :: PP_Doc+ _exprsOnested :: Bool+ _exprsOoptions :: Options+ _exprsOoutputfile :: String+ _exprsIpps :: PP_Docs+ -- "PrintCode.ag"(line 128, column 23)+ _lhsOpp =+ ppUnboxedTuple _lhsInested _exprsIpps+ -- copy rule (down)+ _exprsOnested =+ _lhsInested+ -- copy rule (down)+ _exprsOoptions =+ _lhsIoptions+ -- copy rule (down)+ _exprsOoutputfile =+ _lhsIoutputfile+ ( _exprsIpps) =+ (exprs_ _exprsOnested _exprsOoptions _exprsOoutputfile)+ in ( _lhsOpp))))+-- Exprs -------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ nested : Bool+ options : Options+ outputfile : String+ synthesized attribute:+ pps : PP_Docs+ alternatives:+ alternative Cons:+ child hd : Expr+ child tl : Exprs+ alternative Nil:+-}+-- cata+sem_Exprs :: Exprs ->+ T_Exprs+sem_Exprs list =+ (Prelude.foldr sem_Exprs_Cons sem_Exprs_Nil (Prelude.map sem_Expr list))+-- semantic domain+newtype T_Exprs = T_Exprs (Bool ->+ Options ->+ String ->+ ( PP_Docs))+data Inh_Exprs = Inh_Exprs {nested_Inh_Exprs :: Bool,options_Inh_Exprs :: Options,outputfile_Inh_Exprs :: String}+data Syn_Exprs = Syn_Exprs {pps_Syn_Exprs :: PP_Docs}+wrap_Exprs (T_Exprs sem) (Inh_Exprs _lhsInested _lhsIoptions _lhsIoutputfile) =+ (let ( _lhsOpps) =+ (sem _lhsInested _lhsIoptions _lhsIoutputfile)+ in (Syn_Exprs _lhsOpps))+sem_Exprs_Cons :: T_Expr ->+ T_Exprs ->+ T_Exprs+sem_Exprs_Cons (T_Expr hd_) (T_Exprs tl_) =+ (T_Exprs (\ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpps :: PP_Docs+ _hdOnested :: Bool+ _hdOoptions :: Options+ _hdOoutputfile :: String+ _tlOnested :: Bool+ _tlOoptions :: Options+ _tlOoutputfile :: String+ _hdIpp :: PP_Doc+ _tlIpps :: PP_Docs+ -- "PrintCode.ag"(line 55, column 10)+ _lhsOpps =+ _hdIpp : _tlIpps+ -- copy rule (down)+ _hdOnested =+ _lhsInested+ -- copy rule (down)+ _hdOoptions =+ _lhsIoptions+ -- copy rule (down)+ _hdOoutputfile =+ _lhsIoutputfile+ -- copy rule (down)+ _tlOnested =+ _lhsInested+ -- copy rule (down)+ _tlOoptions =+ _lhsIoptions+ -- copy rule (down)+ _tlOoutputfile =+ _lhsIoutputfile+ ( _hdIpp) =+ (hd_ _hdOnested _hdOoptions _hdOoutputfile)+ ( _tlIpps) =+ (tl_ _tlOnested _tlOoptions _tlOoutputfile)+ in ( _lhsOpps))))+sem_Exprs_Nil :: T_Exprs+sem_Exprs_Nil =+ (T_Exprs (\ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpps :: PP_Docs+ -- "PrintCode.ag"(line 56, column 10)+ _lhsOpps =+ []+ in ( _lhsOpps))))+-- Lhs ---------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ isDeclOfLet : Bool+ nested : Bool+ options : Options+ outputfile : String+ synthesized attribute:+ pp : PP_Doc+ alternatives:+ alternative Fun:+ child name : {String}+ child args : Exprs+ visit 0:+ local addStrictGuard : _+ local hasStrictVars : _+ local strictGuard : _+ local addBang : _+ alternative Pattern3:+ child pat3 : Pattern+ visit 0:+ local addStrictGuard : _+ local strictGuard : _+ local hasStrictVars : _+ alternative Pattern3SM:+ child pat3 : Pattern+ alternative TupleLhs:+ child comps : {[String]}+ visit 0:+ local addStrictGuard : _+ local strictGuard : _+ local hasStrictVars : _+ local addBang : _+ alternative UnboxedTupleLhs:+ child comps : {[String]}+ visit 0:+ local addStrictGuard : _+ local strictGuard : _+ local hasStrictVars : _+ local addBang : _+-}+-- cata+sem_Lhs :: Lhs ->+ T_Lhs+sem_Lhs (Fun _name _args) =+ (sem_Lhs_Fun _name (sem_Exprs _args))+sem_Lhs (Pattern3 _pat3) =+ (sem_Lhs_Pattern3 (sem_Pattern _pat3))+sem_Lhs (Pattern3SM _pat3) =+ (sem_Lhs_Pattern3SM (sem_Pattern _pat3))+sem_Lhs (TupleLhs _comps) =+ (sem_Lhs_TupleLhs _comps)+sem_Lhs (UnboxedTupleLhs _comps) =+ (sem_Lhs_UnboxedTupleLhs _comps)+-- semantic domain+newtype T_Lhs = T_Lhs (Bool ->+ Bool ->+ Options ->+ String ->+ ( PP_Doc))+data Inh_Lhs = Inh_Lhs {isDeclOfLet_Inh_Lhs :: Bool,nested_Inh_Lhs :: Bool,options_Inh_Lhs :: Options,outputfile_Inh_Lhs :: String}+data Syn_Lhs = Syn_Lhs {pp_Syn_Lhs :: PP_Doc}+wrap_Lhs (T_Lhs sem) (Inh_Lhs _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) =+ (let ( _lhsOpp) =+ (sem _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile)+ in (Syn_Lhs _lhsOpp))+sem_Lhs_Fun :: String ->+ T_Exprs ->+ T_Lhs+sem_Lhs_Fun name_ (T_Exprs args_) =+ (T_Lhs (\ _lhsIisDeclOfLet+ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpp :: PP_Doc+ _argsOnested :: Bool+ _argsOoptions :: Options+ _argsOoutputfile :: String+ _argsIpps :: PP_Docs+ -- "PrintCode.ag"(line 169, column 7)+ _addStrictGuard =+ if strictSems _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id+ -- "PrintCode.ag"(line 170, column 7)+ _hasStrictVars =+ not (null _argsIpps)+ -- "PrintCode.ag"(line 171, column 7)+ _strictGuard =+ _argsIpps `ppMultiSeqH` (pp "True")+ -- "PrintCode.ag"(line 174, column 7)+ _addBang =+ if bangpats _lhsIoptions+ then \p -> "!" >|< p+ else id+ -- "PrintCode.ag"(line 182, column 16)+ _lhsOpp =+ _addStrictGuard (name_ >#< hv_sp (map _addBang _argsIpps))+ -- copy rule (down)+ _argsOnested =+ _lhsInested+ -- copy rule (down)+ _argsOoptions =+ _lhsIoptions+ -- copy rule (down)+ _argsOoutputfile =+ _lhsIoutputfile+ ( _argsIpps) =+ (args_ _argsOnested _argsOoptions _argsOoutputfile)+ in ( _lhsOpp))))+sem_Lhs_Pattern3 :: T_Pattern ->+ T_Lhs+sem_Lhs_Pattern3 (T_Pattern pat3_) =+ (T_Lhs (\ _lhsIisDeclOfLet+ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpp :: PP_Doc+ _pat3ObelowIrrefutable :: Bool+ _pat3OisDeclOfLet :: Bool+ _pat3Ooptions :: Options+ _pat3Icopy :: Pattern+ _pat3IisUnderscore :: Bool+ _pat3Ipp :: PP_Doc+ _pat3Ipp' :: PP_Doc+ _pat3IstrictVars :: ([PP_Doc])+ -- "PrintCode.ag"(line 158, column 7)+ _addStrictGuard =+ if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id+ -- "PrintCode.ag"(line 160, column 7)+ _strictGuard =+ _pat3IstrictVars `ppMultiSeqH` (pp "True")+ -- "PrintCode.ag"(line 161, column 7)+ _hasStrictVars =+ not (null _pat3IstrictVars)+ -- "PrintCode.ag"(line 178, column 16)+ _lhsOpp =+ _addStrictGuard _pat3Ipp+ -- "PrintCode.ag"(line 288, column 7)+ _pat3ObelowIrrefutable =+ False+ -- copy rule (down)+ _pat3OisDeclOfLet =+ _lhsIisDeclOfLet+ -- copy rule (down)+ _pat3Ooptions =+ _lhsIoptions+ ( _pat3Icopy,_pat3IisUnderscore,_pat3Ipp,_pat3Ipp',_pat3IstrictVars) =+ (pat3_ _pat3ObelowIrrefutable _pat3OisDeclOfLet _pat3Ooptions)+ in ( _lhsOpp))))+sem_Lhs_Pattern3SM :: T_Pattern ->+ T_Lhs+sem_Lhs_Pattern3SM (T_Pattern pat3_) =+ (T_Lhs (\ _lhsIisDeclOfLet+ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpp :: PP_Doc+ _pat3ObelowIrrefutable :: Bool+ _pat3OisDeclOfLet :: Bool+ _pat3Ooptions :: Options+ _pat3Icopy :: Pattern+ _pat3IisUnderscore :: Bool+ _pat3Ipp :: PP_Doc+ _pat3Ipp' :: PP_Doc+ _pat3IstrictVars :: ([PP_Doc])+ -- "PrintCode.ag"(line 179, column 16)+ _lhsOpp =+ _pat3Ipp'+ -- "PrintCode.ag"(line 288, column 7)+ _pat3ObelowIrrefutable =+ False+ -- copy rule (down)+ _pat3OisDeclOfLet =+ _lhsIisDeclOfLet+ -- copy rule (down)+ _pat3Ooptions =+ _lhsIoptions+ ( _pat3Icopy,_pat3IisUnderscore,_pat3Ipp,_pat3Ipp',_pat3IstrictVars) =+ (pat3_ _pat3ObelowIrrefutable _pat3OisDeclOfLet _pat3Ooptions)+ in ( _lhsOpp))))+sem_Lhs_TupleLhs :: ([String]) ->+ T_Lhs+sem_Lhs_TupleLhs comps_ =+ (T_Lhs (\ _lhsIisDeclOfLet+ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpp :: PP_Doc+ -- "PrintCode.ag"(line 158, column 7)+ _addStrictGuard =+ if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id+ -- "PrintCode.ag"(line 163, column 7)+ _strictGuard =+ if stricterCases _lhsIoptions && not _lhsIisDeclOfLet+ then map text comps_ `ppMultiSeqH` (pp "True")+ else pp "True"+ -- "PrintCode.ag"(line 166, column 7)+ _hasStrictVars =+ not (null comps_)+ -- "PrintCode.ag"(line 174, column 7)+ _addBang =+ if bangpats _lhsIoptions+ then \p -> "!" >|< p+ else id+ -- "PrintCode.ag"(line 180, column 16)+ _lhsOpp =+ _addStrictGuard $ ppTuple _lhsInested (map (_addBang . text) comps_)+ in ( _lhsOpp))))+sem_Lhs_UnboxedTupleLhs :: ([String]) ->+ T_Lhs+sem_Lhs_UnboxedTupleLhs comps_ =+ (T_Lhs (\ _lhsIisDeclOfLet+ _lhsInested+ _lhsIoptions+ _lhsIoutputfile ->+ (let _lhsOpp :: PP_Doc+ -- "PrintCode.ag"(line 158, column 7)+ _addStrictGuard =+ if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id+ -- "PrintCode.ag"(line 163, column 7)+ _strictGuard =+ if stricterCases _lhsIoptions && not _lhsIisDeclOfLet+ then map text comps_ `ppMultiSeqH` (pp "True")+ else pp "True"+ -- "PrintCode.ag"(line 166, column 7)+ _hasStrictVars =+ not (null comps_)+ -- "PrintCode.ag"(line 174, column 7)+ _addBang =+ if bangpats _lhsIoptions+ then \p -> "!" >|< p+ else id+ -- "PrintCode.ag"(line 181, column 23)+ _lhsOpp =+ _addStrictGuard $ ppUnboxedTuple _lhsInested (map (_addBang . text) comps_)+ in ( _lhsOpp))))+-- Pattern -----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ belowIrrefutable : Bool+ isDeclOfLet : Bool+ options : Options+ synthesized attributes:+ copy : SELF+ isUnderscore : Bool+ pp : PP_Doc+ pp' : PP_Doc+ strictVars : [PP_Doc]+ alternatives:+ alternative Alias:+ child field : {Identifier}+ child attr : {Identifier}+ child pat : Pattern+ child parts : Patterns+ visit 0:+ local strictVar : _+ local strictPatVars : _+ local addBang : _+ local ppVar : _+ local ppVarBang : _+ local copy : _+ alternative Constr:+ child name : {ConstructorIdent}+ child pats : Patterns+ visit 0:+ local addBang : _+ local copy : _+ alternative Irrefutable:+ child pat : Pattern+ visit 0:+ local copy : _+ alternative Product:+ child pos : {Pos}+ child pats : Patterns+ visit 0:+ local addBang : _+ 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 (Bool ->+ Bool ->+ Options ->+ ( Pattern,Bool,PP_Doc,PP_Doc,([PP_Doc])))+data Inh_Pattern = Inh_Pattern {belowIrrefutable_Inh_Pattern :: Bool,isDeclOfLet_Inh_Pattern :: Bool,options_Inh_Pattern :: Options}+data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern,isUnderscore_Syn_Pattern :: Bool,pp_Syn_Pattern :: PP_Doc,pp'_Syn_Pattern :: PP_Doc,strictVars_Syn_Pattern :: [PP_Doc]}+wrap_Pattern (T_Pattern sem) (Inh_Pattern _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) =+ (let ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars) =+ (sem _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions)+ in (Syn_Pattern _lhsOcopy _lhsOisUnderscore _lhsOpp _lhsOpp' _lhsOstrictVars))+sem_Pattern_Alias :: Identifier ->+ Identifier ->+ T_Pattern ->+ T_Patterns ->+ T_Pattern+sem_Pattern_Alias field_ attr_ (T_Pattern pat_) (T_Patterns parts_) =+ (T_Pattern (\ _lhsIbelowIrrefutable+ _lhsIisDeclOfLet+ _lhsIoptions ->+ (let _lhsOstrictVars :: ([PP_Doc])+ _lhsOpp :: PP_Doc+ _lhsOisUnderscore :: Bool+ _lhsOpp' :: PP_Doc+ _lhsOcopy :: Pattern+ _patObelowIrrefutable :: Bool+ _patOisDeclOfLet :: Bool+ _patOoptions :: Options+ _partsObelowIrrefutable :: Bool+ _partsOisDeclOfLet :: Bool+ _partsOoptions :: Options+ _patIcopy :: Pattern+ _patIisUnderscore :: Bool+ _patIpp :: PP_Doc+ _patIpp' :: PP_Doc+ _patIstrictVars :: ([PP_Doc])+ _partsIcopy :: Patterns+ _partsIpps :: ([PP_Doc])+ _partsIpps' :: ([PP_Doc])+ _partsIstrictVars :: ([PP_Doc])+ -- "PrintCode.ag"(line 237, column 7)+ _strictVar =+ if strictCases _lhsIoptions && not _lhsIisDeclOfLet+ then [_ppVar ]+ else []+ -- "PrintCode.ag"(line 241, column 7)+ _strictPatVars =+ if stricterCases _lhsIoptions && not _lhsIisDeclOfLet+ then _patIstrictVars+ else []+ -- "PrintCode.ag"(line 245, column 7)+ _lhsOstrictVars =+ _strictVar ++ _strictPatVars+ -- "PrintCode.ag"(line 260, column 7)+ _addBang =+ if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable+ then \p -> "!" >|< p+ else id+ -- "PrintCode.ag"(line 267, column 13)+ _ppVar =+ pp (attrname False field_ attr_)+ -- "PrintCode.ag"(line 268, column 13)+ _ppVarBang =+ _addBang $ _ppVar+ -- "PrintCode.ag"(line 269, column 13)+ _lhsOpp =+ if _patIisUnderscore+ then _ppVarBang+ else _ppVarBang >|< "@" >|< _patIpp+ -- "PrintCode.ag"(line 278, column 16)+ _lhsOisUnderscore =+ False+ -- "PrintCode.ag"(line 301, column 13)+ _lhsOpp' =+ let attribute | field_ == _LOC || field_ == nullIdent = locname' attr_+ | otherwise = attrname False field_ attr_+ in attribute >|< "@" >|< _patIpp'+ -- self rule+ _copy =+ Alias field_ attr_ _patIcopy _partsIcopy+ -- self rule+ _lhsOcopy =+ _copy+ -- copy rule (down)+ _patObelowIrrefutable =+ _lhsIbelowIrrefutable+ -- copy rule (down)+ _patOisDeclOfLet =+ _lhsIisDeclOfLet+ -- copy rule (down)+ _patOoptions =+ _lhsIoptions+ -- copy rule (down)+ _partsObelowIrrefutable =+ _lhsIbelowIrrefutable+ -- copy rule (down)+ _partsOisDeclOfLet =+ _lhsIisDeclOfLet+ -- copy rule (down)+ _partsOoptions =+ _lhsIoptions+ ( _patIcopy,_patIisUnderscore,_patIpp,_patIpp',_patIstrictVars) =+ (pat_ _patObelowIrrefutable _patOisDeclOfLet _patOoptions)+ ( _partsIcopy,_partsIpps,_partsIpps',_partsIstrictVars) =+ (parts_ _partsObelowIrrefutable _partsOisDeclOfLet _partsOoptions)+ in ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars))))+sem_Pattern_Constr :: ConstructorIdent ->+ T_Patterns ->+ T_Pattern+sem_Pattern_Constr name_ (T_Patterns pats_) =+ (T_Pattern (\ _lhsIbelowIrrefutable+ _lhsIisDeclOfLet+ _lhsIoptions ->+ (let _lhsOpp :: PP_Doc+ _lhsOisUnderscore :: Bool+ _lhsOpp' :: PP_Doc+ _lhsOstrictVars :: ([PP_Doc])+ _lhsOcopy :: Pattern+ _patsObelowIrrefutable :: Bool+ _patsOisDeclOfLet :: Bool+ _patsOoptions :: Options+ _patsIcopy :: Patterns+ _patsIpps :: ([PP_Doc])+ _patsIpps' :: ([PP_Doc])+ _patsIstrictVars :: ([PP_Doc])+ -- "PrintCode.ag"(line 260, column 7)+ _addBang =+ if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable+ then \p -> "!" >|< p+ else id+ -- "PrintCode.ag"(line 265, column 13)+ _lhsOpp =+ _addBang $ pp_parens $ name_ >#< hv_sp _patsIpps+ -- "PrintCode.ag"(line 276, column 16)+ _lhsOisUnderscore =+ False+ -- "PrintCode.ag"(line 299, column 13)+ _lhsOpp' =+ pp_parens $ name_ >#< hv_sp (map pp_parens _patsIpps')+ -- use rule "PrintCode.ag"(line 234, column 40)+ _lhsOstrictVars =+ _patsIstrictVars+ -- self rule+ _copy =+ Constr name_ _patsIcopy+ -- self rule+ _lhsOcopy =+ _copy+ -- copy rule (down)+ _patsObelowIrrefutable =+ _lhsIbelowIrrefutable+ -- copy rule (down)+ _patsOisDeclOfLet =+ _lhsIisDeclOfLet+ -- copy rule (down)+ _patsOoptions =+ _lhsIoptions+ ( _patsIcopy,_patsIpps,_patsIpps',_patsIstrictVars) =+ (pats_ _patsObelowIrrefutable _patsOisDeclOfLet _patsOoptions)+ in ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars))))+sem_Pattern_Irrefutable :: T_Pattern ->+ T_Pattern+sem_Pattern_Irrefutable (T_Pattern pat_) =+ (T_Pattern (\ _lhsIbelowIrrefutable+ _lhsIisDeclOfLet+ _lhsIoptions ->+ (let _lhsOstrictVars :: ([PP_Doc])+ _lhsOpp :: PP_Doc+ _patObelowIrrefutable :: Bool+ _lhsOpp' :: PP_Doc+ _lhsOcopy :: Pattern+ _lhsOisUnderscore :: Bool+ _patOisDeclOfLet :: Bool+ _patOoptions :: Options+ _patIcopy :: Pattern+ _patIisUnderscore :: Bool+ _patIpp :: PP_Doc+ _patIpp' :: PP_Doc+ _patIstrictVars :: ([PP_Doc])+ -- "PrintCode.ag"(line 248, column 7)+ _lhsOstrictVars =+ []+ -- "PrintCode.ag"(line 272, column 17)+ _lhsOpp =+ text "~" >|< pp_parens _patIpp+ -- "PrintCode.ag"(line 284, column 7)+ _patObelowIrrefutable =+ True+ -- "PrintCode.ag"(line 304, column 17)+ _lhsOpp' =+ text "~" >|< pp_parens _patIpp+ -- self rule+ _copy =+ Irrefutable _patIcopy+ -- self rule+ _lhsOcopy =+ _copy+ -- copy rule (up)+ _lhsOisUnderscore =+ _patIisUnderscore+ -- copy rule (down)+ _patOisDeclOfLet =+ _lhsIisDeclOfLet+ -- copy rule (down)+ _patOoptions =+ _lhsIoptions+ ( _patIcopy,_patIisUnderscore,_patIpp,_patIpp',_patIstrictVars) =+ (pat_ _patObelowIrrefutable _patOisDeclOfLet _patOoptions)+ in ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars))))+sem_Pattern_Product :: Pos ->+ T_Patterns ->+ T_Pattern+sem_Pattern_Product pos_ (T_Patterns pats_) =+ (T_Pattern (\ _lhsIbelowIrrefutable+ _lhsIisDeclOfLet+ _lhsIoptions ->+ (let _lhsOpp :: PP_Doc+ _lhsOisUnderscore :: Bool+ _lhsOpp' :: PP_Doc+ _lhsOstrictVars :: ([PP_Doc])+ _lhsOcopy :: Pattern+ _patsObelowIrrefutable :: Bool+ _patsOisDeclOfLet :: Bool+ _patsOoptions :: Options+ _patsIcopy :: Patterns+ _patsIpps :: ([PP_Doc])+ _patsIpps' :: ([PP_Doc])+ _patsIstrictVars :: ([PP_Doc])+ -- "PrintCode.ag"(line 260, column 7)+ _addBang =+ if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable+ then \p -> "!" >|< p+ else id+ -- "PrintCode.ag"(line 266, column 13)+ _lhsOpp =+ _addBang $ pp_block "(" ")" "," _patsIpps+ -- "PrintCode.ag"(line 277, column 16)+ _lhsOisUnderscore =+ False+ -- "PrintCode.ag"(line 300, column 13)+ _lhsOpp' =+ pp_block "(" ")" "," _patsIpps'+ -- use rule "PrintCode.ag"(line 234, column 40)+ _lhsOstrictVars =+ _patsIstrictVars+ -- self rule+ _copy =+ Product pos_ _patsIcopy+ -- self rule+ _lhsOcopy =+ _copy+ -- copy rule (down)+ _patsObelowIrrefutable =+ _lhsIbelowIrrefutable+ -- copy rule (down)+ _patsOisDeclOfLet =+ _lhsIisDeclOfLet+ -- copy rule (down)+ _patsOoptions =+ _lhsIoptions+ ( _patsIcopy,_patsIpps,_patsIpps',_patsIstrictVars) =+ (pats_ _patsObelowIrrefutable _patsOisDeclOfLet _patsOoptions)+ in ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars))))+sem_Pattern_Underscore :: Pos ->+ T_Pattern+sem_Pattern_Underscore pos_ =+ (T_Pattern (\ _lhsIbelowIrrefutable+ _lhsIisDeclOfLet+ _lhsIoptions ->+ (let _lhsOpp :: PP_Doc+ _lhsOisUnderscore :: Bool+ _lhsOpp' :: PP_Doc+ _lhsOstrictVars :: ([PP_Doc])+ _lhsOcopy :: Pattern+ -- "PrintCode.ag"(line 273, column 16)+ _lhsOpp =+ text "_"+ -- "PrintCode.ag"(line 279, column 16)+ _lhsOisUnderscore =+ True+ -- "PrintCode.ag"(line 305, column 16)+ _lhsOpp' =+ text "_"+ -- use rule "PrintCode.ag"(line 234, column 40)+ _lhsOstrictVars =+ []+ -- self rule+ _copy =+ Underscore pos_+ -- self rule+ _lhsOcopy =+ _copy+ in ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars))))+-- Patterns ----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ belowIrrefutable : Bool+ isDeclOfLet : Bool+ options : Options+ synthesized attributes:+ copy : SELF+ pps : [PP_Doc]+ pps' : [PP_Doc]+ strictVars : [PP_Doc]+ 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 (Bool ->+ Bool ->+ Options ->+ ( Patterns,([PP_Doc]),([PP_Doc]),([PP_Doc])))+data Inh_Patterns = Inh_Patterns {belowIrrefutable_Inh_Patterns :: Bool,isDeclOfLet_Inh_Patterns :: Bool,options_Inh_Patterns :: Options}+data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns,pps_Syn_Patterns :: [PP_Doc],pps'_Syn_Patterns :: [PP_Doc],strictVars_Syn_Patterns :: [PP_Doc]}+wrap_Patterns (T_Patterns sem) (Inh_Patterns _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) =+ (let ( _lhsOcopy,_lhsOpps,_lhsOpps',_lhsOstrictVars) =+ (sem _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions)+ in (Syn_Patterns _lhsOcopy _lhsOpps _lhsOpps' _lhsOstrictVars))+sem_Patterns_Cons :: T_Pattern ->+ T_Patterns ->+ T_Patterns+sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) =+ (T_Patterns (\ _lhsIbelowIrrefutable+ _lhsIisDeclOfLet+ _lhsIoptions ->+ (let _lhsOpps :: ([PP_Doc])+ _lhsOpps' :: ([PP_Doc])+ _lhsOstrictVars :: ([PP_Doc])+ _lhsOcopy :: Patterns+ _hdObelowIrrefutable :: Bool+ _hdOisDeclOfLet :: Bool+ _hdOoptions :: Options+ _tlObelowIrrefutable :: Bool+ _tlOisDeclOfLet :: Bool+ _tlOoptions :: Options+ _hdIcopy :: Pattern+ _hdIisUnderscore :: Bool+ _hdIpp :: PP_Doc+ _hdIpp' :: PP_Doc+ _hdIstrictVars :: ([PP_Doc])+ _tlIcopy :: Patterns+ _tlIpps :: ([PP_Doc])+ _tlIpps' :: ([PP_Doc])+ _tlIstrictVars :: ([PP_Doc])+ -- "PrintCode.ag"(line 255, column 10)+ _lhsOpps =+ _hdIpp : _tlIpps+ -- "PrintCode.ag"(line 295, column 10)+ _lhsOpps' =+ _hdIpp' : _tlIpps'+ -- use rule "PrintCode.ag"(line 234, column 40)+ _lhsOstrictVars =+ _hdIstrictVars ++ _tlIstrictVars+ -- self rule+ _copy =+ (:) _hdIcopy _tlIcopy+ -- self rule+ _lhsOcopy =+ _copy+ -- copy rule (down)+ _hdObelowIrrefutable =+ _lhsIbelowIrrefutable+ -- copy rule (down)+ _hdOisDeclOfLet =+ _lhsIisDeclOfLet+ -- copy rule (down)+ _hdOoptions =+ _lhsIoptions+ -- copy rule (down)+ _tlObelowIrrefutable =+ _lhsIbelowIrrefutable+ -- copy rule (down)+ _tlOisDeclOfLet =+ _lhsIisDeclOfLet+ -- copy rule (down)+ _tlOoptions =+ _lhsIoptions+ ( _hdIcopy,_hdIisUnderscore,_hdIpp,_hdIpp',_hdIstrictVars) =+ (hd_ _hdObelowIrrefutable _hdOisDeclOfLet _hdOoptions)+ ( _tlIcopy,_tlIpps,_tlIpps',_tlIstrictVars) =+ (tl_ _tlObelowIrrefutable _tlOisDeclOfLet _tlOoptions)+ in ( _lhsOcopy,_lhsOpps,_lhsOpps',_lhsOstrictVars))))+sem_Patterns_Nil :: T_Patterns+sem_Patterns_Nil =+ (T_Patterns (\ _lhsIbelowIrrefutable+ _lhsIisDeclOfLet+ _lhsIoptions ->+ (let _lhsOpps :: ([PP_Doc])+ _lhsOpps' :: ([PP_Doc])+ _lhsOstrictVars :: ([PP_Doc])+ _lhsOcopy :: Patterns+ -- "PrintCode.ag"(line 256, column 10)+ _lhsOpps =+ []+ -- "PrintCode.ag"(line 296, column 10)+ _lhsOpps' =+ []+ -- use rule "PrintCode.ag"(line 234, column 40)+ _lhsOstrictVars =+ []+ -- self rule+ _copy =+ []+ -- self rule+ _lhsOcopy =+ _copy+ in ( _lhsOcopy,_lhsOpps,_lhsOpps',_lhsOstrictVars))))+-- Program -----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ importBlocks : PP_Doc+ mainFile : String+ mainName : String+ moduleHeader : String -> String -> String -> Bool -> String+ options : Options+ optionsLine : String+ pragmaBlocks : String+ textBlocks : PP_Doc+ synthesized attributes:+ genIO : IO ()+ output : PP_Docs+ alternatives:+ alternative Program:+ child chunks : Chunks+ visit 0:+ local mainModuleFile : _+ local genMainModule : _+ local commonFile : _+ local genCommonModule : _+-}+-- cata+sem_Program :: Program ->+ T_Program+sem_Program (Program _chunks) =+ (sem_Program_Program (sem_Chunks _chunks))+-- semantic domain+newtype T_Program = T_Program (PP_Doc ->+ String ->+ String ->+ (String -> String -> String -> Bool -> String) ->+ Options ->+ String ->+ String ->+ PP_Doc ->+ ( (IO ()),PP_Docs))+data Inh_Program = Inh_Program {importBlocks_Inh_Program :: PP_Doc,mainFile_Inh_Program :: String,mainName_Inh_Program :: String,moduleHeader_Inh_Program :: String -> String -> String -> Bool -> String,options_Inh_Program :: Options,optionsLine_Inh_Program :: String,pragmaBlocks_Inh_Program :: String,textBlocks_Inh_Program :: PP_Doc}+data Syn_Program = Syn_Program {genIO_Syn_Program :: IO (),output_Syn_Program :: PP_Docs}+wrap_Program (T_Program sem) (Inh_Program _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks) =+ (let ( _lhsOgenIO,_lhsOoutput) =+ (sem _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks)+ in (Syn_Program _lhsOgenIO _lhsOoutput))+sem_Program_Program :: T_Chunks ->+ T_Program+sem_Program_Program (T_Chunks chunks_) =+ (T_Program (\ _lhsIimportBlocks+ _lhsImainFile+ _lhsImainName+ _lhsImoduleHeader+ _lhsIoptions+ _lhsIoptionsLine+ _lhsIpragmaBlocks+ _lhsItextBlocks ->+ (let _chunksOnested :: Bool+ _lhsOoutput :: PP_Docs+ _chunksOisDeclOfLet :: Bool+ _lhsOgenIO :: (IO ())+ _chunksOimportBlocks :: PP_Doc+ _chunksOmainFile :: String+ _chunksOmainName :: String+ _chunksOmoduleHeader :: (String -> String -> String -> Bool -> String)+ _chunksOoptions :: Options+ _chunksOoptionsLine :: String+ _chunksOpragmaBlocks :: String+ _chunksOtextBlocks :: PP_Doc+ _chunksIappendCommon :: ([[PP_Doc]])+ _chunksIappendMain :: ([[PP_Doc]])+ _chunksIgenSems :: (IO ())+ _chunksIimports :: ([String])+ _chunksIpps :: PP_Docs+ -- "PrintCode.ag"(line 52, column 13)+ _chunksOnested =+ nest _lhsIoptions+ -- "PrintCode.ag"(line 80, column 16)+ _lhsOoutput =+ _chunksIpps+ -- "PrintCode.ag"(line 318, column 7)+ _chunksOisDeclOfLet =+ False+ -- "PrintCode.ag"(line 347, column 7)+ _mainModuleFile =+ _lhsImainFile ++ ".hs"+ -- "PrintCode.ag"(line 348, column 7)+ _genMainModule =+ writeModule _mainModuleFile+ ( [ pp $ _lhsIpragmaBlocks+ , pp $ _lhsIoptionsLine+ , pp $ _lhsImoduleHeader _lhsImainName "" "" False+ , pp $ ("import " ++ _lhsImainName ++ "_common\n")+ ]+ ++ map pp _chunksIimports+ ++ map vlist _chunksIappendMain+ )+ -- "PrintCode.ag"(line 359, column 7)+ _commonFile =+ _lhsImainFile ++ "_common.hs"+ -- "PrintCode.ag"(line 360, column 7)+ _genCommonModule =+ writeModule _commonFile+ ( [ pp $ _lhsIpragmaBlocks+ , pp $ _lhsIoptionsLine+ , pp $ _lhsImoduleHeader _lhsImainName "_common" "" True+ , _lhsIimportBlocks+ , _lhsItextBlocks+ ]+ ++ map vlist _chunksIappendCommon+ )+ -- "PrintCode.ag"(line 371, column 7)+ _lhsOgenIO =+ do _genMainModule+ _genCommonModule+ _chunksIgenSems+ -- copy rule (down)+ _chunksOimportBlocks =+ _lhsIimportBlocks+ -- copy rule (down)+ _chunksOmainFile =+ _lhsImainFile+ -- copy rule (down)+ _chunksOmainName =+ _lhsImainName+ -- copy rule (down)+ _chunksOmoduleHeader =+ _lhsImoduleHeader+ -- copy rule (down)+ _chunksOoptions =+ _lhsIoptions+ -- copy rule (down)+ _chunksOoptionsLine =+ _lhsIoptionsLine+ -- copy rule (down)+ _chunksOpragmaBlocks =+ _lhsIpragmaBlocks+ -- copy rule (down)+ _chunksOtextBlocks =+ _lhsItextBlocks+ ( _chunksIappendCommon,_chunksIappendMain,_chunksIgenSems,_chunksIimports,_chunksIpps) =+ (chunks_ _chunksOimportBlocks _chunksOisDeclOfLet _chunksOmainFile _chunksOmainName _chunksOmoduleHeader _chunksOnested _chunksOoptions _chunksOoptionsLine _chunksOpragmaBlocks _chunksOtextBlocks)+ in ( _lhsOgenIO,_lhsOoutput))))+-- Type --------------------------------------------------------+{-+ visit 0:+ inherited attribute:+ nested : Bool+ synthesized attributes:+ pp : PP_Doc+ prec : Int+ alternatives:+ alternative Arr:+ child left : Type+ child right : Type+ visit 0:+ local l : _+ local r : _+ alternative CtxApp:+ child left : {[(String, [String])]}+ child right : Type+ alternative List:+ child tp : Type+ alternative SimpleType:+ child txt : {String}+ alternative TupleType:+ child tps : Types+ alternative TypeApp:+ child func : Type+ child args : Types+ alternative UnboxedTupleType:+ child tps : Types+-}+-- cata+sem_Type :: Type ->+ T_Type+sem_Type (Arr _left _right) =+ (sem_Type_Arr (sem_Type _left) (sem_Type _right))+sem_Type (CtxApp _left _right) =+ (sem_Type_CtxApp _left (sem_Type _right))+sem_Type (List _tp) =+ (sem_Type_List (sem_Type _tp))+sem_Type (SimpleType _txt) =+ (sem_Type_SimpleType _txt)+sem_Type (TupleType _tps) =+ (sem_Type_TupleType (sem_Types _tps))+sem_Type (TypeApp _func _args) =+ (sem_Type_TypeApp (sem_Type _func) (sem_Types _args))+sem_Type (UnboxedTupleType _tps) =+ (sem_Type_UnboxedTupleType (sem_Types _tps))+-- semantic domain+newtype T_Type = T_Type (Bool ->+ ( PP_Doc,Int))+data Inh_Type = Inh_Type {nested_Inh_Type :: Bool}+data Syn_Type = Syn_Type {pp_Syn_Type :: PP_Doc,prec_Syn_Type :: Int}+wrap_Type (T_Type sem) (Inh_Type _lhsInested) =+ (let ( _lhsOpp,_lhsOprec) =+ (sem _lhsInested)+ in (Syn_Type _lhsOpp _lhsOprec))+sem_Type_Arr :: T_Type ->+ T_Type ->+ T_Type+sem_Type_Arr (T_Type left_) (T_Type right_) =+ (T_Type (\ _lhsInested ->+ (let _lhsOprec :: Int+ _lhsOpp :: PP_Doc+ _leftOnested :: Bool+ _rightOnested :: Bool+ _leftIpp :: PP_Doc+ _leftIprec :: Int+ _rightIpp :: PP_Doc+ _rightIprec :: Int+ -- "PrintCode.ag"(line 185, column 16)+ _lhsOprec =+ 2+ -- "PrintCode.ag"(line 185, column 16)+ _lhsOpp =+ _l >#< "->" >-< _r+ -- "PrintCode.ag"(line 187, column 16)+ _l =+ if _leftIprec <= 2 then pp_parens _leftIpp else _leftIpp+ -- "PrintCode.ag"(line 187, column 16)+ _r =+ if _rightIprec < 2 then pp_parens _rightIpp else _rightIpp+ -- copy rule (down)+ _leftOnested =+ _lhsInested+ -- copy rule (down)+ _rightOnested =+ _lhsInested+ ( _leftIpp,_leftIprec) =+ (left_ _leftOnested)+ ( _rightIpp,_rightIprec) =+ (right_ _rightOnested)+ in ( _lhsOpp,_lhsOprec))))+sem_Type_CtxApp :: ([(String, [String])]) ->+ T_Type ->+ T_Type+sem_Type_CtxApp left_ (T_Type right_) =+ (T_Type (\ _lhsInested ->+ (let _lhsOpp :: PP_Doc+ _lhsOprec :: Int+ _rightOnested :: Bool+ _rightIpp :: PP_Doc+ _rightIprec :: Int+ -- "PrintCode.ag"(line 194, column 7)+ _lhsOpp =+ (pp_block "(" ")" "," $ map (\(n,ns) -> hv_sp $ map pp (n:ns)) left_) >#< "=>" >#< _rightIpp+ -- copy rule (up)+ _lhsOprec =+ _rightIprec+ -- copy rule (down)+ _rightOnested =+ _lhsInested+ ( _rightIpp,_rightIprec) =+ (right_ _rightOnested)+ in ( _lhsOpp,_lhsOprec))))+sem_Type_List :: T_Type ->+ T_Type+sem_Type_List (T_Type tp_) =+ (T_Type (\ _lhsInested ->+ (let _lhsOprec :: Int+ _lhsOpp :: PP_Doc+ _tpOnested :: Bool+ _tpIpp :: PP_Doc+ _tpIprec :: Int+ -- "PrintCode.ag"(line 202, column 16)+ _lhsOprec =+ 5+ -- "PrintCode.ag"(line 202, column 16)+ _lhsOpp =+ "[" >|< _tpIpp >|< "]"+ -- copy rule (down)+ _tpOnested =+ _lhsInested+ ( _tpIpp,_tpIprec) =+ (tp_ _tpOnested)+ in ( _lhsOpp,_lhsOprec))))+sem_Type_SimpleType :: String ->+ T_Type+sem_Type_SimpleType txt_ =+ (T_Type (\ _lhsInested ->+ (let _lhsOprec :: Int+ _lhsOpp :: PP_Doc+ -- "PrintCode.ag"(line 205, column 16)+ _lhsOprec =+ 5+ -- "PrintCode.ag"(line 205, column 16)+ _lhsOpp =+ if reallySimple txt_ then text txt_ else pp_parens (text txt_)+ in ( _lhsOpp,_lhsOprec))))+sem_Type_TupleType :: T_Types ->+ T_Type+sem_Type_TupleType (T_Types tps_) =+ (T_Type (\ _lhsInested ->+ (let _lhsOprec :: Int+ _lhsOpp :: PP_Doc+ _tpsOnested :: Bool+ _tpsIpps :: PP_Docs+ -- "PrintCode.ag"(line 196, column 16)+ _lhsOprec =+ 5+ -- "PrintCode.ag"(line 196, column 16)+ _lhsOpp =+ ppTuple _lhsInested _tpsIpps+ -- copy rule (down)+ _tpsOnested =+ _lhsInested+ ( _tpsIpps) =+ (tps_ _tpsOnested)+ in ( _lhsOpp,_lhsOprec))))+sem_Type_TypeApp :: T_Type ->+ T_Types ->+ T_Type+sem_Type_TypeApp (T_Type func_) (T_Types args_) =+ (T_Type (\ _lhsInested ->+ (let _lhsOpp :: PP_Doc+ _lhsOprec :: Int+ _funcOnested :: Bool+ _argsOnested :: Bool+ _funcIpp :: PP_Doc+ _funcIprec :: Int+ _argsIpps :: PP_Docs+ -- "PrintCode.ag"(line 191, column 7)+ _lhsOpp =+ hv_sp (_funcIpp : _argsIpps)+ -- copy rule (up)+ _lhsOprec =+ _funcIprec+ -- copy rule (down)+ _funcOnested =+ _lhsInested+ -- copy rule (down)+ _argsOnested =+ _lhsInested+ ( _funcIpp,_funcIprec) =+ (func_ _funcOnested)+ ( _argsIpps) =+ (args_ _argsOnested)+ in ( _lhsOpp,_lhsOprec))))+sem_Type_UnboxedTupleType :: T_Types ->+ T_Type+sem_Type_UnboxedTupleType (T_Types tps_) =+ (T_Type (\ _lhsInested ->+ (let _lhsOprec :: Int+ _lhsOpp :: PP_Doc+ _tpsOnested :: Bool+ _tpsIpps :: PP_Docs+ -- "PrintCode.ag"(line 199, column 23)+ _lhsOprec =+ 5+ -- "PrintCode.ag"(line 199, column 23)+ _lhsOpp =+ ppUnboxedTuple _lhsInested _tpsIpps+ -- copy rule (down)+ _tpsOnested =+ _lhsInested+ ( _tpsIpps) =+ (tps_ _tpsOnested)+ in ( _lhsOpp,_lhsOprec))))+-- Types -------------------------------------------------------+{-+ visit 0:+ inherited attribute:+ nested : Bool+ synthesized attribute:+ pps : PP_Docs+ alternatives:+ alternative Cons:+ child hd : Type+ child tl : Types+ alternative Nil:+-}+-- cata+sem_Types :: Types ->+ T_Types+sem_Types list =+ (Prelude.foldr sem_Types_Cons sem_Types_Nil (Prelude.map sem_Type list))+-- semantic domain+newtype T_Types = T_Types (Bool ->+ ( PP_Docs))+data Inh_Types = Inh_Types {nested_Inh_Types :: Bool}+data Syn_Types = Syn_Types {pps_Syn_Types :: PP_Docs}+wrap_Types (T_Types sem) (Inh_Types _lhsInested) =+ (let ( _lhsOpps) =+ (sem _lhsInested)+ in (Syn_Types _lhsOpps))+sem_Types_Cons :: T_Type ->+ T_Types ->+ T_Types+sem_Types_Cons (T_Type hd_) (T_Types tl_) =+ (T_Types (\ _lhsInested ->+ (let _lhsOpps :: PP_Docs+ _hdOnested :: Bool+ _tlOnested :: Bool+ _hdIpp :: PP_Doc+ _hdIprec :: Int+ _tlIpps :: PP_Docs+ -- "PrintCode.ag"(line 67, column 10)+ _lhsOpps =+ _hdIpp : _tlIpps+ -- copy rule (down)+ _hdOnested =+ _lhsInested+ -- copy rule (down)+ _tlOnested =+ _lhsInested+ ( _hdIpp,_hdIprec) =+ (hd_ _hdOnested)+ ( _tlIpps) =+ (tl_ _tlOnested)+ in ( _lhsOpps))))+sem_Types_Nil :: T_Types+sem_Types_Nil =+ (T_Types (\ _lhsInested ->+ (let _lhsOpps :: PP_Docs+ -- "PrintCode.ag"(line 68, column 10)+ _lhsOpps =+ []+ in ( _lhsOpps))))
src-derived/PrintErrorMessages.hs view
@@ -1,4 +1,3 @@- -- UUAGC 0.9.5 (PrintErrorMessages.ag) module PrintErrorMessages where @@ -6,7 +5,7 @@ import UU.Scanner.Position(Pos(..), noPos) import ErrorMessages import DepTypes-import Options (Options,verbose)+import Options import Data.List(mapAccumL,intersect,(\\)) import GrammarInfo @@ -16,34 +15,37 @@ import CodeSyntax import CommonTypes -isError :: Error -> Bool-isError (ParserError _ _ _ ) = True-isError (DupAlt _ _ _ ) = False-isError (DupSynonym _ _ ) = False-isError (DupSet _ _ ) = False-isError (DupInhAttr _ _ _ ) = True-isError (DupSynAttr _ _ _ ) = True-isError (DupChild _ _ _ _ ) = False-isError (DupRule _ _ _ _ _) = True-isError (DupSig _ _ _ ) = True-isError (UndefNont _ ) = True-isError (UndefAlt _ _ ) = True-isError (UndefChild _ _ _ ) = True-isError (MissingRule _ _ _ _ ) = False-isError (SuperfluousRule _ _ _ _ ) = False-isError (UndefLocal _ _ _ ) = True-isError (ChildAsLocal _ _ _ ) = False-isError (UndefAttr _ _ _ _ ) = True-isError (CyclicSet _ ) = True-isError (CustomError w _ _ ) = not w-isError (LocalCirc _ _ _ _ _) = False-isError (InstCirc _ _ _ _ _) = False-isError (DirectCirc _ _ _ ) = False-isError (InducedCirc _ _ _ ) = False-isError (MissingTypeSig _ _ _ ) = False-isError (MissingInstSig _ _ _ ) = True-isError (ErroneousOrder _ _ _ ) = True+isError :: Options -> Error -> Bool+isError opts (ParserError _ _ _ ) = True+isError opts (DupAlt _ _ _ ) = False+isError opts (DupSynonym _ _ ) = False+isError opts (DupSet _ _ ) = False+isError opts (DupInhAttr _ _ _ ) = True+isError opts (DupSynAttr _ _ _ ) = True+isError opts (DupChild _ _ _ _ ) = False+isError opts (DupRule _ _ _ _ _) = True+isError opts (DupSig _ _ _ ) = True+isError opts (UndefNont _ ) = True+isError opts (UndefAlt _ _ ) = True+isError opts (UndefChild _ _ _ ) = True+isError opts (MissingRule _ _ _ _ ) = False+isError opts (SuperfluousRule _ _ _ _ ) = False+isError opts (UndefLocal _ _ _ ) = True+isError opts (ChildAsLocal _ _ _ ) = False+isError opts (UndefAttr _ _ _ _ _) = True+isError opts (CyclicSet _ ) = True+isError opts (CustomError w _ _ ) = not w+isError opts (LocalCirc _ _ _ _ _) = cycleIsDangerous opts+isError opts (InstCirc _ _ _ _ _) = cycleIsDangerous opts+isError opts (DirectCirc _ _ _ ) = cycleIsDangerous opts+isError opts (InducedCirc _ _ _ ) = cycleIsDangerous opts+isError opts (MissingTypeSig _ _ _ ) = False+isError opts (MissingInstSig _ _ _ ) = True +cycleIsDangerous :: Options -> Bool+cycleIsDangerous opts+ = any ($ opts) [ wignore, bangpats, cases, strictCases, stricterCases, strictSems, withCycle ]+ toWidth n xs | k<n = xs ++ replicate (n-k) ' ' | otherwise = xs where k = length xs@@ -153,16 +155,17 @@ -- Error ------------------------------------------------------- {- visit 0:- inherited attribute:+ inherited attributes:+ options : Options verbose : Bool synthesized attributes: me : SELF pp : PP_Doc alternatives: alternative ChildAsLocal:- child nt : {Nonterminal}- child con : {Constructor}- child var : {Name}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child var : {Identifier} visit 0: local me : _ alternative CustomError:@@ -172,109 +175,103 @@ visit 0: local me : _ alternative CyclicSet:- child name : {Name}+ child name : {Identifier} visit 0: local me : _ alternative DirectCirc:- child nt : {Nonterminal}+ child nt : {NontermIdent} child o_visit : {Bool}- child cyclic : {[((Name,Name),[String],[String])]}+ child cyclic : {[((Identifier,Identifier),[String],[String])]} visit 0: local me : _ alternative DupAlt:- child nt : {Nonterminal}- child con : {Constructor}- child occ1 : {Constructor}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child occ1 : {ConstructorIdent} visit 0: local me : _ alternative DupChild:- child nt : {Nonterminal}- child con : {Constructor}- child name : {Name}- child occ1 : {Name}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child name : {Identifier}+ child occ1 : {Identifier} visit 0: local me : _ alternative DupInhAttr:- child nt : {Nonterminal}- child attr : {Name}- child occ1 : {Name}+ child nt : {NontermIdent}+ child attr : {Identifier}+ child occ1 : {Identifier} visit 0: local me : _ alternative DupRule:- child nt : {Nonterminal}- child con : {Constructor}- child field : {Name}- child attr : {Name}- child occ1 : {Name}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child field : {Identifier}+ child attr : {Identifier}+ child occ1 : {Identifier} visit 0: local me : _ alternative DupSet:- child name : {Nonterminal}- child occ1 : {Nonterminal}+ child name : {NontermIdent}+ child occ1 : {NontermIdent} visit 0: local me : _ alternative DupSig:- child nt : {Nonterminal}- child con : {Constructor}- child attr : {Name}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child attr : {Identifier} visit 0: local me : _ alternative DupSynAttr:- child nt : {Nonterminal}- child attr : {Name}- child occ1 : {Name}+ child nt : {NontermIdent}+ child attr : {Identifier}+ child occ1 : {Identifier} visit 0: local me : _ alternative DupSynonym:- child nt : {Nonterminal}- child occ1 : {Nonterminal}- visit 0:- local me : _- alternative ErroneousOrder:- child nt : {Nonterminal}- child con : {Constructor}- child order : {Dependency}+ child nt : {NontermIdent}+ child occ1 : {NontermIdent} visit 0: local me : _ alternative InducedCirc:- child nt : {Nonterminal}+ child nt : {NontermIdent} child cinter : {CInterface}- child cyclic : {[((Name,Name),[String],[String])]}+ child cyclic : {[((Identifier,Identifier),[String],[String])]} visit 0: local me : _ alternative InstCirc:- child nt : {Nonterminal}- child con : {Constructor}- child attr : {Name}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child attr : {Identifier} child o_visit : {Bool} child path : {[String]} visit 0: local me : _ alternative LocalCirc:- child nt : {Nonterminal}- child con : {Constructor}- child attr : {Name}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child attr : {Identifier} child o_visit : {Bool} child path : {[String]} visit 0: local me : _ alternative MissingInstSig:- child nt : {Nonterminal}- child con : {Constructor}- child attr : {Name}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child attr : {Identifier} visit 0: local me : _ alternative MissingRule:- child nt : {Nonterminal}- child con : {Constructor}- child field : {Name}- child attr : {Name}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child field : {Identifier}+ child attr : {Identifier} visit 0: local me : _ alternative MissingTypeSig:- child nt : {Nonterminal}- child con : {Constructor}- child attr : {Name}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child attr : {Identifier} visit 0: local me : _ alternative ParserError:@@ -284,114 +281,115 @@ visit 0: local me : _ alternative SuperfluousRule:- child nt : {Nonterminal}- child con : {Constructor}- child field : {Name}- child attr : {Name}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child field : {Identifier}+ child attr : {Identifier} visit 0: local me : _ alternative UndefAlt:- child nt : {Nonterminal}- child con : {Constructor}+ child nt : {NontermIdent}+ child con : {ConstructorIdent} visit 0: local me : _ alternative UndefAttr:- child nt : {Nonterminal}- child con : {Constructor}- child field : {Name}- child attr : {Name}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child field : {Identifier}+ child attr : {Identifier}+ child isOut : {Bool} visit 0: local me : _ alternative UndefChild:- child nt : {Nonterminal}- child con : {Constructor}- child name : {Name}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child name : {Identifier} visit 0: local me : _ alternative UndefLocal:- child nt : {Nonterminal}- child con : {Constructor}- child var : {Name}+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child var : {Identifier} visit 0: local me : _ alternative UndefNont:- child nt : {Nonterminal}+ child nt : {NontermIdent} visit 0: local me : _ -} -- cata sem_Error :: Error -> T_Error-sem_Error (ChildAsLocal _nt _con _var ) =- (sem_Error_ChildAsLocal _nt _con _var )-sem_Error (CustomError _isWarning _pos _mesg ) =- (sem_Error_CustomError _isWarning _pos _mesg )-sem_Error (CyclicSet _name ) =- (sem_Error_CyclicSet _name )-sem_Error (DirectCirc _nt _o_visit _cyclic ) =- (sem_Error_DirectCirc _nt _o_visit _cyclic )-sem_Error (DupAlt _nt _con _occ1 ) =- (sem_Error_DupAlt _nt _con _occ1 )-sem_Error (DupChild _nt _con _name _occ1 ) =- (sem_Error_DupChild _nt _con _name _occ1 )-sem_Error (DupInhAttr _nt _attr _occ1 ) =- (sem_Error_DupInhAttr _nt _attr _occ1 )-sem_Error (DupRule _nt _con _field _attr _occ1 ) =- (sem_Error_DupRule _nt _con _field _attr _occ1 )-sem_Error (DupSet _name _occ1 ) =- (sem_Error_DupSet _name _occ1 )-sem_Error (DupSig _nt _con _attr ) =- (sem_Error_DupSig _nt _con _attr )-sem_Error (DupSynAttr _nt _attr _occ1 ) =- (sem_Error_DupSynAttr _nt _attr _occ1 )-sem_Error (DupSynonym _nt _occ1 ) =- (sem_Error_DupSynonym _nt _occ1 )-sem_Error (ErroneousOrder _nt _con _order ) =- (sem_Error_ErroneousOrder _nt _con _order )-sem_Error (InducedCirc _nt _cinter _cyclic ) =- (sem_Error_InducedCirc _nt _cinter _cyclic )-sem_Error (InstCirc _nt _con _attr _o_visit _path ) =- (sem_Error_InstCirc _nt _con _attr _o_visit _path )-sem_Error (LocalCirc _nt _con _attr _o_visit _path ) =- (sem_Error_LocalCirc _nt _con _attr _o_visit _path )-sem_Error (MissingInstSig _nt _con _attr ) =- (sem_Error_MissingInstSig _nt _con _attr )-sem_Error (MissingRule _nt _con _field _attr ) =- (sem_Error_MissingRule _nt _con _field _attr )-sem_Error (MissingTypeSig _nt _con _attr ) =- (sem_Error_MissingTypeSig _nt _con _attr )-sem_Error (ParserError _pos _problem _action ) =- (sem_Error_ParserError _pos _problem _action )-sem_Error (SuperfluousRule _nt _con _field _attr ) =- (sem_Error_SuperfluousRule _nt _con _field _attr )-sem_Error (UndefAlt _nt _con ) =- (sem_Error_UndefAlt _nt _con )-sem_Error (UndefAttr _nt _con _field _attr ) =- (sem_Error_UndefAttr _nt _con _field _attr )-sem_Error (UndefChild _nt _con _name ) =- (sem_Error_UndefChild _nt _con _name )-sem_Error (UndefLocal _nt _con _var ) =- (sem_Error_UndefLocal _nt _con _var )-sem_Error (UndefNont _nt ) =- (sem_Error_UndefNont _nt )+sem_Error (ChildAsLocal _nt _con _var) =+ (sem_Error_ChildAsLocal _nt _con _var)+sem_Error (CustomError _isWarning _pos _mesg) =+ (sem_Error_CustomError _isWarning _pos _mesg)+sem_Error (CyclicSet _name) =+ (sem_Error_CyclicSet _name)+sem_Error (DirectCirc _nt _o_visit _cyclic) =+ (sem_Error_DirectCirc _nt _o_visit _cyclic)+sem_Error (DupAlt _nt _con _occ1) =+ (sem_Error_DupAlt _nt _con _occ1)+sem_Error (DupChild _nt _con _name _occ1) =+ (sem_Error_DupChild _nt _con _name _occ1)+sem_Error (DupInhAttr _nt _attr _occ1) =+ (sem_Error_DupInhAttr _nt _attr _occ1)+sem_Error (DupRule _nt _con _field _attr _occ1) =+ (sem_Error_DupRule _nt _con _field _attr _occ1)+sem_Error (DupSet _name _occ1) =+ (sem_Error_DupSet _name _occ1)+sem_Error (DupSig _nt _con _attr) =+ (sem_Error_DupSig _nt _con _attr)+sem_Error (DupSynAttr _nt _attr _occ1) =+ (sem_Error_DupSynAttr _nt _attr _occ1)+sem_Error (DupSynonym _nt _occ1) =+ (sem_Error_DupSynonym _nt _occ1)+sem_Error (InducedCirc _nt _cinter _cyclic) =+ (sem_Error_InducedCirc _nt _cinter _cyclic)+sem_Error (InstCirc _nt _con _attr _o_visit _path) =+ (sem_Error_InstCirc _nt _con _attr _o_visit _path)+sem_Error (LocalCirc _nt _con _attr _o_visit _path) =+ (sem_Error_LocalCirc _nt _con _attr _o_visit _path)+sem_Error (MissingInstSig _nt _con _attr) =+ (sem_Error_MissingInstSig _nt _con _attr)+sem_Error (MissingRule _nt _con _field _attr) =+ (sem_Error_MissingRule _nt _con _field _attr)+sem_Error (MissingTypeSig _nt _con _attr) =+ (sem_Error_MissingTypeSig _nt _con _attr)+sem_Error (ParserError _pos _problem _action) =+ (sem_Error_ParserError _pos _problem _action)+sem_Error (SuperfluousRule _nt _con _field _attr) =+ (sem_Error_SuperfluousRule _nt _con _field _attr)+sem_Error (UndefAlt _nt _con) =+ (sem_Error_UndefAlt _nt _con)+sem_Error (UndefAttr _nt _con _field _attr _isOut) =+ (sem_Error_UndefAttr _nt _con _field _attr _isOut)+sem_Error (UndefChild _nt _con _name) =+ (sem_Error_UndefChild _nt _con _name)+sem_Error (UndefLocal _nt _con _var) =+ (sem_Error_UndefLocal _nt _con _var)+sem_Error (UndefNont _nt) =+ (sem_Error_UndefNont _nt) -- semantic domain-newtype T_Error = T_Error (Bool ->+newtype T_Error = T_Error (Options ->+ Bool -> ( Error,PP_Doc))-data Inh_Error = Inh_Error {verbose_Inh_Error :: Bool}+data Inh_Error = Inh_Error {options_Inh_Error :: Options,verbose_Inh_Error :: Bool} data Syn_Error = Syn_Error {me_Syn_Error :: Error,pp_Syn_Error :: PP_Doc}-wrap_Error (T_Error sem ) (Inh_Error _lhsIverbose ) =+wrap_Error (T_Error sem) (Inh_Error _lhsIoptions _lhsIverbose) = (let ( _lhsOme,_lhsOpp) =- (sem _lhsIverbose )- in (Syn_Error _lhsOme _lhsOpp ))-sem_Error_ChildAsLocal :: Nonterminal ->- Constructor ->- Name ->+ (sem _lhsIoptions _lhsIverbose)+ in (Syn_Error _lhsOme _lhsOpp))+sem_Error_ChildAsLocal :: NontermIdent ->+ ConstructorIdent ->+ Identifier -> T_Error-sem_Error_ChildAsLocal nt_ con_ var_ =- (T_Error (\ _lhsIverbose ->+sem_Error_ChildAsLocal nt_ con_ var_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error- -- "PrintErrorMessages.ag"(line 297, column 21)+ -- "PrintErrorMessages.ag"(line 300, column 21) _lhsOpp = let mesg = wfill ["Nontrivial field ",getName var_, "is used as local at constructor" , getName con_ , "of nonterminal",getName nt_, "."@@ -404,42 +402,44 @@ ,"You should use @", getName var_, ".self instead, where self is a SELF-attribute." ] act = wfill ["The generated program probably contains a type error or has undefined variables."]- in ppError (isError _me) (getPos var_) mesg pat help act _lhsIverbose+ in ppError (isError _lhsIoptions _me) (getPos var_) mesg pat help act _lhsIverbose -- self rule _me = ChildAsLocal nt_ con_ var_ -- self rule _lhsOme = _me- in ( _lhsOme,_lhsOpp))) )+ in ( _lhsOme,_lhsOpp)))) sem_Error_CustomError :: Bool -> Pos -> PP_Doc -> T_Error-sem_Error_CustomError isWarning_ pos_ mesg_ =- (T_Error (\ _lhsIverbose ->+sem_Error_CustomError isWarning_ pos_ mesg_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error- -- "PrintErrorMessages.ag"(line 335, column 21)+ -- "PrintErrorMessages.ag"(line 342, column 21) _lhsOpp = let pat = text "unknown" help = wfill ["not available."] act = wfill ["unknown"]- in ppError (isError _me) pos_ mesg_ pat help act False+ in ppError (isError _lhsIoptions _me) pos_ mesg_ pat help act False -- self rule _me = CustomError isWarning_ pos_ mesg_ -- self rule _lhsOme = _me- in ( _lhsOme,_lhsOpp))) )-sem_Error_CyclicSet :: Name ->+ in ( _lhsOme,_lhsOpp))))+sem_Error_CyclicSet :: Identifier -> T_Error-sem_Error_CyclicSet name_ =- (T_Error (\ _lhsIverbose ->+sem_Error_CyclicSet name_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error- -- "PrintErrorMessages.ag"(line 326, column 21)+ -- "PrintErrorMessages.ag"(line 333, column 21) _lhsOpp = let mesg = wfill ["Cyclic definition for nonterminal set", getName name_] pat = "SET" >#< getName name_ >#< "=" >#< "..." >#< getName name_ >#< "..."@@ -448,23 +448,24 @@ ,"Adapt the definition of the nonterminal set, to remove the cyclic dependency." ] act = wfill ["The nonterminal set", getName name_, "is considered to be empty."]- in ppError (isError _me) (getPos name_) mesg pat help act _lhsIverbose+ in ppError (isError _lhsIoptions _me) (getPos name_) mesg pat help act _lhsIverbose -- self rule _me = CyclicSet name_ -- self rule _lhsOme = _me- in ( _lhsOme,_lhsOpp))) )-sem_Error_DirectCirc :: Nonterminal ->+ in ( _lhsOme,_lhsOpp))))+sem_Error_DirectCirc :: NontermIdent -> Bool ->- ([((Name,Name),[String],[String])]) ->+ ([((Identifier,Identifier),[String],[String])]) -> T_Error-sem_Error_DirectCirc nt_ o_visit_ cyclic_ =- (T_Error (\ _lhsIverbose ->+sem_Error_DirectCirc nt_ o_visit_ cyclic_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error- -- "PrintErrorMessages.ag"(line 364, column 21)+ -- "PrintErrorMessages.ag"(line 371, column 21) _lhsOpp = let mesg = wfill ["In nonterminal", getName nt_, "synthesized and inherited attributes are mutually dependent" ] >-< vlist (map showEdge cyclic_)@@ -472,23 +473,24 @@ help = vlist (map showEdgeLong cyclic_) act | o_visit_ = text "An unoptimized version was generated. It might hang when run." | otherwise = text "The generated program might hang when run."- in ppError (isError _me) noPos mesg pat help act _lhsIverbose+ in ppError (isError _lhsIoptions _me) noPos mesg pat help act _lhsIverbose -- self rule _me = DirectCirc nt_ o_visit_ cyclic_ -- self rule _lhsOme = _me- in ( _lhsOme,_lhsOpp))) )-sem_Error_DupAlt :: Nonterminal ->- Constructor ->- Constructor ->+ in ( _lhsOme,_lhsOpp))))+sem_Error_DupAlt :: NontermIdent ->+ ConstructorIdent ->+ ConstructorIdent -> T_Error-sem_Error_DupAlt nt_ con_ occ1_ =- (T_Error (\ _lhsIverbose ->+sem_Error_DupAlt nt_ con_ occ1_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error- -- "PrintErrorMessages.ag"(line 70, column 21)+ -- "PrintErrorMessages.ag"(line 73, column 21) _lhsOpp = let mesg = wfill ["Repeated definition for alternative", getName con_ ,"of nonterminal", getName nt_, "."@@ -507,24 +509,25 @@ ,"you have given for nonterminal",getName nt_ ,"is considered valid. All other alternatives have been discarded." ]- in ppError (isError _me) (getPos con_) mesg pat help act _lhsIverbose+ in ppError (isError _lhsIoptions _me) (getPos con_) mesg pat help act _lhsIverbose -- self rule _me = DupAlt nt_ con_ occ1_ -- self rule _lhsOme = _me- in ( _lhsOme,_lhsOpp))) )-sem_Error_DupChild :: Nonterminal ->- Constructor ->- Name ->- Name ->+ in ( _lhsOme,_lhsOpp))))+sem_Error_DupChild :: NontermIdent ->+ ConstructorIdent ->+ Identifier ->+ Identifier -> T_Error-sem_Error_DupChild nt_ con_ name_ occ1_ =- (T_Error (\ _lhsIverbose ->+sem_Error_DupChild nt_ con_ name_ occ1_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error- -- "PrintErrorMessages.ag"(line 163, column 21)+ -- "PrintErrorMessages.ag"(line 166, column 21) _lhsOpp = let mesg = wfill ["Repeated declaration for field", getName name_, "of alternative" ,getName con_, "of nonterminal", getName nt_, "."@@ -542,23 +545,24 @@ act = wfill ["The last declaration with its corresponding type is considered valid." ,"All others have been discarded." ]- in ppError (isError _me) (getPos name_) mesg pat help act _lhsIverbose+ in ppError (isError _lhsIoptions _me) (getPos name_) mesg pat help act _lhsIverbose -- self rule _me = DupChild nt_ con_ name_ occ1_ -- self rule _lhsOme = _me- in ( _lhsOme,_lhsOpp))) )-sem_Error_DupInhAttr :: Nonterminal ->- Name ->- Name ->+ in ( _lhsOme,_lhsOpp))))+sem_Error_DupInhAttr :: NontermIdent ->+ Identifier ->+ Identifier -> T_Error-sem_Error_DupInhAttr nt_ attr_ occ1_ =- (T_Error (\ _lhsIverbose ->+sem_Error_DupInhAttr nt_ attr_ occ1_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error- -- "PrintErrorMessages.ag"(line 125, column 21)+ -- "PrintErrorMessages.ag"(line 128, column 21) _lhsOpp = let mesg = wfill ["Repeated declaration of inherited attribute", getName attr_ , "of nonterminal", getName nt_, "."@@ -575,25 +579,26 @@ act = wfill ["One declaration with its corresponding type is considered valid." ,"All others have been discarded. The generated program will probably not run." ]- in ppError (isError _me) (getPos attr_) mesg pat help act _lhsIverbose+ in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose -- self rule _me = DupInhAttr nt_ attr_ occ1_ -- self rule _lhsOme = _me- in ( _lhsOme,_lhsOpp))) )-sem_Error_DupRule :: Nonterminal ->- Constructor ->- Name ->- Name ->- Name ->+ in ( _lhsOme,_lhsOpp))))+sem_Error_DupRule :: NontermIdent ->+ ConstructorIdent ->+ Identifier ->+ Identifier ->+ Identifier -> T_Error-sem_Error_DupRule nt_ con_ field_ attr_ occ1_ =- (T_Error (\ _lhsIverbose ->+sem_Error_DupRule nt_ con_ field_ attr_ occ1_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error- -- "PrintErrorMessages.ag"(line 183, column 21)+ -- "PrintErrorMessages.ag"(line 186, column 21) _lhsOpp = let mesg = wfill ["At constructor",getName con_, "of nonterminal", getName nt_, "there are two or more rules for" ,showAttrDef field_ attr_,"."@@ -609,22 +614,23 @@ ,getName con_ , "of nonterminal " ,getName nt_ , "uniquely named." ] act = wfill ["The last rule given is considered valid. All others have been discarded."]- in ppError (isError _me) (getPos attr_) mesg pat help act _lhsIverbose+ in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose -- self rule _me = DupRule nt_ con_ field_ attr_ occ1_ -- self rule _lhsOme = _me- in ( _lhsOme,_lhsOpp))) )-sem_Error_DupSet :: Nonterminal ->- Nonterminal ->+ in ( _lhsOme,_lhsOpp))))+sem_Error_DupSet :: NontermIdent ->+ NontermIdent -> T_Error-sem_Error_DupSet name_ occ1_ =- (T_Error (\ _lhsIverbose ->+sem_Error_DupSet name_ occ1_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error- -- "PrintErrorMessages.ag"(line 109, column 21)+ -- "PrintErrorMessages.ag"(line 112, column 21) _lhsOpp = let mesg = wfill ["Definition of nonterminal set", getName name_, "clashes with another" ,"set, a type synonym or a data definition."@@ -640,23 +646,24 @@ ] act = wfill [ "The clashing nonterminal set will be ignored." ]- in ppError (isError _me) (getPos name_) mesg pat help act _lhsIverbose+ in ppError (isError _lhsIoptions _me) (getPos name_) mesg pat help act _lhsIverbose -- self rule _me = DupSet name_ occ1_ -- self rule _lhsOme = _me- in ( _lhsOme,_lhsOpp))) )-sem_Error_DupSig :: Nonterminal ->- Constructor ->- Name ->+ in ( _lhsOme,_lhsOpp))))+sem_Error_DupSig :: NontermIdent ->+ ConstructorIdent ->+ Identifier -> T_Error-sem_Error_DupSig nt_ con_ attr_ =- (T_Error (\ _lhsIverbose ->+sem_Error_DupSig nt_ con_ attr_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error- -- "PrintErrorMessages.ag"(line 201, column 21)+ -- "PrintErrorMessages.ag"(line 204, column 21) _lhsOpp = let mesg = wfill ["At constructor",getName con_, "of nonterminal", getName nt_, "there are two or more typesignatures for" ,showAttrDef _LOC attr_,"."@@ -671,23 +678,24 @@ ,getName con_ , "of nonterminal " ,getName nt_ , "unique." ] act = wfill ["The last typesignature given is considered valid. All others have been discarded."]- in ppError (isError _me) (getPos attr_) mesg pat help act _lhsIverbose+ in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose -- self rule _me = DupSig nt_ con_ attr_ -- self rule _lhsOme = _me- in ( _lhsOme,_lhsOpp))) )-sem_Error_DupSynAttr :: Nonterminal ->- Name ->- Name ->+ in ( _lhsOme,_lhsOpp))))+sem_Error_DupSynAttr :: NontermIdent ->+ Identifier ->+ Identifier -> T_Error-sem_Error_DupSynAttr nt_ attr_ occ1_ =- (T_Error (\ _lhsIverbose ->+sem_Error_DupSynAttr nt_ attr_ occ1_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error- -- "PrintErrorMessages.ag"(line 144, column 21)+ -- "PrintErrorMessages.ag"(line 147, column 21) _lhsOpp = let mesg = wfill ["Repeated declaration of synthesized attribute", getName attr_ , "of nonterminal", getName nt_, "."@@ -704,22 +712,23 @@ act = wfill ["One declaration with its corresponding type is considered valid." ,"All others have been discarded. The generated program will probably not run." ]- in ppError (isError _me) (getPos attr_) mesg pat help act _lhsIverbose+ in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose -- self rule _me = DupSynAttr nt_ attr_ occ1_ -- self rule _lhsOme = _me- in ( _lhsOme,_lhsOpp))) )-sem_Error_DupSynonym :: Nonterminal ->- Nonterminal ->+ in ( _lhsOme,_lhsOpp))))+sem_Error_DupSynonym :: NontermIdent ->+ NontermIdent -> T_Error-sem_Error_DupSynonym nt_ occ1_ =- (T_Error (\ _lhsIverbose ->+sem_Error_DupSynonym nt_ occ1_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error- -- "PrintErrorMessages.ag"(line 92, column 21)+ -- "PrintErrorMessages.ag"(line 95, column 21) _lhsOpp = let mesg = wfill ["Definition of type synonym", getName nt_, "clashes with another" ,"type synonym."@@ -736,57 +745,24 @@ ] act = wfill [ "The clashing type synonym will be ignored." ]- in ppError (isError _me) (getPos nt_) mesg pat help act _lhsIverbose+ in ppError (isError _lhsIoptions _me) (getPos nt_) mesg pat help act _lhsIverbose -- self rule _me = DupSynonym nt_ occ1_ -- self rule _lhsOme = _me- in ( _lhsOme,_lhsOpp))) )-sem_Error_ErroneousOrder :: Nonterminal ->- Constructor ->- Dependency ->- T_Error-sem_Error_ErroneousOrder nt_ con_ order_ =- (T_Error (\ _lhsIverbose ->- (let _lhsOpp :: PP_Doc- _lhsOme :: Error- -- "PrintErrorMessages.ag"(line 409, column 21)- _lhsOpp =- let (Dependency (fldA,nmA) (fldB,nmB)) = order_- mesg = wfill ["At alternative",getName con_, "of nonterminal", getName nt_, "there is an erroneous order"- , showAttrDef fldA nmA- , "<"- , showAttrDef fldB nmB- ]- pat = "SEM" >#< getName nt_- >-< indent 2 ("|" >#< getName con_ >#< ppAttr fldA nmA >#< "<" >#< ppAttr fldB nmB)- help = wfill [ "In the rules for alternative" , getName con_ , "of nonterminal" , getName nt_- , ", there is an erroneous attribute order defined"- , showAttrDef fldA nmA, "<", showAttrDef fldB nmB- , "because"- , showAttrDef fldA nmA- , "is not an In-attribute (inherited attribute of the production, or a synthesized attribute of a child)"- ]- act = wfill ["Please change the order definition."]- in ppError (isError _me) (getPos fldA) mesg pat help act _lhsIverbose- -- self rule- _me =- ErroneousOrder nt_ con_ order_- -- self rule- _lhsOme =- _me- in ( _lhsOme,_lhsOpp))) )-sem_Error_InducedCirc :: Nonterminal ->+ in ( _lhsOme,_lhsOpp))))+sem_Error_InducedCirc :: NontermIdent -> CInterface ->- ([((Name,Name),[String],[String])]) ->+ ([((Identifier,Identifier),[String],[String])]) -> T_Error-sem_Error_InducedCirc nt_ cinter_ cyclic_ =- (T_Error (\ _lhsIverbose ->+sem_Error_InducedCirc nt_ cinter_ cyclic_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error- -- "PrintErrorMessages.ag"(line 372, column 21)+ -- "PrintErrorMessages.ag"(line 379, column 21) _lhsOpp = let mesg = wfill ["After scheduling, in nonterminal", getName nt_, "synthesized and inherited attributes have an INDUCED mutual dependency" ] >-< vlist (map showEdge cyclic_)@@ -795,25 +771,26 @@ help = vlist (("Interface for nonterminal " ++ getName nt_ ++ ":") : map ind (showInter cinter_)) >-< vlist (map showEdgeLong cyclic_) act = text "An unoptimized version was generated. It might hang when run."- in ppError (isError _me) noPos mesg pat help act _lhsIverbose+ in ppError (isError _lhsIoptions _me) noPos mesg pat help act _lhsIverbose -- self rule _me = InducedCirc nt_ cinter_ cyclic_ -- self rule _lhsOme = _me- in ( _lhsOme,_lhsOpp))) )-sem_Error_InstCirc :: Nonterminal ->- Constructor ->- Name ->+ in ( _lhsOme,_lhsOpp))))+sem_Error_InstCirc :: NontermIdent ->+ ConstructorIdent ->+ Identifier -> Bool -> ([String]) -> T_Error-sem_Error_InstCirc nt_ con_ attr_ o_visit_ path_ =- (T_Error (\ _lhsIverbose ->+sem_Error_InstCirc nt_ con_ attr_ o_visit_ path_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error- -- "PrintErrorMessages.ag"(line 352, column 21)+ -- "PrintErrorMessages.ag"(line 359, column 21) _lhsOpp = let mesg = wfill ["Circular dependency for inst attribute", getName attr_ , "of alternative", getName con_, "of nonterminal", getName nt_]@@ -825,25 +802,26 @@ else hlist ("The following attributes are involved in the cycle:": path_) act | o_visit_ = text "An unoptimized version was generated. It might hang when run." | otherwise = text "The generated program might hang when run."- in ppError (isError _me) (getPos (attr_)) mesg pat help act _lhsIverbose+ in ppError (isError _lhsIoptions _me) (getPos (attr_)) mesg pat help act _lhsIverbose -- self rule _me = InstCirc nt_ con_ attr_ o_visit_ path_ -- self rule _lhsOme = _me- in ( _lhsOme,_lhsOpp))) )-sem_Error_LocalCirc :: Nonterminal ->- Constructor ->- Name ->+ in ( _lhsOme,_lhsOpp))))+sem_Error_LocalCirc :: NontermIdent ->+ ConstructorIdent ->+ Identifier -> Bool -> ([String]) -> T_Error-sem_Error_LocalCirc nt_ con_ attr_ o_visit_ path_ =- (T_Error (\ _lhsIverbose ->+sem_Error_LocalCirc nt_ con_ attr_ o_visit_ path_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error- -- "PrintErrorMessages.ag"(line 340, column 21)+ -- "PrintErrorMessages.ag"(line 347, column 21) _lhsOpp = let mesg = wfill ["Circular dependency for local attribute", getName attr_ , "of alternative", getName con_, "of nonterminal", getName nt_]@@ -855,23 +833,24 @@ else hlist ("The following attributes are involved in the cycle:": path_) act | o_visit_ = text "An unoptimized version was generated. It might hang when run." | otherwise = text "The generated program might hang when run."- in ppError (isError _me) (getPos (attr_)) mesg pat help act _lhsIverbose+ in ppError (isError _lhsIoptions _me) (getPos (attr_)) mesg pat help act _lhsIverbose -- self rule _me = LocalCirc nt_ con_ attr_ o_visit_ path_ -- self rule _lhsOme = _me- in ( _lhsOme,_lhsOpp))) )-sem_Error_MissingInstSig :: Nonterminal ->- Constructor ->- Name ->+ in ( _lhsOme,_lhsOpp))))+sem_Error_MissingInstSig :: NontermIdent ->+ ConstructorIdent ->+ Identifier -> T_Error-sem_Error_MissingInstSig nt_ con_ attr_ =- (T_Error (\ _lhsIverbose ->+sem_Error_MissingInstSig nt_ con_ attr_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error- -- "PrintErrorMessages.ag"(line 395, column 21)+ -- "PrintErrorMessages.ag"(line 402, column 21) _lhsOpp = let mesg = wfill ["Type signature needed, but not found for", showAttrDef _INST attr_ , "in alternative" , getName con_ , "of nonterminal",getName nt_ ,"."@@ -885,24 +864,25 @@ ,"Please supply its type." ] act = wfill ["It is not possible to proceed without this signature."]- in ppError (isError _me) (getPos attr_) mesg pat help act _lhsIverbose+ in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose -- self rule _me = MissingInstSig nt_ con_ attr_ -- self rule _lhsOme = _me- in ( _lhsOme,_lhsOpp))) )-sem_Error_MissingRule :: Nonterminal ->- Constructor ->- Name ->- Name ->+ in ( _lhsOme,_lhsOpp))))+sem_Error_MissingRule :: NontermIdent ->+ ConstructorIdent ->+ Identifier ->+ Identifier -> T_Error-sem_Error_MissingRule nt_ con_ field_ attr_ =- (T_Error (\ _lhsIverbose ->+sem_Error_MissingRule nt_ con_ field_ attr_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error- -- "PrintErrorMessages.ag"(line 255, column 21)+ -- "PrintErrorMessages.ag"(line 258, column 21) _lhsOpp = let mesg = wfill ["Missing rule for", showAttrDef field_ attr_ , "in alternative" , getName con_ , "of nonterminal",getName nt_ ,"."@@ -914,23 +894,24 @@ ,"by a copy rule, so you should add an appropriate rule." ] act = wfill ["The value of the attribute has been set to undefined."]- in ppError (isError _me) (getPos attr_) mesg pat help act _lhsIverbose+ in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose -- self rule _me = MissingRule nt_ con_ field_ attr_ -- self rule _lhsOme = _me- in ( _lhsOme,_lhsOpp))) )-sem_Error_MissingTypeSig :: Nonterminal ->- Constructor ->- Name ->+ in ( _lhsOme,_lhsOpp))))+sem_Error_MissingTypeSig :: NontermIdent ->+ ConstructorIdent ->+ Identifier -> T_Error-sem_Error_MissingTypeSig nt_ con_ attr_ =- (T_Error (\ _lhsIverbose ->+sem_Error_MissingTypeSig nt_ con_ attr_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error- -- "PrintErrorMessages.ag"(line 381, column 21)+ -- "PrintErrorMessages.ag"(line 388, column 21) _lhsOpp = let mesg = wfill ["Type signature needed, but not found for", showAttrDef _LOC attr_ , "in alternative" , getName con_ , "of nonterminal",getName nt_ ,"."@@ -944,46 +925,48 @@ ,"Please supply its type." ] act = wfill ["The type signatures of semantic functions are not generated."]- in ppError (isError _me) (getPos attr_) mesg pat help act _lhsIverbose+ in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose -- self rule _me = MissingTypeSig nt_ con_ attr_ -- self rule _lhsOme = _me- in ( _lhsOme,_lhsOpp))) )+ in ( _lhsOme,_lhsOpp)))) sem_Error_ParserError :: Pos -> String -> String -> T_Error-sem_Error_ParserError pos_ problem_ action_ =- (T_Error (\ _lhsIverbose ->+sem_Error_ParserError pos_ problem_ action_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error- -- "PrintErrorMessages.ag"(line 64, column 21)+ -- "PrintErrorMessages.ag"(line 67, column 21) _lhsOpp = let mesg = text ("parser expecting " ++ problem_) pat = text "" help = text "" act = text action_- in ppError (isError _me) pos_ mesg pat help act _lhsIverbose+ in ppError (isError _lhsIoptions _me) pos_ mesg pat help act _lhsIverbose -- self rule _me = ParserError pos_ problem_ action_ -- self rule _lhsOme = _me- in ( _lhsOme,_lhsOpp))) )-sem_Error_SuperfluousRule :: Nonterminal ->- Constructor ->- Name ->- Name ->+ in ( _lhsOme,_lhsOpp))))+sem_Error_SuperfluousRule :: NontermIdent ->+ ConstructorIdent ->+ Identifier ->+ Identifier -> T_Error-sem_Error_SuperfluousRule nt_ con_ field_ attr_ =- (T_Error (\ _lhsIverbose ->+sem_Error_SuperfluousRule nt_ con_ field_ attr_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error- -- "PrintErrorMessages.ag"(line 268, column 21)+ -- "PrintErrorMessages.ag"(line 271, column 21) _lhsOpp = let mesg = wfill ["Rule for non-existing", showAttrDef field_ attr_ , "at alternative" , getName con_ , "of nonterminal",getName nt_, "."@@ -995,22 +978,23 @@ ,"Otherwise either remove the rule or add an appropriate attribute definition." ] act = wfill ["The rule has been ignored."]- in ppError (isError _me) (getPos attr_) mesg pat help act _lhsIverbose+ in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose -- self rule _me = SuperfluousRule nt_ con_ field_ attr_ -- self rule _lhsOme = _me- in ( _lhsOme,_lhsOpp))) )-sem_Error_UndefAlt :: Nonterminal ->- Constructor ->+ in ( _lhsOme,_lhsOpp))))+sem_Error_UndefAlt :: NontermIdent ->+ ConstructorIdent -> T_Error-sem_Error_UndefAlt nt_ con_ =- (T_Error (\ _lhsIverbose ->+sem_Error_UndefAlt nt_ con_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error- -- "PrintErrorMessages.ag"(line 228, column 21)+ -- "PrintErrorMessages.ag"(line 231, column 21) _lhsOpp = let mesg = wfill ["Constructor", getName con_, "of nonterminal" ,getName nt_, "is not defined." ]@@ -1021,26 +1005,32 @@ ,"nonterminal" , getName nt_, ". Maybe you misspelled it? Otherwise insert a definition." ] act = wfill ["All rules for the unknown alternative have been ignored."]- in ppError (isError _me) (getPos con_) mesg pat help act _lhsIverbose+ in ppError (isError _lhsIoptions _me) (getPos con_) mesg pat help act _lhsIverbose -- self rule _me = UndefAlt nt_ con_ -- self rule _lhsOme = _me- in ( _lhsOme,_lhsOpp))) )-sem_Error_UndefAttr :: Nonterminal ->- Constructor ->- Name ->- Name ->+ in ( _lhsOme,_lhsOpp))))+sem_Error_UndefAttr :: NontermIdent ->+ ConstructorIdent ->+ Identifier ->+ Identifier ->+ Bool -> T_Error-sem_Error_UndefAttr nt_ con_ field_ attr_ =- (T_Error (\ _lhsIverbose ->+sem_Error_UndefAttr nt_ con_ field_ attr_ isOut_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error- -- "PrintErrorMessages.ag"(line 311, column 21)+ -- "PrintErrorMessages.ag"(line 314, column 21) _lhsOpp =- let mesg = wfill ["Undefined", showAttrUse field_ attr_, "at constructor"+ let mesg = wfill ["Undefined"+ , if isOut_+ then showAttrDef field_ attr_+ else showAttrUse field_ attr_+ , "at constructor" , getName con_ , "of nonterminal",getName nt_, "." ] pat = "SEM" >#< getName nt_@@ -1052,23 +1042,24 @@ ,"Otherwise either remove the rule or add an appropriate attribute definition." ] act = wfill ["The generated program will not run."]- in ppError (isError _me) (getPos attr_) mesg pat help act _lhsIverbose+ in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose -- self rule _me =- UndefAttr nt_ con_ field_ attr_+ UndefAttr nt_ con_ field_ attr_ isOut_ -- self rule _lhsOme = _me- in ( _lhsOme,_lhsOpp))) )-sem_Error_UndefChild :: Nonterminal ->- Constructor ->- Name ->+ in ( _lhsOme,_lhsOpp))))+sem_Error_UndefChild :: NontermIdent ->+ ConstructorIdent ->+ Identifier -> T_Error-sem_Error_UndefChild nt_ con_ name_ =- (T_Error (\ _lhsIverbose ->+sem_Error_UndefChild nt_ con_ name_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error- -- "PrintErrorMessages.ag"(line 240, column 21)+ -- "PrintErrorMessages.ag"(line 243, column 21) _lhsOpp = let mesg = wfill ["Constructor", getName con_, "of nonterminal" ,getName nt_ , "does not have a nontrivial field named", getName name_ , "."@@ -1082,23 +1073,24 @@ ,"or change its type from an HS-type to an AG-type." ] act = wfill ["All rules for the unknown field have been ignored."]- in ppError (isError _me) (getPos name_) mesg pat help act _lhsIverbose+ in ppError (isError _lhsIoptions _me) (getPos name_) mesg pat help act _lhsIverbose -- self rule _me = UndefChild nt_ con_ name_ -- self rule _lhsOme = _me- in ( _lhsOme,_lhsOpp))) )-sem_Error_UndefLocal :: Nonterminal ->- Constructor ->- Name ->+ in ( _lhsOme,_lhsOpp))))+sem_Error_UndefLocal :: NontermIdent ->+ ConstructorIdent ->+ Identifier -> T_Error-sem_Error_UndefLocal nt_ con_ var_ =- (T_Error (\ _lhsIverbose ->+sem_Error_UndefLocal nt_ con_ var_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error- -- "PrintErrorMessages.ag"(line 282, column 21)+ -- "PrintErrorMessages.ag"(line 285, column 21) _lhsOpp = let mesg = wfill ["Undefined local variable or field",getName var_, "at constructor" , getName con_ , "of nonterminal",getName nt_, "."@@ -1107,26 +1099,27 @@ >-< indent 2 ("|" >#< getName con_ >#< "<field>.<attr> = " >#< "..." >#< "@" >|< getName var_ >#< "..." ) help = wfill ["A rule in the definitions for alternative" , getName con_ ,"of nonterminal"- , getName nt_ , "contains a local variable or field name that is not defined"+ , getName nt_ , "contains a local variable or field name that is not defined. " ,"Maybe you misspelled it?" ,"Otherwise either remove the rule or add an appropriate definition." ] act = wfill ["The generated program will not run."]- in ppError (isError _me) (getPos var_) mesg pat help act _lhsIverbose+ in ppError (isError _lhsIoptions _me) (getPos var_) mesg pat help act _lhsIverbose -- self rule _me = UndefLocal nt_ con_ var_ -- self rule _lhsOme = _me- in ( _lhsOme,_lhsOpp))) )-sem_Error_UndefNont :: Nonterminal ->+ in ( _lhsOme,_lhsOpp))))+sem_Error_UndefNont :: NontermIdent -> T_Error-sem_Error_UndefNont nt_ =- (T_Error (\ _lhsIverbose ->+sem_Error_UndefNont nt_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error- -- "PrintErrorMessages.ag"(line 218, column 21)+ -- "PrintErrorMessages.ag"(line 221, column 21) _lhsOpp = let mesg = wfill ["Nonterminal", getName nt_, "is not defined." ]@@ -1135,14 +1128,14 @@ , "for" ,getName nt_, ". Maybe you misspelled it? Otherwise insert a definition." ] act = wfill ["Everything regarding the unknown nonterminal has been ignored."]- in ppError (isError _me) (getPos nt_) mesg pat help act _lhsIverbose+ in ppError (isError _lhsIoptions _me) (getPos nt_) mesg pat help act _lhsIverbose -- self rule _me = UndefNont nt_ -- self rule _lhsOme = _me- in ( _lhsOme,_lhsOpp))) )+ in ( _lhsOme,_lhsOpp)))) -- Errors ------------------------------------------------------ {- visit 0:@@ -1163,34 +1156,38 @@ -- cata sem_Errors :: Errors -> T_Errors-sem_Errors list =- (Prelude.foldr sem_Errors_Cons sem_Errors_Nil (Prelude.map sem_Error list) )+sem_Errors list =+ (Prelude.foldr sem_Errors_Cons sem_Errors_Nil (Prelude.map sem_Error list)) -- semantic domain newtype T_Errors = T_Errors (Options -> ( PP_Doc)) data Inh_Errors = Inh_Errors {options_Inh_Errors :: Options} data Syn_Errors = Syn_Errors {pp_Syn_Errors :: PP_Doc}-wrap_Errors (T_Errors sem ) (Inh_Errors _lhsIoptions ) =+wrap_Errors (T_Errors sem) (Inh_Errors _lhsIoptions) = (let ( _lhsOpp) =- (sem _lhsIoptions )- in (Syn_Errors _lhsOpp ))+ (sem _lhsIoptions)+ in (Syn_Errors _lhsOpp)) sem_Errors_Cons :: T_Error -> T_Errors -> T_Errors-sem_Errors_Cons (T_Error hd_ ) (T_Errors tl_ ) =+sem_Errors_Cons (T_Error hd_) (T_Errors tl_) = (T_Errors (\ _lhsIoptions -> (let _lhsOpp :: PP_Doc+ _hdOoptions :: Options _hdOverbose :: Bool _tlOoptions :: Options _hdIme :: Error _hdIpp :: PP_Doc _tlIpp :: PP_Doc- -- "PrintErrorMessages.ag"(line 59, column 8)+ -- "PrintErrorMessages.ag"(line 62, column 8) _verbose = verbose _lhsIoptions- -- use rule "PrintErrorMessages.ag"(line 55, column 49)+ -- use rule "PrintErrorMessages.ag"(line 58, column 49) _lhsOpp = _hdIpp >-< _tlIpp+ -- copy rule (down)+ _hdOoptions =+ _lhsIoptions -- copy rule (from local) _hdOverbose = _verbose@@ -1198,18 +1195,18 @@ _tlOoptions = _lhsIoptions ( _hdIme,_hdIpp) =- (hd_ _hdOverbose )+ (hd_ _hdOoptions _hdOverbose) ( _tlIpp) =- (tl_ _tlOoptions )- in ( _lhsOpp))) )+ (tl_ _tlOoptions)+ in ( _lhsOpp)))) sem_Errors_Nil :: T_Errors sem_Errors_Nil = (T_Errors (\ _lhsIoptions -> (let _lhsOpp :: PP_Doc- -- "PrintErrorMessages.ag"(line 59, column 8)+ -- "PrintErrorMessages.ag"(line 62, column 8) _verbose = verbose _lhsIoptions- -- use rule "PrintErrorMessages.ag"(line 55, column 49)+ -- use rule "PrintErrorMessages.ag"(line 58, column 49) _lhsOpp = text ""- in ( _lhsOpp))) )+ in ( _lhsOpp))))
src-derived/SemHsTokens.hs view
@@ -11,14 +11,14 @@ import CommonTypes import UU.Scanner.Position(Pos) -isNTname allnts (Just (NT nt)) = nt `elem` allnts-isNTname allnts _ = False+isNTname allnts (Just (NT nt _)) = nt `elem` allnts+isNTname allnts _ = False -- HsToken ----------------------------------------------------- {- visit 0: inherited attributes:- allfields : [(Name,Type,Bool)]- allnts : [Name]+ allfields : [(Identifier,Type,Bool)]+ allnts : [Identifier] attrs : [(Identifier,Identifier)] con : Identifier fieldnames : [Identifier]@@ -31,12 +31,16 @@ usedLocals : [Identifier] alternatives: alternative AGField:- child field : {Name}- child attr : {Name}+ child field : {Identifier}+ child attr : {Identifier} child pos : {Pos}+ child rdesc : {Maybe String}+ visit 0:+ local addTrace : _ alternative AGLocal:- child var : {Name}+ child var : {Identifier} child pos : {Pos}+ child rdesc : {Maybe String} visit 0: local _tup1 : _ local errors : _@@ -58,10 +62,10 @@ -- cata sem_HsToken :: HsToken -> T_HsToken-sem_HsToken (AGField _field _attr _pos) =- (sem_HsToken_AGField _field _attr _pos)-sem_HsToken (AGLocal _var _pos) =- (sem_HsToken_AGLocal _var _pos)+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) =@@ -71,24 +75,25 @@ sem_HsToken (StrToken _value _pos) = (sem_HsToken_StrToken _value _pos) -- semantic domain-newtype T_HsToken = T_HsToken (([(Name,Type,Bool)]) ->- ([Name]) ->+newtype T_HsToken = T_HsToken (([(Identifier,Type,Bool)]) ->+ ([Identifier]) -> ([(Identifier,Identifier)]) -> Identifier -> ([Identifier]) -> Identifier -> ( (Seq Error),((Pos,String)),([(Identifier,Identifier)]),(Seq Identifier),([Identifier])))-data Inh_HsToken = Inh_HsToken {allfields_Inh_HsToken :: [(Name,Type,Bool)],allnts_Inh_HsToken :: [Name],attrs_Inh_HsToken :: [(Identifier,Identifier)],con_Inh_HsToken :: Identifier,fieldnames_Inh_HsToken :: [Identifier],nt_Inh_HsToken :: Identifier}+data Inh_HsToken = Inh_HsToken {allfields_Inh_HsToken :: [(Identifier,Type,Bool)],allnts_Inh_HsToken :: [Identifier],attrs_Inh_HsToken :: [(Identifier,Identifier)],con_Inh_HsToken :: Identifier,fieldnames_Inh_HsToken :: [Identifier],nt_Inh_HsToken :: Identifier} data Syn_HsToken = Syn_HsToken {errors_Syn_HsToken :: Seq Error,tok_Syn_HsToken :: (Pos,String),usedAttrs_Syn_HsToken :: [(Identifier,Identifier)],usedFields_Syn_HsToken :: Seq Identifier,usedLocals_Syn_HsToken :: [Identifier]} wrap_HsToken (T_HsToken sem) (Inh_HsToken _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt) = (let ( _lhsOerrors,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals) = (sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt) in (Syn_HsToken _lhsOerrors _lhsOtok _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals))-sem_HsToken_AGField :: Name ->- Name ->+sem_HsToken_AGField :: Identifier ->+ Identifier -> Pos ->+ (Maybe String) -> T_HsToken-sem_HsToken_AGField field_ attr_ pos_ =+sem_HsToken_AGField field_ attr_ pos_ rdesc_ = (T_HsToken (\ _lhsIallfields _lhsIallnts _lhsIattrs@@ -100,30 +105,36 @@ _lhsOtok :: ((Pos,String)) _lhsOusedFields :: (Seq Identifier) _lhsOusedLocals :: ([Identifier])- -- "SemHsTokens.ag"(line 73, column 15)+ -- "SemHsTokens.ag"(line 72, column 15) _lhsOerrors = if (field_,attr_) `elem` _lhsIattrs then Seq.empty else if not(field_ `elem` (_LHS : _LOC: _lhsIfieldnames)) then Seq.single (UndefChild _lhsInt _lhsIcon field_)- else Seq.single (UndefAttr _lhsInt _lhsIcon field_ attr_)- -- "SemHsTokens.ag"(line 87, column 13)+ else Seq.single (UndefAttr _lhsInt _lhsIcon field_ attr_ False)+ -- "SemHsTokens.ag"(line 86, column 13) _lhsOusedAttrs = [(field_,attr_)]- -- "SemHsTokens.ag"(line 113, column 14)+ -- "SemHsTokens.ag"(line 113, column 8)+ _addTrace =+ case rdesc_ of+ Just d -> \x -> "(trace " ++ show (d ++ " -> " ++ show field_ ++ "." ++ show attr_) ++ " (" ++ x ++ "))"+ Nothing -> id+ -- "SemHsTokens.ag"(line 116, column 8) _lhsOtok =- (pos_, attrname True field_ attr_)- -- use rule "SemHsTokens.ag"(line 92, column 40)+ (pos_, _addTrace $ attrname True field_ attr_)+ -- use rule "SemHsTokens.ag"(line 91, column 40) _lhsOusedFields = Seq.empty- -- use rule "SemHsTokens.ag"(line 83, column 40)+ -- use rule "SemHsTokens.ag"(line 82, column 40) _lhsOusedLocals = [] in ( _lhsOerrors,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))))-sem_HsToken_AGLocal :: Name ->+sem_HsToken_AGLocal :: Identifier -> Pos ->+ (Maybe String) -> T_HsToken-sem_HsToken_AGLocal var_ pos_ =+sem_HsToken_AGLocal var_ pos_ rdesc_ = (T_HsToken (\ _lhsIallfields _lhsIallnts _lhsIattrs@@ -135,7 +146,7 @@ _lhsOusedAttrs :: ([(Identifier,Identifier)]) _lhsOusedLocals :: ([Identifier]) _lhsOtok :: ((Pos,String))- -- "SemHsTokens.ag"(line 63, column 19)+ -- "SemHsTokens.ag"(line 62, column 19) __tup1 = if var_ `elem` _lhsIfieldnames then if isNTname _lhsIallnts (lookup var_ (map (\(n,t,_) -> (n,t)) _lhsIallfields))@@ -144,27 +155,27 @@ else if (_LOC,var_) `elem` _lhsIattrs then (Seq.empty , (pos_,locname var_), [var_]) else (Seq.single(UndefLocal _lhsInt _lhsIcon var_), (pos_,locname var_), [] )- -- "SemHsTokens.ag"(line 63, column 19)+ -- "SemHsTokens.ag"(line 62, column 19) (_errors,_,_) = __tup1- -- "SemHsTokens.ag"(line 63, column 19)+ -- "SemHsTokens.ag"(line 62, column 19) (_,_tok,_) = __tup1- -- "SemHsTokens.ag"(line 63, column 19)+ -- "SemHsTokens.ag"(line 62, column 19) (_,_,_usedLocals) = __tup1- -- "SemHsTokens.ag"(line 95, column 13)+ -- "SemHsTokens.ag"(line 94, column 13) _lhsOusedFields = if var_ `elem` _lhsIfieldnames then Seq.single var_ else Seq.empty- -- use rule "SemHsTokens.ag"(line 42, column 37)+ -- use rule "SemHsTokens.ag"(line 41, column 37) _lhsOerrors = _errors- -- use rule "SemHsTokens.ag"(line 84, column 40)+ -- use rule "SemHsTokens.ag"(line 83, column 40) _lhsOusedAttrs = []- -- use rule "SemHsTokens.ag"(line 83, column 40)+ -- use rule "SemHsTokens.ag"(line 82, column 40) _lhsOusedLocals = _usedLocals -- copy rule (from local)@@ -186,22 +197,22 @@ _lhsOusedAttrs :: ([(Identifier,Identifier)]) _lhsOusedFields :: (Seq Identifier) _lhsOusedLocals :: ([Identifier])- -- "SemHsTokens.ag"(line 117, column 16)+ -- "SemHsTokens.ag"(line 120, column 16) _lhsOtok = (pos_, if null value_ then "" else showCharShort (head value_) )- -- use rule "SemHsTokens.ag"(line 42, column 37)+ -- use rule "SemHsTokens.ag"(line 41, column 37) _lhsOerrors = Seq.empty- -- use rule "SemHsTokens.ag"(line 84, column 40)+ -- use rule "SemHsTokens.ag"(line 83, column 40) _lhsOusedAttrs = []- -- use rule "SemHsTokens.ag"(line 92, column 40)+ -- use rule "SemHsTokens.ag"(line 91, column 40) _lhsOusedFields = Seq.empty- -- use rule "SemHsTokens.ag"(line 83, column 40)+ -- use rule "SemHsTokens.ag"(line 82, column 40) _lhsOusedLocals = [] in ( _lhsOerrors,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))))@@ -220,20 +231,20 @@ _lhsOusedAttrs :: ([(Identifier,Identifier)]) _lhsOusedFields :: (Seq Identifier) _lhsOusedLocals :: ([Identifier])- -- "SemHsTokens.ag"(line 49, column 9)+ -- "SemHsTokens.ag"(line 48, column 9) _lhsOerrors = let m = text mesg_ in Seq.single (CustomError False pos_ m)- -- "SemHsTokens.ag"(line 123, column 16)+ -- "SemHsTokens.ag"(line 126, column 16) _lhsOtok = (pos_, "")- -- use rule "SemHsTokens.ag"(line 84, column 40)+ -- use rule "SemHsTokens.ag"(line 83, column 40) _lhsOusedAttrs = []- -- use rule "SemHsTokens.ag"(line 92, column 40)+ -- use rule "SemHsTokens.ag"(line 91, column 40) _lhsOusedFields = Seq.empty- -- use rule "SemHsTokens.ag"(line 83, column 40)+ -- use rule "SemHsTokens.ag"(line 82, column 40) _lhsOusedLocals = [] in ( _lhsOerrors,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))))@@ -252,19 +263,19 @@ _lhsOusedAttrs :: ([(Identifier,Identifier)]) _lhsOusedFields :: (Seq Identifier) _lhsOusedLocals :: ([Identifier])- -- "SemHsTokens.ag"(line 115, column 14)+ -- "SemHsTokens.ag"(line 118, column 14) _lhsOtok = (pos_, value_)- -- use rule "SemHsTokens.ag"(line 42, column 37)+ -- use rule "SemHsTokens.ag"(line 41, column 37) _lhsOerrors = Seq.empty- -- use rule "SemHsTokens.ag"(line 84, column 40)+ -- use rule "SemHsTokens.ag"(line 83, column 40) _lhsOusedAttrs = []- -- use rule "SemHsTokens.ag"(line 92, column 40)+ -- use rule "SemHsTokens.ag"(line 91, column 40) _lhsOusedFields = Seq.empty- -- use rule "SemHsTokens.ag"(line 83, column 40)+ -- use rule "SemHsTokens.ag"(line 82, column 40) _lhsOusedLocals = [] in ( _lhsOerrors,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))))@@ -283,19 +294,19 @@ _lhsOusedAttrs :: ([(Identifier,Identifier)]) _lhsOusedFields :: (Seq Identifier) _lhsOusedLocals :: ([Identifier])- -- "SemHsTokens.ag"(line 122, column 16)+ -- "SemHsTokens.ag"(line 125, column 16) _lhsOtok = (pos_, showStrShort value_)- -- use rule "SemHsTokens.ag"(line 42, column 37)+ -- use rule "SemHsTokens.ag"(line 41, column 37) _lhsOerrors = Seq.empty- -- use rule "SemHsTokens.ag"(line 84, column 40)+ -- use rule "SemHsTokens.ag"(line 83, column 40) _lhsOusedAttrs = []- -- use rule "SemHsTokens.ag"(line 92, column 40)+ -- use rule "SemHsTokens.ag"(line 91, column 40) _lhsOusedFields = Seq.empty- -- use rule "SemHsTokens.ag"(line 83, column 40)+ -- use rule "SemHsTokens.ag"(line 82, column 40) _lhsOusedLocals = [] in ( _lhsOerrors,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))))@@ -303,8 +314,8 @@ {- visit 0: inherited attributes:- allfields : [(Name,Type,Bool)]- allnts : [Name]+ allfields : [(Identifier,Type,Bool)]+ allnts : [Identifier] attrs : [(Identifier,Identifier)] con : Identifier fieldnames : [Identifier]@@ -327,14 +338,14 @@ sem_HsTokens list = (Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list)) -- semantic domain-newtype T_HsTokens = T_HsTokens (([(Name,Type,Bool)]) ->- ([Name]) ->+newtype T_HsTokens = T_HsTokens (([(Identifier,Type,Bool)]) ->+ ([Identifier]) -> ([(Identifier,Identifier)]) -> Identifier -> ([Identifier]) -> Identifier -> ( (Seq Error),([(Pos,String)]),([(Identifier,Identifier)]),(Seq Identifier),([Identifier])))-data Inh_HsTokens = Inh_HsTokens {allfields_Inh_HsTokens :: [(Name,Type,Bool)],allnts_Inh_HsTokens :: [Name],attrs_Inh_HsTokens :: [(Identifier,Identifier)],con_Inh_HsTokens :: Identifier,fieldnames_Inh_HsTokens :: [Identifier],nt_Inh_HsTokens :: Identifier}+data Inh_HsTokens = Inh_HsTokens {allfields_Inh_HsTokens :: [(Identifier,Type,Bool)],allnts_Inh_HsTokens :: [Identifier],attrs_Inh_HsTokens :: [(Identifier,Identifier)],con_Inh_HsTokens :: Identifier,fieldnames_Inh_HsTokens :: [Identifier],nt_Inh_HsTokens :: Identifier} data Syn_HsTokens = Syn_HsTokens {errors_Syn_HsTokens :: Seq Error,tks_Syn_HsTokens :: [(Pos,String)],usedAttrs_Syn_HsTokens :: [(Identifier,Identifier)],usedFields_Syn_HsTokens :: Seq Identifier,usedLocals_Syn_HsTokens :: [Identifier]} wrap_HsTokens (T_HsTokens sem) (Inh_HsTokens _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt) = (let ( _lhsOerrors,_lhsOtks,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals) =@@ -355,14 +366,14 @@ _lhsOusedAttrs :: ([(Identifier,Identifier)]) _lhsOusedFields :: (Seq Identifier) _lhsOusedLocals :: ([Identifier])- _hdOallfields :: ([(Name,Type,Bool)])- _hdOallnts :: ([Name])+ _hdOallfields :: ([(Identifier,Type,Bool)])+ _hdOallnts :: ([Identifier]) _hdOattrs :: ([(Identifier,Identifier)]) _hdOcon :: Identifier _hdOfieldnames :: ([Identifier]) _hdOnt :: Identifier- _tlOallfields :: ([(Name,Type,Bool)])- _tlOallnts :: ([Name])+ _tlOallfields :: ([(Identifier,Type,Bool)])+ _tlOallnts :: ([Identifier]) _tlOattrs :: ([(Identifier,Identifier)]) _tlOcon :: Identifier _tlOfieldnames :: ([Identifier])@@ -377,19 +388,19 @@ _tlIusedAttrs :: ([(Identifier,Identifier)]) _tlIusedFields :: (Seq Identifier) _tlIusedLocals :: ([Identifier])- -- "SemHsTokens.ag"(line 109, column 10)+ -- "SemHsTokens.ag"(line 108, column 10) _lhsOtks = _hdItok : _tlItks- -- use rule "SemHsTokens.ag"(line 42, column 37)+ -- use rule "SemHsTokens.ag"(line 41, column 37) _lhsOerrors = _hdIerrors Seq.<> _tlIerrors- -- use rule "SemHsTokens.ag"(line 84, column 40)+ -- use rule "SemHsTokens.ag"(line 83, column 40) _lhsOusedAttrs = _hdIusedAttrs ++ _tlIusedAttrs- -- use rule "SemHsTokens.ag"(line 92, column 40)+ -- use rule "SemHsTokens.ag"(line 91, column 40) _lhsOusedFields = _hdIusedFields Seq.<> _tlIusedFields- -- use rule "SemHsTokens.ag"(line 83, column 40)+ -- use rule "SemHsTokens.ag"(line 82, column 40) _lhsOusedLocals = _hdIusedLocals ++ _tlIusedLocals -- copy rule (down)@@ -446,19 +457,19 @@ _lhsOusedAttrs :: ([(Identifier,Identifier)]) _lhsOusedFields :: (Seq Identifier) _lhsOusedLocals :: ([Identifier])- -- "SemHsTokens.ag"(line 110, column 10)+ -- "SemHsTokens.ag"(line 109, column 10) _lhsOtks = []- -- use rule "SemHsTokens.ag"(line 42, column 37)+ -- use rule "SemHsTokens.ag"(line 41, column 37) _lhsOerrors = Seq.empty- -- use rule "SemHsTokens.ag"(line 84, column 40)+ -- use rule "SemHsTokens.ag"(line 83, column 40) _lhsOusedAttrs = []- -- use rule "SemHsTokens.ag"(line 92, column 40)+ -- use rule "SemHsTokens.ag"(line 91, column 40) _lhsOusedFields = Seq.empty- -- use rule "SemHsTokens.ag"(line 83, column 40)+ -- use rule "SemHsTokens.ag"(line 82, column 40) _lhsOusedLocals = [] in ( _lhsOerrors,_lhsOtks,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))))@@ -466,8 +477,8 @@ {- visit 0: inherited attributes:- allfields : [(Name,Type,Bool)]- allnts : [Name]+ allfields : [(Identifier,Type,Bool)]+ allnts : [Identifier] attrs : [(Identifier,Identifier)] con : Identifier nt : Identifier@@ -487,13 +498,13 @@ sem_HsTokensRoot (HsTokensRoot _tokens) = (sem_HsTokensRoot_HsTokensRoot (sem_HsTokens _tokens)) -- semantic domain-newtype T_HsTokensRoot = T_HsTokensRoot (([(Name,Type,Bool)]) ->- ([Name]) ->+newtype T_HsTokensRoot = T_HsTokensRoot (([(Identifier,Type,Bool)]) ->+ ([Identifier]) -> ([(Identifier,Identifier)]) -> Identifier -> Identifier -> ( (Seq Error),([String]),([(Identifier,Identifier)]),([Identifier]),([Identifier])))-data Inh_HsTokensRoot = Inh_HsTokensRoot {allfields_Inh_HsTokensRoot :: [(Name,Type,Bool)],allnts_Inh_HsTokensRoot :: [Name],attrs_Inh_HsTokensRoot :: [(Identifier,Identifier)],con_Inh_HsTokensRoot :: Identifier,nt_Inh_HsTokensRoot :: Identifier}+data Inh_HsTokensRoot = Inh_HsTokensRoot {allfields_Inh_HsTokensRoot :: [(Identifier,Type,Bool)],allnts_Inh_HsTokensRoot :: [Identifier],attrs_Inh_HsTokensRoot :: [(Identifier,Identifier)],con_Inh_HsTokensRoot :: Identifier,nt_Inh_HsTokensRoot :: Identifier} data Syn_HsTokensRoot = Syn_HsTokensRoot {errors_Syn_HsTokensRoot :: Seq Error,textLines_Syn_HsTokensRoot :: [String],usedAttrs_Syn_HsTokensRoot :: [(Identifier,Identifier)],usedFields_Syn_HsTokensRoot :: [Identifier],usedLocals_Syn_HsTokensRoot :: [Identifier]} wrap_HsTokensRoot (T_HsTokensRoot sem) (Inh_HsTokensRoot _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsInt) = (let ( _lhsOerrors,_lhsOtextLines,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals) =@@ -513,8 +524,8 @@ _lhsOerrors :: (Seq Error) _lhsOusedAttrs :: ([(Identifier,Identifier)]) _lhsOusedLocals :: ([Identifier])- _tokensOallfields :: ([(Name,Type,Bool)])- _tokensOallnts :: ([Name])+ _tokensOallfields :: ([(Identifier,Type,Bool)])+ _tokensOallnts :: ([Identifier]) _tokensOattrs :: ([(Identifier,Identifier)]) _tokensOcon :: Identifier _tokensOnt :: Identifier@@ -523,13 +534,13 @@ _tokensIusedAttrs :: ([(Identifier,Identifier)]) _tokensIusedFields :: (Seq Identifier) _tokensIusedLocals :: ([Identifier])- -- "SemHsTokens.ag"(line 37, column 18)+ -- "SemHsTokens.ag"(line 36, column 18) _tokensOfieldnames = map (\(n,_,_) -> n) _lhsIallfields- -- "SemHsTokens.ag"(line 99, column 18)+ -- "SemHsTokens.ag"(line 98, column 18) _lhsOusedFields = Seq.toList _tokensIusedFields- -- "SemHsTokens.ag"(line 106, column 18)+ -- "SemHsTokens.ag"(line 105, column 18) _lhsOtextLines = showTokens _tokensItks -- use rule "SemHsTokens.ag"(line 16, column 18)
+ src-derived/TfmToVisage.hs view
@@ -0,0 +1,926 @@+-- UUAGC 0.9.5 (TfmToVisage.ag)+module TfmToVisage where++import AbstractSyntax+import VisagePatterns+import VisageSyntax++-- AbstractSyntax.ag imports+import Data.Set(Set)+import Data.Map(Map)+import Patterns (Pattern(..),Patterns)+import Expression (Expression(..))+import CommonTypes++-- Patterns.ag imports+import UU.Scanner.Position(Pos)+import CommonTypes (ConstructorIdent,Identifier)++import UU.Scanner.Position(Pos)+import HsToken++-- Maps a rule to a pair +-- Later, I expect to map to a list of rules, because we might need to unfold.+++-- Checks that a certain alias is in fact a Var in the old representation of the AG system+isVar (Alias _ _ (Underscore _) _) = True+isVar _ = False++type VisageRuleMap = [(String, VisageRule)]++splitVRules :: [VisageRule] -> VisageRuleMap+splitVRules vrs = concat (map unfoldvrs vrs)++unfoldvrs :: VisageRule -> VisageRuleMap+unfoldvrs vr@(VRule attrfields _ _ _ _) = zip (map (getName . fst) attrfields) (map (copyRule vr) attrfields)++copyRule :: VisageRule -> (Identifier,Identifier) -> VisageRule+copyRule (VRule attrfields _ pat expr owrt) (field,attr) = VRule attrfields attr pat expr owrt++getForField :: String -> VisageRuleMap -> [VisageRule]+getForField field xs = map snd (filter ((field ==) . fst) xs)++{-+ Delivers a map from fieldname to VisageRule with all references to others underscored.+ So, (lhs.x, rt.y, loc.z) = (0,1,2) becomes something like+ [("lhs", (lhs.x,_,_) = (0,1,2)++ At this point, we do not use this anymore.+ +allways :: VisageRule -> VisageRuleMap+allways vr@(VRule vrfields _ _ _ _) = zip vrfields (map (underScoreRule vr) (nub vrfields))++splitVRules :: [VisageRule] -> VisageRuleMap+splitVRules vrs = concat (map allways vrs)++underScoreRule :: VisageRule -> String -> VisageRule+underScoreRule (VRule fields pat expr owrt rule) s = VRule fields (underScore s pat) expr owrt rule++underScore :: String -> VisagePattern -> VisagePattern+underScore field (VConstr name pats) = VConstr name (map (underScore field) pats) +underScore field (VProduct pos pats) = VProduct pos (map (underScore field) pats)+underScore field vp@(VVar vfield attr) = + if (field == getName vfield) + then vp+ else (VUnderscore (getPos vfield))+-- Should I recurse into the pat of VAlias?+underScore field vp@(VAlias afield attr pat) =+ if (field == getName afield) + then vp+ else (VUnderscore (getPos afield))+underScore field vp@(VUnderscore pos) = vp+ +-}+-- Child -------------------------------------------------------+{-+ visit 0:+ inherited attribute:+ rulemap : VisageRuleMap+ synthesized attribute:+ vchild : VisageChild+ alternatives:+ alternative Child:+ child name : {Identifier}+ child tp : {Type}+ child inh : {Attributes}+ child syn : {Attributes}+ child higherOrder : {Bool}+-}+-- cata+sem_Child :: Child ->+ T_Child+sem_Child (Child _name _tp _inh _syn _higherOrder) =+ (sem_Child_Child _name _tp _inh _syn _higherOrder)+-- semantic domain+newtype T_Child = T_Child (VisageRuleMap ->+ ( VisageChild))+data Inh_Child = Inh_Child {rulemap_Inh_Child :: VisageRuleMap}+data Syn_Child = Syn_Child {vchild_Syn_Child :: VisageChild}+wrap_Child (T_Child sem) (Inh_Child _lhsIrulemap) =+ (let ( _lhsOvchild) =+ (sem _lhsIrulemap)+ in (Syn_Child _lhsOvchild))+sem_Child_Child :: Identifier ->+ Type ->+ Attributes ->+ Attributes ->+ Bool ->+ T_Child+sem_Child_Child name_ tp_ inh_ syn_ higherOrder_ =+ (T_Child (\ _lhsIrulemap ->+ (let _lhsOvchild :: VisageChild+ -- "TfmToVisage.ag"(line 111, column 11)+ _lhsOvchild =+ VChild name_ tp_ inh_ syn_ (getForField (getName name_) _lhsIrulemap)+ in ( _lhsOvchild))))+-- Children ----------------------------------------------------+{-+ visit 0:+ inherited attribute:+ rulemap : VisageRuleMap+ synthesized attribute:+ vchildren : [VisageChild]+ 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 (VisageRuleMap ->+ ( ([VisageChild])))+data Inh_Children = Inh_Children {rulemap_Inh_Children :: VisageRuleMap}+data Syn_Children = Syn_Children {vchildren_Syn_Children :: [VisageChild]}+wrap_Children (T_Children sem) (Inh_Children _lhsIrulemap) =+ (let ( _lhsOvchildren) =+ (sem _lhsIrulemap)+ in (Syn_Children _lhsOvchildren))+sem_Children_Cons :: T_Child ->+ T_Children ->+ T_Children+sem_Children_Cons (T_Child hd_) (T_Children tl_) =+ (T_Children (\ _lhsIrulemap ->+ (let _lhsOvchildren :: ([VisageChild])+ _hdOrulemap :: VisageRuleMap+ _tlOrulemap :: VisageRuleMap+ _hdIvchild :: VisageChild+ _tlIvchildren :: ([VisageChild])+ -- "TfmToVisage.ag"(line 107, column 17)+ _lhsOvchildren =+ _hdIvchild : _tlIvchildren+ -- copy rule (down)+ _hdOrulemap =+ _lhsIrulemap+ -- copy rule (down)+ _tlOrulemap =+ _lhsIrulemap+ ( _hdIvchild) =+ (hd_ _hdOrulemap)+ ( _tlIvchildren) =+ (tl_ _tlOrulemap)+ in ( _lhsOvchildren))))+sem_Children_Nil :: T_Children+sem_Children_Nil =+ (T_Children (\ _lhsIrulemap ->+ (let _lhsOvchildren :: ([VisageChild])+ -- "TfmToVisage.ag"(line 108, column 17)+ _lhsOvchildren =+ []+ in ( _lhsOvchildren))))+-- Expression --------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ self : SELF+ alternatives:+ alternative Expression:+ child pos : {Pos}+ child tks : {[HsToken]}+ visit 0:+ local self : _+-}+-- cata+sem_Expression :: Expression ->+ T_Expression+sem_Expression (Expression _pos _tks) =+ (sem_Expression_Expression _pos _tks)+-- semantic domain+newtype T_Expression = T_Expression (( Expression))+data Inh_Expression = Inh_Expression {}+data Syn_Expression = Syn_Expression {self_Syn_Expression :: Expression}+wrap_Expression (T_Expression sem) (Inh_Expression ) =+ (let ( _lhsOself) =+ (sem )+ in (Syn_Expression _lhsOself))+sem_Expression_Expression :: Pos ->+ ([HsToken]) ->+ T_Expression+sem_Expression_Expression pos_ tks_ =+ (T_Expression (let _lhsOself :: Expression+ -- self rule+ _self =+ Expression pos_ tks_+ -- self rule+ _lhsOself =+ _self+ in ( _lhsOself)))+-- Grammar -----------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ visage : VisageGrammar+ 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}+-}+-- cata+sem_Grammar :: Grammar ->+ T_Grammar+sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap) =+ (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts) _pragmas _manualAttrOrderMap _paramMap _contextMap)+-- semantic domain+newtype T_Grammar = T_Grammar (( VisageGrammar))+data Inh_Grammar = Inh_Grammar {}+data Syn_Grammar = Syn_Grammar {visage_Syn_Grammar :: VisageGrammar}+wrap_Grammar (T_Grammar sem) (Inh_Grammar ) =+ (let ( _lhsOvisage) =+ (sem )+ in (Syn_Grammar _lhsOvisage))+sem_Grammar_Grammar :: TypeSyns ->+ UseMap ->+ Derivings ->+ (Set NontermIdent) ->+ T_Nonterminals ->+ PragmaMap ->+ AttrOrderMap ->+ ParamMap ->+ ContextMap ->+ T_Grammar+sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ =+ (T_Grammar (let _lhsOvisage :: VisageGrammar+ _nontsIvnonts :: ([VisageNonterminal])+ -- "TfmToVisage.ag"(line 86, column 17)+ _lhsOvisage =+ VGrammar _nontsIvnonts+ ( _nontsIvnonts) =+ (nonts_ )+ in ( _lhsOvisage)))+-- Nonterminal -------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ vnont : VisageNonterminal+ 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 (( VisageNonterminal))+data Inh_Nonterminal = Inh_Nonterminal {}+data Syn_Nonterminal = Syn_Nonterminal {vnont_Syn_Nonterminal :: VisageNonterminal}+wrap_Nonterminal (T_Nonterminal sem) (Inh_Nonterminal ) =+ (let ( _lhsOvnont) =+ (sem )+ in (Syn_Nonterminal _lhsOvnont))+sem_Nonterminal_Nonterminal :: NontermIdent ->+ ([Identifier]) ->+ Attributes ->+ Attributes ->+ T_Productions ->+ T_Nonterminal+sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ (T_Productions prods_) =+ (T_Nonterminal (let _lhsOvnont :: VisageNonterminal+ _prodsIvprods :: ([VisageProduction])+ -- "TfmToVisage.ag"(line 93, column 18)+ _lhsOvnont =+ VNonterminal nt_ inh_ syn_ _prodsIvprods+ ( _prodsIvprods) =+ (prods_ )+ in ( _lhsOvnont)))+-- Nonterminals ------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ vnonts : [VisageNonterminal]+ 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 (( ([VisageNonterminal])))+data Inh_Nonterminals = Inh_Nonterminals {}+data Syn_Nonterminals = Syn_Nonterminals {vnonts_Syn_Nonterminals :: [VisageNonterminal]}+wrap_Nonterminals (T_Nonterminals sem) (Inh_Nonterminals ) =+ (let ( _lhsOvnonts) =+ (sem )+ in (Syn_Nonterminals _lhsOvnonts))+sem_Nonterminals_Cons :: T_Nonterminal ->+ T_Nonterminals ->+ T_Nonterminals+sem_Nonterminals_Cons (T_Nonterminal hd_) (T_Nonterminals tl_) =+ (T_Nonterminals (let _lhsOvnonts :: ([VisageNonterminal])+ _hdIvnont :: VisageNonterminal+ _tlIvnonts :: ([VisageNonterminal])+ -- "TfmToVisage.ag"(line 89, column 17)+ _lhsOvnonts =+ _hdIvnont : _tlIvnonts+ ( _hdIvnont) =+ (hd_ )+ ( _tlIvnonts) =+ (tl_ )+ in ( _lhsOvnonts)))+sem_Nonterminals_Nil :: T_Nonterminals+sem_Nonterminals_Nil =+ (T_Nonterminals (let _lhsOvnonts :: ([VisageNonterminal])+ -- "TfmToVisage.ag"(line 90, column 17)+ _lhsOvnonts =+ []+ in ( _lhsOvnonts)))+-- Pattern -----------------------------------------------------+{-+ visit 0:+ synthesized attributes:+ copy : SELF+ fieldattrs : [(Identifier,Identifier)] + self : SELF+ vpat : VisagePattern+ alternatives:+ alternative Alias:+ child field : {Identifier}+ child attr : {Identifier}+ child pat : Pattern+ child parts : Patterns+ visit 0:+ local copy : _+ local self : _+ alternative Constr:+ child name : {ConstructorIdent}+ child pats : Patterns+ visit 0:+ local copy : _+ local self : _+ alternative Irrefutable:+ child pat : Pattern+ visit 0:+ local copy : _+ local self : _+ alternative Product:+ child pos : {Pos}+ child pats : Patterns+ visit 0:+ local copy : _+ local self : _+ alternative Underscore:+ child pos : {Pos}+ visit 0:+ local copy : _+ local self : _+-}+-- 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)] ),Pattern,VisagePattern))+data Inh_Pattern = Inh_Pattern {}+data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern,fieldattrs_Syn_Pattern :: [(Identifier,Identifier)] ,self_Syn_Pattern :: Pattern,vpat_Syn_Pattern :: VisagePattern}+wrap_Pattern (T_Pattern sem) (Inh_Pattern ) =+ (let ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpat) =+ (sem )+ in (Syn_Pattern _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpat))+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 _lhsOvpat :: VisagePattern+ _lhsOfieldattrs :: ( [(Identifier,Identifier)] )+ _lhsOcopy :: Pattern+ _lhsOself :: Pattern+ _patIcopy :: Pattern+ _patIfieldattrs :: ( [(Identifier,Identifier)] )+ _patIself :: Pattern+ _patIvpat :: VisagePattern+ _partsIcopy :: Patterns+ _partsIfieldattrs :: ( [(Identifier,Identifier)] )+ _partsIself :: Patterns+ _partsIvpats :: ([VisagePattern])+ -- "TfmToVisage.ag"(line 128, column 17)+ _lhsOvpat =+ if (isVar _self)+ then VVar field_ attr_+ else VAlias field_ attr_ _patIvpat+ -- "TfmToVisage.ag"(line 137, column 17)+ _lhsOfieldattrs =+ [(field_, attr_)]+ -- self rule+ _copy =+ Alias field_ attr_ _patIcopy _partsIcopy+ -- self rule+ _self =+ Alias field_ attr_ _patIself _partsIself+ -- self rule+ _lhsOcopy =+ _copy+ -- self rule+ _lhsOself =+ _self+ ( _patIcopy,_patIfieldattrs,_patIself,_patIvpat) =+ (pat_ )+ ( _partsIcopy,_partsIfieldattrs,_partsIself,_partsIvpats) =+ (parts_ )+ in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpat)))+sem_Pattern_Constr :: ConstructorIdent ->+ T_Patterns ->+ T_Pattern+sem_Pattern_Constr name_ (T_Patterns pats_) =+ (T_Pattern (let _lhsOvpat :: VisagePattern+ _lhsOfieldattrs :: ( [(Identifier,Identifier)] )+ _lhsOcopy :: Pattern+ _lhsOself :: Pattern+ _patsIcopy :: Patterns+ _patsIfieldattrs :: ( [(Identifier,Identifier)] )+ _patsIself :: Patterns+ _patsIvpats :: ([VisagePattern])+ -- "TfmToVisage.ag"(line 126, column 17)+ _lhsOvpat =+ VConstr name_ _patsIvpats+ -- use rule "TfmToVisage.ag"(line 134, column 43)+ _lhsOfieldattrs =+ _patsIfieldattrs+ -- self rule+ _copy =+ Constr name_ _patsIcopy+ -- self rule+ _self =+ Constr name_ _patsIself+ -- self rule+ _lhsOcopy =+ _copy+ -- self rule+ _lhsOself =+ _self+ ( _patsIcopy,_patsIfieldattrs,_patsIself,_patsIvpats) =+ (pats_ )+ in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpat)))+sem_Pattern_Irrefutable :: T_Pattern ->+ T_Pattern+sem_Pattern_Irrefutable (T_Pattern pat_) =+ (T_Pattern (let _lhsOfieldattrs :: ( [(Identifier,Identifier)] )+ _lhsOcopy :: Pattern+ _lhsOself :: Pattern+ _lhsOvpat :: VisagePattern+ _patIcopy :: Pattern+ _patIfieldattrs :: ( [(Identifier,Identifier)] )+ _patIself :: Pattern+ _patIvpat :: VisagePattern+ -- use rule "TfmToVisage.ag"(line 134, column 43)+ _lhsOfieldattrs =+ _patIfieldattrs+ -- self rule+ _copy =+ Irrefutable _patIcopy+ -- self rule+ _self =+ Irrefutable _patIself+ -- self rule+ _lhsOcopy =+ _copy+ -- self rule+ _lhsOself =+ _self+ -- copy rule (up)+ _lhsOvpat =+ _patIvpat+ ( _patIcopy,_patIfieldattrs,_patIself,_patIvpat) =+ (pat_ )+ in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpat)))+sem_Pattern_Product :: Pos ->+ T_Patterns ->+ T_Pattern+sem_Pattern_Product pos_ (T_Patterns pats_) =+ (T_Pattern (let _lhsOvpat :: VisagePattern+ _lhsOfieldattrs :: ( [(Identifier,Identifier)] )+ _lhsOcopy :: Pattern+ _lhsOself :: Pattern+ _patsIcopy :: Patterns+ _patsIfieldattrs :: ( [(Identifier,Identifier)] )+ _patsIself :: Patterns+ _patsIvpats :: ([VisagePattern])+ -- "TfmToVisage.ag"(line 127, column 17)+ _lhsOvpat =+ VProduct pos_ _patsIvpats+ -- use rule "TfmToVisage.ag"(line 134, column 43)+ _lhsOfieldattrs =+ _patsIfieldattrs+ -- self rule+ _copy =+ Product pos_ _patsIcopy+ -- self rule+ _self =+ Product pos_ _patsIself+ -- self rule+ _lhsOcopy =+ _copy+ -- self rule+ _lhsOself =+ _self+ ( _patsIcopy,_patsIfieldattrs,_patsIself,_patsIvpats) =+ (pats_ )+ in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpat)))+sem_Pattern_Underscore :: Pos ->+ T_Pattern+sem_Pattern_Underscore pos_ =+ (T_Pattern (let _lhsOvpat :: VisagePattern+ _lhsOfieldattrs :: ( [(Identifier,Identifier)] )+ _lhsOcopy :: Pattern+ _lhsOself :: Pattern+ -- "TfmToVisage.ag"(line 131, column 17)+ _lhsOvpat =+ VUnderscore pos_+ -- use rule "TfmToVisage.ag"(line 134, column 43)+ _lhsOfieldattrs =+ []+ -- self rule+ _copy =+ Underscore pos_+ -- self rule+ _self =+ Underscore pos_+ -- self rule+ _lhsOcopy =+ _copy+ -- self rule+ _lhsOself =+ _self+ in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpat)))+-- Patterns ----------------------------------------------------+{-+ visit 0:+ synthesized attributes:+ copy : SELF+ fieldattrs : [(Identifier,Identifier)] + self : SELF+ vpats : [VisagePattern]+ alternatives:+ alternative Cons:+ child hd : Pattern+ child tl : Patterns+ visit 0:+ local copy : _+ local self : _+ alternative Nil:+ visit 0:+ local copy : _+ local self : _+-}+-- 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,( [(Identifier,Identifier)] ),Patterns,([VisagePattern])))+data Inh_Patterns = Inh_Patterns {}+data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns,fieldattrs_Syn_Patterns :: [(Identifier,Identifier)] ,self_Syn_Patterns :: Patterns,vpats_Syn_Patterns :: [VisagePattern]}+wrap_Patterns (T_Patterns sem) (Inh_Patterns ) =+ (let ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpats) =+ (sem )+ in (Syn_Patterns _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpats))+sem_Patterns_Cons :: T_Pattern ->+ T_Patterns ->+ T_Patterns+sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) =+ (T_Patterns (let _lhsOvpats :: ([VisagePattern])+ _lhsOfieldattrs :: ( [(Identifier,Identifier)] )+ _lhsOcopy :: Patterns+ _lhsOself :: Patterns+ _hdIcopy :: Pattern+ _hdIfieldattrs :: ( [(Identifier,Identifier)] )+ _hdIself :: Pattern+ _hdIvpat :: VisagePattern+ _tlIcopy :: Patterns+ _tlIfieldattrs :: ( [(Identifier,Identifier)] )+ _tlIself :: Patterns+ _tlIvpats :: ([VisagePattern])+ -- "TfmToVisage.ag"(line 122, column 17)+ _lhsOvpats =+ _hdIvpat : _tlIvpats+ -- use rule "TfmToVisage.ag"(line 134, column 43)+ _lhsOfieldattrs =+ _hdIfieldattrs ++ _tlIfieldattrs+ -- self rule+ _copy =+ (:) _hdIcopy _tlIcopy+ -- self rule+ _self =+ (:) _hdIself _tlIself+ -- self rule+ _lhsOcopy =+ _copy+ -- self rule+ _lhsOself =+ _self+ ( _hdIcopy,_hdIfieldattrs,_hdIself,_hdIvpat) =+ (hd_ )+ ( _tlIcopy,_tlIfieldattrs,_tlIself,_tlIvpats) =+ (tl_ )+ in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpats)))+sem_Patterns_Nil :: T_Patterns+sem_Patterns_Nil =+ (T_Patterns (let _lhsOvpats :: ([VisagePattern])+ _lhsOfieldattrs :: ( [(Identifier,Identifier)] )+ _lhsOcopy :: Patterns+ _lhsOself :: Patterns+ -- "TfmToVisage.ag"(line 123, column 17)+ _lhsOvpats =+ []+ -- use rule "TfmToVisage.ag"(line 134, column 43)+ _lhsOfieldattrs =+ []+ -- self rule+ _copy =+ []+ -- self rule+ _self =+ []+ -- self rule+ _lhsOcopy =+ _copy+ -- self rule+ _lhsOself =+ _self+ in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpats)))+-- Production --------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ vprod : VisageProduction+ alternatives:+ alternative Production:+ child con : {ConstructorIdent}+ child children : Children+ child rules : Rules+ child typeSigs : TypeSigs+ visit 0:+ local splitVRules : _+ local locrules : _+ local lhsrules : _+-}+-- 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 (( VisageProduction))+data Inh_Production = Inh_Production {}+data Syn_Production = Syn_Production {vprod_Syn_Production :: VisageProduction}+wrap_Production (T_Production sem) (Inh_Production ) =+ (let ( _lhsOvprod) =+ (sem )+ in (Syn_Production _lhsOvprod))+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 (let _lhsOvprod :: VisageProduction+ _childrenOrulemap :: VisageRuleMap+ _childrenIvchildren :: ([VisageChild])+ _rulesIvrules :: ([VisageRule])+ -- "TfmToVisage.ag"(line 100, column 17)+ _lhsOvprod =+ VProduction con_ _childrenIvchildren _lhsrules _locrules+ -- "TfmToVisage.ag"(line 101, column 17)+ _splitVRules =+ splitVRules _rulesIvrules+ -- "TfmToVisage.ag"(line 102, column 17)+ _locrules =+ getForField "loc" _splitVRules+ -- "TfmToVisage.ag"(line 103, column 17)+ _lhsrules =+ getForField "lhs" _splitVRules+ -- "TfmToVisage.ag"(line 104, column 17)+ _childrenOrulemap =+ _splitVRules+ ( _childrenIvchildren) =+ (children_ _childrenOrulemap)+ ( _rulesIvrules) =+ (rules_ )+ in ( _lhsOvprod)))+-- Productions -------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ vprods : [VisageProduction]+ 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 (( ([VisageProduction])))+data Inh_Productions = Inh_Productions {}+data Syn_Productions = Syn_Productions {vprods_Syn_Productions :: [VisageProduction]}+wrap_Productions (T_Productions sem) (Inh_Productions ) =+ (let ( _lhsOvprods) =+ (sem )+ in (Syn_Productions _lhsOvprods))+sem_Productions_Cons :: T_Production ->+ T_Productions ->+ T_Productions+sem_Productions_Cons (T_Production hd_) (T_Productions tl_) =+ (T_Productions (let _lhsOvprods :: ([VisageProduction])+ _hdIvprod :: VisageProduction+ _tlIvprods :: ([VisageProduction])+ -- "TfmToVisage.ag"(line 96, column 17)+ _lhsOvprods =+ _hdIvprod : _tlIvprods+ ( _hdIvprod) =+ (hd_ )+ ( _tlIvprods) =+ (tl_ )+ in ( _lhsOvprods)))+sem_Productions_Nil :: T_Productions+sem_Productions_Nil =+ (T_Productions (let _lhsOvprods :: ([VisageProduction])+ -- "TfmToVisage.ag"(line 97, column 17)+ _lhsOvprods =+ []+ in ( _lhsOvprods)))+-- Rule --------------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ vrule : VisageRule+ alternatives:+ alternative Rule:+ child pattern : Pattern+ child rhs : Expression+ child owrt : {Bool}+ child origin : {String}+-}+-- cata+sem_Rule :: Rule ->+ T_Rule+sem_Rule (Rule _pattern _rhs _owrt _origin) =+ (sem_Rule_Rule (sem_Pattern _pattern) (sem_Expression _rhs) _owrt _origin)+-- semantic domain+newtype T_Rule = T_Rule (( VisageRule))+data Inh_Rule = Inh_Rule {}+data Syn_Rule = Syn_Rule {vrule_Syn_Rule :: VisageRule}+wrap_Rule (T_Rule sem) (Inh_Rule ) =+ (let ( _lhsOvrule) =+ (sem )+ in (Syn_Rule _lhsOvrule))+sem_Rule_Rule :: T_Pattern ->+ T_Expression ->+ Bool ->+ String ->+ T_Rule+sem_Rule_Rule (T_Pattern pattern_) (T_Expression rhs_) owrt_ origin_ =+ (T_Rule (let _lhsOvrule :: VisageRule+ _patternIcopy :: Pattern+ _patternIfieldattrs :: ( [(Identifier,Identifier)] )+ _patternIself :: Pattern+ _patternIvpat :: VisagePattern+ _rhsIself :: Expression+ -- "TfmToVisage.ag"(line 119, column 11)+ _lhsOvrule =+ VRule _patternIfieldattrs undefined _patternIvpat _rhsIself owrt_+ ( _patternIcopy,_patternIfieldattrs,_patternIself,_patternIvpat) =+ (pattern_ )+ ( _rhsIself) =+ (rhs_ )+ in ( _lhsOvrule)))+-- Rules -------------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ vrules : [VisageRule]+ 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 (( ([VisageRule])))+data Inh_Rules = Inh_Rules {}+data Syn_Rules = Syn_Rules {vrules_Syn_Rules :: [VisageRule]}+wrap_Rules (T_Rules sem) (Inh_Rules ) =+ (let ( _lhsOvrules) =+ (sem )+ in (Syn_Rules _lhsOvrules))+sem_Rules_Cons :: T_Rule ->+ T_Rules ->+ T_Rules+sem_Rules_Cons (T_Rule hd_) (T_Rules tl_) =+ (T_Rules (let _lhsOvrules :: ([VisageRule])+ _hdIvrule :: VisageRule+ _tlIvrules :: ([VisageRule])+ -- "TfmToVisage.ag"(line 114, column 17)+ _lhsOvrules =+ _hdIvrule : _tlIvrules+ ( _hdIvrule) =+ (hd_ )+ ( _tlIvrules) =+ (tl_ )+ in ( _lhsOvrules)))+sem_Rules_Nil :: T_Rules+sem_Rules_Nil =+ (T_Rules (let _lhsOvrules :: ([VisageRule])+ -- "TfmToVisage.ag"(line 115, column 17)+ _lhsOvrules =+ []+ in ( _lhsOvrules)))+-- 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 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 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 ( )))
src-derived/Transform.hs view
@@ -2,3547 +2,3663 @@ module Transform where import Control.Monad(mplus,mzero)-import List (partition, elem)-import Data.Maybe-import qualified Data.Map as Map-import Data.Map (Map)-import Data.Set as Set (Set, member, union, toList, fromList, empty, singleton, member, unions, size, fold, intersection, difference, insert)-import UU.DData.Seq as Seq (Seq, empty, (<>), single, cons, toList, fromList)-import UU.Scanner.Position(noPos)--import ConcreteSyntax-import AbstractSyntax-import ErrorMessages-import Patterns (Patterns(..),Pattern(..))-import Expression (Expression(..))--import Options-import CommonTypes--import UU.Scanner.Position (Pos)-import Patterns (Pattern)-import Expression (Expression)-import CommonTypes---- Patterns.ag imports-import UU.Scanner.Position(Pos)-import CommonTypes (Constructor,Name)-type DefinedSets = Map Name (Set Nonterminal) -type FieldMap = [(Name, Type)] -type DataTypes = Map.Map Nonterminal (Map.Map Constructor FieldMap) -type AttrName = (Name,Name) -type RuleInfo = ([AttrName]->Pattern, Expression, [AttrName], Bool, String) -type SigInfo = (Identifier,Type) ---checkDuplicate :: (Identifier -> Identifier -> Error)- -> Identifier -> val -> Map Identifier val -> (Map Identifier val,Seq Error)-checkDuplicate dupError key val m- = case Map.lookupIndex key m of- Just ix -> let (key',_) = Map.elemAt ix m- in (m,Seq.single (dupError key key'))- Nothing -> (Map.insert key val m,Seq.empty)--checkDuplicates :: (Identifier -> Identifier -> Error)- -> [(Identifier, val)] -> Map Identifier val -> (Map Identifier val,Seq Error)-checkDuplicates dupError new m = foldErrors check m new- where check = uncurry (checkDuplicate dupError)--foldErrors f e xs = foldl g (e,Seq.empty) xs- where g ~(e,es) x = let (e',es') = f x e- in (e', es <> es')---checkForDuplicates :: (Identifier -> Identifier -> Error) -> [Identifier] -> [Error]-checkForDuplicates err [] = []-checkForDuplicates err (x:xs) = let (same,other) = List.partition (equalId x) xs- in map (err x) same ++ checkForDuplicates err other--equalId :: Identifier -> Identifier -> Bool-equalId x y = getName x == getName y---type RulesAndErrors = ([Rule], Seq Error)-type SigsAndErrors = ([TypeSig], Seq Error)-type InstsAndErrors = ([(Identifier, Type)], Seq Error)-type AttrOverwrite = Map AttrName Bool-type AccumRuleCheck = (RulesAndErrors, AttrOverwrite)-type AccumDefiCheck = (Seq Error, AttrOverwrite, [AttrName], [AttrName])--checkRules :: Map Nonterminal (Attributes, Attributes) -> Map Nonterminal (Map Constructor FieldMap) ->- Map Nonterminal (Map Constructor [Identifier]) -> Map Nonterminal (Map Constructor [SigInfo]) ->- Nonterminal -> Constructor -> [RuleInfo] -> RulesAndErrors-checkRules attributes fields allinsts allsigs nt con rs- = let fieldmap :: FieldMap- fieldmap = (_LHS,NT nt) : (_LOC,NT undefined) : (_INST, NT undefined) : (_FIRST, NT undefined) : (_LAST, NT undefined)- : Map.findWithDefault [] con (Map.findWithDefault Map.empty nt fields)- ++ mapMaybe (\instNm -> lookup instNm sigs >>= \tp -> return (instNm, tp)) (Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allinsts))- - sigs = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allsigs)-- hasAttrib f tp attr = Map.member attr (f (Map.findWithDefault (Map.empty,Map.empty) tp attributes))- - checkRule :: RuleInfo -> AccumRuleCheck -> AccumRuleCheck- checkRule (pat,exp,as,owrt,str) ((r1,e1),m1) - = let (e2,m2,u2,b2) = foldr (checkDefi owrt) (e1,m1,[],[]) as- in ( (Rule (pat u2) exp owrt str : r1, e2), m2)-- checkDefi :: Bool -> AttrName -> AccumDefiCheck -> AccumDefiCheck- checkDefi owrt fa@(field,attr) (e,m,u,bs)- = case lookup field fieldmap- of Just (NT tp) -> if field == _LOC || field == _INST || field == _FIRST || field == _LAST- || hasAttrib (if getName field==getName _LHS then snd else fst) tp attr- then case Map.lookupIndex fa m - of Just ix -> let ((_,attr2),b) = Map.elemAt ix m- in if b && not (fa `elem` bs)- then ( e, Map.insert fa owrt m, fa:u, fa:bs)- else (Seq.cons (DupRule nt con field attr2 attr) e, m, fa:u, bs)- Nothing -> ( e, Map.insert fa owrt m, u, fa:bs)- else (Seq.cons (SuperfluousRule nt con field attr) e, m, fa:u, bs)- _ -> (Seq.cons (UndefChild nt con field) e, m, fa:u, bs )-- in fst (foldr checkRule (([],Seq.empty),Map.empty) rs)--checkSigs :: Nonterminal -> Constructor -> [SigInfo] -> SigsAndErrors-checkSigs nt con sis - = let checkSig (ide,typ) (sigs,errs)- = if ide `elem` map (\(TypeSig n t)-> n) sigs- then (sigs, Seq.cons (DupSig nt con ide) errs)- -- else if not (ide `elem` locattrdefs)- -- then (sigs, Seq.cons (SupSig nt con ide) errs)- else (TypeSig ide typ:sigs, errs)- in foldr checkSig ([],Seq.empty) sis--checkInsts :: Map Nonterminal (Map Constructor [SigInfo]) -> Nonterminal -> Constructor -> [Identifier] -> InstsAndErrors-checkInsts sigMap nt con- = foldr (\inst (insts, errs) -> maybe (insts, Seq.single (MissingInstSig nt con inst) <> errs)- (\info -> (info : insts, errs)) $ findSig inst) ([], Seq.empty)- where- sigs = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt sigMap)- - findSig name- = do tp@(NT _) <- lookup name sigs- return (name, tp)--flattenDatas :: DataTypes -> Map Nonterminal (Set Nonterminal)-flattenDatas ds = Map.map flatten ds- where flatten cs = Set.fromList [ nt | (_,NT nt) <- concatMap snd (Map.toList cs)]--reachableFrom :: Map Nonterminal (Set Nonterminal) -> Set Nonterminal -> Set Nonterminal-reachableFrom table nts = reach nts- where reach nts = let nts' = Set.unions (nts : [ ns | nt <- Set.toList nts- , let ns = Map.findWithDefault Set.empty nt table ])- in if Set.size nts' > Set.size nts- then reach nts'- else nts-invert :: Map Nonterminal (Set Nonterminal) -> Map Nonterminal (Set Nonterminal)-invert m = foldr inv Map.empty (Map.toList m)- where inv (x,ns) m = fold (\n m -> Map.insertWith Set.union n (Set.singleton x) m) m ns--path :: Map Nonterminal (Set Nonterminal) -> Nonterminal -> Nonterminal -> Set Nonterminal-path table from to = let children = Map.findWithDefault Set.empty from table- forward = reachableFrom table children- backward = reachableFrom (invert table)- (Set.singleton to)- in Set.intersection forward backward--pragmaMapUnion :: PragmaMap -> PragmaMap -> PragmaMap-pragmaMapUnion = Map.unionWith (Map.unionWith Set.union)--pragmaMapSingle :: Nonterminal -> Constructor -> Set Name -> PragmaMap-pragmaMapSingle nt con nms = Map.singleton nt (Map.singleton con nms)--orderMapUnion :: AttrOrderMap -> AttrOrderMap -> AttrOrderMap-orderMapUnion = Map.unionWith (Map.unionWith Set.union)--orderMapSingle :: Nonterminal -> Constructor -> Set Dependency -> AttrOrderMap-orderMapSingle nt con deps = Map.singleton nt (Map.singleton con deps)--mergeDerivings m1 m2 = foldr (\(n,cs) m -> Map.insertWith Set.union n cs m) m2 (Map.toList m1)--merge x y = foldr f y (Map.toList x)- where f ~(k,v) m = Map.insertWith (Map.union) k v m--checkAttrs allFields nts inherited synthesized decls = foldErrors check decls nts where- check nt decls | not (nt `Map.member` allFields) = (decls,Seq.single(UndefNont nt))- | otherwise = let (inh,syn) = Map.findWithDefault (Map.empty,Map.empty) nt decls- (inh',einh) = checkDuplicates (DupInhAttr nt) inherited inh- (syn',esyn) = checkDuplicates (DupSynAttr nt) synthesized syn- in (Map.insert nt (inh',syn') decls,einh <> esyn)--addSelf name atMap = let (eInh,eSyn) = Map.findWithDefault(Map.empty,Map.empty) name atMap- in Map.insert name (eInh, Map.insert (Ident "self" noPos) (NT _SELF) eSyn)atMap--makeType :: Set Nonterminal -> Type -> Type-makeType nts tp@(NT x) | x == _SELF = tp- | Set.member x nts = tp- | otherwise = Haskell (getName x)-makeType _ tp = tp--constructGrammar :: Set Nonterminal- -> DataTypes- -> Map Nonterminal (Attributes, Attributes)- -> Map Nonterminal (Map Name (String, String, String))- -> Derivings- -> Set Nonterminal- -> Map Nonterminal (Map Constructor [Rule])- -> Map Nonterminal (Map Constructor [TypeSig])- -> Map Nonterminal (Map Constructor [(Identifier, Type)])- -> TypeSyns- -> PragmaMap- -> AttrOrderMap- -> Grammar--constructGrammar nts gram attrs uses derivings wrappers allrules tsigs allinsts tsyns pragmaMap orderMap =- let gr = [ (nt,Map.toList alts) | (nt,alts) <- Map.toList gram]- prods = map prod gr- prod (nt,alts) = let (inh,syn) = Map.findWithDefault (Map.empty,Map.empty) nt attrs- rmap = Map.findWithDefault Map.empty nt allrules- tsmap = Map.findWithDefault Map.empty nt tsigs- instsmap = Map.findWithDefault Map.empty nt allinsts- alt (con,flds) =- let rules = maybe [] id (Map.lookup con rmap)- tsigs = maybe [] id (Map.lookup con tsmap)- insts = maybe [] id (Map.lookup con instsmap)- cldrn = map (child False) flds ++ map (child True) insts- child isVirtual (nm, tp) =- let (inh,syn) = case tp of- NT nt -> Map.findWithDefault (Map.empty,Map.empty) nt attrs- _ -> (Map.empty,Map.empty)- in Child nm tp inh syn isVirtual- in Alternative con cldrn rules tsigs- in Production nt inh syn (map alt alts)- in Grammar tsyns uses derivings wrappers prods pragmaMap orderMap--mapUnionWithSetUnion = Map.unionWith Set.union-mapUnionWithPlusPlus = Map.unionWith (++)--- AG -----------------------------------------------------------{-- visit 0:- inherited attribute:- options : Options- synthesized attributes:- blocks : Blocks- errors : Seq Error- moduleDecl : Maybe (String,String,String)- output : Grammar- pragmas : Options -> Options- alternatives:- alternative AG:- child elems : Elems- visit 0:- local allFields : _- local allConstrs : _- local allRules : _- local allSigs : _- local allInsts : _- local allRulesErrs : _- local allSigsErrs : _- local allInstsErrs : _- local checkedRules : _- local checkedSigs : _- local checkedInsts : _- local errs1 : _- local errs2 : _- local errs3 : _- local errs4 : _- local errs5 : _- local errs6 : _- local allNonterminals : _- local allAttrDecls : _--}--- cata-sem_AG :: AG ->- T_AG-sem_AG (AG _elems) =- (sem_AG_AG (sem_Elems _elems))--- semantic domain-newtype T_AG = T_AG (Options ->- ( Blocks,(Seq Error),(Maybe (String,String,String)),Grammar,(Options -> Options)))-data Inh_AG = Inh_AG {options_Inh_AG :: Options}-data Syn_AG = Syn_AG {blocks_Syn_AG :: Blocks,errors_Syn_AG :: Seq Error,moduleDecl_Syn_AG :: Maybe (String,String,String),output_Syn_AG :: Grammar,pragmas_Syn_AG :: Options -> Options}-wrap_AG (T_AG sem) (Inh_AG _lhsIoptions) =- (let ( _lhsOblocks,_lhsOerrors,_lhsOmoduleDecl,_lhsOoutput,_lhsOpragmas) =- (sem _lhsIoptions)- in (Syn_AG _lhsOblocks _lhsOerrors _lhsOmoduleDecl _lhsOoutput _lhsOpragmas))-sem_AG_AG :: T_Elems ->- T_AG-sem_AG_AG (T_Elems elems_) =- (T_AG (\ _lhsIoptions ->- (let _lhsOoutput :: Grammar- _lhsOerrors :: (Seq Error)- _elemsOallConstructors :: (Map Nonterminal (Set Constructor))- _elemsOdefSets :: (Map Name (Set Nonterminal,Set Name))- _elemsOdefinedSets :: DefinedSets- _elemsOattrDecls :: (Map Nonterminal (Attributes, Attributes))- _lhsOblocks :: Blocks- _lhsOmoduleDecl :: (Maybe (String,String,String))- _lhsOpragmas :: (Options -> Options)- _elemsOallAttrDecls :: (Map Nonterminal (Attributes, Attributes))- _elemsOallFields :: DataTypes- _elemsOallNonterminals :: (Set Nonterminal)- _elemsIattrDecls :: (Map Nonterminal (Attributes, Attributes))- _elemsIattrOrderCollect :: AttrOrderMap- _elemsIblocks :: Blocks- _elemsIcollectedConstructorsMap :: (Map Nonterminal (Set Constructor))- _elemsIcollectedFields :: ([(Nonterminal, Constructor, FieldMap)])- _elemsIcollectedInsts :: ([ (Nonterminal, Constructor, [Identifier]) ])- _elemsIcollectedNames :: (Set Name)- _elemsIcollectedRules :: ([ (Nonterminal, Constructor, RuleInfo)])- _elemsIcollectedSetNames :: (Set Name)- _elemsIcollectedSigs :: ([ (Nonterminal, Constructor, SigInfo) ])- _elemsIdefSets :: (Map Name (Set Nonterminal,Set Name))- _elemsIderivings :: Derivings- _elemsIerrors :: (Seq Error)- _elemsImoduleDecl :: (Maybe (String,String,String))- _elemsIorderDepErrorsCollect :: (Seq Error)- _elemsIpragmas :: (Options -> Options)- _elemsIsemPragmasCollect :: PragmaMap- _elemsItypeSyns :: TypeSyns- _elemsIuseMap :: (Map Nonterminal (Map Name (String,String,String)))- _elemsIwrappers :: (Set Nonterminal)- -- "Transform.ag"(line 45, column 8)- _lhsOoutput =- constructGrammar _allNonterminals- _allFields- _allAttrDecls- _elemsIuseMap- _elemsIderivings- (if wrappers _lhsIoptions then _allNonterminals else _elemsIwrappers)- _checkedRules- _checkedSigs- _checkedInsts- _elemsItypeSyns- _elemsIsemPragmasCollect- _elemsIattrOrderCollect- -- "Transform.ag"(line 217, column 10)- _allFields =- let f (nt,con,fm) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con fm)- in foldr f (Map.empty) _elemsIcollectedFields- -- "Transform.ag"(line 220, column 10)- _allConstrs =- let f (nt,con,_) = Map.insertWith (++) nt [con]- in foldr f (Map.empty) _elemsIcollectedFields- -- "Transform.ag"(line 223, column 10)- _allRules =- let f (nt,con,r) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con [r])- in foldr f (Map.empty) _elemsIcollectedRules- -- "Transform.ag"(line 226, column 10)- _allSigs =- let f (nt,con,t) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con [t])- in foldr f (Map.empty) _elemsIcollectedSigs- -- "Transform.ag"(line 229, column 10)- _allInsts =- let f (nt,con,is) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con is)- in foldr f (Map.empty) _elemsIcollectedInsts- -- "Transform.ag"(line 232, column 10)- _allRulesErrs =- Map.mapWithKey (Map.mapWithKey . (checkRules _allAttrDecls _allFields _allInsts _allSigs )) _allRules- -- "Transform.ag"(line 233, column 10)- _allSigsErrs =- Map.mapWithKey (Map.mapWithKey . (checkSigs )) _allSigs- -- "Transform.ag"(line 234, column 10)- _allInstsErrs =- Map.mapWithKey (Map.mapWithKey . (checkInsts _allSigs )) _allInsts- -- "Transform.ag"(line 236, column 10)- _checkedRules =- Map.map (Map.map fst) _allRulesErrs- -- "Transform.ag"(line 237, column 10)- _checkedSigs =- Map.map (Map.map fst) _allSigsErrs- -- "Transform.ag"(line 238, column 10)- _checkedInsts =- Map.map (Map.map fst) _allInstsErrs- -- "Transform.ag"(line 240, column 10)- _errs1 =- let f = checkForDuplicates (DupSynonym)- in Seq.fromList . f . map fst $ _elemsItypeSyns- -- "Transform.ag"(line 243, column 10)- _errs2 =- let g nt (con,fm) = checkForDuplicates (DupChild nt con) (map fst fm)- f (nt,cfm) = concat . map (g nt) . Map.toList $ cfm- in Seq.fromList . concat . map f . Map.toList $ _allFields- -- "Transform.ag"(line 247, column 10)- _errs3 =- let f (nt,cons) = checkForDuplicates (DupAlt nt) cons- in Seq.empty- -- "Transform.ag"(line 251, column 10)- _errs4 =- let f m s = Map.fold ((<>) . snd) s m- in Map.fold f Seq.empty _allRulesErrs- -- "Transform.ag"(line 254, column 10)- _errs5 =- let f m s = Map.fold ((<>) . snd) s m- in Map.fold f Seq.empty _allSigsErrs- -- "Transform.ag"(line 257, column 10)- _errs6 =- let f m s = Map.fold ((<>) . snd) s m- in Map.fold f Seq.empty _allInstsErrs- -- "Transform.ag"(line 260, column 10)- _lhsOerrors =- _elemsIerrors <> _errs1 <> _errs2 <> _errs3 <> _errs4 <> _errs5 <> _errs6 <> _elemsIorderDepErrorsCollect- -- "Transform.ag"(line 343, column 10)- _allNonterminals =- _elemsIcollectedNames `Set.difference` _elemsIcollectedSetNames- -- "Transform.ag"(line 363, column 8)- _elemsOallConstructors =- _elemsIcollectedConstructorsMap- -- "Transform.ag"(line 417, column 8)- _elemsOdefSets =- Map.fromList (map (\x->(x,(Set.singleton x, Set.empty))) (Set.toList _allNonterminals ))- -- "Transform.ag"(line 418, column 8)- _elemsOdefinedSets =- Map.map fst _elemsIdefSets- -- "Transform.ag"(line 612, column 8)- _elemsOattrDecls =- Map.empty- -- "Transform.ag"(line 651, column 9)- _allAttrDecls =- if withSelf _lhsIoptions- then foldr addSelf _elemsIattrDecls (Set.toList _allNonterminals )- else _elemsIattrDecls- -- use rule "Transform.ag"(line 38, column 19)- _lhsOblocks =- _elemsIblocks- -- use rule "Transform.ag"(line 734, column 37)- _lhsOmoduleDecl =- _elemsImoduleDecl- -- use rule "Transform.ag"(line 499, column 34)- _lhsOpragmas =- _elemsIpragmas- -- copy rule (from local)- _elemsOallAttrDecls =- _allAttrDecls- -- copy rule (from local)- _elemsOallFields =- _allFields- -- copy rule (from local)- _elemsOallNonterminals =- _allNonterminals- ( _elemsIattrDecls,_elemsIattrOrderCollect,_elemsIblocks,_elemsIcollectedConstructorsMap,_elemsIcollectedFields,_elemsIcollectedInsts,_elemsIcollectedNames,_elemsIcollectedRules,_elemsIcollectedSetNames,_elemsIcollectedSigs,_elemsIdefSets,_elemsIderivings,_elemsIerrors,_elemsImoduleDecl,_elemsIorderDepErrorsCollect,_elemsIpragmas,_elemsIsemPragmasCollect,_elemsItypeSyns,_elemsIuseMap,_elemsIwrappers) =- (elems_ _elemsOallAttrDecls _elemsOallConstructors _elemsOallFields _elemsOallNonterminals _elemsOattrDecls _elemsOdefSets _elemsOdefinedSets)- in ( _lhsOblocks,_lhsOerrors,_lhsOmoduleDecl,_lhsOoutput,_lhsOpragmas))))--- Alt ----------------------------------------------------------{-- visit 0:- inherited attributes:- allConstructors : Map Nonterminal (Set Constructor)- allNonterminals : Set Nonterminal- nts : Set Nonterminal- synthesized attributes:- collectedConstructorNames : Set Constructor- collectedFields : [(Nonterminal, Constructor, FieldMap)]- alternatives:- alternative Alt:- child pos : {Pos}- child names : ConstructorSet- child fields : {Fields}--}--- cata-sem_Alt :: Alt ->- T_Alt-sem_Alt (Alt _pos _names _fields) =- (sem_Alt_Alt _pos (sem_ConstructorSet _names) _fields)--- semantic domain-newtype T_Alt = T_Alt ((Map Nonterminal (Set Constructor)) ->- (Set Nonterminal) ->- (Set Nonterminal) ->- ( (Set Constructor),([(Nonterminal, Constructor, FieldMap)])))-data Inh_Alt = Inh_Alt {allConstructors_Inh_Alt :: Map Nonterminal (Set Constructor),allNonterminals_Inh_Alt :: Set Nonterminal,nts_Inh_Alt :: Set Nonterminal}-data Syn_Alt = Syn_Alt {collectedConstructorNames_Syn_Alt :: Set Constructor,collectedFields_Syn_Alt :: [(Nonterminal, Constructor, FieldMap)]}-wrap_Alt (T_Alt sem) (Inh_Alt _lhsIallConstructors _lhsIallNonterminals _lhsInts) =- (let ( _lhsOcollectedConstructorNames,_lhsOcollectedFields) =- (sem _lhsIallConstructors _lhsIallNonterminals _lhsInts)- in (Syn_Alt _lhsOcollectedConstructorNames _lhsOcollectedFields))-sem_Alt_Alt :: Pos ->- T_ConstructorSet ->- Fields ->- T_Alt-sem_Alt_Alt pos_ (T_ConstructorSet names_) fields_ =- (T_Alt (\ _lhsIallConstructors- _lhsIallNonterminals- _lhsInts ->- (let _lhsOcollectedFields :: ([(Nonterminal, Constructor, FieldMap)])- _lhsOcollectedConstructorNames :: (Set Constructor)- _namesIcollectedConstructorNames :: (Set Constructor)- _namesIconstructors :: ((Set Constructor->Set Constructor))- _namesIerrors :: (Seq Error)- -- "Transform.ag"(line 202, column 10)- _lhsOcollectedFields =- let fieldTable =- [ (attr, makeType _lhsIallNonterminals tp)- | (attr, tp) <- fields_- ]- in [ (nt, con, fieldTable)- | nt <- Set.toList _lhsInts- , con <- Set.toList (_namesIconstructors (Map.findWithDefault Set.empty nt _lhsIallConstructors))- ]- -- use rule "Transform.ag"(line 80, column 62)- _lhsOcollectedConstructorNames =- _namesIcollectedConstructorNames- ( _namesIcollectedConstructorNames,_namesIconstructors,_namesIerrors) =- (names_ )- in ( _lhsOcollectedConstructorNames,_lhsOcollectedFields))))--- Alts ---------------------------------------------------------{-- visit 0:- inherited attributes:- allConstructors : Map Nonterminal (Set Constructor)- allNonterminals : Set Nonterminal- nts : Set Nonterminal- synthesized attributes:- collectedConstructorNames : Set Constructor- collectedFields : [(Nonterminal, Constructor, FieldMap)]- alternatives:- alternative Cons:- child hd : Alt- child tl : Alts- alternative Nil:--}--- cata-sem_Alts :: Alts ->- T_Alts-sem_Alts list =- (Prelude.foldr sem_Alts_Cons sem_Alts_Nil (Prelude.map sem_Alt list))--- semantic domain-newtype T_Alts = T_Alts ((Map Nonterminal (Set Constructor)) ->- (Set Nonterminal) ->- (Set Nonterminal) ->- ( (Set Constructor),([(Nonterminal, Constructor, FieldMap)])))-data Inh_Alts = Inh_Alts {allConstructors_Inh_Alts :: Map Nonterminal (Set Constructor),allNonterminals_Inh_Alts :: Set Nonterminal,nts_Inh_Alts :: Set Nonterminal}-data Syn_Alts = Syn_Alts {collectedConstructorNames_Syn_Alts :: Set Constructor,collectedFields_Syn_Alts :: [(Nonterminal, Constructor, FieldMap)]}-wrap_Alts (T_Alts sem) (Inh_Alts _lhsIallConstructors _lhsIallNonterminals _lhsInts) =- (let ( _lhsOcollectedConstructorNames,_lhsOcollectedFields) =- (sem _lhsIallConstructors _lhsIallNonterminals _lhsInts)- in (Syn_Alts _lhsOcollectedConstructorNames _lhsOcollectedFields))-sem_Alts_Cons :: T_Alt ->- T_Alts ->- T_Alts-sem_Alts_Cons (T_Alt hd_) (T_Alts tl_) =- (T_Alts (\ _lhsIallConstructors- _lhsIallNonterminals- _lhsInts ->- (let _lhsOcollectedConstructorNames :: (Set Constructor)- _lhsOcollectedFields :: ([(Nonterminal, Constructor, FieldMap)])- _hdOallConstructors :: (Map Nonterminal (Set Constructor))- _hdOallNonterminals :: (Set Nonterminal)- _hdOnts :: (Set Nonterminal)- _tlOallConstructors :: (Map Nonterminal (Set Constructor))- _tlOallNonterminals :: (Set Nonterminal)- _tlOnts :: (Set Nonterminal)- _hdIcollectedConstructorNames :: (Set Constructor)- _hdIcollectedFields :: ([(Nonterminal, Constructor, FieldMap)])- _tlIcollectedConstructorNames :: (Set Constructor)- _tlIcollectedFields :: ([(Nonterminal, Constructor, FieldMap)])- -- use rule "Transform.ag"(line 80, column 62)- _lhsOcollectedConstructorNames =- _hdIcollectedConstructorNames `Set.union` _tlIcollectedConstructorNames- -- use rule "Transform.ag"(line 112, column 28)- _lhsOcollectedFields =- _hdIcollectedFields ++ _tlIcollectedFields- -- copy rule (down)- _hdOallConstructors =- _lhsIallConstructors- -- copy rule (down)- _hdOallNonterminals =- _lhsIallNonterminals- -- copy rule (down)- _hdOnts =- _lhsInts- -- copy rule (down)- _tlOallConstructors =- _lhsIallConstructors- -- copy rule (down)- _tlOallNonterminals =- _lhsIallNonterminals- -- copy rule (down)- _tlOnts =- _lhsInts- ( _hdIcollectedConstructorNames,_hdIcollectedFields) =- (hd_ _hdOallConstructors _hdOallNonterminals _hdOnts)- ( _tlIcollectedConstructorNames,_tlIcollectedFields) =- (tl_ _tlOallConstructors _tlOallNonterminals _tlOnts)- in ( _lhsOcollectedConstructorNames,_lhsOcollectedFields))))-sem_Alts_Nil :: T_Alts-sem_Alts_Nil =- (T_Alts (\ _lhsIallConstructors- _lhsIallNonterminals- _lhsInts ->- (let _lhsOcollectedConstructorNames :: (Set Constructor)- _lhsOcollectedFields :: ([(Nonterminal, Constructor, FieldMap)])- -- use rule "Transform.ag"(line 80, column 62)- _lhsOcollectedConstructorNames =- Set.empty- -- use rule "Transform.ag"(line 112, column 28)- _lhsOcollectedFields =- []- in ( _lhsOcollectedConstructorNames,_lhsOcollectedFields))))--- Attrs --------------------------------------------------------{-- visit 0:- inherited attributes:- allFields : DataTypes- allNonterminals : Set Nonterminal- nts : Set Nonterminal- chained attribute:- attrDecls : Map Nonterminal (Attributes, Attributes)- synthesized attributes:- errors : Seq Error- useMap : Map Nonterminal (Map Name (String,String,String))- alternatives:- alternative Attrs:- child pos : {Pos}- child inh : {AttrNames}- child chn : {AttrNames}- child syn : {AttrNames}- visit 0:- local _tup1 : _- local attrDecls : _- local errors : _- local _tup2 : _- local inherited : _- local synthesized : _- local useMap : _--}--- cata-sem_Attrs :: Attrs ->- T_Attrs-sem_Attrs (Attrs _pos _inh _chn _syn) =- (sem_Attrs_Attrs _pos _inh _chn _syn)--- semantic domain-newtype T_Attrs = T_Attrs (DataTypes ->- (Set Nonterminal) ->- (Map Nonterminal (Attributes, Attributes)) ->- (Set Nonterminal) ->- ( (Map Nonterminal (Attributes, Attributes)),(Seq Error),(Map Nonterminal (Map Name (String,String,String)))))-data Inh_Attrs = Inh_Attrs {allFields_Inh_Attrs :: DataTypes,allNonterminals_Inh_Attrs :: Set Nonterminal,attrDecls_Inh_Attrs :: Map Nonterminal (Attributes, Attributes),nts_Inh_Attrs :: Set Nonterminal}-data Syn_Attrs = Syn_Attrs {attrDecls_Syn_Attrs :: Map Nonterminal (Attributes, Attributes),errors_Syn_Attrs :: Seq Error,useMap_Syn_Attrs :: Map Nonterminal (Map Name (String,String,String))}-wrap_Attrs (T_Attrs sem) (Inh_Attrs _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsInts) =- (let ( _lhsOattrDecls,_lhsOerrors,_lhsOuseMap) =- (sem _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsInts)- in (Syn_Attrs _lhsOattrDecls _lhsOerrors _lhsOuseMap))-sem_Attrs_Attrs :: Pos ->- AttrNames ->- AttrNames ->- AttrNames ->- T_Attrs-sem_Attrs_Attrs pos_ inh_ chn_ syn_ =- (T_Attrs (\ _lhsIallFields- _lhsIallNonterminals- _lhsIattrDecls- _lhsInts ->- (let _lhsOuseMap :: (Map Nonterminal (Map Name (String,String,String)))- _lhsOerrors :: (Seq Error)- _lhsOattrDecls :: (Map Nonterminal (Attributes, Attributes))- -- "Transform.ag"(line 620, column 15)- __tup1 =- checkAttrs _lhsIallFields (Set.toList _lhsInts) _inherited _synthesized _lhsIattrDecls- -- "Transform.ag"(line 620, column 15)- (_attrDecls,_) =- __tup1- -- "Transform.ag"(line 620, column 15)- (_,_errors) =- __tup1- -- "Transform.ag"(line 622, column 15)- __tup2 =- let splitAttrs xs = unzip [ ((n,makeType _lhsIallNonterminals t),(n,ud))- | (n,t,ud) <- xs- ]- (inh,_) = splitAttrs inh_- (chn,uses1) = splitAttrs chn_- (syn,uses2) = splitAttrs syn_- isUse (n,(e1,e2,_)) = not (null e1 || null e2)- in (inh++chn,chn++syn, Map.fromList (Prelude.filter isUse (uses1++uses2)))- -- "Transform.ag"(line 622, column 15)- (_inherited,_,_) =- __tup2- -- "Transform.ag"(line 622, column 15)- (_,_synthesized,_) =- __tup2- -- "Transform.ag"(line 622, column 15)- (_,_,_useMap) =- __tup2- -- "Transform.ag"(line 630, column 11)- _lhsOuseMap =- Map.fromList (zip (Set.toList _lhsInts) (repeat _useMap))- -- use rule "Transform.ag"(line 36, column 19)- _lhsOerrors =- _errors- -- copy rule (from local)- _lhsOattrDecls =- _attrDecls- in ( _lhsOattrDecls,_lhsOerrors,_lhsOuseMap))))--- ConstructorSet -----------------------------------------------{-- visit 0:- synthesized attributes:- collectedConstructorNames : Set Constructor- constructors : (Set Constructor->Set Constructor)- errors : Seq Error- alternatives:- alternative CAll:- alternative CDifference:- child set1 : ConstructorSet- child set2 : ConstructorSet- alternative CName:- child name : {Constructor}- alternative CUnion:- child set1 : ConstructorSet- child set2 : ConstructorSet--}--- cata-sem_ConstructorSet :: ConstructorSet ->- T_ConstructorSet-sem_ConstructorSet (CAll ) =- (sem_ConstructorSet_CAll )-sem_ConstructorSet (CDifference _set1 _set2) =- (sem_ConstructorSet_CDifference (sem_ConstructorSet _set1) (sem_ConstructorSet _set2))-sem_ConstructorSet (CName _name) =- (sem_ConstructorSet_CName _name)-sem_ConstructorSet (CUnion _set1 _set2) =- (sem_ConstructorSet_CUnion (sem_ConstructorSet _set1) (sem_ConstructorSet _set2))--- semantic domain-newtype T_ConstructorSet = T_ConstructorSet (( (Set Constructor),((Set Constructor->Set Constructor)),(Seq Error)))-data Inh_ConstructorSet = Inh_ConstructorSet {}-data Syn_ConstructorSet = Syn_ConstructorSet {collectedConstructorNames_Syn_ConstructorSet :: Set Constructor,constructors_Syn_ConstructorSet :: (Set Constructor->Set Constructor),errors_Syn_ConstructorSet :: Seq Error}-wrap_ConstructorSet (T_ConstructorSet sem) (Inh_ConstructorSet ) =- (let ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors) =- (sem )- in (Syn_ConstructorSet _lhsOcollectedConstructorNames _lhsOconstructors _lhsOerrors))-sem_ConstructorSet_CAll :: T_ConstructorSet-sem_ConstructorSet_CAll =- (T_ConstructorSet (let _lhsOconstructors :: ((Set Constructor->Set Constructor))- _lhsOcollectedConstructorNames :: (Set Constructor)- _lhsOerrors :: (Seq Error)- -- "Transform.ag"(line 484, column 17)- _lhsOconstructors =- \ds -> ds- -- use rule "Transform.ag"(line 80, column 62)- _lhsOcollectedConstructorNames =- Set.empty- -- use rule "Transform.ag"(line 36, column 19)- _lhsOerrors =- Seq.empty- in ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors)))-sem_ConstructorSet_CDifference :: T_ConstructorSet ->- T_ConstructorSet ->- T_ConstructorSet-sem_ConstructorSet_CDifference (T_ConstructorSet set1_) (T_ConstructorSet set2_) =- (T_ConstructorSet (let _lhsOconstructors :: ((Set Constructor->Set Constructor))- _lhsOcollectedConstructorNames :: (Set Constructor)- _lhsOerrors :: (Seq Error)- _set1IcollectedConstructorNames :: (Set Constructor)- _set1Iconstructors :: ((Set Constructor->Set Constructor))- _set1Ierrors :: (Seq Error)- _set2IcollectedConstructorNames :: (Set Constructor)- _set2Iconstructors :: ((Set Constructor->Set Constructor))- _set2Ierrors :: (Seq Error)- -- "Transform.ag"(line 483, column 17)- _lhsOconstructors =- \ds -> _set1Iconstructors ds `Set.difference` _set2Iconstructors ds- -- use rule "Transform.ag"(line 80, column 62)- _lhsOcollectedConstructorNames =- _set1IcollectedConstructorNames `Set.union` _set2IcollectedConstructorNames- -- use rule "Transform.ag"(line 36, column 19)- _lhsOerrors =- _set1Ierrors Seq.<> _set2Ierrors- ( _set1IcollectedConstructorNames,_set1Iconstructors,_set1Ierrors) =- (set1_ )- ( _set2IcollectedConstructorNames,_set2Iconstructors,_set2Ierrors) =- (set2_ )- in ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors)))-sem_ConstructorSet_CName :: Constructor ->- T_ConstructorSet-sem_ConstructorSet_CName name_ =- (T_ConstructorSet (let _lhsOcollectedConstructorNames :: (Set Constructor)- _lhsOconstructors :: ((Set Constructor->Set Constructor))- _lhsOerrors :: (Seq Error)- -- "Transform.ag"(line 351, column 11)- _lhsOcollectedConstructorNames =- Set.singleton name_- -- "Transform.ag"(line 481, column 17)- _lhsOconstructors =- \ds -> Set.singleton name_- -- use rule "Transform.ag"(line 36, column 19)- _lhsOerrors =- Seq.empty- in ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors)))-sem_ConstructorSet_CUnion :: T_ConstructorSet ->- T_ConstructorSet ->- T_ConstructorSet-sem_ConstructorSet_CUnion (T_ConstructorSet set1_) (T_ConstructorSet set2_) =- (T_ConstructorSet (let _lhsOconstructors :: ((Set Constructor->Set Constructor))- _lhsOcollectedConstructorNames :: (Set Constructor)- _lhsOerrors :: (Seq Error)- _set1IcollectedConstructorNames :: (Set Constructor)- _set1Iconstructors :: ((Set Constructor->Set Constructor))- _set1Ierrors :: (Seq Error)- _set2IcollectedConstructorNames :: (Set Constructor)- _set2Iconstructors :: ((Set Constructor->Set Constructor))- _set2Ierrors :: (Seq Error)- -- "Transform.ag"(line 482, column 17)- _lhsOconstructors =- \ds -> _set1Iconstructors ds `Set.union` _set2Iconstructors ds- -- use rule "Transform.ag"(line 80, column 62)- _lhsOcollectedConstructorNames =- _set1IcollectedConstructorNames `Set.union` _set2IcollectedConstructorNames- -- use rule "Transform.ag"(line 36, column 19)- _lhsOerrors =- _set1Ierrors Seq.<> _set2Ierrors- ( _set1IcollectedConstructorNames,_set1Iconstructors,_set1Ierrors) =- (set1_ )- ( _set2IcollectedConstructorNames,_set2Iconstructors,_set2Ierrors) =- (set2_ )- in ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors)))--- Elem ---------------------------------------------------------{-- visit 0:- inherited attributes:- allAttrDecls : Map Nonterminal (Attributes, Attributes)- allConstructors : Map Nonterminal (Set Constructor)- allFields : DataTypes- allNonterminals : Set Nonterminal- definedSets : DefinedSets- chained attributes:- attrDecls : Map Nonterminal (Attributes, Attributes)- defSets : Map Name (Set Nonterminal,Set Name)- synthesized attributes:- attrOrderCollect : AttrOrderMap- blocks : Blocks- collectedConstructorsMap : Map Nonterminal (Set Constructor)- collectedFields : [(Nonterminal, Constructor, FieldMap)]- collectedInsts : [ (Nonterminal, Constructor, [Identifier]) ]- collectedNames : Set Name- collectedRules : [ (Nonterminal, Constructor, RuleInfo)]- collectedSetNames : Set Name- collectedSigs : [ (Nonterminal, Constructor, SigInfo) ]- derivings : Derivings- errors : Seq Error- moduleDecl : Maybe (String,String,String)- orderDepErrorsCollect : Seq Error- pragmas : Options -> Options- semPragmasCollect : PragmaMap- typeSyns : TypeSyns- useMap : Map Nonterminal (Map Name (String,String,String))- wrappers : Set Nonterminal- alternatives:- alternative Attr:- child pos : {Pos}- child names : NontSet- child attrs : Attrs- alternative Data:- child pos : {Pos}- child names : NontSet- child attrs : Attrs- child alts : Alts- child ext : {Bool}- alternative Deriving:- child pos : {Pos}- child set : NontSet- child classes : {[Name]}- alternative Module:- child pos : {Pos}- child name : {String}- child exports : {String}- child imports : {String}- alternative Pragma:- child pos : {Pos}- child names : {[Name]}- alternative Sem:- child pos : {Pos}- child names : NontSet- child attrs : Attrs- child alts : SemAlts- alternative Set:- child pos : {Pos}- child name : {Name}- child set : NontSet- visit 0:- local _tup3 : _- local defSets2 : _- local errs : _- alternative Txt:- child pos : {Pos}- child name : {Name}- child lines : {[String]}- alternative Type:- child pos : {Pos}- child name : {Nonterminal}- child type : {ComplexType}- visit 0:- local expanded : _- local argType : _- alternative Wrapper:- child pos : {Pos}- child set : NontSet--}--- cata-sem_Elem :: Elem ->- T_Elem-sem_Elem (Attr _pos _names _attrs) =- (sem_Elem_Attr _pos (sem_NontSet _names) (sem_Attrs _attrs))-sem_Elem (Data _pos _names _attrs _alts _ext) =- (sem_Elem_Data _pos (sem_NontSet _names) (sem_Attrs _attrs) (sem_Alts _alts) _ext)-sem_Elem (Deriving _pos _set _classes) =- (sem_Elem_Deriving _pos (sem_NontSet _set) _classes)-sem_Elem (Module _pos _name _exports _imports) =- (sem_Elem_Module _pos _name _exports _imports)-sem_Elem (Pragma _pos _names) =- (sem_Elem_Pragma _pos _names)-sem_Elem (Sem _pos _names _attrs _alts) =- (sem_Elem_Sem _pos (sem_NontSet _names) (sem_Attrs _attrs) (sem_SemAlts _alts))-sem_Elem (Set _pos _name _set) =- (sem_Elem_Set _pos _name (sem_NontSet _set))-sem_Elem (Txt _pos _name _lines) =- (sem_Elem_Txt _pos _name _lines)-sem_Elem (Type _pos _name _type) =- (sem_Elem_Type _pos _name _type)-sem_Elem (Wrapper _pos _set) =- (sem_Elem_Wrapper _pos (sem_NontSet _set))--- semantic domain-newtype T_Elem = T_Elem ((Map Nonterminal (Attributes, Attributes)) ->- (Map Nonterminal (Set Constructor)) ->- DataTypes ->- (Set Nonterminal) ->- (Map Nonterminal (Attributes, Attributes)) ->- (Map Name (Set Nonterminal,Set Name)) ->- DefinedSets ->- ( (Map Nonterminal (Attributes, Attributes)),AttrOrderMap,Blocks,(Map Nonterminal (Set Constructor)),([(Nonterminal, Constructor, FieldMap)]),([ (Nonterminal, Constructor, [Identifier]) ]),(Set Name),([ (Nonterminal, Constructor, RuleInfo)]),(Set Name),([ (Nonterminal, Constructor, SigInfo) ]),(Map Name (Set Nonterminal,Set Name)),Derivings,(Seq Error),(Maybe (String,String,String)),(Seq Error),(Options -> Options),PragmaMap,TypeSyns,(Map Nonterminal (Map Name (String,String,String))),(Set Nonterminal)))-data Inh_Elem = Inh_Elem {allAttrDecls_Inh_Elem :: Map Nonterminal (Attributes, Attributes),allConstructors_Inh_Elem :: Map Nonterminal (Set Constructor),allFields_Inh_Elem :: DataTypes,allNonterminals_Inh_Elem :: Set Nonterminal,attrDecls_Inh_Elem :: Map Nonterminal (Attributes, Attributes),defSets_Inh_Elem :: Map Name (Set Nonterminal,Set Name),definedSets_Inh_Elem :: DefinedSets}-data Syn_Elem = Syn_Elem {attrDecls_Syn_Elem :: Map Nonterminal (Attributes, Attributes),attrOrderCollect_Syn_Elem :: AttrOrderMap,blocks_Syn_Elem :: Blocks,collectedConstructorsMap_Syn_Elem :: Map Nonterminal (Set Constructor),collectedFields_Syn_Elem :: [(Nonterminal, Constructor, FieldMap)],collectedInsts_Syn_Elem :: [ (Nonterminal, Constructor, [Identifier]) ],collectedNames_Syn_Elem :: Set Name,collectedRules_Syn_Elem :: [ (Nonterminal, Constructor, RuleInfo)],collectedSetNames_Syn_Elem :: Set Name,collectedSigs_Syn_Elem :: [ (Nonterminal, Constructor, SigInfo) ],defSets_Syn_Elem :: Map Name (Set Nonterminal,Set Name),derivings_Syn_Elem :: Derivings,errors_Syn_Elem :: Seq Error,moduleDecl_Syn_Elem :: Maybe (String,String,String),orderDepErrorsCollect_Syn_Elem :: Seq Error,pragmas_Syn_Elem :: Options -> Options,semPragmasCollect_Syn_Elem :: PragmaMap,typeSyns_Syn_Elem :: TypeSyns,useMap_Syn_Elem :: Map Nonterminal (Map Name (String,String,String)),wrappers_Syn_Elem :: Set Nonterminal}-wrap_Elem (T_Elem sem) (Inh_Elem _lhsIallAttrDecls _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIdefSets _lhsIdefinedSets) =- (let ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOorderDepErrorsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers) =- (sem _lhsIallAttrDecls _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIdefSets _lhsIdefinedSets)- in (Syn_Elem _lhsOattrDecls _lhsOattrOrderCollect _lhsOblocks _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOorderDepErrorsCollect _lhsOpragmas _lhsOsemPragmasCollect _lhsOtypeSyns _lhsOuseMap _lhsOwrappers))-sem_Elem_Attr :: Pos ->- T_NontSet ->- T_Attrs ->- T_Elem-sem_Elem_Attr pos_ (T_NontSet names_) (T_Attrs attrs_) =- (T_Elem (\ _lhsIallAttrDecls- _lhsIallConstructors- _lhsIallFields- _lhsIallNonterminals- _lhsIattrDecls- _lhsIdefSets- _lhsIdefinedSets ->- (let _attrsOnts :: (Set Nonterminal)- _lhsOattrOrderCollect :: AttrOrderMap- _lhsOblocks :: Blocks- _lhsOcollectedConstructorsMap :: (Map Nonterminal (Set Constructor))- _lhsOcollectedFields :: ([(Nonterminal, Constructor, FieldMap)])- _lhsOcollectedInsts :: ([ (Nonterminal, Constructor, [Identifier]) ])- _lhsOcollectedNames :: (Set Name)- _lhsOcollectedRules :: ([ (Nonterminal, Constructor, RuleInfo)])- _lhsOcollectedSetNames :: (Set Name)- _lhsOcollectedSigs :: ([ (Nonterminal, Constructor, SigInfo) ])- _lhsOderivings :: Derivings- _lhsOerrors :: (Seq Error)- _lhsOmoduleDecl :: (Maybe (String,String,String))- _lhsOorderDepErrorsCollect :: (Seq Error)- _lhsOpragmas :: (Options -> Options)- _lhsOsemPragmasCollect :: PragmaMap- _lhsOtypeSyns :: TypeSyns- _lhsOuseMap :: (Map Nonterminal (Map Name (String,String,String)))- _lhsOwrappers :: (Set Nonterminal)- _lhsOattrDecls :: (Map Nonterminal (Attributes, Attributes))- _lhsOdefSets :: (Map Name (Set Nonterminal,Set Name))- _namesOallFields :: DataTypes- _namesOallNonterminals :: (Set Nonterminal)- _namesOdefinedSets :: DefinedSets- _attrsOallFields :: DataTypes- _attrsOallNonterminals :: (Set Nonterminal)- _attrsOattrDecls :: (Map Nonterminal (Attributes, Attributes))- _namesIcollectedNames :: (Set Name)- _namesIerrors :: (Seq Error)- _namesInontSet :: (Set Nonterminal)- _attrsIattrDecls :: (Map Nonterminal (Attributes, Attributes))- _attrsIerrors :: (Seq Error)- _attrsIuseMap :: (Map Nonterminal (Map Name (String,String,String)))- -- "Transform.ag"(line 616, column 10)- _attrsOnts =- _namesInontSet- -- use rule "Transform.ag"(line 560, column 55)- _lhsOattrOrderCollect =- Map.empty- -- use rule "Transform.ag"(line 38, column 19)- _lhsOblocks =- Map.empty- -- use rule "Transform.ag"(line 81, column 48)- _lhsOcollectedConstructorsMap =- Map.empty- -- use rule "Transform.ag"(line 112, column 28)- _lhsOcollectedFields =- []- -- use rule "Transform.ag"(line 136, column 29)- _lhsOcollectedInsts =- []- -- use rule "Transform.ag"(line 73, column 50)- _lhsOcollectedNames =- _namesIcollectedNames- -- use rule "Transform.ag"(line 134, column 29)- _lhsOcollectedRules =- []- -- use rule "Transform.ag"(line 72, column 50)- _lhsOcollectedSetNames =- Set.empty- -- use rule "Transform.ag"(line 135, column 29)- _lhsOcollectedSigs =- []- -- use rule "Transform.ag"(line 593, column 33)- _lhsOderivings =- Map.empty- -- use rule "Transform.ag"(line 36, column 19)- _lhsOerrors =- _namesIerrors Seq.<> _attrsIerrors- -- use rule "Transform.ag"(line 734, column 37)- _lhsOmoduleDecl =- mzero- -- use rule "Transform.ag"(line 561, column 60)- _lhsOorderDepErrorsCollect =- Seq.empty- -- use rule "Transform.ag"(line 499, column 34)- _lhsOpragmas =- id- -- use rule "Transform.ag"(line 532, column 56)- _lhsOsemPragmasCollect =- Map.empty- -- use rule "Transform.ag"(line 378, column 32)- _lhsOtypeSyns =- []- -- use rule "Transform.ag"(line 124, column 15)- _lhsOuseMap =- _attrsIuseMap- -- use rule "Transform.ag"(line 490, column 32)- _lhsOwrappers =- Set.empty- -- copy rule (up)- _lhsOattrDecls =- _attrsIattrDecls- -- copy rule (chain)- _lhsOdefSets =- _lhsIdefSets- -- copy rule (down)- _namesOallFields =- _lhsIallFields- -- copy rule (down)- _namesOallNonterminals =- _lhsIallNonterminals- -- copy rule (down)- _namesOdefinedSets =- _lhsIdefinedSets- -- copy rule (down)- _attrsOallFields =- _lhsIallFields- -- copy rule (down)- _attrsOallNonterminals =- _lhsIallNonterminals- -- copy rule (down)- _attrsOattrDecls =- _lhsIattrDecls- ( _namesIcollectedNames,_namesIerrors,_namesInontSet) =- (names_ _namesOallFields _namesOallNonterminals _namesOdefinedSets)- ( _attrsIattrDecls,_attrsIerrors,_attrsIuseMap) =- (attrs_ _attrsOallFields _attrsOallNonterminals _attrsOattrDecls _attrsOnts)- in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOorderDepErrorsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))-sem_Elem_Data :: Pos ->- T_NontSet ->- T_Attrs ->- T_Alts ->- Bool ->- T_Elem-sem_Elem_Data pos_ (T_NontSet names_) (T_Attrs attrs_) (T_Alts alts_) ext_ =- (T_Elem (\ _lhsIallAttrDecls- _lhsIallConstructors- _lhsIallFields- _lhsIallNonterminals- _lhsIattrDecls- _lhsIdefSets- _lhsIdefinedSets ->- (let _altsOnts :: (Set Nonterminal)- _lhsOcollectedConstructorsMap :: (Map Nonterminal (Set Constructor))- _attrsOnts :: (Set Nonterminal)- _lhsOattrOrderCollect :: AttrOrderMap- _lhsOblocks :: Blocks- _lhsOcollectedFields :: ([(Nonterminal, Constructor, FieldMap)])- _lhsOcollectedInsts :: ([ (Nonterminal, Constructor, [Identifier]) ])- _lhsOcollectedNames :: (Set Name)- _lhsOcollectedRules :: ([ (Nonterminal, Constructor, RuleInfo)])- _lhsOcollectedSetNames :: (Set Name)- _lhsOcollectedSigs :: ([ (Nonterminal, Constructor, SigInfo) ])- _lhsOderivings :: Derivings- _lhsOerrors :: (Seq Error)- _lhsOmoduleDecl :: (Maybe (String,String,String))- _lhsOorderDepErrorsCollect :: (Seq Error)- _lhsOpragmas :: (Options -> Options)- _lhsOsemPragmasCollect :: PragmaMap- _lhsOtypeSyns :: TypeSyns- _lhsOuseMap :: (Map Nonterminal (Map Name (String,String,String)))- _lhsOwrappers :: (Set Nonterminal)- _lhsOattrDecls :: (Map Nonterminal (Attributes, Attributes))- _lhsOdefSets :: (Map Name (Set Nonterminal,Set Name))- _namesOallFields :: DataTypes- _namesOallNonterminals :: (Set Nonterminal)- _namesOdefinedSets :: DefinedSets- _attrsOallFields :: DataTypes- _attrsOallNonterminals :: (Set Nonterminal)- _attrsOattrDecls :: (Map Nonterminal (Attributes, Attributes))- _altsOallConstructors :: (Map Nonterminal (Set Constructor))- _altsOallNonterminals :: (Set Nonterminal)- _namesIcollectedNames :: (Set Name)- _namesIerrors :: (Seq Error)- _namesInontSet :: (Set Nonterminal)- _attrsIattrDecls :: (Map Nonterminal (Attributes, Attributes))- _attrsIerrors :: (Seq Error)- _attrsIuseMap :: (Map Nonterminal (Map Name (String,String,String)))- _altsIcollectedConstructorNames :: (Set Constructor)- _altsIcollectedFields :: ([(Nonterminal, Constructor, FieldMap)])- -- "Transform.ag"(line 149, column 10)- _altsOnts =- _namesInontSet- -- "Transform.ag"(line 357, column 11)- _lhsOcollectedConstructorsMap =- Map.fromList- [ (n, _altsIcollectedConstructorNames)- | n <- Set.toList _namesInontSet- ]- -- "Transform.ag"(line 615, column 10)- _attrsOnts =- _namesInontSet- -- use rule "Transform.ag"(line 560, column 55)- _lhsOattrOrderCollect =- Map.empty- -- use rule "Transform.ag"(line 38, column 19)- _lhsOblocks =- Map.empty- -- use rule "Transform.ag"(line 112, column 28)- _lhsOcollectedFields =- _altsIcollectedFields- -- use rule "Transform.ag"(line 136, column 29)- _lhsOcollectedInsts =- []- -- use rule "Transform.ag"(line 73, column 50)- _lhsOcollectedNames =- _namesIcollectedNames- -- use rule "Transform.ag"(line 134, column 29)- _lhsOcollectedRules =- []- -- use rule "Transform.ag"(line 72, column 50)- _lhsOcollectedSetNames =- Set.empty- -- use rule "Transform.ag"(line 135, column 29)- _lhsOcollectedSigs =- []- -- use rule "Transform.ag"(line 593, column 33)- _lhsOderivings =- Map.empty- -- use rule "Transform.ag"(line 36, column 19)- _lhsOerrors =- _namesIerrors Seq.<> _attrsIerrors- -- use rule "Transform.ag"(line 734, column 37)- _lhsOmoduleDecl =- mzero- -- use rule "Transform.ag"(line 561, column 60)- _lhsOorderDepErrorsCollect =- Seq.empty- -- use rule "Transform.ag"(line 499, column 34)- _lhsOpragmas =- id- -- use rule "Transform.ag"(line 532, column 56)- _lhsOsemPragmasCollect =- Map.empty- -- use rule "Transform.ag"(line 378, column 32)- _lhsOtypeSyns =- []- -- use rule "Transform.ag"(line 124, column 15)- _lhsOuseMap =- _attrsIuseMap- -- use rule "Transform.ag"(line 490, column 32)- _lhsOwrappers =- Set.empty- -- copy rule (up)- _lhsOattrDecls =- _attrsIattrDecls- -- copy rule (chain)- _lhsOdefSets =- _lhsIdefSets- -- copy rule (down)- _namesOallFields =- _lhsIallFields- -- copy rule (down)- _namesOallNonterminals =- _lhsIallNonterminals- -- copy rule (down)- _namesOdefinedSets =- _lhsIdefinedSets- -- copy rule (down)- _attrsOallFields =- _lhsIallFields- -- copy rule (down)- _attrsOallNonterminals =- _lhsIallNonterminals- -- copy rule (down)- _attrsOattrDecls =- _lhsIattrDecls- -- copy rule (down)- _altsOallConstructors =- _lhsIallConstructors- -- copy rule (down)- _altsOallNonterminals =- _lhsIallNonterminals- ( _namesIcollectedNames,_namesIerrors,_namesInontSet) =- (names_ _namesOallFields _namesOallNonterminals _namesOdefinedSets)- ( _attrsIattrDecls,_attrsIerrors,_attrsIuseMap) =- (attrs_ _attrsOallFields _attrsOallNonterminals _attrsOattrDecls _attrsOnts)- ( _altsIcollectedConstructorNames,_altsIcollectedFields) =- (alts_ _altsOallConstructors _altsOallNonterminals _altsOnts)- in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOorderDepErrorsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))-sem_Elem_Deriving :: Pos ->- T_NontSet ->- ([Name]) ->- T_Elem-sem_Elem_Deriving pos_ (T_NontSet set_) classes_ =- (T_Elem (\ _lhsIallAttrDecls- _lhsIallConstructors- _lhsIallFields- _lhsIallNonterminals- _lhsIattrDecls- _lhsIdefSets- _lhsIdefinedSets ->- (let _lhsOderivings :: Derivings- _lhsOattrOrderCollect :: AttrOrderMap- _lhsOblocks :: Blocks- _lhsOcollectedConstructorsMap :: (Map Nonterminal (Set Constructor))- _lhsOcollectedFields :: ([(Nonterminal, Constructor, FieldMap)])- _lhsOcollectedInsts :: ([ (Nonterminal, Constructor, [Identifier]) ])- _lhsOcollectedNames :: (Set Name)- _lhsOcollectedRules :: ([ (Nonterminal, Constructor, RuleInfo)])- _lhsOcollectedSetNames :: (Set Name)- _lhsOcollectedSigs :: ([ (Nonterminal, Constructor, SigInfo) ])- _lhsOerrors :: (Seq Error)- _lhsOmoduleDecl :: (Maybe (String,String,String))- _lhsOorderDepErrorsCollect :: (Seq Error)- _lhsOpragmas :: (Options -> Options)- _lhsOsemPragmasCollect :: PragmaMap- _lhsOtypeSyns :: TypeSyns- _lhsOuseMap :: (Map Nonterminal (Map Name (String,String,String)))- _lhsOwrappers :: (Set Nonterminal)- _lhsOattrDecls :: (Map Nonterminal (Attributes, Attributes))- _lhsOdefSets :: (Map Name (Set Nonterminal,Set Name))- _setOallFields :: DataTypes- _setOallNonterminals :: (Set Nonterminal)- _setOdefinedSets :: DefinedSets- _setIcollectedNames :: (Set Name)- _setIerrors :: (Seq Error)- _setInontSet :: (Set Nonterminal)- -- "Transform.ag"(line 600, column 14)- _lhsOderivings =- Map.fromList [(nt,Set.fromList classes_) | nt <- Set.toList _setInontSet]- -- use rule "Transform.ag"(line 560, column 55)- _lhsOattrOrderCollect =- Map.empty- -- use rule "Transform.ag"(line 38, column 19)- _lhsOblocks =- Map.empty- -- use rule "Transform.ag"(line 81, column 48)- _lhsOcollectedConstructorsMap =- Map.empty- -- use rule "Transform.ag"(line 112, column 28)- _lhsOcollectedFields =- []- -- use rule "Transform.ag"(line 136, column 29)- _lhsOcollectedInsts =- []- -- use rule "Transform.ag"(line 73, column 50)- _lhsOcollectedNames =- _setIcollectedNames- -- use rule "Transform.ag"(line 134, column 29)- _lhsOcollectedRules =- []- -- use rule "Transform.ag"(line 72, column 50)- _lhsOcollectedSetNames =- Set.empty- -- use rule "Transform.ag"(line 135, column 29)- _lhsOcollectedSigs =- []- -- use rule "Transform.ag"(line 36, column 19)- _lhsOerrors =- _setIerrors- -- use rule "Transform.ag"(line 734, column 37)- _lhsOmoduleDecl =- mzero- -- use rule "Transform.ag"(line 561, column 60)- _lhsOorderDepErrorsCollect =- Seq.empty- -- use rule "Transform.ag"(line 499, column 34)- _lhsOpragmas =- id- -- use rule "Transform.ag"(line 532, column 56)- _lhsOsemPragmasCollect =- Map.empty- -- use rule "Transform.ag"(line 378, column 32)- _lhsOtypeSyns =- []- -- use rule "Transform.ag"(line 124, column 15)- _lhsOuseMap =- Map.empty- -- use rule "Transform.ag"(line 490, column 32)- _lhsOwrappers =- Set.empty- -- copy rule (chain)- _lhsOattrDecls =- _lhsIattrDecls- -- copy rule (chain)- _lhsOdefSets =- _lhsIdefSets- -- copy rule (down)- _setOallFields =- _lhsIallFields- -- copy rule (down)- _setOallNonterminals =- _lhsIallNonterminals- -- copy rule (down)- _setOdefinedSets =- _lhsIdefinedSets- ( _setIcollectedNames,_setIerrors,_setInontSet) =- (set_ _setOallFields _setOallNonterminals _setOdefinedSets)- in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOorderDepErrorsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))-sem_Elem_Module :: Pos ->- String ->- String ->- String ->- T_Elem-sem_Elem_Module pos_ name_ exports_ imports_ =- (T_Elem (\ _lhsIallAttrDecls- _lhsIallConstructors- _lhsIallFields- _lhsIallNonterminals- _lhsIattrDecls- _lhsIdefSets- _lhsIdefinedSets ->- (let _lhsOmoduleDecl :: (Maybe (String,String,String))- _lhsOattrOrderCollect :: AttrOrderMap- _lhsOblocks :: Blocks- _lhsOcollectedConstructorsMap :: (Map Nonterminal (Set Constructor))- _lhsOcollectedFields :: ([(Nonterminal, Constructor, FieldMap)])- _lhsOcollectedInsts :: ([ (Nonterminal, Constructor, [Identifier]) ])- _lhsOcollectedNames :: (Set Name)- _lhsOcollectedRules :: ([ (Nonterminal, Constructor, RuleInfo)])- _lhsOcollectedSetNames :: (Set Name)- _lhsOcollectedSigs :: ([ (Nonterminal, Constructor, SigInfo) ])- _lhsOderivings :: Derivings- _lhsOerrors :: (Seq Error)- _lhsOorderDepErrorsCollect :: (Seq Error)- _lhsOpragmas :: (Options -> Options)- _lhsOsemPragmasCollect :: PragmaMap- _lhsOtypeSyns :: TypeSyns- _lhsOuseMap :: (Map Nonterminal (Map Name (String,String,String)))- _lhsOwrappers :: (Set Nonterminal)- _lhsOattrDecls :: (Map Nonterminal (Attributes, Attributes))- _lhsOdefSets :: (Map Name (Set Nonterminal,Set Name))- -- "Transform.ag"(line 738, column 7)- _lhsOmoduleDecl =- Just (name_, exports_, imports_)- -- use rule "Transform.ag"(line 560, column 55)- _lhsOattrOrderCollect =- Map.empty- -- use rule "Transform.ag"(line 38, column 19)- _lhsOblocks =- Map.empty- -- use rule "Transform.ag"(line 81, column 48)- _lhsOcollectedConstructorsMap =- Map.empty- -- use rule "Transform.ag"(line 112, column 28)- _lhsOcollectedFields =- []- -- use rule "Transform.ag"(line 136, column 29)- _lhsOcollectedInsts =- []- -- use rule "Transform.ag"(line 73, column 50)- _lhsOcollectedNames =- Set.empty- -- use rule "Transform.ag"(line 134, column 29)- _lhsOcollectedRules =- []- -- use rule "Transform.ag"(line 72, column 50)- _lhsOcollectedSetNames =- Set.empty- -- use rule "Transform.ag"(line 135, column 29)- _lhsOcollectedSigs =- []- -- use rule "Transform.ag"(line 593, column 33)- _lhsOderivings =- Map.empty- -- use rule "Transform.ag"(line 36, column 19)- _lhsOerrors =- Seq.empty- -- use rule "Transform.ag"(line 561, column 60)- _lhsOorderDepErrorsCollect =- Seq.empty- -- use rule "Transform.ag"(line 499, column 34)- _lhsOpragmas =- id- -- use rule "Transform.ag"(line 532, column 56)- _lhsOsemPragmasCollect =- Map.empty- -- use rule "Transform.ag"(line 378, column 32)- _lhsOtypeSyns =- []- -- use rule "Transform.ag"(line 124, column 15)- _lhsOuseMap =- Map.empty- -- use rule "Transform.ag"(line 490, column 32)- _lhsOwrappers =- Set.empty- -- copy rule (chain)- _lhsOattrDecls =- _lhsIattrDecls- -- copy rule (chain)- _lhsOdefSets =- _lhsIdefSets- in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOorderDepErrorsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))-sem_Elem_Pragma :: Pos ->- ([Name]) ->- T_Elem-sem_Elem_Pragma pos_ names_ =- (T_Elem (\ _lhsIallAttrDecls- _lhsIallConstructors- _lhsIallFields- _lhsIallNonterminals- _lhsIattrDecls- _lhsIdefSets- _lhsIdefinedSets ->- (let _lhsOpragmas :: (Options -> Options)- _lhsOattrOrderCollect :: AttrOrderMap- _lhsOblocks :: Blocks- _lhsOcollectedConstructorsMap :: (Map Nonterminal (Set Constructor))- _lhsOcollectedFields :: ([(Nonterminal, Constructor, FieldMap)])- _lhsOcollectedInsts :: ([ (Nonterminal, Constructor, [Identifier]) ])- _lhsOcollectedNames :: (Set Name)- _lhsOcollectedRules :: ([ (Nonterminal, Constructor, RuleInfo)])- _lhsOcollectedSetNames :: (Set Name)- _lhsOcollectedSigs :: ([ (Nonterminal, Constructor, SigInfo) ])- _lhsOderivings :: Derivings- _lhsOerrors :: (Seq Error)- _lhsOmoduleDecl :: (Maybe (String,String,String))- _lhsOorderDepErrorsCollect :: (Seq Error)- _lhsOsemPragmasCollect :: PragmaMap- _lhsOtypeSyns :: TypeSyns- _lhsOuseMap :: (Map Nonterminal (Map Name (String,String,String)))- _lhsOwrappers :: (Set Nonterminal)- _lhsOattrDecls :: (Map Nonterminal (Attributes, Attributes))- _lhsOdefSets :: (Map Name (Set Nonterminal,Set Name))- -- "Transform.ag"(line 502, column 13)- _lhsOpragmas =- let mk n o = case getName n of- "nocycle" -> o { withCycle = False }- "cycle" -> o { withCycle = True }- "nostrictdata" -> o { strictData = False }- "strictdata" -> o { strictData = True }- "nostrictcase" -> o { strictCases = False }- "strictcase" -> o { strictCases = True }- "strictercase" -> o { strictCases = True, stricterCases = True }- "nostrictwrap" -> o { strictWrap = False }- "strictwrap" -> o { strictWrap = True }- "novisit" -> o { visit = False }- "visit" -> o { visit = True }- "nocase" -> o { cases = False }- "case" -> o { cases = True }- "noseq" -> o { withSeq = False }- "seq" -> o { withSeq = True }- "nounbox" -> o { unbox = False }- "unbox" -> o { unbox = True }- "bangpats" -> o { bangpats = True }- "nooptimize" -> o { cases = False , visit = False }- "optimize" -> o { cases = True , visit = True }- "strictsem" -> o { strictSems = True }- "gentraces" -> o { genTraces = True }- "splitsems" -> o { splitSems = True }- "gencostcentres" -> o { genCostCentres = True }- "sepsemmods" -> o { sepSemMods = True }- "genlinepragmas" -> o { genLinePragmas = True }- _ -> o- in \o -> foldr mk o names_- -- use rule "Transform.ag"(line 560, column 55)- _lhsOattrOrderCollect =- Map.empty- -- use rule "Transform.ag"(line 38, column 19)- _lhsOblocks =- Map.empty- -- use rule "Transform.ag"(line 81, column 48)- _lhsOcollectedConstructorsMap =- Map.empty- -- use rule "Transform.ag"(line 112, column 28)- _lhsOcollectedFields =- []- -- use rule "Transform.ag"(line 136, column 29)- _lhsOcollectedInsts =- []- -- use rule "Transform.ag"(line 73, column 50)- _lhsOcollectedNames =- Set.empty- -- use rule "Transform.ag"(line 134, column 29)- _lhsOcollectedRules =- []- -- use rule "Transform.ag"(line 72, column 50)- _lhsOcollectedSetNames =- Set.empty- -- use rule "Transform.ag"(line 135, column 29)- _lhsOcollectedSigs =- []- -- use rule "Transform.ag"(line 593, column 33)- _lhsOderivings =- Map.empty- -- use rule "Transform.ag"(line 36, column 19)- _lhsOerrors =- Seq.empty- -- use rule "Transform.ag"(line 734, column 37)- _lhsOmoduleDecl =- mzero- -- use rule "Transform.ag"(line 561, column 60)- _lhsOorderDepErrorsCollect =- Seq.empty- -- use rule "Transform.ag"(line 532, column 56)- _lhsOsemPragmasCollect =- Map.empty- -- use rule "Transform.ag"(line 378, column 32)- _lhsOtypeSyns =- []- -- use rule "Transform.ag"(line 124, column 15)- _lhsOuseMap =- Map.empty- -- use rule "Transform.ag"(line 490, column 32)- _lhsOwrappers =- Set.empty- -- copy rule (chain)- _lhsOattrDecls =- _lhsIattrDecls- -- copy rule (chain)- _lhsOdefSets =- _lhsIdefSets- in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOorderDepErrorsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))-sem_Elem_Sem :: Pos ->- T_NontSet ->- T_Attrs ->- T_SemAlts ->- T_Elem-sem_Elem_Sem pos_ (T_NontSet names_) (T_Attrs attrs_) (T_SemAlts alts_) =- (T_Elem (\ _lhsIallAttrDecls- _lhsIallConstructors- _lhsIallFields- _lhsIallNonterminals- _lhsIattrDecls- _lhsIdefSets- _lhsIdefinedSets ->- (let _altsOnts :: (Set Nonterminal)- _attrsOnts :: (Set Nonterminal)- _lhsOattrOrderCollect :: AttrOrderMap- _lhsOblocks :: Blocks- _lhsOcollectedConstructorsMap :: (Map Nonterminal (Set Constructor))- _lhsOcollectedFields :: ([(Nonterminal, Constructor, FieldMap)])- _lhsOcollectedInsts :: ([ (Nonterminal, Constructor, [Identifier]) ])- _lhsOcollectedNames :: (Set Name)- _lhsOcollectedRules :: ([ (Nonterminal, Constructor, RuleInfo)])- _lhsOcollectedSetNames :: (Set Name)- _lhsOcollectedSigs :: ([ (Nonterminal, Constructor, SigInfo) ])- _lhsOderivings :: Derivings- _lhsOerrors :: (Seq Error)- _lhsOmoduleDecl :: (Maybe (String,String,String))- _lhsOorderDepErrorsCollect :: (Seq Error)- _lhsOpragmas :: (Options -> Options)- _lhsOsemPragmasCollect :: PragmaMap- _lhsOtypeSyns :: TypeSyns- _lhsOuseMap :: (Map Nonterminal (Map Name (String,String,String)))- _lhsOwrappers :: (Set Nonterminal)- _lhsOattrDecls :: (Map Nonterminal (Attributes, Attributes))- _lhsOdefSets :: (Map Name (Set Nonterminal,Set Name))- _namesOallFields :: DataTypes- _namesOallNonterminals :: (Set Nonterminal)- _namesOdefinedSets :: DefinedSets- _attrsOallFields :: DataTypes- _attrsOallNonterminals :: (Set Nonterminal)- _attrsOattrDecls :: (Map Nonterminal (Attributes, Attributes))- _altsOallAttrDecls :: (Map Nonterminal (Attributes, Attributes))- _altsOallFields :: DataTypes- _namesIcollectedNames :: (Set Name)- _namesIerrors :: (Seq Error)- _namesInontSet :: (Set Nonterminal)- _attrsIattrDecls :: (Map Nonterminal (Attributes, Attributes))- _attrsIerrors :: (Seq Error)- _attrsIuseMap :: (Map Nonterminal (Map Name (String,String,String)))- _altsIattrOrderCollect :: AttrOrderMap- _altsIcollectedInsts :: ([ (Nonterminal, Constructor, [Identifier]) ])- _altsIcollectedRules :: ([ (Nonterminal, Constructor, RuleInfo)])- _altsIcollectedSigs :: ([ (Nonterminal, Constructor, SigInfo) ])- _altsIerrors :: (Seq Error)- _altsIorderDepErrorsCollect :: (Seq Error)- _altsIsemPragmasCollect :: PragmaMap- -- "Transform.ag"(line 150, column 10)- _altsOnts =- _namesInontSet- -- "Transform.ag"(line 617, column 10)- _attrsOnts =- _namesInontSet- -- use rule "Transform.ag"(line 560, column 55)- _lhsOattrOrderCollect =- _altsIattrOrderCollect- -- use rule "Transform.ag"(line 38, column 19)- _lhsOblocks =- Map.empty- -- use rule "Transform.ag"(line 81, column 48)- _lhsOcollectedConstructorsMap =- Map.empty- -- use rule "Transform.ag"(line 112, column 28)- _lhsOcollectedFields =- []- -- use rule "Transform.ag"(line 136, column 29)- _lhsOcollectedInsts =- _altsIcollectedInsts- -- use rule "Transform.ag"(line 73, column 50)- _lhsOcollectedNames =- _namesIcollectedNames- -- use rule "Transform.ag"(line 134, column 29)- _lhsOcollectedRules =- _altsIcollectedRules- -- use rule "Transform.ag"(line 72, column 50)- _lhsOcollectedSetNames =- Set.empty- -- use rule "Transform.ag"(line 135, column 29)- _lhsOcollectedSigs =- _altsIcollectedSigs- -- use rule "Transform.ag"(line 593, column 33)- _lhsOderivings =- Map.empty- -- use rule "Transform.ag"(line 36, column 19)- _lhsOerrors =- _namesIerrors Seq.<> _attrsIerrors Seq.<> _altsIerrors- -- use rule "Transform.ag"(line 734, column 37)- _lhsOmoduleDecl =- mzero- -- use rule "Transform.ag"(line 561, column 60)- _lhsOorderDepErrorsCollect =- _altsIorderDepErrorsCollect- -- use rule "Transform.ag"(line 499, column 34)- _lhsOpragmas =- id- -- use rule "Transform.ag"(line 532, column 56)- _lhsOsemPragmasCollect =- _altsIsemPragmasCollect- -- use rule "Transform.ag"(line 378, column 32)- _lhsOtypeSyns =- []- -- use rule "Transform.ag"(line 124, column 15)- _lhsOuseMap =- _attrsIuseMap- -- use rule "Transform.ag"(line 490, column 32)- _lhsOwrappers =- Set.empty- -- copy rule (up)- _lhsOattrDecls =- _attrsIattrDecls- -- copy rule (chain)- _lhsOdefSets =- _lhsIdefSets- -- copy rule (down)- _namesOallFields =- _lhsIallFields- -- copy rule (down)- _namesOallNonterminals =- _lhsIallNonterminals- -- copy rule (down)- _namesOdefinedSets =- _lhsIdefinedSets- -- copy rule (down)- _attrsOallFields =- _lhsIallFields- -- copy rule (down)- _attrsOallNonterminals =- _lhsIallNonterminals- -- copy rule (down)- _attrsOattrDecls =- _lhsIattrDecls- -- copy rule (down)- _altsOallAttrDecls =- _lhsIallAttrDecls- -- copy rule (down)- _altsOallFields =- _lhsIallFields- ( _namesIcollectedNames,_namesIerrors,_namesInontSet) =- (names_ _namesOallFields _namesOallNonterminals _namesOdefinedSets)- ( _attrsIattrDecls,_attrsIerrors,_attrsIuseMap) =- (attrs_ _attrsOallFields _attrsOallNonterminals _attrsOattrDecls _attrsOnts)- ( _altsIattrOrderCollect,_altsIcollectedInsts,_altsIcollectedRules,_altsIcollectedSigs,_altsIerrors,_altsIorderDepErrorsCollect,_altsIsemPragmasCollect) =- (alts_ _altsOallAttrDecls _altsOallFields _altsOnts)- in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOorderDepErrorsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))-sem_Elem_Set :: Pos ->- Name ->- T_NontSet ->- T_Elem-sem_Elem_Set pos_ name_ (T_NontSet set_) =- (T_Elem (\ _lhsIallAttrDecls- _lhsIallConstructors- _lhsIallFields- _lhsIallNonterminals- _lhsIattrDecls- _lhsIdefSets- _lhsIdefinedSets ->- (let _lhsOcollectedSetNames :: (Set Name)- _lhsOdefSets :: (Map Name (Set Nonterminal,Set Name))- _lhsOerrors :: (Seq Error)- _lhsOattrOrderCollect :: AttrOrderMap- _lhsOblocks :: Blocks- _lhsOcollectedConstructorsMap :: (Map Nonterminal (Set Constructor))- _lhsOcollectedFields :: ([(Nonterminal, Constructor, FieldMap)])- _lhsOcollectedInsts :: ([ (Nonterminal, Constructor, [Identifier]) ])- _lhsOcollectedNames :: (Set Name)- _lhsOcollectedRules :: ([ (Nonterminal, Constructor, RuleInfo)])- _lhsOcollectedSigs :: ([ (Nonterminal, Constructor, SigInfo) ])- _lhsOderivings :: Derivings- _lhsOmoduleDecl :: (Maybe (String,String,String))- _lhsOorderDepErrorsCollect :: (Seq Error)- _lhsOpragmas :: (Options -> Options)- _lhsOsemPragmasCollect :: PragmaMap- _lhsOtypeSyns :: TypeSyns- _lhsOuseMap :: (Map Nonterminal (Map Name (String,String,String)))- _lhsOwrappers :: (Set Nonterminal)- _lhsOattrDecls :: (Map Nonterminal (Attributes, Attributes))- _setOallFields :: DataTypes- _setOallNonterminals :: (Set Nonterminal)- _setOdefinedSets :: DefinedSets- _setIcollectedNames :: (Set Name)- _setIerrors :: (Seq Error)- _setInontSet :: (Set Nonterminal)- -- "Transform.ag"(line 334, column 10)- _lhsOcollectedSetNames =- Set.singleton name_- -- "Transform.ag"(line 422, column 13)- __tup3 =- let allUsedNames = Set.unions [ maybe (Set.singleton n)- snd- (Map.lookup n _lhsIdefSets)- | n <- Set.toList _setIcollectedNames- ]- (nontSet,e1) | Set.member name_ allUsedNames- = (Set.empty, Seq.single(CyclicSet name_))- | otherwise = (_setInontSet, Seq.empty)- (res, e2) = checkDuplicate DupSet name_ (nontSet,Set.insert name_ allUsedNames) _lhsIdefSets- in (res, e1 Seq.<> e2)- -- "Transform.ag"(line 422, column 13)- (_defSets2,_) =- __tup3- -- "Transform.ag"(line 422, column 13)- (_,_errs) =- __tup3- -- "Transform.ag"(line 432, column 9)- _lhsOdefSets =- _defSets2- -- "Transform.ag"(line 432, column 9)- _lhsOerrors =- _errs <> _setIerrors- -- use rule "Transform.ag"(line 560, column 55)- _lhsOattrOrderCollect =- Map.empty- -- use rule "Transform.ag"(line 38, column 19)- _lhsOblocks =- Map.empty- -- use rule "Transform.ag"(line 81, column 48)- _lhsOcollectedConstructorsMap =- Map.empty- -- use rule "Transform.ag"(line 112, column 28)- _lhsOcollectedFields =- []- -- use rule "Transform.ag"(line 136, column 29)- _lhsOcollectedInsts =- []- -- use rule "Transform.ag"(line 73, column 50)- _lhsOcollectedNames =- _setIcollectedNames- -- use rule "Transform.ag"(line 134, column 29)- _lhsOcollectedRules =- []- -- use rule "Transform.ag"(line 135, column 29)- _lhsOcollectedSigs =- []- -- use rule "Transform.ag"(line 593, column 33)- _lhsOderivings =- Map.empty- -- use rule "Transform.ag"(line 734, column 37)- _lhsOmoduleDecl =- mzero- -- use rule "Transform.ag"(line 561, column 60)- _lhsOorderDepErrorsCollect =- Seq.empty- -- use rule "Transform.ag"(line 499, column 34)- _lhsOpragmas =- id- -- use rule "Transform.ag"(line 532, column 56)- _lhsOsemPragmasCollect =- Map.empty- -- use rule "Transform.ag"(line 378, column 32)- _lhsOtypeSyns =- []- -- use rule "Transform.ag"(line 124, column 15)- _lhsOuseMap =- Map.empty- -- use rule "Transform.ag"(line 490, column 32)- _lhsOwrappers =- Set.empty- -- copy rule (chain)- _lhsOattrDecls =- _lhsIattrDecls- -- copy rule (down)- _setOallFields =- _lhsIallFields- -- copy rule (down)- _setOallNonterminals =- _lhsIallNonterminals- -- copy rule (down)- _setOdefinedSets =- _lhsIdefinedSets- ( _setIcollectedNames,_setIerrors,_setInontSet) =- (set_ _setOallFields _setOallNonterminals _setOdefinedSets)- in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOorderDepErrorsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))-sem_Elem_Txt :: Pos ->- Name ->- ([String]) ->- T_Elem-sem_Elem_Txt pos_ name_ lines_ =- (T_Elem (\ _lhsIallAttrDecls- _lhsIallConstructors- _lhsIallFields- _lhsIallNonterminals- _lhsIattrDecls- _lhsIdefSets- _lhsIdefinedSets ->- (let _lhsOblocks :: Blocks- _lhsOattrOrderCollect :: AttrOrderMap- _lhsOcollectedConstructorsMap :: (Map Nonterminal (Set Constructor))- _lhsOcollectedFields :: ([(Nonterminal, Constructor, FieldMap)])- _lhsOcollectedInsts :: ([ (Nonterminal, Constructor, [Identifier]) ])- _lhsOcollectedNames :: (Set Name)- _lhsOcollectedRules :: ([ (Nonterminal, Constructor, RuleInfo)])- _lhsOcollectedSetNames :: (Set Name)- _lhsOcollectedSigs :: ([ (Nonterminal, Constructor, SigInfo) ])- _lhsOderivings :: Derivings- _lhsOerrors :: (Seq Error)- _lhsOmoduleDecl :: (Maybe (String,String,String))- _lhsOorderDepErrorsCollect :: (Seq Error)- _lhsOpragmas :: (Options -> Options)- _lhsOsemPragmasCollect :: PragmaMap- _lhsOtypeSyns :: TypeSyns- _lhsOuseMap :: (Map Nonterminal (Map Name (String,String,String)))- _lhsOwrappers :: (Set Nonterminal)- _lhsOattrDecls :: (Map Nonterminal (Attributes, Attributes))- _lhsOdefSets :: (Map Name (Set Nonterminal,Set Name))- -- "Transform.ag"(line 159, column 11)- _lhsOblocks =- Map.singleton (getName name_) [(lines_, pos_)]- -- use rule "Transform.ag"(line 560, column 55)- _lhsOattrOrderCollect =- Map.empty- -- use rule "Transform.ag"(line 81, column 48)- _lhsOcollectedConstructorsMap =- Map.empty- -- use rule "Transform.ag"(line 112, column 28)- _lhsOcollectedFields =- []- -- use rule "Transform.ag"(line 136, column 29)- _lhsOcollectedInsts =- []- -- use rule "Transform.ag"(line 73, column 50)- _lhsOcollectedNames =- Set.empty- -- use rule "Transform.ag"(line 134, column 29)- _lhsOcollectedRules =- []- -- use rule "Transform.ag"(line 72, column 50)- _lhsOcollectedSetNames =- Set.empty- -- use rule "Transform.ag"(line 135, column 29)- _lhsOcollectedSigs =- []- -- use rule "Transform.ag"(line 593, column 33)- _lhsOderivings =- Map.empty- -- use rule "Transform.ag"(line 36, column 19)- _lhsOerrors =- Seq.empty- -- use rule "Transform.ag"(line 734, column 37)- _lhsOmoduleDecl =- mzero- -- use rule "Transform.ag"(line 561, column 60)- _lhsOorderDepErrorsCollect =- Seq.empty- -- use rule "Transform.ag"(line 499, column 34)- _lhsOpragmas =- id- -- use rule "Transform.ag"(line 532, column 56)- _lhsOsemPragmasCollect =- Map.empty- -- use rule "Transform.ag"(line 378, column 32)- _lhsOtypeSyns =- []- -- use rule "Transform.ag"(line 124, column 15)- _lhsOuseMap =- Map.empty- -- use rule "Transform.ag"(line 490, column 32)- _lhsOwrappers =- Set.empty- -- copy rule (chain)- _lhsOattrDecls =- _lhsIattrDecls- -- copy rule (chain)- _lhsOdefSets =- _lhsIdefSets- in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOorderDepErrorsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))-sem_Elem_Type :: Pos ->- Nonterminal ->- ComplexType ->- T_Elem-sem_Elem_Type pos_ name_ type_ =- (T_Elem (\ _lhsIallAttrDecls- _lhsIallConstructors- _lhsIallFields- _lhsIallNonterminals- _lhsIattrDecls- _lhsIdefSets- _lhsIdefinedSets ->- (let _lhsOcollectedFields :: ([(Nonterminal, Constructor, FieldMap)])- _lhsOcollectedNames :: (Set Name)- _lhsOtypeSyns :: TypeSyns- _lhsOattrOrderCollect :: AttrOrderMap- _lhsOblocks :: Blocks- _lhsOcollectedConstructorsMap :: (Map Nonterminal (Set Constructor))- _lhsOcollectedInsts :: ([ (Nonterminal, Constructor, [Identifier]) ])- _lhsOcollectedRules :: ([ (Nonterminal, Constructor, RuleInfo)])- _lhsOcollectedSetNames :: (Set Name)- _lhsOcollectedSigs :: ([ (Nonterminal, Constructor, SigInfo) ])- _lhsOderivings :: Derivings- _lhsOerrors :: (Seq Error)- _lhsOmoduleDecl :: (Maybe (String,String,String))- _lhsOorderDepErrorsCollect :: (Seq Error)- _lhsOpragmas :: (Options -> Options)- _lhsOsemPragmasCollect :: PragmaMap- _lhsOuseMap :: (Map Nonterminal (Map Name (String,String,String)))- _lhsOwrappers :: (Set Nonterminal)- _lhsOattrDecls :: (Map Nonterminal (Attributes, Attributes))- _lhsOdefSets :: (Map Name (Set Nonterminal,Set Name))- -- "Transform.ag"(line 212, column 10)- _lhsOcollectedFields =- map (\(x,y)->(name_, x, y)) _expanded- -- "Transform.ag"(line 337, column 11)- _lhsOcollectedNames =- Set.singleton name_- -- "Transform.ag"(line 391, column 11)- _expanded =- case _argType of- List tp -> [(Ident "Cons" pos_, [(Ident "hd" pos_, tp)- ,(Ident "tl" pos_, NT name_)- ]- )- ,(Ident "Nil" pos_, [])- ]- Maybe tp -> [(Ident "Just" pos_, [(Ident "just" pos_, tp)- ]- )- ,(Ident "Nothing" pos_, [])- ]- Tuple xs -> [(Ident "Tuple" pos_, xs)]- -- "Transform.ag"(line 404, column 11)- _argType =- case type_ of- Maybe tp -> Maybe ( makeType _lhsIallNonterminals tp)- List tp -> List ( makeType _lhsIallNonterminals tp)- Tuple xs -> Tuple [(f,makeType _lhsIallNonterminals tp) | (f,tp) <- xs]- -- "Transform.ag"(line 408, column 11)- _lhsOtypeSyns =- [(name_,_argType)]- -- use rule "Transform.ag"(line 560, column 55)- _lhsOattrOrderCollect =- Map.empty- -- use rule "Transform.ag"(line 38, column 19)- _lhsOblocks =- Map.empty- -- use rule "Transform.ag"(line 81, column 48)- _lhsOcollectedConstructorsMap =- Map.empty- -- use rule "Transform.ag"(line 136, column 29)- _lhsOcollectedInsts =- []- -- use rule "Transform.ag"(line 134, column 29)- _lhsOcollectedRules =- []- -- use rule "Transform.ag"(line 72, column 50)- _lhsOcollectedSetNames =- Set.empty- -- use rule "Transform.ag"(line 135, column 29)- _lhsOcollectedSigs =- []- -- use rule "Transform.ag"(line 593, column 33)- _lhsOderivings =- Map.empty- -- use rule "Transform.ag"(line 36, column 19)- _lhsOerrors =- Seq.empty- -- use rule "Transform.ag"(line 734, column 37)- _lhsOmoduleDecl =- mzero- -- use rule "Transform.ag"(line 561, column 60)- _lhsOorderDepErrorsCollect =- Seq.empty- -- use rule "Transform.ag"(line 499, column 34)- _lhsOpragmas =- id- -- use rule "Transform.ag"(line 532, column 56)- _lhsOsemPragmasCollect =- Map.empty- -- use rule "Transform.ag"(line 124, column 15)- _lhsOuseMap =- Map.empty- -- use rule "Transform.ag"(line 490, column 32)- _lhsOwrappers =- Set.empty- -- copy rule (chain)- _lhsOattrDecls =- _lhsIattrDecls- -- copy rule (chain)- _lhsOdefSets =- _lhsIdefSets- in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOorderDepErrorsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))-sem_Elem_Wrapper :: Pos ->- T_NontSet ->- T_Elem-sem_Elem_Wrapper pos_ (T_NontSet set_) =- (T_Elem (\ _lhsIallAttrDecls- _lhsIallConstructors- _lhsIallFields- _lhsIallNonterminals- _lhsIattrDecls- _lhsIdefSets- _lhsIdefinedSets ->- (let _lhsOwrappers :: (Set Nonterminal)- _lhsOattrOrderCollect :: AttrOrderMap- _lhsOblocks :: Blocks- _lhsOcollectedConstructorsMap :: (Map Nonterminal (Set Constructor))- _lhsOcollectedFields :: ([(Nonterminal, Constructor, FieldMap)])- _lhsOcollectedInsts :: ([ (Nonterminal, Constructor, [Identifier]) ])- _lhsOcollectedNames :: (Set Name)- _lhsOcollectedRules :: ([ (Nonterminal, Constructor, RuleInfo)])- _lhsOcollectedSetNames :: (Set Name)- _lhsOcollectedSigs :: ([ (Nonterminal, Constructor, SigInfo) ])- _lhsOderivings :: Derivings- _lhsOerrors :: (Seq Error)- _lhsOmoduleDecl :: (Maybe (String,String,String))- _lhsOorderDepErrorsCollect :: (Seq Error)- _lhsOpragmas :: (Options -> Options)- _lhsOsemPragmasCollect :: PragmaMap- _lhsOtypeSyns :: TypeSyns- _lhsOuseMap :: (Map Nonterminal (Map Name (String,String,String)))- _lhsOattrDecls :: (Map Nonterminal (Attributes, Attributes))- _lhsOdefSets :: (Map Name (Set Nonterminal,Set Name))- _setOallFields :: DataTypes- _setOallNonterminals :: (Set Nonterminal)- _setOdefinedSets :: DefinedSets- _setIcollectedNames :: (Set Name)- _setIerrors :: (Seq Error)- _setInontSet :: (Set Nonterminal)- -- "Transform.ag"(line 493, column 13)- _lhsOwrappers =- _setInontSet- -- use rule "Transform.ag"(line 560, column 55)- _lhsOattrOrderCollect =- Map.empty- -- use rule "Transform.ag"(line 38, column 19)- _lhsOblocks =- Map.empty- -- use rule "Transform.ag"(line 81, column 48)- _lhsOcollectedConstructorsMap =- Map.empty- -- use rule "Transform.ag"(line 112, column 28)- _lhsOcollectedFields =- []- -- use rule "Transform.ag"(line 136, column 29)- _lhsOcollectedInsts =- []- -- use rule "Transform.ag"(line 73, column 50)- _lhsOcollectedNames =- _setIcollectedNames- -- use rule "Transform.ag"(line 134, column 29)- _lhsOcollectedRules =- []- -- use rule "Transform.ag"(line 72, column 50)- _lhsOcollectedSetNames =- Set.empty- -- use rule "Transform.ag"(line 135, column 29)- _lhsOcollectedSigs =- []- -- use rule "Transform.ag"(line 593, column 33)- _lhsOderivings =- Map.empty- -- use rule "Transform.ag"(line 36, column 19)- _lhsOerrors =- _setIerrors- -- use rule "Transform.ag"(line 734, column 37)- _lhsOmoduleDecl =- mzero- -- use rule "Transform.ag"(line 561, column 60)- _lhsOorderDepErrorsCollect =- Seq.empty- -- use rule "Transform.ag"(line 499, column 34)- _lhsOpragmas =- id- -- use rule "Transform.ag"(line 532, column 56)- _lhsOsemPragmasCollect =- Map.empty- -- use rule "Transform.ag"(line 378, column 32)- _lhsOtypeSyns =- []- -- use rule "Transform.ag"(line 124, column 15)- _lhsOuseMap =- Map.empty- -- copy rule (chain)- _lhsOattrDecls =- _lhsIattrDecls- -- copy rule (chain)- _lhsOdefSets =- _lhsIdefSets- -- copy rule (down)- _setOallFields =- _lhsIallFields- -- copy rule (down)- _setOallNonterminals =- _lhsIallNonterminals- -- copy rule (down)- _setOdefinedSets =- _lhsIdefinedSets- ( _setIcollectedNames,_setIerrors,_setInontSet) =- (set_ _setOallFields _setOallNonterminals _setOdefinedSets)- in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOorderDepErrorsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))--- Elems --------------------------------------------------------{-- visit 0:- inherited attributes:- allAttrDecls : Map Nonterminal (Attributes, Attributes)- allConstructors : Map Nonterminal (Set Constructor)- allFields : DataTypes- allNonterminals : Set Nonterminal- definedSets : DefinedSets- chained attributes:- attrDecls : Map Nonterminal (Attributes, Attributes)- defSets : Map Name (Set Nonterminal,Set Name)- synthesized attributes:- attrOrderCollect : AttrOrderMap- blocks : Blocks- collectedConstructorsMap : Map Nonterminal (Set Constructor)- collectedFields : [(Nonterminal, Constructor, FieldMap)]- collectedInsts : [ (Nonterminal, Constructor, [Identifier]) ]- collectedNames : Set Name- collectedRules : [ (Nonterminal, Constructor, RuleInfo)]- collectedSetNames : Set Name- collectedSigs : [ (Nonterminal, Constructor, SigInfo) ]- derivings : Derivings- errors : Seq Error- moduleDecl : Maybe (String,String,String)- orderDepErrorsCollect : Seq Error- pragmas : Options -> Options- semPragmasCollect : PragmaMap- typeSyns : TypeSyns- useMap : Map Nonterminal (Map Name (String,String,String))- wrappers : Set Nonterminal- alternatives:- alternative Cons:- child hd : Elem- child tl : Elems- alternative Nil:--}--- cata-sem_Elems :: Elems ->- T_Elems-sem_Elems list =- (Prelude.foldr sem_Elems_Cons sem_Elems_Nil (Prelude.map sem_Elem list))--- semantic domain-newtype T_Elems = T_Elems ((Map Nonterminal (Attributes, Attributes)) ->- (Map Nonterminal (Set Constructor)) ->- DataTypes ->- (Set Nonterminal) ->- (Map Nonterminal (Attributes, Attributes)) ->- (Map Name (Set Nonterminal,Set Name)) ->- DefinedSets ->- ( (Map Nonterminal (Attributes, Attributes)),AttrOrderMap,Blocks,(Map Nonterminal (Set Constructor)),([(Nonterminal, Constructor, FieldMap)]),([ (Nonterminal, Constructor, [Identifier]) ]),(Set Name),([ (Nonterminal, Constructor, RuleInfo)]),(Set Name),([ (Nonterminal, Constructor, SigInfo) ]),(Map Name (Set Nonterminal,Set Name)),Derivings,(Seq Error),(Maybe (String,String,String)),(Seq Error),(Options -> Options),PragmaMap,TypeSyns,(Map Nonterminal (Map Name (String,String,String))),(Set Nonterminal)))-data Inh_Elems = Inh_Elems {allAttrDecls_Inh_Elems :: Map Nonterminal (Attributes, Attributes),allConstructors_Inh_Elems :: Map Nonterminal (Set Constructor),allFields_Inh_Elems :: DataTypes,allNonterminals_Inh_Elems :: Set Nonterminal,attrDecls_Inh_Elems :: Map Nonterminal (Attributes, Attributes),defSets_Inh_Elems :: Map Name (Set Nonterminal,Set Name),definedSets_Inh_Elems :: DefinedSets}-data Syn_Elems = Syn_Elems {attrDecls_Syn_Elems :: Map Nonterminal (Attributes, Attributes),attrOrderCollect_Syn_Elems :: AttrOrderMap,blocks_Syn_Elems :: Blocks,collectedConstructorsMap_Syn_Elems :: Map Nonterminal (Set Constructor),collectedFields_Syn_Elems :: [(Nonterminal, Constructor, FieldMap)],collectedInsts_Syn_Elems :: [ (Nonterminal, Constructor, [Identifier]) ],collectedNames_Syn_Elems :: Set Name,collectedRules_Syn_Elems :: [ (Nonterminal, Constructor, RuleInfo)],collectedSetNames_Syn_Elems :: Set Name,collectedSigs_Syn_Elems :: [ (Nonterminal, Constructor, SigInfo) ],defSets_Syn_Elems :: Map Name (Set Nonterminal,Set Name),derivings_Syn_Elems :: Derivings,errors_Syn_Elems :: Seq Error,moduleDecl_Syn_Elems :: Maybe (String,String,String),orderDepErrorsCollect_Syn_Elems :: Seq Error,pragmas_Syn_Elems :: Options -> Options,semPragmasCollect_Syn_Elems :: PragmaMap,typeSyns_Syn_Elems :: TypeSyns,useMap_Syn_Elems :: Map Nonterminal (Map Name (String,String,String)),wrappers_Syn_Elems :: Set Nonterminal}-wrap_Elems (T_Elems sem) (Inh_Elems _lhsIallAttrDecls _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIdefSets _lhsIdefinedSets) =- (let ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOorderDepErrorsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers) =- (sem _lhsIallAttrDecls _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIdefSets _lhsIdefinedSets)- in (Syn_Elems _lhsOattrDecls _lhsOattrOrderCollect _lhsOblocks _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOorderDepErrorsCollect _lhsOpragmas _lhsOsemPragmasCollect _lhsOtypeSyns _lhsOuseMap _lhsOwrappers))-sem_Elems_Cons :: T_Elem ->- T_Elems ->- T_Elems-sem_Elems_Cons (T_Elem hd_) (T_Elems tl_) =- (T_Elems (\ _lhsIallAttrDecls- _lhsIallConstructors- _lhsIallFields- _lhsIallNonterminals- _lhsIattrDecls- _lhsIdefSets- _lhsIdefinedSets ->- (let _lhsOattrOrderCollect :: AttrOrderMap- _lhsOblocks :: Blocks- _lhsOcollectedConstructorsMap :: (Map Nonterminal (Set Constructor))- _lhsOcollectedFields :: ([(Nonterminal, Constructor, FieldMap)])- _lhsOcollectedInsts :: ([ (Nonterminal, Constructor, [Identifier]) ])- _lhsOcollectedNames :: (Set Name)- _lhsOcollectedRules :: ([ (Nonterminal, Constructor, RuleInfo)])- _lhsOcollectedSetNames :: (Set Name)- _lhsOcollectedSigs :: ([ (Nonterminal, Constructor, SigInfo) ])- _lhsOderivings :: Derivings- _lhsOerrors :: (Seq Error)- _lhsOmoduleDecl :: (Maybe (String,String,String))- _lhsOorderDepErrorsCollect :: (Seq Error)- _lhsOpragmas :: (Options -> Options)- _lhsOsemPragmasCollect :: PragmaMap- _lhsOtypeSyns :: TypeSyns- _lhsOuseMap :: (Map Nonterminal (Map Name (String,String,String)))- _lhsOwrappers :: (Set Nonterminal)- _lhsOattrDecls :: (Map Nonterminal (Attributes, Attributes))- _lhsOdefSets :: (Map Name (Set Nonterminal,Set Name))- _hdOallAttrDecls :: (Map Nonterminal (Attributes, Attributes))- _hdOallConstructors :: (Map Nonterminal (Set Constructor))- _hdOallFields :: DataTypes- _hdOallNonterminals :: (Set Nonterminal)- _hdOattrDecls :: (Map Nonterminal (Attributes, Attributes))- _hdOdefSets :: (Map Name (Set Nonterminal,Set Name))- _hdOdefinedSets :: DefinedSets- _tlOallAttrDecls :: (Map Nonterminal (Attributes, Attributes))- _tlOallConstructors :: (Map Nonterminal (Set Constructor))- _tlOallFields :: DataTypes- _tlOallNonterminals :: (Set Nonterminal)- _tlOattrDecls :: (Map Nonterminal (Attributes, Attributes))- _tlOdefSets :: (Map Name (Set Nonterminal,Set Name))- _tlOdefinedSets :: DefinedSets- _hdIattrDecls :: (Map Nonterminal (Attributes, Attributes))- _hdIattrOrderCollect :: AttrOrderMap- _hdIblocks :: Blocks- _hdIcollectedConstructorsMap :: (Map Nonterminal (Set Constructor))- _hdIcollectedFields :: ([(Nonterminal, Constructor, FieldMap)])- _hdIcollectedInsts :: ([ (Nonterminal, Constructor, [Identifier]) ])- _hdIcollectedNames :: (Set Name)- _hdIcollectedRules :: ([ (Nonterminal, Constructor, RuleInfo)])- _hdIcollectedSetNames :: (Set Name)- _hdIcollectedSigs :: ([ (Nonterminal, Constructor, SigInfo) ])- _hdIdefSets :: (Map Name (Set Nonterminal,Set Name))- _hdIderivings :: Derivings- _hdIerrors :: (Seq Error)- _hdImoduleDecl :: (Maybe (String,String,String))- _hdIorderDepErrorsCollect :: (Seq Error)- _hdIpragmas :: (Options -> Options)- _hdIsemPragmasCollect :: PragmaMap- _hdItypeSyns :: TypeSyns- _hdIuseMap :: (Map Nonterminal (Map Name (String,String,String)))- _hdIwrappers :: (Set Nonterminal)- _tlIattrDecls :: (Map Nonterminal (Attributes, Attributes))- _tlIattrOrderCollect :: AttrOrderMap- _tlIblocks :: Blocks- _tlIcollectedConstructorsMap :: (Map Nonterminal (Set Constructor))- _tlIcollectedFields :: ([(Nonterminal, Constructor, FieldMap)])- _tlIcollectedInsts :: ([ (Nonterminal, Constructor, [Identifier]) ])- _tlIcollectedNames :: (Set Name)- _tlIcollectedRules :: ([ (Nonterminal, Constructor, RuleInfo)])- _tlIcollectedSetNames :: (Set Name)- _tlIcollectedSigs :: ([ (Nonterminal, Constructor, SigInfo) ])- _tlIdefSets :: (Map Name (Set Nonterminal,Set Name))- _tlIderivings :: Derivings- _tlIerrors :: (Seq Error)- _tlImoduleDecl :: (Maybe (String,String,String))- _tlIorderDepErrorsCollect :: (Seq Error)- _tlIpragmas :: (Options -> Options)- _tlIsemPragmasCollect :: PragmaMap- _tlItypeSyns :: TypeSyns- _tlIuseMap :: (Map Nonterminal (Map Name (String,String,String)))- _tlIwrappers :: (Set Nonterminal)- -- use rule "Transform.ag"(line 560, column 55)- _lhsOattrOrderCollect =- _hdIattrOrderCollect `orderMapUnion` _tlIattrOrderCollect- -- use rule "Transform.ag"(line 38, column 19)- _lhsOblocks =- _hdIblocks `mapUnionWithPlusPlus` _tlIblocks- -- use rule "Transform.ag"(line 81, column 48)- _lhsOcollectedConstructorsMap =- _hdIcollectedConstructorsMap `mapUnionWithSetUnion` _tlIcollectedConstructorsMap- -- use rule "Transform.ag"(line 112, column 28)- _lhsOcollectedFields =- _hdIcollectedFields ++ _tlIcollectedFields- -- use rule "Transform.ag"(line 136, column 29)- _lhsOcollectedInsts =- _hdIcollectedInsts ++ _tlIcollectedInsts- -- use rule "Transform.ag"(line 73, column 50)- _lhsOcollectedNames =- _hdIcollectedNames `Set.union` _tlIcollectedNames- -- use rule "Transform.ag"(line 134, column 29)- _lhsOcollectedRules =- _hdIcollectedRules ++ _tlIcollectedRules- -- use rule "Transform.ag"(line 72, column 50)- _lhsOcollectedSetNames =- _hdIcollectedSetNames `Set.union` _tlIcollectedSetNames- -- use rule "Transform.ag"(line 135, column 29)- _lhsOcollectedSigs =- _hdIcollectedSigs ++ _tlIcollectedSigs- -- use rule "Transform.ag"(line 593, column 33)- _lhsOderivings =- _hdIderivings `mergeDerivings` _tlIderivings- -- use rule "Transform.ag"(line 36, column 19)- _lhsOerrors =- _hdIerrors Seq.<> _tlIerrors- -- use rule "Transform.ag"(line 734, column 37)- _lhsOmoduleDecl =- _hdImoduleDecl `mplus` _tlImoduleDecl- -- use rule "Transform.ag"(line 561, column 60)- _lhsOorderDepErrorsCollect =- _hdIorderDepErrorsCollect Seq.<> _tlIorderDepErrorsCollect- -- use rule "Transform.ag"(line 499, column 34)- _lhsOpragmas =- _hdIpragmas . _tlIpragmas- -- use rule "Transform.ag"(line 532, column 56)- _lhsOsemPragmasCollect =- _hdIsemPragmasCollect `pragmaMapUnion` _tlIsemPragmasCollect- -- use rule "Transform.ag"(line 378, column 32)- _lhsOtypeSyns =- _hdItypeSyns ++ _tlItypeSyns- -- use rule "Transform.ag"(line 124, column 15)- _lhsOuseMap =- _hdIuseMap `merge` _tlIuseMap- -- use rule "Transform.ag"(line 490, column 32)- _lhsOwrappers =- _hdIwrappers `Set.union` _tlIwrappers- -- copy rule (up)- _lhsOattrDecls =- _tlIattrDecls- -- copy rule (up)- _lhsOdefSets =- _tlIdefSets- -- copy rule (down)- _hdOallAttrDecls =- _lhsIallAttrDecls- -- copy rule (down)- _hdOallConstructors =- _lhsIallConstructors- -- copy rule (down)- _hdOallFields =- _lhsIallFields- -- copy rule (down)- _hdOallNonterminals =- _lhsIallNonterminals- -- copy rule (down)- _hdOattrDecls =- _lhsIattrDecls- -- copy rule (down)- _hdOdefSets =- _lhsIdefSets- -- copy rule (down)- _hdOdefinedSets =- _lhsIdefinedSets- -- copy rule (down)- _tlOallAttrDecls =- _lhsIallAttrDecls- -- copy rule (down)- _tlOallConstructors =- _lhsIallConstructors- -- copy rule (down)- _tlOallFields =- _lhsIallFields- -- copy rule (down)- _tlOallNonterminals =- _lhsIallNonterminals- -- copy rule (chain)- _tlOattrDecls =- _hdIattrDecls- -- copy rule (chain)- _tlOdefSets =- _hdIdefSets- -- copy rule (down)- _tlOdefinedSets =- _lhsIdefinedSets- ( _hdIattrDecls,_hdIattrOrderCollect,_hdIblocks,_hdIcollectedConstructorsMap,_hdIcollectedFields,_hdIcollectedInsts,_hdIcollectedNames,_hdIcollectedRules,_hdIcollectedSetNames,_hdIcollectedSigs,_hdIdefSets,_hdIderivings,_hdIerrors,_hdImoduleDecl,_hdIorderDepErrorsCollect,_hdIpragmas,_hdIsemPragmasCollect,_hdItypeSyns,_hdIuseMap,_hdIwrappers) =- (hd_ _hdOallAttrDecls _hdOallConstructors _hdOallFields _hdOallNonterminals _hdOattrDecls _hdOdefSets _hdOdefinedSets)- ( _tlIattrDecls,_tlIattrOrderCollect,_tlIblocks,_tlIcollectedConstructorsMap,_tlIcollectedFields,_tlIcollectedInsts,_tlIcollectedNames,_tlIcollectedRules,_tlIcollectedSetNames,_tlIcollectedSigs,_tlIdefSets,_tlIderivings,_tlIerrors,_tlImoduleDecl,_tlIorderDepErrorsCollect,_tlIpragmas,_tlIsemPragmasCollect,_tlItypeSyns,_tlIuseMap,_tlIwrappers) =- (tl_ _tlOallAttrDecls _tlOallConstructors _tlOallFields _tlOallNonterminals _tlOattrDecls _tlOdefSets _tlOdefinedSets)- in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOorderDepErrorsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))-sem_Elems_Nil :: T_Elems-sem_Elems_Nil =- (T_Elems (\ _lhsIallAttrDecls- _lhsIallConstructors- _lhsIallFields- _lhsIallNonterminals- _lhsIattrDecls- _lhsIdefSets- _lhsIdefinedSets ->- (let _lhsOattrOrderCollect :: AttrOrderMap- _lhsOblocks :: Blocks- _lhsOcollectedConstructorsMap :: (Map Nonterminal (Set Constructor))- _lhsOcollectedFields :: ([(Nonterminal, Constructor, FieldMap)])- _lhsOcollectedInsts :: ([ (Nonterminal, Constructor, [Identifier]) ])- _lhsOcollectedNames :: (Set Name)- _lhsOcollectedRules :: ([ (Nonterminal, Constructor, RuleInfo)])- _lhsOcollectedSetNames :: (Set Name)- _lhsOcollectedSigs :: ([ (Nonterminal, Constructor, SigInfo) ])- _lhsOderivings :: Derivings- _lhsOerrors :: (Seq Error)- _lhsOmoduleDecl :: (Maybe (String,String,String))- _lhsOorderDepErrorsCollect :: (Seq Error)- _lhsOpragmas :: (Options -> Options)- _lhsOsemPragmasCollect :: PragmaMap- _lhsOtypeSyns :: TypeSyns- _lhsOuseMap :: (Map Nonterminal (Map Name (String,String,String)))- _lhsOwrappers :: (Set Nonterminal)- _lhsOattrDecls :: (Map Nonterminal (Attributes, Attributes))- _lhsOdefSets :: (Map Name (Set Nonterminal,Set Name))- -- use rule "Transform.ag"(line 560, column 55)- _lhsOattrOrderCollect =- Map.empty- -- use rule "Transform.ag"(line 38, column 19)- _lhsOblocks =- Map.empty- -- use rule "Transform.ag"(line 81, column 48)- _lhsOcollectedConstructorsMap =- Map.empty- -- use rule "Transform.ag"(line 112, column 28)- _lhsOcollectedFields =- []- -- use rule "Transform.ag"(line 136, column 29)- _lhsOcollectedInsts =- []- -- use rule "Transform.ag"(line 73, column 50)- _lhsOcollectedNames =- Set.empty- -- use rule "Transform.ag"(line 134, column 29)- _lhsOcollectedRules =- []- -- use rule "Transform.ag"(line 72, column 50)- _lhsOcollectedSetNames =- Set.empty- -- use rule "Transform.ag"(line 135, column 29)- _lhsOcollectedSigs =- []- -- use rule "Transform.ag"(line 593, column 33)- _lhsOderivings =- Map.empty- -- use rule "Transform.ag"(line 36, column 19)- _lhsOerrors =- Seq.empty- -- use rule "Transform.ag"(line 734, column 37)- _lhsOmoduleDecl =- mzero- -- use rule "Transform.ag"(line 561, column 60)- _lhsOorderDepErrorsCollect =- Seq.empty- -- use rule "Transform.ag"(line 499, column 34)- _lhsOpragmas =- id- -- use rule "Transform.ag"(line 532, column 56)- _lhsOsemPragmasCollect =- Map.empty- -- use rule "Transform.ag"(line 378, column 32)- _lhsOtypeSyns =- []- -- use rule "Transform.ag"(line 124, column 15)- _lhsOuseMap =- Map.empty- -- use rule "Transform.ag"(line 490, column 32)- _lhsOwrappers =- Set.empty- -- copy rule (chain)- _lhsOattrDecls =- _lhsIattrDecls- -- copy rule (chain)- _lhsOdefSets =- _lhsIdefSets- in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOorderDepErrorsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))--- NontSet ------------------------------------------------------{-- visit 0:- inherited attributes:- allFields : DataTypes- allNonterminals : Set Nonterminal- definedSets : DefinedSets- synthesized attributes:- collectedNames : Set Name- errors : Seq Error- nontSet : Set Nonterminal- alternatives:- alternative All:- alternative Difference:- child set1 : NontSet- child set2 : NontSet- alternative Intersect:- child set1 : NontSet- child set2 : NontSet- alternative NamedSet:- child name : {Nonterminal}- visit 0:- local _tup4 : _- local nontSet : _- local errors : _- alternative Path:- child from : {Nonterminal}- child to : {Nonterminal}- alternative Union:- child set1 : NontSet- child set2 : NontSet--}--- cata-sem_NontSet :: NontSet ->- T_NontSet-sem_NontSet (All ) =- (sem_NontSet_All )-sem_NontSet (Difference _set1 _set2) =- (sem_NontSet_Difference (sem_NontSet _set1) (sem_NontSet _set2))-sem_NontSet (Intersect _set1 _set2) =- (sem_NontSet_Intersect (sem_NontSet _set1) (sem_NontSet _set2))-sem_NontSet (NamedSet _name) =- (sem_NontSet_NamedSet _name)-sem_NontSet (Path _from _to) =- (sem_NontSet_Path _from _to)-sem_NontSet (Union _set1 _set2) =- (sem_NontSet_Union (sem_NontSet _set1) (sem_NontSet _set2))--- semantic domain-newtype T_NontSet = T_NontSet (DataTypes ->- (Set Nonterminal) ->- DefinedSets ->- ( (Set Name),(Seq Error),(Set Nonterminal)))-data Inh_NontSet = Inh_NontSet {allFields_Inh_NontSet :: DataTypes,allNonterminals_Inh_NontSet :: Set Nonterminal,definedSets_Inh_NontSet :: DefinedSets}-data Syn_NontSet = Syn_NontSet {collectedNames_Syn_NontSet :: Set Name,errors_Syn_NontSet :: Seq Error,nontSet_Syn_NontSet :: Set Nonterminal}-wrap_NontSet (T_NontSet sem) (Inh_NontSet _lhsIallFields _lhsIallNonterminals _lhsIdefinedSets) =- (let ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet) =- (sem _lhsIallFields _lhsIallNonterminals _lhsIdefinedSets)- in (Syn_NontSet _lhsOcollectedNames _lhsOerrors _lhsOnontSet))-sem_NontSet_All :: T_NontSet-sem_NontSet_All =- (T_NontSet (\ _lhsIallFields- _lhsIallNonterminals- _lhsIdefinedSets ->- (let _lhsOnontSet :: (Set Nonterminal)- _lhsOcollectedNames :: (Set Name)- _lhsOerrors :: (Seq Error)- -- "Transform.ag"(line 436, column 16)- _lhsOnontSet =- _lhsIallNonterminals- -- use rule "Transform.ag"(line 73, column 50)- _lhsOcollectedNames =- Set.empty- -- use rule "Transform.ag"(line 36, column 19)- _lhsOerrors =- Seq.empty- in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet))))-sem_NontSet_Difference :: T_NontSet ->- T_NontSet ->- T_NontSet-sem_NontSet_Difference (T_NontSet set1_) (T_NontSet set2_) =- (T_NontSet (\ _lhsIallFields- _lhsIallNonterminals- _lhsIdefinedSets ->- (let _lhsOnontSet :: (Set Nonterminal)- _lhsOcollectedNames :: (Set Name)- _lhsOerrors :: (Seq Error)- _set1OallFields :: DataTypes- _set1OallNonterminals :: (Set Nonterminal)- _set1OdefinedSets :: DefinedSets- _set2OallFields :: DataTypes- _set2OallNonterminals :: (Set Nonterminal)- _set2OdefinedSets :: DefinedSets- _set1IcollectedNames :: (Set Name)- _set1Ierrors :: (Seq Error)- _set1InontSet :: (Set Nonterminal)- _set2IcollectedNames :: (Set Name)- _set2Ierrors :: (Seq Error)- _set2InontSet :: (Set Nonterminal)- -- "Transform.ag"(line 442, column 16)- _lhsOnontSet =- Set.difference _set1InontSet _set2InontSet- -- use rule "Transform.ag"(line 73, column 50)- _lhsOcollectedNames =- _set1IcollectedNames `Set.union` _set2IcollectedNames- -- use rule "Transform.ag"(line 36, column 19)- _lhsOerrors =- _set1Ierrors Seq.<> _set2Ierrors- -- copy rule (down)- _set1OallFields =- _lhsIallFields- -- copy rule (down)- _set1OallNonterminals =- _lhsIallNonterminals- -- copy rule (down)- _set1OdefinedSets =- _lhsIdefinedSets- -- copy rule (down)- _set2OallFields =- _lhsIallFields- -- copy rule (down)- _set2OallNonterminals =- _lhsIallNonterminals- -- copy rule (down)- _set2OdefinedSets =- _lhsIdefinedSets- ( _set1IcollectedNames,_set1Ierrors,_set1InontSet) =- (set1_ _set1OallFields _set1OallNonterminals _set1OdefinedSets)- ( _set2IcollectedNames,_set2Ierrors,_set2InontSet) =- (set2_ _set2OallFields _set2OallNonterminals _set2OdefinedSets)- in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet))))-sem_NontSet_Intersect :: T_NontSet ->- T_NontSet ->- T_NontSet-sem_NontSet_Intersect (T_NontSet set1_) (T_NontSet set2_) =- (T_NontSet (\ _lhsIallFields- _lhsIallNonterminals- _lhsIdefinedSets ->- (let _lhsOnontSet :: (Set Nonterminal)- _lhsOcollectedNames :: (Set Name)- _lhsOerrors :: (Seq Error)- _set1OallFields :: DataTypes- _set1OallNonterminals :: (Set Nonterminal)- _set1OdefinedSets :: DefinedSets- _set2OallFields :: DataTypes- _set2OallNonterminals :: (Set Nonterminal)- _set2OdefinedSets :: DefinedSets- _set1IcollectedNames :: (Set Name)- _set1Ierrors :: (Seq Error)- _set1InontSet :: (Set Nonterminal)- _set2IcollectedNames :: (Set Name)- _set2Ierrors :: (Seq Error)- _set2InontSet :: (Set Nonterminal)- -- "Transform.ag"(line 441, column 16)- _lhsOnontSet =- Set.intersection _set1InontSet _set2InontSet- -- use rule "Transform.ag"(line 73, column 50)- _lhsOcollectedNames =- _set1IcollectedNames `Set.union` _set2IcollectedNames- -- use rule "Transform.ag"(line 36, column 19)- _lhsOerrors =- _set1Ierrors Seq.<> _set2Ierrors- -- copy rule (down)- _set1OallFields =- _lhsIallFields- -- copy rule (down)- _set1OallNonterminals =- _lhsIallNonterminals- -- copy rule (down)- _set1OdefinedSets =- _lhsIdefinedSets- -- copy rule (down)- _set2OallFields =- _lhsIallFields- -- copy rule (down)- _set2OallNonterminals =- _lhsIallNonterminals- -- copy rule (down)- _set2OdefinedSets =- _lhsIdefinedSets- ( _set1IcollectedNames,_set1Ierrors,_set1InontSet) =- (set1_ _set1OallFields _set1OallNonterminals _set1OdefinedSets)- ( _set2IcollectedNames,_set2Ierrors,_set2InontSet) =- (set2_ _set2OallFields _set2OallNonterminals _set2OdefinedSets)- in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet))))-sem_NontSet_NamedSet :: Nonterminal ->- T_NontSet-sem_NontSet_NamedSet name_ =- (T_NontSet (\ _lhsIallFields- _lhsIallNonterminals- _lhsIdefinedSets ->- (let _lhsOcollectedNames :: (Set Name)- _lhsOerrors :: (Seq Error)- _lhsOnontSet :: (Set Nonterminal)- -- "Transform.ag"(line 340, column 14)- _lhsOcollectedNames =- Set.singleton name_- -- "Transform.ag"(line 437, column 20)- __tup4 =- case Map.lookup name_ _lhsIdefinedSets of- Nothing -> (Set.empty, Seq.single (UndefNont name_))- Just set -> (set, Seq.empty)- -- "Transform.ag"(line 437, column 20)- (_nontSet,_) =- __tup4- -- "Transform.ag"(line 437, column 20)- (_,_errors) =- __tup4- -- use rule "Transform.ag"(line 36, column 19)- _lhsOerrors =- _errors- -- copy rule (from local)- _lhsOnontSet =- _nontSet- in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet))))-sem_NontSet_Path :: Nonterminal ->- Nonterminal ->- T_NontSet-sem_NontSet_Path from_ to_ =- (T_NontSet (\ _lhsIallFields- _lhsIallNonterminals- _lhsIdefinedSets ->- (let _lhsOnontSet :: (Set Nonterminal)- _lhsOerrors :: (Seq Error)- _lhsOcollectedNames :: (Set Name)- -- "Transform.ag"(line 443, column 16)- _lhsOnontSet =- let table = flattenDatas _lhsIallFields- in path table from_ to_- -- "Transform.ag"(line 445, column 16)- _lhsOerrors =- let check name | Set.member name _lhsIallNonterminals- = Seq.empty- | otherwise = Seq.single (UndefNont name)- in check from_ <> check to_- -- use rule "Transform.ag"(line 73, column 50)- _lhsOcollectedNames =- Set.empty- in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet))))-sem_NontSet_Union :: T_NontSet ->- T_NontSet ->- T_NontSet-sem_NontSet_Union (T_NontSet set1_) (T_NontSet set2_) =- (T_NontSet (\ _lhsIallFields- _lhsIallNonterminals- _lhsIdefinedSets ->- (let _lhsOnontSet :: (Set Nonterminal)- _lhsOcollectedNames :: (Set Name)- _lhsOerrors :: (Seq Error)- _set1OallFields :: DataTypes- _set1OallNonterminals :: (Set Nonterminal)- _set1OdefinedSets :: DefinedSets- _set2OallFields :: DataTypes- _set2OallNonterminals :: (Set Nonterminal)- _set2OdefinedSets :: DefinedSets- _set1IcollectedNames :: (Set Name)- _set1Ierrors :: (Seq Error)- _set1InontSet :: (Set Nonterminal)- _set2IcollectedNames :: (Set Name)- _set2Ierrors :: (Seq Error)- _set2InontSet :: (Set Nonterminal)- -- "Transform.ag"(line 440, column 16)- _lhsOnontSet =- Set.union _set1InontSet _set2InontSet- -- use rule "Transform.ag"(line 73, column 50)- _lhsOcollectedNames =- _set1IcollectedNames `Set.union` _set2IcollectedNames- -- use rule "Transform.ag"(line 36, column 19)- _lhsOerrors =- _set1Ierrors Seq.<> _set2Ierrors- -- copy rule (down)- _set1OallFields =- _lhsIallFields- -- copy rule (down)- _set1OallNonterminals =- _lhsIallNonterminals- -- copy rule (down)- _set1OdefinedSets =- _lhsIdefinedSets- -- copy rule (down)- _set2OallFields =- _lhsIallFields- -- copy rule (down)- _set2OallNonterminals =- _lhsIallNonterminals- -- copy rule (down)- _set2OdefinedSets =- _lhsIdefinedSets- ( _set1IcollectedNames,_set1Ierrors,_set1InontSet) =- (set1_ _set1OallFields _set1OallNonterminals _set1OdefinedSets)- ( _set2IcollectedNames,_set2Ierrors,_set2InontSet) =- (set2_ _set2OallFields _set2OallNonterminals _set2OdefinedSets)- in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet))))--- Pattern ------------------------------------------------------{-- visit 0:- synthesized attributes:- copy : SELF- definedAttrs : [AttrName]- definedInsts : [Identifier]- patunder : [AttrName]->Pattern- stpos : Pos- alternatives:- alternative Alias:- child field : {Name}- child attr : {Name}- child pat : Pattern- child parts : Patterns- visit 0:- local copy : _- alternative Constr:- child name : {Constructor}- child pats : Patterns- 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 (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,([AttrName]),([Identifier]),([AttrName]->Pattern),Pos))-data Inh_Pattern = Inh_Pattern {}-data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern,definedAttrs_Syn_Pattern :: [AttrName],definedInsts_Syn_Pattern :: [Identifier],patunder_Syn_Pattern :: [AttrName]->Pattern,stpos_Syn_Pattern :: Pos}-wrap_Pattern (T_Pattern sem) (Inh_Pattern ) =- (let ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos) =- (sem )- in (Syn_Pattern _lhsOcopy _lhsOdefinedAttrs _lhsOdefinedInsts _lhsOpatunder _lhsOstpos))-sem_Pattern_Alias :: Name ->- Name ->- T_Pattern ->- T_Patterns ->- T_Pattern-sem_Pattern_Alias field_ attr_ (T_Pattern pat_) (T_Patterns parts_) =- (T_Pattern (let _lhsOdefinedAttrs :: ([AttrName])- _lhsOpatunder :: ([AttrName]->Pattern)- _lhsOdefinedInsts :: ([Identifier])- _lhsOstpos :: Pos- _lhsOcopy :: Pattern- _patIcopy :: Pattern- _patIdefinedAttrs :: ([AttrName])- _patIdefinedInsts :: ([Identifier])- _patIpatunder :: ([AttrName]->Pattern)- _patIstpos :: Pos- _partsIcopy :: Patterns- _partsIdefinedAttrs :: ([AttrName])- _partsIdefinedInsts :: ([Identifier])- _partsIpatunder :: ([AttrName]->Patterns)- -- "Transform.ag"(line 711, column 11)- _lhsOdefinedAttrs =- (field_, attr_) : _patIdefinedAttrs- -- "Transform.ag"(line 712, column 11)- _lhsOpatunder =- \us -> if ((field_,attr_) `elem` us) then Underscore noPos else _copy- -- "Transform.ag"(line 713, column 11)- _lhsOdefinedInsts =- (if field_ == _INST then [attr_] else []) ++ _patIdefinedInsts- -- "Transform.ag"(line 727, column 16)- _lhsOstpos =- getPos field_- -- self rule- _copy =- Alias field_ attr_ _patIcopy _partsIcopy- -- self rule- _lhsOcopy =- _copy- ( _patIcopy,_patIdefinedAttrs,_patIdefinedInsts,_patIpatunder,_patIstpos) =- (pat_ )- ( _partsIcopy,_partsIdefinedAttrs,_partsIdefinedInsts,_partsIpatunder) =- (parts_ )- in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos)))-sem_Pattern_Constr :: Constructor ->- T_Patterns ->- T_Pattern-sem_Pattern_Constr name_ (T_Patterns pats_) =- (T_Pattern (let _lhsOpatunder :: ([AttrName]->Pattern)- _lhsOstpos :: Pos- _lhsOdefinedAttrs :: ([AttrName])- _lhsOdefinedInsts :: ([Identifier])- _lhsOcopy :: Pattern- _patsIcopy :: Patterns- _patsIdefinedAttrs :: ([AttrName])- _patsIdefinedInsts :: ([Identifier])- _patsIpatunder :: ([AttrName]->Patterns)- -- "Transform.ag"(line 715, column 12)- _lhsOpatunder =- \us -> Constr name_ (_patsIpatunder us)- -- "Transform.ag"(line 725, column 16)- _lhsOstpos =- getPos name_- -- use rule "Transform.ag"(line 706, column 42)- _lhsOdefinedAttrs =- _patsIdefinedAttrs- -- use rule "Transform.ag"(line 705, column 55)- _lhsOdefinedInsts =- _patsIdefinedInsts- -- self rule- _copy =- Constr name_ _patsIcopy- -- self rule- _lhsOcopy =- _copy- ( _patsIcopy,_patsIdefinedAttrs,_patsIdefinedInsts,_patsIpatunder) =- (pats_ )- in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos)))-sem_Pattern_Product :: Pos ->- T_Patterns ->- T_Pattern-sem_Pattern_Product pos_ (T_Patterns pats_) =- (T_Pattern (let _lhsOpatunder :: ([AttrName]->Pattern)- _lhsOstpos :: Pos- _lhsOdefinedAttrs :: ([AttrName])- _lhsOdefinedInsts :: ([Identifier])- _lhsOcopy :: Pattern- _patsIcopy :: Patterns- _patsIdefinedAttrs :: ([AttrName])- _patsIdefinedInsts :: ([Identifier])- _patsIpatunder :: ([AttrName]->Patterns)- -- "Transform.ag"(line 716, column 13)- _lhsOpatunder =- \us -> Product pos_ (_patsIpatunder us)- -- "Transform.ag"(line 726, column 16)- _lhsOstpos =- pos_- -- use rule "Transform.ag"(line 706, column 42)- _lhsOdefinedAttrs =- _patsIdefinedAttrs- -- use rule "Transform.ag"(line 705, column 55)- _lhsOdefinedInsts =- _patsIdefinedInsts- -- self rule- _copy =- Product pos_ _patsIcopy- -- self rule- _lhsOcopy =- _copy- ( _patsIcopy,_patsIdefinedAttrs,_patsIdefinedInsts,_patsIpatunder) =- (pats_ )- in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos)))-sem_Pattern_Underscore :: Pos ->- T_Pattern-sem_Pattern_Underscore pos_ =- (T_Pattern (let _lhsOpatunder :: ([AttrName]->Pattern)- _lhsOstpos :: Pos- _lhsOdefinedAttrs :: ([AttrName])- _lhsOdefinedInsts :: ([Identifier])- _lhsOcopy :: Pattern- -- "Transform.ag"(line 714, column 16)- _lhsOpatunder =- \us -> _copy- -- "Transform.ag"(line 728, column 16)- _lhsOstpos =- pos_- -- use rule "Transform.ag"(line 706, column 42)- _lhsOdefinedAttrs =- []- -- use rule "Transform.ag"(line 705, column 55)- _lhsOdefinedInsts =- []- -- self rule- _copy =- Underscore pos_- -- self rule- _lhsOcopy =- _copy- in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos)))--- Patterns -----------------------------------------------------{-- visit 0:- synthesized attributes:- copy : SELF- definedAttrs : [AttrName]- definedInsts : [Identifier]- patunder : [AttrName]->Patterns- 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,([AttrName]),([Identifier]),([AttrName]->Patterns)))-data Inh_Patterns = Inh_Patterns {}-data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns,definedAttrs_Syn_Patterns :: [AttrName],definedInsts_Syn_Patterns :: [Identifier],patunder_Syn_Patterns :: [AttrName]->Patterns}-wrap_Patterns (T_Patterns sem) (Inh_Patterns ) =- (let ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder) =- (sem )- in (Syn_Patterns _lhsOcopy _lhsOdefinedAttrs _lhsOdefinedInsts _lhsOpatunder))-sem_Patterns_Cons :: T_Pattern ->- T_Patterns ->- T_Patterns-sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) =- (T_Patterns (let _lhsOpatunder :: ([AttrName]->Patterns)- _lhsOdefinedAttrs :: ([AttrName])- _lhsOdefinedInsts :: ([Identifier])- _lhsOcopy :: Patterns- _hdIcopy :: Pattern- _hdIdefinedAttrs :: ([AttrName])- _hdIdefinedInsts :: ([Identifier])- _hdIpatunder :: ([AttrName]->Pattern)- _hdIstpos :: Pos- _tlIcopy :: Patterns- _tlIdefinedAttrs :: ([AttrName])- _tlIdefinedInsts :: ([Identifier])- _tlIpatunder :: ([AttrName]->Patterns)- -- "Transform.ag"(line 720, column 10)- _lhsOpatunder =- \us -> (_hdIpatunder us) : (_tlIpatunder us)- -- use rule "Transform.ag"(line 706, column 42)- _lhsOdefinedAttrs =- _hdIdefinedAttrs ++ _tlIdefinedAttrs- -- use rule "Transform.ag"(line 705, column 55)- _lhsOdefinedInsts =- _hdIdefinedInsts ++ _tlIdefinedInsts- -- self rule- _copy =- (:) _hdIcopy _tlIcopy- -- self rule- _lhsOcopy =- _copy- ( _hdIcopy,_hdIdefinedAttrs,_hdIdefinedInsts,_hdIpatunder,_hdIstpos) =- (hd_ )- ( _tlIcopy,_tlIdefinedAttrs,_tlIdefinedInsts,_tlIpatunder) =- (tl_ )- in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder)))-sem_Patterns_Nil :: T_Patterns-sem_Patterns_Nil =- (T_Patterns (let _lhsOpatunder :: ([AttrName]->Patterns)- _lhsOdefinedAttrs :: ([AttrName])- _lhsOdefinedInsts :: ([Identifier])- _lhsOcopy :: Patterns- -- "Transform.ag"(line 719, column 9)- _lhsOpatunder =- \us -> []- -- use rule "Transform.ag"(line 706, column 42)- _lhsOdefinedAttrs =- []- -- use rule "Transform.ag"(line 705, column 55)- _lhsOdefinedInsts =- []- -- self rule- _copy =- []- -- self rule- _lhsOcopy =- _copy- in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder)))--- SemAlt -------------------------------------------------------{-- visit 0:- inherited attributes:- allAttrDecls : Map Nonterminal (Attributes, Attributes)- allFields : DataTypes- nts : Set Nonterminal- synthesized attributes:- attrOrderCollect : AttrOrderMap- collectedInsts : [ (Nonterminal, Constructor, [Identifier]) ]- collectedRules : [ (Nonterminal, Constructor, RuleInfo)]- collectedSigs : [ (Nonterminal, Constructor, SigInfo) ]- errors : Seq Error- orderDepErrorsCollect : Seq Error- semPragmasCollect : PragmaMap- alternatives:- alternative SemAlt:- child pos : {Pos}- child constructorSet : ConstructorSet- child rules : SemDefs- visit 0:- local pragmaNames : _- local attrOrders : _- local coninfo : _--}--- cata-sem_SemAlt :: SemAlt ->- T_SemAlt-sem_SemAlt (SemAlt _pos _constructorSet _rules) =- (sem_SemAlt_SemAlt _pos (sem_ConstructorSet _constructorSet) (sem_SemDefs _rules))--- semantic domain-newtype T_SemAlt = T_SemAlt ((Map Nonterminal (Attributes, Attributes)) ->- DataTypes ->- (Set Nonterminal) ->- ( AttrOrderMap,([ (Nonterminal, Constructor, [Identifier]) ]),([ (Nonterminal, Constructor, RuleInfo)]),([ (Nonterminal, Constructor, SigInfo) ]),(Seq Error),(Seq Error),PragmaMap))-data Inh_SemAlt = Inh_SemAlt {allAttrDecls_Inh_SemAlt :: Map Nonterminal (Attributes, Attributes),allFields_Inh_SemAlt :: DataTypes,nts_Inh_SemAlt :: Set Nonterminal}-data Syn_SemAlt = Syn_SemAlt {attrOrderCollect_Syn_SemAlt :: AttrOrderMap,collectedInsts_Syn_SemAlt :: [ (Nonterminal, Constructor, [Identifier]) ],collectedRules_Syn_SemAlt :: [ (Nonterminal, Constructor, RuleInfo)],collectedSigs_Syn_SemAlt :: [ (Nonterminal, Constructor, SigInfo) ],errors_Syn_SemAlt :: Seq Error,orderDepErrorsCollect_Syn_SemAlt :: Seq Error,semPragmasCollect_Syn_SemAlt :: PragmaMap}-wrap_SemAlt (T_SemAlt sem) (Inh_SemAlt _lhsIallAttrDecls _lhsIallFields _lhsInts) =- (let ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOerrors,_lhsOorderDepErrorsCollect,_lhsOsemPragmasCollect) =- (sem _lhsIallAttrDecls _lhsIallFields _lhsInts)- in (Syn_SemAlt _lhsOattrOrderCollect _lhsOcollectedInsts _lhsOcollectedRules _lhsOcollectedSigs _lhsOerrors _lhsOorderDepErrorsCollect _lhsOsemPragmasCollect))-sem_SemAlt_SemAlt :: Pos ->- T_ConstructorSet ->- T_SemDefs ->- T_SemAlt-sem_SemAlt_SemAlt pos_ (T_ConstructorSet constructorSet_) (T_SemDefs rules_) =- (T_SemAlt (\ _lhsIallAttrDecls- _lhsIallFields- _lhsInts ->- (let _lhsOsemPragmasCollect :: PragmaMap- _lhsOattrOrderCollect :: AttrOrderMap- _lhsOerrors :: (Seq Error)- _lhsOcollectedRules :: ([ (Nonterminal, Constructor, RuleInfo)])- _lhsOcollectedSigs :: ([ (Nonterminal, Constructor, SigInfo) ])- _lhsOcollectedInsts :: ([ (Nonterminal, Constructor, [Identifier]) ])- _lhsOorderDepErrorsCollect :: (Seq Error)- _constructorSetIcollectedConstructorNames :: (Set Constructor)- _constructorSetIconstructors :: ((Set Constructor->Set Constructor))- _constructorSetIerrors :: (Seq Error)- _rulesIdefinedInsts :: ([Identifier])- _rulesIorderDepsCollect :: (Set Dependency)- _rulesIpragmaNamesCollect :: ([Name])- _rulesIruleInfos :: ([RuleInfo])- _rulesIsigInfos :: ([SigInfo] )- -- "Transform.ag"(line 536, column 7)- _pragmaNames =- Set.fromList _rulesIpragmaNamesCollect- -- "Transform.ag"(line 537, column 7)- _lhsOsemPragmasCollect =- foldr pragmaMapUnion Map.empty [ pragmaMapSingle nt con _pragmaNames- | (nt, conset, _) <- _coninfo- , con <- Set.toList conset- ]- -- "Transform.ag"(line 566, column 7)- _attrOrders =- [ orderMapSingle nt con _rulesIorderDepsCollect- | (nt, conset, _) <- _coninfo- , con <- Set.toList conset- ]- -- "Transform.ag"(line 572, column 7)- _lhsOattrOrderCollect =- foldr orderMapUnion Map.empty _attrOrders- -- "Transform.ag"(line 666, column 12)- _coninfo =- [ (nt, conset, conkeys)- | nt <- Set.toList _lhsInts- , let conmap = Map.findWithDefault Map.empty nt _lhsIallFields- , let conkeys = Set.fromList (Map.keys conmap)- , let conset = _constructorSetIconstructors conkeys- ]- -- "Transform.ag"(line 673, column 12)- _lhsOerrors =- Seq.fromList- [ UndefAlt nt con- | (nt, conset, conkeys) <- _coninfo- , con <- Set.toList (Set.difference conset conkeys)- ]- -- "Transform.ag"(line 678, column 12)- _lhsOcollectedRules =- [ (nt,con,r)- | (nt, conset, _) <- _coninfo- , con <- Set.toList conset- , r <- _rulesIruleInfos- ]- -- "Transform.ag"(line 684, column 12)- _lhsOcollectedSigs =- [ (nt,con,ts)- | (nt, conset, _) <- _coninfo- , con <- Set.toList conset- , ts <- _rulesIsigInfos- ]- -- "Transform.ag"(line 691, column 12)- _lhsOcollectedInsts =- [ (nt,con,_rulesIdefinedInsts)- | (nt, conset, _) <- _coninfo- , con <- Set.toList conset- ]- -- use rule "Transform.ag"(line 561, column 60)- _lhsOorderDepErrorsCollect =- Seq.empty- ( _constructorSetIcollectedConstructorNames,_constructorSetIconstructors,_constructorSetIerrors) =- (constructorSet_ )- ( _rulesIdefinedInsts,_rulesIorderDepsCollect,_rulesIpragmaNamesCollect,_rulesIruleInfos,_rulesIsigInfos) =- (rules_ )- in ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOerrors,_lhsOorderDepErrorsCollect,_lhsOsemPragmasCollect))))--- SemAlts ------------------------------------------------------{-- visit 0:- inherited attributes:- allAttrDecls : Map Nonterminal (Attributes, Attributes)- allFields : DataTypes- nts : Set Nonterminal- synthesized attributes:- attrOrderCollect : AttrOrderMap- collectedInsts : [ (Nonterminal, Constructor, [Identifier]) ]- collectedRules : [ (Nonterminal, Constructor, RuleInfo)]- collectedSigs : [ (Nonterminal, Constructor, SigInfo) ]- errors : Seq Error- orderDepErrorsCollect : Seq Error- semPragmasCollect : PragmaMap- alternatives:- alternative Cons:- child hd : SemAlt- child tl : SemAlts- alternative Nil:--}--- cata-sem_SemAlts :: SemAlts ->- T_SemAlts-sem_SemAlts list =- (Prelude.foldr sem_SemAlts_Cons sem_SemAlts_Nil (Prelude.map sem_SemAlt list))--- semantic domain-newtype T_SemAlts = T_SemAlts ((Map Nonterminal (Attributes, Attributes)) ->- DataTypes ->- (Set Nonterminal) ->- ( AttrOrderMap,([ (Nonterminal, Constructor, [Identifier]) ]),([ (Nonterminal, Constructor, RuleInfo)]),([ (Nonterminal, Constructor, SigInfo) ]),(Seq Error),(Seq Error),PragmaMap))-data Inh_SemAlts = Inh_SemAlts {allAttrDecls_Inh_SemAlts :: Map Nonterminal (Attributes, Attributes),allFields_Inh_SemAlts :: DataTypes,nts_Inh_SemAlts :: Set Nonterminal}-data Syn_SemAlts = Syn_SemAlts {attrOrderCollect_Syn_SemAlts :: AttrOrderMap,collectedInsts_Syn_SemAlts :: [ (Nonterminal, Constructor, [Identifier]) ],collectedRules_Syn_SemAlts :: [ (Nonterminal, Constructor, RuleInfo)],collectedSigs_Syn_SemAlts :: [ (Nonterminal, Constructor, SigInfo) ],errors_Syn_SemAlts :: Seq Error,orderDepErrorsCollect_Syn_SemAlts :: Seq Error,semPragmasCollect_Syn_SemAlts :: PragmaMap}-wrap_SemAlts (T_SemAlts sem) (Inh_SemAlts _lhsIallAttrDecls _lhsIallFields _lhsInts) =- (let ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOerrors,_lhsOorderDepErrorsCollect,_lhsOsemPragmasCollect) =- (sem _lhsIallAttrDecls _lhsIallFields _lhsInts)- in (Syn_SemAlts _lhsOattrOrderCollect _lhsOcollectedInsts _lhsOcollectedRules _lhsOcollectedSigs _lhsOerrors _lhsOorderDepErrorsCollect _lhsOsemPragmasCollect))-sem_SemAlts_Cons :: T_SemAlt ->- T_SemAlts ->- T_SemAlts-sem_SemAlts_Cons (T_SemAlt hd_) (T_SemAlts tl_) =- (T_SemAlts (\ _lhsIallAttrDecls- _lhsIallFields- _lhsInts ->- (let _lhsOattrOrderCollect :: AttrOrderMap- _lhsOcollectedInsts :: ([ (Nonterminal, Constructor, [Identifier]) ])- _lhsOcollectedRules :: ([ (Nonterminal, Constructor, RuleInfo)])- _lhsOcollectedSigs :: ([ (Nonterminal, Constructor, SigInfo) ])- _lhsOerrors :: (Seq Error)- _lhsOorderDepErrorsCollect :: (Seq Error)- _lhsOsemPragmasCollect :: PragmaMap- _hdOallAttrDecls :: (Map Nonterminal (Attributes, Attributes))- _hdOallFields :: DataTypes- _hdOnts :: (Set Nonterminal)- _tlOallAttrDecls :: (Map Nonterminal (Attributes, Attributes))- _tlOallFields :: DataTypes- _tlOnts :: (Set Nonterminal)- _hdIattrOrderCollect :: AttrOrderMap- _hdIcollectedInsts :: ([ (Nonterminal, Constructor, [Identifier]) ])- _hdIcollectedRules :: ([ (Nonterminal, Constructor, RuleInfo)])- _hdIcollectedSigs :: ([ (Nonterminal, Constructor, SigInfo) ])- _hdIerrors :: (Seq Error)- _hdIorderDepErrorsCollect :: (Seq Error)- _hdIsemPragmasCollect :: PragmaMap- _tlIattrOrderCollect :: AttrOrderMap- _tlIcollectedInsts :: ([ (Nonterminal, Constructor, [Identifier]) ])- _tlIcollectedRules :: ([ (Nonterminal, Constructor, RuleInfo)])- _tlIcollectedSigs :: ([ (Nonterminal, Constructor, SigInfo) ])- _tlIerrors :: (Seq Error)- _tlIorderDepErrorsCollect :: (Seq Error)- _tlIsemPragmasCollect :: PragmaMap- -- use rule "Transform.ag"(line 560, column 55)- _lhsOattrOrderCollect =- _hdIattrOrderCollect `orderMapUnion` _tlIattrOrderCollect- -- use rule "Transform.ag"(line 136, column 29)- _lhsOcollectedInsts =- _hdIcollectedInsts ++ _tlIcollectedInsts- -- use rule "Transform.ag"(line 134, column 29)- _lhsOcollectedRules =- _hdIcollectedRules ++ _tlIcollectedRules- -- use rule "Transform.ag"(line 135, column 29)- _lhsOcollectedSigs =- _hdIcollectedSigs ++ _tlIcollectedSigs- -- use rule "Transform.ag"(line 36, column 19)- _lhsOerrors =- _hdIerrors Seq.<> _tlIerrors- -- use rule "Transform.ag"(line 561, column 60)- _lhsOorderDepErrorsCollect =- _hdIorderDepErrorsCollect Seq.<> _tlIorderDepErrorsCollect- -- use rule "Transform.ag"(line 532, column 56)- _lhsOsemPragmasCollect =- _hdIsemPragmasCollect `pragmaMapUnion` _tlIsemPragmasCollect- -- copy rule (down)- _hdOallAttrDecls =- _lhsIallAttrDecls- -- copy rule (down)- _hdOallFields =- _lhsIallFields- -- copy rule (down)- _hdOnts =- _lhsInts- -- copy rule (down)- _tlOallAttrDecls =- _lhsIallAttrDecls- -- copy rule (down)- _tlOallFields =- _lhsIallFields- -- copy rule (down)- _tlOnts =- _lhsInts- ( _hdIattrOrderCollect,_hdIcollectedInsts,_hdIcollectedRules,_hdIcollectedSigs,_hdIerrors,_hdIorderDepErrorsCollect,_hdIsemPragmasCollect) =- (hd_ _hdOallAttrDecls _hdOallFields _hdOnts)- ( _tlIattrOrderCollect,_tlIcollectedInsts,_tlIcollectedRules,_tlIcollectedSigs,_tlIerrors,_tlIorderDepErrorsCollect,_tlIsemPragmasCollect) =- (tl_ _tlOallAttrDecls _tlOallFields _tlOnts)- in ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOerrors,_lhsOorderDepErrorsCollect,_lhsOsemPragmasCollect))))-sem_SemAlts_Nil :: T_SemAlts-sem_SemAlts_Nil =- (T_SemAlts (\ _lhsIallAttrDecls- _lhsIallFields- _lhsInts ->- (let _lhsOattrOrderCollect :: AttrOrderMap- _lhsOcollectedInsts :: ([ (Nonterminal, Constructor, [Identifier]) ])- _lhsOcollectedRules :: ([ (Nonterminal, Constructor, RuleInfo)])- _lhsOcollectedSigs :: ([ (Nonterminal, Constructor, SigInfo) ])- _lhsOerrors :: (Seq Error)- _lhsOorderDepErrorsCollect :: (Seq Error)- _lhsOsemPragmasCollect :: PragmaMap- -- use rule "Transform.ag"(line 560, column 55)- _lhsOattrOrderCollect =- Map.empty- -- use rule "Transform.ag"(line 136, column 29)- _lhsOcollectedInsts =- []- -- use rule "Transform.ag"(line 134, column 29)- _lhsOcollectedRules =- []- -- use rule "Transform.ag"(line 135, column 29)- _lhsOcollectedSigs =- []- -- use rule "Transform.ag"(line 36, column 19)- _lhsOerrors =- Seq.empty- -- use rule "Transform.ag"(line 561, column 60)- _lhsOorderDepErrorsCollect =- Seq.empty- -- use rule "Transform.ag"(line 532, column 56)- _lhsOsemPragmasCollect =- Map.empty- in ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOerrors,_lhsOorderDepErrorsCollect,_lhsOsemPragmasCollect))))--- SemDef -------------------------------------------------------{-- visit 0:- synthesized attributes:- definedInsts : [Identifier]- orderDepsCollect : Set Dependency- pragmaNamesCollect : [Name]- ruleInfos : [RuleInfo]- sigInfos : [SigInfo] - alternatives:- alternative AttrOrderBefore:- child before : {(Identifier,Identifier)}- child after : {(Identifier,Identifier)}- visit 0:- local dependency : _- alternative Def:- child pattern : Pattern- child rhs : {Expression}- child owrt : {Bool}- alternative SemPragma:- child names : {[Name]}- alternative TypeDef:- child ident : {Identifier}- child tp : {Type}--}--- cata-sem_SemDef :: SemDef ->- T_SemDef-sem_SemDef (AttrOrderBefore _before _after) =- (sem_SemDef_AttrOrderBefore _before _after)-sem_SemDef (Def _pattern _rhs _owrt) =- (sem_SemDef_Def (sem_Pattern _pattern) _rhs _owrt)-sem_SemDef (SemPragma _names) =- (sem_SemDef_SemPragma _names)-sem_SemDef (TypeDef _ident _tp) =- (sem_SemDef_TypeDef _ident _tp)--- semantic domain-newtype T_SemDef = T_SemDef (( ([Identifier]),(Set Dependency),([Name]),([RuleInfo]),([SigInfo] )))-data Inh_SemDef = Inh_SemDef {}-data Syn_SemDef = Syn_SemDef {definedInsts_Syn_SemDef :: [Identifier],orderDepsCollect_Syn_SemDef :: Set Dependency,pragmaNamesCollect_Syn_SemDef :: [Name],ruleInfos_Syn_SemDef :: [RuleInfo],sigInfos_Syn_SemDef :: [SigInfo] }-wrap_SemDef (T_SemDef sem) (Inh_SemDef ) =- (let ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos) =- (sem )- in (Syn_SemDef _lhsOdefinedInsts _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos))-sem_SemDef_AttrOrderBefore :: ((Identifier,Identifier)) ->- ((Identifier,Identifier)) ->- T_SemDef-sem_SemDef_AttrOrderBefore before_ after_ =- (T_SemDef (let _lhsOorderDepsCollect :: (Set Dependency)- _lhsOdefinedInsts :: ([Identifier])- _lhsOpragmaNamesCollect :: ([Name])- _lhsOruleInfos :: ([RuleInfo])- _lhsOsigInfos :: ([SigInfo] )- -- "Transform.ag"(line 578, column 7)- _dependency =- Dependency before_ after_- -- "Transform.ag"(line 579, column 7)- _lhsOorderDepsCollect =- Set.singleton _dependency- -- use rule "Transform.ag"(line 705, column 55)- _lhsOdefinedInsts =- []- -- use rule "Transform.ag"(line 542, column 46)- _lhsOpragmaNamesCollect =- []- -- use rule "Transform.ag"(line 660, column 37)- _lhsOruleInfos =- []- -- use rule "Transform.ag"(line 661, column 37)- _lhsOsigInfos =- []- in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos)))-sem_SemDef_Def :: T_Pattern ->- Expression ->- Bool ->- T_SemDef-sem_SemDef_Def (T_Pattern pattern_) rhs_ owrt_ =- (T_SemDef (let _lhsOruleInfos :: ([RuleInfo])- _lhsOdefinedInsts :: ([Identifier])- _lhsOorderDepsCollect :: (Set Dependency)- _lhsOpragmaNamesCollect :: ([Name])- _lhsOsigInfos :: ([SigInfo] )- _patternIcopy :: Pattern- _patternIdefinedAttrs :: ([AttrName])- _patternIdefinedInsts :: ([Identifier])- _patternIpatunder :: ([AttrName]->Pattern)- _patternIstpos :: Pos- -- "Transform.ag"(line 699, column 10)- _lhsOruleInfos =- [ (_patternIpatunder, rhs_, _patternIdefinedAttrs, owrt_, show _patternIstpos) ]- -- use rule "Transform.ag"(line 705, column 55)- _lhsOdefinedInsts =- _patternIdefinedInsts- -- use rule "Transform.ag"(line 574, column 44)- _lhsOorderDepsCollect =- Set.empty- -- use rule "Transform.ag"(line 542, column 46)- _lhsOpragmaNamesCollect =- []- -- use rule "Transform.ag"(line 661, column 37)- _lhsOsigInfos =- []- ( _patternIcopy,_patternIdefinedAttrs,_patternIdefinedInsts,_patternIpatunder,_patternIstpos) =- (pattern_ )- in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos)))-sem_SemDef_SemPragma :: ([Name]) ->- T_SemDef-sem_SemDef_SemPragma names_ =- (T_SemDef (let _lhsOpragmaNamesCollect :: ([Name])- _lhsOdefinedInsts :: ([Identifier])- _lhsOorderDepsCollect :: (Set Dependency)- _lhsOruleInfos :: ([RuleInfo])- _lhsOsigInfos :: ([SigInfo] )- -- "Transform.ag"(line 546, column 7)- _lhsOpragmaNamesCollect =- names_- -- use rule "Transform.ag"(line 705, column 55)- _lhsOdefinedInsts =- []- -- use rule "Transform.ag"(line 574, column 44)- _lhsOorderDepsCollect =- Set.empty- -- use rule "Transform.ag"(line 660, column 37)- _lhsOruleInfos =- []- -- use rule "Transform.ag"(line 661, column 37)- _lhsOsigInfos =- []- in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos)))-sem_SemDef_TypeDef :: Identifier ->- Type ->- T_SemDef-sem_SemDef_TypeDef ident_ tp_ =- (T_SemDef (let _lhsOsigInfos :: ([SigInfo] )- _lhsOdefinedInsts :: ([Identifier])- _lhsOorderDepsCollect :: (Set Dependency)- _lhsOpragmaNamesCollect :: ([Name])- _lhsOruleInfos :: ([RuleInfo])- -- "Transform.ag"(line 702, column 14)- _lhsOsigInfos =- [ (ident_, tp_) ]- -- use rule "Transform.ag"(line 705, column 55)- _lhsOdefinedInsts =- []- -- use rule "Transform.ag"(line 574, column 44)- _lhsOorderDepsCollect =- Set.empty- -- use rule "Transform.ag"(line 542, column 46)- _lhsOpragmaNamesCollect =- []- -- use rule "Transform.ag"(line 660, column 37)- _lhsOruleInfos =- []- in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos)))--- SemDefs ------------------------------------------------------{-- visit 0:- synthesized attributes:- definedInsts : [Identifier]- orderDepsCollect : Set Dependency- pragmaNamesCollect : [Name]- ruleInfos : [RuleInfo]- sigInfos : [SigInfo] - alternatives:- alternative Cons:- child hd : SemDef- child tl : SemDefs- alternative Nil:--}--- cata-sem_SemDefs :: SemDefs ->- T_SemDefs-sem_SemDefs list =- (Prelude.foldr sem_SemDefs_Cons sem_SemDefs_Nil (Prelude.map sem_SemDef list))--- semantic domain-newtype T_SemDefs = T_SemDefs (( ([Identifier]),(Set Dependency),([Name]),([RuleInfo]),([SigInfo] )))-data Inh_SemDefs = Inh_SemDefs {}-data Syn_SemDefs = Syn_SemDefs {definedInsts_Syn_SemDefs :: [Identifier],orderDepsCollect_Syn_SemDefs :: Set Dependency,pragmaNamesCollect_Syn_SemDefs :: [Name],ruleInfos_Syn_SemDefs :: [RuleInfo],sigInfos_Syn_SemDefs :: [SigInfo] }-wrap_SemDefs (T_SemDefs sem) (Inh_SemDefs ) =- (let ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos) =- (sem )- in (Syn_SemDefs _lhsOdefinedInsts _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos))-sem_SemDefs_Cons :: T_SemDef ->- T_SemDefs ->- T_SemDefs-sem_SemDefs_Cons (T_SemDef hd_) (T_SemDefs tl_) =- (T_SemDefs (let _lhsOdefinedInsts :: ([Identifier])- _lhsOorderDepsCollect :: (Set Dependency)- _lhsOpragmaNamesCollect :: ([Name])- _lhsOruleInfos :: ([RuleInfo])- _lhsOsigInfos :: ([SigInfo] )- _hdIdefinedInsts :: ([Identifier])- _hdIorderDepsCollect :: (Set Dependency)- _hdIpragmaNamesCollect :: ([Name])- _hdIruleInfos :: ([RuleInfo])- _hdIsigInfos :: ([SigInfo] )- _tlIdefinedInsts :: ([Identifier])- _tlIorderDepsCollect :: (Set Dependency)- _tlIpragmaNamesCollect :: ([Name])- _tlIruleInfos :: ([RuleInfo])- _tlIsigInfos :: ([SigInfo] )- -- use rule "Transform.ag"(line 705, column 55)- _lhsOdefinedInsts =- _hdIdefinedInsts ++ _tlIdefinedInsts- -- use rule "Transform.ag"(line 574, column 44)- _lhsOorderDepsCollect =- _hdIorderDepsCollect `Set.union` _tlIorderDepsCollect- -- use rule "Transform.ag"(line 542, column 46)- _lhsOpragmaNamesCollect =- _hdIpragmaNamesCollect ++ _tlIpragmaNamesCollect- -- use rule "Transform.ag"(line 660, column 37)- _lhsOruleInfos =- _hdIruleInfos ++ _tlIruleInfos- -- use rule "Transform.ag"(line 661, column 37)- _lhsOsigInfos =- _hdIsigInfos ++ _tlIsigInfos- ( _hdIdefinedInsts,_hdIorderDepsCollect,_hdIpragmaNamesCollect,_hdIruleInfos,_hdIsigInfos) =- (hd_ )- ( _tlIdefinedInsts,_tlIorderDepsCollect,_tlIpragmaNamesCollect,_tlIruleInfos,_tlIsigInfos) =- (tl_ )- in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos)))-sem_SemDefs_Nil :: T_SemDefs-sem_SemDefs_Nil =- (T_SemDefs (let _lhsOdefinedInsts :: ([Identifier])- _lhsOorderDepsCollect :: (Set Dependency)- _lhsOpragmaNamesCollect :: ([Name])- _lhsOruleInfos :: ([RuleInfo])- _lhsOsigInfos :: ([SigInfo] )- -- use rule "Transform.ag"(line 705, column 55)- _lhsOdefinedInsts =- []- -- use rule "Transform.ag"(line 574, column 44)- _lhsOorderDepsCollect =- Set.empty- -- use rule "Transform.ag"(line 542, column 46)- _lhsOpragmaNamesCollect =- []- -- use rule "Transform.ag"(line 660, column 37)- _lhsOruleInfos =- []- -- use rule "Transform.ag"(line 661, column 37)+import List (partition, elem, nub)+import Data.Maybe+import qualified Data.Map as Map+import Data.Map (Map)+import Data.Set as Set (Set, member, union, toList, fromList, empty, singleton, member, unions, size, fold, intersection, difference, insert)+import UU.DData.Seq as Seq (Seq, empty, (<>), single, cons, toList, fromList)+import UU.Scanner.Position(noPos)++import ConcreteSyntax+import AbstractSyntax+import ErrorMessages+import Patterns (Patterns(..),Pattern(..))+import Expression (Expression(..))++import Options+import CommonTypes++import UU.Scanner.Position (Pos)+import Patterns (Pattern)+import Expression (Expression)+import CommonTypes++-- Patterns.ag imports+import UU.Scanner.Position(Pos)+import CommonTypes (ConstructorIdent,Identifier)+type DefinedSets = Map Identifier (Set NontermIdent) +type FieldMap = [(Identifier, Type)] +type DataTypes = Map.Map NontermIdent (Map.Map ConstructorIdent FieldMap) +type AttrName = (Identifier,Identifier) +type RuleInfo = ([AttrName]->Pattern, Expression, [AttrName], Bool, String) +type SigInfo = (Identifier,Type) +++checkDuplicate :: (Identifier -> Identifier -> Error)+ -> Identifier -> val -> Map Identifier val -> (Map Identifier val,Seq Error)+checkDuplicate dupError key val m+ = case Map.lookupIndex key m of+ Just ix -> let (key',_) = Map.elemAt ix m+ in (m,Seq.single (dupError key key'))+ Nothing -> (Map.insert key val m,Seq.empty)++checkDuplicates :: (Identifier -> Identifier -> Error)+ -> [(Identifier, val)] -> Map Identifier val -> (Map Identifier val,Seq Error)+checkDuplicates dupError new m = foldErrors check m new+ where check = uncurry (checkDuplicate dupError)++foldErrors f e xs = foldl g (e,Seq.empty) xs+ where g ~(e,es) x = let (e',es') = f x e+ in (e', es <> es')+++checkForDuplicates :: (Identifier -> Identifier -> Error) -> [Identifier] -> [Error]+checkForDuplicates err [] = []+checkForDuplicates err (x:xs) = let (same,other) = List.partition (equalId x) xs+ in map (err x) same ++ checkForDuplicates err other++equalId :: Identifier -> Identifier -> Bool+equalId x y = getName x == getName y+++type RulesAndErrors = ([Rule], Seq Error)+type SigsAndErrors = ([TypeSig], Seq Error)+type InstsAndErrors = ([(Identifier, Type)], Seq Error)+type AttrOverwrite = Map AttrName Bool+type AccumRuleCheck = (RulesAndErrors, AttrOverwrite)+type AccumDefiCheck = (Seq Error, AttrOverwrite, [AttrName], [AttrName])++checkRules :: Map NontermIdent (Attributes, Attributes) -> Map NontermIdent (Map ConstructorIdent FieldMap) ->+ Map NontermIdent (Map ConstructorIdent [Identifier]) -> Map NontermIdent (Map ConstructorIdent [SigInfo]) ->+ NontermIdent -> ConstructorIdent -> [RuleInfo] -> RulesAndErrors+checkRules attributes fields allinsts allsigs nt con rs+ = let fieldmap :: FieldMap+ fieldmap = (_LHS,NT nt undefined) : (_LOC,NT undefined undefined) : (_INST, NT undefined undefined) : (_FIRST, NT undefined undefined) : (_LAST, NT undefined undefined)+ : Map.findWithDefault [] con (Map.findWithDefault Map.empty nt fields)+ ++ mapMaybe (\instNm -> lookup instNm sigs >>= \tp -> return (instNm, tp)) (Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allinsts))+ + sigs = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allsigs)++ hasAttrib f tp attr = Map.member attr (f (Map.findWithDefault (Map.empty,Map.empty) tp attributes))+ + checkRule :: RuleInfo -> AccumRuleCheck -> AccumRuleCheck+ checkRule (pat,exp,as,owrt,str) ((r1,e1),m1) + = let (e2,m2,u2,b2) = foldr (checkDefi owrt) (e1,m1,[],[]) as+ in ( (Rule (pat u2) exp owrt str : r1, e2), m2)++ checkDefi :: Bool -> AttrName -> AccumDefiCheck -> AccumDefiCheck+ checkDefi owrt fa@(field,attr) (e,m,u,bs)+ = case lookup field fieldmap+ of Just (NT tp _) -> if field == _LOC || field == _INST || field == _FIRST || field == _LAST+ || hasAttrib (if getName field==getName _LHS then snd else fst) tp attr+ then case Map.lookupIndex fa m of+ Just ix -> let ((_,attr2),b) = Map.elemAt ix m+ in if b && not (fa `elem` bs)+ then ( e, Map.insert fa owrt m, fa:u, fa:bs)+ else (Seq.cons (DupRule nt con field attr2 attr) e, m, fa:u, bs)+ Nothing -> ( e, Map.insert fa owrt m, u, fa:bs)+ else (Seq.cons (SuperfluousRule nt con field attr) e, m, fa:u, bs)+ _ -> (Seq.cons (UndefChild nt con field) e, m, fa:u, bs )++ in fst (foldr checkRule (([],Seq.empty),Map.empty) rs)++checkSigs :: NontermIdent -> ConstructorIdent -> [SigInfo] -> SigsAndErrors+checkSigs nt con sis + = let checkSig (ide,typ) (sigs,errs)+ = if ide `elem` map (\(TypeSig n t)-> n) sigs+ then (sigs, Seq.cons (DupSig nt con ide) errs)+ -- else if not (ide `elem` locattrdefs)+ -- then (sigs, Seq.cons (SupSig nt con ide) errs)+ else (TypeSig ide typ:sigs, errs)+ in foldr checkSig ([],Seq.empty) sis++checkInsts :: Map NontermIdent (Map ConstructorIdent [SigInfo]) -> NontermIdent -> ConstructorIdent -> [Identifier] -> InstsAndErrors+checkInsts sigMap nt con+ = foldr (\inst (insts, errs) -> maybe (insts, Seq.single (MissingInstSig nt con inst) <> errs)+ (\info -> (info : insts, errs)) $ findSig inst) ([], Seq.empty)+ where+ sigs = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt sigMap)+ + findSig name+ = do tp@(NT _ _) <- lookup name sigs+ return (name, tp)++flattenDatas :: DataTypes -> Map NontermIdent (Set NontermIdent)+flattenDatas ds = Map.map flatten ds+ where flatten cs = Set.fromList [ nt | (_,NT nt _) <- concatMap snd (Map.toList cs)]++reachableFrom :: Map NontermIdent (Set NontermIdent) -> Set NontermIdent -> Set NontermIdent+reachableFrom table nts = reach nts+ where reach nts = let nts' = Set.unions (nts : [ ns | nt <- Set.toList nts+ , let ns = Map.findWithDefault Set.empty nt table ])+ in if Set.size nts' > Set.size nts+ then reach nts'+ else nts+invert :: Map NontermIdent (Set NontermIdent) -> Map NontermIdent (Set NontermIdent)+invert m = foldr inv Map.empty (Map.toList m)+ where inv (x,ns) m = fold (\n m -> Map.insertWith Set.union n (Set.singleton x) m) m ns++path :: Map NontermIdent (Set NontermIdent) -> NontermIdent -> NontermIdent -> Set NontermIdent+path table from to = let children = Map.findWithDefault Set.empty from table+ forward = reachableFrom table children+ backward = reachableFrom (invert table)+ (Set.singleton to)+ in Set.intersection forward backward++pragmaMapUnion :: PragmaMap -> PragmaMap -> PragmaMap+pragmaMapUnion = Map.unionWith (Map.unionWith Set.union)++pragmaMapSingle :: NontermIdent -> ConstructorIdent -> Set Identifier -> PragmaMap+pragmaMapSingle nt con nms = Map.singleton nt (Map.singleton con nms)++orderMapUnion :: AttrOrderMap -> AttrOrderMap -> AttrOrderMap+orderMapUnion = Map.unionWith (Map.unionWith Set.union)++orderMapSingle :: NontermIdent -> ConstructorIdent -> Set Dependency -> AttrOrderMap+orderMapSingle nt con deps = Map.singleton nt (Map.singleton con deps)++mergeParams :: ParamMap -> ParamMap -> ParamMap+mergeParams = Map.unionWith (++)++mergeCtx :: ContextMap -> ContextMap -> ContextMap+mergeCtx+ = Map.unionWith nubconcat+ where nubconcat a b = nub (a ++ b)++mergeDerivings m1 m2 = foldr (\(n,cs) m -> Map.insertWith Set.union n cs m) m2 (Map.toList m1)++merge x y = foldr f y (Map.toList x)+ where f ~(k,v) m = Map.insertWith (Map.union) k v m++checkAttrs allFields nts inherited synthesized decls = foldErrors check decls nts where+ check nt decls | not (nt `Map.member` allFields) = (decls,Seq.single(UndefNont nt))+ | otherwise = let (inh,syn) = Map.findWithDefault (Map.empty,Map.empty) nt decls+ (inh',einh) = checkDuplicates (DupInhAttr nt) inherited inh+ (syn',esyn) = checkDuplicates (DupSynAttr nt) synthesized syn+ in (Map.insert nt (inh',syn') decls,einh <> esyn)++addSelf name atMap = let (eInh,eSyn) = Map.findWithDefault(Map.empty,Map.empty) name atMap+ in Map.insert name (eInh, Map.insert (Ident "self" noPos) (NT _SELF []) eSyn)atMap++makeType :: Set NontermIdent -> Type -> Type+makeType nts tp@(NT x _) | x == _SELF = tp+ | Set.member x nts = tp+ | otherwise = Haskell (typeToHaskellString Nothing [] tp)+makeType _ tp = tp++constructGrammar :: Set NontermIdent+ -> ParamMap+ -> DataTypes+ -> Map NontermIdent (Attributes, Attributes)+ -> Map NontermIdent (Map Identifier (String, String, String))+ -> Derivings+ -> Set NontermIdent+ -> Map NontermIdent (Map ConstructorIdent [Rule])+ -> Map NontermIdent (Map ConstructorIdent [TypeSig])+ -> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)])+ -> TypeSyns+ -> PragmaMap+ -> AttrOrderMap+ -> ContextMap+ -> Grammar++constructGrammar nts ntParams gram attrs uses derivings wrappers allrules tsigs allinsts tsyns pragmaMap orderMap contextMap =+ let gr = [ (nt,Map.toList alts) | (nt,alts) <- Map.toList gram]+ nonts = map nont gr+ nont (nt,alts) = let (inh,syn) = Map.findWithDefault (Map.empty,Map.empty) nt attrs+ rmap = Map.findWithDefault Map.empty nt allrules+ tsmap = Map.findWithDefault Map.empty nt tsigs+ instsmap = Map.findWithDefault Map.empty nt allinsts+ params = Map.findWithDefault [] nt ntParams+ alt (con,flds) =+ let rules = maybe [] id (Map.lookup con rmap)+ tsigs = maybe [] id (Map.lookup con tsmap)+ insts = maybe [] id (Map.lookup con instsmap)+ cldrn = map (child False) flds ++ map (child True) insts+ child isVirtual (nm, tp) =+ let (inh,syn) = case tp of+ NT nt _ -> Map.findWithDefault (Map.empty,Map.empty) nt attrs+ _ -> (Map.empty,Map.empty)+ in Child nm tp inh syn isVirtual+ in Production con cldrn rules tsigs+ in Nonterminal nt params inh syn (map alt alts)+ in Grammar tsyns uses derivings wrappers nonts pragmaMap orderMap ntParams contextMap++mapUnionWithSetUnion = Map.unionWith Set.union+mapUnionWithPlusPlus = Map.unionWith (++)+-- AG ----------------------------------------------------------+{-+ visit 0:+ inherited attribute:+ options : Options+ synthesized attributes:+ blocks : Blocks+ errors : Seq Error+ moduleDecl : Maybe (String,String,String)+ output : Grammar+ pragmas : Options -> Options+ alternatives:+ alternative AG:+ child elems : Elems+ visit 0:+ local allFields : _+ local allConstrs : _+ local allRules : _+ local allSigs : _+ local allInsts : _+ local allRulesErrs : _+ local allSigsErrs : _+ local allInstsErrs : _+ local checkedRules : _+ local checkedSigs : _+ local checkedInsts : _+ local errs1 : _+ local errs2 : _+ local errs3 : _+ local errs4 : _+ local errs5 : _+ local errs6 : _+ local allNonterminals : _+ local allAttrDecls : _+-}+-- cata+sem_AG :: AG ->+ T_AG+sem_AG (AG _elems) =+ (sem_AG_AG (sem_Elems _elems))+-- semantic domain+newtype T_AG = T_AG (Options ->+ ( Blocks,(Seq Error),(Maybe (String,String,String)),Grammar,(Options -> Options)))+data Inh_AG = Inh_AG {options_Inh_AG :: Options}+data Syn_AG = Syn_AG {blocks_Syn_AG :: Blocks,errors_Syn_AG :: Seq Error,moduleDecl_Syn_AG :: Maybe (String,String,String),output_Syn_AG :: Grammar,pragmas_Syn_AG :: Options -> Options}+wrap_AG (T_AG sem) (Inh_AG _lhsIoptions) =+ (let ( _lhsOblocks,_lhsOerrors,_lhsOmoduleDecl,_lhsOoutput,_lhsOpragmas) =+ (sem _lhsIoptions)+ in (Syn_AG _lhsOblocks _lhsOerrors _lhsOmoduleDecl _lhsOoutput _lhsOpragmas))+sem_AG_AG :: T_Elems ->+ T_AG+sem_AG_AG (T_Elems elems_) =+ (T_AG (\ _lhsIoptions ->+ (let _lhsOoutput :: Grammar+ _lhsOerrors :: (Seq Error)+ _elemsOallConstructors :: (Map NontermIdent (Set ConstructorIdent))+ _elemsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))+ _elemsOdefinedSets :: DefinedSets+ _elemsOattrDecls :: (Map NontermIdent (Attributes, Attributes))+ _lhsOblocks :: Blocks+ _lhsOmoduleDecl :: (Maybe (String,String,String))+ _lhsOpragmas :: (Options -> Options)+ _elemsOallAttrDecls :: (Map NontermIdent (Attributes, Attributes))+ _elemsOallFields :: DataTypes+ _elemsOallNonterminals :: (Set NontermIdent)+ _elemsIattrDecls :: (Map NontermIdent (Attributes, Attributes))+ _elemsIattrOrderCollect :: AttrOrderMap+ _elemsIblocks :: Blocks+ _elemsIcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))+ _elemsIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])+ _elemsIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])+ _elemsIcollectedNames :: (Set Identifier)+ _elemsIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])+ _elemsIcollectedSetNames :: (Set Identifier)+ _elemsIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])+ _elemsIctxCollect :: ContextMap+ _elemsIdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))+ _elemsIderivings :: Derivings+ _elemsIerrors :: (Seq Error)+ _elemsImoduleDecl :: (Maybe (String,String,String))+ _elemsIparamsCollect :: ParamMap+ _elemsIpragmas :: (Options -> Options)+ _elemsIsemPragmasCollect :: PragmaMap+ _elemsItypeSyns :: TypeSyns+ _elemsIuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))+ _elemsIwrappers :: (Set NontermIdent)+ -- "Transform.ag"(line 45, column 8)+ _lhsOoutput =+ constructGrammar _allNonterminals+ _elemsIparamsCollect+ _allFields+ _allAttrDecls+ _elemsIuseMap+ _elemsIderivings+ (if wrappers _lhsIoptions then _allNonterminals else _elemsIwrappers)+ _checkedRules+ _checkedSigs+ _checkedInsts+ _elemsItypeSyns+ _elemsIsemPragmasCollect+ _elemsIattrOrderCollect+ _elemsIctxCollect+ -- "Transform.ag"(line 219, column 10)+ _allFields =+ let f (nt,con,fm) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con fm)+ in foldr f (Map.empty) _elemsIcollectedFields+ -- "Transform.ag"(line 222, column 10)+ _allConstrs =+ let f (nt,con,_) = Map.insertWith (++) nt [con]+ in foldr f (Map.empty) _elemsIcollectedFields+ -- "Transform.ag"(line 225, column 10)+ _allRules =+ let f (nt,con,r) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con [r])+ in foldr f (Map.empty) _elemsIcollectedRules+ -- "Transform.ag"(line 228, column 10)+ _allSigs =+ let f (nt,con,t) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con [t])+ in foldr f (Map.empty) _elemsIcollectedSigs+ -- "Transform.ag"(line 231, column 10)+ _allInsts =+ let f (nt,con,is) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con is)+ in foldr f (Map.empty) _elemsIcollectedInsts+ -- "Transform.ag"(line 234, column 10)+ _allRulesErrs =+ Map.mapWithKey (Map.mapWithKey . (checkRules _allAttrDecls _allFields _allInsts _allSigs )) _allRules+ -- "Transform.ag"(line 235, column 10)+ _allSigsErrs =+ Map.mapWithKey (Map.mapWithKey . (checkSigs )) _allSigs+ -- "Transform.ag"(line 236, column 10)+ _allInstsErrs =+ Map.mapWithKey (Map.mapWithKey . (checkInsts _allSigs )) _allInsts+ -- "Transform.ag"(line 238, column 10)+ _checkedRules =+ Map.map (Map.map fst) _allRulesErrs+ -- "Transform.ag"(line 239, column 10)+ _checkedSigs =+ Map.map (Map.map fst) _allSigsErrs+ -- "Transform.ag"(line 240, column 10)+ _checkedInsts =+ Map.map (Map.map fst) _allInstsErrs+ -- "Transform.ag"(line 242, column 10)+ _errs1 =+ let f = checkForDuplicates (DupSynonym)+ in Seq.fromList . f . map fst $ _elemsItypeSyns+ -- "Transform.ag"(line 245, column 10)+ _errs2 =+ let g nt (con,fm) = checkForDuplicates (DupChild nt con) (map fst fm)+ f (nt,cfm) = concat . map (g nt) . Map.toList $ cfm+ in Seq.fromList . concat . map f . Map.toList $ _allFields+ -- "Transform.ag"(line 249, column 10)+ _errs3 =+ let f (nt,cons) = checkForDuplicates (DupAlt nt) cons+ in Seq.empty+ -- "Transform.ag"(line 253, column 10)+ _errs4 =+ let f m s = Map.fold ((<>) . snd) s m+ in Map.fold f Seq.empty _allRulesErrs+ -- "Transform.ag"(line 256, column 10)+ _errs5 =+ let f m s = Map.fold ((<>) . snd) s m+ in Map.fold f Seq.empty _allSigsErrs+ -- "Transform.ag"(line 259, column 10)+ _errs6 =+ let f m s = Map.fold ((<>) . snd) s m+ in Map.fold f Seq.empty _allInstsErrs+ -- "Transform.ag"(line 262, column 10)+ _lhsOerrors =+ _elemsIerrors <> _errs1 <> _errs2 <> _errs3 <> _errs4 <> _errs5 <> _errs6+ -- "Transform.ag"(line 345, column 10)+ _allNonterminals =+ _elemsIcollectedNames `Set.difference` _elemsIcollectedSetNames+ -- "Transform.ag"(line 365, column 8)+ _elemsOallConstructors =+ _elemsIcollectedConstructorsMap+ -- "Transform.ag"(line 419, column 8)+ _elemsOdefSets =+ Map.fromList (map (\x->(x,(Set.singleton x, Set.empty))) (Set.toList _allNonterminals ))+ -- "Transform.ag"(line 420, column 8)+ _elemsOdefinedSets =+ Map.map fst _elemsIdefSets+ -- "Transform.ag"(line 664, column 8)+ _elemsOattrDecls =+ Map.empty+ -- "Transform.ag"(line 703, column 9)+ _allAttrDecls =+ if withSelf _lhsIoptions+ then foldr addSelf _elemsIattrDecls (Set.toList _allNonterminals )+ else _elemsIattrDecls+ -- use rule "Transform.ag"(line 38, column 19)+ _lhsOblocks =+ _elemsIblocks+ -- use rule "Transform.ag"(line 787, column 37)+ _lhsOmoduleDecl =+ _elemsImoduleDecl+ -- use rule "Transform.ag"(line 501, column 34)+ _lhsOpragmas =+ _elemsIpragmas+ -- copy rule (from local)+ _elemsOallAttrDecls =+ _allAttrDecls+ -- copy rule (from local)+ _elemsOallFields =+ _allFields+ -- copy rule (from local)+ _elemsOallNonterminals =+ _allNonterminals+ ( _elemsIattrDecls,_elemsIattrOrderCollect,_elemsIblocks,_elemsIcollectedConstructorsMap,_elemsIcollectedFields,_elemsIcollectedInsts,_elemsIcollectedNames,_elemsIcollectedRules,_elemsIcollectedSetNames,_elemsIcollectedSigs,_elemsIctxCollect,_elemsIdefSets,_elemsIderivings,_elemsIerrors,_elemsImoduleDecl,_elemsIparamsCollect,_elemsIpragmas,_elemsIsemPragmasCollect,_elemsItypeSyns,_elemsIuseMap,_elemsIwrappers) =+ (elems_ _elemsOallAttrDecls _elemsOallConstructors _elemsOallFields _elemsOallNonterminals _elemsOattrDecls _elemsOdefSets _elemsOdefinedSets)+ in ( _lhsOblocks,_lhsOerrors,_lhsOmoduleDecl,_lhsOoutput,_lhsOpragmas))))+-- Alt ---------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allConstructors : Map NontermIdent (Set ConstructorIdent)+ allNonterminals : Set NontermIdent+ nts : Set NontermIdent+ synthesized attributes:+ collectedConstructorNames : Set ConstructorIdent+ collectedFields : [(NontermIdent, ConstructorIdent, FieldMap)]+ alternatives:+ alternative Alt:+ child pos : {Pos}+ child names : ConstructorSet+ child fields : {Fields}+-}+-- cata+sem_Alt :: Alt ->+ T_Alt+sem_Alt (Alt _pos _names _fields) =+ (sem_Alt_Alt _pos (sem_ConstructorSet _names) _fields)+-- semantic domain+newtype T_Alt = T_Alt ((Map NontermIdent (Set ConstructorIdent)) ->+ (Set NontermIdent) ->+ (Set NontermIdent) ->+ ( (Set ConstructorIdent),([(NontermIdent, ConstructorIdent, FieldMap)])))+data Inh_Alt = Inh_Alt {allConstructors_Inh_Alt :: Map NontermIdent (Set ConstructorIdent),allNonterminals_Inh_Alt :: Set NontermIdent,nts_Inh_Alt :: Set NontermIdent}+data Syn_Alt = Syn_Alt {collectedConstructorNames_Syn_Alt :: Set ConstructorIdent,collectedFields_Syn_Alt :: [(NontermIdent, ConstructorIdent, FieldMap)]}+wrap_Alt (T_Alt sem) (Inh_Alt _lhsIallConstructors _lhsIallNonterminals _lhsInts) =+ (let ( _lhsOcollectedConstructorNames,_lhsOcollectedFields) =+ (sem _lhsIallConstructors _lhsIallNonterminals _lhsInts)+ in (Syn_Alt _lhsOcollectedConstructorNames _lhsOcollectedFields))+sem_Alt_Alt :: Pos ->+ T_ConstructorSet ->+ Fields ->+ T_Alt+sem_Alt_Alt pos_ (T_ConstructorSet names_) fields_ =+ (T_Alt (\ _lhsIallConstructors+ _lhsIallNonterminals+ _lhsInts ->+ (let _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])+ _lhsOcollectedConstructorNames :: (Set ConstructorIdent)+ _namesIcollectedConstructorNames :: (Set ConstructorIdent)+ _namesIconstructors :: ((Set ConstructorIdent->Set ConstructorIdent))+ _namesIerrors :: (Seq Error)+ -- "Transform.ag"(line 204, column 10)+ _lhsOcollectedFields =+ let fieldTable =+ [ (attr, makeType _lhsIallNonterminals tp)+ | (attr, tp) <- fields_+ ]+ in [ (nt, con, fieldTable)+ | nt <- Set.toList _lhsInts+ , con <- Set.toList (_namesIconstructors (Map.findWithDefault Set.empty nt _lhsIallConstructors))+ ]+ -- use rule "Transform.ag"(line 82, column 62)+ _lhsOcollectedConstructorNames =+ _namesIcollectedConstructorNames+ ( _namesIcollectedConstructorNames,_namesIconstructors,_namesIerrors) =+ (names_ )+ in ( _lhsOcollectedConstructorNames,_lhsOcollectedFields))))+-- Alts --------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allConstructors : Map NontermIdent (Set ConstructorIdent)+ allNonterminals : Set NontermIdent+ nts : Set NontermIdent+ synthesized attributes:+ collectedConstructorNames : Set ConstructorIdent+ collectedFields : [(NontermIdent, ConstructorIdent, FieldMap)]+ alternatives:+ alternative Cons:+ child hd : Alt+ child tl : Alts+ alternative Nil:+-}+-- cata+sem_Alts :: Alts ->+ T_Alts+sem_Alts list =+ (Prelude.foldr sem_Alts_Cons sem_Alts_Nil (Prelude.map sem_Alt list))+-- semantic domain+newtype T_Alts = T_Alts ((Map NontermIdent (Set ConstructorIdent)) ->+ (Set NontermIdent) ->+ (Set NontermIdent) ->+ ( (Set ConstructorIdent),([(NontermIdent, ConstructorIdent, FieldMap)])))+data Inh_Alts = Inh_Alts {allConstructors_Inh_Alts :: Map NontermIdent (Set ConstructorIdent),allNonterminals_Inh_Alts :: Set NontermIdent,nts_Inh_Alts :: Set NontermIdent}+data Syn_Alts = Syn_Alts {collectedConstructorNames_Syn_Alts :: Set ConstructorIdent,collectedFields_Syn_Alts :: [(NontermIdent, ConstructorIdent, FieldMap)]}+wrap_Alts (T_Alts sem) (Inh_Alts _lhsIallConstructors _lhsIallNonterminals _lhsInts) =+ (let ( _lhsOcollectedConstructorNames,_lhsOcollectedFields) =+ (sem _lhsIallConstructors _lhsIallNonterminals _lhsInts)+ in (Syn_Alts _lhsOcollectedConstructorNames _lhsOcollectedFields))+sem_Alts_Cons :: T_Alt ->+ T_Alts ->+ T_Alts+sem_Alts_Cons (T_Alt hd_) (T_Alts tl_) =+ (T_Alts (\ _lhsIallConstructors+ _lhsIallNonterminals+ _lhsInts ->+ (let _lhsOcollectedConstructorNames :: (Set ConstructorIdent)+ _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])+ _hdOallConstructors :: (Map NontermIdent (Set ConstructorIdent))+ _hdOallNonterminals :: (Set NontermIdent)+ _hdOnts :: (Set NontermIdent)+ _tlOallConstructors :: (Map NontermIdent (Set ConstructorIdent))+ _tlOallNonterminals :: (Set NontermIdent)+ _tlOnts :: (Set NontermIdent)+ _hdIcollectedConstructorNames :: (Set ConstructorIdent)+ _hdIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])+ _tlIcollectedConstructorNames :: (Set ConstructorIdent)+ _tlIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])+ -- use rule "Transform.ag"(line 82, column 62)+ _lhsOcollectedConstructorNames =+ _hdIcollectedConstructorNames `Set.union` _tlIcollectedConstructorNames+ -- use rule "Transform.ag"(line 114, column 28)+ _lhsOcollectedFields =+ _hdIcollectedFields ++ _tlIcollectedFields+ -- copy rule (down)+ _hdOallConstructors =+ _lhsIallConstructors+ -- copy rule (down)+ _hdOallNonterminals =+ _lhsIallNonterminals+ -- copy rule (down)+ _hdOnts =+ _lhsInts+ -- copy rule (down)+ _tlOallConstructors =+ _lhsIallConstructors+ -- copy rule (down)+ _tlOallNonterminals =+ _lhsIallNonterminals+ -- copy rule (down)+ _tlOnts =+ _lhsInts+ ( _hdIcollectedConstructorNames,_hdIcollectedFields) =+ (hd_ _hdOallConstructors _hdOallNonterminals _hdOnts)+ ( _tlIcollectedConstructorNames,_tlIcollectedFields) =+ (tl_ _tlOallConstructors _tlOallNonterminals _tlOnts)+ in ( _lhsOcollectedConstructorNames,_lhsOcollectedFields))))+sem_Alts_Nil :: T_Alts+sem_Alts_Nil =+ (T_Alts (\ _lhsIallConstructors+ _lhsIallNonterminals+ _lhsInts ->+ (let _lhsOcollectedConstructorNames :: (Set ConstructorIdent)+ _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])+ -- use rule "Transform.ag"(line 82, column 62)+ _lhsOcollectedConstructorNames =+ Set.empty+ -- use rule "Transform.ag"(line 114, column 28)+ _lhsOcollectedFields =+ []+ in ( _lhsOcollectedConstructorNames,_lhsOcollectedFields))))+-- Attrs -------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allFields : DataTypes+ allNonterminals : Set NontermIdent+ nts : Set NontermIdent+ chained attribute:+ attrDecls : Map NontermIdent (Attributes, Attributes)+ synthesized attributes:+ errors : Seq Error+ useMap : Map NontermIdent (Map Identifier (String,String,String))+ alternatives:+ alternative Attrs:+ child pos : {Pos}+ child inh : {AttrNames}+ child chn : {AttrNames}+ child syn : {AttrNames}+ visit 0:+ local _tup1 : _+ local attrDecls : _+ local errors : _+ local _tup2 : _+ local inherited : _+ local synthesized : _+ local useMap : _+-}+-- cata+sem_Attrs :: Attrs ->+ T_Attrs+sem_Attrs (Attrs _pos _inh _chn _syn) =+ (sem_Attrs_Attrs _pos _inh _chn _syn)+-- semantic domain+newtype T_Attrs = T_Attrs (DataTypes ->+ (Set NontermIdent) ->+ (Map NontermIdent (Attributes, Attributes)) ->+ (Set NontermIdent) ->+ ( (Map NontermIdent (Attributes, Attributes)),(Seq Error),(Map NontermIdent (Map Identifier (String,String,String)))))+data Inh_Attrs = Inh_Attrs {allFields_Inh_Attrs :: DataTypes,allNonterminals_Inh_Attrs :: Set NontermIdent,attrDecls_Inh_Attrs :: Map NontermIdent (Attributes, Attributes),nts_Inh_Attrs :: Set NontermIdent}+data Syn_Attrs = Syn_Attrs {attrDecls_Syn_Attrs :: Map NontermIdent (Attributes, Attributes),errors_Syn_Attrs :: Seq Error,useMap_Syn_Attrs :: Map NontermIdent (Map Identifier (String,String,String))}+wrap_Attrs (T_Attrs sem) (Inh_Attrs _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsInts) =+ (let ( _lhsOattrDecls,_lhsOerrors,_lhsOuseMap) =+ (sem _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsInts)+ in (Syn_Attrs _lhsOattrDecls _lhsOerrors _lhsOuseMap))+sem_Attrs_Attrs :: Pos ->+ AttrNames ->+ AttrNames ->+ AttrNames ->+ T_Attrs+sem_Attrs_Attrs pos_ inh_ chn_ syn_ =+ (T_Attrs (\ _lhsIallFields+ _lhsIallNonterminals+ _lhsIattrDecls+ _lhsInts ->+ (let _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))+ _lhsOerrors :: (Seq Error)+ _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes))+ -- "Transform.ag"(line 672, column 15)+ __tup1 =+ checkAttrs _lhsIallFields (Set.toList _lhsInts) _inherited _synthesized _lhsIattrDecls+ -- "Transform.ag"(line 672, column 15)+ (_attrDecls,_) =+ __tup1+ -- "Transform.ag"(line 672, column 15)+ (_,_errors) =+ __tup1+ -- "Transform.ag"(line 674, column 15)+ __tup2 =+ let splitAttrs xs = unzip [ ((n,makeType _lhsIallNonterminals t),(n,ud))+ | (n,t,ud) <- xs+ ]+ (inh,_) = splitAttrs inh_+ (chn,uses1) = splitAttrs chn_+ (syn,uses2) = splitAttrs syn_+ isUse (n,(e1,e2,_)) = not (null e1 || null e2)+ in (inh++chn,chn++syn, Map.fromList (Prelude.filter isUse (uses1++uses2)))+ -- "Transform.ag"(line 674, column 15)+ (_inherited,_,_) =+ __tup2+ -- "Transform.ag"(line 674, column 15)+ (_,_synthesized,_) =+ __tup2+ -- "Transform.ag"(line 674, column 15)+ (_,_,_useMap) =+ __tup2+ -- "Transform.ag"(line 682, column 11)+ _lhsOuseMap =+ Map.fromList (zip (Set.toList _lhsInts) (repeat _useMap))+ -- use rule "Transform.ag"(line 36, column 19)+ _lhsOerrors =+ _errors+ -- copy rule (from local)+ _lhsOattrDecls =+ _attrDecls+ in ( _lhsOattrDecls,_lhsOerrors,_lhsOuseMap))))+-- ConstructorSet ----------------------------------------------+{-+ visit 0:+ synthesized attributes:+ collectedConstructorNames : Set ConstructorIdent+ constructors : (Set ConstructorIdent->Set ConstructorIdent)+ errors : Seq Error+ alternatives:+ alternative CAll:+ alternative CDifference:+ child set1 : ConstructorSet+ child set2 : ConstructorSet+ alternative CName:+ child name : {ConstructorIdent}+ alternative CUnion:+ child set1 : ConstructorSet+ child set2 : ConstructorSet+-}+-- cata+sem_ConstructorSet :: ConstructorSet ->+ T_ConstructorSet+sem_ConstructorSet (CAll ) =+ (sem_ConstructorSet_CAll )+sem_ConstructorSet (CDifference _set1 _set2) =+ (sem_ConstructorSet_CDifference (sem_ConstructorSet _set1) (sem_ConstructorSet _set2))+sem_ConstructorSet (CName _name) =+ (sem_ConstructorSet_CName _name)+sem_ConstructorSet (CUnion _set1 _set2) =+ (sem_ConstructorSet_CUnion (sem_ConstructorSet _set1) (sem_ConstructorSet _set2))+-- semantic domain+newtype T_ConstructorSet = T_ConstructorSet (( (Set ConstructorIdent),((Set ConstructorIdent->Set ConstructorIdent)),(Seq Error)))+data Inh_ConstructorSet = Inh_ConstructorSet {}+data Syn_ConstructorSet = Syn_ConstructorSet {collectedConstructorNames_Syn_ConstructorSet :: Set ConstructorIdent,constructors_Syn_ConstructorSet :: (Set ConstructorIdent->Set ConstructorIdent),errors_Syn_ConstructorSet :: Seq Error}+wrap_ConstructorSet (T_ConstructorSet sem) (Inh_ConstructorSet ) =+ (let ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors) =+ (sem )+ in (Syn_ConstructorSet _lhsOcollectedConstructorNames _lhsOconstructors _lhsOerrors))+sem_ConstructorSet_CAll :: T_ConstructorSet+sem_ConstructorSet_CAll =+ (T_ConstructorSet (let _lhsOconstructors :: ((Set ConstructorIdent->Set ConstructorIdent))+ _lhsOcollectedConstructorNames :: (Set ConstructorIdent)+ _lhsOerrors :: (Seq Error)+ -- "Transform.ag"(line 486, column 17)+ _lhsOconstructors =+ \ds -> ds+ -- use rule "Transform.ag"(line 82, column 62)+ _lhsOcollectedConstructorNames =+ Set.empty+ -- use rule "Transform.ag"(line 36, column 19)+ _lhsOerrors =+ Seq.empty+ in ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors)))+sem_ConstructorSet_CDifference :: T_ConstructorSet ->+ T_ConstructorSet ->+ T_ConstructorSet+sem_ConstructorSet_CDifference (T_ConstructorSet set1_) (T_ConstructorSet set2_) =+ (T_ConstructorSet (let _lhsOconstructors :: ((Set ConstructorIdent->Set ConstructorIdent))+ _lhsOcollectedConstructorNames :: (Set ConstructorIdent)+ _lhsOerrors :: (Seq Error)+ _set1IcollectedConstructorNames :: (Set ConstructorIdent)+ _set1Iconstructors :: ((Set ConstructorIdent->Set ConstructorIdent))+ _set1Ierrors :: (Seq Error)+ _set2IcollectedConstructorNames :: (Set ConstructorIdent)+ _set2Iconstructors :: ((Set ConstructorIdent->Set ConstructorIdent))+ _set2Ierrors :: (Seq Error)+ -- "Transform.ag"(line 485, column 17)+ _lhsOconstructors =+ \ds -> _set1Iconstructors ds `Set.difference` _set2Iconstructors ds+ -- use rule "Transform.ag"(line 82, column 62)+ _lhsOcollectedConstructorNames =+ _set1IcollectedConstructorNames `Set.union` _set2IcollectedConstructorNames+ -- use rule "Transform.ag"(line 36, column 19)+ _lhsOerrors =+ _set1Ierrors Seq.<> _set2Ierrors+ ( _set1IcollectedConstructorNames,_set1Iconstructors,_set1Ierrors) =+ (set1_ )+ ( _set2IcollectedConstructorNames,_set2Iconstructors,_set2Ierrors) =+ (set2_ )+ in ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors)))+sem_ConstructorSet_CName :: ConstructorIdent ->+ T_ConstructorSet+sem_ConstructorSet_CName name_ =+ (T_ConstructorSet (let _lhsOcollectedConstructorNames :: (Set ConstructorIdent)+ _lhsOconstructors :: ((Set ConstructorIdent->Set ConstructorIdent))+ _lhsOerrors :: (Seq Error)+ -- "Transform.ag"(line 353, column 11)+ _lhsOcollectedConstructorNames =+ Set.singleton name_+ -- "Transform.ag"(line 483, column 17)+ _lhsOconstructors =+ \ds -> Set.singleton name_+ -- use rule "Transform.ag"(line 36, column 19)+ _lhsOerrors =+ Seq.empty+ in ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors)))+sem_ConstructorSet_CUnion :: T_ConstructorSet ->+ T_ConstructorSet ->+ T_ConstructorSet+sem_ConstructorSet_CUnion (T_ConstructorSet set1_) (T_ConstructorSet set2_) =+ (T_ConstructorSet (let _lhsOconstructors :: ((Set ConstructorIdent->Set ConstructorIdent))+ _lhsOcollectedConstructorNames :: (Set ConstructorIdent)+ _lhsOerrors :: (Seq Error)+ _set1IcollectedConstructorNames :: (Set ConstructorIdent)+ _set1Iconstructors :: ((Set ConstructorIdent->Set ConstructorIdent))+ _set1Ierrors :: (Seq Error)+ _set2IcollectedConstructorNames :: (Set ConstructorIdent)+ _set2Iconstructors :: ((Set ConstructorIdent->Set ConstructorIdent))+ _set2Ierrors :: (Seq Error)+ -- "Transform.ag"(line 484, column 17)+ _lhsOconstructors =+ \ds -> _set1Iconstructors ds `Set.union` _set2Iconstructors ds+ -- use rule "Transform.ag"(line 82, column 62)+ _lhsOcollectedConstructorNames =+ _set1IcollectedConstructorNames `Set.union` _set2IcollectedConstructorNames+ -- use rule "Transform.ag"(line 36, column 19)+ _lhsOerrors =+ _set1Ierrors Seq.<> _set2Ierrors+ ( _set1IcollectedConstructorNames,_set1Iconstructors,_set1Ierrors) =+ (set1_ )+ ( _set2IcollectedConstructorNames,_set2Iconstructors,_set2Ierrors) =+ (set2_ )+ in ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors)))+-- Elem --------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allAttrDecls : Map NontermIdent (Attributes, Attributes)+ allConstructors : Map NontermIdent (Set ConstructorIdent)+ allFields : DataTypes+ allNonterminals : Set NontermIdent+ definedSets : DefinedSets+ chained attributes:+ attrDecls : Map NontermIdent (Attributes, Attributes)+ defSets : Map Identifier (Set NontermIdent,Set Identifier)+ synthesized attributes:+ attrOrderCollect : AttrOrderMap+ blocks : Blocks+ collectedConstructorsMap : Map NontermIdent (Set ConstructorIdent)+ collectedFields : [(NontermIdent, ConstructorIdent, FieldMap)]+ collectedInsts : [ (NontermIdent, ConstructorIdent, [Identifier]) ]+ collectedNames : Set Identifier+ collectedRules : [ (NontermIdent, ConstructorIdent, RuleInfo)]+ collectedSetNames : Set Identifier+ collectedSigs : [ (NontermIdent, ConstructorIdent, SigInfo) ]+ ctxCollect : ContextMap+ derivings : Derivings+ errors : Seq Error+ moduleDecl : Maybe (String,String,String)+ paramsCollect : ParamMap+ pragmas : Options -> Options+ semPragmasCollect : PragmaMap+ typeSyns : TypeSyns+ useMap : Map NontermIdent (Map Identifier (String,String,String))+ wrappers : Set NontermIdent+ alternatives:+ alternative Attr:+ child pos : {Pos}+ child ctx : {ClassContext}+ child names : NontSet+ child attrs : Attrs+ alternative Data:+ child pos : {Pos}+ child ctx : {ClassContext}+ child names : NontSet+ child params : {[Identifier]}+ child attrs : Attrs+ child alts : Alts+ child ext : {Bool}+ alternative Deriving:+ child pos : {Pos}+ child set : NontSet+ child classes : {[NontermIdent]}+ alternative Module:+ child pos : {Pos}+ child name : {String}+ child exports : {String}+ child imports : {String}+ alternative Pragma:+ child pos : {Pos}+ child names : {[NontermIdent]}+ alternative Sem:+ child pos : {Pos}+ child ctx : {ClassContext}+ child names : NontSet+ child attrs : Attrs+ child alts : SemAlts+ alternative Set:+ child pos : {Pos}+ child name : {NontermIdent}+ child set : NontSet+ visit 0:+ local _tup3 : _+ local defSets2 : _+ local errs : _+ alternative Txt:+ child pos : {Pos}+ child name : {NontermIdent}+ child lines : {[String]}+ alternative Type:+ child pos : {Pos}+ child ctx : {ClassContext}+ child name : {NontermIdent}+ child params : {[Identifier]}+ child type : {ComplexType}+ visit 0:+ local expanded : _+ local argType : _+ alternative Wrapper:+ child pos : {Pos}+ child set : NontSet+-}+-- cata+sem_Elem :: Elem ->+ T_Elem+sem_Elem (Attr _pos _ctx _names _attrs) =+ (sem_Elem_Attr _pos _ctx (sem_NontSet _names) (sem_Attrs _attrs))+sem_Elem (Data _pos _ctx _names _params _attrs _alts _ext) =+ (sem_Elem_Data _pos _ctx (sem_NontSet _names) _params (sem_Attrs _attrs) (sem_Alts _alts) _ext)+sem_Elem (Deriving _pos _set _classes) =+ (sem_Elem_Deriving _pos (sem_NontSet _set) _classes)+sem_Elem (Module _pos _name _exports _imports) =+ (sem_Elem_Module _pos _name _exports _imports)+sem_Elem (Pragma _pos _names) =+ (sem_Elem_Pragma _pos _names)+sem_Elem (Sem _pos _ctx _names _attrs _alts) =+ (sem_Elem_Sem _pos _ctx (sem_NontSet _names) (sem_Attrs _attrs) (sem_SemAlts _alts))+sem_Elem (Set _pos _name _set) =+ (sem_Elem_Set _pos _name (sem_NontSet _set))+sem_Elem (Txt _pos _name _lines) =+ (sem_Elem_Txt _pos _name _lines)+sem_Elem (Type _pos _ctx _name _params _type) =+ (sem_Elem_Type _pos _ctx _name _params _type)+sem_Elem (Wrapper _pos _set) =+ (sem_Elem_Wrapper _pos (sem_NontSet _set))+-- semantic domain+newtype T_Elem = T_Elem ((Map NontermIdent (Attributes, Attributes)) ->+ (Map NontermIdent (Set ConstructorIdent)) ->+ DataTypes ->+ (Set NontermIdent) ->+ (Map NontermIdent (Attributes, Attributes)) ->+ (Map Identifier (Set NontermIdent,Set Identifier)) ->+ DefinedSets ->+ ( (Map NontermIdent (Attributes, Attributes)),AttrOrderMap,Blocks,(Map NontermIdent (Set ConstructorIdent)),([(NontermIdent, ConstructorIdent, FieldMap)]),([ (NontermIdent, ConstructorIdent, [Identifier]) ]),(Set Identifier),([ (NontermIdent, ConstructorIdent, RuleInfo)]),(Set Identifier),([ (NontermIdent, ConstructorIdent, SigInfo) ]),ContextMap,(Map Identifier (Set NontermIdent,Set Identifier)),Derivings,(Seq Error),(Maybe (String,String,String)),ParamMap,(Options -> Options),PragmaMap,TypeSyns,(Map NontermIdent (Map Identifier (String,String,String))),(Set NontermIdent)))+data Inh_Elem = Inh_Elem {allAttrDecls_Inh_Elem :: Map NontermIdent (Attributes, Attributes),allConstructors_Inh_Elem :: Map NontermIdent (Set ConstructorIdent),allFields_Inh_Elem :: DataTypes,allNonterminals_Inh_Elem :: Set NontermIdent,attrDecls_Inh_Elem :: Map NontermIdent (Attributes, Attributes),defSets_Inh_Elem :: Map Identifier (Set NontermIdent,Set Identifier),definedSets_Inh_Elem :: DefinedSets}+data Syn_Elem = Syn_Elem {attrDecls_Syn_Elem :: Map NontermIdent (Attributes, Attributes),attrOrderCollect_Syn_Elem :: AttrOrderMap,blocks_Syn_Elem :: Blocks,collectedConstructorsMap_Syn_Elem :: Map NontermIdent (Set ConstructorIdent),collectedFields_Syn_Elem :: [(NontermIdent, ConstructorIdent, FieldMap)],collectedInsts_Syn_Elem :: [ (NontermIdent, ConstructorIdent, [Identifier]) ],collectedNames_Syn_Elem :: Set Identifier,collectedRules_Syn_Elem :: [ (NontermIdent, ConstructorIdent, RuleInfo)],collectedSetNames_Syn_Elem :: Set Identifier,collectedSigs_Syn_Elem :: [ (NontermIdent, ConstructorIdent, SigInfo) ],ctxCollect_Syn_Elem :: ContextMap,defSets_Syn_Elem :: Map Identifier (Set NontermIdent,Set Identifier),derivings_Syn_Elem :: Derivings,errors_Syn_Elem :: Seq Error,moduleDecl_Syn_Elem :: Maybe (String,String,String),paramsCollect_Syn_Elem :: ParamMap,pragmas_Syn_Elem :: Options -> Options,semPragmasCollect_Syn_Elem :: PragmaMap,typeSyns_Syn_Elem :: TypeSyns,useMap_Syn_Elem :: Map NontermIdent (Map Identifier (String,String,String)),wrappers_Syn_Elem :: Set NontermIdent}+wrap_Elem (T_Elem sem) (Inh_Elem _lhsIallAttrDecls _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIdefSets _lhsIdefinedSets) =+ (let ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers) =+ (sem _lhsIallAttrDecls _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIdefSets _lhsIdefinedSets)+ in (Syn_Elem _lhsOattrDecls _lhsOattrOrderCollect _lhsOblocks _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOctxCollect _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOparamsCollect _lhsOpragmas _lhsOsemPragmasCollect _lhsOtypeSyns _lhsOuseMap _lhsOwrappers))+sem_Elem_Attr :: Pos ->+ ClassContext ->+ T_NontSet ->+ T_Attrs ->+ T_Elem+sem_Elem_Attr pos_ ctx_ (T_NontSet names_) (T_Attrs attrs_) =+ (T_Elem (\ _lhsIallAttrDecls+ _lhsIallConstructors+ _lhsIallFields+ _lhsIallNonterminals+ _lhsIattrDecls+ _lhsIdefSets+ _lhsIdefinedSets ->+ (let _lhsOctxCollect :: ContextMap+ _attrsOnts :: (Set NontermIdent)+ _lhsOattrOrderCollect :: AttrOrderMap+ _lhsOblocks :: Blocks+ _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))+ _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])+ _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])+ _lhsOcollectedNames :: (Set Identifier)+ _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])+ _lhsOcollectedSetNames :: (Set Identifier)+ _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])+ _lhsOderivings :: Derivings+ _lhsOerrors :: (Seq Error)+ _lhsOmoduleDecl :: (Maybe (String,String,String))+ _lhsOparamsCollect :: ParamMap+ _lhsOpragmas :: (Options -> Options)+ _lhsOsemPragmasCollect :: PragmaMap+ _lhsOtypeSyns :: TypeSyns+ _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))+ _lhsOwrappers :: (Set NontermIdent)+ _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes))+ _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))+ _namesOallFields :: DataTypes+ _namesOallNonterminals :: (Set NontermIdent)+ _namesOdefinedSets :: DefinedSets+ _attrsOallFields :: DataTypes+ _attrsOallNonterminals :: (Set NontermIdent)+ _attrsOattrDecls :: (Map NontermIdent (Attributes, Attributes))+ _namesIcollectedNames :: (Set Identifier)+ _namesIerrors :: (Seq Error)+ _namesInontSet :: (Set NontermIdent)+ _attrsIattrDecls :: (Map NontermIdent (Attributes, Attributes))+ _attrsIerrors :: (Seq Error)+ _attrsIuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))+ -- "Transform.ag"(line 624, column 7)+ _lhsOctxCollect =+ if null ctx_+ then Map.empty+ else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet]+ -- "Transform.ag"(line 668, column 10)+ _attrsOnts =+ _namesInontSet+ -- use rule "Transform.ag"(line 565, column 55)+ _lhsOattrOrderCollect =+ Map.empty+ -- use rule "Transform.ag"(line 38, column 19)+ _lhsOblocks =+ Map.empty+ -- use rule "Transform.ag"(line 83, column 48)+ _lhsOcollectedConstructorsMap =+ Map.empty+ -- use rule "Transform.ag"(line 114, column 28)+ _lhsOcollectedFields =+ []+ -- use rule "Transform.ag"(line 138, column 29)+ _lhsOcollectedInsts =+ []+ -- use rule "Transform.ag"(line 75, column 50)+ _lhsOcollectedNames =+ _namesIcollectedNames+ -- use rule "Transform.ag"(line 136, column 29)+ _lhsOcollectedRules =+ []+ -- use rule "Transform.ag"(line 74, column 50)+ _lhsOcollectedSetNames =+ Set.empty+ -- use rule "Transform.ag"(line 137, column 29)+ _lhsOcollectedSigs =+ []+ -- use rule "Transform.ag"(line 645, column 33)+ _lhsOderivings =+ Map.empty+ -- use rule "Transform.ag"(line 36, column 19)+ _lhsOerrors =+ _namesIerrors Seq.<> _attrsIerrors+ -- use rule "Transform.ag"(line 787, column 37)+ _lhsOmoduleDecl =+ mzero+ -- use rule "Transform.ag"(line 597, column 37)+ _lhsOparamsCollect =+ Map.empty+ -- use rule "Transform.ag"(line 501, column 34)+ _lhsOpragmas =+ id+ -- use rule "Transform.ag"(line 537, column 56)+ _lhsOsemPragmasCollect =+ Map.empty+ -- use rule "Transform.ag"(line 380, column 32)+ _lhsOtypeSyns =+ []+ -- use rule "Transform.ag"(line 126, column 15)+ _lhsOuseMap =+ _attrsIuseMap+ -- use rule "Transform.ag"(line 492, column 32)+ _lhsOwrappers =+ Set.empty+ -- copy rule (up)+ _lhsOattrDecls =+ _attrsIattrDecls+ -- copy rule (chain)+ _lhsOdefSets =+ _lhsIdefSets+ -- copy rule (down)+ _namesOallFields =+ _lhsIallFields+ -- copy rule (down)+ _namesOallNonterminals =+ _lhsIallNonterminals+ -- copy rule (down)+ _namesOdefinedSets =+ _lhsIdefinedSets+ -- copy rule (down)+ _attrsOallFields =+ _lhsIallFields+ -- copy rule (down)+ _attrsOallNonterminals =+ _lhsIallNonterminals+ -- copy rule (down)+ _attrsOattrDecls =+ _lhsIattrDecls+ ( _namesIcollectedNames,_namesIerrors,_namesInontSet) =+ (names_ _namesOallFields _namesOallNonterminals _namesOdefinedSets)+ ( _attrsIattrDecls,_attrsIerrors,_attrsIuseMap) =+ (attrs_ _attrsOallFields _attrsOallNonterminals _attrsOattrDecls _attrsOnts)+ in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))+sem_Elem_Data :: Pos ->+ ClassContext ->+ T_NontSet ->+ ([Identifier]) ->+ T_Attrs ->+ T_Alts ->+ Bool ->+ T_Elem+sem_Elem_Data pos_ ctx_ (T_NontSet names_) params_ (T_Attrs attrs_) (T_Alts alts_) ext_ =+ (T_Elem (\ _lhsIallAttrDecls+ _lhsIallConstructors+ _lhsIallFields+ _lhsIallNonterminals+ _lhsIattrDecls+ _lhsIdefSets+ _lhsIdefinedSets ->+ (let _altsOnts :: (Set NontermIdent)+ _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))+ _lhsOparamsCollect :: ParamMap+ _lhsOctxCollect :: ContextMap+ _attrsOnts :: (Set NontermIdent)+ _lhsOattrOrderCollect :: AttrOrderMap+ _lhsOblocks :: Blocks+ _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])+ _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])+ _lhsOcollectedNames :: (Set Identifier)+ _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])+ _lhsOcollectedSetNames :: (Set Identifier)+ _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])+ _lhsOderivings :: Derivings+ _lhsOerrors :: (Seq Error)+ _lhsOmoduleDecl :: (Maybe (String,String,String))+ _lhsOpragmas :: (Options -> Options)+ _lhsOsemPragmasCollect :: PragmaMap+ _lhsOtypeSyns :: TypeSyns+ _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))+ _lhsOwrappers :: (Set NontermIdent)+ _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes))+ _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))+ _namesOallFields :: DataTypes+ _namesOallNonterminals :: (Set NontermIdent)+ _namesOdefinedSets :: DefinedSets+ _attrsOallFields :: DataTypes+ _attrsOallNonterminals :: (Set NontermIdent)+ _attrsOattrDecls :: (Map NontermIdent (Attributes, Attributes))+ _altsOallConstructors :: (Map NontermIdent (Set ConstructorIdent))+ _altsOallNonterminals :: (Set NontermIdent)+ _namesIcollectedNames :: (Set Identifier)+ _namesIerrors :: (Seq Error)+ _namesInontSet :: (Set NontermIdent)+ _attrsIattrDecls :: (Map NontermIdent (Attributes, Attributes))+ _attrsIerrors :: (Seq Error)+ _attrsIuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))+ _altsIcollectedConstructorNames :: (Set ConstructorIdent)+ _altsIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])+ -- "Transform.ag"(line 151, column 10)+ _altsOnts =+ _namesInontSet+ -- "Transform.ag"(line 359, column 11)+ _lhsOcollectedConstructorsMap =+ Map.fromList+ [ (n, _altsIcollectedConstructorNames)+ | n <- Set.toList _namesInontSet+ ]+ -- "Transform.ag"(line 601, column 7)+ _lhsOparamsCollect =+ if null params_+ then Map.empty+ else Map.fromList [(nt, params_) | nt <- Set.toList _namesInontSet]+ -- "Transform.ag"(line 624, column 7)+ _lhsOctxCollect =+ if null ctx_+ then Map.empty+ else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet]+ -- "Transform.ag"(line 667, column 10)+ _attrsOnts =+ _namesInontSet+ -- use rule "Transform.ag"(line 565, column 55)+ _lhsOattrOrderCollect =+ Map.empty+ -- use rule "Transform.ag"(line 38, column 19)+ _lhsOblocks =+ Map.empty+ -- use rule "Transform.ag"(line 114, column 28)+ _lhsOcollectedFields =+ _altsIcollectedFields+ -- use rule "Transform.ag"(line 138, column 29)+ _lhsOcollectedInsts =+ []+ -- use rule "Transform.ag"(line 75, column 50)+ _lhsOcollectedNames =+ _namesIcollectedNames+ -- use rule "Transform.ag"(line 136, column 29)+ _lhsOcollectedRules =+ []+ -- use rule "Transform.ag"(line 74, column 50)+ _lhsOcollectedSetNames =+ Set.empty+ -- use rule "Transform.ag"(line 137, column 29)+ _lhsOcollectedSigs =+ []+ -- use rule "Transform.ag"(line 645, column 33)+ _lhsOderivings =+ Map.empty+ -- use rule "Transform.ag"(line 36, column 19)+ _lhsOerrors =+ _namesIerrors Seq.<> _attrsIerrors+ -- use rule "Transform.ag"(line 787, column 37)+ _lhsOmoduleDecl =+ mzero+ -- use rule "Transform.ag"(line 501, column 34)+ _lhsOpragmas =+ id+ -- use rule "Transform.ag"(line 537, column 56)+ _lhsOsemPragmasCollect =+ Map.empty+ -- use rule "Transform.ag"(line 380, column 32)+ _lhsOtypeSyns =+ []+ -- use rule "Transform.ag"(line 126, column 15)+ _lhsOuseMap =+ _attrsIuseMap+ -- use rule "Transform.ag"(line 492, column 32)+ _lhsOwrappers =+ Set.empty+ -- copy rule (up)+ _lhsOattrDecls =+ _attrsIattrDecls+ -- copy rule (chain)+ _lhsOdefSets =+ _lhsIdefSets+ -- copy rule (down)+ _namesOallFields =+ _lhsIallFields+ -- copy rule (down)+ _namesOallNonterminals =+ _lhsIallNonterminals+ -- copy rule (down)+ _namesOdefinedSets =+ _lhsIdefinedSets+ -- copy rule (down)+ _attrsOallFields =+ _lhsIallFields+ -- copy rule (down)+ _attrsOallNonterminals =+ _lhsIallNonterminals+ -- copy rule (down)+ _attrsOattrDecls =+ _lhsIattrDecls+ -- copy rule (down)+ _altsOallConstructors =+ _lhsIallConstructors+ -- copy rule (down)+ _altsOallNonterminals =+ _lhsIallNonterminals+ ( _namesIcollectedNames,_namesIerrors,_namesInontSet) =+ (names_ _namesOallFields _namesOallNonterminals _namesOdefinedSets)+ ( _attrsIattrDecls,_attrsIerrors,_attrsIuseMap) =+ (attrs_ _attrsOallFields _attrsOallNonterminals _attrsOattrDecls _attrsOnts)+ ( _altsIcollectedConstructorNames,_altsIcollectedFields) =+ (alts_ _altsOallConstructors _altsOallNonterminals _altsOnts)+ in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))+sem_Elem_Deriving :: Pos ->+ T_NontSet ->+ ([NontermIdent]) ->+ T_Elem+sem_Elem_Deriving pos_ (T_NontSet set_) classes_ =+ (T_Elem (\ _lhsIallAttrDecls+ _lhsIallConstructors+ _lhsIallFields+ _lhsIallNonterminals+ _lhsIattrDecls+ _lhsIdefSets+ _lhsIdefinedSets ->+ (let _lhsOderivings :: Derivings+ _lhsOattrOrderCollect :: AttrOrderMap+ _lhsOblocks :: Blocks+ _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))+ _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])+ _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])+ _lhsOcollectedNames :: (Set Identifier)+ _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])+ _lhsOcollectedSetNames :: (Set Identifier)+ _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])+ _lhsOctxCollect :: ContextMap+ _lhsOerrors :: (Seq Error)+ _lhsOmoduleDecl :: (Maybe (String,String,String))+ _lhsOparamsCollect :: ParamMap+ _lhsOpragmas :: (Options -> Options)+ _lhsOsemPragmasCollect :: PragmaMap+ _lhsOtypeSyns :: TypeSyns+ _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))+ _lhsOwrappers :: (Set NontermIdent)+ _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes))+ _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))+ _setOallFields :: DataTypes+ _setOallNonterminals :: (Set NontermIdent)+ _setOdefinedSets :: DefinedSets+ _setIcollectedNames :: (Set Identifier)+ _setIerrors :: (Seq Error)+ _setInontSet :: (Set NontermIdent)+ -- "Transform.ag"(line 652, column 14)+ _lhsOderivings =+ Map.fromList [(nt,Set.fromList classes_) | nt <- Set.toList _setInontSet]+ -- use rule "Transform.ag"(line 565, column 55)+ _lhsOattrOrderCollect =+ Map.empty+ -- use rule "Transform.ag"(line 38, column 19)+ _lhsOblocks =+ Map.empty+ -- use rule "Transform.ag"(line 83, column 48)+ _lhsOcollectedConstructorsMap =+ Map.empty+ -- use rule "Transform.ag"(line 114, column 28)+ _lhsOcollectedFields =+ []+ -- use rule "Transform.ag"(line 138, column 29)+ _lhsOcollectedInsts =+ []+ -- use rule "Transform.ag"(line 75, column 50)+ _lhsOcollectedNames =+ _setIcollectedNames+ -- use rule "Transform.ag"(line 136, column 29)+ _lhsOcollectedRules =+ []+ -- use rule "Transform.ag"(line 74, column 50)+ _lhsOcollectedSetNames =+ Set.empty+ -- use rule "Transform.ag"(line 137, column 29)+ _lhsOcollectedSigs =+ []+ -- use rule "Transform.ag"(line 620, column 34)+ _lhsOctxCollect =+ Map.empty+ -- use rule "Transform.ag"(line 36, column 19)+ _lhsOerrors =+ _setIerrors+ -- use rule "Transform.ag"(line 787, column 37)+ _lhsOmoduleDecl =+ mzero+ -- use rule "Transform.ag"(line 597, column 37)+ _lhsOparamsCollect =+ Map.empty+ -- use rule "Transform.ag"(line 501, column 34)+ _lhsOpragmas =+ id+ -- use rule "Transform.ag"(line 537, column 56)+ _lhsOsemPragmasCollect =+ Map.empty+ -- use rule "Transform.ag"(line 380, column 32)+ _lhsOtypeSyns =+ []+ -- use rule "Transform.ag"(line 126, column 15)+ _lhsOuseMap =+ Map.empty+ -- use rule "Transform.ag"(line 492, column 32)+ _lhsOwrappers =+ Set.empty+ -- copy rule (chain)+ _lhsOattrDecls =+ _lhsIattrDecls+ -- copy rule (chain)+ _lhsOdefSets =+ _lhsIdefSets+ -- copy rule (down)+ _setOallFields =+ _lhsIallFields+ -- copy rule (down)+ _setOallNonterminals =+ _lhsIallNonterminals+ -- copy rule (down)+ _setOdefinedSets =+ _lhsIdefinedSets+ ( _setIcollectedNames,_setIerrors,_setInontSet) =+ (set_ _setOallFields _setOallNonterminals _setOdefinedSets)+ in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))+sem_Elem_Module :: Pos ->+ String ->+ String ->+ String ->+ T_Elem+sem_Elem_Module pos_ name_ exports_ imports_ =+ (T_Elem (\ _lhsIallAttrDecls+ _lhsIallConstructors+ _lhsIallFields+ _lhsIallNonterminals+ _lhsIattrDecls+ _lhsIdefSets+ _lhsIdefinedSets ->+ (let _lhsOmoduleDecl :: (Maybe (String,String,String))+ _lhsOattrOrderCollect :: AttrOrderMap+ _lhsOblocks :: Blocks+ _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))+ _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])+ _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])+ _lhsOcollectedNames :: (Set Identifier)+ _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])+ _lhsOcollectedSetNames :: (Set Identifier)+ _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])+ _lhsOctxCollect :: ContextMap+ _lhsOderivings :: Derivings+ _lhsOerrors :: (Seq Error)+ _lhsOparamsCollect :: ParamMap+ _lhsOpragmas :: (Options -> Options)+ _lhsOsemPragmasCollect :: PragmaMap+ _lhsOtypeSyns :: TypeSyns+ _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))+ _lhsOwrappers :: (Set NontermIdent)+ _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes))+ _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))+ -- "Transform.ag"(line 791, column 7)+ _lhsOmoduleDecl =+ Just (name_, exports_, imports_)+ -- use rule "Transform.ag"(line 565, column 55)+ _lhsOattrOrderCollect =+ Map.empty+ -- use rule "Transform.ag"(line 38, column 19)+ _lhsOblocks =+ Map.empty+ -- use rule "Transform.ag"(line 83, column 48)+ _lhsOcollectedConstructorsMap =+ Map.empty+ -- use rule "Transform.ag"(line 114, column 28)+ _lhsOcollectedFields =+ []+ -- use rule "Transform.ag"(line 138, column 29)+ _lhsOcollectedInsts =+ []+ -- use rule "Transform.ag"(line 75, column 50)+ _lhsOcollectedNames =+ Set.empty+ -- use rule "Transform.ag"(line 136, column 29)+ _lhsOcollectedRules =+ []+ -- use rule "Transform.ag"(line 74, column 50)+ _lhsOcollectedSetNames =+ Set.empty+ -- use rule "Transform.ag"(line 137, column 29)+ _lhsOcollectedSigs =+ []+ -- use rule "Transform.ag"(line 620, column 34)+ _lhsOctxCollect =+ Map.empty+ -- use rule "Transform.ag"(line 645, column 33)+ _lhsOderivings =+ Map.empty+ -- use rule "Transform.ag"(line 36, column 19)+ _lhsOerrors =+ Seq.empty+ -- use rule "Transform.ag"(line 597, column 37)+ _lhsOparamsCollect =+ Map.empty+ -- use rule "Transform.ag"(line 501, column 34)+ _lhsOpragmas =+ id+ -- use rule "Transform.ag"(line 537, column 56)+ _lhsOsemPragmasCollect =+ Map.empty+ -- use rule "Transform.ag"(line 380, column 32)+ _lhsOtypeSyns =+ []+ -- use rule "Transform.ag"(line 126, column 15)+ _lhsOuseMap =+ Map.empty+ -- use rule "Transform.ag"(line 492, column 32)+ _lhsOwrappers =+ Set.empty+ -- copy rule (chain)+ _lhsOattrDecls =+ _lhsIattrDecls+ -- copy rule (chain)+ _lhsOdefSets =+ _lhsIdefSets+ in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))+sem_Elem_Pragma :: Pos ->+ ([NontermIdent]) ->+ T_Elem+sem_Elem_Pragma pos_ names_ =+ (T_Elem (\ _lhsIallAttrDecls+ _lhsIallConstructors+ _lhsIallFields+ _lhsIallNonterminals+ _lhsIattrDecls+ _lhsIdefSets+ _lhsIdefinedSets ->+ (let _lhsOpragmas :: (Options -> Options)+ _lhsOattrOrderCollect :: AttrOrderMap+ _lhsOblocks :: Blocks+ _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))+ _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])+ _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])+ _lhsOcollectedNames :: (Set Identifier)+ _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])+ _lhsOcollectedSetNames :: (Set Identifier)+ _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])+ _lhsOctxCollect :: ContextMap+ _lhsOderivings :: Derivings+ _lhsOerrors :: (Seq Error)+ _lhsOmoduleDecl :: (Maybe (String,String,String))+ _lhsOparamsCollect :: ParamMap+ _lhsOsemPragmasCollect :: PragmaMap+ _lhsOtypeSyns :: TypeSyns+ _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))+ _lhsOwrappers :: (Set NontermIdent)+ _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes))+ _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))+ -- "Transform.ag"(line 504, column 13)+ _lhsOpragmas =+ let mk n o = case getName n of+ "nocycle" -> o { withCycle = False }+ "cycle" -> o { withCycle = True }+ "nostrictdata" -> o { strictData = False }+ "strictdata" -> o { strictData = True }+ "nostrictcase" -> o { strictCases = False }+ "strictcase" -> o { strictCases = True }+ "strictercase" -> o { strictCases = True, stricterCases = True }+ "nostrictwrap" -> o { strictWrap = False }+ "strictwrap" -> o { strictWrap = True }+ "novisit" -> o { visit = False }+ "visit" -> o { visit = True }+ "nocase" -> o { cases = False }+ "case" -> o { cases = True }+ "noseq" -> o { withSeq = False }+ "seq" -> o { withSeq = True }+ "nounbox" -> o { unbox = False }+ "unbox" -> o { unbox = True }+ "bangpats" -> o { bangpats = True }+ "nooptimize" -> o { cases = False , visit = False }+ "optimize" -> o { cases = True , visit = True }+ "strictsem" -> o { strictSems = True }+ "gentraces" -> o { genTraces = True }+ "genusetraces" -> o { genUseTraces = True }+ "splitsems" -> o { splitSems = True }+ "gencostcentres" -> o { genCostCentres = True }+ "sepsemmods" -> o { sepSemMods = True }+ "genlinepragmas" -> o { genLinePragmas = True }+ "newtypes" -> o { newtypes = True }+ "nonewtypes" -> o { newtypes = False }+ _ -> o+ in \o -> foldr mk o names_+ -- use rule "Transform.ag"(line 565, column 55)+ _lhsOattrOrderCollect =+ Map.empty+ -- use rule "Transform.ag"(line 38, column 19)+ _lhsOblocks =+ Map.empty+ -- use rule "Transform.ag"(line 83, column 48)+ _lhsOcollectedConstructorsMap =+ Map.empty+ -- use rule "Transform.ag"(line 114, column 28)+ _lhsOcollectedFields =+ []+ -- use rule "Transform.ag"(line 138, column 29)+ _lhsOcollectedInsts =+ []+ -- use rule "Transform.ag"(line 75, column 50)+ _lhsOcollectedNames =+ Set.empty+ -- use rule "Transform.ag"(line 136, column 29)+ _lhsOcollectedRules =+ []+ -- use rule "Transform.ag"(line 74, column 50)+ _lhsOcollectedSetNames =+ Set.empty+ -- use rule "Transform.ag"(line 137, column 29)+ _lhsOcollectedSigs =+ []+ -- use rule "Transform.ag"(line 620, column 34)+ _lhsOctxCollect =+ Map.empty+ -- use rule "Transform.ag"(line 645, column 33)+ _lhsOderivings =+ Map.empty+ -- use rule "Transform.ag"(line 36, column 19)+ _lhsOerrors =+ Seq.empty+ -- use rule "Transform.ag"(line 787, column 37)+ _lhsOmoduleDecl =+ mzero+ -- use rule "Transform.ag"(line 597, column 37)+ _lhsOparamsCollect =+ Map.empty+ -- use rule "Transform.ag"(line 537, column 56)+ _lhsOsemPragmasCollect =+ Map.empty+ -- use rule "Transform.ag"(line 380, column 32)+ _lhsOtypeSyns =+ []+ -- use rule "Transform.ag"(line 126, column 15)+ _lhsOuseMap =+ Map.empty+ -- use rule "Transform.ag"(line 492, column 32)+ _lhsOwrappers =+ Set.empty+ -- copy rule (chain)+ _lhsOattrDecls =+ _lhsIattrDecls+ -- copy rule (chain)+ _lhsOdefSets =+ _lhsIdefSets+ in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))+sem_Elem_Sem :: Pos ->+ ClassContext ->+ T_NontSet ->+ T_Attrs ->+ T_SemAlts ->+ T_Elem+sem_Elem_Sem pos_ ctx_ (T_NontSet names_) (T_Attrs attrs_) (T_SemAlts alts_) =+ (T_Elem (\ _lhsIallAttrDecls+ _lhsIallConstructors+ _lhsIallFields+ _lhsIallNonterminals+ _lhsIattrDecls+ _lhsIdefSets+ _lhsIdefinedSets ->+ (let _altsOnts :: (Set NontermIdent)+ _lhsOctxCollect :: ContextMap+ _attrsOnts :: (Set NontermIdent)+ _lhsOattrOrderCollect :: AttrOrderMap+ _lhsOblocks :: Blocks+ _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))+ _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])+ _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])+ _lhsOcollectedNames :: (Set Identifier)+ _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])+ _lhsOcollectedSetNames :: (Set Identifier)+ _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])+ _lhsOderivings :: Derivings+ _lhsOerrors :: (Seq Error)+ _lhsOmoduleDecl :: (Maybe (String,String,String))+ _lhsOparamsCollect :: ParamMap+ _lhsOpragmas :: (Options -> Options)+ _lhsOsemPragmasCollect :: PragmaMap+ _lhsOtypeSyns :: TypeSyns+ _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))+ _lhsOwrappers :: (Set NontermIdent)+ _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes))+ _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))+ _namesOallFields :: DataTypes+ _namesOallNonterminals :: (Set NontermIdent)+ _namesOdefinedSets :: DefinedSets+ _attrsOallFields :: DataTypes+ _attrsOallNonterminals :: (Set NontermIdent)+ _attrsOattrDecls :: (Map NontermIdent (Attributes, Attributes))+ _altsOallAttrDecls :: (Map NontermIdent (Attributes, Attributes))+ _altsOallFields :: DataTypes+ _namesIcollectedNames :: (Set Identifier)+ _namesIerrors :: (Seq Error)+ _namesInontSet :: (Set NontermIdent)+ _attrsIattrDecls :: (Map NontermIdent (Attributes, Attributes))+ _attrsIerrors :: (Seq Error)+ _attrsIuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))+ _altsIattrOrderCollect :: AttrOrderMap+ _altsIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])+ _altsIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])+ _altsIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])+ _altsIerrors :: (Seq Error)+ _altsIsemPragmasCollect :: PragmaMap+ -- "Transform.ag"(line 152, column 10)+ _altsOnts =+ _namesInontSet+ -- "Transform.ag"(line 624, column 7)+ _lhsOctxCollect =+ if null ctx_+ then Map.empty+ else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet]+ -- "Transform.ag"(line 669, column 10)+ _attrsOnts =+ _namesInontSet+ -- use rule "Transform.ag"(line 565, column 55)+ _lhsOattrOrderCollect =+ _altsIattrOrderCollect+ -- use rule "Transform.ag"(line 38, column 19)+ _lhsOblocks =+ Map.empty+ -- use rule "Transform.ag"(line 83, column 48)+ _lhsOcollectedConstructorsMap =+ Map.empty+ -- use rule "Transform.ag"(line 114, column 28)+ _lhsOcollectedFields =+ []+ -- use rule "Transform.ag"(line 138, column 29)+ _lhsOcollectedInsts =+ _altsIcollectedInsts+ -- use rule "Transform.ag"(line 75, column 50)+ _lhsOcollectedNames =+ _namesIcollectedNames+ -- use rule "Transform.ag"(line 136, column 29)+ _lhsOcollectedRules =+ _altsIcollectedRules+ -- use rule "Transform.ag"(line 74, column 50)+ _lhsOcollectedSetNames =+ Set.empty+ -- use rule "Transform.ag"(line 137, column 29)+ _lhsOcollectedSigs =+ _altsIcollectedSigs+ -- use rule "Transform.ag"(line 645, column 33)+ _lhsOderivings =+ Map.empty+ -- use rule "Transform.ag"(line 36, column 19)+ _lhsOerrors =+ _namesIerrors Seq.<> _attrsIerrors Seq.<> _altsIerrors+ -- use rule "Transform.ag"(line 787, column 37)+ _lhsOmoduleDecl =+ mzero+ -- use rule "Transform.ag"(line 597, column 37)+ _lhsOparamsCollect =+ Map.empty+ -- use rule "Transform.ag"(line 501, column 34)+ _lhsOpragmas =+ id+ -- use rule "Transform.ag"(line 537, column 56)+ _lhsOsemPragmasCollect =+ _altsIsemPragmasCollect+ -- use rule "Transform.ag"(line 380, column 32)+ _lhsOtypeSyns =+ []+ -- use rule "Transform.ag"(line 126, column 15)+ _lhsOuseMap =+ _attrsIuseMap+ -- use rule "Transform.ag"(line 492, column 32)+ _lhsOwrappers =+ Set.empty+ -- copy rule (up)+ _lhsOattrDecls =+ _attrsIattrDecls+ -- copy rule (chain)+ _lhsOdefSets =+ _lhsIdefSets+ -- copy rule (down)+ _namesOallFields =+ _lhsIallFields+ -- copy rule (down)+ _namesOallNonterminals =+ _lhsIallNonterminals+ -- copy rule (down)+ _namesOdefinedSets =+ _lhsIdefinedSets+ -- copy rule (down)+ _attrsOallFields =+ _lhsIallFields+ -- copy rule (down)+ _attrsOallNonterminals =+ _lhsIallNonterminals+ -- copy rule (down)+ _attrsOattrDecls =+ _lhsIattrDecls+ -- copy rule (down)+ _altsOallAttrDecls =+ _lhsIallAttrDecls+ -- copy rule (down)+ _altsOallFields =+ _lhsIallFields+ ( _namesIcollectedNames,_namesIerrors,_namesInontSet) =+ (names_ _namesOallFields _namesOallNonterminals _namesOdefinedSets)+ ( _attrsIattrDecls,_attrsIerrors,_attrsIuseMap) =+ (attrs_ _attrsOallFields _attrsOallNonterminals _attrsOattrDecls _attrsOnts)+ ( _altsIattrOrderCollect,_altsIcollectedInsts,_altsIcollectedRules,_altsIcollectedSigs,_altsIerrors,_altsIsemPragmasCollect) =+ (alts_ _altsOallAttrDecls _altsOallFields _altsOnts)+ in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))+sem_Elem_Set :: Pos ->+ NontermIdent ->+ T_NontSet ->+ T_Elem+sem_Elem_Set pos_ name_ (T_NontSet set_) =+ (T_Elem (\ _lhsIallAttrDecls+ _lhsIallConstructors+ _lhsIallFields+ _lhsIallNonterminals+ _lhsIattrDecls+ _lhsIdefSets+ _lhsIdefinedSets ->+ (let _lhsOcollectedSetNames :: (Set Identifier)+ _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))+ _lhsOerrors :: (Seq Error)+ _lhsOattrOrderCollect :: AttrOrderMap+ _lhsOblocks :: Blocks+ _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))+ _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])+ _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])+ _lhsOcollectedNames :: (Set Identifier)+ _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])+ _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])+ _lhsOctxCollect :: ContextMap+ _lhsOderivings :: Derivings+ _lhsOmoduleDecl :: (Maybe (String,String,String))+ _lhsOparamsCollect :: ParamMap+ _lhsOpragmas :: (Options -> Options)+ _lhsOsemPragmasCollect :: PragmaMap+ _lhsOtypeSyns :: TypeSyns+ _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))+ _lhsOwrappers :: (Set NontermIdent)+ _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes))+ _setOallFields :: DataTypes+ _setOallNonterminals :: (Set NontermIdent)+ _setOdefinedSets :: DefinedSets+ _setIcollectedNames :: (Set Identifier)+ _setIerrors :: (Seq Error)+ _setInontSet :: (Set NontermIdent)+ -- "Transform.ag"(line 336, column 10)+ _lhsOcollectedSetNames =+ Set.singleton name_+ -- "Transform.ag"(line 424, column 13)+ __tup3 =+ let allUsedNames = Set.unions [ maybe (Set.singleton n)+ snd+ (Map.lookup n _lhsIdefSets)+ | n <- Set.toList _setIcollectedNames+ ]+ (nontSet,e1) | Set.member name_ allUsedNames+ = (Set.empty, Seq.single(CyclicSet name_))+ | otherwise = (_setInontSet, Seq.empty)+ (res, e2) = checkDuplicate DupSet name_ (nontSet,Set.insert name_ allUsedNames) _lhsIdefSets+ in (res, e1 Seq.<> e2)+ -- "Transform.ag"(line 424, column 13)+ (_defSets2,_) =+ __tup3+ -- "Transform.ag"(line 424, column 13)+ (_,_errs) =+ __tup3+ -- "Transform.ag"(line 434, column 9)+ _lhsOdefSets =+ _defSets2+ -- "Transform.ag"(line 434, column 9)+ _lhsOerrors =+ _errs <> _setIerrors+ -- use rule "Transform.ag"(line 565, column 55)+ _lhsOattrOrderCollect =+ Map.empty+ -- use rule "Transform.ag"(line 38, column 19)+ _lhsOblocks =+ Map.empty+ -- use rule "Transform.ag"(line 83, column 48)+ _lhsOcollectedConstructorsMap =+ Map.empty+ -- use rule "Transform.ag"(line 114, column 28)+ _lhsOcollectedFields =+ []+ -- use rule "Transform.ag"(line 138, column 29)+ _lhsOcollectedInsts =+ []+ -- use rule "Transform.ag"(line 75, column 50)+ _lhsOcollectedNames =+ _setIcollectedNames+ -- use rule "Transform.ag"(line 136, column 29)+ _lhsOcollectedRules =+ []+ -- use rule "Transform.ag"(line 137, column 29)+ _lhsOcollectedSigs =+ []+ -- use rule "Transform.ag"(line 620, column 34)+ _lhsOctxCollect =+ Map.empty+ -- use rule "Transform.ag"(line 645, column 33)+ _lhsOderivings =+ Map.empty+ -- use rule "Transform.ag"(line 787, column 37)+ _lhsOmoduleDecl =+ mzero+ -- use rule "Transform.ag"(line 597, column 37)+ _lhsOparamsCollect =+ Map.empty+ -- use rule "Transform.ag"(line 501, column 34)+ _lhsOpragmas =+ id+ -- use rule "Transform.ag"(line 537, column 56)+ _lhsOsemPragmasCollect =+ Map.empty+ -- use rule "Transform.ag"(line 380, column 32)+ _lhsOtypeSyns =+ []+ -- use rule "Transform.ag"(line 126, column 15)+ _lhsOuseMap =+ Map.empty+ -- use rule "Transform.ag"(line 492, column 32)+ _lhsOwrappers =+ Set.empty+ -- copy rule (chain)+ _lhsOattrDecls =+ _lhsIattrDecls+ -- copy rule (down)+ _setOallFields =+ _lhsIallFields+ -- copy rule (down)+ _setOallNonterminals =+ _lhsIallNonterminals+ -- copy rule (down)+ _setOdefinedSets =+ _lhsIdefinedSets+ ( _setIcollectedNames,_setIerrors,_setInontSet) =+ (set_ _setOallFields _setOallNonterminals _setOdefinedSets)+ in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))+sem_Elem_Txt :: Pos ->+ NontermIdent ->+ ([String]) ->+ T_Elem+sem_Elem_Txt pos_ name_ lines_ =+ (T_Elem (\ _lhsIallAttrDecls+ _lhsIallConstructors+ _lhsIallFields+ _lhsIallNonterminals+ _lhsIattrDecls+ _lhsIdefSets+ _lhsIdefinedSets ->+ (let _lhsOblocks :: Blocks+ _lhsOattrOrderCollect :: AttrOrderMap+ _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))+ _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])+ _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])+ _lhsOcollectedNames :: (Set Identifier)+ _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])+ _lhsOcollectedSetNames :: (Set Identifier)+ _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])+ _lhsOctxCollect :: ContextMap+ _lhsOderivings :: Derivings+ _lhsOerrors :: (Seq Error)+ _lhsOmoduleDecl :: (Maybe (String,String,String))+ _lhsOparamsCollect :: ParamMap+ _lhsOpragmas :: (Options -> Options)+ _lhsOsemPragmasCollect :: PragmaMap+ _lhsOtypeSyns :: TypeSyns+ _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))+ _lhsOwrappers :: (Set NontermIdent)+ _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes))+ _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))+ -- "Transform.ag"(line 161, column 11)+ _lhsOblocks =+ Map.singleton (getName name_) [(lines_, pos_)]+ -- use rule "Transform.ag"(line 565, column 55)+ _lhsOattrOrderCollect =+ Map.empty+ -- use rule "Transform.ag"(line 83, column 48)+ _lhsOcollectedConstructorsMap =+ Map.empty+ -- use rule "Transform.ag"(line 114, column 28)+ _lhsOcollectedFields =+ []+ -- use rule "Transform.ag"(line 138, column 29)+ _lhsOcollectedInsts =+ []+ -- use rule "Transform.ag"(line 75, column 50)+ _lhsOcollectedNames =+ Set.empty+ -- use rule "Transform.ag"(line 136, column 29)+ _lhsOcollectedRules =+ []+ -- use rule "Transform.ag"(line 74, column 50)+ _lhsOcollectedSetNames =+ Set.empty+ -- use rule "Transform.ag"(line 137, column 29)+ _lhsOcollectedSigs =+ []+ -- use rule "Transform.ag"(line 620, column 34)+ _lhsOctxCollect =+ Map.empty+ -- use rule "Transform.ag"(line 645, column 33)+ _lhsOderivings =+ Map.empty+ -- use rule "Transform.ag"(line 36, column 19)+ _lhsOerrors =+ Seq.empty+ -- use rule "Transform.ag"(line 787, column 37)+ _lhsOmoduleDecl =+ mzero+ -- use rule "Transform.ag"(line 597, column 37)+ _lhsOparamsCollect =+ Map.empty+ -- use rule "Transform.ag"(line 501, column 34)+ _lhsOpragmas =+ id+ -- use rule "Transform.ag"(line 537, column 56)+ _lhsOsemPragmasCollect =+ Map.empty+ -- use rule "Transform.ag"(line 380, column 32)+ _lhsOtypeSyns =+ []+ -- use rule "Transform.ag"(line 126, column 15)+ _lhsOuseMap =+ Map.empty+ -- use rule "Transform.ag"(line 492, column 32)+ _lhsOwrappers =+ Set.empty+ -- copy rule (chain)+ _lhsOattrDecls =+ _lhsIattrDecls+ -- copy rule (chain)+ _lhsOdefSets =+ _lhsIdefSets+ in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))+sem_Elem_Type :: Pos ->+ ClassContext ->+ NontermIdent ->+ ([Identifier]) ->+ ComplexType ->+ T_Elem+sem_Elem_Type pos_ ctx_ name_ params_ type_ =+ (T_Elem (\ _lhsIallAttrDecls+ _lhsIallConstructors+ _lhsIallFields+ _lhsIallNonterminals+ _lhsIattrDecls+ _lhsIdefSets+ _lhsIdefinedSets ->+ (let _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])+ _lhsOcollectedNames :: (Set Identifier)+ _lhsOtypeSyns :: TypeSyns+ _lhsOparamsCollect :: ParamMap+ _lhsOctxCollect :: ContextMap+ _lhsOattrOrderCollect :: AttrOrderMap+ _lhsOblocks :: Blocks+ _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))+ _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])+ _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])+ _lhsOcollectedSetNames :: (Set Identifier)+ _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])+ _lhsOderivings :: Derivings+ _lhsOerrors :: (Seq Error)+ _lhsOmoduleDecl :: (Maybe (String,String,String))+ _lhsOpragmas :: (Options -> Options)+ _lhsOsemPragmasCollect :: PragmaMap+ _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))+ _lhsOwrappers :: (Set NontermIdent)+ _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes))+ _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))+ -- "Transform.ag"(line 214, column 10)+ _lhsOcollectedFields =+ map (\(x,y)->(name_, x, y)) _expanded+ -- "Transform.ag"(line 339, column 11)+ _lhsOcollectedNames =+ Set.singleton name_+ -- "Transform.ag"(line 393, column 11)+ _expanded =+ case _argType of+ List tp -> [(Ident "Cons" pos_, [(Ident "hd" pos_, tp)+ ,(Ident "tl" pos_, NT name_ (map getName params_))+ ]+ )+ ,(Ident "Nil" pos_, [])+ ]+ Maybe tp -> [(Ident "Just" pos_, [(Ident "just" pos_, tp)+ ]+ )+ ,(Ident "Nothing" pos_, [])+ ]+ Tuple xs -> [(Ident "Tuple" pos_, xs)]+ -- "Transform.ag"(line 406, column 11)+ _argType =+ case type_ of+ Maybe tp -> Maybe ( makeType _lhsIallNonterminals tp)+ List tp -> List ( makeType _lhsIallNonterminals tp)+ Tuple xs -> Tuple [(f,makeType _lhsIallNonterminals tp) | (f,tp) <- xs]+ -- "Transform.ag"(line 410, column 11)+ _lhsOtypeSyns =+ [(name_,_argType)]+ -- "Transform.ag"(line 607, column 7)+ _lhsOparamsCollect =+ if null params_+ then Map.empty+ else Map.singleton name_ params_+ -- "Transform.ag"(line 630, column 7)+ _lhsOctxCollect =+ if null ctx_+ then Map.empty+ else Map.singleton name_ ctx_+ -- use rule "Transform.ag"(line 565, column 55)+ _lhsOattrOrderCollect =+ Map.empty+ -- use rule "Transform.ag"(line 38, column 19)+ _lhsOblocks =+ Map.empty+ -- use rule "Transform.ag"(line 83, column 48)+ _lhsOcollectedConstructorsMap =+ Map.empty+ -- use rule "Transform.ag"(line 138, column 29)+ _lhsOcollectedInsts =+ []+ -- use rule "Transform.ag"(line 136, column 29)+ _lhsOcollectedRules =+ []+ -- use rule "Transform.ag"(line 74, column 50)+ _lhsOcollectedSetNames =+ Set.empty+ -- use rule "Transform.ag"(line 137, column 29)+ _lhsOcollectedSigs =+ []+ -- use rule "Transform.ag"(line 645, column 33)+ _lhsOderivings =+ Map.empty+ -- use rule "Transform.ag"(line 36, column 19)+ _lhsOerrors =+ Seq.empty+ -- use rule "Transform.ag"(line 787, column 37)+ _lhsOmoduleDecl =+ mzero+ -- use rule "Transform.ag"(line 501, column 34)+ _lhsOpragmas =+ id+ -- use rule "Transform.ag"(line 537, column 56)+ _lhsOsemPragmasCollect =+ Map.empty+ -- use rule "Transform.ag"(line 126, column 15)+ _lhsOuseMap =+ Map.empty+ -- use rule "Transform.ag"(line 492, column 32)+ _lhsOwrappers =+ Set.empty+ -- copy rule (chain)+ _lhsOattrDecls =+ _lhsIattrDecls+ -- copy rule (chain)+ _lhsOdefSets =+ _lhsIdefSets+ in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))+sem_Elem_Wrapper :: Pos ->+ T_NontSet ->+ T_Elem+sem_Elem_Wrapper pos_ (T_NontSet set_) =+ (T_Elem (\ _lhsIallAttrDecls+ _lhsIallConstructors+ _lhsIallFields+ _lhsIallNonterminals+ _lhsIattrDecls+ _lhsIdefSets+ _lhsIdefinedSets ->+ (let _lhsOwrappers :: (Set NontermIdent)+ _lhsOattrOrderCollect :: AttrOrderMap+ _lhsOblocks :: Blocks+ _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))+ _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])+ _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])+ _lhsOcollectedNames :: (Set Identifier)+ _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])+ _lhsOcollectedSetNames :: (Set Identifier)+ _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])+ _lhsOctxCollect :: ContextMap+ _lhsOderivings :: Derivings+ _lhsOerrors :: (Seq Error)+ _lhsOmoduleDecl :: (Maybe (String,String,String))+ _lhsOparamsCollect :: ParamMap+ _lhsOpragmas :: (Options -> Options)+ _lhsOsemPragmasCollect :: PragmaMap+ _lhsOtypeSyns :: TypeSyns+ _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))+ _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes))+ _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))+ _setOallFields :: DataTypes+ _setOallNonterminals :: (Set NontermIdent)+ _setOdefinedSets :: DefinedSets+ _setIcollectedNames :: (Set Identifier)+ _setIerrors :: (Seq Error)+ _setInontSet :: (Set NontermIdent)+ -- "Transform.ag"(line 495, column 13)+ _lhsOwrappers =+ _setInontSet+ -- use rule "Transform.ag"(line 565, column 55)+ _lhsOattrOrderCollect =+ Map.empty+ -- use rule "Transform.ag"(line 38, column 19)+ _lhsOblocks =+ Map.empty+ -- use rule "Transform.ag"(line 83, column 48)+ _lhsOcollectedConstructorsMap =+ Map.empty+ -- use rule "Transform.ag"(line 114, column 28)+ _lhsOcollectedFields =+ []+ -- use rule "Transform.ag"(line 138, column 29)+ _lhsOcollectedInsts =+ []+ -- use rule "Transform.ag"(line 75, column 50)+ _lhsOcollectedNames =+ _setIcollectedNames+ -- use rule "Transform.ag"(line 136, column 29)+ _lhsOcollectedRules =+ []+ -- use rule "Transform.ag"(line 74, column 50)+ _lhsOcollectedSetNames =+ Set.empty+ -- use rule "Transform.ag"(line 137, column 29)+ _lhsOcollectedSigs =+ []+ -- use rule "Transform.ag"(line 620, column 34)+ _lhsOctxCollect =+ Map.empty+ -- use rule "Transform.ag"(line 645, column 33)+ _lhsOderivings =+ Map.empty+ -- use rule "Transform.ag"(line 36, column 19)+ _lhsOerrors =+ _setIerrors+ -- use rule "Transform.ag"(line 787, column 37)+ _lhsOmoduleDecl =+ mzero+ -- use rule "Transform.ag"(line 597, column 37)+ _lhsOparamsCollect =+ Map.empty+ -- use rule "Transform.ag"(line 501, column 34)+ _lhsOpragmas =+ id+ -- use rule "Transform.ag"(line 537, column 56)+ _lhsOsemPragmasCollect =+ Map.empty+ -- use rule "Transform.ag"(line 380, column 32)+ _lhsOtypeSyns =+ []+ -- use rule "Transform.ag"(line 126, column 15)+ _lhsOuseMap =+ Map.empty+ -- copy rule (chain)+ _lhsOattrDecls =+ _lhsIattrDecls+ -- copy rule (chain)+ _lhsOdefSets =+ _lhsIdefSets+ -- copy rule (down)+ _setOallFields =+ _lhsIallFields+ -- copy rule (down)+ _setOallNonterminals =+ _lhsIallNonterminals+ -- copy rule (down)+ _setOdefinedSets =+ _lhsIdefinedSets+ ( _setIcollectedNames,_setIerrors,_setInontSet) =+ (set_ _setOallFields _setOallNonterminals _setOdefinedSets)+ in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))+-- Elems -------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allAttrDecls : Map NontermIdent (Attributes, Attributes)+ allConstructors : Map NontermIdent (Set ConstructorIdent)+ allFields : DataTypes+ allNonterminals : Set NontermIdent+ definedSets : DefinedSets+ chained attributes:+ attrDecls : Map NontermIdent (Attributes, Attributes)+ defSets : Map Identifier (Set NontermIdent,Set Identifier)+ synthesized attributes:+ attrOrderCollect : AttrOrderMap+ blocks : Blocks+ collectedConstructorsMap : Map NontermIdent (Set ConstructorIdent)+ collectedFields : [(NontermIdent, ConstructorIdent, FieldMap)]+ collectedInsts : [ (NontermIdent, ConstructorIdent, [Identifier]) ]+ collectedNames : Set Identifier+ collectedRules : [ (NontermIdent, ConstructorIdent, RuleInfo)]+ collectedSetNames : Set Identifier+ collectedSigs : [ (NontermIdent, ConstructorIdent, SigInfo) ]+ ctxCollect : ContextMap+ derivings : Derivings+ errors : Seq Error+ moduleDecl : Maybe (String,String,String)+ paramsCollect : ParamMap+ pragmas : Options -> Options+ semPragmasCollect : PragmaMap+ typeSyns : TypeSyns+ useMap : Map NontermIdent (Map Identifier (String,String,String))+ wrappers : Set NontermIdent+ alternatives:+ alternative Cons:+ child hd : Elem+ child tl : Elems+ alternative Nil:+-}+-- cata+sem_Elems :: Elems ->+ T_Elems+sem_Elems list =+ (Prelude.foldr sem_Elems_Cons sem_Elems_Nil (Prelude.map sem_Elem list))+-- semantic domain+newtype T_Elems = T_Elems ((Map NontermIdent (Attributes, Attributes)) ->+ (Map NontermIdent (Set ConstructorIdent)) ->+ DataTypes ->+ (Set NontermIdent) ->+ (Map NontermIdent (Attributes, Attributes)) ->+ (Map Identifier (Set NontermIdent,Set Identifier)) ->+ DefinedSets ->+ ( (Map NontermIdent (Attributes, Attributes)),AttrOrderMap,Blocks,(Map NontermIdent (Set ConstructorIdent)),([(NontermIdent, ConstructorIdent, FieldMap)]),([ (NontermIdent, ConstructorIdent, [Identifier]) ]),(Set Identifier),([ (NontermIdent, ConstructorIdent, RuleInfo)]),(Set Identifier),([ (NontermIdent, ConstructorIdent, SigInfo) ]),ContextMap,(Map Identifier (Set NontermIdent,Set Identifier)),Derivings,(Seq Error),(Maybe (String,String,String)),ParamMap,(Options -> Options),PragmaMap,TypeSyns,(Map NontermIdent (Map Identifier (String,String,String))),(Set NontermIdent)))+data Inh_Elems = Inh_Elems {allAttrDecls_Inh_Elems :: Map NontermIdent (Attributes, Attributes),allConstructors_Inh_Elems :: Map NontermIdent (Set ConstructorIdent),allFields_Inh_Elems :: DataTypes,allNonterminals_Inh_Elems :: Set NontermIdent,attrDecls_Inh_Elems :: Map NontermIdent (Attributes, Attributes),defSets_Inh_Elems :: Map Identifier (Set NontermIdent,Set Identifier),definedSets_Inh_Elems :: DefinedSets}+data Syn_Elems = Syn_Elems {attrDecls_Syn_Elems :: Map NontermIdent (Attributes, Attributes),attrOrderCollect_Syn_Elems :: AttrOrderMap,blocks_Syn_Elems :: Blocks,collectedConstructorsMap_Syn_Elems :: Map NontermIdent (Set ConstructorIdent),collectedFields_Syn_Elems :: [(NontermIdent, ConstructorIdent, FieldMap)],collectedInsts_Syn_Elems :: [ (NontermIdent, ConstructorIdent, [Identifier]) ],collectedNames_Syn_Elems :: Set Identifier,collectedRules_Syn_Elems :: [ (NontermIdent, ConstructorIdent, RuleInfo)],collectedSetNames_Syn_Elems :: Set Identifier,collectedSigs_Syn_Elems :: [ (NontermIdent, ConstructorIdent, SigInfo) ],ctxCollect_Syn_Elems :: ContextMap,defSets_Syn_Elems :: Map Identifier (Set NontermIdent,Set Identifier),derivings_Syn_Elems :: Derivings,errors_Syn_Elems :: Seq Error,moduleDecl_Syn_Elems :: Maybe (String,String,String),paramsCollect_Syn_Elems :: ParamMap,pragmas_Syn_Elems :: Options -> Options,semPragmasCollect_Syn_Elems :: PragmaMap,typeSyns_Syn_Elems :: TypeSyns,useMap_Syn_Elems :: Map NontermIdent (Map Identifier (String,String,String)),wrappers_Syn_Elems :: Set NontermIdent}+wrap_Elems (T_Elems sem) (Inh_Elems _lhsIallAttrDecls _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIdefSets _lhsIdefinedSets) =+ (let ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers) =+ (sem _lhsIallAttrDecls _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIdefSets _lhsIdefinedSets)+ in (Syn_Elems _lhsOattrDecls _lhsOattrOrderCollect _lhsOblocks _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOctxCollect _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOparamsCollect _lhsOpragmas _lhsOsemPragmasCollect _lhsOtypeSyns _lhsOuseMap _lhsOwrappers))+sem_Elems_Cons :: T_Elem ->+ T_Elems ->+ T_Elems+sem_Elems_Cons (T_Elem hd_) (T_Elems tl_) =+ (T_Elems (\ _lhsIallAttrDecls+ _lhsIallConstructors+ _lhsIallFields+ _lhsIallNonterminals+ _lhsIattrDecls+ _lhsIdefSets+ _lhsIdefinedSets ->+ (let _lhsOattrOrderCollect :: AttrOrderMap+ _lhsOblocks :: Blocks+ _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))+ _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])+ _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])+ _lhsOcollectedNames :: (Set Identifier)+ _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])+ _lhsOcollectedSetNames :: (Set Identifier)+ _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])+ _lhsOctxCollect :: ContextMap+ _lhsOderivings :: Derivings+ _lhsOerrors :: (Seq Error)+ _lhsOmoduleDecl :: (Maybe (String,String,String))+ _lhsOparamsCollect :: ParamMap+ _lhsOpragmas :: (Options -> Options)+ _lhsOsemPragmasCollect :: PragmaMap+ _lhsOtypeSyns :: TypeSyns+ _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))+ _lhsOwrappers :: (Set NontermIdent)+ _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes))+ _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))+ _hdOallAttrDecls :: (Map NontermIdent (Attributes, Attributes))+ _hdOallConstructors :: (Map NontermIdent (Set ConstructorIdent))+ _hdOallFields :: DataTypes+ _hdOallNonterminals :: (Set NontermIdent)+ _hdOattrDecls :: (Map NontermIdent (Attributes, Attributes))+ _hdOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))+ _hdOdefinedSets :: DefinedSets+ _tlOallAttrDecls :: (Map NontermIdent (Attributes, Attributes))+ _tlOallConstructors :: (Map NontermIdent (Set ConstructorIdent))+ _tlOallFields :: DataTypes+ _tlOallNonterminals :: (Set NontermIdent)+ _tlOattrDecls :: (Map NontermIdent (Attributes, Attributes))+ _tlOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))+ _tlOdefinedSets :: DefinedSets+ _hdIattrDecls :: (Map NontermIdent (Attributes, Attributes))+ _hdIattrOrderCollect :: AttrOrderMap+ _hdIblocks :: Blocks+ _hdIcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))+ _hdIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])+ _hdIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])+ _hdIcollectedNames :: (Set Identifier)+ _hdIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])+ _hdIcollectedSetNames :: (Set Identifier)+ _hdIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])+ _hdIctxCollect :: ContextMap+ _hdIdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))+ _hdIderivings :: Derivings+ _hdIerrors :: (Seq Error)+ _hdImoduleDecl :: (Maybe (String,String,String))+ _hdIparamsCollect :: ParamMap+ _hdIpragmas :: (Options -> Options)+ _hdIsemPragmasCollect :: PragmaMap+ _hdItypeSyns :: TypeSyns+ _hdIuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))+ _hdIwrappers :: (Set NontermIdent)+ _tlIattrDecls :: (Map NontermIdent (Attributes, Attributes))+ _tlIattrOrderCollect :: AttrOrderMap+ _tlIblocks :: Blocks+ _tlIcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))+ _tlIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])+ _tlIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])+ _tlIcollectedNames :: (Set Identifier)+ _tlIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])+ _tlIcollectedSetNames :: (Set Identifier)+ _tlIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])+ _tlIctxCollect :: ContextMap+ _tlIdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))+ _tlIderivings :: Derivings+ _tlIerrors :: (Seq Error)+ _tlImoduleDecl :: (Maybe (String,String,String))+ _tlIparamsCollect :: ParamMap+ _tlIpragmas :: (Options -> Options)+ _tlIsemPragmasCollect :: PragmaMap+ _tlItypeSyns :: TypeSyns+ _tlIuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))+ _tlIwrappers :: (Set NontermIdent)+ -- use rule "Transform.ag"(line 565, column 55)+ _lhsOattrOrderCollect =+ _hdIattrOrderCollect `orderMapUnion` _tlIattrOrderCollect+ -- use rule "Transform.ag"(line 38, column 19)+ _lhsOblocks =+ _hdIblocks `mapUnionWithPlusPlus` _tlIblocks+ -- use rule "Transform.ag"(line 83, column 48)+ _lhsOcollectedConstructorsMap =+ _hdIcollectedConstructorsMap `mapUnionWithSetUnion` _tlIcollectedConstructorsMap+ -- use rule "Transform.ag"(line 114, column 28)+ _lhsOcollectedFields =+ _hdIcollectedFields ++ _tlIcollectedFields+ -- use rule "Transform.ag"(line 138, column 29)+ _lhsOcollectedInsts =+ _hdIcollectedInsts ++ _tlIcollectedInsts+ -- use rule "Transform.ag"(line 75, column 50)+ _lhsOcollectedNames =+ _hdIcollectedNames `Set.union` _tlIcollectedNames+ -- use rule "Transform.ag"(line 136, column 29)+ _lhsOcollectedRules =+ _hdIcollectedRules ++ _tlIcollectedRules+ -- use rule "Transform.ag"(line 74, column 50)+ _lhsOcollectedSetNames =+ _hdIcollectedSetNames `Set.union` _tlIcollectedSetNames+ -- use rule "Transform.ag"(line 137, column 29)+ _lhsOcollectedSigs =+ _hdIcollectedSigs ++ _tlIcollectedSigs+ -- use rule "Transform.ag"(line 620, column 34)+ _lhsOctxCollect =+ _hdIctxCollect `mergeCtx` _tlIctxCollect+ -- use rule "Transform.ag"(line 645, column 33)+ _lhsOderivings =+ _hdIderivings `mergeDerivings` _tlIderivings+ -- use rule "Transform.ag"(line 36, column 19)+ _lhsOerrors =+ _hdIerrors Seq.<> _tlIerrors+ -- use rule "Transform.ag"(line 787, column 37)+ _lhsOmoduleDecl =+ _hdImoduleDecl `mplus` _tlImoduleDecl+ -- use rule "Transform.ag"(line 597, column 37)+ _lhsOparamsCollect =+ _hdIparamsCollect `mergeParams` _tlIparamsCollect+ -- use rule "Transform.ag"(line 501, column 34)+ _lhsOpragmas =+ _hdIpragmas . _tlIpragmas+ -- use rule "Transform.ag"(line 537, column 56)+ _lhsOsemPragmasCollect =+ _hdIsemPragmasCollect `pragmaMapUnion` _tlIsemPragmasCollect+ -- use rule "Transform.ag"(line 380, column 32)+ _lhsOtypeSyns =+ _hdItypeSyns ++ _tlItypeSyns+ -- use rule "Transform.ag"(line 126, column 15)+ _lhsOuseMap =+ _hdIuseMap `merge` _tlIuseMap+ -- use rule "Transform.ag"(line 492, column 32)+ _lhsOwrappers =+ _hdIwrappers `Set.union` _tlIwrappers+ -- copy rule (up)+ _lhsOattrDecls =+ _tlIattrDecls+ -- copy rule (up)+ _lhsOdefSets =+ _tlIdefSets+ -- copy rule (down)+ _hdOallAttrDecls =+ _lhsIallAttrDecls+ -- copy rule (down)+ _hdOallConstructors =+ _lhsIallConstructors+ -- copy rule (down)+ _hdOallFields =+ _lhsIallFields+ -- copy rule (down)+ _hdOallNonterminals =+ _lhsIallNonterminals+ -- copy rule (down)+ _hdOattrDecls =+ _lhsIattrDecls+ -- copy rule (down)+ _hdOdefSets =+ _lhsIdefSets+ -- copy rule (down)+ _hdOdefinedSets =+ _lhsIdefinedSets+ -- copy rule (down)+ _tlOallAttrDecls =+ _lhsIallAttrDecls+ -- copy rule (down)+ _tlOallConstructors =+ _lhsIallConstructors+ -- copy rule (down)+ _tlOallFields =+ _lhsIallFields+ -- copy rule (down)+ _tlOallNonterminals =+ _lhsIallNonterminals+ -- copy rule (chain)+ _tlOattrDecls =+ _hdIattrDecls+ -- copy rule (chain)+ _tlOdefSets =+ _hdIdefSets+ -- copy rule (down)+ _tlOdefinedSets =+ _lhsIdefinedSets+ ( _hdIattrDecls,_hdIattrOrderCollect,_hdIblocks,_hdIcollectedConstructorsMap,_hdIcollectedFields,_hdIcollectedInsts,_hdIcollectedNames,_hdIcollectedRules,_hdIcollectedSetNames,_hdIcollectedSigs,_hdIctxCollect,_hdIdefSets,_hdIderivings,_hdIerrors,_hdImoduleDecl,_hdIparamsCollect,_hdIpragmas,_hdIsemPragmasCollect,_hdItypeSyns,_hdIuseMap,_hdIwrappers) =+ (hd_ _hdOallAttrDecls _hdOallConstructors _hdOallFields _hdOallNonterminals _hdOattrDecls _hdOdefSets _hdOdefinedSets)+ ( _tlIattrDecls,_tlIattrOrderCollect,_tlIblocks,_tlIcollectedConstructorsMap,_tlIcollectedFields,_tlIcollectedInsts,_tlIcollectedNames,_tlIcollectedRules,_tlIcollectedSetNames,_tlIcollectedSigs,_tlIctxCollect,_tlIdefSets,_tlIderivings,_tlIerrors,_tlImoduleDecl,_tlIparamsCollect,_tlIpragmas,_tlIsemPragmasCollect,_tlItypeSyns,_tlIuseMap,_tlIwrappers) =+ (tl_ _tlOallAttrDecls _tlOallConstructors _tlOallFields _tlOallNonterminals _tlOattrDecls _tlOdefSets _tlOdefinedSets)+ in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))+sem_Elems_Nil :: T_Elems+sem_Elems_Nil =+ (T_Elems (\ _lhsIallAttrDecls+ _lhsIallConstructors+ _lhsIallFields+ _lhsIallNonterminals+ _lhsIattrDecls+ _lhsIdefSets+ _lhsIdefinedSets ->+ (let _lhsOattrOrderCollect :: AttrOrderMap+ _lhsOblocks :: Blocks+ _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))+ _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])+ _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])+ _lhsOcollectedNames :: (Set Identifier)+ _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])+ _lhsOcollectedSetNames :: (Set Identifier)+ _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])+ _lhsOctxCollect :: ContextMap+ _lhsOderivings :: Derivings+ _lhsOerrors :: (Seq Error)+ _lhsOmoduleDecl :: (Maybe (String,String,String))+ _lhsOparamsCollect :: ParamMap+ _lhsOpragmas :: (Options -> Options)+ _lhsOsemPragmasCollect :: PragmaMap+ _lhsOtypeSyns :: TypeSyns+ _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))+ _lhsOwrappers :: (Set NontermIdent)+ _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes))+ _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))+ -- use rule "Transform.ag"(line 565, column 55)+ _lhsOattrOrderCollect =+ Map.empty+ -- use rule "Transform.ag"(line 38, column 19)+ _lhsOblocks =+ Map.empty+ -- use rule "Transform.ag"(line 83, column 48)+ _lhsOcollectedConstructorsMap =+ Map.empty+ -- use rule "Transform.ag"(line 114, column 28)+ _lhsOcollectedFields =+ []+ -- use rule "Transform.ag"(line 138, column 29)+ _lhsOcollectedInsts =+ []+ -- use rule "Transform.ag"(line 75, column 50)+ _lhsOcollectedNames =+ Set.empty+ -- use rule "Transform.ag"(line 136, column 29)+ _lhsOcollectedRules =+ []+ -- use rule "Transform.ag"(line 74, column 50)+ _lhsOcollectedSetNames =+ Set.empty+ -- use rule "Transform.ag"(line 137, column 29)+ _lhsOcollectedSigs =+ []+ -- use rule "Transform.ag"(line 620, column 34)+ _lhsOctxCollect =+ Map.empty+ -- use rule "Transform.ag"(line 645, column 33)+ _lhsOderivings =+ Map.empty+ -- use rule "Transform.ag"(line 36, column 19)+ _lhsOerrors =+ Seq.empty+ -- use rule "Transform.ag"(line 787, column 37)+ _lhsOmoduleDecl =+ mzero+ -- use rule "Transform.ag"(line 597, column 37)+ _lhsOparamsCollect =+ Map.empty+ -- use rule "Transform.ag"(line 501, column 34)+ _lhsOpragmas =+ id+ -- use rule "Transform.ag"(line 537, column 56)+ _lhsOsemPragmasCollect =+ Map.empty+ -- use rule "Transform.ag"(line 380, column 32)+ _lhsOtypeSyns =+ []+ -- use rule "Transform.ag"(line 126, column 15)+ _lhsOuseMap =+ Map.empty+ -- use rule "Transform.ag"(line 492, column 32)+ _lhsOwrappers =+ Set.empty+ -- copy rule (chain)+ _lhsOattrDecls =+ _lhsIattrDecls+ -- copy rule (chain)+ _lhsOdefSets =+ _lhsIdefSets+ in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))+-- NontSet -----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allFields : DataTypes+ allNonterminals : Set NontermIdent+ definedSets : DefinedSets+ synthesized attributes:+ collectedNames : Set Identifier+ errors : Seq Error+ nontSet : Set NontermIdent+ alternatives:+ alternative All:+ alternative Difference:+ child set1 : NontSet+ child set2 : NontSet+ alternative Intersect:+ child set1 : NontSet+ child set2 : NontSet+ alternative NamedSet:+ child name : {NontermIdent}+ visit 0:+ local _tup4 : _+ local nontSet : _+ local errors : _+ alternative Path:+ child from : {NontermIdent}+ child to : {NontermIdent}+ alternative Union:+ child set1 : NontSet+ child set2 : NontSet+-}+-- cata+sem_NontSet :: NontSet ->+ T_NontSet+sem_NontSet (All ) =+ (sem_NontSet_All )+sem_NontSet (Difference _set1 _set2) =+ (sem_NontSet_Difference (sem_NontSet _set1) (sem_NontSet _set2))+sem_NontSet (Intersect _set1 _set2) =+ (sem_NontSet_Intersect (sem_NontSet _set1) (sem_NontSet _set2))+sem_NontSet (NamedSet _name) =+ (sem_NontSet_NamedSet _name)+sem_NontSet (Path _from _to) =+ (sem_NontSet_Path _from _to)+sem_NontSet (Union _set1 _set2) =+ (sem_NontSet_Union (sem_NontSet _set1) (sem_NontSet _set2))+-- semantic domain+newtype T_NontSet = T_NontSet (DataTypes ->+ (Set NontermIdent) ->+ DefinedSets ->+ ( (Set Identifier),(Seq Error),(Set NontermIdent)))+data Inh_NontSet = Inh_NontSet {allFields_Inh_NontSet :: DataTypes,allNonterminals_Inh_NontSet :: Set NontermIdent,definedSets_Inh_NontSet :: DefinedSets}+data Syn_NontSet = Syn_NontSet {collectedNames_Syn_NontSet :: Set Identifier,errors_Syn_NontSet :: Seq Error,nontSet_Syn_NontSet :: Set NontermIdent}+wrap_NontSet (T_NontSet sem) (Inh_NontSet _lhsIallFields _lhsIallNonterminals _lhsIdefinedSets) =+ (let ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet) =+ (sem _lhsIallFields _lhsIallNonterminals _lhsIdefinedSets)+ in (Syn_NontSet _lhsOcollectedNames _lhsOerrors _lhsOnontSet))+sem_NontSet_All :: T_NontSet+sem_NontSet_All =+ (T_NontSet (\ _lhsIallFields+ _lhsIallNonterminals+ _lhsIdefinedSets ->+ (let _lhsOnontSet :: (Set NontermIdent)+ _lhsOcollectedNames :: (Set Identifier)+ _lhsOerrors :: (Seq Error)+ -- "Transform.ag"(line 438, column 16)+ _lhsOnontSet =+ _lhsIallNonterminals+ -- use rule "Transform.ag"(line 75, column 50)+ _lhsOcollectedNames =+ Set.empty+ -- use rule "Transform.ag"(line 36, column 19)+ _lhsOerrors =+ Seq.empty+ in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet))))+sem_NontSet_Difference :: T_NontSet ->+ T_NontSet ->+ T_NontSet+sem_NontSet_Difference (T_NontSet set1_) (T_NontSet set2_) =+ (T_NontSet (\ _lhsIallFields+ _lhsIallNonterminals+ _lhsIdefinedSets ->+ (let _lhsOnontSet :: (Set NontermIdent)+ _lhsOcollectedNames :: (Set Identifier)+ _lhsOerrors :: (Seq Error)+ _set1OallFields :: DataTypes+ _set1OallNonterminals :: (Set NontermIdent)+ _set1OdefinedSets :: DefinedSets+ _set2OallFields :: DataTypes+ _set2OallNonterminals :: (Set NontermIdent)+ _set2OdefinedSets :: DefinedSets+ _set1IcollectedNames :: (Set Identifier)+ _set1Ierrors :: (Seq Error)+ _set1InontSet :: (Set NontermIdent)+ _set2IcollectedNames :: (Set Identifier)+ _set2Ierrors :: (Seq Error)+ _set2InontSet :: (Set NontermIdent)+ -- "Transform.ag"(line 444, column 16)+ _lhsOnontSet =+ Set.difference _set1InontSet _set2InontSet+ -- use rule "Transform.ag"(line 75, column 50)+ _lhsOcollectedNames =+ _set1IcollectedNames `Set.union` _set2IcollectedNames+ -- use rule "Transform.ag"(line 36, column 19)+ _lhsOerrors =+ _set1Ierrors Seq.<> _set2Ierrors+ -- copy rule (down)+ _set1OallFields =+ _lhsIallFields+ -- copy rule (down)+ _set1OallNonterminals =+ _lhsIallNonterminals+ -- copy rule (down)+ _set1OdefinedSets =+ _lhsIdefinedSets+ -- copy rule (down)+ _set2OallFields =+ _lhsIallFields+ -- copy rule (down)+ _set2OallNonterminals =+ _lhsIallNonterminals+ -- copy rule (down)+ _set2OdefinedSets =+ _lhsIdefinedSets+ ( _set1IcollectedNames,_set1Ierrors,_set1InontSet) =+ (set1_ _set1OallFields _set1OallNonterminals _set1OdefinedSets)+ ( _set2IcollectedNames,_set2Ierrors,_set2InontSet) =+ (set2_ _set2OallFields _set2OallNonterminals _set2OdefinedSets)+ in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet))))+sem_NontSet_Intersect :: T_NontSet ->+ T_NontSet ->+ T_NontSet+sem_NontSet_Intersect (T_NontSet set1_) (T_NontSet set2_) =+ (T_NontSet (\ _lhsIallFields+ _lhsIallNonterminals+ _lhsIdefinedSets ->+ (let _lhsOnontSet :: (Set NontermIdent)+ _lhsOcollectedNames :: (Set Identifier)+ _lhsOerrors :: (Seq Error)+ _set1OallFields :: DataTypes+ _set1OallNonterminals :: (Set NontermIdent)+ _set1OdefinedSets :: DefinedSets+ _set2OallFields :: DataTypes+ _set2OallNonterminals :: (Set NontermIdent)+ _set2OdefinedSets :: DefinedSets+ _set1IcollectedNames :: (Set Identifier)+ _set1Ierrors :: (Seq Error)+ _set1InontSet :: (Set NontermIdent)+ _set2IcollectedNames :: (Set Identifier)+ _set2Ierrors :: (Seq Error)+ _set2InontSet :: (Set NontermIdent)+ -- "Transform.ag"(line 443, column 16)+ _lhsOnontSet =+ Set.intersection _set1InontSet _set2InontSet+ -- use rule "Transform.ag"(line 75, column 50)+ _lhsOcollectedNames =+ _set1IcollectedNames `Set.union` _set2IcollectedNames+ -- use rule "Transform.ag"(line 36, column 19)+ _lhsOerrors =+ _set1Ierrors Seq.<> _set2Ierrors+ -- copy rule (down)+ _set1OallFields =+ _lhsIallFields+ -- copy rule (down)+ _set1OallNonterminals =+ _lhsIallNonterminals+ -- copy rule (down)+ _set1OdefinedSets =+ _lhsIdefinedSets+ -- copy rule (down)+ _set2OallFields =+ _lhsIallFields+ -- copy rule (down)+ _set2OallNonterminals =+ _lhsIallNonterminals+ -- copy rule (down)+ _set2OdefinedSets =+ _lhsIdefinedSets+ ( _set1IcollectedNames,_set1Ierrors,_set1InontSet) =+ (set1_ _set1OallFields _set1OallNonterminals _set1OdefinedSets)+ ( _set2IcollectedNames,_set2Ierrors,_set2InontSet) =+ (set2_ _set2OallFields _set2OallNonterminals _set2OdefinedSets)+ in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet))))+sem_NontSet_NamedSet :: NontermIdent ->+ T_NontSet+sem_NontSet_NamedSet name_ =+ (T_NontSet (\ _lhsIallFields+ _lhsIallNonterminals+ _lhsIdefinedSets ->+ (let _lhsOcollectedNames :: (Set Identifier)+ _lhsOerrors :: (Seq Error)+ _lhsOnontSet :: (Set NontermIdent)+ -- "Transform.ag"(line 342, column 14)+ _lhsOcollectedNames =+ Set.singleton name_+ -- "Transform.ag"(line 439, column 20)+ __tup4 =+ case Map.lookup name_ _lhsIdefinedSets of+ Nothing -> (Set.empty, Seq.single (UndefNont name_))+ Just set -> (set, Seq.empty)+ -- "Transform.ag"(line 439, column 20)+ (_nontSet,_) =+ __tup4+ -- "Transform.ag"(line 439, column 20)+ (_,_errors) =+ __tup4+ -- use rule "Transform.ag"(line 36, column 19)+ _lhsOerrors =+ _errors+ -- copy rule (from local)+ _lhsOnontSet =+ _nontSet+ in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet))))+sem_NontSet_Path :: NontermIdent ->+ NontermIdent ->+ T_NontSet+sem_NontSet_Path from_ to_ =+ (T_NontSet (\ _lhsIallFields+ _lhsIallNonterminals+ _lhsIdefinedSets ->+ (let _lhsOnontSet :: (Set NontermIdent)+ _lhsOerrors :: (Seq Error)+ _lhsOcollectedNames :: (Set Identifier)+ -- "Transform.ag"(line 445, column 16)+ _lhsOnontSet =+ let table = flattenDatas _lhsIallFields+ in path table from_ to_+ -- "Transform.ag"(line 447, column 16)+ _lhsOerrors =+ let check name | Set.member name _lhsIallNonterminals+ = Seq.empty+ | otherwise = Seq.single (UndefNont name)+ in check from_ <> check to_+ -- use rule "Transform.ag"(line 75, column 50)+ _lhsOcollectedNames =+ Set.empty+ in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet))))+sem_NontSet_Union :: T_NontSet ->+ T_NontSet ->+ T_NontSet+sem_NontSet_Union (T_NontSet set1_) (T_NontSet set2_) =+ (T_NontSet (\ _lhsIallFields+ _lhsIallNonterminals+ _lhsIdefinedSets ->+ (let _lhsOnontSet :: (Set NontermIdent)+ _lhsOcollectedNames :: (Set Identifier)+ _lhsOerrors :: (Seq Error)+ _set1OallFields :: DataTypes+ _set1OallNonterminals :: (Set NontermIdent)+ _set1OdefinedSets :: DefinedSets+ _set2OallFields :: DataTypes+ _set2OallNonterminals :: (Set NontermIdent)+ _set2OdefinedSets :: DefinedSets+ _set1IcollectedNames :: (Set Identifier)+ _set1Ierrors :: (Seq Error)+ _set1InontSet :: (Set NontermIdent)+ _set2IcollectedNames :: (Set Identifier)+ _set2Ierrors :: (Seq Error)+ _set2InontSet :: (Set NontermIdent)+ -- "Transform.ag"(line 442, column 16)+ _lhsOnontSet =+ Set.union _set1InontSet _set2InontSet+ -- use rule "Transform.ag"(line 75, column 50)+ _lhsOcollectedNames =+ _set1IcollectedNames `Set.union` _set2IcollectedNames+ -- use rule "Transform.ag"(line 36, column 19)+ _lhsOerrors =+ _set1Ierrors Seq.<> _set2Ierrors+ -- copy rule (down)+ _set1OallFields =+ _lhsIallFields+ -- copy rule (down)+ _set1OallNonterminals =+ _lhsIallNonterminals+ -- copy rule (down)+ _set1OdefinedSets =+ _lhsIdefinedSets+ -- copy rule (down)+ _set2OallFields =+ _lhsIallFields+ -- copy rule (down)+ _set2OallNonterminals =+ _lhsIallNonterminals+ -- copy rule (down)+ _set2OdefinedSets =+ _lhsIdefinedSets+ ( _set1IcollectedNames,_set1Ierrors,_set1InontSet) =+ (set1_ _set1OallFields _set1OallNonterminals _set1OdefinedSets)+ ( _set2IcollectedNames,_set2Ierrors,_set2InontSet) =+ (set2_ _set2OallFields _set2OallNonterminals _set2OdefinedSets)+ in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet))))+-- Pattern -----------------------------------------------------+{-+ visit 0:+ synthesized attributes:+ copy : SELF+ definedAttrs : [AttrName]+ definedInsts : [Identifier]+ patunder : [AttrName]->Pattern+ stpos : Pos+ 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,([AttrName]),([Identifier]),([AttrName]->Pattern),Pos))+data Inh_Pattern = Inh_Pattern {}+data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern,definedAttrs_Syn_Pattern :: [AttrName],definedInsts_Syn_Pattern :: [Identifier],patunder_Syn_Pattern :: [AttrName]->Pattern,stpos_Syn_Pattern :: Pos}+wrap_Pattern (T_Pattern sem) (Inh_Pattern ) =+ (let ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos) =+ (sem )+ in (Syn_Pattern _lhsOcopy _lhsOdefinedAttrs _lhsOdefinedInsts _lhsOpatunder _lhsOstpos))+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 _lhsOdefinedAttrs :: ([AttrName])+ _lhsOpatunder :: ([AttrName]->Pattern)+ _lhsOdefinedInsts :: ([Identifier])+ _lhsOstpos :: Pos+ _lhsOcopy :: Pattern+ _patIcopy :: Pattern+ _patIdefinedAttrs :: ([AttrName])+ _patIdefinedInsts :: ([Identifier])+ _patIpatunder :: ([AttrName]->Pattern)+ _patIstpos :: Pos+ _partsIcopy :: Patterns+ _partsIdefinedAttrs :: ([AttrName])+ _partsIdefinedInsts :: ([Identifier])+ _partsIpatunder :: ([AttrName]->Patterns)+ -- "Transform.ag"(line 763, column 11)+ _lhsOdefinedAttrs =+ (field_, attr_) : _patIdefinedAttrs+ -- "Transform.ag"(line 764, column 11)+ _lhsOpatunder =+ \us -> if ((field_,attr_) `elem` us) then Underscore noPos else _copy+ -- "Transform.ag"(line 765, column 11)+ _lhsOdefinedInsts =+ (if field_ == _INST then [attr_] else []) ++ _patIdefinedInsts+ -- "Transform.ag"(line 780, column 16)+ _lhsOstpos =+ getPos field_+ -- self rule+ _copy =+ Alias field_ attr_ _patIcopy _partsIcopy+ -- self rule+ _lhsOcopy =+ _copy+ ( _patIcopy,_patIdefinedAttrs,_patIdefinedInsts,_patIpatunder,_patIstpos) =+ (pat_ )+ ( _partsIcopy,_partsIdefinedAttrs,_partsIdefinedInsts,_partsIpatunder) =+ (parts_ )+ in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos)))+sem_Pattern_Constr :: ConstructorIdent ->+ T_Patterns ->+ T_Pattern+sem_Pattern_Constr name_ (T_Patterns pats_) =+ (T_Pattern (let _lhsOpatunder :: ([AttrName]->Pattern)+ _lhsOstpos :: Pos+ _lhsOdefinedAttrs :: ([AttrName])+ _lhsOdefinedInsts :: ([Identifier])+ _lhsOcopy :: Pattern+ _patsIcopy :: Patterns+ _patsIdefinedAttrs :: ([AttrName])+ _patsIdefinedInsts :: ([Identifier])+ _patsIpatunder :: ([AttrName]->Patterns)+ -- "Transform.ag"(line 767, column 12)+ _lhsOpatunder =+ \us -> Constr name_ (_patsIpatunder us)+ -- "Transform.ag"(line 778, column 16)+ _lhsOstpos =+ getPos name_+ -- use rule "Transform.ag"(line 758, column 42)+ _lhsOdefinedAttrs =+ _patsIdefinedAttrs+ -- use rule "Transform.ag"(line 757, column 55)+ _lhsOdefinedInsts =+ _patsIdefinedInsts+ -- self rule+ _copy =+ Constr name_ _patsIcopy+ -- self rule+ _lhsOcopy =+ _copy+ ( _patsIcopy,_patsIdefinedAttrs,_patsIdefinedInsts,_patsIpatunder) =+ (pats_ )+ in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos)))+sem_Pattern_Irrefutable :: T_Pattern ->+ T_Pattern+sem_Pattern_Irrefutable (T_Pattern pat_) =+ (T_Pattern (let _lhsOpatunder :: ([AttrName]->Pattern)+ _lhsOdefinedAttrs :: ([AttrName])+ _lhsOdefinedInsts :: ([Identifier])+ _lhsOcopy :: Pattern+ _lhsOstpos :: Pos+ _patIcopy :: Pattern+ _patIdefinedAttrs :: ([AttrName])+ _patIdefinedInsts :: ([Identifier])+ _patIpatunder :: ([AttrName]->Pattern)+ _patIstpos :: Pos+ -- "Transform.ag"(line 769, column 17)+ _lhsOpatunder =+ \us -> Irrefutable (_patIpatunder us)+ -- use rule "Transform.ag"(line 758, column 42)+ _lhsOdefinedAttrs =+ _patIdefinedAttrs+ -- use rule "Transform.ag"(line 757, column 55)+ _lhsOdefinedInsts =+ _patIdefinedInsts+ -- self rule+ _copy =+ Irrefutable _patIcopy+ -- self rule+ _lhsOcopy =+ _copy+ -- copy rule (up)+ _lhsOstpos =+ _patIstpos+ ( _patIcopy,_patIdefinedAttrs,_patIdefinedInsts,_patIpatunder,_patIstpos) =+ (pat_ )+ in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos)))+sem_Pattern_Product :: Pos ->+ T_Patterns ->+ T_Pattern+sem_Pattern_Product pos_ (T_Patterns pats_) =+ (T_Pattern (let _lhsOpatunder :: ([AttrName]->Pattern)+ _lhsOstpos :: Pos+ _lhsOdefinedAttrs :: ([AttrName])+ _lhsOdefinedInsts :: ([Identifier])+ _lhsOcopy :: Pattern+ _patsIcopy :: Patterns+ _patsIdefinedAttrs :: ([AttrName])+ _patsIdefinedInsts :: ([Identifier])+ _patsIpatunder :: ([AttrName]->Patterns)+ -- "Transform.ag"(line 768, column 13)+ _lhsOpatunder =+ \us -> Product pos_ (_patsIpatunder us)+ -- "Transform.ag"(line 779, column 16)+ _lhsOstpos =+ pos_+ -- use rule "Transform.ag"(line 758, column 42)+ _lhsOdefinedAttrs =+ _patsIdefinedAttrs+ -- use rule "Transform.ag"(line 757, column 55)+ _lhsOdefinedInsts =+ _patsIdefinedInsts+ -- self rule+ _copy =+ Product pos_ _patsIcopy+ -- self rule+ _lhsOcopy =+ _copy+ ( _patsIcopy,_patsIdefinedAttrs,_patsIdefinedInsts,_patsIpatunder) =+ (pats_ )+ in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos)))+sem_Pattern_Underscore :: Pos ->+ T_Pattern+sem_Pattern_Underscore pos_ =+ (T_Pattern (let _lhsOpatunder :: ([AttrName]->Pattern)+ _lhsOstpos :: Pos+ _lhsOdefinedAttrs :: ([AttrName])+ _lhsOdefinedInsts :: ([Identifier])+ _lhsOcopy :: Pattern+ -- "Transform.ag"(line 766, column 16)+ _lhsOpatunder =+ \us -> _copy+ -- "Transform.ag"(line 781, column 16)+ _lhsOstpos =+ pos_+ -- use rule "Transform.ag"(line 758, column 42)+ _lhsOdefinedAttrs =+ []+ -- use rule "Transform.ag"(line 757, column 55)+ _lhsOdefinedInsts =+ []+ -- self rule+ _copy =+ Underscore pos_+ -- self rule+ _lhsOcopy =+ _copy+ in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos)))+-- Patterns ----------------------------------------------------+{-+ visit 0:+ synthesized attributes:+ copy : SELF+ definedAttrs : [AttrName]+ definedInsts : [Identifier]+ patunder : [AttrName]->Patterns+ 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,([AttrName]),([Identifier]),([AttrName]->Patterns)))+data Inh_Patterns = Inh_Patterns {}+data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns,definedAttrs_Syn_Patterns :: [AttrName],definedInsts_Syn_Patterns :: [Identifier],patunder_Syn_Patterns :: [AttrName]->Patterns}+wrap_Patterns (T_Patterns sem) (Inh_Patterns ) =+ (let ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder) =+ (sem )+ in (Syn_Patterns _lhsOcopy _lhsOdefinedAttrs _lhsOdefinedInsts _lhsOpatunder))+sem_Patterns_Cons :: T_Pattern ->+ T_Patterns ->+ T_Patterns+sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) =+ (T_Patterns (let _lhsOpatunder :: ([AttrName]->Patterns)+ _lhsOdefinedAttrs :: ([AttrName])+ _lhsOdefinedInsts :: ([Identifier])+ _lhsOcopy :: Patterns+ _hdIcopy :: Pattern+ _hdIdefinedAttrs :: ([AttrName])+ _hdIdefinedInsts :: ([Identifier])+ _hdIpatunder :: ([AttrName]->Pattern)+ _hdIstpos :: Pos+ _tlIcopy :: Patterns+ _tlIdefinedAttrs :: ([AttrName])+ _tlIdefinedInsts :: ([Identifier])+ _tlIpatunder :: ([AttrName]->Patterns)+ -- "Transform.ag"(line 773, column 10)+ _lhsOpatunder =+ \us -> (_hdIpatunder us) : (_tlIpatunder us)+ -- use rule "Transform.ag"(line 758, column 42)+ _lhsOdefinedAttrs =+ _hdIdefinedAttrs ++ _tlIdefinedAttrs+ -- use rule "Transform.ag"(line 757, column 55)+ _lhsOdefinedInsts =+ _hdIdefinedInsts ++ _tlIdefinedInsts+ -- self rule+ _copy =+ (:) _hdIcopy _tlIcopy+ -- self rule+ _lhsOcopy =+ _copy+ ( _hdIcopy,_hdIdefinedAttrs,_hdIdefinedInsts,_hdIpatunder,_hdIstpos) =+ (hd_ )+ ( _tlIcopy,_tlIdefinedAttrs,_tlIdefinedInsts,_tlIpatunder) =+ (tl_ )+ in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder)))+sem_Patterns_Nil :: T_Patterns+sem_Patterns_Nil =+ (T_Patterns (let _lhsOpatunder :: ([AttrName]->Patterns)+ _lhsOdefinedAttrs :: ([AttrName])+ _lhsOdefinedInsts :: ([Identifier])+ _lhsOcopy :: Patterns+ -- "Transform.ag"(line 772, column 9)+ _lhsOpatunder =+ \us -> []+ -- use rule "Transform.ag"(line 758, column 42)+ _lhsOdefinedAttrs =+ []+ -- use rule "Transform.ag"(line 757, column 55)+ _lhsOdefinedInsts =+ []+ -- self rule+ _copy =+ []+ -- self rule+ _lhsOcopy =+ _copy+ in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder)))+-- SemAlt ------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allAttrDecls : Map NontermIdent (Attributes, Attributes)+ allFields : DataTypes+ nts : Set NontermIdent+ synthesized attributes:+ attrOrderCollect : AttrOrderMap+ collectedInsts : [ (NontermIdent, ConstructorIdent, [Identifier]) ]+ collectedRules : [ (NontermIdent, ConstructorIdent, RuleInfo)]+ collectedSigs : [ (NontermIdent, ConstructorIdent, SigInfo) ]+ errors : Seq Error+ semPragmasCollect : PragmaMap+ alternatives:+ alternative SemAlt:+ child pos : {Pos}+ child constructorSet : ConstructorSet+ child rules : SemDefs+ visit 0:+ local pragmaNames : _+ local attrOrders : _+ local coninfo : _+-}+-- cata+sem_SemAlt :: SemAlt ->+ T_SemAlt+sem_SemAlt (SemAlt _pos _constructorSet _rules) =+ (sem_SemAlt_SemAlt _pos (sem_ConstructorSet _constructorSet) (sem_SemDefs _rules))+-- semantic domain+newtype T_SemAlt = T_SemAlt ((Map NontermIdent (Attributes, Attributes)) ->+ DataTypes ->+ (Set NontermIdent) ->+ ( AttrOrderMap,([ (NontermIdent, ConstructorIdent, [Identifier]) ]),([ (NontermIdent, ConstructorIdent, RuleInfo)]),([ (NontermIdent, ConstructorIdent, SigInfo) ]),(Seq Error),PragmaMap))+data Inh_SemAlt = Inh_SemAlt {allAttrDecls_Inh_SemAlt :: Map NontermIdent (Attributes, Attributes),allFields_Inh_SemAlt :: DataTypes,nts_Inh_SemAlt :: Set NontermIdent}+data Syn_SemAlt = Syn_SemAlt {attrOrderCollect_Syn_SemAlt :: AttrOrderMap,collectedInsts_Syn_SemAlt :: [ (NontermIdent, ConstructorIdent, [Identifier]) ],collectedRules_Syn_SemAlt :: [ (NontermIdent, ConstructorIdent, RuleInfo)],collectedSigs_Syn_SemAlt :: [ (NontermIdent, ConstructorIdent, SigInfo) ],errors_Syn_SemAlt :: Seq Error,semPragmasCollect_Syn_SemAlt :: PragmaMap}+wrap_SemAlt (T_SemAlt sem) (Inh_SemAlt _lhsIallAttrDecls _lhsIallFields _lhsInts) =+ (let ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOerrors,_lhsOsemPragmasCollect) =+ (sem _lhsIallAttrDecls _lhsIallFields _lhsInts)+ in (Syn_SemAlt _lhsOattrOrderCollect _lhsOcollectedInsts _lhsOcollectedRules _lhsOcollectedSigs _lhsOerrors _lhsOsemPragmasCollect))+sem_SemAlt_SemAlt :: Pos ->+ T_ConstructorSet ->+ T_SemDefs ->+ T_SemAlt+sem_SemAlt_SemAlt pos_ (T_ConstructorSet constructorSet_) (T_SemDefs rules_) =+ (T_SemAlt (\ _lhsIallAttrDecls+ _lhsIallFields+ _lhsInts ->+ (let _lhsOsemPragmasCollect :: PragmaMap+ _lhsOattrOrderCollect :: AttrOrderMap+ _lhsOerrors :: (Seq Error)+ _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])+ _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])+ _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])+ _constructorSetIcollectedConstructorNames :: (Set ConstructorIdent)+ _constructorSetIconstructors :: ((Set ConstructorIdent->Set ConstructorIdent))+ _constructorSetIerrors :: (Seq Error)+ _rulesIdefinedInsts :: ([Identifier])+ _rulesIorderDepsCollect :: (Set Dependency)+ _rulesIpragmaNamesCollect :: ([Identifier])+ _rulesIruleInfos :: ([RuleInfo])+ _rulesIsigInfos :: ([SigInfo] )+ -- "Transform.ag"(line 541, column 7)+ _pragmaNames =+ Set.fromList _rulesIpragmaNamesCollect+ -- "Transform.ag"(line 542, column 7)+ _lhsOsemPragmasCollect =+ foldr pragmaMapUnion Map.empty [ pragmaMapSingle nt con _pragmaNames+ | (nt, conset, _) <- _coninfo+ , con <- Set.toList conset+ ]+ -- "Transform.ag"(line 570, column 7)+ _attrOrders =+ [ orderMapSingle nt con _rulesIorderDepsCollect+ | (nt, conset, _) <- _coninfo+ , con <- Set.toList conset+ ]+ -- "Transform.ag"(line 576, column 7)+ _lhsOattrOrderCollect =+ foldr orderMapUnion Map.empty _attrOrders+ -- "Transform.ag"(line 718, column 12)+ _coninfo =+ [ (nt, conset, conkeys)+ | nt <- Set.toList _lhsInts+ , let conmap = Map.findWithDefault Map.empty nt _lhsIallFields+ , let conkeys = Set.fromList (Map.keys conmap)+ , let conset = _constructorSetIconstructors conkeys+ ]+ -- "Transform.ag"(line 725, column 12)+ _lhsOerrors =+ Seq.fromList+ [ UndefAlt nt con+ | (nt, conset, conkeys) <- _coninfo+ , con <- Set.toList (Set.difference conset conkeys)+ ]+ -- "Transform.ag"(line 730, column 12)+ _lhsOcollectedRules =+ [ (nt,con,r)+ | (nt, conset, _) <- _coninfo+ , con <- Set.toList conset+ , r <- _rulesIruleInfos+ ]+ -- "Transform.ag"(line 736, column 12)+ _lhsOcollectedSigs =+ [ (nt,con,ts)+ | (nt, conset, _) <- _coninfo+ , con <- Set.toList conset+ , ts <- _rulesIsigInfos+ ]+ -- "Transform.ag"(line 743, column 12)+ _lhsOcollectedInsts =+ [ (nt,con,_rulesIdefinedInsts)+ | (nt, conset, _) <- _coninfo+ , con <- Set.toList conset+ ]+ ( _constructorSetIcollectedConstructorNames,_constructorSetIconstructors,_constructorSetIerrors) =+ (constructorSet_ )+ ( _rulesIdefinedInsts,_rulesIorderDepsCollect,_rulesIpragmaNamesCollect,_rulesIruleInfos,_rulesIsigInfos) =+ (rules_ )+ in ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOerrors,_lhsOsemPragmasCollect))))+-- SemAlts -----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allAttrDecls : Map NontermIdent (Attributes, Attributes)+ allFields : DataTypes+ nts : Set NontermIdent+ synthesized attributes:+ attrOrderCollect : AttrOrderMap+ collectedInsts : [ (NontermIdent, ConstructorIdent, [Identifier]) ]+ collectedRules : [ (NontermIdent, ConstructorIdent, RuleInfo)]+ collectedSigs : [ (NontermIdent, ConstructorIdent, SigInfo) ]+ errors : Seq Error+ semPragmasCollect : PragmaMap+ alternatives:+ alternative Cons:+ child hd : SemAlt+ child tl : SemAlts+ alternative Nil:+-}+-- cata+sem_SemAlts :: SemAlts ->+ T_SemAlts+sem_SemAlts list =+ (Prelude.foldr sem_SemAlts_Cons sem_SemAlts_Nil (Prelude.map sem_SemAlt list))+-- semantic domain+newtype T_SemAlts = T_SemAlts ((Map NontermIdent (Attributes, Attributes)) ->+ DataTypes ->+ (Set NontermIdent) ->+ ( AttrOrderMap,([ (NontermIdent, ConstructorIdent, [Identifier]) ]),([ (NontermIdent, ConstructorIdent, RuleInfo)]),([ (NontermIdent, ConstructorIdent, SigInfo) ]),(Seq Error),PragmaMap))+data Inh_SemAlts = Inh_SemAlts {allAttrDecls_Inh_SemAlts :: Map NontermIdent (Attributes, Attributes),allFields_Inh_SemAlts :: DataTypes,nts_Inh_SemAlts :: Set NontermIdent}+data Syn_SemAlts = Syn_SemAlts {attrOrderCollect_Syn_SemAlts :: AttrOrderMap,collectedInsts_Syn_SemAlts :: [ (NontermIdent, ConstructorIdent, [Identifier]) ],collectedRules_Syn_SemAlts :: [ (NontermIdent, ConstructorIdent, RuleInfo)],collectedSigs_Syn_SemAlts :: [ (NontermIdent, ConstructorIdent, SigInfo) ],errors_Syn_SemAlts :: Seq Error,semPragmasCollect_Syn_SemAlts :: PragmaMap}+wrap_SemAlts (T_SemAlts sem) (Inh_SemAlts _lhsIallAttrDecls _lhsIallFields _lhsInts) =+ (let ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOerrors,_lhsOsemPragmasCollect) =+ (sem _lhsIallAttrDecls _lhsIallFields _lhsInts)+ in (Syn_SemAlts _lhsOattrOrderCollect _lhsOcollectedInsts _lhsOcollectedRules _lhsOcollectedSigs _lhsOerrors _lhsOsemPragmasCollect))+sem_SemAlts_Cons :: T_SemAlt ->+ T_SemAlts ->+ T_SemAlts+sem_SemAlts_Cons (T_SemAlt hd_) (T_SemAlts tl_) =+ (T_SemAlts (\ _lhsIallAttrDecls+ _lhsIallFields+ _lhsInts ->+ (let _lhsOattrOrderCollect :: AttrOrderMap+ _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])+ _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])+ _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])+ _lhsOerrors :: (Seq Error)+ _lhsOsemPragmasCollect :: PragmaMap+ _hdOallAttrDecls :: (Map NontermIdent (Attributes, Attributes))+ _hdOallFields :: DataTypes+ _hdOnts :: (Set NontermIdent)+ _tlOallAttrDecls :: (Map NontermIdent (Attributes, Attributes))+ _tlOallFields :: DataTypes+ _tlOnts :: (Set NontermIdent)+ _hdIattrOrderCollect :: AttrOrderMap+ _hdIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])+ _hdIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])+ _hdIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])+ _hdIerrors :: (Seq Error)+ _hdIsemPragmasCollect :: PragmaMap+ _tlIattrOrderCollect :: AttrOrderMap+ _tlIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])+ _tlIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])+ _tlIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])+ _tlIerrors :: (Seq Error)+ _tlIsemPragmasCollect :: PragmaMap+ -- use rule "Transform.ag"(line 565, column 55)+ _lhsOattrOrderCollect =+ _hdIattrOrderCollect `orderMapUnion` _tlIattrOrderCollect+ -- use rule "Transform.ag"(line 138, column 29)+ _lhsOcollectedInsts =+ _hdIcollectedInsts ++ _tlIcollectedInsts+ -- use rule "Transform.ag"(line 136, column 29)+ _lhsOcollectedRules =+ _hdIcollectedRules ++ _tlIcollectedRules+ -- use rule "Transform.ag"(line 137, column 29)+ _lhsOcollectedSigs =+ _hdIcollectedSigs ++ _tlIcollectedSigs+ -- use rule "Transform.ag"(line 36, column 19)+ _lhsOerrors =+ _hdIerrors Seq.<> _tlIerrors+ -- use rule "Transform.ag"(line 537, column 56)+ _lhsOsemPragmasCollect =+ _hdIsemPragmasCollect `pragmaMapUnion` _tlIsemPragmasCollect+ -- copy rule (down)+ _hdOallAttrDecls =+ _lhsIallAttrDecls+ -- copy rule (down)+ _hdOallFields =+ _lhsIallFields+ -- copy rule (down)+ _hdOnts =+ _lhsInts+ -- copy rule (down)+ _tlOallAttrDecls =+ _lhsIallAttrDecls+ -- copy rule (down)+ _tlOallFields =+ _lhsIallFields+ -- copy rule (down)+ _tlOnts =+ _lhsInts+ ( _hdIattrOrderCollect,_hdIcollectedInsts,_hdIcollectedRules,_hdIcollectedSigs,_hdIerrors,_hdIsemPragmasCollect) =+ (hd_ _hdOallAttrDecls _hdOallFields _hdOnts)+ ( _tlIattrOrderCollect,_tlIcollectedInsts,_tlIcollectedRules,_tlIcollectedSigs,_tlIerrors,_tlIsemPragmasCollect) =+ (tl_ _tlOallAttrDecls _tlOallFields _tlOnts)+ in ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOerrors,_lhsOsemPragmasCollect))))+sem_SemAlts_Nil :: T_SemAlts+sem_SemAlts_Nil =+ (T_SemAlts (\ _lhsIallAttrDecls+ _lhsIallFields+ _lhsInts ->+ (let _lhsOattrOrderCollect :: AttrOrderMap+ _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])+ _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])+ _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])+ _lhsOerrors :: (Seq Error)+ _lhsOsemPragmasCollect :: PragmaMap+ -- use rule "Transform.ag"(line 565, column 55)+ _lhsOattrOrderCollect =+ Map.empty+ -- use rule "Transform.ag"(line 138, column 29)+ _lhsOcollectedInsts =+ []+ -- use rule "Transform.ag"(line 136, column 29)+ _lhsOcollectedRules =+ []+ -- use rule "Transform.ag"(line 137, column 29)+ _lhsOcollectedSigs =+ []+ -- use rule "Transform.ag"(line 36, column 19)+ _lhsOerrors =+ Seq.empty+ -- use rule "Transform.ag"(line 537, column 56)+ _lhsOsemPragmasCollect =+ Map.empty+ in ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOerrors,_lhsOsemPragmasCollect))))+-- SemDef ------------------------------------------------------+{-+ visit 0:+ synthesized attributes:+ definedInsts : [Identifier]+ orderDepsCollect : Set Dependency+ pragmaNamesCollect : [Identifier]+ ruleInfos : [RuleInfo]+ sigInfos : [SigInfo] + alternatives:+ alternative AttrOrderBefore:+ child before : {[(Identifier,Identifier)]}+ child after : {[(Identifier,Identifier)]}+ visit 0:+ local dependency : _+ alternative Def:+ child pattern : Pattern+ child rhs : {Expression}+ child owrt : {Bool}+ alternative SemPragma:+ child names : {[NontermIdent]}+ alternative TypeDef:+ child ident : {Identifier}+ child tp : {Type}+-}+-- cata+sem_SemDef :: SemDef ->+ T_SemDef+sem_SemDef (AttrOrderBefore _before _after) =+ (sem_SemDef_AttrOrderBefore _before _after)+sem_SemDef (Def _pattern _rhs _owrt) =+ (sem_SemDef_Def (sem_Pattern _pattern) _rhs _owrt)+sem_SemDef (SemPragma _names) =+ (sem_SemDef_SemPragma _names)+sem_SemDef (TypeDef _ident _tp) =+ (sem_SemDef_TypeDef _ident _tp)+-- semantic domain+newtype T_SemDef = T_SemDef (( ([Identifier]),(Set Dependency),([Identifier]),([RuleInfo]),([SigInfo] )))+data Inh_SemDef = Inh_SemDef {}+data Syn_SemDef = Syn_SemDef {definedInsts_Syn_SemDef :: [Identifier],orderDepsCollect_Syn_SemDef :: Set Dependency,pragmaNamesCollect_Syn_SemDef :: [Identifier],ruleInfos_Syn_SemDef :: [RuleInfo],sigInfos_Syn_SemDef :: [SigInfo] }+wrap_SemDef (T_SemDef sem) (Inh_SemDef ) =+ (let ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos) =+ (sem )+ in (Syn_SemDef _lhsOdefinedInsts _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos))+sem_SemDef_AttrOrderBefore :: ([(Identifier,Identifier)]) ->+ ([(Identifier,Identifier)]) ->+ T_SemDef+sem_SemDef_AttrOrderBefore before_ after_ =+ (T_SemDef (let _lhsOorderDepsCollect :: (Set Dependency)+ _lhsOdefinedInsts :: ([Identifier])+ _lhsOpragmaNamesCollect :: ([Identifier])+ _lhsOruleInfos :: ([RuleInfo])+ _lhsOsigInfos :: ([SigInfo] )+ -- "Transform.ag"(line 582, column 7)+ _dependency =+ [ Dependency b a | b <- before_, a <- after_ ]+ -- "Transform.ag"(line 583, column 7)+ _lhsOorderDepsCollect =+ Set.fromList _dependency+ -- use rule "Transform.ag"(line 757, column 55)+ _lhsOdefinedInsts =+ []+ -- use rule "Transform.ag"(line 547, column 46)+ _lhsOpragmaNamesCollect =+ []+ -- use rule "Transform.ag"(line 712, column 37)+ _lhsOruleInfos =+ []+ -- use rule "Transform.ag"(line 713, column 37)+ _lhsOsigInfos =+ []+ in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos)))+sem_SemDef_Def :: T_Pattern ->+ Expression ->+ Bool ->+ T_SemDef+sem_SemDef_Def (T_Pattern pattern_) rhs_ owrt_ =+ (T_SemDef (let _lhsOruleInfos :: ([RuleInfo])+ _lhsOdefinedInsts :: ([Identifier])+ _lhsOorderDepsCollect :: (Set Dependency)+ _lhsOpragmaNamesCollect :: ([Identifier])+ _lhsOsigInfos :: ([SigInfo] )+ _patternIcopy :: Pattern+ _patternIdefinedAttrs :: ([AttrName])+ _patternIdefinedInsts :: ([Identifier])+ _patternIpatunder :: ([AttrName]->Pattern)+ _patternIstpos :: Pos+ -- "Transform.ag"(line 751, column 10)+ _lhsOruleInfos =+ [ (_patternIpatunder, rhs_, _patternIdefinedAttrs, owrt_, show _patternIstpos) ]+ -- use rule "Transform.ag"(line 757, column 55)+ _lhsOdefinedInsts =+ _patternIdefinedInsts+ -- use rule "Transform.ag"(line 578, column 44)+ _lhsOorderDepsCollect =+ Set.empty+ -- use rule "Transform.ag"(line 547, column 46)+ _lhsOpragmaNamesCollect =+ []+ -- use rule "Transform.ag"(line 713, column 37)+ _lhsOsigInfos =+ []+ ( _patternIcopy,_patternIdefinedAttrs,_patternIdefinedInsts,_patternIpatunder,_patternIstpos) =+ (pattern_ )+ in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos)))+sem_SemDef_SemPragma :: ([NontermIdent]) ->+ T_SemDef+sem_SemDef_SemPragma names_ =+ (T_SemDef (let _lhsOpragmaNamesCollect :: ([Identifier])+ _lhsOdefinedInsts :: ([Identifier])+ _lhsOorderDepsCollect :: (Set Dependency)+ _lhsOruleInfos :: ([RuleInfo])+ _lhsOsigInfos :: ([SigInfo] )+ -- "Transform.ag"(line 551, column 7)+ _lhsOpragmaNamesCollect =+ names_+ -- use rule "Transform.ag"(line 757, column 55)+ _lhsOdefinedInsts =+ []+ -- use rule "Transform.ag"(line 578, column 44)+ _lhsOorderDepsCollect =+ Set.empty+ -- use rule "Transform.ag"(line 712, column 37)+ _lhsOruleInfos =+ []+ -- use rule "Transform.ag"(line 713, column 37)+ _lhsOsigInfos =+ []+ in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos)))+sem_SemDef_TypeDef :: Identifier ->+ Type ->+ T_SemDef+sem_SemDef_TypeDef ident_ tp_ =+ (T_SemDef (let _lhsOsigInfos :: ([SigInfo] )+ _lhsOdefinedInsts :: ([Identifier])+ _lhsOorderDepsCollect :: (Set Dependency)+ _lhsOpragmaNamesCollect :: ([Identifier])+ _lhsOruleInfos :: ([RuleInfo])+ -- "Transform.ag"(line 754, column 14)+ _lhsOsigInfos =+ [ (ident_, tp_) ]+ -- use rule "Transform.ag"(line 757, column 55)+ _lhsOdefinedInsts =+ []+ -- use rule "Transform.ag"(line 578, column 44)+ _lhsOorderDepsCollect =+ Set.empty+ -- use rule "Transform.ag"(line 547, column 46)+ _lhsOpragmaNamesCollect =+ []+ -- use rule "Transform.ag"(line 712, column 37)+ _lhsOruleInfos =+ []+ in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos)))+-- SemDefs -----------------------------------------------------+{-+ visit 0:+ synthesized attributes:+ definedInsts : [Identifier]+ orderDepsCollect : Set Dependency+ pragmaNamesCollect : [Identifier]+ ruleInfos : [RuleInfo]+ sigInfos : [SigInfo] + alternatives:+ alternative Cons:+ child hd : SemDef+ child tl : SemDefs+ alternative Nil:+-}+-- cata+sem_SemDefs :: SemDefs ->+ T_SemDefs+sem_SemDefs list =+ (Prelude.foldr sem_SemDefs_Cons sem_SemDefs_Nil (Prelude.map sem_SemDef list))+-- semantic domain+newtype T_SemDefs = T_SemDefs (( ([Identifier]),(Set Dependency),([Identifier]),([RuleInfo]),([SigInfo] )))+data Inh_SemDefs = Inh_SemDefs {}+data Syn_SemDefs = Syn_SemDefs {definedInsts_Syn_SemDefs :: [Identifier],orderDepsCollect_Syn_SemDefs :: Set Dependency,pragmaNamesCollect_Syn_SemDefs :: [Identifier],ruleInfos_Syn_SemDefs :: [RuleInfo],sigInfos_Syn_SemDefs :: [SigInfo] }+wrap_SemDefs (T_SemDefs sem) (Inh_SemDefs ) =+ (let ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos) =+ (sem )+ in (Syn_SemDefs _lhsOdefinedInsts _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos))+sem_SemDefs_Cons :: T_SemDef ->+ T_SemDefs ->+ T_SemDefs+sem_SemDefs_Cons (T_SemDef hd_) (T_SemDefs tl_) =+ (T_SemDefs (let _lhsOdefinedInsts :: ([Identifier])+ _lhsOorderDepsCollect :: (Set Dependency)+ _lhsOpragmaNamesCollect :: ([Identifier])+ _lhsOruleInfos :: ([RuleInfo])+ _lhsOsigInfos :: ([SigInfo] )+ _hdIdefinedInsts :: ([Identifier])+ _hdIorderDepsCollect :: (Set Dependency)+ _hdIpragmaNamesCollect :: ([Identifier])+ _hdIruleInfos :: ([RuleInfo])+ _hdIsigInfos :: ([SigInfo] )+ _tlIdefinedInsts :: ([Identifier])+ _tlIorderDepsCollect :: (Set Dependency)+ _tlIpragmaNamesCollect :: ([Identifier])+ _tlIruleInfos :: ([RuleInfo])+ _tlIsigInfos :: ([SigInfo] )+ -- use rule "Transform.ag"(line 757, column 55)+ _lhsOdefinedInsts =+ _hdIdefinedInsts ++ _tlIdefinedInsts+ -- use rule "Transform.ag"(line 578, column 44)+ _lhsOorderDepsCollect =+ _hdIorderDepsCollect `Set.union` _tlIorderDepsCollect+ -- use rule "Transform.ag"(line 547, column 46)+ _lhsOpragmaNamesCollect =+ _hdIpragmaNamesCollect ++ _tlIpragmaNamesCollect+ -- use rule "Transform.ag"(line 712, column 37)+ _lhsOruleInfos =+ _hdIruleInfos ++ _tlIruleInfos+ -- use rule "Transform.ag"(line 713, column 37)+ _lhsOsigInfos =+ _hdIsigInfos ++ _tlIsigInfos+ ( _hdIdefinedInsts,_hdIorderDepsCollect,_hdIpragmaNamesCollect,_hdIruleInfos,_hdIsigInfos) =+ (hd_ )+ ( _tlIdefinedInsts,_tlIorderDepsCollect,_tlIpragmaNamesCollect,_tlIruleInfos,_tlIsigInfos) =+ (tl_ )+ in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos)))+sem_SemDefs_Nil :: T_SemDefs+sem_SemDefs_Nil =+ (T_SemDefs (let _lhsOdefinedInsts :: ([Identifier])+ _lhsOorderDepsCollect :: (Set Dependency)+ _lhsOpragmaNamesCollect :: ([Identifier])+ _lhsOruleInfos :: ([RuleInfo])+ _lhsOsigInfos :: ([SigInfo] )+ -- use rule "Transform.ag"(line 757, column 55)+ _lhsOdefinedInsts =+ []+ -- use rule "Transform.ag"(line 578, column 44)+ _lhsOorderDepsCollect =+ Set.empty+ -- use rule "Transform.ag"(line 547, column 46)+ _lhsOpragmaNamesCollect =+ []+ -- use rule "Transform.ag"(line 712, column 37)+ _lhsOruleInfos =+ []+ -- use rule "Transform.ag"(line 713, column 37) _lhsOsigInfos = [] in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos)))
+ src-derived/Visage.hs view
@@ -0,0 +1,655 @@++-- UUAGC 0.9.5 (Visage.ag)+module Visage where++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+++import CommonTypes+import UU.Pretty+import AbstractSyntax+import VisagePatterns+import Expression+++import UU.Scanner.Position(Pos)+import CommonTypes+++import UU.Scanner.Position(Pos)+import HsToken++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+-- 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 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+ -- "Visage.ag"(line 103, column 17)+ _lhsOaterm =+ AAppl "Expression" [AString (sQ (showAGPos pos_)), AString (sQ (unlines . showTokens . tokensToStrings $ tks_))]+ 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 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])+ -- "Visage.ag"(line 85, column 18)+ _lhsOaterm =+ AAppl "Child" [AString (sQ (getName name_)), AString (sQ (show tp_)),+ AString (sQ (showMap inh_)),+ AString (sQ (showMap syn_)),+ AAppl "Rules" _rulesIaterms]+ -- "Visage.ag"(line 89, column 18)+ _rulesOisLoc =+ False+ ( _rulesIaterms) =+ (rules_ _rulesOisLoc )+ 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 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])+ -- "Visage.ag"(line 80, column 17)+ _lhsOaterms =+ _hdIaterm : _tlIaterms+ ( _hdIaterm) =+ (hd_ )+ ( _tlIaterms) =+ (tl_ )+ in ( _lhsOaterms)) )+sem_VisageChildren_Nil :: T_VisageChildren+sem_VisageChildren_Nil =+ (T_VisageChildren (let _lhsOaterms :: ([ATerm])+ -- "Visage.ag"(line 81, column 17)+ _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 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])+ -- "Visage.ag"(line 54, column 18)+ _lhsOaterm =+ AAppl "Productions" _nontsIaterms+ ( _nontsIaterms) =+ (nonts_ )+ 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 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])+ -- "Visage.ag"(line 63, column 19)+ _lhsOaterm =+ AAppl "Production" [AString (sQ (getName nt_)), AString (sQ(showMap inh_)),+ AString (sQ(showMap syn_)), AAppl "Alternatives" _altsIaterms]+ ( _altsIaterms) =+ (alts_ )+ 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 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])+ -- "Visage.ag"(line 58, column 17)+ _lhsOaterms =+ _hdIaterm : _tlIaterms+ ( _hdIaterm) =+ (hd_ )+ ( _tlIaterms) =+ (tl_ )+ in ( _lhsOaterms)) )+sem_VisageNonterminals_Nil :: T_VisageNonterminals+sem_VisageNonterminals_Nil =+ (T_VisageNonterminals (let _lhsOaterms :: ([ATerm])+ -- "Visage.ag"(line 59, column 17)+ _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 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+ -- "Visage.ag"(line 119, column 18)+ _lhsOaterm =+ AAppl "Pattern" [AAppl "Alias" [AString (sQ (showAGPos (getPos field_))),+ AString (sQ (getName field_ ++ "." ++ getName attr_)), _patIaterm]]+ ( _patIaterm) =+ (pat_ )+ in ( _lhsOaterm)) )+sem_VisagePattern_VConstr :: ConstructorIdent ->+ T_VisagePatterns ->+ T_VisagePattern+sem_VisagePattern_VConstr name_ (T_VisagePatterns pats_ ) =+ (T_VisagePattern (let _lhsOaterm :: ATerm+ _patsIaterms :: ([ATerm])+ -- "Visage.ag"(line 112, column 18)+ _lhsOaterm =+ AAppl "Pattern" [AAppl "Constr" [AString (sQ (showAGPos (getPos name_))),+ AString (sQ (getName name_)),+ AAppl "Patterns" _patsIaterms]]+ ( _patsIaterms) =+ (pats_ )+ in ( _lhsOaterm)) )+sem_VisagePattern_VProduct :: Pos ->+ T_VisagePatterns ->+ T_VisagePattern+sem_VisagePattern_VProduct pos_ (T_VisagePatterns pats_ ) =+ (T_VisagePattern (let _lhsOaterm :: ATerm+ _patsIaterms :: ([ATerm])+ -- "Visage.ag"(line 115, column 18)+ _lhsOaterm =+ AAppl "Pattern" [AAppl "Product" [AString (sQ (showAGPos pos_)),+ AAppl "Patterns" _patsIaterms]]+ ( _patsIaterms) =+ (pats_ )+ in ( _lhsOaterm)) )+sem_VisagePattern_VUnderscore :: Pos ->+ T_VisagePattern+sem_VisagePattern_VUnderscore pos_ =+ (T_VisagePattern (let _lhsOaterm :: ATerm+ -- "Visage.ag"(line 121, column 18)+ _lhsOaterm =+ AAppl "Pattern" [AAppl "Underscore" [AString (sQ (showAGPos pos_))]]+ in ( _lhsOaterm)) )+sem_VisagePattern_VVar :: Identifier ->+ Identifier ->+ T_VisagePattern+sem_VisagePattern_VVar field_ attr_ =+ (T_VisagePattern (let _lhsOaterm :: ATerm+ -- "Visage.ag"(line 117, column 18)+ _lhsOaterm =+ AAppl "Pattern" [AAppl "Var" [AString (sQ (showAGPos (getPos field_))),+ AString (sQ (getName field_ ++ "." ++ getName attr_))]]+ 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 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])+ -- "Visage.ag"(line 107, column 17)+ _lhsOaterms =+ _hdIaterm : _tlIaterms+ ( _hdIaterm) =+ (hd_ )+ ( _tlIaterms) =+ (tl_ )+ in ( _lhsOaterms)) )+sem_VisagePatterns_Nil :: T_VisagePatterns+sem_VisagePatterns_Nil =+ (T_VisagePatterns (let _lhsOaterms :: ([ATerm])+ -- "Visage.ag"(line 108, column 17)+ _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 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])+ -- "Visage.ag"(line 73, column 17)+ _lhsOaterm =+ AAppl "Alternative" [AString (sQ (getName con_)), AAppl "Children" _childrenIaterms,+ AAppl "Rules" _rulesIaterms,+ AAppl "LocRules" _locrulesIaterms]+ -- "Visage.ag"(line 76, column 18)+ _locrulesOisLoc =+ True+ -- "Visage.ag"(line 77, column 18)+ _rulesOisLoc =+ False+ ( _childrenIaterms) =+ (children_ )+ ( _rulesIaterms) =+ (rules_ _rulesOisLoc )+ ( _locrulesIaterms) =+ (locrules_ _locrulesOisLoc )+ 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 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])+ -- "Visage.ag"(line 68, column 17)+ _lhsOaterms =+ _hdIaterm : _tlIaterms+ ( _hdIaterm) =+ (hd_ )+ ( _tlIaterms) =+ (tl_ )+ in ( _lhsOaterms)) )+sem_VisageProductions_Nil :: T_VisageProductions+sem_VisageProductions_Nil =+ (T_VisageProductions (let _lhsOaterms :: ([ATerm])+ -- "Visage.ag"(line 69, column 17)+ _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 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+ -- "Visage.ag"(line 97, column 18)+ _lhsOaterm =+ AAppl (if _lhsIisLoc then "LocRule" else "Rule")+ ([AString (sQ (getName attr_)), _patIaterm, _rhsIaterm] ++ if _lhsIisLoc then [AString (sQ (show owrt_))] else [])+ ( _patIaterm) =+ (pat_ )+ ( _rhsIaterm) =+ (rhs_ )+ 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 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])+ -- "Visage.ag"(line 92, column 17)+ _lhsOaterms =+ _hdIaterm : _tlIaterms+ -- copy rule (down)+ _hdOisLoc =+ _lhsIisLoc+ -- copy rule (down)+ _tlOisLoc =+ _lhsIisLoc+ ( _hdIaterm) =+ (hd_ _hdOisLoc )+ ( _tlIaterms) =+ (tl_ _tlOisLoc )+ in ( _lhsOaterms))) )+sem_VisageRules_Nil :: T_VisageRules+sem_VisageRules_Nil =+ (T_VisageRules (\ _lhsIisLoc ->+ (let _lhsOaterms :: ([ATerm])+ -- "Visage.ag"(line 93, column 17)+ _lhsOaterms =+ []+ in ( _lhsOaterms))) )
+ src-derived/VisagePatterns.hs view
@@ -0,0 +1,39 @@++-- UUAGC 0.9.5 (VisagePatterns.ag)+module VisagePatterns where++import UU.Scanner.Position(Pos)+import CommonTypes+-- VisagePattern -----------------------------------------------+{-+ 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}+-}+data VisagePattern = VAlias (Identifier) (Identifier) (VisagePattern) + | VConstr (ConstructorIdent) (VisagePatterns) + | VProduct (Pos) (VisagePatterns) + | VUnderscore (Pos) + | VVar (Identifier) (Identifier) +-- VisagePatterns ----------------------------------------------+{-+ alternatives:+ alternative Cons:+ child hd : VisagePattern + child tl : VisagePatterns + alternative Nil:+-}+type VisagePatterns = [VisagePattern]
+ src-derived/VisageSyntax.hs view
@@ -0,0 +1,94 @@++-- UUAGC 0.9.5 (VisageSyntax.ag)+module VisageSyntax where++import CommonTypes+import UU.Pretty+import AbstractSyntax+import VisagePatterns+import Expression+-- VisageChild -------------------------------------------------+{-+ alternatives:+ alternative VChild:+ child name : {Identifier}+ child tp : {Type}+ child inh : {Attributes}+ child syn : {Attributes}+ child rules : VisageRules +-}+data VisageChild = VChild (Identifier) (Type) (Attributes) (Attributes) (VisageRules) +-- VisageChildren ----------------------------------------------+{-+ alternatives:+ alternative Cons:+ child hd : VisageChild + child tl : VisageChildren + alternative Nil:+-}+type VisageChildren = [VisageChild]+-- VisageGrammar -----------------------------------------------+{-+ alternatives:+ alternative VGrammar:+ child nonts : VisageNonterminals +-}+data VisageGrammar = VGrammar (VisageNonterminals) +-- VisageNonterminal -------------------------------------------+{-+ alternatives:+ alternative VNonterminal:+ child nt : {NontermIdent}+ child inh : {Attributes}+ child syn : {Attributes}+ child alts : VisageProductions +-}+data VisageNonterminal = VNonterminal (NontermIdent) (Attributes) (Attributes) (VisageProductions) +-- VisageNonterminals ------------------------------------------+{-+ alternatives:+ alternative Cons:+ child hd : VisageNonterminal + child tl : VisageNonterminals + alternative Nil:+-}+type VisageNonterminals = [VisageNonterminal]+-- VisageProduction --------------------------------------------+{-+ alternatives:+ alternative VProduction:+ child con : {ConstructorIdent}+ child children : VisageChildren + child rules : VisageRules + child locrules : VisageRules +-}+data VisageProduction = VProduction (ConstructorIdent) (VisageChildren) (VisageRules) (VisageRules) +-- VisageProductions -------------------------------------------+{-+ alternatives:+ alternative Cons:+ child hd : VisageProduction + child tl : VisageProductions + alternative Nil:+-}+type VisageProductions = [VisageProduction]+-- VisageRule --------------------------------------------------+{-+ alternatives:+ alternative VRule:+ child fieldattrs : {[(Identifier,Identifier)]}+ child attr : {Identifier}+ child pat : {VisagePattern}+ child rhs : {Expression}+ child owrt : {Bool}+-}+data VisageRule = VRule ([(Identifier,Identifier)]) (Identifier) (VisagePattern) (Expression) (Bool) +-- VisageRules -------------------------------------------------+{-+ alternatives:+ alternative Cons:+ child hd : VisageRule + child tl : VisageRules + alternative Nil:+-}+type VisageRules = [VisageRule]
+ src/ATermAbstractSyntax.hs view
@@ -0,0 +1,23 @@+{-----------------------------------------------------------------------------++ Haskell ATerm Library+ + Joost Visser+ CWI, Amsterdam++ This module is part of the ATerm library for Haskell. It defines the+ abstract syntax of ATerms as a Haskell datatype.+ +------------------------------------------------------------------------------}++module ATermAbstractSyntax where++-- Abstract syntax -----------------------------------------------------------++data ATerm = AAppl String [ATerm]+ | AList [ATerm]+ | AInt Integer+ | AString String+ deriving (Read,Show,Eq,Ord)++------------------------------------------------------------------------------
+ src/ATermWrite.hs view
@@ -0,0 +1,24 @@+module ATermWrite where + +import ATermAbstractSyntax + +writeATerm t = writeAT 0 t + +writeAT :: Int -> ATerm -> String +writeAT n (AAppl c ts) = (if (n > 0) then "\n" else "") + ++ replicate n ' ' + ++ writeATermAux c (map (writeAT (n+2)) ts) +writeAT n (AList ts) = bracket (commaSep (map (writeAT n) ts)) +writeAT n (AInt i) = show i +writeAT n (AString s) = quote s + +writeATermAux c [] = c++(parenthesise "") +writeATermAux c ts = c++(parenthesise (commaSep ts)) + +sepBy sep (x:y:ys) = x:sep:sepBy sep (y:ys) +sepBy sep ys = ys + +commaSep strs = concat (sepBy "," strs) +bracket str = "["++str++"]" +parenthesise str = "("++str++")" +quote str = "\""++str++"\""
src/Ag.hs view
@@ -6,7 +6,8 @@ import Monad (zipWithM_) import Data.Maybe -import qualified Data.Map as Map (elems, partitionWithKey, unionWith)+import qualified Data.Set as Set+import qualified Data.Map as Map import qualified UU.DData.Seq as Seq ((<>),toList) import Pretty @@ -21,15 +22,18 @@ import qualified GenerateCode as Pass4 (sem_CGrammar, wrap_CGrammar, Syn_CGrammar(..), Inh_CGrammar(..)) import qualified PrintCode as Pass5 (sem_Program, wrap_Program, Syn_Program (..), Inh_Program (..)) import qualified PrintErrorMessages as PrErr (sem_Errors , wrap_Errors , Syn_Errors (..), Inh_Errors (..), isError)+import qualified TfmToVisage as PassV (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..)) import qualified AbstractSyntaxDump as GrammarDump (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..)) import qualified CodeSyntaxDump as CGrammarDump (sem_CGrammar, wrap_CGrammar, Syn_CGrammar (..), Inh_CGrammar (..))+import qualified Visage as VisageDump (sem_VisageGrammar, wrap_VisageGrammar, Syn_VisageGrammar(..), Inh_VisageGrammar(..)) import Options import Version (banner) import Parser (parseAG, depsAG) import ErrorMessages (Error(ParserError), Errors)-import CommonTypes (Blocks)+import CommonTypes+import ATermWrite main :: IO ()@@ -52,14 +56,17 @@ compile :: Options -> String -> String -> IO () compile flags input output = do (output0,parseErrors) <- parseAG (searchPath flags) (inputFile input)+ irrefutableMap <- readIrrefutableMap flags let output1 = Pass1.wrap_AG (Pass1.sem_AG output0 ) Pass1.Inh_AG {Pass1.options_Inh_AG = flags} flags' = Pass1.pragmas_Syn_AG output1 $ flags grammar1 = Pass1.output_Syn_AG output1- output1a = Pass1a.wrap_Grammar (Pass1a.sem_Grammar grammar1 ) Pass1a.Inh_Grammar {Pass1a.options_Inh_Grammar = flags'}+ output1a = Pass1a.wrap_Grammar (Pass1a.sem_Grammar grammar1 ) Pass1a.Inh_Grammar {Pass1a.options_Inh_Grammar = flags', Pass1a.forcedIrrefutables_Inh_Grammar = irrefutableMap } grammar1a =Pass1a.output_Syn_Grammar output1a output2 = Pass2.wrap_Grammar (Pass2.sem_Grammar grammar1a ) Pass2.Inh_Grammar {Pass2.options_Inh_Grammar = flags'} grammar2 = Pass2.output_Syn_Grammar output2+ outputV = PassV.wrap_Grammar (PassV.sem_Grammar grammar2 ) PassV.Inh_Grammar {}+ grammarV = PassV.visage_Syn_Grammar outputV output3 = Pass3.wrap_Grammar (Pass3.sem_Grammar grammar2 ) Pass3.Inh_Grammar {Pass3.options_Inh_Grammar = flags'} grammar3 = Pass3.output_Syn_Grammar output3 output4 = Pass4.wrap_CGrammar (Pass4.sem_CGrammar(Pass3.output_Syn_Grammar output3)) Pass4.Inh_CGrammar {Pass4.options_Inh_CGrammar = flags'}@@ -69,6 +76,9 @@ dump1 = GrammarDump.wrap_Grammar (GrammarDump.sem_Grammar grammar1 ) GrammarDump.Inh_Grammar dump2 = GrammarDump.wrap_Grammar (GrammarDump.sem_Grammar grammar2 ) GrammarDump.Inh_Grammar dump3 = CGrammarDump.wrap_CGrammar (CGrammarDump.sem_CGrammar grammar3 ) CGrammarDump.Inh_CGrammar+ + outputVisage = VisageDump.wrap_VisageGrammar (VisageDump.sem_VisageGrammar grammarV) VisageDump.Inh_VisageGrammar+ aterm = VisageDump.aterm_Syn_VisageGrammar outputVisage parseErrorList = map message2error parseErrors errorList = parseErrorList@@ -79,12 +89,12 @@ Seq.<> Pass4.errors_Syn_CGrammar output4 ) - fatalErrorList = filter PrErr.isError errorList+ fatalErrorList = filter (PrErr.isError flags') errorList allErrors = if null parseErrors then if wignore flags' then fatalErrorList- else errorsToFront errorList+ else errorsToFront flags' errorList else take 1 parseErrorList -- the other 1000 or so parse errors are usually not that informative @@ -120,10 +130,10 @@ mainName = stripPath $ defaultModuleName input mainFile = defaultModuleName input - nrOfErrorsToReport = length $ filter PrErr.isError errorsToReport- nrOfWarningsToReport = length $ filter (not.PrErr.isError) errorsToReport- totalNrOfErrors = length $ filter PrErr.isError allErrors- totalNrOfWarnings = length $ filter (not.PrErr.isError) allErrors+ nrOfErrorsToReport = length $ filter (PrErr.isError flags') errorsToReport+ nrOfWarningsToReport = length $ filter (not.(PrErr.isError flags')) errorsToReport+ totalNrOfErrors = length $ filter (PrErr.isError flags') allErrors+ totalNrOfWarnings = length $ filter (not.(PrErr.isError flags')) allErrors additionalErrors = totalNrOfErrors - nrOfErrorsToReport additionalWarnings = totalNrOfWarnings - nrOfWarningsToReport pluralS n = if n == 1 then "" else "s"@@ -141,12 +151,22 @@ if not (null fatalErrorList) then exitFailure- else if sepSemMods flags'+ else + do if genvisage flags'+ then writeFile (outputfile++".visage") (writeATerm aterm)+ else return ()+ + if genAttributeList flags'+ then writeAttributeList (outputfile++".attrs") (Pass1a.allAttributes_Syn_Grammar output1a)+ else return ()++ if sepSemMods flags' then do -- alternative module gen Pass5.genIO_Syn_Program output5 if not (null errorsToStopOn) then exitFailure else return () else do -- conventional module gen let doc = vlist [ pp optionsLine+ , pp pragmaBlocksTxt , pp $ take 70 ("-- UUAGC " ++ drop 50 banner ++ " (" ++ input) ++ ")" , pp $ if isNothing $ Pass1.moduleDecl_Syn_AG output1 then moduleHeader flags' mainName@@ -191,8 +211,8 @@ Other ms -> ms -errorsToFront :: [Error] -> [Error]-errorsToFront mesgs = filter PrErr.isError mesgs ++ filter (not.PrErr.isError) mesgs+errorsToFront :: Options -> [Error] -> [Error]+errorsToFront flags mesgs = filter (PrErr.isError flags) mesgs ++ filter (not.(PrErr.isError flags)) mesgs moduleHeader :: Options -> String -> String@@ -258,4 +278,21 @@ combine :: ([a],[b]) -> ([a], [b]) -> ([a], [b]) combine (fs, mesgs) (fsr, mesgsr) = (fs ++ fsr, mesgs ++ mesgsr)+++writeAttributeList :: String -> AttrMap -> IO ()+writeAttributeList file mp+ = writeFile file s+ where+ s = show $ map (\(x,y) -> (show x, y)) $ Map.toList $ Map.map (map (\(x,y) -> (show x, y)) . Map.toList . Map.map (map (\(x,y) -> (show x, show y)) . Set.toList)) $ mp++readIrrefutableMap :: Options -> IO AttrMap+readIrrefutableMap flags+ = case forceIrrefutables flags of+ Just file -> do s <- readFile file+ seq (length s) (return ())+ let lists :: [(String,[(String,[(String, String)])])]+ lists = read s+ return $ Map.fromList [ (identifier n, Map.fromList [(identifier c, Set.fromList [ (identifier fld, identifier attr) | (fld,attr) <- ss ]) | (c,ss) <- cs ]) | (n,cs) <- lists ]+ Nothing -> return Map.empty
src/CommonTypes.hs view
@@ -1,6 +1,5 @@ module CommonTypes where ---import UU.Pretty (PP,text,pp) import Pretty import UU.Scanner.Position(Pos,noPos) import qualified Data.Map as Map@@ -26,7 +25,7 @@ pp = text . getName data Type = Haskell String- | NT Name+ | NT Identifier [String] data ComplexType = List Type | Tuple [(Identifier, Type)]@@ -38,30 +37,27 @@ show (Maybe t ) = "Maybe " ++ show t instance Show Type where- show (Haskell t) = t- show (NT nt ) = getName nt--instance Eq Type where- NT x == NT y = x == y- _ == _ = False- -type Attributes = Map Name Type-type TypeSyns = [(Nonterminal,ComplexType)]+ show = typeToHaskellString Nothing [] -type AttrNames = [(Name,Type,(String,String,String))]-type UseMap = Map Nonterminal (Map Name (String,String,String))-type PragmaMap = Map Nonterminal (Map Constructor (Set Name))-type Fields = [(Name,Type)]-type Derivings = Map Nonterminal (Set Name)+type Attributes = Map Identifier Type+type TypeSyns = [(NontermIdent,ComplexType)]+type ParamMap = Map NontermIdent [Identifier]+type AttrNames = [(Identifier,Type,(String,String,String))]+type UseMap = Map NontermIdent (Map Identifier (String,String,String))+type PragmaMap = Map NontermIdent (Map ConstructorIdent (Set Identifier))+type AttrMap = Map NontermIdent (Map ConstructorIdent (Set (Identifier,Identifier)))+type Fields = [(Identifier,Type)]+type Derivings = Map NontermIdent (Set Identifier)+type ClassContext = [(Identifier, [String])]+type ContextMap = Map NontermIdent ClassContext type Strings = [String]-type Name = Identifier-type Nonterminal = Name-type Constructor = Name-type AttrOrderMap = Map Nonterminal (Map Constructor (Set Dependency))+type NontermIdent = Identifier+type ConstructorIdent = Identifier+type AttrOrderMap = Map NontermIdent (Map ConstructorIdent (Set Dependency)) data Dependency = Dependency (Identifier,Identifier) (Identifier,Identifier) deriving (Eq,Ord,Show) -type AttrEnv = ( [Name]- , [(Name,Name)]+type AttrEnv = ( [Identifier]+ , [(Identifier,Identifier)] ) identifier x = Ident x noPos @@ -75,23 +71,23 @@ _FIRST = identifier "first" _LAST = identifier "last" -sdtype :: Nonterminal -> String+sdtype :: NontermIdent -> String sdtype nt = "T_"++getName nt -cataname :: String -> Name -> String+cataname :: String -> Identifier -> String cataname pre name = pre++getName name -conname :: Bool -> Nonterminal -> Constructor -> String+conname :: Bool -> NontermIdent -> ConstructorIdent -> String conname rename nt con | rename = getName nt ++ "_" ++ getName con | otherwise = getName con -semname :: String -> Nonterminal -> Constructor -> String+semname :: String -> NontermIdent -> ConstructorIdent -> String semname pre nt con = pre ++ (getName nt ++ "_" ++ getName con) -lhsname :: Bool -> Name -> String+lhsname :: Bool -> Identifier -> String lhsname isIn = attrname isIn _LHS -attrname :: Bool -> Name -> Name -> String+attrname :: Bool -> Identifier -> Identifier -> String attrname isIn field attr | field == _LOC = locname attr | field == _INST = instname attr | field == _INST' = inst'name attr@@ -105,25 +101,47 @@ inst'name v = getName v ++ "_" fieldname v = getName v++"_" -typeToString :: Nonterminal -> Type -> String-typeToString _ (Haskell t) = t-typeToString nt (NT t ) | t == _SELF = getName nt- | otherwise = getName t+typeToAGString :: Type -> String+typeToAGString tp+ = case tp of+ Haskell t -> t+ NT nt tps -> formatNonterminalToHaskell (getName nt) (map (\s -> "{" ++ s ++ "}") tps) +typeToHaskellString :: Maybe NontermIdent -> [String] -> Type -> String+typeToHaskellString mbNt params tp+ = case tp of+ Haskell t -> t+ NT nt tps | nt == _SELF -> formatNonterminalToHaskell (maybe "Unknown" getName mbNt) params+ | otherwise -> formatNonterminalToHaskell (getName nt) tps++formatNonterminalToHaskell :: String -> [String] -> String+formatNonterminalToHaskell nt tps+ = unwords (nt:tps)+ ind :: String -> String ind s = replicate 3 ' ' ++ s -_NOCASE :: Name+_NOCASE :: Identifier _NOCASE = identifier "nocase" -hasPragma :: PragmaMap -> Nonterminal -> Constructor -> Name -> Bool+hasPragma :: PragmaMap -> NontermIdent -> ConstructorIdent -> Identifier -> Bool hasPragma mp nt con nm = nm `Set.member` Map.findWithDefault Set.empty con (Map.findWithDefault Map.empty nt mp) isNonterminal :: Type -> Bool-isNonterminal (NT _) = True-isNonterminal _ = False+isNonterminal (NT _ _) = True+isNonterminal _ = False -extractNonterminal :: Type -> Nonterminal-extractNonterminal (NT n) = n+isSELFNonterminal :: Type -> Bool+isSELFNonterminal (NT nt _) | nt == _SELF = True+isSELFNonterminal _ = False++extractNonterminal :: Type -> NontermIdent+extractNonterminal (NT n _) = n++nontermArgs :: Type -> [String]+nontermArgs tp+ = case tp of+ NT _ args -> args+ _ -> []
src/DepTypes.hs view
@@ -21,15 +21,15 @@ -- kan helaas niet met named fields, want dat levert een conflict op in de uniekheid vd naamgeving. -- ERROR "CommonTypes.hs" (line 44): Repeated definition for selector "nt" -data Vertex = Local Name Name Name -- lhs nt, constructor, attribute- | LHSInh Name Name Name -- lhs nt, constructor, attribute- | LHSSyn Name Name Name -- lhs nt, constructor, attribute- | ShRHSInh Name Name Name Name -- lhs nt, constructor, field, attribute !!rhs nt not known, equal to RHSInh!!- | ShRHSSyn Name Name Name Name -- lhs nt, constructor, field, attribute !!rhs nt not known, equal to RHSSyn!!- | RHSInh Name Name Name Name Name -- rhs nt, lhs nt, constructor, field, attribute- | RHSSyn Name Name Name Name Name -- rhs nt, lhs nt, constructor, field, attribute- | NTInh Name Name -- nt, attribute- | NTSyn Name Name -- nt, attribute+data Vertex = Local Identifier Identifier Identifier -- lhs nt, constructor, attribute+ | LHSInh Identifier Identifier Identifier -- lhs nt, constructor, attribute+ | LHSSyn Identifier Identifier Identifier -- lhs nt, constructor, attribute+ | ShRHSInh Identifier Identifier Identifier Identifier -- lhs nt, constructor, field, attribute !!rhs nt not known, equal to RHSInh!!+ | ShRHSSyn Identifier Identifier Identifier Identifier -- lhs nt, constructor, field, attribute !!rhs nt not known, equal to RHSSyn!!+ | RHSInh Identifier Identifier Identifier Identifier Identifier -- rhs nt, lhs nt, constructor, field, attribute+ | RHSSyn Identifier Identifier Identifier Identifier Identifier -- rhs nt, lhs nt, constructor, field, attribute+ | NTInh Identifier Identifier -- nt, attribute+ | NTSyn Identifier Identifier -- nt, attribute instance Eq Vertex where Local lhs1 con1 attr1 == Local lhs2 con2 attr2 = lhs1==lhs2 && con1==con2 && attr1==attr2@@ -86,18 +86,18 @@ type UseStream = (Vertex,Stream) type Stream = [Result] type Result = ([UsedAttr],[UsedAttr])-data UsedAttr = Loc Name Name Trace -- field name and attribute name- | Glo Name Trace -- attribute name+data UsedAttr = Loc Identifier Identifier Trace -- field name and attribute name+ | Glo Identifier Trace -- attribute name -- lhs en rhs slaan op de lhs en rhs van een attribute equation en niet van de productie!! data TraceElem = TE { lineNr :: Int- , nt :: Nonterminal- , prod :: Name- , lhsNt :: Nonterminal- , lhsFld :: Name- , lhsAttr :: Name- , rhsFld :: Name- , rhsAttr :: Name } deriving Show+ , nt :: NontermIdent+ , prod :: Identifier+ , lhsNt :: NontermIdent+ , lhsFld :: Identifier+ , lhsAttr :: Identifier+ , rhsFld :: Identifier+ , rhsAttr :: Identifier } deriving Show type Trace = [TraceElem] @@ -105,7 +105,7 @@ getTrace (Loc _ _ trace) = trace getTrace (Glo _ trace) = trace -toPair :: UsedAttr -> (Name,Trace)+toPair :: UsedAttr -> (Identifier,Trace) toPair (Loc _ attr trace) = (attr,trace) toPair (Glo attr trace) = (attr,trace)
src/GrammarInfo.hs view
@@ -15,8 +15,8 @@ , attrTable :: Table NTAttr , ruleTable :: Table CRule , lmh :: [LMH]- , prods :: [(Nonterminal,[Constructor])]- , wraps :: Set Nonterminal+ , nonts :: [(NontermIdent,[ConstructorIdent])]+ , wraps :: Set NontermIdent } deriving Show @@ -25,8 +25,8 @@ = "CRule " ++ show name ++ " nt: " ++ show nt ++ " con: " ++ show con ++ " field: " ++ show field ++ " childnt: " ++ show childnt ++ " rhs: " ++ concat rhs ++ " uses: " ++ show [ attrname True fld nm | (fld,nm) <- Set.toList uses ] -type CInterfaceMap = Map Nonterminal CInterface-type CVisitsMap = Map Nonterminal (Map Constructor CVisits)+type CInterfaceMap = Map NontermIdent CInterface+type CVisitsMap = Map NontermIdent (Map ConstructorIdent CVisits) data CycleStatus = CycleFree CInterfaceMap CVisitsMap@@ -39,7 +39,7 @@ showsSegment (CSegment inh syn) = let syn' = map toString (Map.toList syn) inh' = map toString (Map.toList inh)- toString (a,t) = (getName a, case t of (NT nt) -> getName nt; Haskell t -> t)+ toString (a,t) = (getName a, case t of (NT nt tps) -> getName nt ++ " " ++ unwords tps; Haskell t -> t) chnn = inh' `intersect` syn' inhn = inh' \\ chnn synn = syn' \\ chnn
src/HsTokenScanner.hs view
@@ -48,8 +48,8 @@ ('.':r:rs) | isIdStart r -> let (at,p3,rest2) = scanIdent (advc 2 p2) rs attr = r : at- in AGField (Ident field p) (Ident attr p) p : doScan p3 rest2- _ -> AGLocal (Ident field p) p : doScan p2 rest+ in AGField (Ident field p) (Ident attr p) p Nothing : doScan p3 rest2+ _ -> AGLocal (Ident field p) p Nothing : doScan p2 rest doScan p ('-':'-':s) = doScan p (dropWhile (/= '\n') s) doScan p ('{':'-':s) = advc' 2 p (lexNest doScan) s -- }
src/Options.hs view
@@ -44,10 +44,14 @@ , Option [] ["dumpgrammar"] (NoArg dumpgrammarOpt) "Dump internal grammar representation (in generated code)" , Option [] ["dumpcgrammar"] (NoArg dumpcgrammarOpt) "Dump internal cgrammar representation (in generated code)" , Option [] ["gentraces"] (NoArg genTracesOpt) "Generate trace expressions (in generated code)"+ , Option [] ["genusetraces"] (NoArg genUseTracesOpt) "Generate trace expressions at attribute use sites (in generated code)" , Option [] ["gencostcentres"] (NoArg genCostCentresOpt) "Generate cost centre pragmas (in generated code)" , Option [] ["genlinepragmas"] (NoArg genLinePragmasOpt) "Generate GHC LINE pragmas (in generated code)" , Option [] ["sepsemmods"] (NoArg sepSemModsOpt) "Generate separate modules for semantic functions (in generated code)" , Option ['M'] ["genfiledeps"] (NoArg genFileDepsOpt) "Generate a list of dependencies on the input AG files"+ , Option [] ["genvisage"] (NoArg genVisageOpt) "Generate output for the AG visualizer Visage"+ , Option [] ["genattrlist"] (NoArg genAttrListOpt) "Generate a list of all explicitly defined attributes (outside irrefutable patterns)"+ , Option [] ["forceirrefutable"] (OptArg forceIrrefutableOpt "file") "Force a set of explicitly defined attributes to be irrefutable, specify file containing the attribute set" ] allc = "dcfsprm"@@ -90,10 +94,14 @@ , dumpgrammar :: Bool , dumpcgrammar :: Bool , genTraces :: Bool+ , genUseTraces :: Bool , genCostCentres :: Bool , sepSemMods :: Bool , genFileDeps :: Bool , genLinePragmas :: Bool+ , genvisage :: Bool+ , genAttributeList :: Bool+ , forceIrrefutables :: Maybe String } deriving Show noOptions = Options { moduleName = NoName , dataTypes = False@@ -133,10 +141,14 @@ , dumpgrammar = False , dumpcgrammar = False , genTraces = False+ , genUseTraces = False , genCostCentres = False , sepSemMods = False , genFileDeps = False , genLinePragmas = False+ , genvisage = False+ , genAttributeList = False+ , forceIrrefutables = Nothing } @@ -176,10 +188,14 @@ dumpgrammarOpt opts = opts{dumpgrammar = True} dumpcgrammarOpt opts = opts{dumpcgrammar = True} genTracesOpt opts = opts{genTraces = True}+genUseTracesOpt opts = opts{genUseTraces = True} genCostCentresOpt opts = opts{genCostCentres = True} sepSemModsOpt opts = opts{sepSemMods = True} genFileDepsOpt opts = opts{genFileDeps = True} genLinePragmasOpt opts = opts{genLinePragmas = True}+genVisageOpt opts = opts{genvisage = True }+genAttrListOpt opts = opts { genAttributeList = True }+forceIrrefutableOpt mbNm opts = opts { forceIrrefutables = mbNm } outputOpt file opts = opts{outputFiles = file : outputFiles opts} searchPathOpt path opts = opts{searchPath = extract path ++ searchPath opts}
src/Parser.hs view
@@ -19,7 +19,8 @@ import UU.Scanner.GenTokenParser import UU.Scanner.Position import UU.Scanner.TokenShow() -import System.Directory +import System.Directory+import HsTokenScanner type AGParser = AnaParser Input Pair Token Pos @@ -129,7 +130,7 @@ <|> All <$ pStar <|> pParens set0 -pNames :: AGParser [Name] +pNames :: AGParser [Identifier] pNames = pList1 pIdentifier pAG :: AGParser AG @@ -138,27 +139,33 @@ pElems :: AGParser Elems pElems = pList_ng pElem -pComplexType = List <$> pBracks pType +pComplexType = List <$> pBracks pTypeEncapsulated <|> Maybe <$ pMAYBE <*> pType <|> tuple <$> pParens (pListSep pComma field) - where field = (,) <$> ((Just <$> pIdentifier <* pColon) `opt` Nothing) <*> pType + where field = (,) <$> ((Just <$> pIdentifier <* pColon) `opt` Nothing) <*> pTypeEncapsulated tuple xs = Tuple [(fromMaybe (Ident ("x"++show n) noPos) f, t) | (n,(f,t)) <- zip [1..] xs ] pElem :: AGParser Elem -pElem = Data <$> pDATA - <*> pNontSet +pElem = Data <$> pDATA+ <*> pOptClassContext + <*> pNontSet+ <*> pList pIdentifier <*> pOptAttrs <*> pAlts <*> pSucceed False - <|> Attr <$> pATTR + <|> Attr <$> pATTR+ <*> pOptClassContext <*> pNontSet <*> pAttrs - <|> Type <$> pTYPE - <*> pIdentifierU + <|> Type <$> pTYPE+ <*> pOptClassContext + <*> pIdentifierU+ <*> pList pIdentifier <* pEquals <*> pComplexType - <|> Sem <$> pSEM + <|> Sem <$> pSEM+ <*> pOptClassContext <*> pNontSet <*> pOptAttrs <*> pSemAlts @@ -185,11 +192,21 @@ <|> codeBlock <$> (pIdentifier <|> pSucceed (Ident "" noPos)) <*> pCodeBlock <?> "a statement" where codeBlock nm (txt,pos) = Txt pos nm (lines txt) + -- Insertion is expensive for pCodeBlock in order to prevent infinite inserts. pCodeBlock :: AGParser (String,Pos) pCodeBlock = pCostValToken 90 TkTextln "" <?> "a code block" +pOptClassContext :: AGParser ClassContext+pOptClassContext+ = pClassContext <* pDoubleArrow+ <|> pSucceed []++pClassContext :: AGParser ClassContext+pClassContext+ = pListSep pComma ((,) <$> pIdentifierU <*> pList pTypeHaskellAnyAsString)+ pAttrs :: AGParser Attrs pAttrs = Attrs <$> pOBrackPos <*> (concat <$> pList pInhAttrNames <?> "inherited attribute declarations") <* pBar <*> (concat <$> pList pAttrNames <?> "chained attribute declarations" ) @@ -197,10 +214,29 @@ <* pCBrack pOptAttrs :: AGParser Attrs -pOptAttrs = pAttrs `opt` Attrs noPos [] [] [] +pOptAttrs = pAttrs `opt` Attrs noPos [] [] []++pTypeNt :: AGParser Type+pTypeNt+ = (\nt -> NT nt []) <$> pIdentifierU+ <|> pParens (NT <$> pIdentifierU <*> pList pTypeHaskellAnyAsString)++pTypeHaskellAnyAsString :: AGParser String+pTypeHaskellAnyAsString+ = getName <$> pIdentifier+ <|> getName <$> pIdentifierU+ <|> pCodescrap' <?> "a type"++-- if the type is within some kind of parentheses or brackets (then we allow lowercase identifiers as well)+pTypeEncapsulated :: AGParser Type+pTypeEncapsulated+ = pParens pTypeEncapsulated+ <|> NT <$> pIdentifierU <*> pList pTypeHaskellAnyAsString+ <|> (Haskell . getName) <$> pIdentifier+ <|> Haskell <$> pCodescrap' <?> "a type" pType :: AGParser Type -pType = NT <$> pIdentifierU +pType = pTypeNt <|> Haskell <$> pCodescrap' <?> "a type" @@ -231,7 +267,7 @@ pField :: AGParser Fields pField = (\nms tp -> map (flip (,) tp) nms) <$> pIdentifiers <* pColon <*> pType - <|> (\s -> [(Ident (mklower (getName s)) (getPos s) ,NT s)]) <$> pIdentifierU + <|> (\s -> [(Ident (mklower (getName s)) (getPos s) ,NT s [])]) <$> pIdentifierU mklower :: String -> String mklower (x:xs) = toLower x : xs @@ -256,8 +292,9 @@ pSemAlts :: AGParser SemAlts pSemAlts = pList pSemAlt <?> "SEM alternatives" -pFieldIdentifier = pIdentifier - <|> Ident "lhs" <$> pLHS +pFieldIdentifier :: AGParser Identifier+pFieldIdentifier = pIdentifier + <|> Ident "lhs" <$> pLHS <|> Ident "loc" <$> pLOC <|> Ident "inst" <$> pINST @@ -266,16 +303,16 @@ <|> pLOC *> pList1 pLocDecl <|> pINST *> pList1 pInstDecl <|> pSEMPRAGMA *> pList1 (SemPragma <$> pNames)- <|> (\a b -> [AttrOrderBefore a b]) <$> pAttr <* pSmaller <*> pAttr+ <|> (\a b -> [AttrOrderBefore a [b]]) <$> pList1 pAttr <* pSmaller <*> pAttr <|> (\pat owrt exp -> [Def (pat ()) exp owrt]) <$> pPattern (const <$> pAttr) <*> pAssign <*> pExpr pAttr = (,) <$> pFieldIdentifier <* pDot <*> pIdentifier -pAttrDef :: AGParser (Name -> SemDef) +pAttrDef :: AGParser (Identifier -> SemDef) pAttrDef = (\pat owrt exp fld -> Def (pat fld) exp owrt) <$ pDot <*> pattern <*> pAssign <*> pExpr where pattern = pPattern pVar - <|> (\a fld -> Alias fld a (Underscore noPos) []) <$> pIdentifier + <|> (\ir a fld -> ir $ Alias fld a (Underscore noPos) []) <$> ((Irrefutable <$ pTilde) `opt` id) <*> pIdentifier nl2sp :: Char -> Char @@ -292,36 +329,36 @@ pInstDecl :: AGParser SemDef pInstDecl = (\ident tp -> TypeDef ident tp)- <$ pDot <*> pIdentifier <* pColon <*> (NT <$> pIdentifierU) + <$ pDot <*> pIdentifier <* pColon <*> pTypeNt pSemDefs :: AGParser SemDefs pSemDefs = concat <$> pList_ng pSemDef <?> "attribute rules" -pVar :: AGParser (Name -> (Name, Name)) +pVar :: AGParser (Identifier -> (Identifier, Identifier)) pVar = (\att fld -> (fld,att)) <$> pIdentifier pExpr :: AGParser Expression -pExpr = (\(str,pos) -> Expression pos str) <$> ( pCodescrapL ) <?> "an expression" +pExpr = (\(str,pos) -> Expression pos (lexTokens pos str)) <$> pCodescrapL <?> "an expression" pAssign :: AGParser Bool pAssign = False <$ pReserved "=" <|> True <$ pReserved ":=" -pAttrDefs :: AGParser (Name -> [SemDef]) +pAttrDefs :: AGParser (Identifier -> [SemDef]) pAttrDefs = (\fs field -> map ($ field) fs) <$> pList1 pAttrDef <?> "attribute definitions" -pPattern :: AGParser (a -> (Name,Name)) -> AGParser (a -> Pattern) +pPattern :: AGParser (a -> (Identifier,Identifier)) -> AGParser (a -> Pattern) pPattern pvar = pPattern2 where pPattern0 = (\i pats a -> Constr i (map ($ a) pats)) <$> pIdentifierU <*> pList pPattern1 <|> pPattern1 <?> "a pattern" - pPattern1 = pvariable + pPattern1 = pvariable <|> pPattern2 - pvariable = (\var pat a -> case var a of (fld,att) -> Alias fld att (pat a) []) - <$> pvar <*> ((pAt *> pPattern1) `opt` const (Underscore noPos)) + pvariable = (\ir var pat a -> case var a of (fld,att) -> ir $ Alias fld att (pat a) []) + <$> ((Irrefutable <$ pTilde) `opt` id) <*> pvar <*> ((pAt *> pPattern1) `opt` const (Underscore noPos)) pPattern2 = (mkTuple <$> pOParenPos <*> pListSep pComma pPattern0 <* pCParen ) - <|> (const . Underscore) <$> pUScore <?> "a pattern" + <|> (const . Underscore) <$> pUScore <?> "a pattern" where mkTuple _ [x] a = x a mkTuple p xs a = Product p (map ($ a) xs) @@ -333,10 +370,10 @@ pCodescrap :: AGParser (String,Pos) pCodescrap = pCodeBlock -pSEM, pATTR, pDATA, pUSE, pLOC,pINCLUDE, pTYPE, pEquals, pColonEquals, - pBar, pColon, pLHS,pINST,pSET,pDERIVING,pMinus,pIntersect,pArrow, - pDot, pUScore, pEXT,pAt,pStar, pSmaller, pWRAPPER, pMAYBE, pMODULE - :: AGParser Pos +pSEM, pATTR, pDATA, pUSE, pLOC,pINCLUDE, pTYPE, pEquals, pColonEquals, pTilde, + pBar, pColon, pLHS,pINST,pSET,pDERIVING,pMinus,pIntersect,pDoubleArrow,pArrow, + pDot, pUScore, pEXT,pAt,pStar, pSmaller, pWRAPPER, pPRAGMA, pMAYBE, pMODULE + :: AGParser Pos pSET = pCostReserved 90 "SET" <?> "SET" pDERIVING = pCostReserved 90 "DERIVING"<?> "DERIVING" pWRAPPER = pCostReserved 90 "WRAPPER" <?> "WRAPPER" @@ -358,10 +395,12 @@ pUScore = pCostReserved 5 "_" <?> "_" pColon = pCostReserved 5 ":" <?> ":" pEquals = pCostReserved 5 "=" <?> "=" -pColonEquals = pCostReserved 5 ":=" <?> ":=" +pColonEquals = pCostReserved 5 ":=" <?> ":="+pTilde = pCostReserved 5 "~" <?> "~" pBar = pCostReserved 5 "|" <?> "|" pIntersect = pCostReserved 5 "/\\" <?> "/\\" -pMinus = pCostReserved 5 "-" <?> "-" +pMinus = pCostReserved 5 "-" <?> "-"+pDoubleArrow = pCostReserved 5 "=>" <?> "=>" pArrow = pCostReserved 5 "->" <?> "->" pStar = pCostReserved 5 "*" <?> "*" pSmaller = pCostReserved 5 "<" <?> "<"
src/Scanner.hs view
@@ -51,6 +51,7 @@ scan' ('@' :rs) = (reserved "@" p, advc 1 p, rs) scan' (',' :rs) = (reserved "," p, advc 1 p, rs) scan' ('_' :rs) = (reserved "_" p, advc 1 p, rs)+ scan' ('~' :rs) = (reserved "~" p, advc 1 p, rs) scan' ('<' :rs) = (reserved "<" p, advc 1 p, rs) scan' ('[' :rs) = (reserved "[" p, advc 1 p, rs) scan' (']' :rs) = (reserved "]" p, advc 1 p, rs) @@ -66,6 +67,7 @@ , advc (1+length str) p,rest) else (valueToken TkString str p, advc (2+length str) p, tail rest) + scan' ('=' : '>' : rs) = (reserved "=>" p, advc 2 p, rs) scan' ('=' :rs) = (reserved "=" p, advc 1 p, rs) scan' (':':'=':rs) = (reserved ":=" p, advc 2 p, rs)
src/SequentialComputation.lhs view
@@ -212,7 +212,7 @@ = let interslist = reverse . makeInterface tds [] mkSegments = foldr (sem_Segments_Cons . uncurry sem_Segment_Segment) sem_Segments_Nil . interslist mkInter ((nt,cons),lmh) = sem_Interface_Interface nt cons (mkSegments lmh)- inters = foldr (sem_Interfaces_Cons . mkInter) sem_Interfaces_Nil (zip (prods info) (lmh info))+ inters = foldr (sem_Interfaces_Cons . mkInter) sem_Interfaces_Nil (zip (nonts info) (lmh info)) in sem_IRoot_IRoot inters \end{code}
src/SequentialTypes.hs view
@@ -30,9 +30,9 @@ type Table a = Array Vertex a -data ChildVisit = ChildVisit Name Name Int [Vertex] [Vertex] deriving (Eq,Show) -- field, rhs nt, visit nr., inh, syn-data NTAttr = NTAInh Nonterminal Name Type -- nt, attribute, type- | NTASyn Nonterminal Name Type -- nt, attribute, type+data ChildVisit = ChildVisit Identifier Identifier Int [Vertex] [Vertex] deriving (Eq,Show) -- field, rhs nt, visit nr., inh, syn+data NTAttr = NTAInh NontermIdent Identifier Type -- nt, attribute, type+ | NTASyn NontermIdent Identifier Type -- nt, attribute, type deriving Show getNtaNameType (NTAInh nt name tp) = (name,tp)@@ -75,14 +75,14 @@ getNt cr = if isRhs cr then fromJust (getRhsNt cr) else getLhsNt cr in Just (at (getNt cr) (getAttr cr) (fromJust (getType cr))) -cRuleLhsInh :: Name -> Nonterminal -> Constructor -> Type -> CRule+cRuleLhsInh :: Identifier -> NontermIdent -> ConstructorIdent -> Type -> CRule cRuleLhsInh attr nt con tp = CRule attr True False nt con _LHS Nothing (Just tp) (error "cRuleLhsInh") [] Map.empty False "" Set.empty-cRuleTerminal :: Name -> Nonterminal -> Constructor -> Type -> CRule+cRuleTerminal :: Identifier -> NontermIdent -> ConstructorIdent -> Type -> CRule cRuleTerminal attr nt con tp = CRule attr True False nt con _LOC Nothing (Just tp) (error ("cRuleTerminal: " ++ show (attr, nt, con, tp))) [] Map.empty False "" Set.empty-cRuleRhsSyn :: Name -> Nonterminal -> Constructor -> Type -> Name -> Nonterminal -> CRule+cRuleRhsSyn :: Identifier -> NontermIdent -> ConstructorIdent -> Type -> Identifier -> NontermIdent -> CRule cRuleRhsSyn attr nt con tp field childnt = CRule attr True False nt con field (Just childnt) (Just tp) (error ("cRuleRhsSyn: " ++ show (attr, nt, con, tp, field))) [] Map.empty False "" Set.empty -defaultRule :: Name -> Nonterminal -> Constructor -> Name -> CRule+defaultRule :: Identifier -> NontermIdent -> ConstructorIdent -> Identifier -> CRule defaultRule attr nt con field = CRule attr (er 1) (er 2) nt con field (er 3) (er 4) (er 5) (er 6) (er 7) (er 8) (er 9) (er 10) where er i = error ("Default rule has no code " ++ show i) @@ -121,7 +121,7 @@ lhsshow (NTAInh field attr _) = lhsname True attr lhsshow (NTASyn field attr _) = lhsname False attr -rhsshow :: Name -> NTAttr -> String+rhsshow :: Identifier -> NTAttr -> String rhsshow field (NTAInh _ attr _) = attrname False field attr rhsshow field (NTASyn _ attr _) = attrname True field attr
src/TokenDef.hs view
@@ -7,6 +7,8 @@ import UU.Scanner.Position import UU.Parsing.MachineInterface(Symbol(..)) import Char(isPrint,ord)+import HsToken+import CommonTypes @@ -23,6 +25,20 @@ TkError -> 0 _ -> 5 ++tokensToStrings :: [HsToken] -> [(Pos,String)]+tokensToStrings+ = map tokenToString++tokenToString :: HsToken -> (Pos, String)+tokenToString tk+ = case tk of+ AGLocal var pos _ -> (pos, "@" ++ getName var)+ AGField field attr pos _ -> (pos, "@" ++ getName field ++ "." ++ getName attr)+ HsToken value pos -> (pos, value)+ CharToken value pos -> (pos, show value)+ StrToken value pos -> (pos, show value)+ Err mesg pos -> (pos, " ***" ++ mesg ++ "*** ") showTokens :: [(Pos,String)] -> [String] showTokens [] = []
src/Version.hs view
@@ -1,4 +1,4 @@ module Version where banner :: String -banner = "Attribute Grammar compiler / HUT project. Version 0.9.5" +banner = "Attribute Grammar compiler / HUT project. Version 0.9.6"
uuagc.cabal view
@@ -1,7 +1,7 @@ cabal-version: >=1.2 build-type: Simple name: uuagc-version: 0.9.5+version: 0.9.6 license: GPL license-file: LICENSE maintainer: Arie Middelkoop <ariem@cs.uu.nl>@@ -59,6 +59,12 @@ , PrintErrorMessages , SemHsTokens , Transform+ , ATermWrite+ , ATermAbstractSyntax+ , TfmToVisage+ , Visage+ , VisageSyntax+ , VisagePatterns extensions: TypeSynonymInstances, MultiParamTypeClasses hs-source-dirs: src, src-derived
uuagc.cabal-for-ghc-6.6 view
@@ -1,5 +1,5 @@ name: uuagc-version: 0.9.5+version: 0.9.6 license: GPL license-file: LICENSE maintainer: Arie Middelkoop <ariem@cs.uu.nl>@@ -43,5 +43,11 @@ , PrintErrorMessages , SemHsTokens , Transform+ , ATermWrite+ , ATermAbstractSyntax+ , TfmToVisage+ , Visage+ , VisageSyntax+ , VisagePatterns Extensions: TypeSynonymInstances, MultiParamTypeClasses Hs-Source-Dirs: src, src-derived