uuagc 0.9.12 → 0.9.13
raw patch · 29 files changed
+26103/−26103 lines, 29 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- src-derived/AbstractSyntax.hs +121/−121
- src-derived/AbstractSyntaxDump.hs +878/−878
- src-derived/Code.hs +259/−259
- src-derived/CodeSyntax.hs +142/−142
- src-derived/CodeSyntaxDump.hs +923/−923
- src-derived/ConcreteSyntax.hs +208/−208
- src-derived/DeclBlocks.hs +25/−25
- src-derived/DefaultRules.hs +1678/−1678
- src-derived/Desugar.hs +1868/−1868
- src-derived/ErrorMessages.hs +160/−160
- src-derived/Expression.hs +14/−14
- src-derived/GenerateCode.hs +5256/−5256
- src-derived/HsToken.hs +53/−53
- src-derived/Interfaces.hs +48/−48
- src-derived/InterfacesRules.hs +976/−976
- src-derived/Order.hs +3535/−3535
- src-derived/Patterns.hs +61/−61
- src-derived/PrintCode.hs +2217/−2217
- src-derived/PrintErrorMessages.hs +1302/−1302
- src-derived/SemHsTokens.hs +585/−585
- src-derived/TfmToVisage.hs +974/−974
- src-derived/Transform.hs +3989/−3989
- src-derived/Visage.hs +691/−691
- src-derived/VisagePatterns.hs +39/−39
- src-derived/VisageSyntax.hs +94/−94
- src/Scanner.hs +1/−1
- src/Version.hs +4/−4
- uuagc.cabal +1/−1
- uuagc.cabal-for-ghc-6.6 +1/−1
src-derived/AbstractSyntax.hs view
@@ -1,122 +1,122 @@- - --- UUAGC 0.9.11 (AbstractSyntax.ag) -module AbstractSyntax where - --- AbstractSyntax.ag imports -import Data.Set(Set) -import Data.Map(Map) -import Patterns (Pattern(..),Patterns) -import Expression (Expression(..)) -import CommonTypes --- Child ------------------------------------------------------- -{- - alternatives: - alternative Child: - child name : {Identifier} - child tp : {Type} - child inh : {Attributes} - child syn : {Attributes} - child higherOrder : {Bool} --} -data Child = Child (Identifier) (Type) (Attributes) (Attributes) (Bool) --- Children ---------------------------------------------------- -{- - alternatives: - alternative Cons: - child hd : Child - child tl : Children - alternative Nil: --} -type Children = [(Child)] --- Grammar ----------------------------------------------------- -{- - alternatives: - alternative Grammar: - child typeSyns : {TypeSyns} - child useMap : {UseMap} - child derivings : {Derivings} - child wrappers : {Set NontermIdent} - child nonts : Nonterminals - child pragmas : {PragmaMap} - child manualAttrOrderMap : {AttrOrderMap} - child paramMap : {ParamMap} - child contextMap : {ContextMap} - child uniqueMap : {UniqueMap} --} -data Grammar = Grammar (TypeSyns) (UseMap) (Derivings) (Set NontermIdent) (Nonterminals) (PragmaMap) (AttrOrderMap) (ParamMap) (ContextMap) (UniqueMap) --- Nonterminal ------------------------------------------------- -{- - alternatives: - alternative Nonterminal: - child nt : {NontermIdent} - child params : {[Identifier]} - child inh : {Attributes} - child syn : {Attributes} - child prods : Productions --} -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: - alternative Cons: - child hd : Production - child tl : Productions - alternative Nil: --} -type Productions = [(Production)] --- Rule -------------------------------------------------------- -{- - alternatives: - alternative Rule: - child pattern : {Pattern} - child rhs : {Expression} - child owrt : {Bool} - child origin : {String} --} -data Rule = Rule (Pattern) (Expression) (Bool) (String) --- Rules ------------------------------------------------------- -{- - alternatives: - alternative Cons: - child hd : Rule - child tl : Rules - alternative Nil: --} -type Rules = [(Rule)] --- TypeSig ----------------------------------------------------- -{- - alternatives: - alternative TypeSig: - child name : {Identifier} - child tp : {Type} --} -data TypeSig = TypeSig (Identifier) (Type) --- TypeSigs ---------------------------------------------------- -{- - alternatives: - alternative Cons: - child hd : TypeSig - child tl : TypeSigs - alternative Nil: --} +++-- UUAGC 0.9.12 (AbstractSyntax.ag)+module AbstractSyntax where++-- AbstractSyntax.ag imports+import Data.Set(Set)+import Data.Map(Map)+import Patterns (Pattern(..),Patterns)+import Expression (Expression(..))+import CommonTypes+-- Child -------------------------------------------------------+{-+ alternatives:+ alternative Child:+ child name : {Identifier}+ child tp : {Type}+ child inh : {Attributes}+ child syn : {Attributes}+ child higherOrder : {Bool}+-}+data Child = Child (Identifier) (Type) (Attributes) (Attributes) (Bool) +-- Children ----------------------------------------------------+{-+ alternatives:+ alternative Cons:+ child hd : Child + child tl : Children + alternative Nil:+-}+type Children = [(Child)]+-- Grammar -----------------------------------------------------+{-+ alternatives:+ alternative Grammar:+ child typeSyns : {TypeSyns}+ child useMap : {UseMap}+ child derivings : {Derivings}+ child wrappers : {Set NontermIdent}+ child nonts : Nonterminals + child pragmas : {PragmaMap}+ child manualAttrOrderMap : {AttrOrderMap}+ child paramMap : {ParamMap}+ child contextMap : {ContextMap}+ child uniqueMap : {UniqueMap}+-}+data Grammar = Grammar (TypeSyns) (UseMap) (Derivings) (Set NontermIdent) (Nonterminals) (PragmaMap) (AttrOrderMap) (ParamMap) (ContextMap) (UniqueMap) +-- Nonterminal -------------------------------------------------+{-+ alternatives:+ alternative Nonterminal:+ child nt : {NontermIdent}+ child params : {[Identifier]}+ child inh : {Attributes}+ child syn : {Attributes}+ child prods : Productions +-}+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:+ alternative Cons:+ child hd : Production + child tl : Productions + alternative Nil:+-}+type Productions = [(Production)]+-- Rule --------------------------------------------------------+{-+ alternatives:+ alternative Rule:+ child pattern : {Pattern}+ child rhs : {Expression}+ child owrt : {Bool}+ child origin : {String}+-}+data Rule = Rule (Pattern) (Expression) (Bool) (String) +-- Rules -------------------------------------------------------+{-+ alternatives:+ alternative Cons:+ child hd : Rule + child tl : Rules + alternative Nil:+-}+type Rules = [(Rule)]+-- TypeSig -----------------------------------------------------+{-+ alternatives:+ alternative TypeSig:+ child name : {Identifier}+ child tp : {Type}+-}+data TypeSig = TypeSig (Identifier) (Type) +-- TypeSigs ----------------------------------------------------+{-+ alternatives:+ alternative Cons:+ child hd : TypeSig + child tl : TypeSigs + alternative Nil:+-} type TypeSigs = [(TypeSig)]
src-derived/AbstractSyntaxDump.hs view
@@ -1,879 +1,879 @@- - --- UUAGC 0.9.11 (AbstractSyntaxDump.ag) -module AbstractSyntaxDump where - -import Data.List -import qualified Data.Map as Map - -import Pretty -import PPUtil - -import AbstractSyntax -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 --- Child ------------------------------------------------------- -{- - visit 0: - synthesized attribute: - pp : PP_Doc - 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 (( PP_Doc)) -data Inh_Child = Inh_Child {} -data Syn_Child = Syn_Child {pp_Syn_Child :: PP_Doc} -wrap_Child :: T_Child -> - Inh_Child -> - Syn_Child -wrap_Child (T_Child sem ) (Inh_Child ) = - (let ( _lhsOpp) = - (sem ) - in (Syn_Child _lhsOpp )) -sem_Child_Child :: Identifier -> - Type -> - Attributes -> - Attributes -> - Bool -> - T_Child -sem_Child_Child name_ tp_ inh_ syn_ higherOrder_ = - (T_Child (let _lhsOpp :: PP_Doc - -- "AbstractSyntaxDump.ag"(line 35, column 33) - _lhsOpp = - ppNestInfo ["Child","Child"] [pp name_, ppShow tp_] [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_] [] - in ( _lhsOpp)) ) --- Children ---------------------------------------------------- -{- - visit 0: - synthesized attributes: - pp : PP_Doc - ppL : [PP_Doc] - alternatives: - alternative Cons: - child hd : Child - child tl : Children - alternative Nil: --} --- cata -sem_Children :: Children -> - T_Children -sem_Children list = - (Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list) ) --- semantic domain -newtype T_Children = T_Children (( PP_Doc,([PP_Doc]))) -data Inh_Children = Inh_Children {} -data Syn_Children = Syn_Children {pp_Syn_Children :: PP_Doc,ppL_Syn_Children :: [PP_Doc]} -wrap_Children :: T_Children -> - Inh_Children -> - Syn_Children -wrap_Children (T_Children sem ) (Inh_Children ) = - (let ( _lhsOpp,_lhsOppL) = - (sem ) - in (Syn_Children _lhsOpp _lhsOppL )) -sem_Children_Cons :: T_Child -> - T_Children -> - T_Children -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 67, 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_Children_Nil :: T_Children -sem_Children_Nil = - (T_Children (let _lhsOppL :: ([PP_Doc]) - _lhsOpp :: PP_Doc - -- "AbstractSyntaxDump.ag"(line 68, column 33) - _lhsOppL = - [] - -- use rule "AbstractSyntaxDump.ag"(line 17, column 58) - _lhsOpp = - empty - in ( _lhsOpp,_lhsOppL)) ) --- Expression -------------------------------------------------- -{- - visit 0: - synthesized attribute: - pp : PP_Doc - alternatives: - alternative Expression: - child pos : {Pos} - child tks : {[HsToken]} --} --- cata -sem_Expression :: Expression -> - T_Expression -sem_Expression (Expression _pos _tks ) = - (sem_Expression_Expression _pos _tks ) --- semantic domain -newtype T_Expression = T_Expression (( PP_Doc)) -data Inh_Expression = Inh_Expression {} -data Syn_Expression = Syn_Expression {pp_Syn_Expression :: PP_Doc} -wrap_Expression :: T_Expression -> - Inh_Expression -> - Syn_Expression -wrap_Expression (T_Expression sem ) (Inh_Expression ) = - (let ( _lhsOpp) = - (sem ) - in (Syn_Expression _lhsOpp )) -sem_Expression_Expression :: Pos -> - ([HsToken]) -> - T_Expression -sem_Expression_Expression pos_ tks_ = - (T_Expression (let _lhsOpp :: PP_Doc - -- "AbstractSyntaxDump.ag"(line 50, column 25) - _lhsOpp = - ppNestInfo ["Expression","Expression"] [ppShow pos_] [ppF "txt" $ vlist . showTokens . tokensToStrings $ tks_] [] - in ( _lhsOpp)) ) --- Grammar ----------------------------------------------------- -{- - visit 0: - synthesized attribute: - pp : PP_Doc - alternatives: - alternative Grammar: - child typeSyns : {TypeSyns} - child useMap : {UseMap} - child derivings : {Derivings} - child wrappers : {Set NontermIdent} - child nonts : Nonterminals - child pragmas : {PragmaMap} - child manualAttrOrderMap : {AttrOrderMap} - child paramMap : {ParamMap} - child contextMap : {ContextMap} - child uniqueMap : {UniqueMap} --} --- cata -sem_Grammar :: Grammar -> - T_Grammar -sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap ) = - (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts ) _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap ) --- semantic domain -newtype T_Grammar = T_Grammar (( PP_Doc)) -data Inh_Grammar = Inh_Grammar {} -data Syn_Grammar = Syn_Grammar {pp_Syn_Grammar :: PP_Doc} -wrap_Grammar :: T_Grammar -> - Inh_Grammar -> - Syn_Grammar -wrap_Grammar (T_Grammar sem ) (Inh_Grammar ) = - (let ( _lhsOpp) = - (sem ) - in (Syn_Grammar _lhsOpp )) -sem_Grammar_Grammar :: TypeSyns -> - UseMap -> - Derivings -> - (Set NontermIdent) -> - T_Nonterminals -> - PragmaMap -> - AttrOrderMap -> - ParamMap -> - ContextMap -> - UniqueMap -> - T_Grammar -sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ uniqueMap_ = - (T_Grammar (let _lhsOpp :: PP_Doc - _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 "nonts" $ ppVList _nontsIppL - ] [] - ( _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 -> - Inh_Nonterminal -> - Syn_Nonterminal -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 -> - Inh_Nonterminals -> - Syn_Nonterminals -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: - synthesized attributes: - copy : SELF - pp : PP_Doc - 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,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 -> - Inh_Pattern -> - Syn_Pattern -wrap_Pattern (T_Pattern sem ) (Inh_Pattern ) = - (let ( _lhsOcopy,_lhsOpp) = - (sem ) - 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_ ) = - (T_Pattern (let _lhsOpp :: PP_Doc - _lhsOcopy :: Pattern - _patIcopy :: Pattern - _patIpp :: PP_Doc - _partsIcopy :: Patterns - _partsIpp :: PP_Doc - _partsIppL :: ([PP_Doc]) - -- "AbstractSyntaxDump.ag"(line 46, column 33) - _lhsOpp = - ppNestInfo ["Pattern","Alias"] [pp field_, pp attr_] [ppF "pat" $ _patIpp] [] - -- self rule - _copy = - Alias field_ attr_ _patIcopy _partsIcopy - -- self rule - _lhsOcopy = - _copy - ( _patIcopy,_patIpp) = - (pat_ ) - ( _partsIcopy,_partsIpp,_partsIppL) = - (parts_ ) - in ( _lhsOcopy,_lhsOpp)) ) -sem_Pattern_Constr :: ConstructorIdent -> - T_Patterns -> - T_Pattern -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 44, column 33) - _lhsOpp = - ppNestInfo ["Pattern","Constr"] [pp name_] [ppF "pats" $ ppVList _patsIppL] [] - -- self rule - _copy = - Constr name_ _patsIcopy - -- self rule - _lhsOcopy = - _copy - ( _patsIcopy,_patsIpp,_patsIppL) = - (pats_ ) - 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_ ) = - (T_Pattern (let _lhsOpp :: PP_Doc - _lhsOcopy :: Pattern - _patsIcopy :: Patterns - _patsIpp :: PP_Doc - _patsIppL :: ([PP_Doc]) - -- "AbstractSyntaxDump.ag"(line 45, column 33) - _lhsOpp = - ppNestInfo ["Pattern","Product"] [ppShow pos_] [ppF "pats" $ ppVList _patsIppL] [] - -- self rule - _copy = - Product pos_ _patsIcopy - -- self rule - _lhsOcopy = - _copy - ( _patsIcopy,_patsIpp,_patsIppL) = - (pats_ ) - in ( _lhsOcopy,_lhsOpp)) ) -sem_Pattern_Underscore :: Pos -> - T_Pattern -sem_Pattern_Underscore pos_ = - (T_Pattern (let _lhsOpp :: PP_Doc - _lhsOcopy :: Pattern - -- "AbstractSyntaxDump.ag"(line 47, column 25) - _lhsOpp = - ppNestInfo ["Pattern","Underscore"] [ppShow pos_] [] [] - -- self rule - _copy = - Underscore pos_ - -- self rule - _lhsOcopy = - _copy - in ( _lhsOcopy,_lhsOpp)) ) --- Patterns ---------------------------------------------------- -{- - visit 0: - synthesized attributes: - copy : SELF - pp : PP_Doc - ppL : [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 (( 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 -> - Inh_Patterns -> - Syn_Patterns -wrap_Patterns (T_Patterns sem ) (Inh_Patterns ) = - (let ( _lhsOcopy,_lhsOpp,_lhsOppL) = - (sem ) - in (Syn_Patterns _lhsOcopy _lhsOpp _lhsOppL )) -sem_Patterns_Cons :: T_Pattern -> - T_Patterns -> - T_Patterns -sem_Patterns_Cons (T_Pattern hd_ ) (T_Patterns tl_ ) = - (T_Patterns (let _lhsOppL :: ([PP_Doc]) - _lhsOpp :: PP_Doc - _lhsOcopy :: Patterns - _hdIcopy :: Pattern - _hdIpp :: PP_Doc - _tlIcopy :: Patterns - _tlIpp :: PP_Doc - _tlIppL :: ([PP_Doc]) - -- "AbstractSyntaxDump.ag"(line 55, column 33) - _lhsOppL = - _hdIpp : _tlIppL - -- use rule "AbstractSyntaxDump.ag"(line 17, column 58) - _lhsOpp = - _hdIpp >-< _tlIpp - -- self rule - _copy = - (:) _hdIcopy _tlIcopy - -- self rule - _lhsOcopy = - _copy - ( _hdIcopy,_hdIpp) = - (hd_ ) - ( _tlIcopy,_tlIpp,_tlIppL) = - (tl_ ) - 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 56, column 33) - _lhsOppL = - [] - -- use rule "AbstractSyntaxDump.ag"(line 17, column 58) - _lhsOpp = - empty - -- self rule - _copy = - [] - -- self rule - _lhsOcopy = - _copy - in ( _lhsOcopy,_lhsOpp,_lhsOppL)) ) --- Production -------------------------------------------------- -{- - visit 0: - synthesized attribute: - pp : PP_Doc - alternatives: - alternative Production: - child con : {ConstructorIdent} - child children : Children - child rules : Rules - child typeSigs : TypeSigs --} --- cata -sem_Production :: Production -> - T_Production -sem_Production (Production _con _children _rules _typeSigs ) = - (sem_Production_Production _con (sem_Children _children ) (sem_Rules _rules ) (sem_TypeSigs _typeSigs ) ) --- semantic domain -newtype T_Production = T_Production (( PP_Doc)) -data Inh_Production = Inh_Production {} -data Syn_Production = Syn_Production {pp_Syn_Production :: PP_Doc} -wrap_Production :: T_Production -> - Inh_Production -> - Syn_Production -wrap_Production (T_Production sem ) (Inh_Production ) = - (let ( _lhsOpp) = - (sem ) - in (Syn_Production _lhsOpp )) -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 _lhsOpp :: PP_Doc - _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 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: - synthesized attributes: - pp : PP_Doc - ppL : [PP_Doc] - alternatives: - alternative Cons: - child hd : Production - child tl : Productions - alternative Nil: --} --- cata -sem_Productions :: Productions -> - T_Productions -sem_Productions list = - (Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list) ) --- semantic domain -newtype T_Productions = T_Productions (( PP_Doc,([PP_Doc]))) -data Inh_Productions = Inh_Productions {} -data Syn_Productions = Syn_Productions {pp_Syn_Productions :: PP_Doc,ppL_Syn_Productions :: [PP_Doc]} -wrap_Productions :: T_Productions -> - Inh_Productions -> - Syn_Productions -wrap_Productions (T_Productions sem ) (Inh_Productions ) = - (let ( _lhsOpp,_lhsOppL) = - (sem ) - in (Syn_Productions _lhsOpp _lhsOppL )) -sem_Productions_Cons :: T_Production -> - T_Productions -> - T_Productions -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 71, 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_Productions_Nil :: T_Productions -sem_Productions_Nil = - (T_Productions (let _lhsOppL :: ([PP_Doc]) - _lhsOpp :: PP_Doc - -- "AbstractSyntaxDump.ag"(line 72, column 33) - _lhsOppL = - [] - -- use rule "AbstractSyntaxDump.ag"(line 17, column 58) - _lhsOpp = - empty - in ( _lhsOpp,_lhsOppL)) ) --- Rule -------------------------------------------------------- -{- - visit 0: - synthesized attribute: - pp : PP_Doc - 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 (( PP_Doc)) -data Inh_Rule = Inh_Rule {} -data Syn_Rule = Syn_Rule {pp_Syn_Rule :: PP_Doc} -wrap_Rule :: T_Rule -> - Inh_Rule -> - Syn_Rule -wrap_Rule (T_Rule sem ) (Inh_Rule ) = - (let ( _lhsOpp) = - (sem ) - 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_ = - (T_Rule (let _lhsOpp :: PP_Doc - _patternIcopy :: Pattern - _patternIpp :: PP_Doc - _rhsIpp :: PP_Doc - -- "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)) ) --- Rules ------------------------------------------------------- -{- - visit 0: - synthesized attributes: - pp : PP_Doc - ppL : [PP_Doc] - alternatives: - alternative Cons: - child hd : Rule - child tl : Rules - alternative Nil: --} --- cata -sem_Rules :: Rules -> - T_Rules -sem_Rules list = - (Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list) ) --- semantic domain -newtype T_Rules = T_Rules (( PP_Doc,([PP_Doc]))) -data Inh_Rules = Inh_Rules {} -data Syn_Rules = Syn_Rules {pp_Syn_Rules :: PP_Doc,ppL_Syn_Rules :: [PP_Doc]} -wrap_Rules :: T_Rules -> - Inh_Rules -> - Syn_Rules -wrap_Rules (T_Rules sem ) (Inh_Rules ) = - (let ( _lhsOpp,_lhsOppL) = - (sem ) - in (Syn_Rules _lhsOpp _lhsOppL )) -sem_Rules_Cons :: T_Rule -> - T_Rules -> - T_Rules -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 63, 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_Rules_Nil :: T_Rules -sem_Rules_Nil = - (T_Rules (let _lhsOppL :: ([PP_Doc]) - _lhsOpp :: PP_Doc - -- "AbstractSyntaxDump.ag"(line 64, column 33) - _lhsOppL = - [] - -- use rule "AbstractSyntaxDump.ag"(line 17, column 58) - _lhsOpp = - empty - in ( _lhsOpp,_lhsOppL)) ) --- TypeSig ----------------------------------------------------- -{- - visit 0: - synthesized attribute: - pp : PP_Doc - 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 (( PP_Doc)) -data Inh_TypeSig = Inh_TypeSig {} -data Syn_TypeSig = Syn_TypeSig {pp_Syn_TypeSig :: PP_Doc} -wrap_TypeSig :: T_TypeSig -> - Inh_TypeSig -> - Syn_TypeSig -wrap_TypeSig (T_TypeSig sem ) (Inh_TypeSig ) = - (let ( _lhsOpp) = - (sem ) - in (Syn_TypeSig _lhsOpp )) -sem_TypeSig_TypeSig :: Identifier -> - Type -> - T_TypeSig -sem_TypeSig_TypeSig name_ tp_ = - (T_TypeSig (let _lhsOpp :: PP_Doc - -- "AbstractSyntaxDump.ag"(line 41, column 33) - _lhsOpp = - ppNestInfo ["TypeSig","TypeSig"] [pp name_, ppShow tp_] [] [] - in ( _lhsOpp)) ) --- TypeSigs ---------------------------------------------------- -{- - visit 0: - synthesized attributes: - pp : PP_Doc - ppL : [PP_Doc] - 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 (( 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 -> - Inh_TypeSigs -> - Syn_TypeSigs -wrap_TypeSigs (T_TypeSigs sem ) (Inh_TypeSigs ) = - (let ( _lhsOpp,_lhsOppL) = - (sem ) - in (Syn_TypeSigs _lhsOpp _lhsOppL )) -sem_TypeSigs_Cons :: T_TypeSig -> - T_TypeSigs -> - T_TypeSigs -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 59, 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_TypeSigs_Nil :: T_TypeSigs -sem_TypeSigs_Nil = - (T_TypeSigs (let _lhsOppL :: ([PP_Doc]) - _lhsOpp :: PP_Doc - -- "AbstractSyntaxDump.ag"(line 60, column 33) - _lhsOppL = - [] - -- use rule "AbstractSyntaxDump.ag"(line 17, column 58) - _lhsOpp = - empty +++-- UUAGC 0.9.12 (AbstractSyntaxDump.ag)+module AbstractSyntaxDump where++import Data.List+import qualified Data.Map as Map++import Pretty+import PPUtil++import AbstractSyntax+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+-- Child -------------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ pp : PP_Doc+ 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 (( PP_Doc))+data Inh_Child = Inh_Child {}+data Syn_Child = Syn_Child {pp_Syn_Child :: PP_Doc}+wrap_Child :: T_Child ->+ Inh_Child ->+ Syn_Child +wrap_Child (T_Child sem ) (Inh_Child ) =+ (let ( _lhsOpp) =+ (sem )+ in (Syn_Child _lhsOpp ))+sem_Child_Child :: Identifier ->+ Type ->+ Attributes ->+ Attributes ->+ Bool ->+ T_Child +sem_Child_Child name_ tp_ inh_ syn_ higherOrder_ =+ (T_Child (let _lhsOpp :: PP_Doc+ -- "AbstractSyntaxDump.ag"(line 35, column 33)+ _lhsOpp =+ ppNestInfo ["Child","Child"] [pp name_, ppShow tp_] [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_] []+ in ( _lhsOpp)) )+-- Children ----------------------------------------------------+{-+ visit 0:+ synthesized attributes:+ pp : PP_Doc+ ppL : [PP_Doc]+ alternatives:+ alternative Cons:+ child hd : Child + child tl : Children + alternative Nil:+-}+-- cata+sem_Children :: Children ->+ T_Children +sem_Children list =+ (Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list) )+-- semantic domain+newtype T_Children = T_Children (( PP_Doc,([PP_Doc])))+data Inh_Children = Inh_Children {}+data Syn_Children = Syn_Children {pp_Syn_Children :: PP_Doc,ppL_Syn_Children :: [PP_Doc]}+wrap_Children :: T_Children ->+ Inh_Children ->+ Syn_Children +wrap_Children (T_Children sem ) (Inh_Children ) =+ (let ( _lhsOpp,_lhsOppL) =+ (sem )+ in (Syn_Children _lhsOpp _lhsOppL ))+sem_Children_Cons :: T_Child ->+ T_Children ->+ T_Children +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 67, 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_Children_Nil :: T_Children +sem_Children_Nil =+ (T_Children (let _lhsOppL :: ([PP_Doc])+ _lhsOpp :: PP_Doc+ -- "AbstractSyntaxDump.ag"(line 68, column 33)+ _lhsOppL =+ []+ -- use rule "AbstractSyntaxDump.ag"(line 17, column 58)+ _lhsOpp =+ empty+ in ( _lhsOpp,_lhsOppL)) )+-- Expression --------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ pp : PP_Doc+ alternatives:+ alternative Expression:+ child pos : {Pos}+ child tks : {[HsToken]}+-}+-- cata+sem_Expression :: Expression ->+ T_Expression +sem_Expression (Expression _pos _tks ) =+ (sem_Expression_Expression _pos _tks )+-- semantic domain+newtype T_Expression = T_Expression (( PP_Doc))+data Inh_Expression = Inh_Expression {}+data Syn_Expression = Syn_Expression {pp_Syn_Expression :: PP_Doc}+wrap_Expression :: T_Expression ->+ Inh_Expression ->+ Syn_Expression +wrap_Expression (T_Expression sem ) (Inh_Expression ) =+ (let ( _lhsOpp) =+ (sem )+ in (Syn_Expression _lhsOpp ))+sem_Expression_Expression :: Pos ->+ ([HsToken]) ->+ T_Expression +sem_Expression_Expression pos_ tks_ =+ (T_Expression (let _lhsOpp :: PP_Doc+ -- "AbstractSyntaxDump.ag"(line 50, column 25)+ _lhsOpp =+ ppNestInfo ["Expression","Expression"] [ppShow pos_] [ppF "txt" $ vlist . showTokens . tokensToStrings $ tks_] []+ in ( _lhsOpp)) )+-- Grammar -----------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ pp : PP_Doc+ alternatives:+ alternative Grammar:+ child typeSyns : {TypeSyns}+ child useMap : {UseMap}+ child derivings : {Derivings}+ child wrappers : {Set NontermIdent}+ child nonts : Nonterminals + child pragmas : {PragmaMap}+ child manualAttrOrderMap : {AttrOrderMap}+ child paramMap : {ParamMap}+ child contextMap : {ContextMap}+ child uniqueMap : {UniqueMap}+-}+-- cata+sem_Grammar :: Grammar ->+ T_Grammar +sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap ) =+ (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts ) _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap )+-- semantic domain+newtype T_Grammar = T_Grammar (( PP_Doc))+data Inh_Grammar = Inh_Grammar {}+data Syn_Grammar = Syn_Grammar {pp_Syn_Grammar :: PP_Doc}+wrap_Grammar :: T_Grammar ->+ Inh_Grammar ->+ Syn_Grammar +wrap_Grammar (T_Grammar sem ) (Inh_Grammar ) =+ (let ( _lhsOpp) =+ (sem )+ in (Syn_Grammar _lhsOpp ))+sem_Grammar_Grammar :: TypeSyns ->+ UseMap ->+ Derivings ->+ (Set NontermIdent) ->+ T_Nonterminals ->+ PragmaMap ->+ AttrOrderMap ->+ ParamMap ->+ ContextMap ->+ UniqueMap ->+ T_Grammar +sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ uniqueMap_ =+ (T_Grammar (let _lhsOpp :: PP_Doc+ _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 "nonts" $ ppVList _nontsIppL+ ] []+ ( _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 ->+ Inh_Nonterminal ->+ Syn_Nonterminal +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 ->+ Inh_Nonterminals ->+ Syn_Nonterminals +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:+ synthesized attributes:+ copy : SELF + pp : PP_Doc+ 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,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 ->+ Inh_Pattern ->+ Syn_Pattern +wrap_Pattern (T_Pattern sem ) (Inh_Pattern ) =+ (let ( _lhsOcopy,_lhsOpp) =+ (sem )+ 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_ ) =+ (T_Pattern (let _lhsOpp :: PP_Doc+ _lhsOcopy :: Pattern+ _patIcopy :: Pattern+ _patIpp :: PP_Doc+ _partsIcopy :: Patterns+ _partsIpp :: PP_Doc+ _partsIppL :: ([PP_Doc])+ -- "AbstractSyntaxDump.ag"(line 46, column 33)+ _lhsOpp =+ ppNestInfo ["Pattern","Alias"] [pp field_, pp attr_] [ppF "pat" $ _patIpp] []+ -- self rule+ _copy =+ Alias field_ attr_ _patIcopy _partsIcopy+ -- self rule+ _lhsOcopy =+ _copy+ ( _patIcopy,_patIpp) =+ (pat_ )+ ( _partsIcopy,_partsIpp,_partsIppL) =+ (parts_ )+ in ( _lhsOcopy,_lhsOpp)) )+sem_Pattern_Constr :: ConstructorIdent ->+ T_Patterns ->+ T_Pattern +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 44, column 33)+ _lhsOpp =+ ppNestInfo ["Pattern","Constr"] [pp name_] [ppF "pats" $ ppVList _patsIppL] []+ -- self rule+ _copy =+ Constr name_ _patsIcopy+ -- self rule+ _lhsOcopy =+ _copy+ ( _patsIcopy,_patsIpp,_patsIppL) =+ (pats_ )+ 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_ ) =+ (T_Pattern (let _lhsOpp :: PP_Doc+ _lhsOcopy :: Pattern+ _patsIcopy :: Patterns+ _patsIpp :: PP_Doc+ _patsIppL :: ([PP_Doc])+ -- "AbstractSyntaxDump.ag"(line 45, column 33)+ _lhsOpp =+ ppNestInfo ["Pattern","Product"] [ppShow pos_] [ppF "pats" $ ppVList _patsIppL] []+ -- self rule+ _copy =+ Product pos_ _patsIcopy+ -- self rule+ _lhsOcopy =+ _copy+ ( _patsIcopy,_patsIpp,_patsIppL) =+ (pats_ )+ in ( _lhsOcopy,_lhsOpp)) )+sem_Pattern_Underscore :: Pos ->+ T_Pattern +sem_Pattern_Underscore pos_ =+ (T_Pattern (let _lhsOpp :: PP_Doc+ _lhsOcopy :: Pattern+ -- "AbstractSyntaxDump.ag"(line 47, column 25)+ _lhsOpp =+ ppNestInfo ["Pattern","Underscore"] [ppShow pos_] [] []+ -- self rule+ _copy =+ Underscore pos_+ -- self rule+ _lhsOcopy =+ _copy+ in ( _lhsOcopy,_lhsOpp)) )+-- Patterns ----------------------------------------------------+{-+ visit 0:+ synthesized attributes:+ copy : SELF + pp : PP_Doc+ ppL : [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 (( 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 ->+ Inh_Patterns ->+ Syn_Patterns +wrap_Patterns (T_Patterns sem ) (Inh_Patterns ) =+ (let ( _lhsOcopy,_lhsOpp,_lhsOppL) =+ (sem )+ in (Syn_Patterns _lhsOcopy _lhsOpp _lhsOppL ))+sem_Patterns_Cons :: T_Pattern ->+ T_Patterns ->+ T_Patterns +sem_Patterns_Cons (T_Pattern hd_ ) (T_Patterns tl_ ) =+ (T_Patterns (let _lhsOppL :: ([PP_Doc])+ _lhsOpp :: PP_Doc+ _lhsOcopy :: Patterns+ _hdIcopy :: Pattern+ _hdIpp :: PP_Doc+ _tlIcopy :: Patterns+ _tlIpp :: PP_Doc+ _tlIppL :: ([PP_Doc])+ -- "AbstractSyntaxDump.ag"(line 55, column 33)+ _lhsOppL =+ _hdIpp : _tlIppL+ -- use rule "AbstractSyntaxDump.ag"(line 17, column 58)+ _lhsOpp =+ _hdIpp >-< _tlIpp+ -- self rule+ _copy =+ (:) _hdIcopy _tlIcopy+ -- self rule+ _lhsOcopy =+ _copy+ ( _hdIcopy,_hdIpp) =+ (hd_ )+ ( _tlIcopy,_tlIpp,_tlIppL) =+ (tl_ )+ 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 56, column 33)+ _lhsOppL =+ []+ -- use rule "AbstractSyntaxDump.ag"(line 17, column 58)+ _lhsOpp =+ empty+ -- self rule+ _copy =+ []+ -- self rule+ _lhsOcopy =+ _copy+ in ( _lhsOcopy,_lhsOpp,_lhsOppL)) )+-- Production --------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ pp : PP_Doc+ alternatives:+ alternative Production:+ child con : {ConstructorIdent}+ child children : Children + child rules : Rules + child typeSigs : TypeSigs +-}+-- cata+sem_Production :: Production ->+ T_Production +sem_Production (Production _con _children _rules _typeSigs ) =+ (sem_Production_Production _con (sem_Children _children ) (sem_Rules _rules ) (sem_TypeSigs _typeSigs ) )+-- semantic domain+newtype T_Production = T_Production (( PP_Doc))+data Inh_Production = Inh_Production {}+data Syn_Production = Syn_Production {pp_Syn_Production :: PP_Doc}+wrap_Production :: T_Production ->+ Inh_Production ->+ Syn_Production +wrap_Production (T_Production sem ) (Inh_Production ) =+ (let ( _lhsOpp) =+ (sem )+ in (Syn_Production _lhsOpp ))+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 _lhsOpp :: PP_Doc+ _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 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:+ synthesized attributes:+ pp : PP_Doc+ ppL : [PP_Doc]+ alternatives:+ alternative Cons:+ child hd : Production + child tl : Productions + alternative Nil:+-}+-- cata+sem_Productions :: Productions ->+ T_Productions +sem_Productions list =+ (Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list) )+-- semantic domain+newtype T_Productions = T_Productions (( PP_Doc,([PP_Doc])))+data Inh_Productions = Inh_Productions {}+data Syn_Productions = Syn_Productions {pp_Syn_Productions :: PP_Doc,ppL_Syn_Productions :: [PP_Doc]}+wrap_Productions :: T_Productions ->+ Inh_Productions ->+ Syn_Productions +wrap_Productions (T_Productions sem ) (Inh_Productions ) =+ (let ( _lhsOpp,_lhsOppL) =+ (sem )+ in (Syn_Productions _lhsOpp _lhsOppL ))+sem_Productions_Cons :: T_Production ->+ T_Productions ->+ T_Productions +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 71, 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_Productions_Nil :: T_Productions +sem_Productions_Nil =+ (T_Productions (let _lhsOppL :: ([PP_Doc])+ _lhsOpp :: PP_Doc+ -- "AbstractSyntaxDump.ag"(line 72, column 33)+ _lhsOppL =+ []+ -- use rule "AbstractSyntaxDump.ag"(line 17, column 58)+ _lhsOpp =+ empty+ in ( _lhsOpp,_lhsOppL)) )+-- Rule --------------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ pp : PP_Doc+ 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 (( PP_Doc))+data Inh_Rule = Inh_Rule {}+data Syn_Rule = Syn_Rule {pp_Syn_Rule :: PP_Doc}+wrap_Rule :: T_Rule ->+ Inh_Rule ->+ Syn_Rule +wrap_Rule (T_Rule sem ) (Inh_Rule ) =+ (let ( _lhsOpp) =+ (sem )+ 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_ =+ (T_Rule (let _lhsOpp :: PP_Doc+ _patternIcopy :: Pattern+ _patternIpp :: PP_Doc+ _rhsIpp :: PP_Doc+ -- "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)) )+-- Rules -------------------------------------------------------+{-+ visit 0:+ synthesized attributes:+ pp : PP_Doc+ ppL : [PP_Doc]+ alternatives:+ alternative Cons:+ child hd : Rule + child tl : Rules + alternative Nil:+-}+-- cata+sem_Rules :: Rules ->+ T_Rules +sem_Rules list =+ (Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list) )+-- semantic domain+newtype T_Rules = T_Rules (( PP_Doc,([PP_Doc])))+data Inh_Rules = Inh_Rules {}+data Syn_Rules = Syn_Rules {pp_Syn_Rules :: PP_Doc,ppL_Syn_Rules :: [PP_Doc]}+wrap_Rules :: T_Rules ->+ Inh_Rules ->+ Syn_Rules +wrap_Rules (T_Rules sem ) (Inh_Rules ) =+ (let ( _lhsOpp,_lhsOppL) =+ (sem )+ in (Syn_Rules _lhsOpp _lhsOppL ))+sem_Rules_Cons :: T_Rule ->+ T_Rules ->+ T_Rules +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 63, 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_Rules_Nil :: T_Rules +sem_Rules_Nil =+ (T_Rules (let _lhsOppL :: ([PP_Doc])+ _lhsOpp :: PP_Doc+ -- "AbstractSyntaxDump.ag"(line 64, column 33)+ _lhsOppL =+ []+ -- use rule "AbstractSyntaxDump.ag"(line 17, column 58)+ _lhsOpp =+ empty+ in ( _lhsOpp,_lhsOppL)) )+-- TypeSig -----------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ pp : PP_Doc+ 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 (( PP_Doc))+data Inh_TypeSig = Inh_TypeSig {}+data Syn_TypeSig = Syn_TypeSig {pp_Syn_TypeSig :: PP_Doc}+wrap_TypeSig :: T_TypeSig ->+ Inh_TypeSig ->+ Syn_TypeSig +wrap_TypeSig (T_TypeSig sem ) (Inh_TypeSig ) =+ (let ( _lhsOpp) =+ (sem )+ in (Syn_TypeSig _lhsOpp ))+sem_TypeSig_TypeSig :: Identifier ->+ Type ->+ T_TypeSig +sem_TypeSig_TypeSig name_ tp_ =+ (T_TypeSig (let _lhsOpp :: PP_Doc+ -- "AbstractSyntaxDump.ag"(line 41, column 33)+ _lhsOpp =+ ppNestInfo ["TypeSig","TypeSig"] [pp name_, ppShow tp_] [] []+ in ( _lhsOpp)) )+-- TypeSigs ----------------------------------------------------+{-+ visit 0:+ synthesized attributes:+ pp : PP_Doc+ ppL : [PP_Doc]+ 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 (( 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 ->+ Inh_TypeSigs ->+ Syn_TypeSigs +wrap_TypeSigs (T_TypeSigs sem ) (Inh_TypeSigs ) =+ (let ( _lhsOpp,_lhsOppL) =+ (sem )+ in (Syn_TypeSigs _lhsOpp _lhsOppL ))+sem_TypeSigs_Cons :: T_TypeSig ->+ T_TypeSigs ->+ T_TypeSigs +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 59, 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_TypeSigs_Nil :: T_TypeSigs +sem_TypeSigs_Nil =+ (T_TypeSigs (let _lhsOppL :: ([PP_Doc])+ _lhsOpp :: PP_Doc+ -- "AbstractSyntaxDump.ag"(line 60, column 33)+ _lhsOppL =+ []+ -- use rule "AbstractSyntaxDump.ag"(line 17, column 58)+ _lhsOpp =+ empty in ( _lhsOpp,_lhsOppL)) )
src-derived/Code.hs view
@@ -1,260 +1,260 @@- - --- UUAGC 0.9.11 (Code.ag) -module Code where - -import Pretty -import Patterns -import Data.List(partition) -import Data.Set(Set) -import qualified Data.Set as Set -import Data.Map(Map) -import qualified Data.Map as Map - --- 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 ----------------------------------------------------- -{- - alternatives: - alternative CaseAlt: - child left : Lhs - child expr : Expr --} -data CaseAlt = CaseAlt (Lhs) (Expr) --- CaseAlts ---------------------------------------------------- -{- - alternatives: - alternative Cons: - child hd : CaseAlt - child tl : CaseAlts - alternative Nil: --} -type CaseAlts = [(CaseAlt)] --- Chunk ------------------------------------------------------- -{- - 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]} --} -data Chunk = Chunk (String) (Decl) (Decls) (Decls) (Decls) (Decls) (Decls) (Decls) ([String]) --- Chunks ------------------------------------------------------ -{- - alternatives: - alternative Cons: - child hd : Chunk - child tl : Chunks - alternative Nil: --} -type Chunks = [(Chunk)] --- DataAlt ----------------------------------------------------- -{- - alternatives: - alternative DataAlt: - child name : {String} - child args : {[String]} - alternative Record: - child name : {String} - child args : {[(String,String)]} --} -data DataAlt = DataAlt (String) ([String]) - | Record (String) ([(String,String)]) --- DataAlts ---------------------------------------------------- -{- - alternatives: - alternative Cons: - child hd : DataAlt - child tl : DataAlts - alternative Nil: --} -type DataAlts = [(DataAlt)] --- Decl -------------------------------------------------------- -{- - 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 --} -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: - alternative Cons: - child hd : Decl - child tl : Decls - alternative Nil: --} -type Decls = [(Decl)] --- Expr -------------------------------------------------------- -{- - 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 - 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 --} -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: - alternative Cons: - child hd : Expr - child tl : Exprs - alternative Nil: --} -type Exprs = [(Expr)] --- Lhs --------------------------------------------------------- -{- - alternatives: - alternative Fun: - child name : {String} - child args : Exprs - alternative Pattern3: - child pat3 : {Pattern} - alternative Pattern3SM: - child pat3 : {Pattern} - alternative TupleLhs: - child comps : {[String]} - alternative UnboxedTupleLhs: - child comps : {[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) --- 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) - | CtxApp ([(String, [String])]) (Type) - | List (Type) - | SimpleType (String) - | TupleType (Types) - | TypeApp (Type) (Types) - | UnboxedTupleType (Types) - deriving ( Show) --- Types ------------------------------------------------------- -{- - alternatives: - alternative Cons: - child hd : Type - child tl : Types - alternative Nil: --} +++-- UUAGC 0.9.12 (Code.ag)+module Code where++import Pretty+import Patterns+import Data.List(partition)+import Data.Set(Set)+import qualified Data.Set as Set+import Data.Map(Map)+import qualified Data.Map as Map++-- 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 -----------------------------------------------------+{-+ alternatives:+ alternative CaseAlt:+ child left : Lhs + child expr : Expr +-}+data CaseAlt = CaseAlt (Lhs) (Expr) +-- CaseAlts ----------------------------------------------------+{-+ alternatives:+ alternative Cons:+ child hd : CaseAlt + child tl : CaseAlts + alternative Nil:+-}+type CaseAlts = [(CaseAlt)]+-- Chunk -------------------------------------------------------+{-+ 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]}+-}+data Chunk = Chunk (String) (Decl) (Decls) (Decls) (Decls) (Decls) (Decls) (Decls) ([String]) +-- Chunks ------------------------------------------------------+{-+ alternatives:+ alternative Cons:+ child hd : Chunk + child tl : Chunks + alternative Nil:+-}+type Chunks = [(Chunk)]+-- DataAlt -----------------------------------------------------+{-+ alternatives:+ alternative DataAlt:+ child name : {String}+ child args : {[String]}+ alternative Record:+ child name : {String}+ child args : {[(String,String)]}+-}+data DataAlt = DataAlt (String) ([String]) + | Record (String) ([(String,String)]) +-- DataAlts ----------------------------------------------------+{-+ alternatives:+ alternative Cons:+ child hd : DataAlt + child tl : DataAlts + alternative Nil:+-}+type DataAlts = [(DataAlt)]+-- Decl --------------------------------------------------------+{-+ 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 +-}+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:+ alternative Cons:+ child hd : Decl + child tl : Decls + alternative Nil:+-}+type Decls = [(Decl)]+-- Expr --------------------------------------------------------+{-+ 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 + 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 +-}+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:+ alternative Cons:+ child hd : Expr + child tl : Exprs + alternative Nil:+-}+type Exprs = [(Expr)]+-- Lhs ---------------------------------------------------------+{-+ alternatives:+ alternative Fun:+ child name : {String}+ child args : Exprs + alternative Pattern3:+ child pat3 : {Pattern}+ alternative Pattern3SM:+ child pat3 : {Pattern}+ alternative TupleLhs:+ child comps : {[String]}+ alternative UnboxedTupleLhs:+ child comps : {[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) +-- 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) + | CtxApp ([(String, [String])]) (Type) + | List (Type) + | SimpleType (String) + | TupleType (Types) + | TypeApp (Type) (Types) + | UnboxedTupleType (Types) + deriving ( Show)+-- Types -------------------------------------------------------+{-+ alternatives:+ alternative Cons:+ child hd : Type + child tl : Types + alternative Nil:+-} type Types = [(Type)]
src-derived/CodeSyntax.hs view
@@ -1,143 +1,143 @@- - --- UUAGC 0.9.11 (CodeSyntax.ag) -module CodeSyntax where - -import Patterns -import CommonTypes -import Data.Map(Map) -import Data.Set(Set) --- CGrammar ---------------------------------------------------- -{- - 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} --} -data CGrammar = CGrammar (TypeSyns) (Derivings) (Set NontermIdent) (CNonterminals) (PragmaMap) (ParamMap) (ContextMap) --- CInterface -------------------------------------------------- -{- - alternatives: - alternative CInterface: - child seg : CSegments --} -data CInterface = CInterface (CSegments) --- CNonterminal ------------------------------------------------ -{- - alternatives: - alternative CNonterminal: - child nt : {NontermIdent} - child params : {[Identifier]} - child inh : {Attributes} - child syn : {Attributes} - child prods : CProductions - child inter : 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: - alternative Cons: - child hd : CProduction - child tl : CProductions - alternative Nil: --} -type CProductions = [(CProduction)] --- CRule ------------------------------------------------------- -{- - alternatives: - alternative CChildVisit: - child name : {Identifier} - child nt : {NontermIdent} - child nr : {Int} - child inh : {Attributes} - child syn : {Attributes} - child isLast : {Bool} - 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)} --} -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: - alternative CSegment: - child inh : {Attributes} - child syn : {Attributes} --} -data CSegment = CSegment (Attributes) (Attributes) --- CSegments --------------------------------------------------- -{- - alternatives: - alternative Cons: - child hd : CSegment - child tl : CSegments - alternative Nil: --} -type CSegments = [(CSegment)] --- CVisit ------------------------------------------------------ -{- - alternatives: - alternative CVisit: - child inh : {Attributes} - child syn : {Attributes} - child vss : Sequence - child intra : Sequence - child ordered : {Bool} --} -data CVisit = CVisit (Attributes) (Attributes) (Sequence) (Sequence) (Bool) --- CVisits ----------------------------------------------------- -{- - alternatives: - alternative Cons: - child hd : CVisit - child tl : CVisits - alternative Nil: --} -type CVisits = [(CVisit)] --- Sequence ---------------------------------------------------- -{- - alternatives: - alternative Cons: - child hd : CRule - child tl : Sequence - alternative Nil: --} +++-- UUAGC 0.9.12 (CodeSyntax.ag)+module CodeSyntax where++import Patterns+import CommonTypes+import Data.Map(Map)+import Data.Set(Set)+-- CGrammar ----------------------------------------------------+{-+ 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}+-}+data CGrammar = CGrammar (TypeSyns) (Derivings) (Set NontermIdent) (CNonterminals) (PragmaMap) (ParamMap) (ContextMap) +-- CInterface --------------------------------------------------+{-+ alternatives:+ alternative CInterface:+ child seg : CSegments +-}+data CInterface = CInterface (CSegments) +-- CNonterminal ------------------------------------------------+{-+ alternatives:+ alternative CNonterminal:+ child nt : {NontermIdent}+ child params : {[Identifier]}+ child inh : {Attributes}+ child syn : {Attributes}+ child prods : CProductions + child inter : 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:+ alternative Cons:+ child hd : CProduction + child tl : CProductions + alternative Nil:+-}+type CProductions = [(CProduction)]+-- CRule -------------------------------------------------------+{-+ alternatives:+ alternative CChildVisit:+ child name : {Identifier}+ child nt : {NontermIdent}+ child nr : {Int}+ child inh : {Attributes}+ child syn : {Attributes}+ child isLast : {Bool}+ 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)}+-}+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:+ alternative CSegment:+ child inh : {Attributes}+ child syn : {Attributes}+-}+data CSegment = CSegment (Attributes) (Attributes) +-- CSegments ---------------------------------------------------+{-+ alternatives:+ alternative Cons:+ child hd : CSegment + child tl : CSegments + alternative Nil:+-}+type CSegments = [(CSegment)]+-- CVisit ------------------------------------------------------+{-+ alternatives:+ alternative CVisit:+ child inh : {Attributes}+ child syn : {Attributes}+ child vss : Sequence + child intra : Sequence + child ordered : {Bool}+-}+data CVisit = CVisit (Attributes) (Attributes) (Sequence) (Sequence) (Bool) +-- CVisits -----------------------------------------------------+{-+ alternatives:+ alternative Cons:+ child hd : CVisit + child tl : CVisits + alternative Nil:+-}+type CVisits = [(CVisit)]+-- Sequence ----------------------------------------------------+{-+ alternatives:+ alternative Cons:+ child hd : CRule + child tl : Sequence + alternative Nil:+-} type Sequence = [(CRule)]
src-derived/CodeSyntaxDump.hs view
@@ -1,924 +1,924 @@- - --- UUAGC 0.9.11 (CodeSyntaxDump.ag) -module CodeSyntaxDump where - -import Data.List -import qualified Data.Map as Map - -import Pretty -import PPUtil - -import CodeSyntax - - -import Patterns -import CommonTypes -import Data.Map(Map) -import Data.Set(Set) - - --- Patterns.ag imports -import UU.Scanner.Position(Pos) -import CommonTypes (ConstructorIdent,Identifier) - -ppChild :: (Identifier,Type,Bool) -> PP_Doc -ppChild (nm,tp,b) - = pp nm >#< "::" >#< pp (show tp) >#< "<" >|< ppBool b >|< ">" - -ppVertexMap :: Map Int (Identifier,Identifier,Maybe Type) -> PP_Doc -ppVertexMap m - = ppVList [ ppF (show k) $ ppAttr v | (k,v) <- Map.toList m ] - -ppAttr :: (Identifier,Identifier,Maybe Type) -> PP_Doc -ppAttr (fld,nm,mTp) - = pp fld >|< "." >|< pp nm >#< - case mTp of - Just tp -> pp "::" >#< show tp - Nothing -> empty - -ppBool :: Bool -> PP_Doc -ppBool True = pp "T" -ppBool False = pp "F" - -ppMaybeShow :: Show a => Maybe a -> PP_Doc -ppMaybeShow (Just x) = pp (show x) -ppMaybeShow Nothing = pp "_" - -ppStrings :: [String] -> PP_Doc -ppStrings = vlist --- CGrammar ---------------------------------------------------- -{- - visit 0: - synthesized attribute: - pp : PP_Doc - 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} --} --- 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 (( PP_Doc)) -data Inh_CGrammar = Inh_CGrammar {} -data Syn_CGrammar = Syn_CGrammar {pp_Syn_CGrammar :: PP_Doc} -wrap_CGrammar :: T_CGrammar -> - Inh_CGrammar -> - Syn_CGrammar -wrap_CGrammar (T_CGrammar sem ) (Inh_CGrammar ) = - (let ( _lhsOpp) = - (sem ) - in (Syn_CGrammar _lhsOpp )) -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 (let _lhsOpp :: 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 "nonts" $ ppVList _nontsIppL - ] [] - ( _nontsIpp,_nontsIppL) = - (nonts_ ) - in ( _lhsOpp)) ) --- CInterface -------------------------------------------------- -{- - visit 0: - synthesized attribute: - pp : PP_Doc - 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 (( PP_Doc)) -data Inh_CInterface = Inh_CInterface {} -data Syn_CInterface = Syn_CInterface {pp_Syn_CInterface :: PP_Doc} -wrap_CInterface :: T_CInterface -> - Inh_CInterface -> - Syn_CInterface -wrap_CInterface (T_CInterface sem ) (Inh_CInterface ) = - (let ( _lhsOpp) = - (sem ) - in (Syn_CInterface _lhsOpp )) -sem_CInterface_CInterface :: T_CSegments -> - T_CInterface -sem_CInterface_CInterface (T_CSegments seg_ ) = - (T_CInterface (let _lhsOpp :: PP_Doc - _segIpp :: PP_Doc - _segIppL :: ([PP_Doc]) - -- "CodeSyntaxDump.ag"(line 57, column 21) - _lhsOpp = - ppNestInfo ["CInterface","CInterface"] [] [ppF "seg" $ ppVList _segIppL] [] - ( _segIpp,_segIppL) = - (seg_ ) - in ( _lhsOpp)) ) --- CNonterminal ------------------------------------------------ -{- - visit 0: - synthesized attribute: - pp : PP_Doc - alternatives: - alternative CNonterminal: - child nt : {NontermIdent} - child params : {[Identifier]} - child inh : {Attributes} - child syn : {Attributes} - 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 -> - Inh_CNonterminal -> - Syn_CNonterminal -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 -> - Inh_CNonterminals -> - Syn_CNonterminals -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 _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 -> - Inh_CProduction -> - Syn_CProduction -wrap_CProduction (T_CProduction sem ) (Inh_CProduction ) = - (let ( _lhsOpp) = - (sem ) - in (Syn_CProduction _lhsOpp )) -sem_CProduction_CProduction :: ConstructorIdent -> - T_CVisits -> - ([(Identifier,Type,Bool)]) -> - ([Identifier]) -> - T_CProduction -sem_CProduction_CProduction con_ (T_CVisits visits_ ) children_ terminals_ = - (T_CProduction (let _lhsOpp :: PP_Doc - _visitsIpp :: PP_Doc - _visitsIppL :: ([PP_Doc]) - -- "CodeSyntaxDump.ag"(line 63, column 17) - _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: - synthesized attributes: - pp : PP_Doc - ppL : [PP_Doc] - 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 (( 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 -> - Inh_CProductions -> - Syn_CProductions -wrap_CProductions (T_CProductions sem ) (Inh_CProductions ) = - (let ( _lhsOpp,_lhsOppL) = - (sem ) - in (Syn_CProductions _lhsOpp _lhsOppL )) -sem_CProductions_Cons :: T_CProduction -> - T_CProductions -> - T_CProductions -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 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_CProductions_Nil :: T_CProductions -sem_CProductions_Nil = - (T_CProductions (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)) ) --- CRule ------------------------------------------------------- -{- - visit 0: - synthesized attribute: - pp : PP_Doc - alternatives: - alternative CChildVisit: - child name : {Identifier} - child nt : {NontermIdent} - child nr : {Int} - child inh : {Attributes} - child syn : {Attributes} - child isLast : {Bool} - 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)} --} --- 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 (( PP_Doc)) -data Inh_CRule = Inh_CRule {} -data Syn_CRule = Syn_CRule {pp_Syn_CRule :: PP_Doc} -wrap_CRule :: T_CRule -> - Inh_CRule -> - Syn_CRule -wrap_CRule (T_CRule sem ) (Inh_CRule ) = - (let ( _lhsOpp) = - (sem ) - in (Syn_CRule _lhsOpp )) -sem_CRule_CChildVisit :: Identifier -> - NontermIdent -> - Int -> - Attributes -> - Attributes -> - Bool -> - T_CRule -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 :: 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 (let _lhsOpp :: PP_Doc - _patternIcopy :: Pattern - _patternIpp :: PP_Doc - -- "CodeSyntaxDump.ag"(line 69, column 33) - _lhsOpp = - 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)) ) --- CSegment ---------------------------------------------------- -{- - visit 0: - synthesized attribute: - pp : PP_Doc - 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 (( PP_Doc)) -data Inh_CSegment = Inh_CSegment {} -data Syn_CSegment = Syn_CSegment {pp_Syn_CSegment :: PP_Doc} -wrap_CSegment :: T_CSegment -> - Inh_CSegment -> - Syn_CSegment -wrap_CSegment (T_CSegment sem ) (Inh_CSegment ) = - (let ( _lhsOpp) = - (sem ) - in (Syn_CSegment _lhsOpp )) -sem_CSegment_CSegment :: Attributes -> - Attributes -> - T_CSegment -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)) ) --- CSegments --------------------------------------------------- -{- - visit 0: - synthesized attributes: - pp : PP_Doc - ppL : [PP_Doc] - 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 (( 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 -> - Inh_CSegments -> - Syn_CSegments -wrap_CSegments (T_CSegments sem ) (Inh_CSegments ) = - (let ( _lhsOpp,_lhsOppL) = - (sem ) - in (Syn_CSegments _lhsOpp _lhsOppL )) -sem_CSegments_Cons :: T_CSegment -> - T_CSegments -> - T_CSegments -sem_CSegments_Cons (T_CSegment hd_ ) (T_CSegments tl_ ) = - (T_CSegments (let _lhsOppL :: ([PP_Doc]) - _lhsOpp :: PP_Doc - _hdIpp :: PP_Doc - _tlIpp :: PP_Doc - _tlIppL :: ([PP_Doc]) - -- "CodeSyntaxDump.ag"(line 98, 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_CSegments_Nil :: T_CSegments -sem_CSegments_Nil = - (T_CSegments (let _lhsOppL :: ([PP_Doc]) - _lhsOpp :: PP_Doc - -- "CodeSyntaxDump.ag"(line 99, column 33) - _lhsOppL = - [] - -- use rule "CodeSyntaxDump.ag"(line 44, column 40) - _lhsOpp = - empty - in ( _lhsOpp,_lhsOppL)) ) --- CVisit ------------------------------------------------------ -{- - visit 0: - synthesized attribute: - pp : PP_Doc - alternatives: - alternative CVisit: - child inh : {Attributes} - child syn : {Attributes} - child vss : Sequence - child intra : Sequence - child ordered : {Bool} --} --- 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 (( PP_Doc)) -data Inh_CVisit = Inh_CVisit {} -data Syn_CVisit = Syn_CVisit {pp_Syn_CVisit :: PP_Doc} -wrap_CVisit :: T_CVisit -> - Inh_CVisit -> - Syn_CVisit -wrap_CVisit (T_CVisit sem ) (Inh_CVisit ) = - (let ( _lhsOpp) = - (sem ) - 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_ = - (T_CVisit (let _lhsOpp :: PP_Doc - _vssIppL :: ([PP_Doc]) - _intraIppL :: ([PP_Doc]) - -- "CodeSyntaxDump.ag"(line 66, column 21) - _lhsOpp = - ppNestInfo ["CVisit","CVisit"] [] [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_, ppF "sequence" $ ppVList _vssIppL, ppF "intra" $ ppVList _intraIppL, ppF "ordered" $ ppBool ordered_] [] - ( _vssIppL) = - (vss_ ) - ( _intraIppL) = - (intra_ ) - in ( _lhsOpp)) ) --- CVisits ----------------------------------------------------- -{- - visit 0: - synthesized attributes: - pp : PP_Doc - ppL : [PP_Doc] - 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 (( 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 -> - Inh_CVisits -> - Syn_CVisits -wrap_CVisits (T_CVisits sem ) (Inh_CVisits ) = - (let ( _lhsOpp,_lhsOppL) = - (sem ) - in (Syn_CVisits _lhsOpp _lhsOppL )) -sem_CVisits_Cons :: T_CVisit -> - T_CVisits -> - T_CVisits -sem_CVisits_Cons (T_CVisit hd_ ) (T_CVisits tl_ ) = - (T_CVisits (let _lhsOppL :: ([PP_Doc]) - _lhsOpp :: PP_Doc - _hdIpp :: PP_Doc - _tlIpp :: PP_Doc - _tlIppL :: ([PP_Doc]) - -- "CodeSyntaxDump.ag"(line 90, 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_CVisits_Nil :: T_CVisits -sem_CVisits_Nil = - (T_CVisits (let _lhsOppL :: ([PP_Doc]) - _lhsOpp :: PP_Doc - -- "CodeSyntaxDump.ag"(line 91, column 33) - _lhsOppL = - [] - -- use rule "CodeSyntaxDump.ag"(line 44, column 40) - _lhsOpp = - empty - in ( _lhsOpp,_lhsOppL)) ) --- Pattern ----------------------------------------------------- -{- - visit 0: - synthesized attributes: - copy : SELF - pp : PP_Doc - 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,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 -> - Inh_Pattern -> - Syn_Pattern -wrap_Pattern (T_Pattern sem ) (Inh_Pattern ) = - (let ( _lhsOcopy,_lhsOpp) = - (sem ) - 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_ ) = - (T_Pattern (let _lhsOpp :: PP_Doc - _lhsOcopy :: Pattern - _patIcopy :: Pattern - _patIpp :: PP_Doc - _partsIcopy :: Patterns - _partsIpp :: PP_Doc - _partsIppL :: ([PP_Doc]) - -- "CodeSyntaxDump.ag"(line 75, column 33) - _lhsOpp = - ppNestInfo ["Pattern","Alias"] [pp field_, pp attr_] [ppF "pat" $ _patIpp] [] - -- self rule - _copy = - Alias field_ attr_ _patIcopy _partsIcopy - -- self rule - _lhsOcopy = - _copy - ( _patIcopy,_patIpp) = - (pat_ ) - ( _partsIcopy,_partsIpp,_partsIppL) = - (parts_ ) - in ( _lhsOcopy,_lhsOpp)) ) -sem_Pattern_Constr :: ConstructorIdent -> - T_Patterns -> - T_Pattern -sem_Pattern_Constr name_ (T_Patterns pats_ ) = - (T_Pattern (let _lhsOpp :: PP_Doc - _lhsOcopy :: Pattern - _patsIcopy :: Patterns - _patsIpp :: PP_Doc - _patsIppL :: ([PP_Doc]) - -- "CodeSyntaxDump.ag"(line 73, column 33) - _lhsOpp = - ppNestInfo ["Pattern","Constr"] [pp name_] [ppF "pats" $ ppVList _patsIppL] [] - -- self rule - _copy = - Constr name_ _patsIcopy - -- self rule - _lhsOcopy = - _copy - ( _patsIcopy,_patsIpp,_patsIppL) = - (pats_ ) - 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_ ) = - (T_Pattern (let _lhsOpp :: PP_Doc - _lhsOcopy :: Pattern - _patsIcopy :: Patterns - _patsIpp :: PP_Doc - _patsIppL :: ([PP_Doc]) - -- "CodeSyntaxDump.ag"(line 74, column 33) - _lhsOpp = - ppNestInfo ["Pattern","Product"] [ppShow pos_] [ppF "pats" $ ppVList _patsIppL] [] - -- self rule - _copy = - Product pos_ _patsIcopy - -- self rule - _lhsOcopy = - _copy - ( _patsIcopy,_patsIpp,_patsIppL) = - (pats_ ) - in ( _lhsOcopy,_lhsOpp)) ) -sem_Pattern_Underscore :: Pos -> - T_Pattern -sem_Pattern_Underscore pos_ = - (T_Pattern (let _lhsOpp :: PP_Doc - _lhsOcopy :: Pattern - -- "CodeSyntaxDump.ag"(line 76, column 25) - _lhsOpp = - ppNestInfo ["Pattern","Underscore"] [ppShow pos_] [] [] - -- self rule - _copy = - Underscore pos_ - -- self rule - _lhsOcopy = - _copy - in ( _lhsOcopy,_lhsOpp)) ) --- Patterns ---------------------------------------------------- -{- - visit 0: - synthesized attributes: - copy : SELF - pp : PP_Doc - ppL : [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 (( 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 -> - Inh_Patterns -> - Syn_Patterns -wrap_Patterns (T_Patterns sem ) (Inh_Patterns ) = - (let ( _lhsOcopy,_lhsOpp,_lhsOppL) = - (sem ) - in (Syn_Patterns _lhsOcopy _lhsOpp _lhsOppL )) -sem_Patterns_Cons :: T_Pattern -> - T_Patterns -> - T_Patterns -sem_Patterns_Cons (T_Pattern hd_ ) (T_Patterns tl_ ) = - (T_Patterns (let _lhsOppL :: ([PP_Doc]) - _lhsOpp :: PP_Doc - _lhsOcopy :: Patterns - _hdIcopy :: Pattern - _hdIpp :: PP_Doc - _tlIcopy :: Patterns - _tlIpp :: PP_Doc - _tlIppL :: ([PP_Doc]) - -- "CodeSyntaxDump.ag"(line 82, column 33) - _lhsOppL = - _hdIpp : _tlIppL - -- use rule "CodeSyntaxDump.ag"(line 44, column 40) - _lhsOpp = - _hdIpp >-< _tlIpp - -- self rule - _copy = - (:) _hdIcopy _tlIcopy - -- self rule - _lhsOcopy = - _copy - ( _hdIcopy,_hdIpp) = - (hd_ ) - ( _tlIcopy,_tlIpp,_tlIppL) = - (tl_ ) - in ( _lhsOcopy,_lhsOpp,_lhsOppL)) ) -sem_Patterns_Nil :: T_Patterns -sem_Patterns_Nil = - (T_Patterns (let _lhsOppL :: ([PP_Doc]) - _lhsOpp :: PP_Doc - _lhsOcopy :: Patterns - -- "CodeSyntaxDump.ag"(line 83, column 33) - _lhsOppL = - [] - -- use rule "CodeSyntaxDump.ag"(line 44, column 40) - _lhsOpp = - empty - -- self rule - _copy = - [] - -- self rule - _lhsOcopy = - _copy - in ( _lhsOcopy,_lhsOpp,_lhsOppL)) ) --- Sequence ---------------------------------------------------- -{- - visit 0: - synthesized attribute: - ppL : [PP_Doc] - 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 (( ([PP_Doc]))) -data Inh_Sequence = Inh_Sequence {} -data Syn_Sequence = Syn_Sequence {ppL_Syn_Sequence :: [PP_Doc]} -wrap_Sequence :: T_Sequence -> - Inh_Sequence -> - Syn_Sequence -wrap_Sequence (T_Sequence sem ) (Inh_Sequence ) = - (let ( _lhsOppL) = - (sem ) - in (Syn_Sequence _lhsOppL )) -sem_Sequence_Cons :: T_CRule -> - T_Sequence -> - T_Sequence -sem_Sequence_Cons (T_CRule hd_ ) (T_Sequence tl_ ) = - (T_Sequence (let _lhsOppL :: ([PP_Doc]) - _hdIpp :: PP_Doc - _tlIppL :: ([PP_Doc]) - -- "CodeSyntaxDump.ag"(line 86, column 33) - _lhsOppL = - _hdIpp : _tlIppL - ( _hdIpp) = - (hd_ ) - ( _tlIppL) = - (tl_ ) - in ( _lhsOppL)) ) -sem_Sequence_Nil :: T_Sequence -sem_Sequence_Nil = - (T_Sequence (let _lhsOppL :: ([PP_Doc]) - -- "CodeSyntaxDump.ag"(line 87, column 33) - _lhsOppL = - [] +++-- UUAGC 0.9.12 (CodeSyntaxDump.ag)+module CodeSyntaxDump where++import Data.List+import qualified Data.Map as Map++import Pretty+import PPUtil++import CodeSyntax+++import Patterns+import CommonTypes+import Data.Map(Map)+import Data.Set(Set)+++-- Patterns.ag imports+import UU.Scanner.Position(Pos)+import CommonTypes (ConstructorIdent,Identifier)++ppChild :: (Identifier,Type,Bool) -> PP_Doc+ppChild (nm,tp,b)+ = pp nm >#< "::" >#< pp (show tp) >#< "<" >|< ppBool b >|< ">"+ +ppVertexMap :: Map Int (Identifier,Identifier,Maybe Type) -> PP_Doc+ppVertexMap m+ = ppVList [ ppF (show k) $ ppAttr v | (k,v) <- Map.toList m ]++ppAttr :: (Identifier,Identifier,Maybe Type) -> PP_Doc+ppAttr (fld,nm,mTp)+ = pp fld >|< "." >|< pp nm >#<+ case mTp of+ Just tp -> pp "::" >#< show tp+ Nothing -> empty++ppBool :: Bool -> PP_Doc+ppBool True = pp "T"+ppBool False = pp "F"++ppMaybeShow :: Show a => Maybe a -> PP_Doc+ppMaybeShow (Just x) = pp (show x)+ppMaybeShow Nothing = pp "_"++ppStrings :: [String] -> PP_Doc+ppStrings = vlist+-- CGrammar ----------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ pp : PP_Doc+ 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}+-}+-- 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 (( PP_Doc))+data Inh_CGrammar = Inh_CGrammar {}+data Syn_CGrammar = Syn_CGrammar {pp_Syn_CGrammar :: PP_Doc}+wrap_CGrammar :: T_CGrammar ->+ Inh_CGrammar ->+ Syn_CGrammar +wrap_CGrammar (T_CGrammar sem ) (Inh_CGrammar ) =+ (let ( _lhsOpp) =+ (sem )+ in (Syn_CGrammar _lhsOpp ))+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 (let _lhsOpp :: 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 "nonts" $ ppVList _nontsIppL+ ] []+ ( _nontsIpp,_nontsIppL) =+ (nonts_ )+ in ( _lhsOpp)) )+-- CInterface --------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ pp : PP_Doc+ 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 (( PP_Doc))+data Inh_CInterface = Inh_CInterface {}+data Syn_CInterface = Syn_CInterface {pp_Syn_CInterface :: PP_Doc}+wrap_CInterface :: T_CInterface ->+ Inh_CInterface ->+ Syn_CInterface +wrap_CInterface (T_CInterface sem ) (Inh_CInterface ) =+ (let ( _lhsOpp) =+ (sem )+ in (Syn_CInterface _lhsOpp ))+sem_CInterface_CInterface :: T_CSegments ->+ T_CInterface +sem_CInterface_CInterface (T_CSegments seg_ ) =+ (T_CInterface (let _lhsOpp :: PP_Doc+ _segIpp :: PP_Doc+ _segIppL :: ([PP_Doc])+ -- "CodeSyntaxDump.ag"(line 57, column 21)+ _lhsOpp =+ ppNestInfo ["CInterface","CInterface"] [] [ppF "seg" $ ppVList _segIppL] []+ ( _segIpp,_segIppL) =+ (seg_ )+ in ( _lhsOpp)) )+-- CNonterminal ------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ pp : PP_Doc+ alternatives:+ alternative CNonterminal:+ child nt : {NontermIdent}+ child params : {[Identifier]}+ child inh : {Attributes}+ child syn : {Attributes}+ 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 ->+ Inh_CNonterminal ->+ Syn_CNonterminal +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 ->+ Inh_CNonterminals ->+ Syn_CNonterminals +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 _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 ->+ Inh_CProduction ->+ Syn_CProduction +wrap_CProduction (T_CProduction sem ) (Inh_CProduction ) =+ (let ( _lhsOpp) =+ (sem )+ in (Syn_CProduction _lhsOpp ))+sem_CProduction_CProduction :: ConstructorIdent ->+ T_CVisits ->+ ([(Identifier,Type,Bool)]) ->+ ([Identifier]) ->+ T_CProduction +sem_CProduction_CProduction con_ (T_CVisits visits_ ) children_ terminals_ =+ (T_CProduction (let _lhsOpp :: PP_Doc+ _visitsIpp :: PP_Doc+ _visitsIppL :: ([PP_Doc])+ -- "CodeSyntaxDump.ag"(line 63, column 17)+ _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:+ synthesized attributes:+ pp : PP_Doc+ ppL : [PP_Doc]+ 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 (( 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 ->+ Inh_CProductions ->+ Syn_CProductions +wrap_CProductions (T_CProductions sem ) (Inh_CProductions ) =+ (let ( _lhsOpp,_lhsOppL) =+ (sem )+ in (Syn_CProductions _lhsOpp _lhsOppL ))+sem_CProductions_Cons :: T_CProduction ->+ T_CProductions ->+ T_CProductions +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 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_CProductions_Nil :: T_CProductions +sem_CProductions_Nil =+ (T_CProductions (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)) )+-- CRule -------------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ pp : PP_Doc+ alternatives:+ alternative CChildVisit:+ child name : {Identifier}+ child nt : {NontermIdent}+ child nr : {Int}+ child inh : {Attributes}+ child syn : {Attributes}+ child isLast : {Bool}+ 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)}+-}+-- 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 (( PP_Doc))+data Inh_CRule = Inh_CRule {}+data Syn_CRule = Syn_CRule {pp_Syn_CRule :: PP_Doc}+wrap_CRule :: T_CRule ->+ Inh_CRule ->+ Syn_CRule +wrap_CRule (T_CRule sem ) (Inh_CRule ) =+ (let ( _lhsOpp) =+ (sem )+ in (Syn_CRule _lhsOpp ))+sem_CRule_CChildVisit :: Identifier ->+ NontermIdent ->+ Int ->+ Attributes ->+ Attributes ->+ Bool ->+ T_CRule +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 :: 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 (let _lhsOpp :: PP_Doc+ _patternIcopy :: Pattern+ _patternIpp :: PP_Doc+ -- "CodeSyntaxDump.ag"(line 69, column 33)+ _lhsOpp =+ 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)) )+-- CSegment ----------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ pp : PP_Doc+ 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 (( PP_Doc))+data Inh_CSegment = Inh_CSegment {}+data Syn_CSegment = Syn_CSegment {pp_Syn_CSegment :: PP_Doc}+wrap_CSegment :: T_CSegment ->+ Inh_CSegment ->+ Syn_CSegment +wrap_CSegment (T_CSegment sem ) (Inh_CSegment ) =+ (let ( _lhsOpp) =+ (sem )+ in (Syn_CSegment _lhsOpp ))+sem_CSegment_CSegment :: Attributes ->+ Attributes ->+ T_CSegment +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)) )+-- CSegments ---------------------------------------------------+{-+ visit 0:+ synthesized attributes:+ pp : PP_Doc+ ppL : [PP_Doc]+ 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 (( 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 ->+ Inh_CSegments ->+ Syn_CSegments +wrap_CSegments (T_CSegments sem ) (Inh_CSegments ) =+ (let ( _lhsOpp,_lhsOppL) =+ (sem )+ in (Syn_CSegments _lhsOpp _lhsOppL ))+sem_CSegments_Cons :: T_CSegment ->+ T_CSegments ->+ T_CSegments +sem_CSegments_Cons (T_CSegment hd_ ) (T_CSegments tl_ ) =+ (T_CSegments (let _lhsOppL :: ([PP_Doc])+ _lhsOpp :: PP_Doc+ _hdIpp :: PP_Doc+ _tlIpp :: PP_Doc+ _tlIppL :: ([PP_Doc])+ -- "CodeSyntaxDump.ag"(line 98, 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_CSegments_Nil :: T_CSegments +sem_CSegments_Nil =+ (T_CSegments (let _lhsOppL :: ([PP_Doc])+ _lhsOpp :: PP_Doc+ -- "CodeSyntaxDump.ag"(line 99, column 33)+ _lhsOppL =+ []+ -- use rule "CodeSyntaxDump.ag"(line 44, column 40)+ _lhsOpp =+ empty+ in ( _lhsOpp,_lhsOppL)) )+-- CVisit ------------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ pp : PP_Doc+ alternatives:+ alternative CVisit:+ child inh : {Attributes}+ child syn : {Attributes}+ child vss : Sequence + child intra : Sequence + child ordered : {Bool}+-}+-- 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 (( PP_Doc))+data Inh_CVisit = Inh_CVisit {}+data Syn_CVisit = Syn_CVisit {pp_Syn_CVisit :: PP_Doc}+wrap_CVisit :: T_CVisit ->+ Inh_CVisit ->+ Syn_CVisit +wrap_CVisit (T_CVisit sem ) (Inh_CVisit ) =+ (let ( _lhsOpp) =+ (sem )+ 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_ =+ (T_CVisit (let _lhsOpp :: PP_Doc+ _vssIppL :: ([PP_Doc])+ _intraIppL :: ([PP_Doc])+ -- "CodeSyntaxDump.ag"(line 66, column 21)+ _lhsOpp =+ ppNestInfo ["CVisit","CVisit"] [] [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_, ppF "sequence" $ ppVList _vssIppL, ppF "intra" $ ppVList _intraIppL, ppF "ordered" $ ppBool ordered_] []+ ( _vssIppL) =+ (vss_ )+ ( _intraIppL) =+ (intra_ )+ in ( _lhsOpp)) )+-- CVisits -----------------------------------------------------+{-+ visit 0:+ synthesized attributes:+ pp : PP_Doc+ ppL : [PP_Doc]+ 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 (( 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 ->+ Inh_CVisits ->+ Syn_CVisits +wrap_CVisits (T_CVisits sem ) (Inh_CVisits ) =+ (let ( _lhsOpp,_lhsOppL) =+ (sem )+ in (Syn_CVisits _lhsOpp _lhsOppL ))+sem_CVisits_Cons :: T_CVisit ->+ T_CVisits ->+ T_CVisits +sem_CVisits_Cons (T_CVisit hd_ ) (T_CVisits tl_ ) =+ (T_CVisits (let _lhsOppL :: ([PP_Doc])+ _lhsOpp :: PP_Doc+ _hdIpp :: PP_Doc+ _tlIpp :: PP_Doc+ _tlIppL :: ([PP_Doc])+ -- "CodeSyntaxDump.ag"(line 90, 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_CVisits_Nil :: T_CVisits +sem_CVisits_Nil =+ (T_CVisits (let _lhsOppL :: ([PP_Doc])+ _lhsOpp :: PP_Doc+ -- "CodeSyntaxDump.ag"(line 91, column 33)+ _lhsOppL =+ []+ -- use rule "CodeSyntaxDump.ag"(line 44, column 40)+ _lhsOpp =+ empty+ in ( _lhsOpp,_lhsOppL)) )+-- Pattern -----------------------------------------------------+{-+ visit 0:+ synthesized attributes:+ copy : SELF + pp : PP_Doc+ 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,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 ->+ Inh_Pattern ->+ Syn_Pattern +wrap_Pattern (T_Pattern sem ) (Inh_Pattern ) =+ (let ( _lhsOcopy,_lhsOpp) =+ (sem )+ 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_ ) =+ (T_Pattern (let _lhsOpp :: PP_Doc+ _lhsOcopy :: Pattern+ _patIcopy :: Pattern+ _patIpp :: PP_Doc+ _partsIcopy :: Patterns+ _partsIpp :: PP_Doc+ _partsIppL :: ([PP_Doc])+ -- "CodeSyntaxDump.ag"(line 75, column 33)+ _lhsOpp =+ ppNestInfo ["Pattern","Alias"] [pp field_, pp attr_] [ppF "pat" $ _patIpp] []+ -- self rule+ _copy =+ Alias field_ attr_ _patIcopy _partsIcopy+ -- self rule+ _lhsOcopy =+ _copy+ ( _patIcopy,_patIpp) =+ (pat_ )+ ( _partsIcopy,_partsIpp,_partsIppL) =+ (parts_ )+ in ( _lhsOcopy,_lhsOpp)) )+sem_Pattern_Constr :: ConstructorIdent ->+ T_Patterns ->+ T_Pattern +sem_Pattern_Constr name_ (T_Patterns pats_ ) =+ (T_Pattern (let _lhsOpp :: PP_Doc+ _lhsOcopy :: Pattern+ _patsIcopy :: Patterns+ _patsIpp :: PP_Doc+ _patsIppL :: ([PP_Doc])+ -- "CodeSyntaxDump.ag"(line 73, column 33)+ _lhsOpp =+ ppNestInfo ["Pattern","Constr"] [pp name_] [ppF "pats" $ ppVList _patsIppL] []+ -- self rule+ _copy =+ Constr name_ _patsIcopy+ -- self rule+ _lhsOcopy =+ _copy+ ( _patsIcopy,_patsIpp,_patsIppL) =+ (pats_ )+ 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_ ) =+ (T_Pattern (let _lhsOpp :: PP_Doc+ _lhsOcopy :: Pattern+ _patsIcopy :: Patterns+ _patsIpp :: PP_Doc+ _patsIppL :: ([PP_Doc])+ -- "CodeSyntaxDump.ag"(line 74, column 33)+ _lhsOpp =+ ppNestInfo ["Pattern","Product"] [ppShow pos_] [ppF "pats" $ ppVList _patsIppL] []+ -- self rule+ _copy =+ Product pos_ _patsIcopy+ -- self rule+ _lhsOcopy =+ _copy+ ( _patsIcopy,_patsIpp,_patsIppL) =+ (pats_ )+ in ( _lhsOcopy,_lhsOpp)) )+sem_Pattern_Underscore :: Pos ->+ T_Pattern +sem_Pattern_Underscore pos_ =+ (T_Pattern (let _lhsOpp :: PP_Doc+ _lhsOcopy :: Pattern+ -- "CodeSyntaxDump.ag"(line 76, column 25)+ _lhsOpp =+ ppNestInfo ["Pattern","Underscore"] [ppShow pos_] [] []+ -- self rule+ _copy =+ Underscore pos_+ -- self rule+ _lhsOcopy =+ _copy+ in ( _lhsOcopy,_lhsOpp)) )+-- Patterns ----------------------------------------------------+{-+ visit 0:+ synthesized attributes:+ copy : SELF + pp : PP_Doc+ ppL : [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 (( 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 ->+ Inh_Patterns ->+ Syn_Patterns +wrap_Patterns (T_Patterns sem ) (Inh_Patterns ) =+ (let ( _lhsOcopy,_lhsOpp,_lhsOppL) =+ (sem )+ in (Syn_Patterns _lhsOcopy _lhsOpp _lhsOppL ))+sem_Patterns_Cons :: T_Pattern ->+ T_Patterns ->+ T_Patterns +sem_Patterns_Cons (T_Pattern hd_ ) (T_Patterns tl_ ) =+ (T_Patterns (let _lhsOppL :: ([PP_Doc])+ _lhsOpp :: PP_Doc+ _lhsOcopy :: Patterns+ _hdIcopy :: Pattern+ _hdIpp :: PP_Doc+ _tlIcopy :: Patterns+ _tlIpp :: PP_Doc+ _tlIppL :: ([PP_Doc])+ -- "CodeSyntaxDump.ag"(line 82, column 33)+ _lhsOppL =+ _hdIpp : _tlIppL+ -- use rule "CodeSyntaxDump.ag"(line 44, column 40)+ _lhsOpp =+ _hdIpp >-< _tlIpp+ -- self rule+ _copy =+ (:) _hdIcopy _tlIcopy+ -- self rule+ _lhsOcopy =+ _copy+ ( _hdIcopy,_hdIpp) =+ (hd_ )+ ( _tlIcopy,_tlIpp,_tlIppL) =+ (tl_ )+ in ( _lhsOcopy,_lhsOpp,_lhsOppL)) )+sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil =+ (T_Patterns (let _lhsOppL :: ([PP_Doc])+ _lhsOpp :: PP_Doc+ _lhsOcopy :: Patterns+ -- "CodeSyntaxDump.ag"(line 83, column 33)+ _lhsOppL =+ []+ -- use rule "CodeSyntaxDump.ag"(line 44, column 40)+ _lhsOpp =+ empty+ -- self rule+ _copy =+ []+ -- self rule+ _lhsOcopy =+ _copy+ in ( _lhsOcopy,_lhsOpp,_lhsOppL)) )+-- Sequence ----------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ ppL : [PP_Doc]+ 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 (( ([PP_Doc])))+data Inh_Sequence = Inh_Sequence {}+data Syn_Sequence = Syn_Sequence {ppL_Syn_Sequence :: [PP_Doc]}+wrap_Sequence :: T_Sequence ->+ Inh_Sequence ->+ Syn_Sequence +wrap_Sequence (T_Sequence sem ) (Inh_Sequence ) =+ (let ( _lhsOppL) =+ (sem )+ in (Syn_Sequence _lhsOppL ))+sem_Sequence_Cons :: T_CRule ->+ T_Sequence ->+ T_Sequence +sem_Sequence_Cons (T_CRule hd_ ) (T_Sequence tl_ ) =+ (T_Sequence (let _lhsOppL :: ([PP_Doc])+ _hdIpp :: PP_Doc+ _tlIppL :: ([PP_Doc])+ -- "CodeSyntaxDump.ag"(line 86, column 33)+ _lhsOppL =+ _hdIpp : _tlIppL+ ( _hdIpp) =+ (hd_ )+ ( _tlIppL) =+ (tl_ )+ 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)) )
src-derived/ConcreteSyntax.hs view
@@ -1,209 +1,209 @@- - --- UUAGC 0.9.11 (ConcreteSyntax.ag) -module ConcreteSyntax where - -import UU.Scanner.Position (Pos) -import Patterns (Pattern) -import Expression (Expression) -import CommonTypes --- AG ---------------------------------------------------------- -{- - alternatives: - alternative AG: - child elems : Elems --} -data AG = AG (Elems) --- Alt --------------------------------------------------------- -{- - alternatives: - alternative Alt: - child pos : {Pos} - child names : ConstructorSet - child fields : {Fields} --} -data Alt = Alt (Pos) (ConstructorSet) (Fields) --- Alts -------------------------------------------------------- -{- - alternatives: - alternative Cons: - child hd : Alt - child tl : Alts - alternative Nil: --} -type Alts = [(Alt)] --- Attrs ------------------------------------------------------- -{- - alternatives: - alternative Attrs: - child pos : {Pos} - child inh : {AttrNames} - child chn : {AttrNames} - child syn : {AttrNames} --} -data Attrs = Attrs (Pos) (AttrNames) (AttrNames) (AttrNames) --- ConstructorSet ---------------------------------------------- -{- - alternatives: - alternative CAll: - alternative CDifference: - child set1 : ConstructorSet - child set2 : ConstructorSet - alternative CName: - child name : {ConstructorIdent} - alternative CUnion: - child set1 : ConstructorSet - child set2 : ConstructorSet --} -data ConstructorSet = CAll - | 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 : {[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 - alternative Txt: - child pos : {Pos} - child name : {Identifier} - child mbNt : {Maybe NontermIdent} - child lines : {[String]} - alternative Type: - child pos : {Pos} - child ctx : {ClassContext} - child name : {NontermIdent} - child params : {[Identifier]} - child type : {ComplexType} - alternative Wrapper: - child pos : {Pos} - child set : 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) (Identifier) (Maybe NontermIdent) ([String]) - | Type (Pos) (ClassContext) (NontermIdent) ([Identifier]) (ComplexType) - | Wrapper (Pos) (NontSet) --- Elems ------------------------------------------------------- -{- - alternatives: - alternative Cons: - child hd : Elem - child tl : Elems - alternative Nil: --} -type Elems = [(Elem)] --- NontSet ----------------------------------------------------- -{- - alternatives: - alternative All: - alternative Difference: - child set1 : NontSet - child set2 : NontSet - alternative Intersect: - child set1 : NontSet - child set2 : NontSet - alternative NamedSet: - child name : {NontermIdent} - alternative Path: - child from : {NontermIdent} - child to : {NontermIdent} - alternative Union: - child set1 : NontSet - child set2 : NontSet --} -data NontSet = All - | Difference (NontSet) (NontSet) - | Intersect (NontSet) (NontSet) - | NamedSet (NontermIdent) - | Path (NontermIdent) (NontermIdent) - | Union (NontSet) (NontSet) --- SemAlt ------------------------------------------------------ -{- - alternatives: - alternative SemAlt: - child pos : {Pos} - child constructorSet : ConstructorSet - child rules : SemDefs --} -data SemAlt = SemAlt (Pos) (ConstructorSet) (SemDefs) --- SemAlts ----------------------------------------------------- -{- - alternatives: - alternative Cons: - child hd : SemAlt - child tl : SemAlts - alternative Nil: --} -type SemAlts = [(SemAlt)] --- SemDef ------------------------------------------------------ -{- - alternatives: - alternative AttrOrderBefore: - child before : {[(Identifier,Identifier)]} - child after : {[(Identifier,Identifier)]} - alternative Def: - child pattern : {Pattern} - child rhs : {Expression} - child owrt : {Bool} - alternative SemPragma: - child names : {[NontermIdent]} - alternative TypeDef: - child ident : {Identifier} - child tp : {Type} - alternative UniqueDef: - child ident : {Identifier} - child ref : {Identifier} --} -data SemDef = AttrOrderBefore ([(Identifier,Identifier)]) ([(Identifier,Identifier)]) - | Def (Pattern) (Expression) (Bool) - | SemPragma ([NontermIdent]) - | TypeDef (Identifier) (Type) - | UniqueDef (Identifier) (Identifier) --- SemDefs ----------------------------------------------------- -{- - alternatives: - alternative Cons: - child hd : SemDef - child tl : SemDefs - alternative Nil: --} +++-- UUAGC 0.9.12 (ConcreteSyntax.ag)+module ConcreteSyntax where++import UU.Scanner.Position (Pos)+import Patterns (Pattern)+import Expression (Expression)+import CommonTypes+-- AG ----------------------------------------------------------+{-+ alternatives:+ alternative AG:+ child elems : Elems +-}+data AG = AG (Elems) +-- Alt ---------------------------------------------------------+{-+ alternatives:+ alternative Alt:+ child pos : {Pos}+ child names : ConstructorSet + child fields : {Fields}+-}+data Alt = Alt (Pos) (ConstructorSet) (Fields) +-- Alts --------------------------------------------------------+{-+ alternatives:+ alternative Cons:+ child hd : Alt + child tl : Alts + alternative Nil:+-}+type Alts = [(Alt)]+-- Attrs -------------------------------------------------------+{-+ alternatives:+ alternative Attrs:+ child pos : {Pos}+ child inh : {AttrNames}+ child chn : {AttrNames}+ child syn : {AttrNames}+-}+data Attrs = Attrs (Pos) (AttrNames) (AttrNames) (AttrNames) +-- ConstructorSet ----------------------------------------------+{-+ alternatives:+ alternative CAll:+ alternative CDifference:+ child set1 : ConstructorSet + child set2 : ConstructorSet + alternative CName:+ child name : {ConstructorIdent}+ alternative CUnion:+ child set1 : ConstructorSet + child set2 : ConstructorSet +-}+data ConstructorSet = CAll + | 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 : {[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 + alternative Txt:+ child pos : {Pos}+ child name : {Identifier}+ child mbNt : {Maybe NontermIdent}+ child lines : {[String]}+ alternative Type:+ child pos : {Pos}+ child ctx : {ClassContext}+ child name : {NontermIdent}+ child params : {[Identifier]}+ child type : {ComplexType}+ alternative Wrapper:+ child pos : {Pos}+ child set : 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) (Identifier) (Maybe NontermIdent) ([String]) + | Type (Pos) (ClassContext) (NontermIdent) ([Identifier]) (ComplexType) + | Wrapper (Pos) (NontSet) +-- Elems -------------------------------------------------------+{-+ alternatives:+ alternative Cons:+ child hd : Elem + child tl : Elems + alternative Nil:+-}+type Elems = [(Elem)]+-- NontSet -----------------------------------------------------+{-+ alternatives:+ alternative All:+ alternative Difference:+ child set1 : NontSet + child set2 : NontSet + alternative Intersect:+ child set1 : NontSet + child set2 : NontSet + alternative NamedSet:+ child name : {NontermIdent}+ alternative Path:+ child from : {NontermIdent}+ child to : {NontermIdent}+ alternative Union:+ child set1 : NontSet + child set2 : NontSet +-}+data NontSet = All + | Difference (NontSet) (NontSet) + | Intersect (NontSet) (NontSet) + | NamedSet (NontermIdent) + | Path (NontermIdent) (NontermIdent) + | Union (NontSet) (NontSet) +-- SemAlt ------------------------------------------------------+{-+ alternatives:+ alternative SemAlt:+ child pos : {Pos}+ child constructorSet : ConstructorSet + child rules : SemDefs +-}+data SemAlt = SemAlt (Pos) (ConstructorSet) (SemDefs) +-- SemAlts -----------------------------------------------------+{-+ alternatives:+ alternative Cons:+ child hd : SemAlt + child tl : SemAlts + alternative Nil:+-}+type SemAlts = [(SemAlt)]+-- SemDef ------------------------------------------------------+{-+ alternatives:+ alternative AttrOrderBefore:+ child before : {[(Identifier,Identifier)]}+ child after : {[(Identifier,Identifier)]}+ alternative Def:+ child pattern : {Pattern}+ child rhs : {Expression}+ child owrt : {Bool}+ alternative SemPragma:+ child names : {[NontermIdent]}+ alternative TypeDef:+ child ident : {Identifier}+ child tp : {Type}+ alternative UniqueDef:+ child ident : {Identifier}+ child ref : {Identifier}+-}+data SemDef = AttrOrderBefore ([(Identifier,Identifier)]) ([(Identifier,Identifier)]) + | Def (Pattern) (Expression) (Bool) + | SemPragma ([NontermIdent]) + | TypeDef (Identifier) (Type) + | UniqueDef (Identifier) (Identifier) +-- SemDefs -----------------------------------------------------+{-+ alternatives:+ alternative Cons:+ child hd : SemDef + child tl : SemDefs + alternative Nil:+-} type SemDefs = [(SemDef)]
src-derived/DeclBlocks.hs view
@@ -1,26 +1,26 @@- - --- UUAGC 0.9.11 (DeclBlocks.ag) -module DeclBlocks where - -import Code (Decl,Expr) --- DeclBlocks -------------------------------------------------- -{- - alternatives: - alternative DeclBlock: - child defs : {[Decl]} - child visit : {Decl} - child next : DeclBlocks - alternative DeclTerminator: - child defs : {[Decl]} - child result : {Expr} --} -data DeclBlocks = DeclBlock ([Decl]) (Decl) (DeclBlocks) - | DeclTerminator ([Decl]) (Expr) --- DeclBlocksRoot ---------------------------------------------- -{- - alternatives: - alternative DeclBlocksRoot: - child blocks : DeclBlocks --} +++-- UUAGC 0.9.12 (DeclBlocks.ag)+module DeclBlocks where++import Code (Decl,Expr)+-- DeclBlocks --------------------------------------------------+{-+ alternatives:+ alternative DeclBlock:+ child defs : {[Decl]}+ child visit : {Decl}+ child next : DeclBlocks + alternative DeclTerminator:+ child defs : {[Decl]}+ child result : {Expr}+-}+data DeclBlocks = DeclBlock ([Decl]) (Decl) (DeclBlocks) + | DeclTerminator ([Decl]) (Expr) +-- DeclBlocksRoot ----------------------------------------------+{-+ alternatives:+ alternative DeclBlocksRoot:+ child blocks : DeclBlocks +-} data DeclBlocksRoot = DeclBlocksRoot (DeclBlocks)
src-derived/DefaultRules.hs view
@@ -1,1679 +1,1679 @@-{-# OPTIONS_GHC -fbang-patterns #-} - --- UUAGC 0.9.11 (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 Data.Sequence as Seq -import Data.Sequence(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.><) 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.singleton (MissingRule nt con fld a) - ) - Just f - | f == _ACHILD -> ( fieldName a - , Seq.singleton (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.singleton (MissingRule nt con fld a) - ) - Just f - | f == _ACHILD -> ( [AGLocal a noPos Nothing] - , Seq.singleton (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 -> - Inh_Child -> - Syn_Child -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) -> - (case (Seq.empty) of - { !_lhsOerrors -> - (case ((name_,tp_,higherOrder_)) of - { !_lhsOfield -> - (case (inh_) of - { !_lhsOinherited -> - (case (name_) of - { !_lhsOname -> - (case (Child name_ tp_ inh_ syn_ higherOrder_) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - (case (syn_) of - { !_lhsOsynthesized -> - ( _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 -> - Inh_Children -> - Syn_Children -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) -> - (case (_lhsInt) of - { !_tlOnt -> - (case (_lhsIcr) of - { !_tlOcr -> - (case (_lhsIcon) of - { !_tlOcon -> - (case ((tl_ _tlOcon _tlOcr _tlOnt )) of - { ( !_tlIerrors,!_tlIfields,!_tlIinputs,!_tlIoutput,!_tlIoutputs) -> - (case (_lhsInt) of - { !_hdOnt -> - (case (_lhsIcr) of - { !_hdOcr -> - (case (_lhsIcon) of - { !_hdOcon -> - (case ((hd_ _hdOcon _hdOcr _hdOnt )) of - { ( !_hdIerrors,!_hdIfield,!_hdIinherited,!_hdIname,!_hdIoutput,!_hdIsynthesized) -> - (case (_hdIerrors Seq.>< _tlIerrors) of - { !_lhsOerrors -> - (case (_hdIfield : _tlIfields) of - { !_lhsOfields -> - (case ((_hdIname, _hdIinherited) : _tlIinputs) of - { !_lhsOinputs -> - (case ((:) _hdIoutput _tlIoutput) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - (case ((_hdIname, _hdIsynthesized) : _tlIoutputs) of - { !_lhsOoutputs -> - ( _lhsOerrors,_lhsOfields,_lhsOinputs,_lhsOoutput,_lhsOoutputs) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Children_Nil :: T_Children -sem_Children_Nil = - (T_Children (\ (!_lhsIcon) - (!_lhsIcr) - (!_lhsInt) -> - (case (Seq.empty) of - { !_lhsOerrors -> - (case ([]) of - { !_lhsOfields -> - (case ([]) of - { !_lhsOinputs -> - (case ([]) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - (case ([]) of - { !_lhsOoutputs -> - ( _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} - child uniqueMap : {UniqueMap} - visit 0: - local output : _ --} --- cata -sem_Grammar :: Grammar -> - T_Grammar -sem_Grammar !(Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap ) = - (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts ) _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap ) --- 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 -> - Inh_Grammar -> - Syn_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 -> - UniqueMap -> - T_Grammar -sem_Grammar_Grammar !typeSyns_ !useMap_ !derivings_ !wrappers_ !(T_Nonterminals nonts_ ) !pragmas_ !manualAttrOrderMap_ !paramMap_ !contextMap_ !uniqueMap_ = - (T_Grammar (\ (!_lhsIoptions) -> - (case (manualAttrOrderMap_) of - { !_nontsOmanualAttrOrderMap -> - (case (typeSyns_) of - { !_nontsOtypeSyns -> - (case (useMap_) of - { !_nontsOuseMap -> - (case (modcopy _lhsIoptions) of - { !_nontsOcr -> - (case (rename _lhsIoptions) of - { !_nontsOo_rename -> - (case ((nonts_ )) of - { ( !_nontsIcollect_nts,!T_Nonterminals_1 nonts_1) -> - (case (1) of - { !_nontsOuniq -> - (case (_nontsIcollect_nts) of - { !_nontsOnonterminals -> - (case ((nonts_1 _nontsOcr _nontsOmanualAttrOrderMap _nontsOnonterminals _nontsOo_rename _nontsOtypeSyns _nontsOuniq _nontsOuseMap )) of - { ( !_nontsIerrors,!_nontsIoutput,!_nontsIuniq) -> - (case (_nontsIerrors) of - { !_lhsOerrors -> - (case (Grammar typeSyns_ useMap_ derivings_ wrappers_ _nontsIoutput pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ uniqueMap_) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) })) ) --- Nonterminal ------------------------------------------------- -{- - visit 0: - synthesized attribute: - collect_nts : Set NontermIdent - visit 1: - inherited attributes: - cr : Bool - manualAttrOrderMap : AttrOrderMap - nonterminals : Set NontermIdent - o_rename : Bool - typeSyns : TypeSyns - useMap : UseMap - chained attribute: - uniq : Int - synthesized attributes: - errors : Seq Error - output : SELF - alternatives: - alternative Nonterminal: - child nt : {NontermIdent} - child params : {[Identifier]} - child inh : {Attributes} - child syn : {Attributes} - child prods : Productions - visit 1: - 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 (( (Set NontermIdent),T_Nonterminal_1 )) -newtype T_Nonterminal_1 = T_Nonterminal_1 (Bool -> - AttrOrderMap -> - (Set NontermIdent) -> - Bool -> - TypeSyns -> - Int -> - UseMap -> - ( (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 -> - Inh_Nonterminal -> - Syn_Nonterminal -wrap_Nonterminal !(T_Nonterminal sem ) !(Inh_Nonterminal _lhsIcr _lhsImanualAttrOrderMap _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap ) = - (let ( !_lhsOcollect_nts,!T_Nonterminal_1 sem_1) = - (sem ) - ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = - (sem_1 _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 (case (Set.singleton nt_) of - { !_lhsOcollect_nts -> - (case ((sem_Nonterminal_Nonterminal_1 nt_ syn_ inh_ (T_Productions prods_ ) params_ )) of - { ( !sem_Nonterminal_1) -> - ( _lhsOcollect_nts,sem_Nonterminal_1) }) }) ) -sem_Nonterminal_Nonterminal_1 :: NontermIdent -> - Attributes -> - Attributes -> - T_Productions -> - ([Identifier]) -> - T_Nonterminal_1 -sem_Nonterminal_Nonterminal_1 !nt_ !syn_ !inh_ !(T_Productions prods_ ) !params_ = - (T_Nonterminal_1 (\ (!_lhsIcr) - (!_lhsImanualAttrOrderMap) - (!_lhsInonterminals) - (!_lhsIo_rename) - (!_lhsItypeSyns) - (!_lhsIuniq) - (!_lhsIuseMap) -> - (case (_lhsItypeSyns) of - { !_prodsOtypeSyns -> - (case (_lhsIo_rename) of - { !_prodsOo_rename -> - (case (_lhsImanualAttrOrderMap) of - { !_prodsOmanualAttrOrderMap -> - (case (_lhsIcr) of - { !_prodsOcr -> - (case (nt_) of - { !_prodsOnt -> - (case (Map.findWithDefault Map.empty nt_ _lhsIuseMap) of - { !_prodsOuseMap -> - (case (syn_) of - { !_prodsOsyn -> - (case (inh_) of - { !_prodsOinh -> - (case (_lhsIuniq) of - { !_prodsOuniq -> - (case (_lhsInonterminals) of - { !_prodsOnonterminals -> - (case ((prods_ _prodsOcr _prodsOinh _prodsOmanualAttrOrderMap _prodsOnonterminals _prodsOnt _prodsOo_rename _prodsOsyn _prodsOtypeSyns _prodsOuniq _prodsOuseMap )) of - { ( !_prodsIerrors,!_prodsIoutput,!_prodsIuniq) -> - (case (_prodsIerrors) of - { !_lhsOerrors -> - (case (Nonterminal nt_ params_ inh_ syn_ _prodsIoutput) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - (case (_prodsIuniq) of - { !_lhsOuniq -> - ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) --- Nonterminals ------------------------------------------------ -{- - visit 0: - synthesized attribute: - collect_nts : Set NontermIdent - visit 1: - inherited attributes: - cr : Bool - manualAttrOrderMap : AttrOrderMap - nonterminals : Set NontermIdent - o_rename : Bool - typeSyns : TypeSyns - useMap : UseMap - chained attribute: - uniq : Int - synthesized attributes: - errors : Seq Error - output : SELF - alternatives: - alternative Cons: - child hd : Nonterminal - child tl : Nonterminals - visit 1: - local output : _ - alternative Nil: - visit 1: - 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 (( (Set NontermIdent),T_Nonterminals_1 )) -newtype T_Nonterminals_1 = T_Nonterminals_1 (Bool -> - AttrOrderMap -> - (Set NontermIdent) -> - Bool -> - TypeSyns -> - Int -> - UseMap -> - ( (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 -> - Inh_Nonterminals -> - Syn_Nonterminals -wrap_Nonterminals !(T_Nonterminals sem ) !(Inh_Nonterminals _lhsIcr _lhsImanualAttrOrderMap _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap ) = - (let ( !_lhsOcollect_nts,!T_Nonterminals_1 sem_1) = - (sem ) - ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = - (sem_1 _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 (case ((tl_ )) of - { ( !_tlIcollect_nts,!T_Nonterminals_1 tl_1) -> - (case ((hd_ )) of - { ( !_hdIcollect_nts,!T_Nonterminal_1 hd_1) -> - (case (_hdIcollect_nts `Set.union` _tlIcollect_nts) of - { !_lhsOcollect_nts -> - (case ((sem_Nonterminals_Cons_1 (T_Nonterminal_1 hd_1 ) (T_Nonterminals_1 tl_1 ) )) of - { ( !sem_Nonterminals_1) -> - ( _lhsOcollect_nts,sem_Nonterminals_1) }) }) }) }) ) -sem_Nonterminals_Cons_1 :: T_Nonterminal_1 -> - T_Nonterminals_1 -> - T_Nonterminals_1 -sem_Nonterminals_Cons_1 !(T_Nonterminal_1 hd_1 ) !(T_Nonterminals_1 tl_1 ) = - (T_Nonterminals_1 (\ (!_lhsIcr) - (!_lhsImanualAttrOrderMap) - (!_lhsInonterminals) - (!_lhsIo_rename) - (!_lhsItypeSyns) - (!_lhsIuniq) - (!_lhsIuseMap) -> - (case (_lhsIuseMap) of - { !_tlOuseMap -> - (case (_lhsItypeSyns) of - { !_tlOtypeSyns -> - (case (_lhsIo_rename) of - { !_tlOo_rename -> - (case (_lhsImanualAttrOrderMap) of - { !_tlOmanualAttrOrderMap -> - (case (_lhsIcr) of - { !_tlOcr -> - (case (_lhsIuseMap) of - { !_hdOuseMap -> - (case (_lhsItypeSyns) of - { !_hdOtypeSyns -> - (case (_lhsIo_rename) of - { !_hdOo_rename -> - (case (_lhsImanualAttrOrderMap) of - { !_hdOmanualAttrOrderMap -> - (case (_lhsIcr) of - { !_hdOcr -> - (case (_lhsIuniq) of - { !_hdOuniq -> - (case (_lhsInonterminals) of - { !_hdOnonterminals -> - (case ((hd_1 _hdOcr _hdOmanualAttrOrderMap _hdOnonterminals _hdOo_rename _hdOtypeSyns _hdOuniq _hdOuseMap )) of - { ( !_hdIerrors,!_hdIoutput,!_hdIuniq) -> - (case (_hdIuniq) of - { !_tlOuniq -> - (case (_lhsInonterminals) of - { !_tlOnonterminals -> - (case ((tl_1 _tlOcr _tlOmanualAttrOrderMap _tlOnonterminals _tlOo_rename _tlOtypeSyns _tlOuniq _tlOuseMap )) of - { ( !_tlIerrors,!_tlIoutput,!_tlIuniq) -> - (case (_hdIerrors Seq.>< _tlIerrors) of - { !_lhsOerrors -> - (case ((:) _hdIoutput _tlIoutput) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - (case (_tlIuniq) of - { !_lhsOuniq -> - ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Nonterminals_Nil :: T_Nonterminals -sem_Nonterminals_Nil = - (T_Nonterminals (case (Set.empty) of - { !_lhsOcollect_nts -> - (case ((sem_Nonterminals_Nil_1 )) of - { ( !sem_Nonterminals_1) -> - ( _lhsOcollect_nts,sem_Nonterminals_1) }) }) ) -sem_Nonterminals_Nil_1 :: T_Nonterminals_1 -sem_Nonterminals_Nil_1 = - (T_Nonterminals_1 (\ (!_lhsIcr) - (!_lhsImanualAttrOrderMap) - (!_lhsInonterminals) - (!_lhsIo_rename) - (!_lhsItypeSyns) - (!_lhsIuniq) - (!_lhsIuseMap) -> - (case (Seq.empty) of - { !_lhsOerrors -> - (case ([]) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - (case (_lhsIuniq) of - { !_lhsOuniq -> - ( _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 -> - Inh_Pattern -> - Syn_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) -> - (case (True) of - { !_lhsOcontainsVars -> - (case (_lhsInt) of - { !_partsOnt -> - (case (_lhsIcon) of - { !_partsOcon -> - (case ((parts_ _partsOcon _partsOnt )) of - { ( !_partsIcontainsVars,!_partsIcopy,!_partsIdefinedAttrs,!_partsIerrors,!_partsIlocals,!_partsIoutput) -> - (case (_lhsInt) of - { !_patOnt -> - (case (_lhsIcon) of - { !_patOcon -> - (case ((pat_ _patOcon _patOnt )) of - { ( !_patIcontainsVars,!_patIcopy,!_patIdefinedAttrs,!_patIerrors,!_patIlocals,!_patIoutput) -> - (case (Alias field_ attr_ _patIcopy _partsIcopy) of - { !_copy -> - (case (_copy) of - { !_lhsOcopy -> - (case (Set.insert (field_,attr_) _patIdefinedAttrs) of - { !_lhsOdefinedAttrs -> - (case (_patIerrors Seq.>< _partsIerrors) of - { !_lhsOerrors -> - (case (if field_ == _LOC - then Set.insert attr_ _patIlocals - else _patIlocals) of - { !_lhsOlocals -> - (case (Alias field_ attr_ _patIoutput _partsIoutput) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _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) -> - (case (_lhsInt) of - { !_patsOnt -> - (case (_lhsIcon) of - { !_patsOcon -> - (case ((pats_ _patsOcon _patsOnt )) of - { ( !_patsIcontainsVars,!_patsIcopy,!_patsIdefinedAttrs,!_patsIerrors,!_patsIlocals,!_patsIoutput) -> - (case (_patsIcontainsVars) of - { !_lhsOcontainsVars -> - (case (Constr name_ _patsIcopy) of - { !_copy -> - (case (_copy) of - { !_lhsOcopy -> - (case (_patsIdefinedAttrs) of - { !_lhsOdefinedAttrs -> - (case (_patsIerrors) of - { !_lhsOerrors -> - (case (_patsIlocals) of - { !_lhsOlocals -> - (case (Constr name_ _patsIoutput) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Pattern_Irrefutable :: T_Pattern -> - T_Pattern -sem_Pattern_Irrefutable !(T_Pattern pat_ ) = - (T_Pattern (\ (!_lhsIcon) - (!_lhsInt) -> - (case (_lhsInt) of - { !_patOnt -> - (case (_lhsIcon) of - { !_patOcon -> - (case ((pat_ _patOcon _patOnt )) of - { ( !_patIcontainsVars,!_patIcopy,!_patIdefinedAttrs,!_patIerrors,!_patIlocals,!_patIoutput) -> - (case (_patIcontainsVars) of - { !_lhsOcontainsVars -> - (case (Irrefutable _patIcopy) of - { !_copy -> - (case (_copy) of - { !_lhsOcopy -> - (case (_patIdefinedAttrs) of - { !_lhsOdefinedAttrs -> - (case (_patIerrors) of - { !_lhsOerrors -> - (case (_patIlocals) of - { !_lhsOlocals -> - (case (Irrefutable _patIoutput) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _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) -> - (case (_lhsInt) of - { !_patsOnt -> - (case (_lhsIcon) of - { !_patsOcon -> - (case ((pats_ _patsOcon _patsOnt )) of - { ( !_patsIcontainsVars,!_patsIcopy,!_patsIdefinedAttrs,!_patsIerrors,!_patsIlocals,!_patsIoutput) -> - (case (_patsIcontainsVars) of - { !_lhsOcontainsVars -> - (case (Product pos_ _patsIcopy) of - { !_copy -> - (case (_copy) of - { !_lhsOcopy -> - (case (_patsIdefinedAttrs) of - { !_lhsOdefinedAttrs -> - (case (_patsIerrors) of - { !_lhsOerrors -> - (case (_patsIlocals) of - { !_lhsOlocals -> - (case (Product pos_ _patsIoutput) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Pattern_Underscore :: Pos -> - T_Pattern -sem_Pattern_Underscore !pos_ = - (T_Pattern (\ (!_lhsIcon) - (!_lhsInt) -> - (case (False) of - { !_lhsOcontainsVars -> - (case (Underscore pos_) of - { !_copy -> - (case (_copy) of - { !_lhsOcopy -> - (case (Set.empty) of - { !_lhsOdefinedAttrs -> - (case (Seq.empty) of - { !_lhsOerrors -> - (case (Set.empty) of - { !_lhsOlocals -> - (case (Underscore pos_) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _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 -> - Inh_Patterns -> - Syn_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) -> - (case (_lhsInt) of - { !_tlOnt -> - (case (_lhsIcon) of - { !_tlOcon -> - (case ((tl_ _tlOcon _tlOnt )) of - { ( !_tlIcontainsVars,!_tlIcopy,!_tlIdefinedAttrs,!_tlIerrors,!_tlIlocals,!_tlIoutput) -> - (case (_lhsInt) of - { !_hdOnt -> - (case (_lhsIcon) of - { !_hdOcon -> - (case ((hd_ _hdOcon _hdOnt )) of - { ( !_hdIcontainsVars,!_hdIcopy,!_hdIdefinedAttrs,!_hdIerrors,!_hdIlocals,!_hdIoutput) -> - (case (_hdIcontainsVars || _tlIcontainsVars) of - { !_lhsOcontainsVars -> - (case ((:) _hdIcopy _tlIcopy) of - { !_copy -> - (case (_copy) of - { !_lhsOcopy -> - (case (_hdIdefinedAttrs `Set.union` _tlIdefinedAttrs) of - { !_lhsOdefinedAttrs -> - (case (_hdIerrors Seq.>< _tlIerrors) of - { !_lhsOerrors -> - (case (_hdIlocals `Set.union` _tlIlocals) of - { !_lhsOlocals -> - (case ((:) _hdIoutput _tlIoutput) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Patterns_Nil :: T_Patterns -sem_Patterns_Nil = - (T_Patterns (\ (!_lhsIcon) - (!_lhsInt) -> - (case (False) of - { !_lhsOcontainsVars -> - (case ([]) of - { !_copy -> - (case (_copy) of - { !_lhsOcopy -> - (case (Set.empty) of - { !_lhsOdefinedAttrs -> - (case (Seq.empty) of - { !_lhsOerrors -> - (case (Set.empty) of - { !_lhsOlocals -> - (case ([]) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _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 orderDeps : _ - local orderErrs : _ - local _tup1 : _ - local errs : _ - local newRls : _ --} --- 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 -> - Inh_Production -> - Syn_Production -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) -> - (case (Set.toList $ Map.findWithDefault Set.empty con_ $ Map.findWithDefault Map.empty _lhsInt _lhsImanualAttrOrderMap) of - { !_orderDeps -> - (case (_lhsIuniq) of - { !_rulesOuniq -> - (case (_lhsInt) of - { !_rulesOnt -> - (case (con_) of - { !_rulesOcon -> - (case ((rules_ _rulesOcon _rulesOnt _rulesOuniq )) of - { ( !_rulesIdefinedAttrs,!_rulesIerrors,!_rulesIlocals,!_rulesIoutput,!_rulesIuniq) -> - (case (_lhsInt) of - { !_childrenOnt -> - (case (_lhsIcr) of - { !_childrenOcr -> - (case (con_) of - { !_childrenOcon -> - (case ((children_ _childrenOcon _childrenOcr _childrenOnt )) of - { ( !_childrenIerrors,!_childrenIfields,!_childrenIinputs,!_childrenIoutput,!_childrenIoutputs) -> - (case (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 - ]) of - { !_orderErrs -> - (case (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)) of - { !__tup1 -> - (case (__tup1) of - { !(_,!_errs) -> - (case (_childrenIerrors >< _errs >< _rulesIerrors >< _orderErrs) of - { !_lhsOerrors -> - (case (__tup1) of - { !(!_newRls,_) -> - (case ((typeSigs_ )) of - { ( !_typeSigsIoutput) -> - (case (Production con_ _childrenIoutput (_rulesIoutput ++ _newRls) _typeSigsIoutput) of - { !_lhsOoutput -> - (case (_rulesIuniq) of - { !_lhsOuniq -> - ( _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 -> - Inh_Productions -> - Syn_Productions -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) -> - (case (_lhsIuseMap) of - { !_tlOuseMap -> - (case (_lhsItypeSyns) of - { !_tlOtypeSyns -> - (case (_lhsIsyn) of - { !_tlOsyn -> - (case (_lhsIo_rename) of - { !_tlOo_rename -> - (case (_lhsInt) of - { !_tlOnt -> - (case (_lhsImanualAttrOrderMap) of - { !_tlOmanualAttrOrderMap -> - (case (_lhsIinh) of - { !_tlOinh -> - (case (_lhsIcr) of - { !_tlOcr -> - (case (_lhsIuseMap) of - { !_hdOuseMap -> - (case (_lhsItypeSyns) of - { !_hdOtypeSyns -> - (case (_lhsIsyn) of - { !_hdOsyn -> - (case (_lhsIo_rename) of - { !_hdOo_rename -> - (case (_lhsInt) of - { !_hdOnt -> - (case (_lhsImanualAttrOrderMap) of - { !_hdOmanualAttrOrderMap -> - (case (_lhsIinh) of - { !_hdOinh -> - (case (_lhsIcr) of - { !_hdOcr -> - (case (_lhsIuniq) of - { !_hdOuniq -> - (case (_lhsInonterminals) of - { !_hdOnonterminals -> - (case ((hd_ _hdOcr _hdOinh _hdOmanualAttrOrderMap _hdOnonterminals _hdOnt _hdOo_rename _hdOsyn _hdOtypeSyns _hdOuniq _hdOuseMap )) of - { ( !_hdIerrors,!_hdIoutput,!_hdIuniq) -> - (case (_hdIuniq) of - { !_tlOuniq -> - (case (_lhsInonterminals) of - { !_tlOnonterminals -> - (case ((tl_ _tlOcr _tlOinh _tlOmanualAttrOrderMap _tlOnonterminals _tlOnt _tlOo_rename _tlOsyn _tlOtypeSyns _tlOuniq _tlOuseMap )) of - { ( !_tlIerrors,!_tlIoutput,!_tlIuniq) -> - (case (_hdIerrors Seq.>< _tlIerrors) of - { !_lhsOerrors -> - (case ((:) _hdIoutput _tlIoutput) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - (case (_tlIuniq) of - { !_lhsOuniq -> - ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Productions_Nil :: T_Productions -sem_Productions_Nil = - (T_Productions (\ (!_lhsIcr) - (!_lhsIinh) - (!_lhsImanualAttrOrderMap) - (!_lhsInonterminals) - (!_lhsInt) - (!_lhsIo_rename) - (!_lhsIsyn) - (!_lhsItypeSyns) - (!_lhsIuniq) - (!_lhsIuseMap) -> - (case (Seq.empty) of - { !_lhsOerrors -> - (case ([]) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - (case (_lhsIuniq) of - { !_lhsOuniq -> - ( _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 output : _ - local _tup2 : {(Rules,Int)} --} --- 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 -> - Inh_Rule -> - Syn_Rule -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) -> - (case (_lhsInt) of - { !_patternOnt -> - (case (_lhsIcon) of - { !_patternOcon -> - (case ((pattern_ _patternOcon _patternOnt )) of - { ( !_patternIcontainsVars,!_patternIcopy,!_patternIdefinedAttrs,!_patternIerrors,!_patternIlocals,!_patternIoutput) -> - (case (_patternIcontainsVars) of - { !_lhsOcontainsVars -> - (case (_patternIdefinedAttrs) of - { !_lhsOdefinedAttrs -> - (case (_patternIerrors) of - { !_lhsOerrors -> - (case (_patternIlocals) of - { !_lhsOlocals -> - (case (Rule _patternIoutput rhs_ owrt_ origin_) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - (case (multiRule _output _lhsIuniq) of - { !__tup2 -> - (case (__tup2) of - { !(!_lhsOoutputs,_) -> - (case (__tup2) of - { !(_,!_lhsOuniq) -> - ( _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 - 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 -> - Inh_Rules -> - Syn_Rules -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) -> - (case (_lhsIuniq) of - { !_hdOuniq -> - (case (_lhsInt) of - { !_hdOnt -> - (case (_lhsIcon) of - { !_hdOcon -> - (case ((hd_ _hdOcon _hdOnt _hdOuniq )) of - { ( !_hdIcontainsVars,!_hdIdefinedAttrs,!_hdIerrors,!_hdIlocals,!_hdIoutput,!_hdIoutputs,!_hdIuniq) -> - (case (_hdIuniq) of - { !_tlOuniq -> - (case (_lhsInt) of - { !_tlOnt -> - (case (_lhsIcon) of - { !_tlOcon -> - (case ((tl_ _tlOcon _tlOnt _tlOuniq )) of - { ( !_tlIdefinedAttrs,!_tlIerrors,!_tlIlocals,!_tlIoutput,!_tlIuniq) -> - (case (_hdIdefinedAttrs `Set.union` _tlIdefinedAttrs) of - { !_lhsOdefinedAttrs -> - (case (_hdIerrors Seq.>< _tlIerrors) of - { !_lhsOerrors -> - (case (_hdIlocals `Set.union` _tlIlocals) of - { !_lhsOlocals -> - (case (if _hdIcontainsVars then _hdIoutputs ++ _tlIoutput else _tlIoutput) of - { !_lhsOoutput -> - (case (_tlIuniq) of - { !_lhsOuniq -> - ( _lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Rules_Nil :: T_Rules -sem_Rules_Nil = - (T_Rules (\ (!_lhsIcon) - (!_lhsInt) - (!_lhsIuniq) -> - (case (Set.empty) of - { !_lhsOdefinedAttrs -> - (case (Seq.empty) of - { !_lhsOerrors -> - (case (Set.empty) of - { !_lhsOlocals -> - (case ([]) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - (case (_lhsIuniq) of - { !_lhsOuniq -> - ( _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 -> - Inh_TypeSig -> - Syn_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 (case (TypeSig name_ tp_) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _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 -> - Inh_TypeSigs -> - Syn_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 (case ((tl_ )) of - { ( !_tlIoutput) -> - (case ((hd_ )) of - { ( !_hdIoutput) -> - (case ((:) _hdIoutput _tlIoutput) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _lhsOoutput) }) }) }) }) ) -sem_TypeSigs_Nil :: T_TypeSigs -sem_TypeSigs_Nil = - (T_TypeSigs (case ([]) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> +{-# OPTIONS_GHC -fbang-patterns #-}++-- UUAGC 0.9.12 (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 Data.Sequence as Seq+import Data.Sequence(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.><) 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.singleton (MissingRule nt con fld a)+ )+ Just f + | f == _ACHILD -> ( fieldName a+ , Seq.singleton (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.singleton (MissingRule nt con fld a)+ )+ Just f + | f == _ACHILD -> ( [AGLocal a noPos Nothing]+ , Seq.singleton (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 ->+ Inh_Child ->+ Syn_Child +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) ->+ (case (Seq.empty) of+ { !_lhsOerrors ->+ (case ((name_,tp_,higherOrder_)) of+ { !_lhsOfield ->+ (case (inh_) of+ { !_lhsOinherited ->+ (case (name_) of+ { !_lhsOname ->+ (case (Child name_ tp_ inh_ syn_ higherOrder_) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ (case (syn_) of+ { !_lhsOsynthesized ->+ ( _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 ->+ Inh_Children ->+ Syn_Children +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) ->+ (case (_lhsInt) of+ { !_tlOnt ->+ (case (_lhsIcr) of+ { !_tlOcr ->+ (case (_lhsIcon) of+ { !_tlOcon ->+ (case ((tl_ _tlOcon _tlOcr _tlOnt )) of+ { ( !_tlIerrors,!_tlIfields,!_tlIinputs,!_tlIoutput,!_tlIoutputs) ->+ (case (_lhsInt) of+ { !_hdOnt ->+ (case (_lhsIcr) of+ { !_hdOcr ->+ (case (_lhsIcon) of+ { !_hdOcon ->+ (case ((hd_ _hdOcon _hdOcr _hdOnt )) of+ { ( !_hdIerrors,!_hdIfield,!_hdIinherited,!_hdIname,!_hdIoutput,!_hdIsynthesized) ->+ (case (_hdIerrors Seq.>< _tlIerrors) of+ { !_lhsOerrors ->+ (case (_hdIfield : _tlIfields) of+ { !_lhsOfields ->+ (case ((_hdIname, _hdIinherited) : _tlIinputs) of+ { !_lhsOinputs ->+ (case ((:) _hdIoutput _tlIoutput) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ (case ((_hdIname, _hdIsynthesized) : _tlIoutputs) of+ { !_lhsOoutputs ->+ ( _lhsOerrors,_lhsOfields,_lhsOinputs,_lhsOoutput,_lhsOoutputs) }) }) }) }) }) }) }) }) }) }) }) }) }) })) )+sem_Children_Nil :: T_Children +sem_Children_Nil =+ (T_Children (\ (!_lhsIcon)+ (!_lhsIcr)+ (!_lhsInt) ->+ (case (Seq.empty) of+ { !_lhsOerrors ->+ (case ([]) of+ { !_lhsOfields ->+ (case ([]) of+ { !_lhsOinputs ->+ (case ([]) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ (case ([]) of+ { !_lhsOoutputs ->+ ( _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}+ child uniqueMap : {UniqueMap}+ visit 0:+ local output : _+-}+-- cata+sem_Grammar :: Grammar ->+ T_Grammar +sem_Grammar !(Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap ) =+ (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts ) _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap )+-- 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 ->+ Inh_Grammar ->+ Syn_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 ->+ UniqueMap ->+ T_Grammar +sem_Grammar_Grammar !typeSyns_ !useMap_ !derivings_ !wrappers_ !(T_Nonterminals nonts_ ) !pragmas_ !manualAttrOrderMap_ !paramMap_ !contextMap_ !uniqueMap_ =+ (T_Grammar (\ (!_lhsIoptions) ->+ (case (manualAttrOrderMap_) of+ { !_nontsOmanualAttrOrderMap ->+ (case (typeSyns_) of+ { !_nontsOtypeSyns ->+ (case (useMap_) of+ { !_nontsOuseMap ->+ (case (modcopy _lhsIoptions) of+ { !_nontsOcr ->+ (case (rename _lhsIoptions) of+ { !_nontsOo_rename ->+ (case ((nonts_ )) of+ { ( !_nontsIcollect_nts,!T_Nonterminals_1 nonts_1) ->+ (case (1) of+ { !_nontsOuniq ->+ (case (_nontsIcollect_nts) of+ { !_nontsOnonterminals ->+ (case ((nonts_1 _nontsOcr _nontsOmanualAttrOrderMap _nontsOnonterminals _nontsOo_rename _nontsOtypeSyns _nontsOuniq _nontsOuseMap )) of+ { ( !_nontsIerrors,!_nontsIoutput,!_nontsIuniq) ->+ (case (_nontsIerrors) of+ { !_lhsOerrors ->+ (case (Grammar typeSyns_ useMap_ derivings_ wrappers_ _nontsIoutput pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ uniqueMap_) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) })) )+-- Nonterminal -------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ collect_nts : Set NontermIdent+ visit 1:+ inherited attributes:+ cr : Bool+ manualAttrOrderMap : AttrOrderMap+ nonterminals : Set NontermIdent+ o_rename : Bool+ typeSyns : TypeSyns+ useMap : UseMap+ chained attribute:+ uniq : Int+ synthesized attributes:+ errors : Seq Error+ output : SELF + alternatives:+ alternative Nonterminal:+ child nt : {NontermIdent}+ child params : {[Identifier]}+ child inh : {Attributes}+ child syn : {Attributes}+ child prods : Productions + visit 1:+ 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 (( (Set NontermIdent),T_Nonterminal_1 ))+newtype T_Nonterminal_1 = T_Nonterminal_1 (Bool ->+ AttrOrderMap ->+ (Set NontermIdent) ->+ Bool ->+ TypeSyns ->+ Int ->+ UseMap ->+ ( (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 ->+ Inh_Nonterminal ->+ Syn_Nonterminal +wrap_Nonterminal !(T_Nonterminal sem ) !(Inh_Nonterminal _lhsIcr _lhsImanualAttrOrderMap _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap ) =+ (let ( !_lhsOcollect_nts,!T_Nonterminal_1 sem_1) =+ (sem )+ ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) =+ (sem_1 _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 (case (Set.singleton nt_) of+ { !_lhsOcollect_nts ->+ (case ((sem_Nonterminal_Nonterminal_1 nt_ syn_ inh_ (T_Productions prods_ ) params_ )) of+ { ( !sem_Nonterminal_1) ->+ ( _lhsOcollect_nts,sem_Nonterminal_1) }) }) )+sem_Nonterminal_Nonterminal_1 :: NontermIdent ->+ Attributes ->+ Attributes ->+ T_Productions ->+ ([Identifier]) ->+ T_Nonterminal_1 +sem_Nonterminal_Nonterminal_1 !nt_ !syn_ !inh_ !(T_Productions prods_ ) !params_ =+ (T_Nonterminal_1 (\ (!_lhsIcr)+ (!_lhsImanualAttrOrderMap)+ (!_lhsInonterminals)+ (!_lhsIo_rename)+ (!_lhsItypeSyns)+ (!_lhsIuniq)+ (!_lhsIuseMap) ->+ (case (_lhsItypeSyns) of+ { !_prodsOtypeSyns ->+ (case (_lhsIo_rename) of+ { !_prodsOo_rename ->+ (case (_lhsImanualAttrOrderMap) of+ { !_prodsOmanualAttrOrderMap ->+ (case (_lhsIcr) of+ { !_prodsOcr ->+ (case (nt_) of+ { !_prodsOnt ->+ (case (Map.findWithDefault Map.empty nt_ _lhsIuseMap) of+ { !_prodsOuseMap ->+ (case (syn_) of+ { !_prodsOsyn ->+ (case (inh_) of+ { !_prodsOinh ->+ (case (_lhsIuniq) of+ { !_prodsOuniq ->+ (case (_lhsInonterminals) of+ { !_prodsOnonterminals ->+ (case ((prods_ _prodsOcr _prodsOinh _prodsOmanualAttrOrderMap _prodsOnonterminals _prodsOnt _prodsOo_rename _prodsOsyn _prodsOtypeSyns _prodsOuniq _prodsOuseMap )) of+ { ( !_prodsIerrors,!_prodsIoutput,!_prodsIuniq) ->+ (case (_prodsIerrors) of+ { !_lhsOerrors ->+ (case (Nonterminal nt_ params_ inh_ syn_ _prodsIoutput) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ (case (_prodsIuniq) of+ { !_lhsOuniq ->+ ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) )+-- Nonterminals ------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ collect_nts : Set NontermIdent+ visit 1:+ inherited attributes:+ cr : Bool+ manualAttrOrderMap : AttrOrderMap+ nonterminals : Set NontermIdent+ o_rename : Bool+ typeSyns : TypeSyns+ useMap : UseMap+ chained attribute:+ uniq : Int+ synthesized attributes:+ errors : Seq Error+ output : SELF + alternatives:+ alternative Cons:+ child hd : Nonterminal + child tl : Nonterminals + visit 1:+ local output : _+ alternative Nil:+ visit 1:+ 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 (( (Set NontermIdent),T_Nonterminals_1 ))+newtype T_Nonterminals_1 = T_Nonterminals_1 (Bool ->+ AttrOrderMap ->+ (Set NontermIdent) ->+ Bool ->+ TypeSyns ->+ Int ->+ UseMap ->+ ( (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 ->+ Inh_Nonterminals ->+ Syn_Nonterminals +wrap_Nonterminals !(T_Nonterminals sem ) !(Inh_Nonterminals _lhsIcr _lhsImanualAttrOrderMap _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap ) =+ (let ( !_lhsOcollect_nts,!T_Nonterminals_1 sem_1) =+ (sem )+ ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) =+ (sem_1 _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 (case ((tl_ )) of+ { ( !_tlIcollect_nts,!T_Nonterminals_1 tl_1) ->+ (case ((hd_ )) of+ { ( !_hdIcollect_nts,!T_Nonterminal_1 hd_1) ->+ (case (_hdIcollect_nts `Set.union` _tlIcollect_nts) of+ { !_lhsOcollect_nts ->+ (case ((sem_Nonterminals_Cons_1 (T_Nonterminal_1 hd_1 ) (T_Nonterminals_1 tl_1 ) )) of+ { ( !sem_Nonterminals_1) ->+ ( _lhsOcollect_nts,sem_Nonterminals_1) }) }) }) }) )+sem_Nonterminals_Cons_1 :: T_Nonterminal_1 ->+ T_Nonterminals_1 ->+ T_Nonterminals_1 +sem_Nonterminals_Cons_1 !(T_Nonterminal_1 hd_1 ) !(T_Nonterminals_1 tl_1 ) =+ (T_Nonterminals_1 (\ (!_lhsIcr)+ (!_lhsImanualAttrOrderMap)+ (!_lhsInonterminals)+ (!_lhsIo_rename)+ (!_lhsItypeSyns)+ (!_lhsIuniq)+ (!_lhsIuseMap) ->+ (case (_lhsIuseMap) of+ { !_tlOuseMap ->+ (case (_lhsItypeSyns) of+ { !_tlOtypeSyns ->+ (case (_lhsIo_rename) of+ { !_tlOo_rename ->+ (case (_lhsImanualAttrOrderMap) of+ { !_tlOmanualAttrOrderMap ->+ (case (_lhsIcr) of+ { !_tlOcr ->+ (case (_lhsIuseMap) of+ { !_hdOuseMap ->+ (case (_lhsItypeSyns) of+ { !_hdOtypeSyns ->+ (case (_lhsIo_rename) of+ { !_hdOo_rename ->+ (case (_lhsImanualAttrOrderMap) of+ { !_hdOmanualAttrOrderMap ->+ (case (_lhsIcr) of+ { !_hdOcr ->+ (case (_lhsIuniq) of+ { !_hdOuniq ->+ (case (_lhsInonterminals) of+ { !_hdOnonterminals ->+ (case ((hd_1 _hdOcr _hdOmanualAttrOrderMap _hdOnonterminals _hdOo_rename _hdOtypeSyns _hdOuniq _hdOuseMap )) of+ { ( !_hdIerrors,!_hdIoutput,!_hdIuniq) ->+ (case (_hdIuniq) of+ { !_tlOuniq ->+ (case (_lhsInonterminals) of+ { !_tlOnonterminals ->+ (case ((tl_1 _tlOcr _tlOmanualAttrOrderMap _tlOnonterminals _tlOo_rename _tlOtypeSyns _tlOuniq _tlOuseMap )) of+ { ( !_tlIerrors,!_tlIoutput,!_tlIuniq) ->+ (case (_hdIerrors Seq.>< _tlIerrors) of+ { !_lhsOerrors ->+ (case ((:) _hdIoutput _tlIoutput) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ (case (_tlIuniq) of+ { !_lhsOuniq ->+ ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) )+sem_Nonterminals_Nil :: T_Nonterminals +sem_Nonterminals_Nil =+ (T_Nonterminals (case (Set.empty) of+ { !_lhsOcollect_nts ->+ (case ((sem_Nonterminals_Nil_1 )) of+ { ( !sem_Nonterminals_1) ->+ ( _lhsOcollect_nts,sem_Nonterminals_1) }) }) )+sem_Nonterminals_Nil_1 :: T_Nonterminals_1 +sem_Nonterminals_Nil_1 =+ (T_Nonterminals_1 (\ (!_lhsIcr)+ (!_lhsImanualAttrOrderMap)+ (!_lhsInonterminals)+ (!_lhsIo_rename)+ (!_lhsItypeSyns)+ (!_lhsIuniq)+ (!_lhsIuseMap) ->+ (case (Seq.empty) of+ { !_lhsOerrors ->+ (case ([]) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ (case (_lhsIuniq) of+ { !_lhsOuniq ->+ ( _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 ->+ Inh_Pattern ->+ Syn_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) ->+ (case (True) of+ { !_lhsOcontainsVars ->+ (case (_lhsInt) of+ { !_partsOnt ->+ (case (_lhsIcon) of+ { !_partsOcon ->+ (case ((parts_ _partsOcon _partsOnt )) of+ { ( !_partsIcontainsVars,!_partsIcopy,!_partsIdefinedAttrs,!_partsIerrors,!_partsIlocals,!_partsIoutput) ->+ (case (_lhsInt) of+ { !_patOnt ->+ (case (_lhsIcon) of+ { !_patOcon ->+ (case ((pat_ _patOcon _patOnt )) of+ { ( !_patIcontainsVars,!_patIcopy,!_patIdefinedAttrs,!_patIerrors,!_patIlocals,!_patIoutput) ->+ (case (Alias field_ attr_ _patIcopy _partsIcopy) of+ { !_copy ->+ (case (_copy) of+ { !_lhsOcopy ->+ (case (Set.insert (field_,attr_) _patIdefinedAttrs) of+ { !_lhsOdefinedAttrs ->+ (case (_patIerrors Seq.>< _partsIerrors) of+ { !_lhsOerrors ->+ (case (if field_ == _LOC+ then Set.insert attr_ _patIlocals+ else _patIlocals) of+ { !_lhsOlocals ->+ (case (Alias field_ attr_ _patIoutput _partsIoutput) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _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) ->+ (case (_lhsInt) of+ { !_patsOnt ->+ (case (_lhsIcon) of+ { !_patsOcon ->+ (case ((pats_ _patsOcon _patsOnt )) of+ { ( !_patsIcontainsVars,!_patsIcopy,!_patsIdefinedAttrs,!_patsIerrors,!_patsIlocals,!_patsIoutput) ->+ (case (_patsIcontainsVars) of+ { !_lhsOcontainsVars ->+ (case (Constr name_ _patsIcopy) of+ { !_copy ->+ (case (_copy) of+ { !_lhsOcopy ->+ (case (_patsIdefinedAttrs) of+ { !_lhsOdefinedAttrs ->+ (case (_patsIerrors) of+ { !_lhsOerrors ->+ (case (_patsIlocals) of+ { !_lhsOlocals ->+ (case (Constr name_ _patsIoutput) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) })) )+sem_Pattern_Irrefutable :: T_Pattern ->+ T_Pattern +sem_Pattern_Irrefutable !(T_Pattern pat_ ) =+ (T_Pattern (\ (!_lhsIcon)+ (!_lhsInt) ->+ (case (_lhsInt) of+ { !_patOnt ->+ (case (_lhsIcon) of+ { !_patOcon ->+ (case ((pat_ _patOcon _patOnt )) of+ { ( !_patIcontainsVars,!_patIcopy,!_patIdefinedAttrs,!_patIerrors,!_patIlocals,!_patIoutput) ->+ (case (_patIcontainsVars) of+ { !_lhsOcontainsVars ->+ (case (Irrefutable _patIcopy) of+ { !_copy ->+ (case (_copy) of+ { !_lhsOcopy ->+ (case (_patIdefinedAttrs) of+ { !_lhsOdefinedAttrs ->+ (case (_patIerrors) of+ { !_lhsOerrors ->+ (case (_patIlocals) of+ { !_lhsOlocals ->+ (case (Irrefutable _patIoutput) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _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) ->+ (case (_lhsInt) of+ { !_patsOnt ->+ (case (_lhsIcon) of+ { !_patsOcon ->+ (case ((pats_ _patsOcon _patsOnt )) of+ { ( !_patsIcontainsVars,!_patsIcopy,!_patsIdefinedAttrs,!_patsIerrors,!_patsIlocals,!_patsIoutput) ->+ (case (_patsIcontainsVars) of+ { !_lhsOcontainsVars ->+ (case (Product pos_ _patsIcopy) of+ { !_copy ->+ (case (_copy) of+ { !_lhsOcopy ->+ (case (_patsIdefinedAttrs) of+ { !_lhsOdefinedAttrs ->+ (case (_patsIerrors) of+ { !_lhsOerrors ->+ (case (_patsIlocals) of+ { !_lhsOlocals ->+ (case (Product pos_ _patsIoutput) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) })) )+sem_Pattern_Underscore :: Pos ->+ T_Pattern +sem_Pattern_Underscore !pos_ =+ (T_Pattern (\ (!_lhsIcon)+ (!_lhsInt) ->+ (case (False) of+ { !_lhsOcontainsVars ->+ (case (Underscore pos_) of+ { !_copy ->+ (case (_copy) of+ { !_lhsOcopy ->+ (case (Set.empty) of+ { !_lhsOdefinedAttrs ->+ (case (Seq.empty) of+ { !_lhsOerrors ->+ (case (Set.empty) of+ { !_lhsOlocals ->+ (case (Underscore pos_) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _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 ->+ Inh_Patterns ->+ Syn_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) ->+ (case (_lhsInt) of+ { !_tlOnt ->+ (case (_lhsIcon) of+ { !_tlOcon ->+ (case ((tl_ _tlOcon _tlOnt )) of+ { ( !_tlIcontainsVars,!_tlIcopy,!_tlIdefinedAttrs,!_tlIerrors,!_tlIlocals,!_tlIoutput) ->+ (case (_lhsInt) of+ { !_hdOnt ->+ (case (_lhsIcon) of+ { !_hdOcon ->+ (case ((hd_ _hdOcon _hdOnt )) of+ { ( !_hdIcontainsVars,!_hdIcopy,!_hdIdefinedAttrs,!_hdIerrors,!_hdIlocals,!_hdIoutput) ->+ (case (_hdIcontainsVars || _tlIcontainsVars) of+ { !_lhsOcontainsVars ->+ (case ((:) _hdIcopy _tlIcopy) of+ { !_copy ->+ (case (_copy) of+ { !_lhsOcopy ->+ (case (_hdIdefinedAttrs `Set.union` _tlIdefinedAttrs) of+ { !_lhsOdefinedAttrs ->+ (case (_hdIerrors Seq.>< _tlIerrors) of+ { !_lhsOerrors ->+ (case (_hdIlocals `Set.union` _tlIlocals) of+ { !_lhsOlocals ->+ (case ((:) _hdIoutput _tlIoutput) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) })) )+sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil =+ (T_Patterns (\ (!_lhsIcon)+ (!_lhsInt) ->+ (case (False) of+ { !_lhsOcontainsVars ->+ (case ([]) of+ { !_copy ->+ (case (_copy) of+ { !_lhsOcopy ->+ (case (Set.empty) of+ { !_lhsOdefinedAttrs ->+ (case (Seq.empty) of+ { !_lhsOerrors ->+ (case (Set.empty) of+ { !_lhsOlocals ->+ (case ([]) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _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 orderDeps : _+ local orderErrs : _+ local _tup1 : _+ local errs : _+ local newRls : _+-}+-- 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 ->+ Inh_Production ->+ Syn_Production +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) ->+ (case (Set.toList $ Map.findWithDefault Set.empty con_ $ Map.findWithDefault Map.empty _lhsInt _lhsImanualAttrOrderMap) of+ { !_orderDeps ->+ (case (_lhsIuniq) of+ { !_rulesOuniq ->+ (case (_lhsInt) of+ { !_rulesOnt ->+ (case (con_) of+ { !_rulesOcon ->+ (case ((rules_ _rulesOcon _rulesOnt _rulesOuniq )) of+ { ( !_rulesIdefinedAttrs,!_rulesIerrors,!_rulesIlocals,!_rulesIoutput,!_rulesIuniq) ->+ (case (_lhsInt) of+ { !_childrenOnt ->+ (case (_lhsIcr) of+ { !_childrenOcr ->+ (case (con_) of+ { !_childrenOcon ->+ (case ((children_ _childrenOcon _childrenOcr _childrenOnt )) of+ { ( !_childrenIerrors,!_childrenIfields,!_childrenIinputs,!_childrenIoutput,!_childrenIoutputs) ->+ (case (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+ ]) of+ { !_orderErrs ->+ (case (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)) of+ { !__tup1 ->+ (case (__tup1) of+ { !(_,!_errs) ->+ (case (_childrenIerrors >< _errs >< _rulesIerrors >< _orderErrs) of+ { !_lhsOerrors ->+ (case (__tup1) of+ { !(!_newRls,_) ->+ (case ((typeSigs_ )) of+ { ( !_typeSigsIoutput) ->+ (case (Production con_ _childrenIoutput (_rulesIoutput ++ _newRls) _typeSigsIoutput) of+ { !_lhsOoutput ->+ (case (_rulesIuniq) of+ { !_lhsOuniq ->+ ( _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 ->+ Inh_Productions ->+ Syn_Productions +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) ->+ (case (_lhsIuseMap) of+ { !_tlOuseMap ->+ (case (_lhsItypeSyns) of+ { !_tlOtypeSyns ->+ (case (_lhsIsyn) of+ { !_tlOsyn ->+ (case (_lhsIo_rename) of+ { !_tlOo_rename ->+ (case (_lhsInt) of+ { !_tlOnt ->+ (case (_lhsImanualAttrOrderMap) of+ { !_tlOmanualAttrOrderMap ->+ (case (_lhsIinh) of+ { !_tlOinh ->+ (case (_lhsIcr) of+ { !_tlOcr ->+ (case (_lhsIuseMap) of+ { !_hdOuseMap ->+ (case (_lhsItypeSyns) of+ { !_hdOtypeSyns ->+ (case (_lhsIsyn) of+ { !_hdOsyn ->+ (case (_lhsIo_rename) of+ { !_hdOo_rename ->+ (case (_lhsInt) of+ { !_hdOnt ->+ (case (_lhsImanualAttrOrderMap) of+ { !_hdOmanualAttrOrderMap ->+ (case (_lhsIinh) of+ { !_hdOinh ->+ (case (_lhsIcr) of+ { !_hdOcr ->+ (case (_lhsIuniq) of+ { !_hdOuniq ->+ (case (_lhsInonterminals) of+ { !_hdOnonterminals ->+ (case ((hd_ _hdOcr _hdOinh _hdOmanualAttrOrderMap _hdOnonterminals _hdOnt _hdOo_rename _hdOsyn _hdOtypeSyns _hdOuniq _hdOuseMap )) of+ { ( !_hdIerrors,!_hdIoutput,!_hdIuniq) ->+ (case (_hdIuniq) of+ { !_tlOuniq ->+ (case (_lhsInonterminals) of+ { !_tlOnonterminals ->+ (case ((tl_ _tlOcr _tlOinh _tlOmanualAttrOrderMap _tlOnonterminals _tlOnt _tlOo_rename _tlOsyn _tlOtypeSyns _tlOuniq _tlOuseMap )) of+ { ( !_tlIerrors,!_tlIoutput,!_tlIuniq) ->+ (case (_hdIerrors Seq.>< _tlIerrors) of+ { !_lhsOerrors ->+ (case ((:) _hdIoutput _tlIoutput) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ (case (_tlIuniq) of+ { !_lhsOuniq ->+ ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) )+sem_Productions_Nil :: T_Productions +sem_Productions_Nil =+ (T_Productions (\ (!_lhsIcr)+ (!_lhsIinh)+ (!_lhsImanualAttrOrderMap)+ (!_lhsInonterminals)+ (!_lhsInt)+ (!_lhsIo_rename)+ (!_lhsIsyn)+ (!_lhsItypeSyns)+ (!_lhsIuniq)+ (!_lhsIuseMap) ->+ (case (Seq.empty) of+ { !_lhsOerrors ->+ (case ([]) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ (case (_lhsIuniq) of+ { !_lhsOuniq ->+ ( _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 output : _+ local _tup2 : {(Rules,Int)}+-}+-- 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 ->+ Inh_Rule ->+ Syn_Rule +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) ->+ (case (_lhsInt) of+ { !_patternOnt ->+ (case (_lhsIcon) of+ { !_patternOcon ->+ (case ((pattern_ _patternOcon _patternOnt )) of+ { ( !_patternIcontainsVars,!_patternIcopy,!_patternIdefinedAttrs,!_patternIerrors,!_patternIlocals,!_patternIoutput) ->+ (case (_patternIcontainsVars) of+ { !_lhsOcontainsVars ->+ (case (_patternIdefinedAttrs) of+ { !_lhsOdefinedAttrs ->+ (case (_patternIerrors) of+ { !_lhsOerrors ->+ (case (_patternIlocals) of+ { !_lhsOlocals ->+ (case (Rule _patternIoutput rhs_ owrt_ origin_) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ (case (multiRule _output _lhsIuniq) of+ { !__tup2 ->+ (case (__tup2) of+ { !(!_lhsOoutputs,_) ->+ (case (__tup2) of+ { !(_,!_lhsOuniq) ->+ ( _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 + 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 ->+ Inh_Rules ->+ Syn_Rules +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) ->+ (case (_lhsIuniq) of+ { !_hdOuniq ->+ (case (_lhsInt) of+ { !_hdOnt ->+ (case (_lhsIcon) of+ { !_hdOcon ->+ (case ((hd_ _hdOcon _hdOnt _hdOuniq )) of+ { ( !_hdIcontainsVars,!_hdIdefinedAttrs,!_hdIerrors,!_hdIlocals,!_hdIoutput,!_hdIoutputs,!_hdIuniq) ->+ (case (_hdIuniq) of+ { !_tlOuniq ->+ (case (_lhsInt) of+ { !_tlOnt ->+ (case (_lhsIcon) of+ { !_tlOcon ->+ (case ((tl_ _tlOcon _tlOnt _tlOuniq )) of+ { ( !_tlIdefinedAttrs,!_tlIerrors,!_tlIlocals,!_tlIoutput,!_tlIuniq) ->+ (case (_hdIdefinedAttrs `Set.union` _tlIdefinedAttrs) of+ { !_lhsOdefinedAttrs ->+ (case (_hdIerrors Seq.>< _tlIerrors) of+ { !_lhsOerrors ->+ (case (_hdIlocals `Set.union` _tlIlocals) of+ { !_lhsOlocals ->+ (case (if _hdIcontainsVars then _hdIoutputs ++ _tlIoutput else _tlIoutput) of+ { !_lhsOoutput ->+ (case (_tlIuniq) of+ { !_lhsOuniq ->+ ( _lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) })) )+sem_Rules_Nil :: T_Rules +sem_Rules_Nil =+ (T_Rules (\ (!_lhsIcon)+ (!_lhsInt)+ (!_lhsIuniq) ->+ (case (Set.empty) of+ { !_lhsOdefinedAttrs ->+ (case (Seq.empty) of+ { !_lhsOerrors ->+ (case (Set.empty) of+ { !_lhsOlocals ->+ (case ([]) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ (case (_lhsIuniq) of+ { !_lhsOuniq ->+ ( _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 ->+ Inh_TypeSig ->+ Syn_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 (case (TypeSig name_ tp_) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _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 ->+ Inh_TypeSigs ->+ Syn_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 (case ((tl_ )) of+ { ( !_tlIoutput) ->+ (case ((hd_ )) of+ { ( !_hdIoutput) ->+ (case ((:) _hdIoutput _tlIoutput) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _lhsOoutput) }) }) }) }) )+sem_TypeSigs_Nil :: T_TypeSigs +sem_TypeSigs_Nil =+ (T_TypeSigs (case ([]) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput -> ( _lhsOoutput) }) }) )
src-derived/Desugar.hs view
@@ -1,1869 +1,1869 @@-{-# OPTIONS_GHC -fbang-patterns #-} - --- UUAGC 0.9.11 (Desugar.ag) -module Desugar where - -import qualified Data.Set as Set -import qualified Data.Map as Map -import Data.Map(Map) -import qualified Data.Sequence as Seq -import Data.Sequence(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.singleton 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 -> - Inh_Child -> - Syn_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 (case ([(i, name_) | i <- Map.keys inh_ ]) of - { !_lhsOchildInhs -> - (case ([(s, name_) | s <- Map.keys syn_ ]) of - { !_lhsOchildSyns -> - (case (Child name_ tp_ inh_ syn_ higherOrder_) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _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 -> - Inh_Children -> - Syn_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 (case ((tl_ )) of - { ( !_tlIchildInhs,!_tlIchildSyns,!_tlIoutput) -> - (case ((hd_ )) of - { ( !_hdIchildInhs,!_hdIchildSyns,!_hdIoutput) -> - (case (_hdIchildInhs ++ _tlIchildInhs) of - { !_lhsOchildInhs -> - (case (_hdIchildSyns ++ _tlIchildSyns) of - { !_lhsOchildSyns -> - (case ((:) _hdIoutput _tlIoutput) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput) }) }) }) }) }) }) ) -sem_Children_Nil :: T_Children -sem_Children_Nil = - (T_Children (case ([]) of - { !_lhsOchildInhs -> - (case ([]) of - { !_lhsOchildSyns -> - (case ([]) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _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' : _ --} --- 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 -> - Inh_Expression -> - Syn_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) -> - (case (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)) of - { !__tup1 -> - (case (__tup1) of - { !(_,!_lhsOerrors) -> - (case (__tup1) of - { !(!_tks',_) -> - (case (Expression pos_ _tks') of - { !_lhsOoutput -> - ( _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} - child uniqueMap : {UniqueMap} - visit 0: - local output : _ --} --- cata -sem_Grammar :: Grammar -> - T_Grammar -sem_Grammar !(Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap ) = - (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts ) _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap ) --- 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 -> - Inh_Grammar -> - Syn_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 -> - UniqueMap -> - T_Grammar -sem_Grammar_Grammar !typeSyns_ !useMap_ !derivings_ !wrappers_ !(T_Nonterminals nonts_ ) !pragmas_ !manualAttrOrderMap_ !paramMap_ !contextMap_ !uniqueMap_ = - (T_Grammar (\ (!_lhsIforcedIrrefutables) - (!_lhsIoptions) -> - (case (_lhsIoptions) of - { !_nontsOoptions -> - (case (_lhsIforcedIrrefutables) of - { !_nontsOforcedIrrefutables -> - (case ((nonts_ _nontsOforcedIrrefutables _nontsOoptions )) of - { ( !_nontsIallAttributes,!_nontsIerrors,!_nontsIoutput) -> - (case (_nontsIallAttributes) of - { !_lhsOallAttributes -> - (case (_nontsIerrors) of - { !_lhsOerrors -> - (case (Grammar typeSyns_ useMap_ derivings_ wrappers_ _nontsIoutput pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ uniqueMap_) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _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 -> - Inh_HsToken -> - Syn_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) -> - (case (findField field_ attr_ _lhsIchildSyns) of - { !_mField -> - (case (maybe field_ id _mField) of - { !_field' -> - (case (if _lhsIuseFieldIdent || length (getName field_) < length (getName _field' ) - then _lhsIaddLines + 1 - else _lhsIaddLines) of - { !_lhsOaddLines -> - (case (maybe (Seq.singleton (UndefAttr _lhsInt _lhsIcon field_ (Ident "<ANY>" (getPos field_)) False)) (const Seq.empty) _mField) of - { !_lhsOerrors -> - (case (AGField _field' attr_ (addl _lhsIaddLines pos_) (if _lhsIuseFieldIdent then Just _lhsIruleDescr else Nothing)) of - { !_tks -> - (case (_tks) of - { !_lhsOtks -> - ( _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) -> - (case (if _lhsIuseFieldIdent - then _lhsIaddLines + 1 - else _lhsIaddLines) of - { !_lhsOaddLines -> - (case (Seq.empty) of - { !_lhsOerrors -> - (case (AGLocal var_ (addl _lhsIaddLines pos_) (if _lhsIuseFieldIdent then Just _lhsIruleDescr else Nothing)) of - { !_tks -> - (case (_tks) of - { !_lhsOtks -> - ( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) })) ) -sem_HsToken_CharToken :: String -> - Pos -> - T_HsToken -sem_HsToken_CharToken !value_ !pos_ = - (T_HsToken (\ (!_lhsIaddLines) - (!_lhsIchildInhs) - (!_lhsIchildSyns) - (!_lhsIcon) - (!_lhsInt) - (!_lhsIruleDescr) - (!_lhsIuseFieldIdent) -> - (case (_lhsIaddLines) of - { !_lhsOaddLines -> - (case (Seq.empty) of - { !_lhsOerrors -> - (case (CharToken value_ (addl _lhsIaddLines pos_)) of - { !_tks -> - (case (_tks) of - { !_lhsOtks -> - ( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) })) ) -sem_HsToken_Err :: String -> - Pos -> - T_HsToken -sem_HsToken_Err !mesg_ !pos_ = - (T_HsToken (\ (!_lhsIaddLines) - (!_lhsIchildInhs) - (!_lhsIchildSyns) - (!_lhsIcon) - (!_lhsInt) - (!_lhsIruleDescr) - (!_lhsIuseFieldIdent) -> - (case (_lhsIaddLines) of - { !_lhsOaddLines -> - (case (Seq.empty) of - { !_lhsOerrors -> - (case (Err mesg_ (addl _lhsIaddLines pos_)) of - { !_tks -> - (case (_tks) of - { !_lhsOtks -> - ( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) })) ) -sem_HsToken_HsToken :: String -> - Pos -> - T_HsToken -sem_HsToken_HsToken !value_ !pos_ = - (T_HsToken (\ (!_lhsIaddLines) - (!_lhsIchildInhs) - (!_lhsIchildSyns) - (!_lhsIcon) - (!_lhsInt) - (!_lhsIruleDescr) - (!_lhsIuseFieldIdent) -> - (case (_lhsIaddLines) of - { !_lhsOaddLines -> - (case (Seq.empty) of - { !_lhsOerrors -> - (case (HsToken value_ (addl _lhsIaddLines pos_)) of - { !_tks -> - (case (_tks) of - { !_lhsOtks -> - ( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) })) ) -sem_HsToken_StrToken :: String -> - Pos -> - T_HsToken -sem_HsToken_StrToken !value_ !pos_ = - (T_HsToken (\ (!_lhsIaddLines) - (!_lhsIchildInhs) - (!_lhsIchildSyns) - (!_lhsIcon) - (!_lhsInt) - (!_lhsIruleDescr) - (!_lhsIuseFieldIdent) -> - (case (_lhsIaddLines) of - { !_lhsOaddLines -> - (case (Seq.empty) of - { !_lhsOerrors -> - (case (StrToken value_ (addl _lhsIaddLines pos_)) of - { !_tks -> - (case (_tks) of - { !_lhsOtks -> - ( _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 -> - Inh_HsTokens -> - Syn_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) -> - (case (_lhsIuseFieldIdent) of - { !_tlOuseFieldIdent -> - (case (_lhsIchildSyns) of - { !_tlOchildSyns -> - (case (_lhsIuseFieldIdent) of - { !_hdOuseFieldIdent -> - (case (_lhsIchildSyns) of - { !_hdOchildSyns -> - (case (_lhsIaddLines) of - { !_hdOaddLines -> - (case (_lhsIruleDescr) of - { !_hdOruleDescr -> - (case (_lhsInt) of - { !_hdOnt -> - (case (_lhsIcon) of - { !_hdOcon -> - (case (_lhsIchildInhs) of - { !_hdOchildInhs -> - (case ((hd_ _hdOaddLines _hdOchildInhs _hdOchildSyns _hdOcon _hdOnt _hdOruleDescr _hdOuseFieldIdent )) of - { ( !_hdIaddLines,!_hdIerrors,!_hdItks) -> - (case (_hdIaddLines) of - { !_tlOaddLines -> - (case (_lhsIruleDescr) of - { !_tlOruleDescr -> - (case (_lhsInt) of - { !_tlOnt -> - (case (_lhsIcon) of - { !_tlOcon -> - (case (_lhsIchildInhs) of - { !_tlOchildInhs -> - (case ((tl_ _tlOaddLines _tlOchildInhs _tlOchildSyns _tlOcon _tlOnt _tlOruleDescr _tlOuseFieldIdent )) of - { ( !_tlIaddLines,!_tlIerrors,!_tlItks) -> - (case (_tlIaddLines) of - { !_lhsOaddLines -> - (case (_hdIerrors Seq.>< _tlIerrors) of - { !_lhsOerrors -> - (case ((:) _hdItks _tlItks) of - { !_tks -> - (case (_tks) of - { !_lhsOtks -> - ( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_HsTokens_Nil :: T_HsTokens -sem_HsTokens_Nil = - (T_HsTokens (\ (!_lhsIaddLines) - (!_lhsIchildInhs) - (!_lhsIchildSyns) - (!_lhsIcon) - (!_lhsInt) - (!_lhsIruleDescr) - (!_lhsIuseFieldIdent) -> - (case (_lhsIaddLines) of - { !_lhsOaddLines -> - (case (Seq.empty) of - { !_lhsOerrors -> - (case ([]) of - { !_tks -> - (case (_tks) of - { !_lhsOtks -> - ( _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 -> - Inh_HsTokensRoot -> - Syn_HsTokensRoot -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) -> - (case (_lhsInt) of - { !_tokensOnt -> - (case (_lhsIcon) of - { !_tokensOcon -> - (case (_lhsIchildSyns) of - { !_tokensOchildSyns -> - (case (_lhsIuseFieldIdent) of - { !_tokensOuseFieldIdent -> - (case (_lhsIruleDescr) of - { !_tokensOruleDescr -> - (case (_lhsIchildInhs) of - { !_tokensOchildInhs -> - (case (0) of - { !_tokensOaddLines -> - (case ((tokens_ _tokensOaddLines _tokensOchildInhs _tokensOchildSyns _tokensOcon _tokensOnt _tokensOruleDescr _tokensOuseFieldIdent )) of - { ( !_tokensIaddLines,!_tokensIerrors,!_tokensItks) -> - (case (_tokensIerrors) of - { !_lhsOerrors -> - (case (_tokensItks) of - { !_lhsOtks -> - ( _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 -> - Inh_Nonterminal -> - Syn_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) -> - (case (nt_) of - { !_prodsOnt -> - (case (_lhsIoptions) of - { !_prodsOoptions -> - (case (_lhsIforcedIrrefutables) of - { !_prodsOforcedIrrefutables -> - (case ((prods_ _prodsOforcedIrrefutables _prodsOnt _prodsOoptions )) of - { ( !_prodsIallAttributes,!_prodsIerrors,!_prodsIoutput) -> - (case (_prodsIallAttributes) of - { !_lhsOallAttributes -> - (case (_prodsIerrors) of - { !_lhsOerrors -> - (case (Nonterminal nt_ params_ inh_ syn_ _prodsIoutput) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _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 -> - Inh_Nonterminals -> - Syn_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) -> - (case (_lhsIoptions) of - { !_tlOoptions -> - (case (_lhsIforcedIrrefutables) of - { !_tlOforcedIrrefutables -> - (case ((tl_ _tlOforcedIrrefutables _tlOoptions )) of - { ( !_tlIallAttributes,!_tlIerrors,!_tlIoutput) -> - (case (_lhsIoptions) of - { !_hdOoptions -> - (case (_lhsIforcedIrrefutables) of - { !_hdOforcedIrrefutables -> - (case ((hd_ _hdOforcedIrrefutables _hdOoptions )) of - { ( !_hdIallAttributes,!_hdIerrors,!_hdIoutput) -> - (case (_hdIallAttributes `mergeAttributes` _tlIallAttributes) of - { !_lhsOallAttributes -> - (case (_hdIerrors Seq.>< _tlIerrors) of - { !_lhsOerrors -> - (case ((:) _hdIoutput _tlIoutput) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) })) ) -sem_Nonterminals_Nil :: T_Nonterminals -sem_Nonterminals_Nil = - (T_Nonterminals (\ (!_lhsIforcedIrrefutables) - (!_lhsIoptions) -> - (case (Map.empty) of - { !_lhsOallAttributes -> - (case (Seq.empty) of - { !_lhsOerrors -> - (case ([]) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) })) ) --- Pattern ----------------------------------------------------- -{- - visit 0: - synthesized attribute: - defsCollect : Set (Identifier, Identifier) - visit 1: - inherited attributes: - childInhs : [(Identifier, Identifier)] - childSyns : [(Identifier, Identifier)] - con : ConstructorIdent - defs : Set (Identifier, Identifier) - forcedIrrefutables : AttrMap - nt : NontermIdent - synthesized attributes: - allAttributes : AttrMap - copy : SELF - errors : Seq Error - output : SELF - alternatives: - alternative Alias: - child field : {Identifier} - child attr : {Identifier} - child pat : Pattern - child parts : Patterns - visit 0: - local def : _ - visit 1: - local copy : _ - local _tup2 : _ - local field' : _ - local err2 : _ - local err1 : _ - local output : _ - alternative Constr: - child name : {ConstructorIdent} - child pats : Patterns - visit 1: - local copy : _ - local output : _ - alternative Irrefutable: - child pat : Pattern - visit 1: - local copy : _ - local output : _ - alternative Product: - child pos : {Pos} - child pats : Patterns - visit 1: - local copy : _ - local output : _ - alternative Underscore: - child pos : {Pos} - visit 1: - 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 (( (Set (Identifier, Identifier)),T_Pattern_1 )) -newtype T_Pattern_1 = T_Pattern_1 (([(Identifier, Identifier)]) -> - ([(Identifier, Identifier)]) -> - ConstructorIdent -> - (Set (Identifier, Identifier)) -> - AttrMap -> - NontermIdent -> - ( AttrMap,Pattern,(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 -> - Inh_Pattern -> - Syn_Pattern -wrap_Pattern !(T_Pattern sem ) !(Inh_Pattern _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt ) = - (let ( !_lhsOdefsCollect,!T_Pattern_1 sem_1) = - (sem ) - ( !_lhsOallAttributes,!_lhsOcopy,!_lhsOerrors,!_lhsOoutput) = - (sem_1 _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 (case (Set.singleton (field_, attr_)) of - { !_def -> - (case ((parts_ )) of - { ( !_partsIdefsCollect,!T_Patterns_1 parts_1) -> - (case ((pat_ )) of - { ( !_patIdefsCollect,!T_Pattern_1 pat_1) -> - (case (_def `Set.union` _patIdefsCollect `Set.union` _partsIdefsCollect) of - { !_lhsOdefsCollect -> - (case ((sem_Pattern_Alias_1 (T_Pattern_1 pat_1 ) attr_ field_ (T_Patterns_1 parts_1 ) )) of - { ( !sem_Pattern_1) -> - ( _lhsOdefsCollect,sem_Pattern_1) }) }) }) }) }) ) -sem_Pattern_Alias_1 :: T_Pattern_1 -> - Identifier -> - Identifier -> - T_Patterns_1 -> - T_Pattern_1 -sem_Pattern_Alias_1 !(T_Pattern_1 pat_1 ) !attr_ !field_ !(T_Patterns_1 parts_1 ) = - (T_Pattern_1 (\ (!_lhsIchildInhs) - (!_lhsIchildSyns) - (!_lhsIcon) - (!_lhsIdefs) - (!_lhsIforcedIrrefutables) - (!_lhsInt) -> - (case (_lhsInt) of - { !_patOnt -> - (case (_lhsIcon) of - { !_patOcon -> - (case (_lhsIforcedIrrefutables) of - { !_patOforcedIrrefutables -> - (case (_lhsIdefs) of - { !_patOdefs -> - (case (_lhsIchildSyns) of - { !_patOchildSyns -> - (case (_lhsIchildInhs) of - { !_patOchildInhs -> - (case ((pat_1 _patOchildInhs _patOchildSyns _patOcon _patOdefs _patOforcedIrrefutables _patOnt )) of - { ( !_patIallAttributes,!_patIcopy,!_patIerrors,!_patIoutput) -> - (case ((Map.singleton _lhsInt $ Map.singleton _lhsIcon $ Set.singleton (field_, attr_)) `mergeAttributes` _patIallAttributes) of - { !_lhsOallAttributes -> - (case (_lhsInt) of - { !_partsOnt -> - (case (_lhsIforcedIrrefutables) of - { !_partsOforcedIrrefutables -> - (case (_lhsIdefs) of - { !_partsOdefs -> - (case (_lhsIcon) of - { !_partsOcon -> - (case (_lhsIchildSyns) of - { !_partsOchildSyns -> - (case (_lhsIchildInhs) of - { !_partsOchildInhs -> - (case ((parts_1 _partsOchildInhs _partsOchildSyns _partsOcon _partsOdefs _partsOforcedIrrefutables _partsOnt )) of - { ( !_partsIallAttributes,!_partsIcopy,!_partsIerrors,!_partsIoutput) -> - (case (Alias field_ attr_ _patIcopy _partsIcopy) of - { !_copy -> - (case (_copy) of - { !_lhsOcopy -> - (case (maybeError field_ (UndefAttr _lhsInt _lhsIcon (Ident "<ANY>" (getPos field_)) attr_ True) $ - findField field_ attr_ _lhsIchildInhs) of - { !__tup2 -> - (case (__tup2) of - { !(!_field',_) -> - (case (if _field' == field_ - then Seq.empty - else if (_field' , attr_) `Set.member` _lhsIdefs - then Seq.singleton $ DupRule _lhsInt _lhsIcon field_ attr_ _field' - else Seq.empty) of - { !_err2 -> - (case (__tup2) of - { !(_,!_err1) -> - (case (_err1 Seq.>< _err2 Seq.>< _patIerrors Seq.>< _partsIerrors) of - { !_lhsOerrors -> - (case (Alias _field' attr_ _patIoutput _partsIoutput) of - { !_output -> - (case (if Set.member (field_, attr_) $ Map.findWithDefault Set.empty _lhsIcon $ Map.findWithDefault Map.empty _lhsInt $ _lhsIforcedIrrefutables - then Irrefutable _output - else _output) of - { !_lhsOoutput -> - ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Pattern_Constr :: ConstructorIdent -> - T_Patterns -> - T_Pattern -sem_Pattern_Constr !name_ !(T_Patterns pats_ ) = - (T_Pattern (case ((pats_ )) of - { ( !_patsIdefsCollect,!T_Patterns_1 pats_1) -> - (case (_patsIdefsCollect) of - { !_lhsOdefsCollect -> - (case ((sem_Pattern_Constr_1 (T_Patterns_1 pats_1 ) name_ )) of - { ( !sem_Pattern_1) -> - ( _lhsOdefsCollect,sem_Pattern_1) }) }) }) ) -sem_Pattern_Constr_1 :: T_Patterns_1 -> - ConstructorIdent -> - T_Pattern_1 -sem_Pattern_Constr_1 !(T_Patterns_1 pats_1 ) !name_ = - (T_Pattern_1 (\ (!_lhsIchildInhs) - (!_lhsIchildSyns) - (!_lhsIcon) - (!_lhsIdefs) - (!_lhsIforcedIrrefutables) - (!_lhsInt) -> - (case (_lhsInt) of - { !_patsOnt -> - (case (_lhsIcon) of - { !_patsOcon -> - (case (_lhsIforcedIrrefutables) of - { !_patsOforcedIrrefutables -> - (case (_lhsIdefs) of - { !_patsOdefs -> - (case (_lhsIchildSyns) of - { !_patsOchildSyns -> - (case (_lhsIchildInhs) of - { !_patsOchildInhs -> - (case ((pats_1 _patsOchildInhs _patsOchildSyns _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt )) of - { ( !_patsIallAttributes,!_patsIcopy,!_patsIerrors,!_patsIoutput) -> - (case (_patsIallAttributes) of - { !_lhsOallAttributes -> - (case (Constr name_ _patsIcopy) of - { !_copy -> - (case (_copy) of - { !_lhsOcopy -> - (case (_patsIerrors) of - { !_lhsOerrors -> - (case (Constr name_ _patsIoutput) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Pattern_Irrefutable :: T_Pattern -> - T_Pattern -sem_Pattern_Irrefutable !(T_Pattern pat_ ) = - (T_Pattern (case ((pat_ )) of - { ( !_patIdefsCollect,!T_Pattern_1 pat_1) -> - (case (_patIdefsCollect) of - { !_lhsOdefsCollect -> - (case ((sem_Pattern_Irrefutable_1 (T_Pattern_1 pat_1 ) )) of - { ( !sem_Pattern_1) -> - ( _lhsOdefsCollect,sem_Pattern_1) }) }) }) ) -sem_Pattern_Irrefutable_1 :: T_Pattern_1 -> - T_Pattern_1 -sem_Pattern_Irrefutable_1 !(T_Pattern_1 pat_1 ) = - (T_Pattern_1 (\ (!_lhsIchildInhs) - (!_lhsIchildSyns) - (!_lhsIcon) - (!_lhsIdefs) - (!_lhsIforcedIrrefutables) - (!_lhsInt) -> - (case (Map.empty) of - { !_lhsOallAttributes -> - (case (_lhsInt) of - { !_patOnt -> - (case (_lhsIforcedIrrefutables) of - { !_patOforcedIrrefutables -> - (case (_lhsIdefs) of - { !_patOdefs -> - (case (_lhsIcon) of - { !_patOcon -> - (case (_lhsIchildSyns) of - { !_patOchildSyns -> - (case (_lhsIchildInhs) of - { !_patOchildInhs -> - (case ((pat_1 _patOchildInhs _patOchildSyns _patOcon _patOdefs _patOforcedIrrefutables _patOnt )) of - { ( !_patIallAttributes,!_patIcopy,!_patIerrors,!_patIoutput) -> - (case (Irrefutable _patIcopy) of - { !_copy -> - (case (_copy) of - { !_lhsOcopy -> - (case (_patIerrors) of - { !_lhsOerrors -> - (case (Irrefutable _patIoutput) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Pattern_Product :: Pos -> - T_Patterns -> - T_Pattern -sem_Pattern_Product !pos_ !(T_Patterns pats_ ) = - (T_Pattern (case ((pats_ )) of - { ( !_patsIdefsCollect,!T_Patterns_1 pats_1) -> - (case (_patsIdefsCollect) of - { !_lhsOdefsCollect -> - (case ((sem_Pattern_Product_1 (T_Patterns_1 pats_1 ) pos_ )) of - { ( !sem_Pattern_1) -> - ( _lhsOdefsCollect,sem_Pattern_1) }) }) }) ) -sem_Pattern_Product_1 :: T_Patterns_1 -> - Pos -> - T_Pattern_1 -sem_Pattern_Product_1 !(T_Patterns_1 pats_1 ) !pos_ = - (T_Pattern_1 (\ (!_lhsIchildInhs) - (!_lhsIchildSyns) - (!_lhsIcon) - (!_lhsIdefs) - (!_lhsIforcedIrrefutables) - (!_lhsInt) -> - (case (_lhsInt) of - { !_patsOnt -> - (case (_lhsIcon) of - { !_patsOcon -> - (case (_lhsIforcedIrrefutables) of - { !_patsOforcedIrrefutables -> - (case (_lhsIdefs) of - { !_patsOdefs -> - (case (_lhsIchildSyns) of - { !_patsOchildSyns -> - (case (_lhsIchildInhs) of - { !_patsOchildInhs -> - (case ((pats_1 _patsOchildInhs _patsOchildSyns _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt )) of - { ( !_patsIallAttributes,!_patsIcopy,!_patsIerrors,!_patsIoutput) -> - (case (_patsIallAttributes) of - { !_lhsOallAttributes -> - (case (Product pos_ _patsIcopy) of - { !_copy -> - (case (_copy) of - { !_lhsOcopy -> - (case (_patsIerrors) of - { !_lhsOerrors -> - (case (Product pos_ _patsIoutput) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Pattern_Underscore :: Pos -> - T_Pattern -sem_Pattern_Underscore !pos_ = - (T_Pattern (case (Set.empty) of - { !_lhsOdefsCollect -> - (case ((sem_Pattern_Underscore_1 pos_ )) of - { ( !sem_Pattern_1) -> - ( _lhsOdefsCollect,sem_Pattern_1) }) }) ) -sem_Pattern_Underscore_1 :: Pos -> - T_Pattern_1 -sem_Pattern_Underscore_1 !pos_ = - (T_Pattern_1 (\ (!_lhsIchildInhs) - (!_lhsIchildSyns) - (!_lhsIcon) - (!_lhsIdefs) - (!_lhsIforcedIrrefutables) - (!_lhsInt) -> - (case (Map.empty) of - { !_lhsOallAttributes -> - (case (Underscore pos_) of - { !_copy -> - (case (_copy) of - { !_lhsOcopy -> - (case (Seq.empty) of - { !_lhsOerrors -> - (case (Underscore pos_) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) })) ) --- Patterns ---------------------------------------------------- -{- - visit 0: - synthesized attribute: - defsCollect : Set (Identifier, Identifier) - visit 1: - inherited attributes: - childInhs : [(Identifier, Identifier)] - childSyns : [(Identifier, Identifier)] - con : ConstructorIdent - defs : Set (Identifier, Identifier) - forcedIrrefutables : AttrMap - nt : NontermIdent - synthesized attributes: - allAttributes : AttrMap - copy : SELF - errors : Seq Error - output : SELF - alternatives: - alternative Cons: - child hd : Pattern - child tl : Patterns - visit 1: - local copy : _ - local output : _ - alternative Nil: - visit 1: - 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 (( (Set (Identifier, Identifier)),T_Patterns_1 )) -newtype T_Patterns_1 = T_Patterns_1 (([(Identifier, Identifier)]) -> - ([(Identifier, Identifier)]) -> - ConstructorIdent -> - (Set (Identifier, Identifier)) -> - AttrMap -> - NontermIdent -> - ( AttrMap,Patterns,(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 -> - Inh_Patterns -> - Syn_Patterns -wrap_Patterns !(T_Patterns sem ) !(Inh_Patterns _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt ) = - (let ( !_lhsOdefsCollect,!T_Patterns_1 sem_1) = - (sem ) - ( !_lhsOallAttributes,!_lhsOcopy,!_lhsOerrors,!_lhsOoutput) = - (sem_1 _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 (case ((tl_ )) of - { ( !_tlIdefsCollect,!T_Patterns_1 tl_1) -> - (case ((hd_ )) of - { ( !_hdIdefsCollect,!T_Pattern_1 hd_1) -> - (case (_hdIdefsCollect `Set.union` _tlIdefsCollect) of - { !_lhsOdefsCollect -> - (case ((sem_Patterns_Cons_1 (T_Patterns_1 tl_1 ) (T_Pattern_1 hd_1 ) )) of - { ( !sem_Patterns_1) -> - ( _lhsOdefsCollect,sem_Patterns_1) }) }) }) }) ) -sem_Patterns_Cons_1 :: T_Patterns_1 -> - T_Pattern_1 -> - T_Patterns_1 -sem_Patterns_Cons_1 !(T_Patterns_1 tl_1 ) !(T_Pattern_1 hd_1 ) = - (T_Patterns_1 (\ (!_lhsIchildInhs) - (!_lhsIchildSyns) - (!_lhsIcon) - (!_lhsIdefs) - (!_lhsIforcedIrrefutables) - (!_lhsInt) -> - (case (_lhsInt) of - { !_tlOnt -> - (case (_lhsIcon) of - { !_tlOcon -> - (case (_lhsInt) of - { !_hdOnt -> - (case (_lhsIcon) of - { !_hdOcon -> - (case (_lhsIforcedIrrefutables) of - { !_tlOforcedIrrefutables -> - (case (_lhsIdefs) of - { !_tlOdefs -> - (case (_lhsIchildSyns) of - { !_tlOchildSyns -> - (case (_lhsIchildInhs) of - { !_tlOchildInhs -> - (case ((tl_1 _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt )) of - { ( !_tlIallAttributes,!_tlIcopy,!_tlIerrors,!_tlIoutput) -> - (case (_lhsIforcedIrrefutables) of - { !_hdOforcedIrrefutables -> - (case (_lhsIdefs) of - { !_hdOdefs -> - (case (_lhsIchildSyns) of - { !_hdOchildSyns -> - (case (_lhsIchildInhs) of - { !_hdOchildInhs -> - (case ((hd_1 _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt )) of - { ( !_hdIallAttributes,!_hdIcopy,!_hdIerrors,!_hdIoutput) -> - (case (_hdIallAttributes `mergeAttributes` _tlIallAttributes) of - { !_lhsOallAttributes -> - (case ((:) _hdIcopy _tlIcopy) of - { !_copy -> - (case (_copy) of - { !_lhsOcopy -> - (case (_hdIerrors Seq.>< _tlIerrors) of - { !_lhsOerrors -> - (case ((:) _hdIoutput _tlIoutput) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Patterns_Nil :: T_Patterns -sem_Patterns_Nil = - (T_Patterns (case (Set.empty) of - { !_lhsOdefsCollect -> - (case ((sem_Patterns_Nil_1 )) of - { ( !sem_Patterns_1) -> - ( _lhsOdefsCollect,sem_Patterns_1) }) }) ) -sem_Patterns_Nil_1 :: T_Patterns_1 -sem_Patterns_Nil_1 = - (T_Patterns_1 (\ (!_lhsIchildInhs) - (!_lhsIchildSyns) - (!_lhsIcon) - (!_lhsIdefs) - (!_lhsIforcedIrrefutables) - (!_lhsInt) -> - (case (Map.empty) of - { !_lhsOallAttributes -> - (case ([]) of - { !_copy -> - (case (_copy) of - { !_lhsOcopy -> - (case (Seq.empty) of - { !_lhsOerrors -> - (case ([]) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _lhsOallAttributes,_lhsOcopy,_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 -> - Inh_Production -> - Syn_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) -> - (case (_lhsInt) of - { !_rulesOnt -> - (case (con_) of - { !_rulesOcon -> - (case ((rules_ )) of - { ( !_rulesIdefsCollect,!T_Rules_1 rules_1) -> - (case (_lhsIoptions) of - { !_rulesOoptions -> - (case (_lhsIforcedIrrefutables) of - { !_rulesOforcedIrrefutables -> - (case ((children_ )) of - { ( !_childrenIchildInhs,!_childrenIchildSyns,!_childrenIoutput) -> - (case (_childrenIchildSyns) of - { !_rulesOchildSyns -> - (case (_childrenIchildInhs) of - { !_rulesOchildInhs -> - (case (_rulesIdefsCollect) of - { !_rulesOdefs -> - (case ((rules_1 _rulesOchildInhs _rulesOchildSyns _rulesOcon _rulesOdefs _rulesOforcedIrrefutables _rulesOnt _rulesOoptions )) of - { ( !_rulesIallAttributes,!_rulesIerrors,!_rulesIoutput) -> - (case (_rulesIallAttributes) of - { !_lhsOallAttributes -> - (case (_rulesIerrors) of - { !_lhsOerrors -> - (case ((typeSigs_ )) of - { ( !_typeSigsIoutput) -> - (case (Production con_ _childrenIoutput _rulesIoutput _typeSigsIoutput) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _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 -> - Inh_Productions -> - Syn_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) -> - (case (_lhsInt) of - { !_tlOnt -> - (case (_lhsInt) of - { !_hdOnt -> - (case (_lhsIoptions) of - { !_tlOoptions -> - (case (_lhsIforcedIrrefutables) of - { !_tlOforcedIrrefutables -> - (case ((tl_ _tlOforcedIrrefutables _tlOnt _tlOoptions )) of - { ( !_tlIallAttributes,!_tlIerrors,!_tlIoutput) -> - (case (_lhsIoptions) of - { !_hdOoptions -> - (case (_lhsIforcedIrrefutables) of - { !_hdOforcedIrrefutables -> - (case ((hd_ _hdOforcedIrrefutables _hdOnt _hdOoptions )) of - { ( !_hdIallAttributes,!_hdIerrors,!_hdIoutput) -> - (case (_hdIallAttributes `mergeAttributes` _tlIallAttributes) of - { !_lhsOallAttributes -> - (case (_hdIerrors Seq.>< _tlIerrors) of - { !_lhsOerrors -> - (case ((:) _hdIoutput _tlIoutput) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Productions_Nil :: T_Productions -sem_Productions_Nil = - (T_Productions (\ (!_lhsIforcedIrrefutables) - (!_lhsInt) - (!_lhsIoptions) -> - (case (Map.empty) of - { !_lhsOallAttributes -> - (case (Seq.empty) of - { !_lhsOerrors -> - (case ([]) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) })) ) --- Rule -------------------------------------------------------- -{- - visit 0: - synthesized attribute: - defsCollect : Set (Identifier, Identifier) - visit 1: - inherited attributes: - childInhs : [(Identifier, Identifier)] - childSyns : [(Identifier, Identifier)] - con : ConstructorIdent - defs : Set (Identifier, Identifier) - forcedIrrefutables : AttrMap - nt : NontermIdent - options : Options - synthesized attributes: - allAttributes : AttrMap - errors : Seq Error - output : SELF - alternatives: - alternative Rule: - child pattern : Pattern - child rhs : Expression - child owrt : {Bool} - child origin : {String} - visit 1: - 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 (( (Set (Identifier, Identifier)),T_Rule_1 )) -newtype T_Rule_1 = T_Rule_1 (([(Identifier, Identifier)]) -> - ([(Identifier, Identifier)]) -> - ConstructorIdent -> - (Set (Identifier, Identifier)) -> - AttrMap -> - NontermIdent -> - Options -> - ( AttrMap,(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 -> - Inh_Rule -> - Syn_Rule -wrap_Rule !(T_Rule sem ) !(Inh_Rule _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions ) = - (let ( !_lhsOdefsCollect,!T_Rule_1 sem_1) = - (sem ) - ( !_lhsOallAttributes,!_lhsOerrors,!_lhsOoutput) = - (sem_1 _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 (case ((pattern_ )) of - { ( !_patternIdefsCollect,!T_Pattern_1 pattern_1) -> - (case (_patternIdefsCollect) of - { !_lhsOdefsCollect -> - (case ((sem_Rule_Rule_1 (T_Pattern_1 pattern_1 ) _patternIdefsCollect (T_Expression rhs_ ) origin_ owrt_ )) of - { ( !sem_Rule_1) -> - ( _lhsOdefsCollect,sem_Rule_1) }) }) }) ) -sem_Rule_Rule_1 :: T_Pattern_1 -> - (Set (Identifier, Identifier)) -> - T_Expression -> - String -> - Bool -> - T_Rule_1 -sem_Rule_Rule_1 !(T_Pattern_1 pattern_1 ) !_patternIdefsCollect !(T_Expression rhs_ ) !origin_ !owrt_ = - (T_Rule_1 (\ (!_lhsIchildInhs) - (!_lhsIchildSyns) - (!_lhsIcon) - (!_lhsIdefs) - (!_lhsIforcedIrrefutables) - (!_lhsInt) - (!_lhsIoptions) -> - (case (_lhsInt) of - { !_patternOnt -> - (case (_lhsIcon) of - { !_patternOcon -> - (case (_lhsIforcedIrrefutables) of - { !_patternOforcedIrrefutables -> - (case (_lhsIdefs) of - { !_patternOdefs -> - (case (_lhsIchildSyns) of - { !_patternOchildSyns -> - (case (_lhsIchildInhs) of - { !_patternOchildInhs -> - (case ((pattern_1 _patternOchildInhs _patternOchildSyns _patternOcon _patternOdefs _patternOforcedIrrefutables _patternOnt )) of - { ( !_patternIallAttributes,!_patternIcopy,!_patternIerrors,!_patternIoutput) -> - (case (_patternIallAttributes) of - { !_lhsOallAttributes -> - (case (show _lhsInt ++ " :: " ++ show _lhsIcon ++ " :: " ++ (concat $ intersperse "," $ map (\(f,a) -> show f ++ "." ++ show a) $ Set.toList _patternIdefsCollect)) of - { !_ruleDescr -> - (case (_ruleDescr) of - { !_rhsOruleDescr -> - (case (_lhsIoptions) of - { !_rhsOoptions -> - (case (_lhsInt) of - { !_rhsOnt -> - (case (_lhsIcon) of - { !_rhsOcon -> - (case (_lhsIchildSyns) of - { !_rhsOchildSyns -> - (case (_lhsIchildInhs) of - { !_rhsOchildInhs -> - (case ((rhs_ _rhsOchildInhs _rhsOchildSyns _rhsOcon _rhsOnt _rhsOoptions _rhsOruleDescr )) of - { ( !_rhsIerrors,!_rhsIoutput) -> - (case (_patternIerrors Seq.>< _rhsIerrors) of - { !_lhsOerrors -> - (case (Rule _patternIoutput _rhsIoutput owrt_ origin_) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) --- Rules ------------------------------------------------------- -{- - visit 0: - synthesized attribute: - defsCollect : Set (Identifier, Identifier) - visit 1: - inherited attributes: - childInhs : [(Identifier, Identifier)] - childSyns : [(Identifier, Identifier)] - con : ConstructorIdent - defs : Set (Identifier, Identifier) - forcedIrrefutables : AttrMap - nt : NontermIdent - options : Options - synthesized attributes: - allAttributes : AttrMap - errors : Seq Error - output : SELF - alternatives: - alternative Cons: - child hd : Rule - child tl : Rules - visit 1: - local output : _ - alternative Nil: - visit 1: - 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 (( (Set (Identifier, Identifier)),T_Rules_1 )) -newtype T_Rules_1 = T_Rules_1 (([(Identifier, Identifier)]) -> - ([(Identifier, Identifier)]) -> - ConstructorIdent -> - (Set (Identifier, Identifier)) -> - AttrMap -> - NontermIdent -> - Options -> - ( AttrMap,(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 -> - Inh_Rules -> - Syn_Rules -wrap_Rules !(T_Rules sem ) !(Inh_Rules _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions ) = - (let ( !_lhsOdefsCollect,!T_Rules_1 sem_1) = - (sem ) - ( !_lhsOallAttributes,!_lhsOerrors,!_lhsOoutput) = - (sem_1 _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 (case ((tl_ )) of - { ( !_tlIdefsCollect,!T_Rules_1 tl_1) -> - (case ((hd_ )) of - { ( !_hdIdefsCollect,!T_Rule_1 hd_1) -> - (case (_hdIdefsCollect `Set.union` _tlIdefsCollect) of - { !_lhsOdefsCollect -> - (case ((sem_Rules_Cons_1 (T_Rules_1 tl_1 ) (T_Rule_1 hd_1 ) )) of - { ( !sem_Rules_1) -> - ( _lhsOdefsCollect,sem_Rules_1) }) }) }) }) ) -sem_Rules_Cons_1 :: T_Rules_1 -> - T_Rule_1 -> - T_Rules_1 -sem_Rules_Cons_1 !(T_Rules_1 tl_1 ) !(T_Rule_1 hd_1 ) = - (T_Rules_1 (\ (!_lhsIchildInhs) - (!_lhsIchildSyns) - (!_lhsIcon) - (!_lhsIdefs) - (!_lhsIforcedIrrefutables) - (!_lhsInt) - (!_lhsIoptions) -> - (case (_lhsInt) of - { !_tlOnt -> - (case (_lhsIcon) of - { !_tlOcon -> - (case (_lhsInt) of - { !_hdOnt -> - (case (_lhsIcon) of - { !_hdOcon -> - (case (_lhsIoptions) of - { !_tlOoptions -> - (case (_lhsIforcedIrrefutables) of - { !_tlOforcedIrrefutables -> - (case (_lhsIdefs) of - { !_tlOdefs -> - (case (_lhsIchildSyns) of - { !_tlOchildSyns -> - (case (_lhsIchildInhs) of - { !_tlOchildInhs -> - (case ((tl_1 _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt _tlOoptions )) of - { ( !_tlIallAttributes,!_tlIerrors,!_tlIoutput) -> - (case (_lhsIoptions) of - { !_hdOoptions -> - (case (_lhsIforcedIrrefutables) of - { !_hdOforcedIrrefutables -> - (case (_lhsIdefs) of - { !_hdOdefs -> - (case (_lhsIchildSyns) of - { !_hdOchildSyns -> - (case (_lhsIchildInhs) of - { !_hdOchildInhs -> - (case ((hd_1 _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt _hdOoptions )) of - { ( !_hdIallAttributes,!_hdIerrors,!_hdIoutput) -> - (case (_hdIallAttributes `mergeAttributes` _tlIallAttributes) of - { !_lhsOallAttributes -> - (case (_hdIerrors Seq.>< _tlIerrors) of - { !_lhsOerrors -> - (case ((:) _hdIoutput _tlIoutput) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Rules_Nil :: T_Rules -sem_Rules_Nil = - (T_Rules (case (Set.empty) of - { !_lhsOdefsCollect -> - (case ((sem_Rules_Nil_1 )) of - { ( !sem_Rules_1) -> - ( _lhsOdefsCollect,sem_Rules_1) }) }) ) -sem_Rules_Nil_1 :: T_Rules_1 -sem_Rules_Nil_1 = - (T_Rules_1 (\ (!_lhsIchildInhs) - (!_lhsIchildSyns) - (!_lhsIcon) - (!_lhsIdefs) - (!_lhsIforcedIrrefutables) - (!_lhsInt) - (!_lhsIoptions) -> - (case (Map.empty) of - { !_lhsOallAttributes -> - (case (Seq.empty) of - { !_lhsOerrors -> - (case ([]) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _lhsOallAttributes,_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 -> - Inh_TypeSig -> - Syn_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 (case (TypeSig name_ tp_) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _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 -> - Inh_TypeSigs -> - Syn_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 (case ((tl_ )) of - { ( !_tlIoutput) -> - (case ((hd_ )) of - { ( !_hdIoutput) -> - (case ((:) _hdIoutput _tlIoutput) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> - ( _lhsOoutput) }) }) }) }) ) -sem_TypeSigs_Nil :: T_TypeSigs -sem_TypeSigs_Nil = - (T_TypeSigs (case ([]) of - { !_output -> - (case (_output) of - { !_lhsOoutput -> +{-# OPTIONS_GHC -fbang-patterns #-}++-- UUAGC 0.9.12 (Desugar.ag)+module Desugar where++import qualified Data.Set as Set+import qualified Data.Map as Map+import Data.Map(Map)+import qualified Data.Sequence as Seq+import Data.Sequence(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.singleton 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 ->+ Inh_Child ->+ Syn_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 (case ([(i, name_) | i <- Map.keys inh_ ]) of+ { !_lhsOchildInhs ->+ (case ([(s, name_) | s <- Map.keys syn_ ]) of+ { !_lhsOchildSyns ->+ (case (Child name_ tp_ inh_ syn_ higherOrder_) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _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 ->+ Inh_Children ->+ Syn_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 (case ((tl_ )) of+ { ( !_tlIchildInhs,!_tlIchildSyns,!_tlIoutput) ->+ (case ((hd_ )) of+ { ( !_hdIchildInhs,!_hdIchildSyns,!_hdIoutput) ->+ (case (_hdIchildInhs ++ _tlIchildInhs) of+ { !_lhsOchildInhs ->+ (case (_hdIchildSyns ++ _tlIchildSyns) of+ { !_lhsOchildSyns ->+ (case ((:) _hdIoutput _tlIoutput) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput) }) }) }) }) }) }) )+sem_Children_Nil :: T_Children +sem_Children_Nil =+ (T_Children (case ([]) of+ { !_lhsOchildInhs ->+ (case ([]) of+ { !_lhsOchildSyns ->+ (case ([]) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _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' : _+-}+-- 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 ->+ Inh_Expression ->+ Syn_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) ->+ (case (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)) of+ { !__tup1 ->+ (case (__tup1) of+ { !(_,!_lhsOerrors) ->+ (case (__tup1) of+ { !(!_tks',_) ->+ (case (Expression pos_ _tks') of+ { !_lhsOoutput ->+ ( _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}+ child uniqueMap : {UniqueMap}+ visit 0:+ local output : _+-}+-- cata+sem_Grammar :: Grammar ->+ T_Grammar +sem_Grammar !(Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap ) =+ (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts ) _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap )+-- 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 ->+ Inh_Grammar ->+ Syn_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 ->+ UniqueMap ->+ T_Grammar +sem_Grammar_Grammar !typeSyns_ !useMap_ !derivings_ !wrappers_ !(T_Nonterminals nonts_ ) !pragmas_ !manualAttrOrderMap_ !paramMap_ !contextMap_ !uniqueMap_ =+ (T_Grammar (\ (!_lhsIforcedIrrefutables)+ (!_lhsIoptions) ->+ (case (_lhsIoptions) of+ { !_nontsOoptions ->+ (case (_lhsIforcedIrrefutables) of+ { !_nontsOforcedIrrefutables ->+ (case ((nonts_ _nontsOforcedIrrefutables _nontsOoptions )) of+ { ( !_nontsIallAttributes,!_nontsIerrors,!_nontsIoutput) ->+ (case (_nontsIallAttributes) of+ { !_lhsOallAttributes ->+ (case (_nontsIerrors) of+ { !_lhsOerrors ->+ (case (Grammar typeSyns_ useMap_ derivings_ wrappers_ _nontsIoutput pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ uniqueMap_) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _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 ->+ Inh_HsToken ->+ Syn_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) ->+ (case (findField field_ attr_ _lhsIchildSyns) of+ { !_mField ->+ (case (maybe field_ id _mField) of+ { !_field' ->+ (case (if _lhsIuseFieldIdent || length (getName field_) < length (getName _field' )+ then _lhsIaddLines + 1+ else _lhsIaddLines) of+ { !_lhsOaddLines ->+ (case (maybe (Seq.singleton (UndefAttr _lhsInt _lhsIcon field_ (Ident "<ANY>" (getPos field_)) False)) (const Seq.empty) _mField) of+ { !_lhsOerrors ->+ (case (AGField _field' attr_ (addl _lhsIaddLines pos_) (if _lhsIuseFieldIdent then Just _lhsIruleDescr else Nothing)) of+ { !_tks ->+ (case (_tks) of+ { !_lhsOtks ->+ ( _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) ->+ (case (if _lhsIuseFieldIdent+ then _lhsIaddLines + 1+ else _lhsIaddLines) of+ { !_lhsOaddLines ->+ (case (Seq.empty) of+ { !_lhsOerrors ->+ (case (AGLocal var_ (addl _lhsIaddLines pos_) (if _lhsIuseFieldIdent then Just _lhsIruleDescr else Nothing)) of+ { !_tks ->+ (case (_tks) of+ { !_lhsOtks ->+ ( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) })) )+sem_HsToken_CharToken :: String ->+ Pos ->+ T_HsToken +sem_HsToken_CharToken !value_ !pos_ =+ (T_HsToken (\ (!_lhsIaddLines)+ (!_lhsIchildInhs)+ (!_lhsIchildSyns)+ (!_lhsIcon)+ (!_lhsInt)+ (!_lhsIruleDescr)+ (!_lhsIuseFieldIdent) ->+ (case (_lhsIaddLines) of+ { !_lhsOaddLines ->+ (case (Seq.empty) of+ { !_lhsOerrors ->+ (case (CharToken value_ (addl _lhsIaddLines pos_)) of+ { !_tks ->+ (case (_tks) of+ { !_lhsOtks ->+ ( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) })) )+sem_HsToken_Err :: String ->+ Pos ->+ T_HsToken +sem_HsToken_Err !mesg_ !pos_ =+ (T_HsToken (\ (!_lhsIaddLines)+ (!_lhsIchildInhs)+ (!_lhsIchildSyns)+ (!_lhsIcon)+ (!_lhsInt)+ (!_lhsIruleDescr)+ (!_lhsIuseFieldIdent) ->+ (case (_lhsIaddLines) of+ { !_lhsOaddLines ->+ (case (Seq.empty) of+ { !_lhsOerrors ->+ (case (Err mesg_ (addl _lhsIaddLines pos_)) of+ { !_tks ->+ (case (_tks) of+ { !_lhsOtks ->+ ( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) })) )+sem_HsToken_HsToken :: String ->+ Pos ->+ T_HsToken +sem_HsToken_HsToken !value_ !pos_ =+ (T_HsToken (\ (!_lhsIaddLines)+ (!_lhsIchildInhs)+ (!_lhsIchildSyns)+ (!_lhsIcon)+ (!_lhsInt)+ (!_lhsIruleDescr)+ (!_lhsIuseFieldIdent) ->+ (case (_lhsIaddLines) of+ { !_lhsOaddLines ->+ (case (Seq.empty) of+ { !_lhsOerrors ->+ (case (HsToken value_ (addl _lhsIaddLines pos_)) of+ { !_tks ->+ (case (_tks) of+ { !_lhsOtks ->+ ( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) })) )+sem_HsToken_StrToken :: String ->+ Pos ->+ T_HsToken +sem_HsToken_StrToken !value_ !pos_ =+ (T_HsToken (\ (!_lhsIaddLines)+ (!_lhsIchildInhs)+ (!_lhsIchildSyns)+ (!_lhsIcon)+ (!_lhsInt)+ (!_lhsIruleDescr)+ (!_lhsIuseFieldIdent) ->+ (case (_lhsIaddLines) of+ { !_lhsOaddLines ->+ (case (Seq.empty) of+ { !_lhsOerrors ->+ (case (StrToken value_ (addl _lhsIaddLines pos_)) of+ { !_tks ->+ (case (_tks) of+ { !_lhsOtks ->+ ( _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 ->+ Inh_HsTokens ->+ Syn_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) ->+ (case (_lhsIuseFieldIdent) of+ { !_tlOuseFieldIdent ->+ (case (_lhsIchildSyns) of+ { !_tlOchildSyns ->+ (case (_lhsIuseFieldIdent) of+ { !_hdOuseFieldIdent ->+ (case (_lhsIchildSyns) of+ { !_hdOchildSyns ->+ (case (_lhsIaddLines) of+ { !_hdOaddLines ->+ (case (_lhsIruleDescr) of+ { !_hdOruleDescr ->+ (case (_lhsInt) of+ { !_hdOnt ->+ (case (_lhsIcon) of+ { !_hdOcon ->+ (case (_lhsIchildInhs) of+ { !_hdOchildInhs ->+ (case ((hd_ _hdOaddLines _hdOchildInhs _hdOchildSyns _hdOcon _hdOnt _hdOruleDescr _hdOuseFieldIdent )) of+ { ( !_hdIaddLines,!_hdIerrors,!_hdItks) ->+ (case (_hdIaddLines) of+ { !_tlOaddLines ->+ (case (_lhsIruleDescr) of+ { !_tlOruleDescr ->+ (case (_lhsInt) of+ { !_tlOnt ->+ (case (_lhsIcon) of+ { !_tlOcon ->+ (case (_lhsIchildInhs) of+ { !_tlOchildInhs ->+ (case ((tl_ _tlOaddLines _tlOchildInhs _tlOchildSyns _tlOcon _tlOnt _tlOruleDescr _tlOuseFieldIdent )) of+ { ( !_tlIaddLines,!_tlIerrors,!_tlItks) ->+ (case (_tlIaddLines) of+ { !_lhsOaddLines ->+ (case (_hdIerrors Seq.>< _tlIerrors) of+ { !_lhsOerrors ->+ (case ((:) _hdItks _tlItks) of+ { !_tks ->+ (case (_tks) of+ { !_lhsOtks ->+ ( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) )+sem_HsTokens_Nil :: T_HsTokens +sem_HsTokens_Nil =+ (T_HsTokens (\ (!_lhsIaddLines)+ (!_lhsIchildInhs)+ (!_lhsIchildSyns)+ (!_lhsIcon)+ (!_lhsInt)+ (!_lhsIruleDescr)+ (!_lhsIuseFieldIdent) ->+ (case (_lhsIaddLines) of+ { !_lhsOaddLines ->+ (case (Seq.empty) of+ { !_lhsOerrors ->+ (case ([]) of+ { !_tks ->+ (case (_tks) of+ { !_lhsOtks ->+ ( _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 ->+ Inh_HsTokensRoot ->+ Syn_HsTokensRoot +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) ->+ (case (_lhsInt) of+ { !_tokensOnt ->+ (case (_lhsIcon) of+ { !_tokensOcon ->+ (case (_lhsIchildSyns) of+ { !_tokensOchildSyns ->+ (case (_lhsIuseFieldIdent) of+ { !_tokensOuseFieldIdent ->+ (case (_lhsIruleDescr) of+ { !_tokensOruleDescr ->+ (case (_lhsIchildInhs) of+ { !_tokensOchildInhs ->+ (case (0) of+ { !_tokensOaddLines ->+ (case ((tokens_ _tokensOaddLines _tokensOchildInhs _tokensOchildSyns _tokensOcon _tokensOnt _tokensOruleDescr _tokensOuseFieldIdent )) of+ { ( !_tokensIaddLines,!_tokensIerrors,!_tokensItks) ->+ (case (_tokensIerrors) of+ { !_lhsOerrors ->+ (case (_tokensItks) of+ { !_lhsOtks ->+ ( _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 ->+ Inh_Nonterminal ->+ Syn_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) ->+ (case (nt_) of+ { !_prodsOnt ->+ (case (_lhsIoptions) of+ { !_prodsOoptions ->+ (case (_lhsIforcedIrrefutables) of+ { !_prodsOforcedIrrefutables ->+ (case ((prods_ _prodsOforcedIrrefutables _prodsOnt _prodsOoptions )) of+ { ( !_prodsIallAttributes,!_prodsIerrors,!_prodsIoutput) ->+ (case (_prodsIallAttributes) of+ { !_lhsOallAttributes ->+ (case (_prodsIerrors) of+ { !_lhsOerrors ->+ (case (Nonterminal nt_ params_ inh_ syn_ _prodsIoutput) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _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 ->+ Inh_Nonterminals ->+ Syn_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) ->+ (case (_lhsIoptions) of+ { !_tlOoptions ->+ (case (_lhsIforcedIrrefutables) of+ { !_tlOforcedIrrefutables ->+ (case ((tl_ _tlOforcedIrrefutables _tlOoptions )) of+ { ( !_tlIallAttributes,!_tlIerrors,!_tlIoutput) ->+ (case (_lhsIoptions) of+ { !_hdOoptions ->+ (case (_lhsIforcedIrrefutables) of+ { !_hdOforcedIrrefutables ->+ (case ((hd_ _hdOforcedIrrefutables _hdOoptions )) of+ { ( !_hdIallAttributes,!_hdIerrors,!_hdIoutput) ->+ (case (_hdIallAttributes `mergeAttributes` _tlIallAttributes) of+ { !_lhsOallAttributes ->+ (case (_hdIerrors Seq.>< _tlIerrors) of+ { !_lhsOerrors ->+ (case ((:) _hdIoutput _tlIoutput) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) })) )+sem_Nonterminals_Nil :: T_Nonterminals +sem_Nonterminals_Nil =+ (T_Nonterminals (\ (!_lhsIforcedIrrefutables)+ (!_lhsIoptions) ->+ (case (Map.empty) of+ { !_lhsOallAttributes ->+ (case (Seq.empty) of+ { !_lhsOerrors ->+ (case ([]) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) })) )+-- Pattern -----------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ defsCollect : Set (Identifier, Identifier)+ visit 1:+ inherited attributes:+ childInhs : [(Identifier, Identifier)]+ childSyns : [(Identifier, Identifier)]+ con : ConstructorIdent+ defs : Set (Identifier, Identifier)+ forcedIrrefutables : AttrMap+ nt : NontermIdent+ synthesized attributes:+ allAttributes : AttrMap+ copy : SELF + errors : Seq Error+ output : SELF + alternatives:+ alternative Alias:+ child field : {Identifier}+ child attr : {Identifier}+ child pat : Pattern + child parts : Patterns + visit 0:+ local def : _+ visit 1:+ local copy : _+ local _tup2 : _+ local field' : _+ local err2 : _+ local err1 : _+ local output : _+ alternative Constr:+ child name : {ConstructorIdent}+ child pats : Patterns + visit 1:+ local copy : _+ local output : _+ alternative Irrefutable:+ child pat : Pattern + visit 1:+ local copy : _+ local output : _+ alternative Product:+ child pos : {Pos}+ child pats : Patterns + visit 1:+ local copy : _+ local output : _+ alternative Underscore:+ child pos : {Pos}+ visit 1:+ 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 (( (Set (Identifier, Identifier)),T_Pattern_1 ))+newtype T_Pattern_1 = T_Pattern_1 (([(Identifier, Identifier)]) ->+ ([(Identifier, Identifier)]) ->+ ConstructorIdent ->+ (Set (Identifier, Identifier)) ->+ AttrMap ->+ NontermIdent ->+ ( AttrMap,Pattern,(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 ->+ Inh_Pattern ->+ Syn_Pattern +wrap_Pattern !(T_Pattern sem ) !(Inh_Pattern _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt ) =+ (let ( !_lhsOdefsCollect,!T_Pattern_1 sem_1) =+ (sem )+ ( !_lhsOallAttributes,!_lhsOcopy,!_lhsOerrors,!_lhsOoutput) =+ (sem_1 _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 (case (Set.singleton (field_, attr_)) of+ { !_def ->+ (case ((parts_ )) of+ { ( !_partsIdefsCollect,!T_Patterns_1 parts_1) ->+ (case ((pat_ )) of+ { ( !_patIdefsCollect,!T_Pattern_1 pat_1) ->+ (case (_def `Set.union` _patIdefsCollect `Set.union` _partsIdefsCollect) of+ { !_lhsOdefsCollect ->+ (case ((sem_Pattern_Alias_1 (T_Pattern_1 pat_1 ) attr_ field_ (T_Patterns_1 parts_1 ) )) of+ { ( !sem_Pattern_1) ->+ ( _lhsOdefsCollect,sem_Pattern_1) }) }) }) }) }) )+sem_Pattern_Alias_1 :: T_Pattern_1 ->+ Identifier ->+ Identifier ->+ T_Patterns_1 ->+ T_Pattern_1 +sem_Pattern_Alias_1 !(T_Pattern_1 pat_1 ) !attr_ !field_ !(T_Patterns_1 parts_1 ) =+ (T_Pattern_1 (\ (!_lhsIchildInhs)+ (!_lhsIchildSyns)+ (!_lhsIcon)+ (!_lhsIdefs)+ (!_lhsIforcedIrrefutables)+ (!_lhsInt) ->+ (case (_lhsInt) of+ { !_patOnt ->+ (case (_lhsIcon) of+ { !_patOcon ->+ (case (_lhsIforcedIrrefutables) of+ { !_patOforcedIrrefutables ->+ (case (_lhsIdefs) of+ { !_patOdefs ->+ (case (_lhsIchildSyns) of+ { !_patOchildSyns ->+ (case (_lhsIchildInhs) of+ { !_patOchildInhs ->+ (case ((pat_1 _patOchildInhs _patOchildSyns _patOcon _patOdefs _patOforcedIrrefutables _patOnt )) of+ { ( !_patIallAttributes,!_patIcopy,!_patIerrors,!_patIoutput) ->+ (case ((Map.singleton _lhsInt $ Map.singleton _lhsIcon $ Set.singleton (field_, attr_)) `mergeAttributes` _patIallAttributes) of+ { !_lhsOallAttributes ->+ (case (_lhsInt) of+ { !_partsOnt ->+ (case (_lhsIforcedIrrefutables) of+ { !_partsOforcedIrrefutables ->+ (case (_lhsIdefs) of+ { !_partsOdefs ->+ (case (_lhsIcon) of+ { !_partsOcon ->+ (case (_lhsIchildSyns) of+ { !_partsOchildSyns ->+ (case (_lhsIchildInhs) of+ { !_partsOchildInhs ->+ (case ((parts_1 _partsOchildInhs _partsOchildSyns _partsOcon _partsOdefs _partsOforcedIrrefutables _partsOnt )) of+ { ( !_partsIallAttributes,!_partsIcopy,!_partsIerrors,!_partsIoutput) ->+ (case (Alias field_ attr_ _patIcopy _partsIcopy) of+ { !_copy ->+ (case (_copy) of+ { !_lhsOcopy ->+ (case (maybeError field_ (UndefAttr _lhsInt _lhsIcon (Ident "<ANY>" (getPos field_)) attr_ True) $+ findField field_ attr_ _lhsIchildInhs) of+ { !__tup2 ->+ (case (__tup2) of+ { !(!_field',_) ->+ (case (if _field' == field_+ then Seq.empty+ else if (_field' , attr_) `Set.member` _lhsIdefs+ then Seq.singleton $ DupRule _lhsInt _lhsIcon field_ attr_ _field'+ else Seq.empty) of+ { !_err2 ->+ (case (__tup2) of+ { !(_,!_err1) ->+ (case (_err1 Seq.>< _err2 Seq.>< _patIerrors Seq.>< _partsIerrors) of+ { !_lhsOerrors ->+ (case (Alias _field' attr_ _patIoutput _partsIoutput) of+ { !_output ->+ (case (if Set.member (field_, attr_) $ Map.findWithDefault Set.empty _lhsIcon $ Map.findWithDefault Map.empty _lhsInt $ _lhsIforcedIrrefutables+ then Irrefutable _output+ else _output) of+ { !_lhsOoutput ->+ ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) )+sem_Pattern_Constr :: ConstructorIdent ->+ T_Patterns ->+ T_Pattern +sem_Pattern_Constr !name_ !(T_Patterns pats_ ) =+ (T_Pattern (case ((pats_ )) of+ { ( !_patsIdefsCollect,!T_Patterns_1 pats_1) ->+ (case (_patsIdefsCollect) of+ { !_lhsOdefsCollect ->+ (case ((sem_Pattern_Constr_1 (T_Patterns_1 pats_1 ) name_ )) of+ { ( !sem_Pattern_1) ->+ ( _lhsOdefsCollect,sem_Pattern_1) }) }) }) )+sem_Pattern_Constr_1 :: T_Patterns_1 ->+ ConstructorIdent ->+ T_Pattern_1 +sem_Pattern_Constr_1 !(T_Patterns_1 pats_1 ) !name_ =+ (T_Pattern_1 (\ (!_lhsIchildInhs)+ (!_lhsIchildSyns)+ (!_lhsIcon)+ (!_lhsIdefs)+ (!_lhsIforcedIrrefutables)+ (!_lhsInt) ->+ (case (_lhsInt) of+ { !_patsOnt ->+ (case (_lhsIcon) of+ { !_patsOcon ->+ (case (_lhsIforcedIrrefutables) of+ { !_patsOforcedIrrefutables ->+ (case (_lhsIdefs) of+ { !_patsOdefs ->+ (case (_lhsIchildSyns) of+ { !_patsOchildSyns ->+ (case (_lhsIchildInhs) of+ { !_patsOchildInhs ->+ (case ((pats_1 _patsOchildInhs _patsOchildSyns _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt )) of+ { ( !_patsIallAttributes,!_patsIcopy,!_patsIerrors,!_patsIoutput) ->+ (case (_patsIallAttributes) of+ { !_lhsOallAttributes ->+ (case (Constr name_ _patsIcopy) of+ { !_copy ->+ (case (_copy) of+ { !_lhsOcopy ->+ (case (_patsIerrors) of+ { !_lhsOerrors ->+ (case (Constr name_ _patsIoutput) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) })) )+sem_Pattern_Irrefutable :: T_Pattern ->+ T_Pattern +sem_Pattern_Irrefutable !(T_Pattern pat_ ) =+ (T_Pattern (case ((pat_ )) of+ { ( !_patIdefsCollect,!T_Pattern_1 pat_1) ->+ (case (_patIdefsCollect) of+ { !_lhsOdefsCollect ->+ (case ((sem_Pattern_Irrefutable_1 (T_Pattern_1 pat_1 ) )) of+ { ( !sem_Pattern_1) ->+ ( _lhsOdefsCollect,sem_Pattern_1) }) }) }) )+sem_Pattern_Irrefutable_1 :: T_Pattern_1 ->+ T_Pattern_1 +sem_Pattern_Irrefutable_1 !(T_Pattern_1 pat_1 ) =+ (T_Pattern_1 (\ (!_lhsIchildInhs)+ (!_lhsIchildSyns)+ (!_lhsIcon)+ (!_lhsIdefs)+ (!_lhsIforcedIrrefutables)+ (!_lhsInt) ->+ (case (Map.empty) of+ { !_lhsOallAttributes ->+ (case (_lhsInt) of+ { !_patOnt ->+ (case (_lhsIforcedIrrefutables) of+ { !_patOforcedIrrefutables ->+ (case (_lhsIdefs) of+ { !_patOdefs ->+ (case (_lhsIcon) of+ { !_patOcon ->+ (case (_lhsIchildSyns) of+ { !_patOchildSyns ->+ (case (_lhsIchildInhs) of+ { !_patOchildInhs ->+ (case ((pat_1 _patOchildInhs _patOchildSyns _patOcon _patOdefs _patOforcedIrrefutables _patOnt )) of+ { ( !_patIallAttributes,!_patIcopy,!_patIerrors,!_patIoutput) ->+ (case (Irrefutable _patIcopy) of+ { !_copy ->+ (case (_copy) of+ { !_lhsOcopy ->+ (case (_patIerrors) of+ { !_lhsOerrors ->+ (case (Irrefutable _patIoutput) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) })) )+sem_Pattern_Product :: Pos ->+ T_Patterns ->+ T_Pattern +sem_Pattern_Product !pos_ !(T_Patterns pats_ ) =+ (T_Pattern (case ((pats_ )) of+ { ( !_patsIdefsCollect,!T_Patterns_1 pats_1) ->+ (case (_patsIdefsCollect) of+ { !_lhsOdefsCollect ->+ (case ((sem_Pattern_Product_1 (T_Patterns_1 pats_1 ) pos_ )) of+ { ( !sem_Pattern_1) ->+ ( _lhsOdefsCollect,sem_Pattern_1) }) }) }) )+sem_Pattern_Product_1 :: T_Patterns_1 ->+ Pos ->+ T_Pattern_1 +sem_Pattern_Product_1 !(T_Patterns_1 pats_1 ) !pos_ =+ (T_Pattern_1 (\ (!_lhsIchildInhs)+ (!_lhsIchildSyns)+ (!_lhsIcon)+ (!_lhsIdefs)+ (!_lhsIforcedIrrefutables)+ (!_lhsInt) ->+ (case (_lhsInt) of+ { !_patsOnt ->+ (case (_lhsIcon) of+ { !_patsOcon ->+ (case (_lhsIforcedIrrefutables) of+ { !_patsOforcedIrrefutables ->+ (case (_lhsIdefs) of+ { !_patsOdefs ->+ (case (_lhsIchildSyns) of+ { !_patsOchildSyns ->+ (case (_lhsIchildInhs) of+ { !_patsOchildInhs ->+ (case ((pats_1 _patsOchildInhs _patsOchildSyns _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt )) of+ { ( !_patsIallAttributes,!_patsIcopy,!_patsIerrors,!_patsIoutput) ->+ (case (_patsIallAttributes) of+ { !_lhsOallAttributes ->+ (case (Product pos_ _patsIcopy) of+ { !_copy ->+ (case (_copy) of+ { !_lhsOcopy ->+ (case (_patsIerrors) of+ { !_lhsOerrors ->+ (case (Product pos_ _patsIoutput) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) })) )+sem_Pattern_Underscore :: Pos ->+ T_Pattern +sem_Pattern_Underscore !pos_ =+ (T_Pattern (case (Set.empty) of+ { !_lhsOdefsCollect ->+ (case ((sem_Pattern_Underscore_1 pos_ )) of+ { ( !sem_Pattern_1) ->+ ( _lhsOdefsCollect,sem_Pattern_1) }) }) )+sem_Pattern_Underscore_1 :: Pos ->+ T_Pattern_1 +sem_Pattern_Underscore_1 !pos_ =+ (T_Pattern_1 (\ (!_lhsIchildInhs)+ (!_lhsIchildSyns)+ (!_lhsIcon)+ (!_lhsIdefs)+ (!_lhsIforcedIrrefutables)+ (!_lhsInt) ->+ (case (Map.empty) of+ { !_lhsOallAttributes ->+ (case (Underscore pos_) of+ { !_copy ->+ (case (_copy) of+ { !_lhsOcopy ->+ (case (Seq.empty) of+ { !_lhsOerrors ->+ (case (Underscore pos_) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) })) )+-- Patterns ----------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ defsCollect : Set (Identifier, Identifier)+ visit 1:+ inherited attributes:+ childInhs : [(Identifier, Identifier)]+ childSyns : [(Identifier, Identifier)]+ con : ConstructorIdent+ defs : Set (Identifier, Identifier)+ forcedIrrefutables : AttrMap+ nt : NontermIdent+ synthesized attributes:+ allAttributes : AttrMap+ copy : SELF + errors : Seq Error+ output : SELF + alternatives:+ alternative Cons:+ child hd : Pattern + child tl : Patterns + visit 1:+ local copy : _+ local output : _+ alternative Nil:+ visit 1:+ 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 (( (Set (Identifier, Identifier)),T_Patterns_1 ))+newtype T_Patterns_1 = T_Patterns_1 (([(Identifier, Identifier)]) ->+ ([(Identifier, Identifier)]) ->+ ConstructorIdent ->+ (Set (Identifier, Identifier)) ->+ AttrMap ->+ NontermIdent ->+ ( AttrMap,Patterns,(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 ->+ Inh_Patterns ->+ Syn_Patterns +wrap_Patterns !(T_Patterns sem ) !(Inh_Patterns _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt ) =+ (let ( !_lhsOdefsCollect,!T_Patterns_1 sem_1) =+ (sem )+ ( !_lhsOallAttributes,!_lhsOcopy,!_lhsOerrors,!_lhsOoutput) =+ (sem_1 _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 (case ((tl_ )) of+ { ( !_tlIdefsCollect,!T_Patterns_1 tl_1) ->+ (case ((hd_ )) of+ { ( !_hdIdefsCollect,!T_Pattern_1 hd_1) ->+ (case (_hdIdefsCollect `Set.union` _tlIdefsCollect) of+ { !_lhsOdefsCollect ->+ (case ((sem_Patterns_Cons_1 (T_Patterns_1 tl_1 ) (T_Pattern_1 hd_1 ) )) of+ { ( !sem_Patterns_1) ->+ ( _lhsOdefsCollect,sem_Patterns_1) }) }) }) }) )+sem_Patterns_Cons_1 :: T_Patterns_1 ->+ T_Pattern_1 ->+ T_Patterns_1 +sem_Patterns_Cons_1 !(T_Patterns_1 tl_1 ) !(T_Pattern_1 hd_1 ) =+ (T_Patterns_1 (\ (!_lhsIchildInhs)+ (!_lhsIchildSyns)+ (!_lhsIcon)+ (!_lhsIdefs)+ (!_lhsIforcedIrrefutables)+ (!_lhsInt) ->+ (case (_lhsInt) of+ { !_tlOnt ->+ (case (_lhsIcon) of+ { !_tlOcon ->+ (case (_lhsInt) of+ { !_hdOnt ->+ (case (_lhsIcon) of+ { !_hdOcon ->+ (case (_lhsIforcedIrrefutables) of+ { !_tlOforcedIrrefutables ->+ (case (_lhsIdefs) of+ { !_tlOdefs ->+ (case (_lhsIchildSyns) of+ { !_tlOchildSyns ->+ (case (_lhsIchildInhs) of+ { !_tlOchildInhs ->+ (case ((tl_1 _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt )) of+ { ( !_tlIallAttributes,!_tlIcopy,!_tlIerrors,!_tlIoutput) ->+ (case (_lhsIforcedIrrefutables) of+ { !_hdOforcedIrrefutables ->+ (case (_lhsIdefs) of+ { !_hdOdefs ->+ (case (_lhsIchildSyns) of+ { !_hdOchildSyns ->+ (case (_lhsIchildInhs) of+ { !_hdOchildInhs ->+ (case ((hd_1 _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt )) of+ { ( !_hdIallAttributes,!_hdIcopy,!_hdIerrors,!_hdIoutput) ->+ (case (_hdIallAttributes `mergeAttributes` _tlIallAttributes) of+ { !_lhsOallAttributes ->+ (case ((:) _hdIcopy _tlIcopy) of+ { !_copy ->+ (case (_copy) of+ { !_lhsOcopy ->+ (case (_hdIerrors Seq.>< _tlIerrors) of+ { !_lhsOerrors ->+ (case ((:) _hdIoutput _tlIoutput) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) )+sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil =+ (T_Patterns (case (Set.empty) of+ { !_lhsOdefsCollect ->+ (case ((sem_Patterns_Nil_1 )) of+ { ( !sem_Patterns_1) ->+ ( _lhsOdefsCollect,sem_Patterns_1) }) }) )+sem_Patterns_Nil_1 :: T_Patterns_1 +sem_Patterns_Nil_1 =+ (T_Patterns_1 (\ (!_lhsIchildInhs)+ (!_lhsIchildSyns)+ (!_lhsIcon)+ (!_lhsIdefs)+ (!_lhsIforcedIrrefutables)+ (!_lhsInt) ->+ (case (Map.empty) of+ { !_lhsOallAttributes ->+ (case ([]) of+ { !_copy ->+ (case (_copy) of+ { !_lhsOcopy ->+ (case (Seq.empty) of+ { !_lhsOerrors ->+ (case ([]) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _lhsOallAttributes,_lhsOcopy,_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 ->+ Inh_Production ->+ Syn_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) ->+ (case (_lhsInt) of+ { !_rulesOnt ->+ (case (con_) of+ { !_rulesOcon ->+ (case ((rules_ )) of+ { ( !_rulesIdefsCollect,!T_Rules_1 rules_1) ->+ (case (_lhsIoptions) of+ { !_rulesOoptions ->+ (case (_lhsIforcedIrrefutables) of+ { !_rulesOforcedIrrefutables ->+ (case ((children_ )) of+ { ( !_childrenIchildInhs,!_childrenIchildSyns,!_childrenIoutput) ->+ (case (_childrenIchildSyns) of+ { !_rulesOchildSyns ->+ (case (_childrenIchildInhs) of+ { !_rulesOchildInhs ->+ (case (_rulesIdefsCollect) of+ { !_rulesOdefs ->+ (case ((rules_1 _rulesOchildInhs _rulesOchildSyns _rulesOcon _rulesOdefs _rulesOforcedIrrefutables _rulesOnt _rulesOoptions )) of+ { ( !_rulesIallAttributes,!_rulesIerrors,!_rulesIoutput) ->+ (case (_rulesIallAttributes) of+ { !_lhsOallAttributes ->+ (case (_rulesIerrors) of+ { !_lhsOerrors ->+ (case ((typeSigs_ )) of+ { ( !_typeSigsIoutput) ->+ (case (Production con_ _childrenIoutput _rulesIoutput _typeSigsIoutput) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _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 ->+ Inh_Productions ->+ Syn_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) ->+ (case (_lhsInt) of+ { !_tlOnt ->+ (case (_lhsInt) of+ { !_hdOnt ->+ (case (_lhsIoptions) of+ { !_tlOoptions ->+ (case (_lhsIforcedIrrefutables) of+ { !_tlOforcedIrrefutables ->+ (case ((tl_ _tlOforcedIrrefutables _tlOnt _tlOoptions )) of+ { ( !_tlIallAttributes,!_tlIerrors,!_tlIoutput) ->+ (case (_lhsIoptions) of+ { !_hdOoptions ->+ (case (_lhsIforcedIrrefutables) of+ { !_hdOforcedIrrefutables ->+ (case ((hd_ _hdOforcedIrrefutables _hdOnt _hdOoptions )) of+ { ( !_hdIallAttributes,!_hdIerrors,!_hdIoutput) ->+ (case (_hdIallAttributes `mergeAttributes` _tlIallAttributes) of+ { !_lhsOallAttributes ->+ (case (_hdIerrors Seq.>< _tlIerrors) of+ { !_lhsOerrors ->+ (case ((:) _hdIoutput _tlIoutput) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) })) )+sem_Productions_Nil :: T_Productions +sem_Productions_Nil =+ (T_Productions (\ (!_lhsIforcedIrrefutables)+ (!_lhsInt)+ (!_lhsIoptions) ->+ (case (Map.empty) of+ { !_lhsOallAttributes ->+ (case (Seq.empty) of+ { !_lhsOerrors ->+ (case ([]) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) })) )+-- Rule --------------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ defsCollect : Set (Identifier, Identifier)+ visit 1:+ inherited attributes:+ childInhs : [(Identifier, Identifier)]+ childSyns : [(Identifier, Identifier)]+ con : ConstructorIdent+ defs : Set (Identifier, Identifier)+ forcedIrrefutables : AttrMap+ nt : NontermIdent+ options : Options+ synthesized attributes:+ allAttributes : AttrMap+ errors : Seq Error+ output : SELF + alternatives:+ alternative Rule:+ child pattern : Pattern + child rhs : Expression + child owrt : {Bool}+ child origin : {String}+ visit 1:+ 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 (( (Set (Identifier, Identifier)),T_Rule_1 ))+newtype T_Rule_1 = T_Rule_1 (([(Identifier, Identifier)]) ->+ ([(Identifier, Identifier)]) ->+ ConstructorIdent ->+ (Set (Identifier, Identifier)) ->+ AttrMap ->+ NontermIdent ->+ Options ->+ ( AttrMap,(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 ->+ Inh_Rule ->+ Syn_Rule +wrap_Rule !(T_Rule sem ) !(Inh_Rule _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions ) =+ (let ( !_lhsOdefsCollect,!T_Rule_1 sem_1) =+ (sem )+ ( !_lhsOallAttributes,!_lhsOerrors,!_lhsOoutput) =+ (sem_1 _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 (case ((pattern_ )) of+ { ( !_patternIdefsCollect,!T_Pattern_1 pattern_1) ->+ (case (_patternIdefsCollect) of+ { !_lhsOdefsCollect ->+ (case ((sem_Rule_Rule_1 (T_Pattern_1 pattern_1 ) _patternIdefsCollect (T_Expression rhs_ ) origin_ owrt_ )) of+ { ( !sem_Rule_1) ->+ ( _lhsOdefsCollect,sem_Rule_1) }) }) }) )+sem_Rule_Rule_1 :: T_Pattern_1 ->+ (Set (Identifier, Identifier)) ->+ T_Expression ->+ String ->+ Bool ->+ T_Rule_1 +sem_Rule_Rule_1 !(T_Pattern_1 pattern_1 ) !_patternIdefsCollect !(T_Expression rhs_ ) !origin_ !owrt_ =+ (T_Rule_1 (\ (!_lhsIchildInhs)+ (!_lhsIchildSyns)+ (!_lhsIcon)+ (!_lhsIdefs)+ (!_lhsIforcedIrrefutables)+ (!_lhsInt)+ (!_lhsIoptions) ->+ (case (_lhsInt) of+ { !_patternOnt ->+ (case (_lhsIcon) of+ { !_patternOcon ->+ (case (_lhsIforcedIrrefutables) of+ { !_patternOforcedIrrefutables ->+ (case (_lhsIdefs) of+ { !_patternOdefs ->+ (case (_lhsIchildSyns) of+ { !_patternOchildSyns ->+ (case (_lhsIchildInhs) of+ { !_patternOchildInhs ->+ (case ((pattern_1 _patternOchildInhs _patternOchildSyns _patternOcon _patternOdefs _patternOforcedIrrefutables _patternOnt )) of+ { ( !_patternIallAttributes,!_patternIcopy,!_patternIerrors,!_patternIoutput) ->+ (case (_patternIallAttributes) of+ { !_lhsOallAttributes ->+ (case (show _lhsInt ++ " :: " ++ show _lhsIcon ++ " :: " ++ (concat $ intersperse "," $ map (\(f,a) -> show f ++ "." ++ show a) $ Set.toList _patternIdefsCollect)) of+ { !_ruleDescr ->+ (case (_ruleDescr) of+ { !_rhsOruleDescr ->+ (case (_lhsIoptions) of+ { !_rhsOoptions ->+ (case (_lhsInt) of+ { !_rhsOnt ->+ (case (_lhsIcon) of+ { !_rhsOcon ->+ (case (_lhsIchildSyns) of+ { !_rhsOchildSyns ->+ (case (_lhsIchildInhs) of+ { !_rhsOchildInhs ->+ (case ((rhs_ _rhsOchildInhs _rhsOchildSyns _rhsOcon _rhsOnt _rhsOoptions _rhsOruleDescr )) of+ { ( !_rhsIerrors,!_rhsIoutput) ->+ (case (_patternIerrors Seq.>< _rhsIerrors) of+ { !_lhsOerrors ->+ (case (Rule _patternIoutput _rhsIoutput owrt_ origin_) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) )+-- Rules -------------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ defsCollect : Set (Identifier, Identifier)+ visit 1:+ inherited attributes:+ childInhs : [(Identifier, Identifier)]+ childSyns : [(Identifier, Identifier)]+ con : ConstructorIdent+ defs : Set (Identifier, Identifier)+ forcedIrrefutables : AttrMap+ nt : NontermIdent+ options : Options+ synthesized attributes:+ allAttributes : AttrMap+ errors : Seq Error+ output : SELF + alternatives:+ alternative Cons:+ child hd : Rule + child tl : Rules + visit 1:+ local output : _+ alternative Nil:+ visit 1:+ 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 (( (Set (Identifier, Identifier)),T_Rules_1 ))+newtype T_Rules_1 = T_Rules_1 (([(Identifier, Identifier)]) ->+ ([(Identifier, Identifier)]) ->+ ConstructorIdent ->+ (Set (Identifier, Identifier)) ->+ AttrMap ->+ NontermIdent ->+ Options ->+ ( AttrMap,(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 ->+ Inh_Rules ->+ Syn_Rules +wrap_Rules !(T_Rules sem ) !(Inh_Rules _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions ) =+ (let ( !_lhsOdefsCollect,!T_Rules_1 sem_1) =+ (sem )+ ( !_lhsOallAttributes,!_lhsOerrors,!_lhsOoutput) =+ (sem_1 _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 (case ((tl_ )) of+ { ( !_tlIdefsCollect,!T_Rules_1 tl_1) ->+ (case ((hd_ )) of+ { ( !_hdIdefsCollect,!T_Rule_1 hd_1) ->+ (case (_hdIdefsCollect `Set.union` _tlIdefsCollect) of+ { !_lhsOdefsCollect ->+ (case ((sem_Rules_Cons_1 (T_Rules_1 tl_1 ) (T_Rule_1 hd_1 ) )) of+ { ( !sem_Rules_1) ->+ ( _lhsOdefsCollect,sem_Rules_1) }) }) }) }) )+sem_Rules_Cons_1 :: T_Rules_1 ->+ T_Rule_1 ->+ T_Rules_1 +sem_Rules_Cons_1 !(T_Rules_1 tl_1 ) !(T_Rule_1 hd_1 ) =+ (T_Rules_1 (\ (!_lhsIchildInhs)+ (!_lhsIchildSyns)+ (!_lhsIcon)+ (!_lhsIdefs)+ (!_lhsIforcedIrrefutables)+ (!_lhsInt)+ (!_lhsIoptions) ->+ (case (_lhsInt) of+ { !_tlOnt ->+ (case (_lhsIcon) of+ { !_tlOcon ->+ (case (_lhsInt) of+ { !_hdOnt ->+ (case (_lhsIcon) of+ { !_hdOcon ->+ (case (_lhsIoptions) of+ { !_tlOoptions ->+ (case (_lhsIforcedIrrefutables) of+ { !_tlOforcedIrrefutables ->+ (case (_lhsIdefs) of+ { !_tlOdefs ->+ (case (_lhsIchildSyns) of+ { !_tlOchildSyns ->+ (case (_lhsIchildInhs) of+ { !_tlOchildInhs ->+ (case ((tl_1 _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt _tlOoptions )) of+ { ( !_tlIallAttributes,!_tlIerrors,!_tlIoutput) ->+ (case (_lhsIoptions) of+ { !_hdOoptions ->+ (case (_lhsIforcedIrrefutables) of+ { !_hdOforcedIrrefutables ->+ (case (_lhsIdefs) of+ { !_hdOdefs ->+ (case (_lhsIchildSyns) of+ { !_hdOchildSyns ->+ (case (_lhsIchildInhs) of+ { !_hdOchildInhs ->+ (case ((hd_1 _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt _hdOoptions )) of+ { ( !_hdIallAttributes,!_hdIerrors,!_hdIoutput) ->+ (case (_hdIallAttributes `mergeAttributes` _tlIallAttributes) of+ { !_lhsOallAttributes ->+ (case (_hdIerrors Seq.>< _tlIerrors) of+ { !_lhsOerrors ->+ (case ((:) _hdIoutput _tlIoutput) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) )+sem_Rules_Nil :: T_Rules +sem_Rules_Nil =+ (T_Rules (case (Set.empty) of+ { !_lhsOdefsCollect ->+ (case ((sem_Rules_Nil_1 )) of+ { ( !sem_Rules_1) ->+ ( _lhsOdefsCollect,sem_Rules_1) }) }) )+sem_Rules_Nil_1 :: T_Rules_1 +sem_Rules_Nil_1 =+ (T_Rules_1 (\ (!_lhsIchildInhs)+ (!_lhsIchildSyns)+ (!_lhsIcon)+ (!_lhsIdefs)+ (!_lhsIforcedIrrefutables)+ (!_lhsInt)+ (!_lhsIoptions) ->+ (case (Map.empty) of+ { !_lhsOallAttributes ->+ (case (Seq.empty) of+ { !_lhsOerrors ->+ (case ([]) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _lhsOallAttributes,_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 ->+ Inh_TypeSig ->+ Syn_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 (case (TypeSig name_ tp_) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _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 ->+ Inh_TypeSigs ->+ Syn_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 (case ((tl_ )) of+ { ( !_tlIoutput) ->+ (case ((hd_ )) of+ { ( !_hdIoutput) ->+ (case ((:) _hdIoutput _tlIoutput) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput ->+ ( _lhsOoutput) }) }) }) }) )+sem_TypeSigs_Nil :: T_TypeSigs +sem_TypeSigs_Nil =+ (T_TypeSigs (case ([]) of+ { !_output ->+ (case (_output) of+ { !_lhsOoutput -> ( _lhsOoutput) }) }) )
src-derived/ErrorMessages.hs view
@@ -1,161 +1,161 @@- - --- UUAGC 0.9.11 (ErrorMessages.ag) -module ErrorMessages where - -import UU.Scanner.Position(Pos) -import Pretty -import DepTypes(Trace) -import CodeSyntax -import CommonTypes --- Error ------------------------------------------------------- -{- - alternatives: - alternative ChildAsLocal: - 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 : {Identifier} - alternative DirectCirc: - child nt : {NontermIdent} - child o_visit : {Bool} - child cyclic : {[((Identifier,Identifier),[String],[String])]} - alternative DupAlt: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child occ1 : {ConstructorIdent} - alternative DupChild: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child name : {Identifier} - child occ1 : {Identifier} - alternative DupInhAttr: - child nt : {NontermIdent} - child attr : {Identifier} - child occ1 : {Identifier} - alternative DupRule: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child field : {Identifier} - child attr : {Identifier} - child occ1 : {Identifier} - alternative DupSet: - child name : {NontermIdent} - child occ1 : {NontermIdent} - alternative DupSig: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child attr : {Identifier} - alternative DupSynAttr: - child nt : {NontermIdent} - child attr : {Identifier} - child occ1 : {Identifier} - alternative DupSynonym: - child nt : {NontermIdent} - child occ1 : {NontermIdent} - alternative DupUnique: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child attr : {Identifier} - alternative InducedCirc: - child nt : {NontermIdent} - child cinter : {CInterface} - child cyclic : {[((Identifier,Identifier),[String],[String])]} - alternative InstCirc: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child attr : {Identifier} - child o_visit : {Bool} - child path : {[String]} - alternative LocalCirc: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child attr : {Identifier} - child o_visit : {Bool} - child path : {[String]} - alternative MissingInstSig: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child attr : {Identifier} - alternative MissingRule: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child field : {Identifier} - child attr : {Identifier} - alternative MissingTypeSig: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child attr : {Identifier} - alternative MissingUnique: - child nt : {NontermIdent} - child attr : {Identifier} - alternative ParserError: - child pos : {Pos} - child problem : {String} - child action : {String} - alternative SuperfluousRule: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child field : {Identifier} - child attr : {Identifier} - alternative UndefAlt: - child nt : {NontermIdent} - child con : {ConstructorIdent} - alternative UndefAttr: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child field : {Identifier} - child attr : {Identifier} - child isOut : {Bool} - alternative UndefChild: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child name : {Identifier} - alternative UndefLocal: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child var : {Identifier} - alternative UndefNont: - child nt : {NontermIdent} --} -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) - | DupUnique (NontermIdent) (ConstructorIdent) (Identifier) - | 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) - | MissingUnique (NontermIdent) (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: - alternative Cons: - child hd : Error - child tl : Errors - alternative Nil: --} +++-- UUAGC 0.9.12 (ErrorMessages.ag)+module ErrorMessages where++import UU.Scanner.Position(Pos)+import Pretty+import DepTypes(Trace)+import CodeSyntax+import CommonTypes+-- Error -------------------------------------------------------+{-+ alternatives:+ alternative ChildAsLocal:+ 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 : {Identifier}+ alternative DirectCirc:+ child nt : {NontermIdent}+ child o_visit : {Bool}+ child cyclic : {[((Identifier,Identifier),[String],[String])]}+ alternative DupAlt:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child occ1 : {ConstructorIdent}+ alternative DupChild:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child name : {Identifier}+ child occ1 : {Identifier}+ alternative DupInhAttr:+ child nt : {NontermIdent}+ child attr : {Identifier}+ child occ1 : {Identifier}+ alternative DupRule:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child field : {Identifier}+ child attr : {Identifier}+ child occ1 : {Identifier}+ alternative DupSet:+ child name : {NontermIdent}+ child occ1 : {NontermIdent}+ alternative DupSig:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child attr : {Identifier}+ alternative DupSynAttr:+ child nt : {NontermIdent}+ child attr : {Identifier}+ child occ1 : {Identifier}+ alternative DupSynonym:+ child nt : {NontermIdent}+ child occ1 : {NontermIdent}+ alternative DupUnique:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child attr : {Identifier}+ alternative InducedCirc:+ child nt : {NontermIdent}+ child cinter : {CInterface}+ child cyclic : {[((Identifier,Identifier),[String],[String])]}+ alternative InstCirc:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child attr : {Identifier}+ child o_visit : {Bool}+ child path : {[String]}+ alternative LocalCirc:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child attr : {Identifier}+ child o_visit : {Bool}+ child path : {[String]}+ alternative MissingInstSig:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child attr : {Identifier}+ alternative MissingRule:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child field : {Identifier}+ child attr : {Identifier}+ alternative MissingTypeSig:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child attr : {Identifier}+ alternative MissingUnique:+ child nt : {NontermIdent}+ child attr : {Identifier}+ alternative ParserError:+ child pos : {Pos}+ child problem : {String}+ child action : {String}+ alternative SuperfluousRule:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child field : {Identifier}+ child attr : {Identifier}+ alternative UndefAlt:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ alternative UndefAttr:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child field : {Identifier}+ child attr : {Identifier}+ child isOut : {Bool}+ alternative UndefChild:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child name : {Identifier}+ alternative UndefLocal:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child var : {Identifier}+ alternative UndefNont:+ child nt : {NontermIdent}+-}+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) + | DupUnique (NontermIdent) (ConstructorIdent) (Identifier) + | 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) + | MissingUnique (NontermIdent) (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:+ alternative Cons:+ child hd : Error + child tl : Errors + alternative Nil:+-} type Errors = [(Error)]
src-derived/Expression.hs view
@@ -1,15 +1,15 @@- - --- UUAGC 0.9.11 (Expression.ag) -module Expression where - -import UU.Scanner.Position(Pos) -import HsToken --- Expression -------------------------------------------------- -{- - alternatives: - alternative Expression: - child pos : {Pos} - child tks : {[HsToken]} --} +++-- UUAGC 0.9.12 (Expression.ag)+module Expression where++import UU.Scanner.Position(Pos)+import HsToken+-- Expression --------------------------------------------------+{-+ alternatives:+ alternative Expression:+ child pos : {Pos}+ child tks : {[HsToken]}+-} data Expression = Expression (Pos) ([HsToken])
src-derived/GenerateCode.hs view
@@ -1,5257 +1,5257 @@- - --- UUAGC 0.9.11 (GenerateCode.ag) -module GenerateCode where - -import CommonTypes -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 Data.Sequence as Seq -import Data.Sequence(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 - -ntOfVisit :: NontermIdent -> Int -> NontermIdent -ntOfVisit nt 0 = nt -ntOfVisit nt n = Ident (show nt ++ "_" ++ show n) (getPos nt) - --- 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 -> - Inh_CGrammar -> - Syn_CGrammar -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 - _nontsOallNts :: (Set NontermIdent) - _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) - _nontsIgathNts :: (Set NontermIdent) - _nontsIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) - -- "GenerateCode.ag"(line 50, column 17) - _nontsOo_sig = - typeSigs _lhsIoptions - -- "GenerateCode.ag"(line 50, column 17) - _nontsOo_cata = - folds _lhsIoptions - -- "GenerateCode.ag"(line 50, column 17) - _nontsOo_sem = - semfuns _lhsIoptions - -- "GenerateCode.ag"(line 50, column 17) - _nontsOo_newtypes = - newtypes _lhsIoptions - -- "GenerateCode.ag"(line 50, column 17) - _nontsOo_unbox = - unbox _lhsIoptions - -- "GenerateCode.ag"(line 50, column 17) - _nontsOo_case = - cases _lhsIoptions - -- "GenerateCode.ag"(line 50, column 17) - _nontsOo_pretty = - attrInfo _lhsIoptions - -- "GenerateCode.ag"(line 50, column 17) - _nontsOo_rename = - rename _lhsIoptions - -- "GenerateCode.ag"(line 50, column 17) - _nontsOo_strictwrap = - strictWrap _lhsIoptions - -- "GenerateCode.ag"(line 50, column 17) - _nontsOo_splitsems = - splitSems _lhsIoptions - -- "GenerateCode.ag"(line 50, column 17) - _nontsOo_data = - if dataTypes _lhsIoptions then Just (strictData _lhsIoptions) else Nothing - -- "GenerateCode.ag"(line 50, column 17) - _nontsOprefix = - prefix _lhsIoptions - -- "GenerateCode.ag"(line 50, column 17) - _nontsOo_traces = - genTraces _lhsIoptions - -- "GenerateCode.ag"(line 50, column 17) - _nontsOo_costcentre = - genCostCentres _lhsIoptions - -- "GenerateCode.ag"(line 50, column 17) - _nontsOo_linePragmas = - genLinePragmas _lhsIoptions - -- "GenerateCode.ag"(line 69, column 15) - _nontsOallPragmas = - pragmas_ - -- "GenerateCode.ag"(line 91, column 14) - _nontsOparamMap = - paramMap_ - -- "GenerateCode.ag"(line 112, column 7) - _nontsOcontextMap = - contextMap_ - -- "GenerateCode.ag"(line 124, column 7) - _nontsOallNts = - _nontsIgathNts - -- "GenerateCode.ag"(line 621, column 7) - _unfoldSemDom = - \nt nr repl -> - let (params, tp) = Map.findWithDefault (error ("No such semantic domain: " ++ show nt)) (nt, nr) _nontsIsemDomUnfoldGath - replMap = Map.fromList (zip params repl) - replace k = Map.findWithDefault ('@':k) k replMap - in evalType replace tp - -- "GenerateCode.ag"(line 714, column 14) - _nontsOwith_sig = - typeSigs _lhsIoptions && _nontsIallTpsFound - -- "GenerateCode.ag"(line 721, column 15) - _nontsOerrors = - Seq.empty - -- "GenerateCode.ag"(line 785, column 17) - _lhsOoutput = - Program _nontsIchunks - -- "GenerateCode.ag"(line 838, column 14) - _nontsOtypeSyns = - typeSyns_ - -- "GenerateCode.ag"(line 838, column 14) - _nontsOderivings = - derivings_ - -- "GenerateCode.ag"(line 838, column 14) - _nontsOwrappers = - wrappers_ - -- copy rule (up) - _lhsOerrors = - _nontsIerrors - -- copy rule (from local) - _nontsOunfoldSemDom = - _unfoldSemDom - ( _nontsIallTpsFound,_nontsIchunks,_nontsIerrors,_nontsIgathNts,_nontsIsemDomUnfoldGath) = - (nonts_ _nontsOallNts _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 -> - Inh_CInterface -> - Syn_CInterface -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 218, column 17) - _segOnr = - 0 - -- "GenerateCode.ag"(line 594, column 18) - _lhsOsemDom = - Comment "semantic domain" : _segIsemDom - -- use rule "GenerateCode.ag"(line 738, column 52) - _lhsOcomments = - _segIcomments - -- use rule "GenerateCode.ag"(line 611, column 86) - _lhsOsemDomUnfoldGath = - _segIsemDomUnfoldGath - -- use rule "GenerateCode.ag"(line 687, 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: - allNts : Set NontermIdent - 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 - gathNts : Set NontermIdent - 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 ((Set NontermIdent) -> - 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),(Set NontermIdent),(Map (NontermIdent, Int) ([String], Code.Type)))) -data Inh_CNonterminal = Inh_CNonterminal {allNts_Inh_CNonterminal :: !(Set NontermIdent),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),gathNts_Syn_CNonterminal :: !(Set NontermIdent),semDomUnfoldGath_Syn_CNonterminal :: !(Map (NontermIdent, Int) ([String], Code.Type))} -wrap_CNonterminal :: T_CNonterminal -> - Inh_CNonterminal -> - Syn_CNonterminal -wrap_CNonterminal (T_CNonterminal sem ) (Inh_CNonterminal _lhsIallNts _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,_lhsOgathNts,_lhsOsemDomUnfoldGath) = - (sem _lhsIallNts _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 _lhsOgathNts _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 (\ _lhsIallNts - _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 - _lhsOgathNts :: (Set NontermIdent) - _lhsOchunks :: Chunks - _lhsOallTpsFound :: Bool - _lhsOerrors :: (Seq Error) - _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) - _prodsOallNts :: (Set NontermIdent) - _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 79, column 26) - __tup1 = - (inh_,syn_,nt_) - -- "GenerateCode.ag"(line 79, column 26) - (_interOinh,_,_) = - __tup1 - -- "GenerateCode.ag"(line 79, column 26) - (_,_interOsyn,_) = - __tup1 - -- "GenerateCode.ag"(line 79, column 26) - (_,_,_interOnt) = - __tup1 - -- "GenerateCode.ag"(line 80, column 25) - __tup2 = - (inh_,syn_,nt_) - -- "GenerateCode.ag"(line 80, column 25) - (_prodsOinh,_,_) = - __tup2 - -- "GenerateCode.ag"(line 80, column 25) - (_,_prodsOsyn,_) = - __tup2 - -- "GenerateCode.ag"(line 80, column 25) - (_,_,_prodsOnt) = - __tup2 - -- "GenerateCode.ag"(line 130, column 7) - _lhsOgathNts = - Set.singleton nt_ - -- "GenerateCode.ag"(line 659, 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 734, column 18) - _comment = - Comment . unlines . map ind $ ( _interIcomments ++ ("alternatives:" : map ind _prodsIcomments) ) - -- "GenerateCode.ag"(line 788, 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 843, 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.Either t1 t2 -> SimpleType ("Either (" ++ typeToHaskellString (Just nt_) params' t1 ++") (" - ++ typeToHaskellString (Just nt_) params' t2 ++")") - CommonTypes.Map t1 t2 -> SimpleType ("Map (" ++ typeToHaskellString (Just nt_) params' t1 ++") (" - ++ typeToHaskellString (Just nt_) params' t2 ++")") - CommonTypes.IntMap t -> SimpleType ("IntMap (" ++ 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' (idEvalType 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 877, 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.Either tp1 tp2 -> - let left = semname _lhsIprefix nt_ (identifier "Left") - right = semname _lhsIprefix nt_ (identifier "Right" ) - arg = SimpleExpr "x" - rarg0 = case tp1 of - NT t _ -> App (cataname _lhsIprefix t) [arg] - _ -> arg - rarg1 = case tp2 of - NT t _ -> App (cataname _lhsIprefix t) [arg] - _ -> arg - lhs a = Fun (cataname _lhsIprefix nt_) [a] - in [Decl (lhs (App "Prelude.Left" [arg])) (App left [rarg0]) Set.empty Set.empty - ,Decl (lhs (App "Prelude.Right" [arg])) (App right [rarg1]) Set.empty Set.empty - ] - CommonTypes.Map _ tp -> - let entry = SimpleExpr (semname _lhsIprefix nt_ (identifier "Entry")) - nil = SimpleExpr (semname _lhsIprefix nt_ (identifier "Nil")) - arg = SimpleExpr "m" - rarg = case tp of - NT t _ -> App "Map.map" [SimpleExpr $ cataname _lhsIprefix t, arg] - _ -> arg - lhs = Fun (cataname _lhsIprefix nt_) [arg] - rhs = App "Map.foldWithKey" [entry,nil,rarg] - in [Decl lhs rhs Set.empty Set.empty] - CommonTypes.IntMap tp -> - let entry = SimpleExpr (semname _lhsIprefix nt_ (identifier "Entry")) - nil = SimpleExpr (semname _lhsIprefix nt_ (identifier "Nil")) - arg = SimpleExpr "m" - rarg = case tp of - NT t _ -> App "IntMap.map" [SimpleExpr $ cataname _lhsIprefix t, arg] - _ -> arg - lhs = Fun (cataname _lhsIprefix nt_) [arg] - rhs = App "IntMap.foldWithKey" [entry,nil,rarg] - in [Decl lhs rhs 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 706, column 39) - _lhsOallTpsFound = - _prodsIallTpsFound - -- use rule "GenerateCode.ag"(line 719, column 32) - _lhsOerrors = - _prodsIerrors - -- use rule "GenerateCode.ag"(line 611, column 86) - _lhsOsemDomUnfoldGath = - _interIsemDomUnfoldGath - -- copy rule (down) - _prodsOallNts = - _lhsIallNts - -- 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_ _prodsOallNts _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,_lhsOgathNts,_lhsOsemDomUnfoldGath))) ) --- CNonterminals ----------------------------------------------- -{- - visit 0: - inherited attributes: - allNts : Set NontermIdent - 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 - gathNts : Set NontermIdent - 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 ((Set NontermIdent) -> - 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),(Set NontermIdent),(Map (NontermIdent, Int) ([String], Code.Type)))) -data Inh_CNonterminals = Inh_CNonterminals {allNts_Inh_CNonterminals :: !(Set NontermIdent),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),gathNts_Syn_CNonterminals :: !(Set NontermIdent),semDomUnfoldGath_Syn_CNonterminals :: !(Map (NontermIdent, Int) ([String], Code.Type))} -wrap_CNonterminals :: T_CNonterminals -> - Inh_CNonterminals -> - Syn_CNonterminals -wrap_CNonterminals (T_CNonterminals sem ) (Inh_CNonterminals _lhsIallNts _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,_lhsOgathNts,_lhsOsemDomUnfoldGath) = - (sem _lhsIallNts _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 _lhsOgathNts _lhsOsemDomUnfoldGath )) -sem_CNonterminals_Cons :: T_CNonterminal -> - T_CNonterminals -> - T_CNonterminals -sem_CNonterminals_Cons (T_CNonterminal hd_ ) (T_CNonterminals tl_ ) = - (T_CNonterminals (\ _lhsIallNts - _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) - _lhsOgathNts :: (Set NontermIdent) - _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) - _hdOallNts :: (Set NontermIdent) - _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) - _tlOallNts :: (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) - _hdIgathNts :: (Set NontermIdent) - _hdIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) - _tlIallTpsFound :: Bool - _tlIchunks :: Chunks - _tlIerrors :: (Seq Error) - _tlIgathNts :: (Set NontermIdent) - _tlIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) - -- use rule "GenerateCode.ag"(line 706, column 39) - _lhsOallTpsFound = - _hdIallTpsFound && _tlIallTpsFound - -- use rule "GenerateCode.ag"(line 780, column 49) - _lhsOchunks = - _hdIchunks ++ _tlIchunks - -- use rule "GenerateCode.ag"(line 719, column 32) - _lhsOerrors = - _hdIerrors Seq.>< _tlIerrors - -- use rule "GenerateCode.ag"(line 126, column 47) - _lhsOgathNts = - _hdIgathNts `Set.union` _tlIgathNts - -- use rule "GenerateCode.ag"(line 611, column 86) - _lhsOsemDomUnfoldGath = - _hdIsemDomUnfoldGath `Map.union` _tlIsemDomUnfoldGath - -- copy rule (down) - _hdOallNts = - _lhsIallNts - -- 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) - _tlOallNts = - _lhsIallNts - -- 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,_hdIgathNts,_hdIsemDomUnfoldGath) = - (hd_ _hdOallNts _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,_tlIgathNts,_tlIsemDomUnfoldGath) = - (tl_ _tlOallNts _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,_lhsOgathNts,_lhsOsemDomUnfoldGath))) ) -sem_CNonterminals_Nil :: T_CNonterminals -sem_CNonterminals_Nil = - (T_CNonterminals (\ _lhsIallNts - _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) - _lhsOgathNts :: (Set NontermIdent) - _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) - -- use rule "GenerateCode.ag"(line 706, column 39) - _lhsOallTpsFound = - True - -- use rule "GenerateCode.ag"(line 780, column 49) - _lhsOchunks = - [] - -- use rule "GenerateCode.ag"(line 719, column 32) - _lhsOerrors = - Seq.empty - -- use rule "GenerateCode.ag"(line 126, column 47) - _lhsOgathNts = - Set.empty - -- use rule "GenerateCode.ag"(line 611, column 86) - _lhsOsemDomUnfoldGath = - Map.empty - in ( _lhsOallTpsFound,_lhsOchunks,_lhsOerrors,_lhsOgathNts,_lhsOsemDomUnfoldGath))) ) --- CProduction ------------------------------------------------- -{- - visit 0: - inherited attributes: - allNts : Set NontermIdent - 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 ((Set NontermIdent) -> - 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 {allNts_Inh_CProduction :: !(Set NontermIdent),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 -> - Inh_CProduction -> - Syn_CProduction -wrap_CProduction (T_CProduction sem ) (Inh_CProduction _lhsIallNts _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 _lhsIallNts _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 (\ _lhsIallNts - _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]) - _visitsOallNts :: (Set NontermIdent) - _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 85, column 19) - _visitsOcon = - con_ - -- "GenerateCode.ag"(line 86, column 20) - _visitsOterminals = - terminals_ - -- "GenerateCode.ag"(line 98, column 7) - _paramInstMap = - Map.fromList [(nm, (extractNonterminal tp, tps)) | (nm,tp,_) <- children_, let tps = map cleanupArg $ nontermArgs tp, not (null tps) ] - -- "GenerateCode.ag"(line 214, column 18) - _visitsOnr = - 0 - -- "GenerateCode.ag"(line 340, column 18) - _visitsOchildren = - children_ - -- "GenerateCode.ag"(line 450, column 7) - _visitsOinstVisitNrs = - _visitsIgatherInstVisitNrs - -- "GenerateCode.ag"(line 749, column 17) - _firstOrderChildren = - filter (\(_,_,ho) -> not ho) children_ - -- "GenerateCode.ag"(line 750, column 18) - _lhsOcomments = - ("alternative " ++ getName con_ ++ ":") - : map ind ( map (\(x,y,_) -> makeLocalComment 14 "child" x (Just y)) _firstOrderChildren - ++ _visitsIcomments - ) - -- "GenerateCode.ag"(line 869, column 17) - _params = - map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap - -- "GenerateCode.ag"(line 870, column 17) - _lhsOdataAlt = - DataAlt (conname _lhsIo_rename _lhsInt con_) (map (\(_,t,_) -> typeToHaskellString (Just _lhsInt) _params t) _firstOrderChildren ) - -- "GenerateCode.ag"(line 962, 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 706, column 39) - _lhsOallTpsFound = - _visitsIallTpsFound - -- use rule "GenerateCode.ag"(line 781, column 44) - _lhsOdecls = - _visitsIdecls - -- use rule "GenerateCode.ag"(line 719, column 32) - _lhsOerrors = - _visitsIerrors - -- use rule "GenerateCode.ag"(line 977, column 61) - _lhsOsemNames = - _visitsIsemNames - -- copy rule (down) - _visitsOallNts = - _lhsIallNts - -- 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_ _visitsOallNts _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: - allNts : Set NontermIdent - 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 ((Set NontermIdent) -> - 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 {allNts_Inh_CProductions :: !(Set NontermIdent),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 -> - Inh_CProductions -> - Syn_CProductions -wrap_CProductions (T_CProductions sem ) (Inh_CProductions _lhsIallNts _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 _lhsIallNts _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 (\ _lhsIallNts - _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]) - _hdOallNts :: (Set NontermIdent) - _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 - _tlOallNts :: (Set NontermIdent) - _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 865, column 17) - _lhsOdataAlts = - _hdIdataAlt : _tlIdataAlts - -- "GenerateCode.ag"(line 958, column 10) - _lhsOcataAlts = - _hdIcataAlt : _tlIcataAlts - -- use rule "GenerateCode.ag"(line 706, column 39) - _lhsOallTpsFound = - _hdIallTpsFound && _tlIallTpsFound - -- use rule "GenerateCode.ag"(line 738, column 52) - _lhsOcomments = - _hdIcomments ++ _tlIcomments - -- use rule "GenerateCode.ag"(line 781, column 44) - _lhsOdecls = - _hdIdecls ++ _tlIdecls - -- use rule "GenerateCode.ag"(line 719, column 32) - _lhsOerrors = - _hdIerrors Seq.>< _tlIerrors - -- use rule "GenerateCode.ag"(line 977, column 61) - _lhsOsemNames = - _hdIsemNames ++ _tlIsemNames - -- copy rule (down) - _hdOallNts = - _lhsIallNts - -- 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) - _tlOallNts = - _lhsIallNts - -- 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_ _hdOallNts _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_ _tlOallNts _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 (\ _lhsIallNts - _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 866, column 17) - _lhsOdataAlts = - [] - -- "GenerateCode.ag"(line 959, column 10) - _lhsOcataAlts = - [] - -- use rule "GenerateCode.ag"(line 706, column 39) - _lhsOallTpsFound = - True - -- use rule "GenerateCode.ag"(line 738, column 52) - _lhsOcomments = - [] - -- use rule "GenerateCode.ag"(line 781, column 44) - _lhsOdecls = - [] - -- use rule "GenerateCode.ag"(line 719, column 32) - _lhsOerrors = - Seq.empty - -- use rule "GenerateCode.ag"(line 977, column 61) - _lhsOsemNames = - [] - in ( _lhsOallTpsFound,_lhsOcataAlts,_lhsOcomments,_lhsOdataAlts,_lhsOdecls,_lhsOerrors,_lhsOsemNames))) ) --- CRule ------------------------------------------------------- -{- - visit 0: - inherited attributes: - allNts : Set NontermIdent - 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] - unfoldSemDom : NontermIdent -> Int -> [String] -> Code.Type - 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 rulename : _ - 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 ((Set NontermIdent) -> - ([(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]) -> - (NontermIdent -> Int -> [String] -> Code.Type) -> - String -> - ( Bool,(DeclBlocks -> DeclBlocks),([String]),Decls,([Decl]),([Identifier]),(Seq Error),Exprs,([Decl]),([Type]),(Set String))) -data Inh_CRule = Inh_CRule {allNts_Inh_CRule :: !(Set NontermIdent),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]),unfoldSemDom_Inh_CRule :: !(NontermIdent -> Int -> [String] -> Code.Type),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 -> - Inh_CRule -> - Syn_CRule -wrap_CRule (T_CRule sem ) (Inh_CRule _lhsIallNts _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 _lhsIunfoldSemDom _lhsIwhat ) = - (let ( _lhsOallTpsFound,_lhsObldBlocksFun,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOerrors,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars) = - (sem _lhsIallNts _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 _lhsIunfoldSemDom _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 (\ _lhsIallNts - _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 - _lhsIunfoldSemDom - _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 181, column 18) - _costCentreDescr = - show _lhsInt ++ ":" ++ show _lhsIcon ++ ":" ++ show name_ ++ ":" ++ show nt_ ++ ":" ++ show nr_ - -- "GenerateCode.ag"(line 182, column 18) - _addCostCentre = - \v -> if _lhsIo_costcentre - then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v - else v - -- "GenerateCode.ag"(line 185, 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 261, column 7) - _isSuperfluousHigherOrderIntra = - _lhsInr <= Map.findWithDefault (-1) name_ _lhsIinstVisitNrs - -- "GenerateCode.ag"(line 275, column 8) - _names = - if _isSuperfluousHigherOrderIntra - then [] - else [funname name_ (nr_+1)] - -- "GenerateCode.ag"(line 279, column 8) - _lhsOexprs = - let wrap = if _lhsIo_newtypes then \x -> App (typeName nt_ (nr_ + 1)) [x] else id - addType expr | null _instParams = expr - | otherwise = TypedExpr expr (_lhsIunfoldSemDom nt_ (nr_+1) _instParams ) - in map (wrap . addType . SimpleExpr) _names - -- "GenerateCode.ag"(line 291, column 7) - _lhsOusedVars = - Set.fromList _names - -- "GenerateCode.ag"(line 315, column 19) - _mkTp = - _evalTp . SimpleType . typeToHaskellString (Just nt_) _orgParams - -- "GenerateCode.ag"(line 316, column 19) - _definedTps = - [ TSig (attrname True name_ a) (_mkTp tp) | (a,tp) <- Map.toList syn_ ] - -- "GenerateCode.ag"(line 317, column 19) - _nextTp = - typeName nt_ (nr_+1) - -- "GenerateCode.ag"(line 318, column 19) - _lhsOtSigs = - (if isLast_ then id else (TSig (funname name_ (nr_+1)) (TypeApp (SimpleType _nextTp) (map SimpleType _instParams )) :)) _definedTps - -- "GenerateCode.ag"(line 320, column 19) - _orgParams = - map getName $ Map.findWithDefault [] nt_ _lhsIparamMap - -- "GenerateCode.ag"(line 321, column 19) - _instParams = - snd $ Map.findWithDefault (nt_,[]) name_ _lhsIparamInstMap - -- "GenerateCode.ag"(line 322, column 19) - _replParamMap = - Map.fromList (zip _orgParams _instParams ) - -- "GenerateCode.ag"(line 323, column 19) - _replace = - \k -> Map.findWithDefault k k _replParamMap - -- "GenerateCode.ag"(line 324, column 19) - _evalTp = - if null _orgParams then id else evalType _replace - -- "GenerateCode.ag"(line 347, column 19) - _lhsOtps = - if _isSuperfluousHigherOrderIntra - then [] - else [NT (ntOfVisit nt_ (nr_+1)) _instParams ] - -- "GenerateCode.ag"(line 472, column 7) - _lhsOdeclsAbove = - [] - -- "GenerateCode.ag"(line 485, column 7) - _lhsObldBlocksFun = - DeclBlock _lhsIdeclsAbove (head _decls ) - -- use rule "GenerateCode.ag"(line 344, column 39) - _lhsOallTpsFound = - True - -- use rule "GenerateCode.ag"(line 738, column 52) - _lhsOcomments = - [] - -- use rule "GenerateCode.ag"(line 138, column 34) - _lhsOdecls = - _decls - -- use rule "GenerateCode.ag"(line 195, column 55) - _lhsOdefinedInsts = - [] - -- use rule "GenerateCode.ag"(line 719, 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 (\ _lhsIallNts - _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 - _lhsIunfoldSemDom - _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 140, column 12) - _instTypes = - map (\(n,NT t _,_) -> (n,t)) _lhsIhigherOrderChildren - -- "GenerateCode.ag"(line 141, column 12) - _originComment = - if _lhsIo_pretty - then (Comment origin_:) - else id - -- "GenerateCode.ag"(line 144, column 12) - _instDecls = - [ Decl (Pattern3 (Alias _INST' inst (Underscore (getPos inst)) [])) - ( let nm = fromJust $ inst `lookup` _instTypes - in case nm `Set.member` _lhsIallNts of - True -> App (cataname _lhsIprefix nm) - [SimpleExpr instLocFieldName] - False -> 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 156, column 12) - _patDescr = - if isIn_ - then "_" - else concat $ intersperse "," (map (\(f,a) -> show f ++ "." ++ show a) _patternIpatternAttributes) - -- "GenerateCode.ag"(line 159, column 12) - _traceDescr = - show nt_ ++ " :: " ++ show con_ ++ " :: " ++ _patDescr - -- "GenerateCode.ag"(line 161, column 12) - _addTrace = - \v -> if _lhsIo_traces - then Trace _traceDescr v - else v - -- "GenerateCode.ag"(line 164, column 12) - _costCentreDescr = - show nt_ ++ ":" ++ show con_ ++ ":" ++ _patDescr - -- "GenerateCode.ag"(line 165, column 12) - _addCostCentre = - \v -> if _lhsIo_costcentre - then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v - else v - -- "GenerateCode.ag"(line 168, 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 175, 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 200, column 12) - _definedInsts = - if isIn_ then [] else _patternIdefinedInsts - -- "GenerateCode.ag"(line 270, column 12) - _rulename = - if field_ == _LOC && name_ `elem` _lhsIterminals - then funname name_ 0 - else attrname isIn_ field_ name_ - -- "GenerateCode.ag"(line 273, column 12) - _lhsOexprs = - [SimpleExpr _rulename ] - -- "GenerateCode.ag"(line 289, column 7) - _lhsOusedVars = - Set.singleton _rulename - -- "GenerateCode.ag"(line 299, column 19) - _mkTp = - SimpleType . typeToHaskellString (Just _lhsInt) _orgParams - -- "GenerateCode.ag"(line 300, column 19) - _lhsOtSigs = - [ TSig (attrname False field attr) (_evalTp field $ _mkTp (fromJust tp)) - | (field,attr,tp) <- Map.elems defines_, isJust tp ] - -- "GenerateCode.ag"(line 303, column 19) - _orgParams = - map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap - -- "GenerateCode.ag"(line 304, 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 346, column 23) - __tup3 = - maybe ([],False) (\tp -> ([substSelf (fromJust childnt_) tp],True)) tp_ - -- "GenerateCode.ag"(line 346, column 23) - (_lhsOtps,_) = - __tup3 - -- "GenerateCode.ag"(line 346, column 23) - (_,_lhsOallTpsFound) = - __tup3 - -- "GenerateCode.ag"(line 470, column 7) - _lhsOdeclsAbove = - _lhsIdeclsAbove ++ _decls - -- "GenerateCode.ag"(line 483, column 7) - _lhsObldBlocksFun = - id - -- "GenerateCode.ag"(line 725, column 12) - _lhsOerrors = - let nameOf (Alias _ _ _ pats@(_:_)) = Ident (show (map (\(Alias _ a _ _)->a) pats)) (getPos name_) - nameOf _ = name_ - in maybe (Seq.singleton (MissingTypeSig _lhsInt _lhsIcon (nameOf _patternIcopy))) (const Seq.empty) tp_ - -- "GenerateCode.ag"(line 765, 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 138, column 34) - _lhsOdecls = - _decls - -- use rule "GenerateCode.ag"(line 195, 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 -> - Inh_CSegment -> - Syn_CSegment -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 597, column 15) - _tp = - foldr Arr _synTps _inhTps - -- "GenerateCode.ag"(line 598, column 15) - _inhTps = - [SimpleType (typeToHaskellString (Just _lhsInt) _params tp) | tp <- Map.elems inh_] - -- "GenerateCode.ag"(line 599, column 15) - _synTps = - mkTupleType _lhsIo_unbox (null _inhTps ) ([SimpleType (typeToHaskellString (Just _lhsInt) _params tp) | tp <- Map.elems syn_] ++ _continuation ) - -- "GenerateCode.ag"(line 600, column 15) - _continuation = - if _lhsIisLast - then [] - else [TypeApp (SimpleType (typeName _lhsInt (_lhsInr + 1))) (map (SimpleType . ('@':)) _params )] - -- "GenerateCode.ag"(line 603, column 15) - _params = - map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap - -- "GenerateCode.ag"(line 604, 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 615, column 7) - _lhsOsemDomUnfoldGath = - Map.singleton (_lhsInt, _lhsInr) (_params , _tp ) - -- "GenerateCode.ag"(line 689, 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 743, 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 -> - Inh_CSegments -> - Syn_CSegments -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 220, column 11) - _tlOnr = - _lhsInr + 1 - -- "GenerateCode.ag"(line 233, column 12) - _lhsOisNil = - False - -- "GenerateCode.ag"(line 234, column 12) - _hdOisLast = - _tlIisNil - -- use rule "GenerateCode.ag"(line 738, column 52) - _lhsOcomments = - _hdIcomments ++ _tlIcomments - -- use rule "GenerateCode.ag"(line 592, column 50) - _lhsOsemDom = - _hdIsemDom ++ _tlIsemDom - -- use rule "GenerateCode.ag"(line 611, column 86) - _lhsOsemDomUnfoldGath = - _hdIsemDomUnfoldGath `Map.union` _tlIsemDomUnfoldGath - -- use rule "GenerateCode.ag"(line 687, 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 235, column 10) - _lhsOisNil = - True - -- use rule "GenerateCode.ag"(line 738, column 52) - _lhsOcomments = - [] - -- use rule "GenerateCode.ag"(line 592, column 50) - _lhsOsemDom = - [] - -- use rule "GenerateCode.ag"(line 611, column 86) - _lhsOsemDomUnfoldGath = - Map.empty - -- use rule "GenerateCode.ag"(line 687, column 52) - _lhsOwrapDecls = - [] - in ( _lhsOcomments,_lhsOisNil,_lhsOsemDom,_lhsOsemDomUnfoldGath,_lhsOwrapDecls))) ) --- CVisit ------------------------------------------------------ -{- - visit 0: - inherited attributes: - allNts : Set NontermIdent - 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 ((Set NontermIdent) -> - 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 {allNts_Inh_CVisit :: !(Set NontermIdent),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 -> - Inh_CVisit -> - Syn_CVisit -wrap_CVisit (T_CVisit sem ) (Inh_CVisit _lhsIallNts _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 _lhsIallNts _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 (\ _lhsIallNts - _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]) - _vssOallNts :: (Set NontermIdent) - _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]) - _vssOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) - _intraOallNts :: (Set NontermIdent) - _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]) - _intraOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) - _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 244, column 13) - _lhsOintra = - _intraIexprs - -- "GenerateCode.ag"(line 245, column 13) - _lhsOintraVars = - _intraIusedVars - -- "GenerateCode.ag"(line 357, column 13) - __tup4 = - partition (\(_,_,ho) -> ho) _lhsIchildren - -- "GenerateCode.ag"(line 357, column 13) - (_higherOrderChildren,_) = - __tup4 - -- "GenerateCode.ag"(line 357, column 13) - (_,_firstOrderChildren) = - __tup4 - -- "GenerateCode.ag"(line 358, column 13) - _funcname = - seqSemname _lhsIprefix _lhsInt _lhsIcon _lhsInr - -- "GenerateCode.ag"(line 359, column 13) - _nextVisitName = - if _lhsIisLast then [] else [visitname _lhsIprefix _lhsInt (_lhsInr+1)] - -- "GenerateCode.ag"(line 360, 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 366, column 13) - _decls = - _typeSigs ++ _vssIdecls ++ _nextVisitDecl - -- "GenerateCode.ag"(line 367, column 13) - _vssOlastExpr = - mkTupleExpr _lhsIo_unbox (null $ Map.keys inh_) $ map (SimpleExpr . lhsname False) (Map.keys syn_) ++ map SimpleExpr _nextVisitName - -- "GenerateCode.ag"(line 368, column 13) - _intraOlastExpr = - error "lastExpr: not used here" - -- "GenerateCode.ag"(line 369, column 13) - _lastExprVars = - map (lhsname False) (Map.keys syn_) ++ _nextVisitName - -- "GenerateCode.ag"(line 370, column 13) - __tup5 = - mkPartitionedFunction _funcname _o_case _nextVisitDecl _lastExprVars _vssIblockDecls - -- "GenerateCode.ag"(line 370, column 13) - (_blockFunDecls,_) = - __tup5 - -- "GenerateCode.ag"(line 370, column 13) - (_,_blockFirstFunCall) = - __tup5 - -- "GenerateCode.ag"(line 372, column 13) - _costCentreDescr = - "b" ++ ":" ++ show _lhsInt ++ ":" ++ show _lhsIcon ++ ":" ++ show _lhsInr - -- "GenerateCode.ag"(line 373, column 13) - _addCostCentre = - \v -> if _lhsIo_costcentre - then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v - else v - -- "GenerateCode.ag"(line 377, column 13) - _params = - map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap - -- "GenerateCode.ag"(line 378, 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 (idEvalType $ 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 408, column 13) - _tsig = - TSig _funcname _semType - -- "GenerateCode.ag"(line 409, 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 420, column 13) - _lhsOdecls = - ( if _lhsIwith_sig - then [_tsig, _semFun] - else [_semFun] - ) ++ - ( if ordered_ && _o_splitsems - then _blockFunDecls - else [] - ) - -- "GenerateCode.ag"(line 428, column 13) - _typeSigs = - if _lhsIo_sig && not _o_case - then _vssItSigs - else [] - -- "GenerateCode.ag"(line 431, column 13) - _o_case = - _lhsIo_case && ordered_ && not (hasPragma _lhsIallPragmas _lhsInt _lhsIcon _NOCASE) - -- "GenerateCode.ag"(line 432, column 13) - _o_splitsems = - ordered_ && _lhsIo_splitsems - -- "GenerateCode.ag"(line 454, column 7) - _lhsOgatherInstVisitNrs = - Map.fromList [(i,_lhsInr) | i <- _vssIdefinedInsts] - -- "GenerateCode.ag"(line 465, column 7) - _vssOdeclsAbove = - [] - -- "GenerateCode.ag"(line 466, column 7) - _intraOdeclsAbove = - error "declsAbove: not used here" - -- "GenerateCode.ag"(line 712, column 13) - _lhsOallTpsFound = - _intraIallTpsFound - -- "GenerateCode.ag"(line 723, column 13) - _lhsOerrors = - _intraIerrors - -- "GenerateCode.ag"(line 756, column 18) - _lhsOcomments = - let body = map ind (_vssIcomments ++ _intraIcomments) - in if null body - then [] - else ("visit " ++ show _lhsInr ++ ":") : body - -- "GenerateCode.ag"(line 760, column 18) - _vssOwhat = - "local" - -- "GenerateCode.ag"(line 761, column 18) - _intraOwhat = - "intra" - -- "GenerateCode.ag"(line 987, column 7) - _lhsOsemNames = - [_funcname ] - -- copy rule (down) - _vssOallNts = - _lhsIallNts - -- 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) - _vssOunfoldSemDom = - _lhsIunfoldSemDom - -- copy rule (down) - _intraOallNts = - _lhsIallNts - -- 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 - -- copy rule (down) - _intraOunfoldSemDom = - _lhsIunfoldSemDom - ( _vssIallTpsFound,_vssIblockDecls,_vssIcomments,_vssIdecls,_vssIdeclsAbove,_vssIdefinedInsts,_vssIerrors,_vssIexprs,_vssItSigs,_vssItps,_vssIusedVars) = - (vss_ _vssOallNts _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 _vssOunfoldSemDom _vssOwhat ) - ( _intraIallTpsFound,_intraIblockDecls,_intraIcomments,_intraIdecls,_intraIdeclsAbove,_intraIdefinedInsts,_intraIerrors,_intraIexprs,_intraItSigs,_intraItps,_intraIusedVars) = - (intra_ _intraOallNts _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 _intraOunfoldSemDom _intraOwhat ) - in ( _lhsOallTpsFound,_lhsOcomments,_lhsOdecls,_lhsOerrors,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOsemNames))) ) --- CVisits ----------------------------------------------------- -{- - visit 0: - inherited attributes: - allNts : Set NontermIdent - 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 ((Set NontermIdent) -> - 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 {allNts_Inh_CVisits :: !(Set NontermIdent),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 -> - Inh_CVisits -> - Syn_CVisits -wrap_CVisits (T_CVisits sem ) (Inh_CVisits _lhsIallNts _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 _lhsIallNts _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 (\ _lhsIallNts - _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]) - _hdOallNts :: (Set NontermIdent) - _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 - _tlOallNts :: (Set NontermIdent) - _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 216, column 11) - _tlOnr = - _lhsInr + 1 - -- "GenerateCode.ag"(line 229, column 12) - _lhsOisNil = - False - -- "GenerateCode.ag"(line 230, column 12) - _hdOisLast = - _tlIisNil - -- "GenerateCode.ag"(line 247, column 12) - _hdOnextIntra = - _tlIintra - -- "GenerateCode.ag"(line 248, column 12) - _hdOnextIntraVars = - _tlIintraVars - -- "GenerateCode.ag"(line 249, column 12) - _lhsOintra = - _hdIintra - -- "GenerateCode.ag"(line 250, column 12) - _lhsOintraVars = - _hdIintraVars - -- use rule "GenerateCode.ag"(line 706, column 39) - _lhsOallTpsFound = - _hdIallTpsFound && _tlIallTpsFound - -- use rule "GenerateCode.ag"(line 738, column 52) - _lhsOcomments = - _hdIcomments ++ _tlIcomments - -- use rule "GenerateCode.ag"(line 355, column 33) - _lhsOdecls = - _hdIdecls ++ _tlIdecls - -- use rule "GenerateCode.ag"(line 719, column 32) - _lhsOerrors = - _hdIerrors Seq.>< _tlIerrors - -- use rule "GenerateCode.ag"(line 447, column 44) - _lhsOgatherInstVisitNrs = - _hdIgatherInstVisitNrs `Map.union` _tlIgatherInstVisitNrs - -- use rule "GenerateCode.ag"(line 977, column 61) - _lhsOsemNames = - _hdIsemNames ++ _tlIsemNames - -- copy rule (down) - _hdOallNts = - _lhsIallNts - -- 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) - _tlOallNts = - _lhsIallNts - -- 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_ _hdOallNts _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_ _tlOallNts _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 (\ _lhsIallNts - _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 231, column 10) - _lhsOisNil = - True - -- "GenerateCode.ag"(line 251, column 10) - _lhsOintra = - [] - -- "GenerateCode.ag"(line 252, column 10) - _lhsOintraVars = - Set.empty - -- use rule "GenerateCode.ag"(line 706, column 39) - _lhsOallTpsFound = - True - -- use rule "GenerateCode.ag"(line 738, column 52) - _lhsOcomments = - [] - -- use rule "GenerateCode.ag"(line 355, column 33) - _lhsOdecls = - [] - -- use rule "GenerateCode.ag"(line 719, column 32) - _lhsOerrors = - Seq.empty - -- use rule "GenerateCode.ag"(line 447, column 44) - _lhsOgatherInstVisitNrs = - Map.empty - -- use rule "GenerateCode.ag"(line 977, 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 -> - Inh_DeclBlocks -> - Syn_DeclBlocks -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 544, column 7) - _nextOblockNr = - _lhsIblockNr + 1 - -- "GenerateCode.ag"(line 549, column 7) - _lambdaName = - _lhsIprefix ++ "_block" ++ show _lhsIblockNr - -- "GenerateCode.ag"(line 550, column 7) - _pragmaDecl = - PragmaDecl ("NOINLINE " ++ _lambdaName ) - -- "GenerateCode.ag"(line 551, column 7) - _lhsOcallExpr = - App _lambdaName (map SimpleExpr _freeVars ) - -- "GenerateCode.ag"(line 555, column 7) - _freeVars = - freevars _nextIfreeVars (visit_ : defs_) - -- "GenerateCode.ag"(line 562, column 7) - _decl = - mkBlockLambda _lhsIoptCase _lambdaName _freeVars (defs_ ++ [visit_]) _nextIcallExpr - -- "GenerateCode.ag"(line 563, 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 549, column 7) - _lambdaName = - _lhsIprefix ++ "_block" ++ show _lhsIblockNr - -- "GenerateCode.ag"(line 550, column 7) - _pragmaDecl = - PragmaDecl ("NOINLINE " ++ _lambdaName ) - -- "GenerateCode.ag"(line 551, column 7) - _lhsOcallExpr = - App _lambdaName (map SimpleExpr _freeVars ) - -- "GenerateCode.ag"(line 553, column 7) - _freeVars = - freevars _lhsIlastExprVars (defs_ ++ _lhsInextVisitDecls) - -- "GenerateCode.ag"(line 560, 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 -> - Inh_DeclBlocksRoot -> - Syn_DeclBlocksRoot -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 535, column 7) - _lhsOlambdas = - _blocksIdecls - -- "GenerateCode.ag"(line 536, column 7) - _lhsOfirstCall = - _blocksIcallExpr - -- "GenerateCode.ag"(line 541, 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 -> - Inh_Pattern -> - Syn_Pattern -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 197, column 11) - _lhsOdefinedInsts = - (if field_ == _INST then [attr_] else []) ++ _patIdefinedInsts - -- "GenerateCode.ag"(line 205, 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 195, column 55) - _lhsOdefinedInsts = - _patsIdefinedInsts - -- use rule "GenerateCode.ag"(line 202, 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 195, column 55) - _lhsOdefinedInsts = - _patIdefinedInsts - -- use rule "GenerateCode.ag"(line 202, 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 195, column 55) - _lhsOdefinedInsts = - _patsIdefinedInsts - -- use rule "GenerateCode.ag"(line 202, 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 195, column 55) - _lhsOdefinedInsts = - [] - -- use rule "GenerateCode.ag"(line 202, 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 -> - Inh_Patterns -> - Syn_Patterns -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 195, column 55) - _lhsOdefinedInsts = - _hdIdefinedInsts ++ _tlIdefinedInsts - -- use rule "GenerateCode.ag"(line 202, 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 195, column 55) - _lhsOdefinedInsts = - [] - -- use rule "GenerateCode.ag"(line 202, column 47) - _lhsOpatternAttributes = - [] - -- self rule - _copy = - [] - -- self rule - _lhsOcopy = - _copy - in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)) ) --- Sequence ---------------------------------------------------- -{- - visit 0: - inherited attributes: - allNts : Set NontermIdent - 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] - unfoldSemDom : NontermIdent -> Int -> [String] -> Code.Type - 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 ((Set NontermIdent) -> - ([(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]) -> - (NontermIdent -> Int -> [String] -> Code.Type) -> - String -> - ( Bool,DeclBlocks,([String]),Decls,([Decl]),([Identifier]),(Seq Error),Exprs,([Decl]),([Type]),(Set String))) -data Inh_Sequence = Inh_Sequence {allNts_Inh_Sequence :: !(Set NontermIdent),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]),unfoldSemDom_Inh_Sequence :: !(NontermIdent -> Int -> [String] -> Code.Type),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 -> - Inh_Sequence -> - Syn_Sequence -wrap_Sequence (T_Sequence sem ) (Inh_Sequence _lhsIallNts _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 _lhsIunfoldSemDom _lhsIwhat ) = - (let ( _lhsOallTpsFound,_lhsOblockDecls,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOerrors,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars) = - (sem _lhsIallNts _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 _lhsIunfoldSemDom _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 (\ _lhsIallNts - _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 - _lhsIunfoldSemDom - _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]) - _hdOallNts :: (Set NontermIdent) - _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]) - _hdOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) - _hdOwhat :: String - _tlOallNts :: (Set NontermIdent) - _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]) - _tlOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) - _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 476, column 7) - _lhsOblockDecls = - _hdIbldBlocksFun _tlIblockDecls - -- use rule "GenerateCode.ag"(line 344, column 39) - _lhsOallTpsFound = - _hdIallTpsFound && _tlIallTpsFound - -- use rule "GenerateCode.ag"(line 738, column 52) - _lhsOcomments = - _hdIcomments ++ _tlIcomments - -- use rule "GenerateCode.ag"(line 138, column 34) - _lhsOdecls = - _hdIdecls ++ _tlIdecls - -- use rule "GenerateCode.ag"(line 195, column 55) - _lhsOdefinedInsts = - _hdIdefinedInsts ++ _tlIdefinedInsts - -- use rule "GenerateCode.ag"(line 719, column 32) - _lhsOerrors = - _hdIerrors Seq.>< _tlIerrors - -- use rule "GenerateCode.ag"(line 268, column 34) - _lhsOexprs = - _hdIexprs ++ _tlIexprs - -- use rule "GenerateCode.ag"(line 297, column 33) - _lhsOtSigs = - _hdItSigs ++ _tlItSigs - -- use rule "GenerateCode.ag"(line 343, column 31) - _lhsOtps = - _hdItps ++ _tlItps - -- use rule "GenerateCode.ag"(line 286, column 37) - _lhsOusedVars = - _hdIusedVars `Set.union` _tlIusedVars - -- copy rule (up) - _lhsOdeclsAbove = - _tlIdeclsAbove - -- copy rule (down) - _hdOallNts = - _lhsIallNts - -- 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) - _hdOunfoldSemDom = - _lhsIunfoldSemDom - -- copy rule (down) - _hdOwhat = - _lhsIwhat - -- copy rule (down) - _tlOallNts = - _lhsIallNts - -- 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) - _tlOunfoldSemDom = - _lhsIunfoldSemDom - -- copy rule (down) - _tlOwhat = - _lhsIwhat - ( _hdIallTpsFound,_hdIbldBlocksFun,_hdIcomments,_hdIdecls,_hdIdeclsAbove,_hdIdefinedInsts,_hdIerrors,_hdIexprs,_hdItSigs,_hdItps,_hdIusedVars) = - (hd_ _hdOallNts _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 _hdOunfoldSemDom _hdOwhat ) - ( _tlIallTpsFound,_tlIblockDecls,_tlIcomments,_tlIdecls,_tlIdeclsAbove,_tlIdefinedInsts,_tlIerrors,_tlIexprs,_tlItSigs,_tlItps,_tlIusedVars) = - (tl_ _tlOallNts _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 _tlOunfoldSemDom _tlOwhat ) - in ( _lhsOallTpsFound,_lhsOblockDecls,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOerrors,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars))) ) -sem_Sequence_Nil :: T_Sequence -sem_Sequence_Nil = - (T_Sequence (\ _lhsIallNts - _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 - _lhsIunfoldSemDom - _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 478, column 7) - _lhsOblockDecls = - DeclTerminator _lhsIdeclsAbove _lhsIlastExpr - -- use rule "GenerateCode.ag"(line 344, column 39) - _lhsOallTpsFound = - True - -- use rule "GenerateCode.ag"(line 738, column 52) - _lhsOcomments = - [] - -- use rule "GenerateCode.ag"(line 138, column 34) - _lhsOdecls = - [] - -- use rule "GenerateCode.ag"(line 195, column 55) - _lhsOdefinedInsts = - [] - -- use rule "GenerateCode.ag"(line 719, column 32) - _lhsOerrors = - Seq.empty - -- use rule "GenerateCode.ag"(line 268, column 34) - _lhsOexprs = - [] - -- use rule "GenerateCode.ag"(line 297, column 33) - _lhsOtSigs = - [] - -- use rule "GenerateCode.ag"(line 343, column 31) - _lhsOtps = - [] - -- use rule "GenerateCode.ag"(line 286, column 37) - _lhsOusedVars = - Set.empty - -- copy rule (chain) - _lhsOdeclsAbove = - _lhsIdeclsAbove +++-- UUAGC 0.9.12 (GenerateCode.ag)+module GenerateCode where++import CommonTypes+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 Data.Sequence as Seq+import Data.Sequence(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+ = r+ where+ r 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++ntOfVisit :: NontermIdent -> Int -> NontermIdent+ntOfVisit nt 0 = nt+ntOfVisit nt n = Ident (show nt ++ "_" ++ show n) (getPos nt)++-- 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 ->+ Inh_CGrammar ->+ Syn_CGrammar +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+ _nontsOallNts :: (Set NontermIdent)+ _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)+ _nontsIgathNts :: (Set NontermIdent)+ _nontsIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type))+ -- "GenerateCode.ag"(line 50, column 17)+ _nontsOo_sig =+ typeSigs _lhsIoptions+ -- "GenerateCode.ag"(line 50, column 17)+ _nontsOo_cata =+ folds _lhsIoptions+ -- "GenerateCode.ag"(line 50, column 17)+ _nontsOo_sem =+ semfuns _lhsIoptions+ -- "GenerateCode.ag"(line 50, column 17)+ _nontsOo_newtypes =+ newtypes _lhsIoptions+ -- "GenerateCode.ag"(line 50, column 17)+ _nontsOo_unbox =+ unbox _lhsIoptions+ -- "GenerateCode.ag"(line 50, column 17)+ _nontsOo_case =+ cases _lhsIoptions+ -- "GenerateCode.ag"(line 50, column 17)+ _nontsOo_pretty =+ attrInfo _lhsIoptions+ -- "GenerateCode.ag"(line 50, column 17)+ _nontsOo_rename =+ rename _lhsIoptions+ -- "GenerateCode.ag"(line 50, column 17)+ _nontsOo_strictwrap =+ strictWrap _lhsIoptions+ -- "GenerateCode.ag"(line 50, column 17)+ _nontsOo_splitsems =+ splitSems _lhsIoptions+ -- "GenerateCode.ag"(line 50, column 17)+ _nontsOo_data =+ if dataTypes _lhsIoptions then Just (strictData _lhsIoptions) else Nothing+ -- "GenerateCode.ag"(line 50, column 17)+ _nontsOprefix =+ prefix _lhsIoptions+ -- "GenerateCode.ag"(line 50, column 17)+ _nontsOo_traces =+ genTraces _lhsIoptions+ -- "GenerateCode.ag"(line 50, column 17)+ _nontsOo_costcentre =+ genCostCentres _lhsIoptions+ -- "GenerateCode.ag"(line 50, column 17)+ _nontsOo_linePragmas =+ genLinePragmas _lhsIoptions+ -- "GenerateCode.ag"(line 69, column 15)+ _nontsOallPragmas =+ pragmas_+ -- "GenerateCode.ag"(line 91, column 14)+ _nontsOparamMap =+ paramMap_+ -- "GenerateCode.ag"(line 112, column 7)+ _nontsOcontextMap =+ contextMap_+ -- "GenerateCode.ag"(line 124, column 7)+ _nontsOallNts =+ _nontsIgathNts+ -- "GenerateCode.ag"(line 621, column 7)+ _unfoldSemDom =+ \nt nr repl ->+ let (params, tp) = Map.findWithDefault (error ("No such semantic domain: " ++ show nt)) (nt, nr) _nontsIsemDomUnfoldGath+ replMap = Map.fromList (zip params repl)+ replace k = Map.findWithDefault ('@':k) k replMap+ in evalType replace tp+ -- "GenerateCode.ag"(line 714, column 14)+ _nontsOwith_sig =+ typeSigs _lhsIoptions && _nontsIallTpsFound+ -- "GenerateCode.ag"(line 721, column 15)+ _nontsOerrors =+ Seq.empty+ -- "GenerateCode.ag"(line 785, column 17)+ _lhsOoutput =+ Program _nontsIchunks+ -- "GenerateCode.ag"(line 838, column 14)+ _nontsOtypeSyns =+ typeSyns_+ -- "GenerateCode.ag"(line 838, column 14)+ _nontsOderivings =+ derivings_+ -- "GenerateCode.ag"(line 838, column 14)+ _nontsOwrappers =+ wrappers_+ -- copy rule (up)+ _lhsOerrors =+ _nontsIerrors+ -- copy rule (from local)+ _nontsOunfoldSemDom =+ _unfoldSemDom+ ( _nontsIallTpsFound,_nontsIchunks,_nontsIerrors,_nontsIgathNts,_nontsIsemDomUnfoldGath) =+ (nonts_ _nontsOallNts _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 ->+ Inh_CInterface ->+ Syn_CInterface +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 218, column 17)+ _segOnr =+ 0+ -- "GenerateCode.ag"(line 594, column 18)+ _lhsOsemDom =+ Comment "semantic domain" : _segIsemDom+ -- use rule "GenerateCode.ag"(line 738, column 52)+ _lhsOcomments =+ _segIcomments+ -- use rule "GenerateCode.ag"(line 611, column 86)+ _lhsOsemDomUnfoldGath =+ _segIsemDomUnfoldGath+ -- use rule "GenerateCode.ag"(line 687, 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:+ allNts : Set NontermIdent+ 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+ gathNts : Set NontermIdent+ 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 ((Set NontermIdent) ->+ 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),(Set NontermIdent),(Map (NontermIdent, Int) ([String], Code.Type))))+data Inh_CNonterminal = Inh_CNonterminal {allNts_Inh_CNonterminal :: !(Set NontermIdent),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),gathNts_Syn_CNonterminal :: !(Set NontermIdent),semDomUnfoldGath_Syn_CNonterminal :: !(Map (NontermIdent, Int) ([String], Code.Type))}+wrap_CNonterminal :: T_CNonterminal ->+ Inh_CNonterminal ->+ Syn_CNonterminal +wrap_CNonterminal (T_CNonterminal sem ) (Inh_CNonterminal _lhsIallNts _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,_lhsOgathNts,_lhsOsemDomUnfoldGath) =+ (sem _lhsIallNts _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 _lhsOgathNts _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 (\ _lhsIallNts+ _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+ _lhsOgathNts :: (Set NontermIdent)+ _lhsOchunks :: Chunks+ _lhsOallTpsFound :: Bool+ _lhsOerrors :: (Seq Error)+ _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type))+ _prodsOallNts :: (Set NontermIdent)+ _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 79, column 26)+ __tup1 =+ (inh_,syn_,nt_)+ -- "GenerateCode.ag"(line 79, column 26)+ (_interOinh,_,_) =+ __tup1+ -- "GenerateCode.ag"(line 79, column 26)+ (_,_interOsyn,_) =+ __tup1+ -- "GenerateCode.ag"(line 79, column 26)+ (_,_,_interOnt) =+ __tup1+ -- "GenerateCode.ag"(line 80, column 25)+ __tup2 =+ (inh_,syn_,nt_)+ -- "GenerateCode.ag"(line 80, column 25)+ (_prodsOinh,_,_) =+ __tup2+ -- "GenerateCode.ag"(line 80, column 25)+ (_,_prodsOsyn,_) =+ __tup2+ -- "GenerateCode.ag"(line 80, column 25)+ (_,_,_prodsOnt) =+ __tup2+ -- "GenerateCode.ag"(line 130, column 7)+ _lhsOgathNts =+ Set.singleton nt_+ -- "GenerateCode.ag"(line 659, 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 734, column 18)+ _comment =+ Comment . unlines . map ind $ ( _interIcomments ++ ("alternatives:" : map ind _prodsIcomments) )+ -- "GenerateCode.ag"(line 788, 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 843, 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.Either t1 t2 -> SimpleType ("Either (" ++ typeToHaskellString (Just nt_) params' t1 ++") ("+ ++ typeToHaskellString (Just nt_) params' t2 ++")")+ CommonTypes.Map t1 t2 -> SimpleType ("Map (" ++ typeToHaskellString (Just nt_) params' t1 ++") ("+ ++ typeToHaskellString (Just nt_) params' t2 ++")")+ CommonTypes.IntMap t -> SimpleType ("IntMap (" ++ 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' (idEvalType 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 877, 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.Either tp1 tp2 ->+ let left = semname _lhsIprefix nt_ (identifier "Left")+ right = semname _lhsIprefix nt_ (identifier "Right" )+ arg = SimpleExpr "x"+ rarg0 = case tp1 of+ NT t _ -> App (cataname _lhsIprefix t) [arg]+ _ -> arg+ rarg1 = case tp2 of+ NT t _ -> App (cataname _lhsIprefix t) [arg]+ _ -> arg+ lhs a = Fun (cataname _lhsIprefix nt_) [a]+ in [Decl (lhs (App "Prelude.Left" [arg])) (App left [rarg0]) Set.empty Set.empty+ ,Decl (lhs (App "Prelude.Right" [arg])) (App right [rarg1]) Set.empty Set.empty+ ]+ CommonTypes.Map _ tp ->+ let entry = SimpleExpr (semname _lhsIprefix nt_ (identifier "Entry"))+ nil = SimpleExpr (semname _lhsIprefix nt_ (identifier "Nil"))+ arg = SimpleExpr "m"+ rarg = case tp of+ NT t _ -> App "Map.map" [SimpleExpr $ cataname _lhsIprefix t, arg]+ _ -> arg+ lhs = Fun (cataname _lhsIprefix nt_) [arg]+ rhs = App "Map.foldWithKey" [entry,nil,rarg]+ in [Decl lhs rhs Set.empty Set.empty]+ CommonTypes.IntMap tp ->+ let entry = SimpleExpr (semname _lhsIprefix nt_ (identifier "Entry"))+ nil = SimpleExpr (semname _lhsIprefix nt_ (identifier "Nil"))+ arg = SimpleExpr "m"+ rarg = case tp of+ NT t _ -> App "IntMap.map" [SimpleExpr $ cataname _lhsIprefix t, arg]+ _ -> arg+ lhs = Fun (cataname _lhsIprefix nt_) [arg]+ rhs = App "IntMap.foldWithKey" [entry,nil,rarg]+ in [Decl lhs rhs 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 706, column 39)+ _lhsOallTpsFound =+ _prodsIallTpsFound+ -- use rule "GenerateCode.ag"(line 719, column 32)+ _lhsOerrors =+ _prodsIerrors+ -- use rule "GenerateCode.ag"(line 611, column 86)+ _lhsOsemDomUnfoldGath =+ _interIsemDomUnfoldGath+ -- copy rule (down)+ _prodsOallNts =+ _lhsIallNts+ -- 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_ _prodsOallNts _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,_lhsOgathNts,_lhsOsemDomUnfoldGath))) )+-- CNonterminals -----------------------------------------------+{-+ visit 0:+ inherited attributes:+ allNts : Set NontermIdent+ 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+ gathNts : Set NontermIdent+ 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 ((Set NontermIdent) ->+ 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),(Set NontermIdent),(Map (NontermIdent, Int) ([String], Code.Type))))+data Inh_CNonterminals = Inh_CNonterminals {allNts_Inh_CNonterminals :: !(Set NontermIdent),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),gathNts_Syn_CNonterminals :: !(Set NontermIdent),semDomUnfoldGath_Syn_CNonterminals :: !(Map (NontermIdent, Int) ([String], Code.Type))}+wrap_CNonterminals :: T_CNonterminals ->+ Inh_CNonterminals ->+ Syn_CNonterminals +wrap_CNonterminals (T_CNonterminals sem ) (Inh_CNonterminals _lhsIallNts _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,_lhsOgathNts,_lhsOsemDomUnfoldGath) =+ (sem _lhsIallNts _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 _lhsOgathNts _lhsOsemDomUnfoldGath ))+sem_CNonterminals_Cons :: T_CNonterminal ->+ T_CNonterminals ->+ T_CNonterminals +sem_CNonterminals_Cons (T_CNonterminal hd_ ) (T_CNonterminals tl_ ) =+ (T_CNonterminals (\ _lhsIallNts+ _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)+ _lhsOgathNts :: (Set NontermIdent)+ _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type))+ _hdOallNts :: (Set NontermIdent)+ _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)+ _tlOallNts :: (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)+ _hdIgathNts :: (Set NontermIdent)+ _hdIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type))+ _tlIallTpsFound :: Bool+ _tlIchunks :: Chunks+ _tlIerrors :: (Seq Error)+ _tlIgathNts :: (Set NontermIdent)+ _tlIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type))+ -- use rule "GenerateCode.ag"(line 706, column 39)+ _lhsOallTpsFound =+ _hdIallTpsFound && _tlIallTpsFound+ -- use rule "GenerateCode.ag"(line 780, column 49)+ _lhsOchunks =+ _hdIchunks ++ _tlIchunks+ -- use rule "GenerateCode.ag"(line 719, column 32)+ _lhsOerrors =+ _hdIerrors Seq.>< _tlIerrors+ -- use rule "GenerateCode.ag"(line 126, column 47)+ _lhsOgathNts =+ _hdIgathNts `Set.union` _tlIgathNts+ -- use rule "GenerateCode.ag"(line 611, column 86)+ _lhsOsemDomUnfoldGath =+ _hdIsemDomUnfoldGath `Map.union` _tlIsemDomUnfoldGath+ -- copy rule (down)+ _hdOallNts =+ _lhsIallNts+ -- 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)+ _tlOallNts =+ _lhsIallNts+ -- 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,_hdIgathNts,_hdIsemDomUnfoldGath) =+ (hd_ _hdOallNts _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,_tlIgathNts,_tlIsemDomUnfoldGath) =+ (tl_ _tlOallNts _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,_lhsOgathNts,_lhsOsemDomUnfoldGath))) )+sem_CNonterminals_Nil :: T_CNonterminals +sem_CNonterminals_Nil =+ (T_CNonterminals (\ _lhsIallNts+ _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)+ _lhsOgathNts :: (Set NontermIdent)+ _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type))+ -- use rule "GenerateCode.ag"(line 706, column 39)+ _lhsOallTpsFound =+ True+ -- use rule "GenerateCode.ag"(line 780, column 49)+ _lhsOchunks =+ []+ -- use rule "GenerateCode.ag"(line 719, column 32)+ _lhsOerrors =+ Seq.empty+ -- use rule "GenerateCode.ag"(line 126, column 47)+ _lhsOgathNts =+ Set.empty+ -- use rule "GenerateCode.ag"(line 611, column 86)+ _lhsOsemDomUnfoldGath =+ Map.empty+ in ( _lhsOallTpsFound,_lhsOchunks,_lhsOerrors,_lhsOgathNts,_lhsOsemDomUnfoldGath))) )+-- CProduction -------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allNts : Set NontermIdent+ 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 ((Set NontermIdent) ->+ 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 {allNts_Inh_CProduction :: !(Set NontermIdent),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 ->+ Inh_CProduction ->+ Syn_CProduction +wrap_CProduction (T_CProduction sem ) (Inh_CProduction _lhsIallNts _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 _lhsIallNts _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 (\ _lhsIallNts+ _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])+ _visitsOallNts :: (Set NontermIdent)+ _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 85, column 19)+ _visitsOcon =+ con_+ -- "GenerateCode.ag"(line 86, column 20)+ _visitsOterminals =+ terminals_+ -- "GenerateCode.ag"(line 98, column 7)+ _paramInstMap =+ Map.fromList [(nm, (extractNonterminal tp, tps)) | (nm,tp,_) <- children_, let tps = map cleanupArg $ nontermArgs tp, not (null tps) ]+ -- "GenerateCode.ag"(line 214, column 18)+ _visitsOnr =+ 0+ -- "GenerateCode.ag"(line 340, column 18)+ _visitsOchildren =+ children_+ -- "GenerateCode.ag"(line 450, column 7)+ _visitsOinstVisitNrs =+ _visitsIgatherInstVisitNrs+ -- "GenerateCode.ag"(line 749, column 17)+ _firstOrderChildren =+ filter (\(_,_,ho) -> not ho) children_+ -- "GenerateCode.ag"(line 750, column 18)+ _lhsOcomments =+ ("alternative " ++ getName con_ ++ ":")+ : map ind ( map (\(x,y,_) -> makeLocalComment 14 "child" x (Just y)) _firstOrderChildren+ ++ _visitsIcomments+ )+ -- "GenerateCode.ag"(line 869, column 17)+ _params =+ map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap+ -- "GenerateCode.ag"(line 870, column 17)+ _lhsOdataAlt =+ DataAlt (conname _lhsIo_rename _lhsInt con_) (map (\(_,t,_) -> typeToHaskellString (Just _lhsInt) _params t) _firstOrderChildren )+ -- "GenerateCode.ag"(line 962, 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 706, column 39)+ _lhsOallTpsFound =+ _visitsIallTpsFound+ -- use rule "GenerateCode.ag"(line 781, column 44)+ _lhsOdecls =+ _visitsIdecls+ -- use rule "GenerateCode.ag"(line 719, column 32)+ _lhsOerrors =+ _visitsIerrors+ -- use rule "GenerateCode.ag"(line 977, column 61)+ _lhsOsemNames =+ _visitsIsemNames+ -- copy rule (down)+ _visitsOallNts =+ _lhsIallNts+ -- 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_ _visitsOallNts _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:+ allNts : Set NontermIdent+ 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 ((Set NontermIdent) ->+ 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 {allNts_Inh_CProductions :: !(Set NontermIdent),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 ->+ Inh_CProductions ->+ Syn_CProductions +wrap_CProductions (T_CProductions sem ) (Inh_CProductions _lhsIallNts _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 _lhsIallNts _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 (\ _lhsIallNts+ _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])+ _hdOallNts :: (Set NontermIdent)+ _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+ _tlOallNts :: (Set NontermIdent)+ _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 865, column 17)+ _lhsOdataAlts =+ _hdIdataAlt : _tlIdataAlts+ -- "GenerateCode.ag"(line 958, column 10)+ _lhsOcataAlts =+ _hdIcataAlt : _tlIcataAlts+ -- use rule "GenerateCode.ag"(line 706, column 39)+ _lhsOallTpsFound =+ _hdIallTpsFound && _tlIallTpsFound+ -- use rule "GenerateCode.ag"(line 738, column 52)+ _lhsOcomments =+ _hdIcomments ++ _tlIcomments+ -- use rule "GenerateCode.ag"(line 781, column 44)+ _lhsOdecls =+ _hdIdecls ++ _tlIdecls+ -- use rule "GenerateCode.ag"(line 719, column 32)+ _lhsOerrors =+ _hdIerrors Seq.>< _tlIerrors+ -- use rule "GenerateCode.ag"(line 977, column 61)+ _lhsOsemNames =+ _hdIsemNames ++ _tlIsemNames+ -- copy rule (down)+ _hdOallNts =+ _lhsIallNts+ -- 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)+ _tlOallNts =+ _lhsIallNts+ -- 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_ _hdOallNts _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_ _tlOallNts _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 (\ _lhsIallNts+ _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 866, column 17)+ _lhsOdataAlts =+ []+ -- "GenerateCode.ag"(line 959, column 10)+ _lhsOcataAlts =+ []+ -- use rule "GenerateCode.ag"(line 706, column 39)+ _lhsOallTpsFound =+ True+ -- use rule "GenerateCode.ag"(line 738, column 52)+ _lhsOcomments =+ []+ -- use rule "GenerateCode.ag"(line 781, column 44)+ _lhsOdecls =+ []+ -- use rule "GenerateCode.ag"(line 719, column 32)+ _lhsOerrors =+ Seq.empty+ -- use rule "GenerateCode.ag"(line 977, column 61)+ _lhsOsemNames =+ []+ in ( _lhsOallTpsFound,_lhsOcataAlts,_lhsOcomments,_lhsOdataAlts,_lhsOdecls,_lhsOerrors,_lhsOsemNames))) )+-- CRule -------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allNts : Set NontermIdent+ 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]+ unfoldSemDom : NontermIdent -> Int -> [String] -> Code.Type+ 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 rulename : _+ 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 ((Set NontermIdent) ->+ ([(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]) ->+ (NontermIdent -> Int -> [String] -> Code.Type) ->+ String ->+ ( Bool,(DeclBlocks -> DeclBlocks),([String]),Decls,([Decl]),([Identifier]),(Seq Error),Exprs,([Decl]),([Type]),(Set String)))+data Inh_CRule = Inh_CRule {allNts_Inh_CRule :: !(Set NontermIdent),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]),unfoldSemDom_Inh_CRule :: !(NontermIdent -> Int -> [String] -> Code.Type),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 ->+ Inh_CRule ->+ Syn_CRule +wrap_CRule (T_CRule sem ) (Inh_CRule _lhsIallNts _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 _lhsIunfoldSemDom _lhsIwhat ) =+ (let ( _lhsOallTpsFound,_lhsObldBlocksFun,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOerrors,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars) =+ (sem _lhsIallNts _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 _lhsIunfoldSemDom _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 (\ _lhsIallNts+ _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+ _lhsIunfoldSemDom+ _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 181, column 18)+ _costCentreDescr =+ show _lhsInt ++ ":" ++ show _lhsIcon ++ ":" ++ show name_ ++ ":" ++ show nt_ ++ ":" ++ show nr_+ -- "GenerateCode.ag"(line 182, column 18)+ _addCostCentre =+ \v -> if _lhsIo_costcentre+ then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v+ else v+ -- "GenerateCode.ag"(line 185, 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 261, column 7)+ _isSuperfluousHigherOrderIntra =+ _lhsInr <= Map.findWithDefault (-1) name_ _lhsIinstVisitNrs+ -- "GenerateCode.ag"(line 275, column 8)+ _names =+ if _isSuperfluousHigherOrderIntra+ then []+ else [funname name_ (nr_+1)]+ -- "GenerateCode.ag"(line 279, column 8)+ _lhsOexprs =+ let wrap = if _lhsIo_newtypes then \x -> App (typeName nt_ (nr_ + 1)) [x] else id+ addType expr | null _instParams = expr+ | otherwise = TypedExpr expr (_lhsIunfoldSemDom nt_ (nr_+1) _instParams )+ in map (wrap . addType . SimpleExpr) _names+ -- "GenerateCode.ag"(line 291, column 7)+ _lhsOusedVars =+ Set.fromList _names+ -- "GenerateCode.ag"(line 315, column 19)+ _mkTp =+ _evalTp . SimpleType . typeToHaskellString (Just nt_) _orgParams+ -- "GenerateCode.ag"(line 316, column 19)+ _definedTps =+ [ TSig (attrname True name_ a) (_mkTp tp) | (a,tp) <- Map.toList syn_ ]+ -- "GenerateCode.ag"(line 317, column 19)+ _nextTp =+ typeName nt_ (nr_+1)+ -- "GenerateCode.ag"(line 318, column 19)+ _lhsOtSigs =+ (if isLast_ then id else (TSig (funname name_ (nr_+1)) (TypeApp (SimpleType _nextTp) (map SimpleType _instParams )) :)) _definedTps+ -- "GenerateCode.ag"(line 320, column 19)+ _orgParams =+ map getName $ Map.findWithDefault [] nt_ _lhsIparamMap+ -- "GenerateCode.ag"(line 321, column 19)+ _instParams =+ snd $ Map.findWithDefault (nt_,[]) name_ _lhsIparamInstMap+ -- "GenerateCode.ag"(line 322, column 19)+ _replParamMap =+ Map.fromList (zip _orgParams _instParams )+ -- "GenerateCode.ag"(line 323, column 19)+ _replace =+ \k -> Map.findWithDefault k k _replParamMap+ -- "GenerateCode.ag"(line 324, column 19)+ _evalTp =+ if null _orgParams then id else evalType _replace+ -- "GenerateCode.ag"(line 347, column 19)+ _lhsOtps =+ if _isSuperfluousHigherOrderIntra+ then []+ else [NT (ntOfVisit nt_ (nr_+1)) _instParams ]+ -- "GenerateCode.ag"(line 472, column 7)+ _lhsOdeclsAbove =+ []+ -- "GenerateCode.ag"(line 485, column 7)+ _lhsObldBlocksFun =+ DeclBlock _lhsIdeclsAbove (head _decls )+ -- use rule "GenerateCode.ag"(line 344, column 39)+ _lhsOallTpsFound =+ True+ -- use rule "GenerateCode.ag"(line 738, column 52)+ _lhsOcomments =+ []+ -- use rule "GenerateCode.ag"(line 138, column 34)+ _lhsOdecls =+ _decls+ -- use rule "GenerateCode.ag"(line 195, column 55)+ _lhsOdefinedInsts =+ []+ -- use rule "GenerateCode.ag"(line 719, 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 (\ _lhsIallNts+ _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+ _lhsIunfoldSemDom+ _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 140, column 12)+ _instTypes =+ map (\(n,NT t _,_) -> (n,t)) _lhsIhigherOrderChildren+ -- "GenerateCode.ag"(line 141, column 12)+ _originComment =+ if _lhsIo_pretty+ then (Comment origin_:)+ else id+ -- "GenerateCode.ag"(line 144, column 12)+ _instDecls =+ [ Decl (Pattern3 (Alias _INST' inst (Underscore (getPos inst)) []))+ ( let nm = fromJust $ inst `lookup` _instTypes+ in case nm `Set.member` _lhsIallNts of+ True -> App (cataname _lhsIprefix nm)+ [SimpleExpr instLocFieldName]+ False -> 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 156, column 12)+ _patDescr =+ if isIn_+ then "_"+ else concat $ intersperse "," (map (\(f,a) -> show f ++ "." ++ show a) _patternIpatternAttributes)+ -- "GenerateCode.ag"(line 159, column 12)+ _traceDescr =+ show nt_ ++ " :: " ++ show con_ ++ " :: " ++ _patDescr+ -- "GenerateCode.ag"(line 161, column 12)+ _addTrace =+ \v -> if _lhsIo_traces+ then Trace _traceDescr v+ else v+ -- "GenerateCode.ag"(line 164, column 12)+ _costCentreDescr =+ show nt_ ++ ":" ++ show con_ ++ ":" ++ _patDescr+ -- "GenerateCode.ag"(line 165, column 12)+ _addCostCentre =+ \v -> if _lhsIo_costcentre+ then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v+ else v+ -- "GenerateCode.ag"(line 168, 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 175, 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 200, column 12)+ _definedInsts =+ if isIn_ then [] else _patternIdefinedInsts+ -- "GenerateCode.ag"(line 270, column 12)+ _rulename =+ if field_ == _LOC && name_ `elem` _lhsIterminals+ then funname name_ 0+ else attrname isIn_ field_ name_+ -- "GenerateCode.ag"(line 273, column 12)+ _lhsOexprs =+ [SimpleExpr _rulename ]+ -- "GenerateCode.ag"(line 289, column 7)+ _lhsOusedVars =+ Set.singleton _rulename+ -- "GenerateCode.ag"(line 299, column 19)+ _mkTp =+ SimpleType . typeToHaskellString (Just _lhsInt) _orgParams+ -- "GenerateCode.ag"(line 300, column 19)+ _lhsOtSigs =+ [ TSig (attrname False field attr) (_evalTp field $ _mkTp (fromJust tp))+ | (field,attr,tp) <- Map.elems defines_, isJust tp ]+ -- "GenerateCode.ag"(line 303, column 19)+ _orgParams =+ map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap+ -- "GenerateCode.ag"(line 304, 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 346, column 23)+ __tup3 =+ maybe ([],False) (\tp -> ([substSelf (fromJust childnt_) tp],True)) tp_+ -- "GenerateCode.ag"(line 346, column 23)+ (_lhsOtps,_) =+ __tup3+ -- "GenerateCode.ag"(line 346, column 23)+ (_,_lhsOallTpsFound) =+ __tup3+ -- "GenerateCode.ag"(line 470, column 7)+ _lhsOdeclsAbove =+ _lhsIdeclsAbove ++ _decls+ -- "GenerateCode.ag"(line 483, column 7)+ _lhsObldBlocksFun =+ id+ -- "GenerateCode.ag"(line 725, column 12)+ _lhsOerrors =+ let nameOf (Alias _ _ _ pats@(_:_)) = Ident (show (map (\(Alias _ a _ _)->a) pats)) (getPos name_)+ nameOf _ = name_+ in maybe (Seq.singleton (MissingTypeSig _lhsInt _lhsIcon (nameOf _patternIcopy))) (const Seq.empty) tp_+ -- "GenerateCode.ag"(line 765, 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 138, column 34)+ _lhsOdecls =+ _decls+ -- use rule "GenerateCode.ag"(line 195, 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 ->+ Inh_CSegment ->+ Syn_CSegment +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 597, column 15)+ _tp =+ foldr Arr _synTps _inhTps+ -- "GenerateCode.ag"(line 598, column 15)+ _inhTps =+ [SimpleType (typeToHaskellString (Just _lhsInt) _params tp) | tp <- Map.elems inh_]+ -- "GenerateCode.ag"(line 599, column 15)+ _synTps =+ mkTupleType _lhsIo_unbox (null _inhTps ) ([SimpleType (typeToHaskellString (Just _lhsInt) _params tp) | tp <- Map.elems syn_] ++ _continuation )+ -- "GenerateCode.ag"(line 600, column 15)+ _continuation =+ if _lhsIisLast+ then []+ else [TypeApp (SimpleType (typeName _lhsInt (_lhsInr + 1))) (map (SimpleType . ('@':)) _params )]+ -- "GenerateCode.ag"(line 603, column 15)+ _params =+ map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap+ -- "GenerateCode.ag"(line 604, 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 615, column 7)+ _lhsOsemDomUnfoldGath =+ Map.singleton (_lhsInt, _lhsInr) (_params , _tp )+ -- "GenerateCode.ag"(line 689, 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 743, 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 ->+ Inh_CSegments ->+ Syn_CSegments +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 220, column 11)+ _tlOnr =+ _lhsInr + 1+ -- "GenerateCode.ag"(line 233, column 12)+ _lhsOisNil =+ False+ -- "GenerateCode.ag"(line 234, column 12)+ _hdOisLast =+ _tlIisNil+ -- use rule "GenerateCode.ag"(line 738, column 52)+ _lhsOcomments =+ _hdIcomments ++ _tlIcomments+ -- use rule "GenerateCode.ag"(line 592, column 50)+ _lhsOsemDom =+ _hdIsemDom ++ _tlIsemDom+ -- use rule "GenerateCode.ag"(line 611, column 86)+ _lhsOsemDomUnfoldGath =+ _hdIsemDomUnfoldGath `Map.union` _tlIsemDomUnfoldGath+ -- use rule "GenerateCode.ag"(line 687, 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 235, column 10)+ _lhsOisNil =+ True+ -- use rule "GenerateCode.ag"(line 738, column 52)+ _lhsOcomments =+ []+ -- use rule "GenerateCode.ag"(line 592, column 50)+ _lhsOsemDom =+ []+ -- use rule "GenerateCode.ag"(line 611, column 86)+ _lhsOsemDomUnfoldGath =+ Map.empty+ -- use rule "GenerateCode.ag"(line 687, column 52)+ _lhsOwrapDecls =+ []+ in ( _lhsOcomments,_lhsOisNil,_lhsOsemDom,_lhsOsemDomUnfoldGath,_lhsOwrapDecls))) )+-- CVisit ------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allNts : Set NontermIdent+ 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 ((Set NontermIdent) ->+ 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 {allNts_Inh_CVisit :: !(Set NontermIdent),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 ->+ Inh_CVisit ->+ Syn_CVisit +wrap_CVisit (T_CVisit sem ) (Inh_CVisit _lhsIallNts _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 _lhsIallNts _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 (\ _lhsIallNts+ _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])+ _vssOallNts :: (Set NontermIdent)+ _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])+ _vssOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type)+ _intraOallNts :: (Set NontermIdent)+ _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])+ _intraOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type)+ _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 244, column 13)+ _lhsOintra =+ _intraIexprs+ -- "GenerateCode.ag"(line 245, column 13)+ _lhsOintraVars =+ _intraIusedVars+ -- "GenerateCode.ag"(line 357, column 13)+ __tup4 =+ partition (\(_,_,ho) -> ho) _lhsIchildren+ -- "GenerateCode.ag"(line 357, column 13)+ (_higherOrderChildren,_) =+ __tup4+ -- "GenerateCode.ag"(line 357, column 13)+ (_,_firstOrderChildren) =+ __tup4+ -- "GenerateCode.ag"(line 358, column 13)+ _funcname =+ seqSemname _lhsIprefix _lhsInt _lhsIcon _lhsInr+ -- "GenerateCode.ag"(line 359, column 13)+ _nextVisitName =+ if _lhsIisLast then [] else [visitname _lhsIprefix _lhsInt (_lhsInr+1)]+ -- "GenerateCode.ag"(line 360, 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 366, column 13)+ _decls =+ _typeSigs ++ _vssIdecls ++ _nextVisitDecl+ -- "GenerateCode.ag"(line 367, column 13)+ _vssOlastExpr =+ mkTupleExpr _lhsIo_unbox (null $ Map.keys inh_) $ map (SimpleExpr . lhsname False) (Map.keys syn_) ++ map SimpleExpr _nextVisitName+ -- "GenerateCode.ag"(line 368, column 13)+ _intraOlastExpr =+ error "lastExpr: not used here"+ -- "GenerateCode.ag"(line 369, column 13)+ _lastExprVars =+ map (lhsname False) (Map.keys syn_) ++ _nextVisitName+ -- "GenerateCode.ag"(line 370, column 13)+ __tup5 =+ mkPartitionedFunction _funcname _o_case _nextVisitDecl _lastExprVars _vssIblockDecls+ -- "GenerateCode.ag"(line 370, column 13)+ (_blockFunDecls,_) =+ __tup5+ -- "GenerateCode.ag"(line 370, column 13)+ (_,_blockFirstFunCall) =+ __tup5+ -- "GenerateCode.ag"(line 372, column 13)+ _costCentreDescr =+ "b" ++ ":" ++ show _lhsInt ++ ":" ++ show _lhsIcon ++ ":" ++ show _lhsInr+ -- "GenerateCode.ag"(line 373, column 13)+ _addCostCentre =+ \v -> if _lhsIo_costcentre+ then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v+ else v+ -- "GenerateCode.ag"(line 377, column 13)+ _params =+ map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap+ -- "GenerateCode.ag"(line 378, 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 (idEvalType $ 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 408, column 13)+ _tsig =+ TSig _funcname _semType+ -- "GenerateCode.ag"(line 409, column 13)+ _semType =+ let argType (NT tp tps) r | tp /= _SELF = typeAppStrs (sdtype tp) tps `Arr` r+ | tp == _SELF = error "GenerateCode: found an intra-type with type SELF, which should have been prevented by CRule.tps"+ argType (Haskell tp) r = SimpleType tp `Arr` r+ 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 420, column 13)+ _lhsOdecls =+ ( if _lhsIwith_sig+ then [_tsig, _semFun]+ else [_semFun]+ ) +++ ( if ordered_ && _o_splitsems+ then _blockFunDecls+ else []+ )+ -- "GenerateCode.ag"(line 428, column 13)+ _typeSigs =+ if _lhsIo_sig && not _o_case+ then _vssItSigs+ else []+ -- "GenerateCode.ag"(line 431, column 13)+ _o_case =+ _lhsIo_case && ordered_ && not (hasPragma _lhsIallPragmas _lhsInt _lhsIcon _NOCASE)+ -- "GenerateCode.ag"(line 432, column 13)+ _o_splitsems =+ ordered_ && _lhsIo_splitsems+ -- "GenerateCode.ag"(line 454, column 7)+ _lhsOgatherInstVisitNrs =+ Map.fromList [(i,_lhsInr) | i <- _vssIdefinedInsts]+ -- "GenerateCode.ag"(line 465, column 7)+ _vssOdeclsAbove =+ []+ -- "GenerateCode.ag"(line 466, column 7)+ _intraOdeclsAbove =+ error "declsAbove: not used here"+ -- "GenerateCode.ag"(line 712, column 13)+ _lhsOallTpsFound =+ _intraIallTpsFound+ -- "GenerateCode.ag"(line 723, column 13)+ _lhsOerrors =+ _intraIerrors+ -- "GenerateCode.ag"(line 756, column 18)+ _lhsOcomments =+ let body = map ind (_vssIcomments ++ _intraIcomments)+ in if null body+ then []+ else ("visit " ++ show _lhsInr ++ ":") : body+ -- "GenerateCode.ag"(line 760, column 18)+ _vssOwhat =+ "local"+ -- "GenerateCode.ag"(line 761, column 18)+ _intraOwhat =+ "intra"+ -- "GenerateCode.ag"(line 987, column 7)+ _lhsOsemNames =+ [_funcname ]+ -- copy rule (down)+ _vssOallNts =+ _lhsIallNts+ -- 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)+ _vssOunfoldSemDom =+ _lhsIunfoldSemDom+ -- copy rule (down)+ _intraOallNts =+ _lhsIallNts+ -- 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+ -- copy rule (down)+ _intraOunfoldSemDom =+ _lhsIunfoldSemDom+ ( _vssIallTpsFound,_vssIblockDecls,_vssIcomments,_vssIdecls,_vssIdeclsAbove,_vssIdefinedInsts,_vssIerrors,_vssIexprs,_vssItSigs,_vssItps,_vssIusedVars) =+ (vss_ _vssOallNts _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 _vssOunfoldSemDom _vssOwhat )+ ( _intraIallTpsFound,_intraIblockDecls,_intraIcomments,_intraIdecls,_intraIdeclsAbove,_intraIdefinedInsts,_intraIerrors,_intraIexprs,_intraItSigs,_intraItps,_intraIusedVars) =+ (intra_ _intraOallNts _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 _intraOunfoldSemDom _intraOwhat )+ in ( _lhsOallTpsFound,_lhsOcomments,_lhsOdecls,_lhsOerrors,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOsemNames))) )+-- CVisits -----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allNts : Set NontermIdent+ 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 ((Set NontermIdent) ->+ 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 {allNts_Inh_CVisits :: !(Set NontermIdent),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 ->+ Inh_CVisits ->+ Syn_CVisits +wrap_CVisits (T_CVisits sem ) (Inh_CVisits _lhsIallNts _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 _lhsIallNts _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 (\ _lhsIallNts+ _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])+ _hdOallNts :: (Set NontermIdent)+ _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+ _tlOallNts :: (Set NontermIdent)+ _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 216, column 11)+ _tlOnr =+ _lhsInr + 1+ -- "GenerateCode.ag"(line 229, column 12)+ _lhsOisNil =+ False+ -- "GenerateCode.ag"(line 230, column 12)+ _hdOisLast =+ _tlIisNil+ -- "GenerateCode.ag"(line 247, column 12)+ _hdOnextIntra =+ _tlIintra+ -- "GenerateCode.ag"(line 248, column 12)+ _hdOnextIntraVars =+ _tlIintraVars+ -- "GenerateCode.ag"(line 249, column 12)+ _lhsOintra =+ _hdIintra+ -- "GenerateCode.ag"(line 250, column 12)+ _lhsOintraVars =+ _hdIintraVars+ -- use rule "GenerateCode.ag"(line 706, column 39)+ _lhsOallTpsFound =+ _hdIallTpsFound && _tlIallTpsFound+ -- use rule "GenerateCode.ag"(line 738, column 52)+ _lhsOcomments =+ _hdIcomments ++ _tlIcomments+ -- use rule "GenerateCode.ag"(line 355, column 33)+ _lhsOdecls =+ _hdIdecls ++ _tlIdecls+ -- use rule "GenerateCode.ag"(line 719, column 32)+ _lhsOerrors =+ _hdIerrors Seq.>< _tlIerrors+ -- use rule "GenerateCode.ag"(line 447, column 44)+ _lhsOgatherInstVisitNrs =+ _hdIgatherInstVisitNrs `Map.union` _tlIgatherInstVisitNrs+ -- use rule "GenerateCode.ag"(line 977, column 61)+ _lhsOsemNames =+ _hdIsemNames ++ _tlIsemNames+ -- copy rule (down)+ _hdOallNts =+ _lhsIallNts+ -- 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)+ _tlOallNts =+ _lhsIallNts+ -- 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_ _hdOallNts _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_ _tlOallNts _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 (\ _lhsIallNts+ _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 231, column 10)+ _lhsOisNil =+ True+ -- "GenerateCode.ag"(line 251, column 10)+ _lhsOintra =+ []+ -- "GenerateCode.ag"(line 252, column 10)+ _lhsOintraVars =+ Set.empty+ -- use rule "GenerateCode.ag"(line 706, column 39)+ _lhsOallTpsFound =+ True+ -- use rule "GenerateCode.ag"(line 738, column 52)+ _lhsOcomments =+ []+ -- use rule "GenerateCode.ag"(line 355, column 33)+ _lhsOdecls =+ []+ -- use rule "GenerateCode.ag"(line 719, column 32)+ _lhsOerrors =+ Seq.empty+ -- use rule "GenerateCode.ag"(line 447, column 44)+ _lhsOgatherInstVisitNrs =+ Map.empty+ -- use rule "GenerateCode.ag"(line 977, 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 ->+ Inh_DeclBlocks ->+ Syn_DeclBlocks +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 544, column 7)+ _nextOblockNr =+ _lhsIblockNr + 1+ -- "GenerateCode.ag"(line 549, column 7)+ _lambdaName =+ _lhsIprefix ++ "_block" ++ show _lhsIblockNr+ -- "GenerateCode.ag"(line 550, column 7)+ _pragmaDecl =+ PragmaDecl ("NOINLINE " ++ _lambdaName )+ -- "GenerateCode.ag"(line 551, column 7)+ _lhsOcallExpr =+ App _lambdaName (map SimpleExpr _freeVars )+ -- "GenerateCode.ag"(line 555, column 7)+ _freeVars =+ freevars _nextIfreeVars (visit_ : defs_)+ -- "GenerateCode.ag"(line 562, column 7)+ _decl =+ mkBlockLambda _lhsIoptCase _lambdaName _freeVars (defs_ ++ [visit_]) _nextIcallExpr+ -- "GenerateCode.ag"(line 563, 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 549, column 7)+ _lambdaName =+ _lhsIprefix ++ "_block" ++ show _lhsIblockNr+ -- "GenerateCode.ag"(line 550, column 7)+ _pragmaDecl =+ PragmaDecl ("NOINLINE " ++ _lambdaName )+ -- "GenerateCode.ag"(line 551, column 7)+ _lhsOcallExpr =+ App _lambdaName (map SimpleExpr _freeVars )+ -- "GenerateCode.ag"(line 553, column 7)+ _freeVars =+ freevars _lhsIlastExprVars (defs_ ++ _lhsInextVisitDecls)+ -- "GenerateCode.ag"(line 560, 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 ->+ Inh_DeclBlocksRoot ->+ Syn_DeclBlocksRoot +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 535, column 7)+ _lhsOlambdas =+ _blocksIdecls+ -- "GenerateCode.ag"(line 536, column 7)+ _lhsOfirstCall =+ _blocksIcallExpr+ -- "GenerateCode.ag"(line 541, 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 ->+ Inh_Pattern ->+ Syn_Pattern +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 197, column 11)+ _lhsOdefinedInsts =+ (if field_ == _INST then [attr_] else []) ++ _patIdefinedInsts+ -- "GenerateCode.ag"(line 205, 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 195, column 55)+ _lhsOdefinedInsts =+ _patsIdefinedInsts+ -- use rule "GenerateCode.ag"(line 202, 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 195, column 55)+ _lhsOdefinedInsts =+ _patIdefinedInsts+ -- use rule "GenerateCode.ag"(line 202, 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 195, column 55)+ _lhsOdefinedInsts =+ _patsIdefinedInsts+ -- use rule "GenerateCode.ag"(line 202, 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 195, column 55)+ _lhsOdefinedInsts =+ []+ -- use rule "GenerateCode.ag"(line 202, 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 ->+ Inh_Patterns ->+ Syn_Patterns +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 195, column 55)+ _lhsOdefinedInsts =+ _hdIdefinedInsts ++ _tlIdefinedInsts+ -- use rule "GenerateCode.ag"(line 202, 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 195, column 55)+ _lhsOdefinedInsts =+ []+ -- use rule "GenerateCode.ag"(line 202, column 47)+ _lhsOpatternAttributes =+ []+ -- self rule+ _copy =+ []+ -- self rule+ _lhsOcopy =+ _copy+ in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)) )+-- Sequence ----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allNts : Set NontermIdent+ 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]+ unfoldSemDom : NontermIdent -> Int -> [String] -> Code.Type+ 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 ((Set NontermIdent) ->+ ([(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]) ->+ (NontermIdent -> Int -> [String] -> Code.Type) ->+ String ->+ ( Bool,DeclBlocks,([String]),Decls,([Decl]),([Identifier]),(Seq Error),Exprs,([Decl]),([Type]),(Set String)))+data Inh_Sequence = Inh_Sequence {allNts_Inh_Sequence :: !(Set NontermIdent),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]),unfoldSemDom_Inh_Sequence :: !(NontermIdent -> Int -> [String] -> Code.Type),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 ->+ Inh_Sequence ->+ Syn_Sequence +wrap_Sequence (T_Sequence sem ) (Inh_Sequence _lhsIallNts _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 _lhsIunfoldSemDom _lhsIwhat ) =+ (let ( _lhsOallTpsFound,_lhsOblockDecls,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOerrors,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars) =+ (sem _lhsIallNts _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 _lhsIunfoldSemDom _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 (\ _lhsIallNts+ _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+ _lhsIunfoldSemDom+ _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])+ _hdOallNts :: (Set NontermIdent)+ _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])+ _hdOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type)+ _hdOwhat :: String+ _tlOallNts :: (Set NontermIdent)+ _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])+ _tlOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type)+ _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 476, column 7)+ _lhsOblockDecls =+ _hdIbldBlocksFun _tlIblockDecls+ -- use rule "GenerateCode.ag"(line 344, column 39)+ _lhsOallTpsFound =+ _hdIallTpsFound && _tlIallTpsFound+ -- use rule "GenerateCode.ag"(line 738, column 52)+ _lhsOcomments =+ _hdIcomments ++ _tlIcomments+ -- use rule "GenerateCode.ag"(line 138, column 34)+ _lhsOdecls =+ _hdIdecls ++ _tlIdecls+ -- use rule "GenerateCode.ag"(line 195, column 55)+ _lhsOdefinedInsts =+ _hdIdefinedInsts ++ _tlIdefinedInsts+ -- use rule "GenerateCode.ag"(line 719, column 32)+ _lhsOerrors =+ _hdIerrors Seq.>< _tlIerrors+ -- use rule "GenerateCode.ag"(line 268, column 34)+ _lhsOexprs =+ _hdIexprs ++ _tlIexprs+ -- use rule "GenerateCode.ag"(line 297, column 33)+ _lhsOtSigs =+ _hdItSigs ++ _tlItSigs+ -- use rule "GenerateCode.ag"(line 343, column 31)+ _lhsOtps =+ _hdItps ++ _tlItps+ -- use rule "GenerateCode.ag"(line 286, column 37)+ _lhsOusedVars =+ _hdIusedVars `Set.union` _tlIusedVars+ -- copy rule (up)+ _lhsOdeclsAbove =+ _tlIdeclsAbove+ -- copy rule (down)+ _hdOallNts =+ _lhsIallNts+ -- 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)+ _hdOunfoldSemDom =+ _lhsIunfoldSemDom+ -- copy rule (down)+ _hdOwhat =+ _lhsIwhat+ -- copy rule (down)+ _tlOallNts =+ _lhsIallNts+ -- 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)+ _tlOunfoldSemDom =+ _lhsIunfoldSemDom+ -- copy rule (down)+ _tlOwhat =+ _lhsIwhat+ ( _hdIallTpsFound,_hdIbldBlocksFun,_hdIcomments,_hdIdecls,_hdIdeclsAbove,_hdIdefinedInsts,_hdIerrors,_hdIexprs,_hdItSigs,_hdItps,_hdIusedVars) =+ (hd_ _hdOallNts _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 _hdOunfoldSemDom _hdOwhat )+ ( _tlIallTpsFound,_tlIblockDecls,_tlIcomments,_tlIdecls,_tlIdeclsAbove,_tlIdefinedInsts,_tlIerrors,_tlIexprs,_tlItSigs,_tlItps,_tlIusedVars) =+ (tl_ _tlOallNts _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 _tlOunfoldSemDom _tlOwhat )+ in ( _lhsOallTpsFound,_lhsOblockDecls,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOerrors,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars))) )+sem_Sequence_Nil :: T_Sequence +sem_Sequence_Nil =+ (T_Sequence (\ _lhsIallNts+ _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+ _lhsIunfoldSemDom+ _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 478, column 7)+ _lhsOblockDecls =+ DeclTerminator _lhsIdeclsAbove _lhsIlastExpr+ -- use rule "GenerateCode.ag"(line 344, column 39)+ _lhsOallTpsFound =+ True+ -- use rule "GenerateCode.ag"(line 738, column 52)+ _lhsOcomments =+ []+ -- use rule "GenerateCode.ag"(line 138, column 34)+ _lhsOdecls =+ []+ -- use rule "GenerateCode.ag"(line 195, column 55)+ _lhsOdefinedInsts =+ []+ -- use rule "GenerateCode.ag"(line 719, column 32)+ _lhsOerrors =+ Seq.empty+ -- use rule "GenerateCode.ag"(line 268, column 34)+ _lhsOexprs =+ []+ -- use rule "GenerateCode.ag"(line 297, column 33)+ _lhsOtSigs =+ []+ -- use rule "GenerateCode.ag"(line 343, column 31)+ _lhsOtps =+ []+ -- use rule "GenerateCode.ag"(line 286, 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,54 +1,54 @@- - --- UUAGC 0.9.11 (HsToken.ag) -module HsToken where - -import CommonTypes -import UU.Scanner.Position(Pos) --- HsToken ----------------------------------------------------- -{- - alternatives: - alternative AGField: - child field : {Identifier} - child attr : {Identifier} - child pos : {Pos} - child rdesc : {Maybe String} - alternative AGLocal: - child var : {Identifier} - child pos : {Pos} - child rdesc : {Maybe String} - alternative CharToken: - child value : {String} - child pos : {Pos} - alternative Err: - child mesg : {String} - child pos : {Pos} - alternative HsToken: - child value : {String} - child pos : {Pos} - alternative StrToken: - child value : {String} - child pos : {Pos} --} -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: - alternative Cons: - child hd : HsToken - child tl : HsTokens - alternative Nil: --} -type HsTokens = [(HsToken)] --- HsTokensRoot ------------------------------------------------ -{- - alternatives: - alternative HsTokensRoot: - child tokens : HsTokens --} +++-- UUAGC 0.9.12 (HsToken.ag)+module HsToken where++import CommonTypes+import UU.Scanner.Position(Pos)+-- HsToken -----------------------------------------------------+{-+ alternatives:+ alternative AGField:+ child field : {Identifier}+ child attr : {Identifier}+ child pos : {Pos}+ child rdesc : {Maybe String}+ alternative AGLocal:+ child var : {Identifier}+ child pos : {Pos}+ child rdesc : {Maybe String}+ alternative CharToken:+ child value : {String}+ child pos : {Pos}+ alternative Err:+ child mesg : {String}+ child pos : {Pos}+ alternative HsToken:+ child value : {String}+ child pos : {Pos}+ alternative StrToken:+ child value : {String}+ child pos : {Pos}+-}+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:+ alternative Cons:+ child hd : HsToken + child tl : HsTokens + alternative Nil:+-}+type HsTokens = [(HsToken)]+-- HsTokensRoot ------------------------------------------------+{-+ alternatives:+ alternative HsTokensRoot:+ child tokens : HsTokens +-} data HsTokensRoot = HsTokensRoot (HsTokens)
src-derived/Interfaces.hs view
@@ -1,49 +1,49 @@- - --- UUAGC 0.9.11 (Interfaces.ag) -module Interfaces where - -import CommonTypes -import SequentialTypes --- IRoot ------------------------------------------------------- -{- - alternatives: - alternative IRoot: - child inters : Interfaces --} -data IRoot = IRoot (Interfaces) --- Interface --------------------------------------------------- -{- - alternatives: - alternative Interface: - child nt : {NontermIdent} - child cons : {[ConstructorIdent]} - child seg : Segments --} -data Interface = Interface (NontermIdent) ([ConstructorIdent]) (Segments) --- Interfaces -------------------------------------------------- -{- - alternatives: - alternative Cons: - child hd : Interface - child tl : Interfaces - alternative Nil: --} -type Interfaces = [(Interface)] --- Segment ----------------------------------------------------- -{- - alternatives: - alternative Segment: - child inh : {[Vertex]} - child syn : {[Vertex]} --} -data Segment = Segment ([Vertex]) ([Vertex]) --- Segments ---------------------------------------------------- -{- - alternatives: - alternative Cons: - child hd : Segment - child tl : Segments - alternative Nil: --} +++-- UUAGC 0.9.12 (Interfaces.ag)+module Interfaces where++import CommonTypes+import SequentialTypes+-- IRoot -------------------------------------------------------+{-+ alternatives:+ alternative IRoot:+ child inters : Interfaces +-}+data IRoot = IRoot (Interfaces) +-- Interface ---------------------------------------------------+{-+ alternatives:+ alternative Interface:+ child nt : {NontermIdent}+ child cons : {[ConstructorIdent]}+ child seg : Segments +-}+data Interface = Interface (NontermIdent) ([ConstructorIdent]) (Segments) +-- Interfaces --------------------------------------------------+{-+ alternatives:+ alternative Cons:+ child hd : Interface + child tl : Interfaces + alternative Nil:+-}+type Interfaces = [(Interface)]+-- Segment -----------------------------------------------------+{-+ alternatives:+ alternative Segment:+ child inh : {[Vertex]}+ child syn : {[Vertex]}+-}+data Segment = Segment ([Vertex]) ([Vertex]) +-- Segments ----------------------------------------------------+{-+ alternatives:+ alternative Cons:+ child hd : Segment + child tl : Segments + alternative Nil:+-} type Segments = [(Segment)]
src-derived/InterfacesRules.hs view
@@ -1,977 +1,977 @@-{-# OPTIONS_GHC -fbang-patterns #-} - --- UUAGC 0.9.11 (InterfacesRules.lag) -module InterfacesRules where - -import Interfaces -import SequentialTypes -import CodeSyntax -import GrammarInfo - -import qualified Data.Sequence as Seq -import Data.Sequence(Seq) -import qualified Data.Map as Map -import Data.Map(Map) -import qualified Data.Set as Set -import Data.Set(Set) -import Data.Tree(Tree(Node)) -import Data.Graph(Graph, dfs, edges, buildG, transposeG) -import Data.Maybe (fromJust) -import Data.List (partition,transpose,(\\),nub,intersect, findIndex) -import Data.Array ((!),inRange,bounds,assocs) -import Data.Foldable(toList) - -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) -cv look n v (inh,syn) = let fld = getField (look (head syn)) - rnt = fromJust (getRhsNt (look (head syn))) - 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 :: 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 - (seg:remain) = drop n segs - CSegment inh syn = seg - last = null remain --- IRoot ------------------------------------------------------- -{- - visit 0: - inherited attributes: - dpr : [Edge] - info : Info - tdp : Graph - synthesized attributes: - edp : [Edge] - inters : CInterfaceMap - visits : CVisitsMap - alternatives: - alternative IRoot: - child inters : Interfaces - visit 0: - local newedges : _ - local visitssGraph : _ - local descr : _ --} --- cata -sem_IRoot :: IRoot -> - T_IRoot -sem_IRoot !(IRoot _inters ) = - (sem_IRoot_IRoot (sem_Interfaces _inters ) ) --- semantic domain -newtype T_IRoot = T_IRoot (([Edge]) -> - Info -> - Graph -> - ( ([Edge]),CInterfaceMap,CVisitsMap)) -data Inh_IRoot = Inh_IRoot {dpr_Inh_IRoot :: !([Edge]),info_Inh_IRoot :: !(Info),tdp_Inh_IRoot :: !(Graph)} -data Syn_IRoot = Syn_IRoot {edp_Syn_IRoot :: !([Edge]),inters_Syn_IRoot :: !(CInterfaceMap),visits_Syn_IRoot :: !(CVisitsMap)} -wrap_IRoot :: T_IRoot -> - Inh_IRoot -> - Syn_IRoot -wrap_IRoot !(T_IRoot sem ) !(Inh_IRoot _lhsIdpr _lhsIinfo _lhsItdp ) = - (let ( !_lhsOedp,!_lhsOinters,!_lhsOvisits) = - (sem _lhsIdpr _lhsIinfo _lhsItdp ) - in (Syn_IRoot _lhsOedp _lhsOinters _lhsOvisits )) -sem_IRoot_IRoot :: T_Interfaces -> - T_IRoot -sem_IRoot_IRoot !(T_Interfaces inters_ ) = - (T_IRoot (\ (!_lhsIdpr) - (!_lhsIinfo) - (!_lhsItdp) -> - (case (_lhsIinfo) of - { !_intersOinfo -> - (case (snd (bounds _lhsItdp) + 1) of - { !_intersOv -> - (case ((inters_ _intersOinfo _intersOv )) of - { ( !_intersIdescr,!_intersIfirstvisitvertices,!_intersInewedges,!_intersIv,!T_Interfaces_1 inters_1) -> - (case (let terminals = [ v | (v,cr) <- assocs (ruleTable _lhsIinfo), not (getHasCode cr), isLocal cr ] - in _intersIfirstvisitvertices ++ terminals) of - { !_intersOprev -> - (case (toList _intersInewedges) of - { !_newedges -> - (case (let graph = buildG (0,_intersIv-1) es - es = _newedges ++ edges _lhsItdp - in transposeG graph) of - { !_visitssGraph -> - (case (_visitssGraph) of - { !_intersOvssGraph -> - (case (toList _intersIdescr) of - { !_descr -> - (case (Map.fromList _descr) of - { !_intersOvisitDescr -> - (case ((inters_1 _intersOprev _intersOvisitDescr _intersOvssGraph )) of - { ( !_intersIinters,!T_Interfaces_2 inters_2) -> - (case (_intersIinters) of - { !_intersOallInters -> - (case (buildG (0,_intersIv-1) (map swap (_lhsIdpr ++ _newedges))) of - { !_intersOddp -> - (case ((inters_2 _intersOallInters _intersOddp )) of - { ( !_intersIedp,!_intersIvisits) -> - (case (toList _intersIedp) of - { !_lhsOedp -> - (case (_intersIinters) of - { !_lhsOinters -> - (case (_intersIvisits) of - { !_lhsOvisits -> - ( _lhsOedp,_lhsOinters,_lhsOvisits) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) --- Interface --------------------------------------------------- -{- - visit 0: - inherited attribute: - info : Info - chained attribute: - v : Vertex - synthesized attributes: - descr : Seq (Vertex,ChildVisit) - firstvisitvertices : [Vertex] - newedges : Seq Edge - visit 1: - inherited attributes: - prev : [Vertex] - visitDescr : Map Vertex ChildVisit - vssGraph : Graph - synthesized attributes: - inter : CInterface - nt : NontermIdent - visit 2: - inherited attributes: - allInters : CInterfaceMap - ddp : Graph - synthesized attributes: - edp : Seq Edge - visits : Map ConstructorIdent CVisits - alternatives: - alternative Interface: - child nt : {NontermIdent} - child cons : {[ConstructorIdent]} - child seg : Segments - visit 0: - local look : {Vertex -> CRule} - local v : _ - local firstvisitvertices : _ - local descr : _ - local newedges : _ --} --- cata -sem_Interface :: Interface -> - T_Interface -sem_Interface !(Interface _nt _cons _seg ) = - (sem_Interface_Interface _nt _cons (sem_Segments _seg ) ) --- semantic domain -newtype T_Interface = T_Interface (Info -> - Vertex -> - ( (Seq (Vertex,ChildVisit)),([Vertex]),(Seq Edge ),Vertex,T_Interface_1 )) -newtype T_Interface_1 = T_Interface_1 (([Vertex]) -> - (Map Vertex ChildVisit) -> - Graph -> - ( CInterface,NontermIdent,T_Interface_2 )) -newtype T_Interface_2 = T_Interface_2 (CInterfaceMap -> - Graph -> - ( (Seq Edge),(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 :: !(NontermIdent),v_Syn_Interface :: !(Vertex),visits_Syn_Interface :: !(Map ConstructorIdent CVisits)} -wrap_Interface :: T_Interface -> - Inh_Interface -> - Syn_Interface -wrap_Interface !(T_Interface sem ) !(Inh_Interface _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) = - (let ( !_lhsOdescr,!_lhsOfirstvisitvertices,!_lhsOnewedges,!_lhsOv,!T_Interface_1 sem_1) = - (sem _lhsIinfo _lhsIv ) - ( !_lhsOinter,!_lhsOnt,!T_Interface_2 sem_2) = - (sem_1 _lhsIprev _lhsIvisitDescr _lhsIvssGraph ) - ( !_lhsOedp,!_lhsOvisits) = - (sem_2 _lhsIallInters _lhsIddp ) - in (Syn_Interface _lhsOdescr _lhsOedp _lhsOfirstvisitvertices _lhsOinter _lhsOnewedges _lhsOnt _lhsOv _lhsOvisits )) -sem_Interface_Interface :: NontermIdent -> - ([ConstructorIdent]) -> - T_Segments -> - T_Interface -sem_Interface_Interface !nt_ !cons_ !(T_Segments seg_ ) = - (T_Interface (\ (!_lhsIinfo) - (!_lhsIv) -> - (case (_lhsIinfo) of - { !_segOinfo -> - (case (0) of - { !_segOn -> - (case (\a -> ruleTable _lhsIinfo ! a) of - { !_look -> - (case (_lhsIv) of - { !_segOv -> - (case ((seg_ _segOinfo _segOn _segOv )) of - { ( !_segIdescr,!_segIgroups,!_segInewedges,!_segInewvertices,!_segIv,!T_Segments_1 seg_1) -> - (case (_segIv + length _segInewvertices) of - { !_v -> - (case ([_segIv .. _v-1]) of - { !_firstvisitvertices -> - (case (zipWith (cv _look (-1)) _firstvisitvertices _segIgroups) of - { !_descr -> - (case (_segIdescr Seq.>< Seq.fromList _descr) of - { !_lhsOdescr -> - (case (_firstvisitvertices) of - { !_lhsOfirstvisitvertices -> - (case (zip _firstvisitvertices _segInewvertices) of - { !_newedges -> - (case (_segInewedges Seq.>< Seq.fromList _newedges) of - { !_lhsOnewedges -> - (case (_v) of - { !_lhsOv -> - (case ((sem_Interface_Interface_1 cons_ (T_Segments_1 seg_1 ) nt_ )) of - { ( !sem_Interface_1) -> - ( _lhsOdescr,_lhsOfirstvisitvertices,_lhsOnewedges,_lhsOv,sem_Interface_1) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Interface_Interface_1 :: ([ConstructorIdent]) -> - T_Segments_1 -> - NontermIdent -> - T_Interface_1 -sem_Interface_Interface_1 !cons_ !(T_Segments_1 seg_1 ) !nt_ = - (T_Interface_1 (\ (!_lhsIprev) - (!_lhsIvisitDescr) - (!_lhsIvssGraph) -> - (case (_lhsIvssGraph) of - { !_segOvssGraph -> - (case (_lhsIvisitDescr) of - { !_segOvisitDescr -> - (case (_lhsIprev) of - { !_segOprev -> - (case (cons_) of - { !_segOcons -> - (case ((seg_1 _segOcons _segOprev _segOvisitDescr _segOvssGraph )) of - { ( !_segIsegs,!T_Segments_2 seg_2) -> - (case (CInterface _segIsegs) of - { !_lhsOinter -> - (case (nt_) of - { !_lhsOnt -> - (case ((sem_Interface_Interface_2 _lhsIprev (T_Segments_2 seg_2 ) cons_ )) of - { ( !sem_Interface_2) -> - ( _lhsOinter,_lhsOnt,sem_Interface_2) }) }) }) }) }) }) }) })) ) -sem_Interface_Interface_2 :: ([Vertex]) -> - T_Segments_2 -> - ([ConstructorIdent]) -> - T_Interface_2 -sem_Interface_Interface_2 !_lhsIprev !(T_Segments_2 seg_2 ) !cons_ = - (T_Interface_2 (\ (!_lhsIallInters) - (!_lhsIddp) -> - (case (_lhsIddp) of - { !_segOddp -> - (case (_lhsIallInters) of - { !_segOallInters -> - (case (_lhsIprev) of - { !_segOfromLhs -> - (case (True) of - { !_segOisFirst -> - (case ((seg_2 _segOallInters _segOddp _segOfromLhs _segOisFirst )) of - { ( !_segIcvisits,!_segIedp,!_segIfirstInh,!_segIhdIntravisits,!_segIprev) -> - (case (_segIedp) of - { !_lhsOedp -> - (case (Map.fromList (zip cons_ (transpose _segIcvisits))) of - { !_lhsOvisits -> - ( _lhsOedp,_lhsOvisits) }) }) }) }) }) }) })) ) --- Interfaces -------------------------------------------------- -{- - visit 0: - inherited attribute: - info : Info - chained attribute: - v : Vertex - synthesized attributes: - descr : Seq (Vertex,ChildVisit) - firstvisitvertices : [Vertex] - newedges : Seq Edge - visit 1: - inherited attributes: - prev : [Vertex] - visitDescr : Map Vertex ChildVisit - vssGraph : Graph - synthesized attribute: - inters : CInterfaceMap - visit 2: - inherited attributes: - allInters : CInterfaceMap - ddp : Graph - synthesized attributes: - edp : Seq Edge - visits : CVisitsMap - alternatives: - alternative Cons: - child hd : Interface - child tl : Interfaces - alternative Nil: --} --- cata -sem_Interfaces :: Interfaces -> - T_Interfaces -sem_Interfaces !list = - (Prelude.foldr sem_Interfaces_Cons sem_Interfaces_Nil (Prelude.map sem_Interface list) ) --- semantic domain -newtype T_Interfaces = T_Interfaces (Info -> - Vertex -> - ( (Seq (Vertex,ChildVisit)),([Vertex]),(Seq Edge ),Vertex,T_Interfaces_1 )) -newtype T_Interfaces_1 = T_Interfaces_1 (([Vertex]) -> - (Map Vertex ChildVisit) -> - Graph -> - ( CInterfaceMap,T_Interfaces_2 )) -newtype T_Interfaces_2 = T_Interfaces_2 (CInterfaceMap -> - Graph -> - ( (Seq Edge),CVisitsMap)) -data Inh_Interfaces = Inh_Interfaces {allInters_Inh_Interfaces :: !(CInterfaceMap),ddp_Inh_Interfaces :: !(Graph),info_Inh_Interfaces :: !(Info),prev_Inh_Interfaces :: !([Vertex]),v_Inh_Interfaces :: !(Vertex),visitDescr_Inh_Interfaces :: !(Map Vertex ChildVisit),vssGraph_Inh_Interfaces :: !(Graph)} -data Syn_Interfaces = Syn_Interfaces {descr_Syn_Interfaces :: !(Seq (Vertex,ChildVisit)),edp_Syn_Interfaces :: !(Seq Edge),firstvisitvertices_Syn_Interfaces :: !([Vertex]),inters_Syn_Interfaces :: !(CInterfaceMap),newedges_Syn_Interfaces :: !(Seq Edge ),v_Syn_Interfaces :: !(Vertex),visits_Syn_Interfaces :: !(CVisitsMap)} -wrap_Interfaces :: T_Interfaces -> - Inh_Interfaces -> - Syn_Interfaces -wrap_Interfaces !(T_Interfaces sem ) !(Inh_Interfaces _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) = - (let ( !_lhsOdescr,!_lhsOfirstvisitvertices,!_lhsOnewedges,!_lhsOv,!T_Interfaces_1 sem_1) = - (sem _lhsIinfo _lhsIv ) - ( !_lhsOinters,!T_Interfaces_2 sem_2) = - (sem_1 _lhsIprev _lhsIvisitDescr _lhsIvssGraph ) - ( !_lhsOedp,!_lhsOvisits) = - (sem_2 _lhsIallInters _lhsIddp ) - in (Syn_Interfaces _lhsOdescr _lhsOedp _lhsOfirstvisitvertices _lhsOinters _lhsOnewedges _lhsOv _lhsOvisits )) -sem_Interfaces_Cons :: T_Interface -> - T_Interfaces -> - T_Interfaces -sem_Interfaces_Cons !(T_Interface hd_ ) !(T_Interfaces tl_ ) = - (T_Interfaces (\ (!_lhsIinfo) - (!_lhsIv) -> - (case (_lhsIv) of - { !_hdOv -> - (case (_lhsIinfo) of - { !_hdOinfo -> - (case ((hd_ _hdOinfo _hdOv )) of - { ( !_hdIdescr,!_hdIfirstvisitvertices,!_hdInewedges,!_hdIv,!T_Interface_1 hd_1) -> - (case (_hdIv) of - { !_tlOv -> - (case (_lhsIinfo) of - { !_tlOinfo -> - (case ((tl_ _tlOinfo _tlOv )) of - { ( !_tlIdescr,!_tlIfirstvisitvertices,!_tlInewedges,!_tlIv,!T_Interfaces_1 tl_1) -> - (case (_hdIdescr Seq.>< _tlIdescr) of - { !_lhsOdescr -> - (case (_hdIfirstvisitvertices ++ _tlIfirstvisitvertices) of - { !_lhsOfirstvisitvertices -> - (case (_hdInewedges Seq.>< _tlInewedges) of - { !_lhsOnewedges -> - (case (_tlIv) of - { !_lhsOv -> - (case ((sem_Interfaces_Cons_1 (T_Interfaces_1 tl_1 ) (T_Interface_1 hd_1 ) )) of - { ( !sem_Interfaces_1) -> - ( _lhsOdescr,_lhsOfirstvisitvertices,_lhsOnewedges,_lhsOv,sem_Interfaces_1) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Interfaces_Cons_1 :: T_Interfaces_1 -> - T_Interface_1 -> - T_Interfaces_1 -sem_Interfaces_Cons_1 !(T_Interfaces_1 tl_1 ) !(T_Interface_1 hd_1 ) = - (T_Interfaces_1 (\ (!_lhsIprev) - (!_lhsIvisitDescr) - (!_lhsIvssGraph) -> - (case (_lhsIvssGraph) of - { !_tlOvssGraph -> - (case (_lhsIvisitDescr) of - { !_tlOvisitDescr -> - (case (_lhsIprev) of - { !_tlOprev -> - (case (_lhsIvssGraph) of - { !_hdOvssGraph -> - (case (_lhsIvisitDescr) of - { !_hdOvisitDescr -> - (case (_lhsIprev) of - { !_hdOprev -> - (case ((tl_1 _tlOprev _tlOvisitDescr _tlOvssGraph )) of - { ( !_tlIinters,!T_Interfaces_2 tl_2) -> - (case ((hd_1 _hdOprev _hdOvisitDescr _hdOvssGraph )) of - { ( !_hdIinter,!_hdInt,!T_Interface_2 hd_2) -> - (case (Map.insert _hdInt _hdIinter _tlIinters) of - { !_lhsOinters -> - (case ((sem_Interfaces_Cons_2 (T_Interfaces_2 tl_2 ) (T_Interface_2 hd_2 ) _hdInt )) of - { ( !sem_Interfaces_2) -> - ( _lhsOinters,sem_Interfaces_2) }) }) }) }) }) }) }) }) }) })) ) -sem_Interfaces_Cons_2 :: T_Interfaces_2 -> - T_Interface_2 -> - NontermIdent -> - T_Interfaces_2 -sem_Interfaces_Cons_2 !(T_Interfaces_2 tl_2 ) !(T_Interface_2 hd_2 ) !_hdInt = - (T_Interfaces_2 (\ (!_lhsIallInters) - (!_lhsIddp) -> - (case (_lhsIddp) of - { !_tlOddp -> - (case (_lhsIallInters) of - { !_tlOallInters -> - (case ((tl_2 _tlOallInters _tlOddp )) of - { ( !_tlIedp,!_tlIvisits) -> - (case (_lhsIddp) of - { !_hdOddp -> - (case (_lhsIallInters) of - { !_hdOallInters -> - (case ((hd_2 _hdOallInters _hdOddp )) of - { ( !_hdIedp,!_hdIvisits) -> - (case (_hdIedp Seq.>< _tlIedp) of - { !_lhsOedp -> - (case (Map.insert _hdInt _hdIvisits _tlIvisits) of - { !_lhsOvisits -> - ( _lhsOedp,_lhsOvisits) }) }) }) }) }) }) }) })) ) -sem_Interfaces_Nil :: T_Interfaces -sem_Interfaces_Nil = - (T_Interfaces (\ (!_lhsIinfo) - (!_lhsIv) -> - (case (Seq.empty) of - { !_lhsOdescr -> - (case ([]) of - { !_lhsOfirstvisitvertices -> - (case (Seq.empty) of - { !_lhsOnewedges -> - (case (_lhsIv) of - { !_lhsOv -> - (case ((sem_Interfaces_Nil_1 )) of - { ( !sem_Interfaces_1) -> - ( _lhsOdescr,_lhsOfirstvisitvertices,_lhsOnewedges,_lhsOv,sem_Interfaces_1) }) }) }) }) })) ) -sem_Interfaces_Nil_1 :: T_Interfaces_1 -sem_Interfaces_Nil_1 = - (T_Interfaces_1 (\ (!_lhsIprev) - (!_lhsIvisitDescr) - (!_lhsIvssGraph) -> - (case (Map.empty) of - { !_lhsOinters -> - (case ((sem_Interfaces_Nil_2 )) of - { ( !sem_Interfaces_2) -> - ( _lhsOinters,sem_Interfaces_2) }) })) ) -sem_Interfaces_Nil_2 :: T_Interfaces_2 -sem_Interfaces_Nil_2 = - (T_Interfaces_2 (\ (!_lhsIallInters) - (!_lhsIddp) -> - (case (Seq.empty) of - { !_lhsOedp -> - (case (Map.empty) of - { !_lhsOvisits -> - ( _lhsOedp,_lhsOvisits) }) })) ) --- Segment ----------------------------------------------------- -{- - visit 0: - inherited attribute: - info : Info - chained attribute: - v : Vertex - visit 1: - inherited attributes: - n : Int - nextNewvertices : [Vertex] - synthesized attributes: - descr : Seq (Vertex,ChildVisit) - groups : [([Vertex],[Vertex])] - newedges : Seq Edge - newvertices : [Vertex] - visit 2: - inherited attributes: - cons : [ConstructorIdent] - visitDescr : Map Vertex ChildVisit - vssGraph : Graph - chained attribute: - prev : [Vertex] - synthesized attribute: - seg : CSegment - visit 3: - inherited attributes: - allInters : CInterfaceMap - ddp : Graph - fromLhs : [Vertex] - isFirst : Bool - nextInh : [Vertex] - nextIntravisits : [IntraVisit] - synthesized attributes: - cvisits : [CVisit] - edp : Seq Edge - inh : [Vertex] - intravisits : [IntraVisit] - visitss : [VisitSS] - alternatives: - alternative Segment: - child inh : {[Vertex]} - child syn : {[Vertex]} - visit 0: - local look : {Vertex -> CRule} - local occurAs : {(CRule -> Bool) -> [Vertex] -> [Vertex]} - local groups : {[([Vertex],[Vertex])]} - local v : {Int} - visit 1: - local newvertices : _ - local visitedges : _ - local attredges : _ - intra v : {Int} - intra groups : {[([Vertex],[Vertex])]} - intra look : {Vertex -> CRule} - intra occurAs : {(CRule -> Bool) -> [Vertex] -> [Vertex]} - visit 2: - local synOccur : _ - local vss : _ - local visitss' : _ - local visitss : {[[Vertex]]} - local defined : _ - local _tup1 : {(Map Identifier Type,Map Identifier Type)} - local synmap : {Map Identifier Type} - local inhmap : {Map Identifier Type} - intra occurAs : {(CRule -> Bool) -> [Vertex] -> [Vertex]} - visit 3: - local computed : _ - local fromLhs : _ - local iv : _ - local intravisits : _ - intra visitss : {[[Vertex]]} - intra occurAs : {(CRule -> Bool) -> [Vertex] -> [Vertex]} - intra synmap : {Map Identifier Type} - intra inhmap : {Map Identifier Type} --} --- cata -sem_Segment :: Segment -> - T_Segment -sem_Segment !(Segment _inh _syn ) = - (sem_Segment_Segment _inh _syn ) --- semantic domain -newtype T_Segment = T_Segment (Info -> - Vertex -> - ( Vertex,T_Segment_1 )) -newtype T_Segment_1 = T_Segment_1 (Int -> - ([Vertex]) -> - ( (Seq (Vertex,ChildVisit)),([([Vertex],[Vertex])]),(Seq Edge ),([Vertex]),T_Segment_2 )) -newtype T_Segment_2 = T_Segment_2 (([ConstructorIdent]) -> - ([Vertex]) -> - (Map Vertex ChildVisit) -> - Graph -> - ( ([Vertex]),CSegment,T_Segment_3 )) -newtype T_Segment_3 = T_Segment_3 (CInterfaceMap -> - Graph -> - ([Vertex]) -> - Bool -> - ([Vertex]) -> - ([IntraVisit]) -> - ( ([CVisit]),(Seq Edge),([Vertex]),([IntraVisit]),([VisitSS]))) -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 -> - Inh_Segment -> - Syn_Segment -wrap_Segment !(T_Segment sem ) !(Inh_Segment _lhsIallInters _lhsIcons _lhsIddp _lhsIfromLhs _lhsIinfo _lhsIisFirst _lhsIn _lhsInextInh _lhsInextIntravisits _lhsInextNewvertices _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) = - (let ( !_lhsOv,!T_Segment_1 sem_1) = - (sem _lhsIinfo _lhsIv ) - ( !_lhsOdescr,!_lhsOgroups,!_lhsOnewedges,!_lhsOnewvertices,!T_Segment_2 sem_2) = - (sem_1 _lhsIn _lhsInextNewvertices ) - ( !_lhsOprev,!_lhsOseg,!T_Segment_3 sem_3) = - (sem_2 _lhsIcons _lhsIprev _lhsIvisitDescr _lhsIvssGraph ) - ( !_lhsOcvisits,!_lhsOedp,!_lhsOinh,!_lhsOintravisits,!_lhsOvisitss) = - (sem_3 _lhsIallInters _lhsIddp _lhsIfromLhs _lhsIisFirst _lhsInextInh _lhsInextIntravisits ) - in (Syn_Segment _lhsOcvisits _lhsOdescr _lhsOedp _lhsOgroups _lhsOinh _lhsOintravisits _lhsOnewedges _lhsOnewvertices _lhsOprev _lhsOseg _lhsOv _lhsOvisitss )) -sem_Segment_Segment :: ([Vertex]) -> - ([Vertex]) -> - T_Segment -sem_Segment_Segment !inh_ !syn_ = - (T_Segment (\ (!_lhsIinfo) - (!_lhsIv) -> - (case (\a -> ruleTable _lhsIinfo ! a) of - { !_look -> - (case (\p us -> [ a | u <- us - , a <- tdsToTdp _lhsIinfo ! u - , p (_look a)]) of - { !_occurAs -> - (case (let group as = gather _lhsIinfo (_occurAs isRhs as) - in map (partition (isInh . _look)) (group (inh_ ++ syn_))) of - { !_groups -> - (case (_lhsIv + length _groups) of - { !_v -> - (case (_v) of - { !_lhsOv -> - (case ((sem_Segment_Segment_1 _v _lhsIv _groups _look syn_ _occurAs _lhsIinfo inh_ )) of - { ( !sem_Segment_1) -> - ( _lhsOv,sem_Segment_1) }) }) }) }) }) })) ) -sem_Segment_Segment_1 :: Int -> - Vertex -> - ([([Vertex],[Vertex])]) -> - (Vertex -> CRule) -> - ([Vertex]) -> - ((CRule -> Bool) -> [Vertex] -> [Vertex]) -> - Info -> - ([Vertex]) -> - T_Segment_1 -sem_Segment_Segment_1 !_v !_lhsIv !_groups !_look !syn_ !_occurAs !_lhsIinfo !inh_ = - (T_Segment_1 (\ (!_lhsIn) - (!_lhsInextNewvertices) -> - (case ([_lhsIv .. _v -1]) of - { !_newvertices -> - (case (Seq.fromList $ zipWith (cv _look _lhsIn) _newvertices _groups) of - { !_lhsOdescr -> - (case (_groups) of - { !_lhsOgroups -> - (case (zip _newvertices _lhsInextNewvertices) of - { !_visitedges -> - (case (concat (zipWith ed _newvertices _groups)) of - { !_attredges -> - (case (Seq.fromList _attredges Seq.>< Seq.fromList _visitedges) of - { !_lhsOnewedges -> - (case (_newvertices) of - { !_lhsOnewvertices -> - (case ((sem_Segment_Segment_2 syn_ _occurAs _lhsIinfo inh_ )) of - { ( !sem_Segment_2) -> - ( _lhsOdescr,_lhsOgroups,_lhsOnewedges,_lhsOnewvertices,sem_Segment_2) }) }) }) }) }) }) }) })) ) -sem_Segment_Segment_2 :: ([Vertex]) -> - ((CRule -> Bool) -> [Vertex] -> [Vertex]) -> - Info -> - ([Vertex]) -> - T_Segment_2 -sem_Segment_Segment_2 !syn_ !_occurAs !_lhsIinfo !inh_ = - (T_Segment_2 (\ (!_lhsIcons) - (!_lhsIprev) - (!_lhsIvisitDescr) - (!_lhsIvssGraph) -> - (case (gather _lhsIinfo (_occurAs isLhs syn_)) of - { !_synOccur -> - (case (let hasCode v | inRange (bounds (ruleTable _lhsIinfo)) v = getHasCode (ruleTable _lhsIinfo ! v) - | otherwise = True - in if null syn_ - then replicate (length _lhsIcons) [] - else map (filter hasCode . topSort' _lhsIvssGraph) _synOccur) of - { !_vss -> - (case (map (\\ _lhsIprev) _vss) of - { !_visitss' -> - (case (let rem :: [(Identifier,Identifier,Maybe Type)] -> [Vertex] -> [Vertex] - rem prev [] = [] - rem prev (v:vs) - | inRange (bounds table) v - = let cr = table ! 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') of - { !_visitss -> - (case (let defines v = case Map.lookup v _lhsIvisitDescr of - Nothing -> [v] - Just (ChildVisit _ _ _ inh _) -> v:inh - in concatMap (concatMap defines) _visitss) of - { !_defined -> - (case (_lhsIprev ++ _defined) of - { !_lhsOprev -> - (case (let makemap = Map.fromList . map findType - findType v = getNtaNameType (attrTable _lhsIinfo ! v) - in (makemap inh_,makemap syn_)) of - { !__tup1 -> - (case (__tup1) of - { !(_,!_synmap) -> - (case (__tup1) of - { !(!_inhmap,_) -> - (case (if False then undefined _lhsIvssGraph _lhsIvisitDescr _lhsIprev else CSegment _inhmap _synmap) of - { !_lhsOseg -> - (case ((sem_Segment_Segment_3 _visitss _lhsIinfo _lhsIvisitDescr inh_ _occurAs _synmap _inhmap syn_ )) of - { ( !sem_Segment_3) -> - ( _lhsOprev,_lhsOseg,sem_Segment_3) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Segment_Segment_3 :: ([[Vertex]]) -> - Info -> - (Map Vertex ChildVisit) -> - ([Vertex]) -> - ((CRule -> Bool) -> [Vertex] -> [Vertex]) -> - (Map Identifier Type) -> - (Map Identifier Type) -> - ([Vertex]) -> - T_Segment_3 -sem_Segment_Segment_3 !_visitss !_lhsIinfo !_lhsIvisitDescr !inh_ !_occurAs !_synmap !_inhmap !syn_ = - (T_Segment_3 (\ (!_lhsIallInters) - (!_lhsIddp) - (!_lhsIfromLhs) - (!_lhsIisFirst) - (!_lhsInextInh) - (!_lhsInextIntravisits) -> - (case (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) of - { !_computed -> - (case (_occurAs isLhs inh_ ++ _lhsIfromLhs) of - { !_fromLhs -> - (case (\vs next -> - let needed = concatMap (_lhsIddp !) vs - in nub (needed ++ next) \\ (_fromLhs ++ _computed)) of - { !_iv -> - (case (zipWith _iv _visitss _lhsInextIntravisits) of - { !_intravisits -> - (case (let mkVisit vss intra = CVisit _inhmap _synmap (mkSequence vss) (mkSequence intra) True - mkSequence = map mkRule - mkRule v = case Map.lookup v _lhsIvisitDescr of - Nothing -> ruleTable _lhsIinfo ! v - Just (ChildVisit name nt n _ _) -> ccv name nt n _lhsIallInters - in zipWith mkVisit _visitss _intravisits) of - { !_lhsOcvisits -> - (case (Seq.fromList [(i,s) | i <- inh_, s <- syn_] - Seq.>< Seq.fromList [(s,i) | s <- syn_, i <- _lhsInextInh ]) of - { !_lhsOedp -> - (case (inh_) of - { !_lhsOinh -> - (case (_intravisits) of - { !_lhsOintravisits -> - (case (_visitss) of - { !_lhsOvisitss -> - ( _lhsOcvisits,_lhsOedp,_lhsOinh,_lhsOintravisits,_lhsOvisitss) }) }) }) }) }) }) }) }) })) ) --- Segments ---------------------------------------------------- -{- - visit 0: - inherited attributes: - info : Info - n : Int - chained attribute: - v : Vertex - synthesized attributes: - descr : Seq (Vertex,ChildVisit) - groups : [([Vertex],[Vertex])] - newedges : Seq Edge - newvertices : [Vertex] - visit 1: - inherited attributes: - cons : [ConstructorIdent] - prev : [Vertex] - visitDescr : Map Vertex ChildVisit - vssGraph : Graph - synthesized attribute: - segs : CSegments - visit 2: - inherited attributes: - allInters : CInterfaceMap - ddp : Graph - fromLhs : [Vertex] - isFirst : Bool - synthesized attributes: - cvisits : [[CVisit]] - edp : Seq Edge - firstInh : [Vertex] - hdIntravisits : [IntraVisit] - prev : [Vertex] - alternatives: - alternative Cons: - child hd : Segment - child tl : Segments - alternative Nil: --} --- cata -sem_Segments :: Segments -> - T_Segments -sem_Segments !list = - (Prelude.foldr sem_Segments_Cons sem_Segments_Nil (Prelude.map sem_Segment list) ) --- semantic domain -newtype T_Segments = T_Segments (Info -> - Int -> - Vertex -> - ( (Seq (Vertex,ChildVisit)),([([Vertex],[Vertex])]),(Seq Edge ),([Vertex]),Vertex,T_Segments_1 )) -newtype T_Segments_1 = T_Segments_1 (([ConstructorIdent]) -> - ([Vertex]) -> - (Map Vertex ChildVisit) -> - Graph -> - ( CSegments,T_Segments_2 )) -newtype T_Segments_2 = T_Segments_2 (CInterfaceMap -> - Graph -> - ([Vertex]) -> - Bool -> - ( ([[CVisit]]),(Seq Edge),([Vertex]),([IntraVisit]),([Vertex]))) -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 -> - Inh_Segments -> - Syn_Segments -wrap_Segments !(T_Segments sem ) !(Inh_Segments _lhsIallInters _lhsIcons _lhsIddp _lhsIfromLhs _lhsIinfo _lhsIisFirst _lhsIn _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) = - (let ( !_lhsOdescr,!_lhsOgroups,!_lhsOnewedges,!_lhsOnewvertices,!_lhsOv,!T_Segments_1 sem_1) = - (sem _lhsIinfo _lhsIn _lhsIv ) - ( !_lhsOsegs,!T_Segments_2 sem_2) = - (sem_1 _lhsIcons _lhsIprev _lhsIvisitDescr _lhsIvssGraph ) - ( !_lhsOcvisits,!_lhsOedp,!_lhsOfirstInh,!_lhsOhdIntravisits,!_lhsOprev) = - (sem_2 _lhsIallInters _lhsIddp _lhsIfromLhs _lhsIisFirst ) - in (Syn_Segments _lhsOcvisits _lhsOdescr _lhsOedp _lhsOfirstInh _lhsOgroups _lhsOhdIntravisits _lhsOnewedges _lhsOnewvertices _lhsOprev _lhsOsegs _lhsOv )) -sem_Segments_Cons :: T_Segment -> - T_Segments -> - T_Segments -sem_Segments_Cons !(T_Segment hd_ ) !(T_Segments tl_ ) = - (T_Segments (\ (!_lhsIinfo) - (!_lhsIn) - (!_lhsIv) -> - (case (_lhsIv) of - { !_hdOv -> - (case (_lhsIinfo) of - { !_hdOinfo -> - (case ((hd_ _hdOinfo _hdOv )) of - { ( !_hdIv,!T_Segment_1 hd_1) -> - (case (_hdIv) of - { !_tlOv -> - (case (_lhsIinfo) of - { !_tlOinfo -> - (case (_lhsIn) of - { !_hdOn -> - (case (_lhsIn + 1) of - { !_tlOn -> - (case ((tl_ _tlOinfo _tlOn _tlOv )) of - { ( !_tlIdescr,!_tlIgroups,!_tlInewedges,!_tlInewvertices,!_tlIv,!T_Segments_1 tl_1) -> - (case (_tlInewvertices) of - { !_hdOnextNewvertices -> - (case ((hd_1 _hdOn _hdOnextNewvertices )) of - { ( !_hdIdescr,!_hdIgroups,!_hdInewedges,!_hdInewvertices,!T_Segment_2 hd_2) -> - (case (_hdIdescr Seq.>< _tlIdescr) of - { !_lhsOdescr -> - (case (_hdIgroups) of - { !_lhsOgroups -> - (case (_hdInewedges Seq.>< _tlInewedges) of - { !_lhsOnewedges -> - (case (_hdInewvertices) of - { !_lhsOnewvertices -> - (case (_tlIv) of - { !_lhsOv -> - (case ((sem_Segments_Cons_1 (T_Segment_2 hd_2 ) (T_Segments_1 tl_1 ) )) of - { ( !sem_Segments_1) -> - ( _lhsOdescr,_lhsOgroups,_lhsOnewedges,_lhsOnewvertices,_lhsOv,sem_Segments_1) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Segments_Cons_1 :: T_Segment_2 -> - T_Segments_1 -> - T_Segments_1 -sem_Segments_Cons_1 !(T_Segment_2 hd_2 ) !(T_Segments_1 tl_1 ) = - (T_Segments_1 (\ (!_lhsIcons) - (!_lhsIprev) - (!_lhsIvisitDescr) - (!_lhsIvssGraph) -> - (case (_lhsIvssGraph) of - { !_tlOvssGraph -> - (case (_lhsIvisitDescr) of - { !_tlOvisitDescr -> - (case (_lhsIvssGraph) of - { !_hdOvssGraph -> - (case (_lhsIvisitDescr) of - { !_hdOvisitDescr -> - (case (_lhsIprev) of - { !_hdOprev -> - (case (_lhsIcons) of - { !_hdOcons -> - (case ((hd_2 _hdOcons _hdOprev _hdOvisitDescr _hdOvssGraph )) of - { ( !_hdIprev,!_hdIseg,!T_Segment_3 hd_3) -> - (case (_hdIprev) of - { !_tlOprev -> - (case (_lhsIcons) of - { !_tlOcons -> - (case ((tl_1 _tlOcons _tlOprev _tlOvisitDescr _tlOvssGraph )) of - { ( !_tlIsegs,!T_Segments_2 tl_2) -> - (case (_hdIseg : _tlIsegs) of - { !_lhsOsegs -> - (case ((sem_Segments_Cons_2 (T_Segments_2 tl_2 ) (T_Segment_3 hd_3 ) )) of - { ( !sem_Segments_2) -> - ( _lhsOsegs,sem_Segments_2) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Segments_Cons_2 :: T_Segments_2 -> - T_Segment_3 -> - T_Segments_2 -sem_Segments_Cons_2 !(T_Segments_2 tl_2 ) !(T_Segment_3 hd_3 ) = - (T_Segments_2 (\ (!_lhsIallInters) - (!_lhsIddp) - (!_lhsIfromLhs) - (!_lhsIisFirst) -> - (case (_lhsIddp) of - { !_tlOddp -> - (case (_lhsIallInters) of - { !_tlOallInters -> - (case (_lhsIddp) of - { !_hdOddp -> - (case (_lhsIallInters) of - { !_hdOallInters -> - (case ([]) of - { !_tlOfromLhs -> - (case (_lhsIfromLhs) of - { !_hdOfromLhs -> - (case (False) of - { !_tlOisFirst -> - (case ((tl_2 _tlOallInters _tlOddp _tlOfromLhs _tlOisFirst )) of - { ( !_tlIcvisits,!_tlIedp,!_tlIfirstInh,!_tlIhdIntravisits,!_tlIprev) -> - (case (_tlIhdIntravisits) of - { !_hdOnextIntravisits -> - (case (_lhsIisFirst) of - { !_hdOisFirst -> - (case (_tlIfirstInh) of - { !_hdOnextInh -> - (case ((hd_3 _hdOallInters _hdOddp _hdOfromLhs _hdOisFirst _hdOnextInh _hdOnextIntravisits )) of - { ( !_hdIcvisits,!_hdIedp,!_hdIinh,!_hdIintravisits,!_hdIvisitss) -> - (case (_hdIcvisits : _tlIcvisits) of - { !_lhsOcvisits -> - (case (_hdIedp Seq.>< _tlIedp) of - { !_lhsOedp -> - (case (_hdIinh) of - { !_lhsOfirstInh -> - (case (_hdIintravisits) of - { !_lhsOhdIntravisits -> - (case (_tlIprev) of - { !_lhsOprev -> - ( _lhsOcvisits,_lhsOedp,_lhsOfirstInh,_lhsOhdIntravisits,_lhsOprev) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Segments_Nil :: T_Segments -sem_Segments_Nil = - (T_Segments (\ (!_lhsIinfo) - (!_lhsIn) - (!_lhsIv) -> - (case (Seq.empty) of - { !_lhsOdescr -> - (case ([]) of - { !_lhsOgroups -> - (case (Seq.empty) of - { !_lhsOnewedges -> - (case ([]) of - { !_lhsOnewvertices -> - (case (_lhsIv) of - { !_lhsOv -> - (case ((sem_Segments_Nil_1 )) of - { ( !sem_Segments_1) -> - ( _lhsOdescr,_lhsOgroups,_lhsOnewedges,_lhsOnewvertices,_lhsOv,sem_Segments_1) }) }) }) }) }) })) ) -sem_Segments_Nil_1 :: T_Segments_1 -sem_Segments_Nil_1 = - (T_Segments_1 (\ (!_lhsIcons) - (!_lhsIprev) - (!_lhsIvisitDescr) - (!_lhsIvssGraph) -> - (case ([]) of - { !_lhsOsegs -> - (case ((sem_Segments_Nil_2 _lhsIprev )) of - { ( !sem_Segments_2) -> - ( _lhsOsegs,sem_Segments_2) }) })) ) -sem_Segments_Nil_2 :: ([Vertex]) -> - T_Segments_2 -sem_Segments_Nil_2 !_lhsIprev = - (T_Segments_2 (\ (!_lhsIallInters) - (!_lhsIddp) - (!_lhsIfromLhs) - (!_lhsIisFirst) -> - (case ([]) of - { !_lhsOcvisits -> - (case (Seq.empty) of - { !_lhsOedp -> - (case ([]) of - { !_lhsOfirstInh -> - (case (repeat []) of - { !_lhsOhdIntravisits -> - (case (_lhsIprev) of - { !_lhsOprev -> +{-# OPTIONS_GHC -fbang-patterns #-}++-- UUAGC 0.9.12 (InterfacesRules.lag)+module InterfacesRules where++import Interfaces+import SequentialTypes+import CodeSyntax+import GrammarInfo++import qualified Data.Sequence as Seq+import Data.Sequence(Seq)+import qualified Data.Map as Map+import Data.Map(Map)+import qualified Data.Set as Set+import Data.Set(Set)+import Data.Tree(Tree(Node))+import Data.Graph(Graph, dfs, edges, buildG, transposeG)+import Data.Maybe (fromJust)+import Data.List (partition,transpose,(\\),nub,intersect, findIndex)+import Data.Array ((!),inRange,bounds,assocs)+import Data.Foldable(toList)++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)+cv look n v (inh,syn) = let fld = getField (look (head syn))+ rnt = fromJust (getRhsNt (look (head syn)))+ 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 :: 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+ (seg:remain) = drop n segs+ CSegment inh syn = seg + last = null remain+-- IRoot -------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ dpr : [Edge]+ info : Info+ tdp : Graph+ synthesized attributes:+ edp : [Edge]+ inters : CInterfaceMap+ visits : CVisitsMap+ alternatives:+ alternative IRoot:+ child inters : Interfaces + visit 0:+ local newedges : _+ local visitssGraph : _+ local descr : _+-}+-- cata+sem_IRoot :: IRoot ->+ T_IRoot +sem_IRoot !(IRoot _inters ) =+ (sem_IRoot_IRoot (sem_Interfaces _inters ) )+-- semantic domain+newtype T_IRoot = T_IRoot (([Edge]) ->+ Info ->+ Graph ->+ ( ([Edge]),CInterfaceMap,CVisitsMap))+data Inh_IRoot = Inh_IRoot {dpr_Inh_IRoot :: !([Edge]),info_Inh_IRoot :: !(Info),tdp_Inh_IRoot :: !(Graph)}+data Syn_IRoot = Syn_IRoot {edp_Syn_IRoot :: !([Edge]),inters_Syn_IRoot :: !(CInterfaceMap),visits_Syn_IRoot :: !(CVisitsMap)}+wrap_IRoot :: T_IRoot ->+ Inh_IRoot ->+ Syn_IRoot +wrap_IRoot !(T_IRoot sem ) !(Inh_IRoot _lhsIdpr _lhsIinfo _lhsItdp ) =+ (let ( !_lhsOedp,!_lhsOinters,!_lhsOvisits) =+ (sem _lhsIdpr _lhsIinfo _lhsItdp )+ in (Syn_IRoot _lhsOedp _lhsOinters _lhsOvisits ))+sem_IRoot_IRoot :: T_Interfaces ->+ T_IRoot +sem_IRoot_IRoot !(T_Interfaces inters_ ) =+ (T_IRoot (\ (!_lhsIdpr)+ (!_lhsIinfo)+ (!_lhsItdp) ->+ (case (_lhsIinfo) of+ { !_intersOinfo ->+ (case (snd (bounds _lhsItdp) + 1) of+ { !_intersOv ->+ (case ((inters_ _intersOinfo _intersOv )) of+ { ( !_intersIdescr,!_intersIfirstvisitvertices,!_intersInewedges,!_intersIv,!T_Interfaces_1 inters_1) ->+ (case (let terminals = [ v | (v,cr) <- assocs (ruleTable _lhsIinfo), not (getHasCode cr), isLocal cr ]+ in _intersIfirstvisitvertices ++ terminals) of+ { !_intersOprev ->+ (case (toList _intersInewedges) of+ { !_newedges ->+ (case (let graph = buildG (0,_intersIv-1) es+ es = _newedges ++ edges _lhsItdp+ in transposeG graph) of+ { !_visitssGraph ->+ (case (_visitssGraph) of+ { !_intersOvssGraph ->+ (case (toList _intersIdescr) of+ { !_descr ->+ (case (Map.fromList _descr) of+ { !_intersOvisitDescr ->+ (case ((inters_1 _intersOprev _intersOvisitDescr _intersOvssGraph )) of+ { ( !_intersIinters,!T_Interfaces_2 inters_2) ->+ (case (_intersIinters) of+ { !_intersOallInters ->+ (case (buildG (0,_intersIv-1) (map swap (_lhsIdpr ++ _newedges))) of+ { !_intersOddp ->+ (case ((inters_2 _intersOallInters _intersOddp )) of+ { ( !_intersIedp,!_intersIvisits) ->+ (case (toList _intersIedp) of+ { !_lhsOedp ->+ (case (_intersIinters) of+ { !_lhsOinters ->+ (case (_intersIvisits) of+ { !_lhsOvisits ->+ ( _lhsOedp,_lhsOinters,_lhsOvisits) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) )+-- Interface ---------------------------------------------------+{-+ visit 0:+ inherited attribute:+ info : Info+ chained attribute:+ v : Vertex+ synthesized attributes:+ descr : Seq (Vertex,ChildVisit)+ firstvisitvertices : [Vertex]+ newedges : Seq Edge + visit 1:+ inherited attributes:+ prev : [Vertex]+ visitDescr : Map Vertex ChildVisit+ vssGraph : Graph+ synthesized attributes:+ inter : CInterface+ nt : NontermIdent+ visit 2:+ inherited attributes:+ allInters : CInterfaceMap+ ddp : Graph+ synthesized attributes:+ edp : Seq Edge+ visits : Map ConstructorIdent CVisits+ alternatives:+ alternative Interface:+ child nt : {NontermIdent}+ child cons : {[ConstructorIdent]}+ child seg : Segments + visit 0:+ local look : {Vertex -> CRule}+ local v : _+ local firstvisitvertices : _+ local descr : _+ local newedges : _+-}+-- cata+sem_Interface :: Interface ->+ T_Interface +sem_Interface !(Interface _nt _cons _seg ) =+ (sem_Interface_Interface _nt _cons (sem_Segments _seg ) )+-- semantic domain+newtype T_Interface = T_Interface (Info ->+ Vertex ->+ ( (Seq (Vertex,ChildVisit)),([Vertex]),(Seq Edge ),Vertex,T_Interface_1 ))+newtype T_Interface_1 = T_Interface_1 (([Vertex]) ->+ (Map Vertex ChildVisit) ->+ Graph ->+ ( CInterface,NontermIdent,T_Interface_2 ))+newtype T_Interface_2 = T_Interface_2 (CInterfaceMap ->+ Graph ->+ ( (Seq Edge),(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 :: !(NontermIdent),v_Syn_Interface :: !(Vertex),visits_Syn_Interface :: !(Map ConstructorIdent CVisits)}+wrap_Interface :: T_Interface ->+ Inh_Interface ->+ Syn_Interface +wrap_Interface !(T_Interface sem ) !(Inh_Interface _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) =+ (let ( !_lhsOdescr,!_lhsOfirstvisitvertices,!_lhsOnewedges,!_lhsOv,!T_Interface_1 sem_1) =+ (sem _lhsIinfo _lhsIv )+ ( !_lhsOinter,!_lhsOnt,!T_Interface_2 sem_2) =+ (sem_1 _lhsIprev _lhsIvisitDescr _lhsIvssGraph )+ ( !_lhsOedp,!_lhsOvisits) =+ (sem_2 _lhsIallInters _lhsIddp )+ in (Syn_Interface _lhsOdescr _lhsOedp _lhsOfirstvisitvertices _lhsOinter _lhsOnewedges _lhsOnt _lhsOv _lhsOvisits ))+sem_Interface_Interface :: NontermIdent ->+ ([ConstructorIdent]) ->+ T_Segments ->+ T_Interface +sem_Interface_Interface !nt_ !cons_ !(T_Segments seg_ ) =+ (T_Interface (\ (!_lhsIinfo)+ (!_lhsIv) ->+ (case (_lhsIinfo) of+ { !_segOinfo ->+ (case (0) of+ { !_segOn ->+ (case (\a -> ruleTable _lhsIinfo ! a) of+ { !_look ->+ (case (_lhsIv) of+ { !_segOv ->+ (case ((seg_ _segOinfo _segOn _segOv )) of+ { ( !_segIdescr,!_segIgroups,!_segInewedges,!_segInewvertices,!_segIv,!T_Segments_1 seg_1) ->+ (case (_segIv + length _segInewvertices) of+ { !_v ->+ (case ([_segIv .. _v-1]) of+ { !_firstvisitvertices ->+ (case (zipWith (cv _look (-1)) _firstvisitvertices _segIgroups) of+ { !_descr ->+ (case (_segIdescr Seq.>< Seq.fromList _descr) of+ { !_lhsOdescr ->+ (case (_firstvisitvertices) of+ { !_lhsOfirstvisitvertices ->+ (case (zip _firstvisitvertices _segInewvertices) of+ { !_newedges ->+ (case (_segInewedges Seq.>< Seq.fromList _newedges) of+ { !_lhsOnewedges ->+ (case (_v) of+ { !_lhsOv ->+ (case ((sem_Interface_Interface_1 cons_ (T_Segments_1 seg_1 ) nt_ )) of+ { ( !sem_Interface_1) ->+ ( _lhsOdescr,_lhsOfirstvisitvertices,_lhsOnewedges,_lhsOv,sem_Interface_1) }) }) }) }) }) }) }) }) }) }) }) }) }) })) )+sem_Interface_Interface_1 :: ([ConstructorIdent]) ->+ T_Segments_1 ->+ NontermIdent ->+ T_Interface_1 +sem_Interface_Interface_1 !cons_ !(T_Segments_1 seg_1 ) !nt_ =+ (T_Interface_1 (\ (!_lhsIprev)+ (!_lhsIvisitDescr)+ (!_lhsIvssGraph) ->+ (case (_lhsIvssGraph) of+ { !_segOvssGraph ->+ (case (_lhsIvisitDescr) of+ { !_segOvisitDescr ->+ (case (_lhsIprev) of+ { !_segOprev ->+ (case (cons_) of+ { !_segOcons ->+ (case ((seg_1 _segOcons _segOprev _segOvisitDescr _segOvssGraph )) of+ { ( !_segIsegs,!T_Segments_2 seg_2) ->+ (case (CInterface _segIsegs) of+ { !_lhsOinter ->+ (case (nt_) of+ { !_lhsOnt ->+ (case ((sem_Interface_Interface_2 _lhsIprev (T_Segments_2 seg_2 ) cons_ )) of+ { ( !sem_Interface_2) ->+ ( _lhsOinter,_lhsOnt,sem_Interface_2) }) }) }) }) }) }) }) })) )+sem_Interface_Interface_2 :: ([Vertex]) ->+ T_Segments_2 ->+ ([ConstructorIdent]) ->+ T_Interface_2 +sem_Interface_Interface_2 !_lhsIprev !(T_Segments_2 seg_2 ) !cons_ =+ (T_Interface_2 (\ (!_lhsIallInters)+ (!_lhsIddp) ->+ (case (_lhsIddp) of+ { !_segOddp ->+ (case (_lhsIallInters) of+ { !_segOallInters ->+ (case (_lhsIprev) of+ { !_segOfromLhs ->+ (case (True) of+ { !_segOisFirst ->+ (case ((seg_2 _segOallInters _segOddp _segOfromLhs _segOisFirst )) of+ { ( !_segIcvisits,!_segIedp,!_segIfirstInh,!_segIhdIntravisits,!_segIprev) ->+ (case (_segIedp) of+ { !_lhsOedp ->+ (case (Map.fromList (zip cons_ (transpose _segIcvisits))) of+ { !_lhsOvisits ->+ ( _lhsOedp,_lhsOvisits) }) }) }) }) }) }) })) )+-- Interfaces --------------------------------------------------+{-+ visit 0:+ inherited attribute:+ info : Info+ chained attribute:+ v : Vertex+ synthesized attributes:+ descr : Seq (Vertex,ChildVisit)+ firstvisitvertices : [Vertex]+ newedges : Seq Edge + visit 1:+ inherited attributes:+ prev : [Vertex]+ visitDescr : Map Vertex ChildVisit+ vssGraph : Graph+ synthesized attribute:+ inters : CInterfaceMap+ visit 2:+ inherited attributes:+ allInters : CInterfaceMap+ ddp : Graph+ synthesized attributes:+ edp : Seq Edge+ visits : CVisitsMap+ alternatives:+ alternative Cons:+ child hd : Interface + child tl : Interfaces + alternative Nil:+-}+-- cata+sem_Interfaces :: Interfaces ->+ T_Interfaces +sem_Interfaces !list =+ (Prelude.foldr sem_Interfaces_Cons sem_Interfaces_Nil (Prelude.map sem_Interface list) )+-- semantic domain+newtype T_Interfaces = T_Interfaces (Info ->+ Vertex ->+ ( (Seq (Vertex,ChildVisit)),([Vertex]),(Seq Edge ),Vertex,T_Interfaces_1 ))+newtype T_Interfaces_1 = T_Interfaces_1 (([Vertex]) ->+ (Map Vertex ChildVisit) ->+ Graph ->+ ( CInterfaceMap,T_Interfaces_2 ))+newtype T_Interfaces_2 = T_Interfaces_2 (CInterfaceMap ->+ Graph ->+ ( (Seq Edge),CVisitsMap))+data Inh_Interfaces = Inh_Interfaces {allInters_Inh_Interfaces :: !(CInterfaceMap),ddp_Inh_Interfaces :: !(Graph),info_Inh_Interfaces :: !(Info),prev_Inh_Interfaces :: !([Vertex]),v_Inh_Interfaces :: !(Vertex),visitDescr_Inh_Interfaces :: !(Map Vertex ChildVisit),vssGraph_Inh_Interfaces :: !(Graph)}+data Syn_Interfaces = Syn_Interfaces {descr_Syn_Interfaces :: !(Seq (Vertex,ChildVisit)),edp_Syn_Interfaces :: !(Seq Edge),firstvisitvertices_Syn_Interfaces :: !([Vertex]),inters_Syn_Interfaces :: !(CInterfaceMap),newedges_Syn_Interfaces :: !(Seq Edge ),v_Syn_Interfaces :: !(Vertex),visits_Syn_Interfaces :: !(CVisitsMap)}+wrap_Interfaces :: T_Interfaces ->+ Inh_Interfaces ->+ Syn_Interfaces +wrap_Interfaces !(T_Interfaces sem ) !(Inh_Interfaces _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) =+ (let ( !_lhsOdescr,!_lhsOfirstvisitvertices,!_lhsOnewedges,!_lhsOv,!T_Interfaces_1 sem_1) =+ (sem _lhsIinfo _lhsIv )+ ( !_lhsOinters,!T_Interfaces_2 sem_2) =+ (sem_1 _lhsIprev _lhsIvisitDescr _lhsIvssGraph )+ ( !_lhsOedp,!_lhsOvisits) =+ (sem_2 _lhsIallInters _lhsIddp )+ in (Syn_Interfaces _lhsOdescr _lhsOedp _lhsOfirstvisitvertices _lhsOinters _lhsOnewedges _lhsOv _lhsOvisits ))+sem_Interfaces_Cons :: T_Interface ->+ T_Interfaces ->+ T_Interfaces +sem_Interfaces_Cons !(T_Interface hd_ ) !(T_Interfaces tl_ ) =+ (T_Interfaces (\ (!_lhsIinfo)+ (!_lhsIv) ->+ (case (_lhsIv) of+ { !_hdOv ->+ (case (_lhsIinfo) of+ { !_hdOinfo ->+ (case ((hd_ _hdOinfo _hdOv )) of+ { ( !_hdIdescr,!_hdIfirstvisitvertices,!_hdInewedges,!_hdIv,!T_Interface_1 hd_1) ->+ (case (_hdIv) of+ { !_tlOv ->+ (case (_lhsIinfo) of+ { !_tlOinfo ->+ (case ((tl_ _tlOinfo _tlOv )) of+ { ( !_tlIdescr,!_tlIfirstvisitvertices,!_tlInewedges,!_tlIv,!T_Interfaces_1 tl_1) ->+ (case (_hdIdescr Seq.>< _tlIdescr) of+ { !_lhsOdescr ->+ (case (_hdIfirstvisitvertices ++ _tlIfirstvisitvertices) of+ { !_lhsOfirstvisitvertices ->+ (case (_hdInewedges Seq.>< _tlInewedges) of+ { !_lhsOnewedges ->+ (case (_tlIv) of+ { !_lhsOv ->+ (case ((sem_Interfaces_Cons_1 (T_Interfaces_1 tl_1 ) (T_Interface_1 hd_1 ) )) of+ { ( !sem_Interfaces_1) ->+ ( _lhsOdescr,_lhsOfirstvisitvertices,_lhsOnewedges,_lhsOv,sem_Interfaces_1) }) }) }) }) }) }) }) }) }) }) })) )+sem_Interfaces_Cons_1 :: T_Interfaces_1 ->+ T_Interface_1 ->+ T_Interfaces_1 +sem_Interfaces_Cons_1 !(T_Interfaces_1 tl_1 ) !(T_Interface_1 hd_1 ) =+ (T_Interfaces_1 (\ (!_lhsIprev)+ (!_lhsIvisitDescr)+ (!_lhsIvssGraph) ->+ (case (_lhsIvssGraph) of+ { !_tlOvssGraph ->+ (case (_lhsIvisitDescr) of+ { !_tlOvisitDescr ->+ (case (_lhsIprev) of+ { !_tlOprev ->+ (case (_lhsIvssGraph) of+ { !_hdOvssGraph ->+ (case (_lhsIvisitDescr) of+ { !_hdOvisitDescr ->+ (case (_lhsIprev) of+ { !_hdOprev ->+ (case ((tl_1 _tlOprev _tlOvisitDescr _tlOvssGraph )) of+ { ( !_tlIinters,!T_Interfaces_2 tl_2) ->+ (case ((hd_1 _hdOprev _hdOvisitDescr _hdOvssGraph )) of+ { ( !_hdIinter,!_hdInt,!T_Interface_2 hd_2) ->+ (case (Map.insert _hdInt _hdIinter _tlIinters) of+ { !_lhsOinters ->+ (case ((sem_Interfaces_Cons_2 (T_Interfaces_2 tl_2 ) (T_Interface_2 hd_2 ) _hdInt )) of+ { ( !sem_Interfaces_2) ->+ ( _lhsOinters,sem_Interfaces_2) }) }) }) }) }) }) }) }) }) })) )+sem_Interfaces_Cons_2 :: T_Interfaces_2 ->+ T_Interface_2 ->+ NontermIdent ->+ T_Interfaces_2 +sem_Interfaces_Cons_2 !(T_Interfaces_2 tl_2 ) !(T_Interface_2 hd_2 ) !_hdInt =+ (T_Interfaces_2 (\ (!_lhsIallInters)+ (!_lhsIddp) ->+ (case (_lhsIddp) of+ { !_tlOddp ->+ (case (_lhsIallInters) of+ { !_tlOallInters ->+ (case ((tl_2 _tlOallInters _tlOddp )) of+ { ( !_tlIedp,!_tlIvisits) ->+ (case (_lhsIddp) of+ { !_hdOddp ->+ (case (_lhsIallInters) of+ { !_hdOallInters ->+ (case ((hd_2 _hdOallInters _hdOddp )) of+ { ( !_hdIedp,!_hdIvisits) ->+ (case (_hdIedp Seq.>< _tlIedp) of+ { !_lhsOedp ->+ (case (Map.insert _hdInt _hdIvisits _tlIvisits) of+ { !_lhsOvisits ->+ ( _lhsOedp,_lhsOvisits) }) }) }) }) }) }) }) })) )+sem_Interfaces_Nil :: T_Interfaces +sem_Interfaces_Nil =+ (T_Interfaces (\ (!_lhsIinfo)+ (!_lhsIv) ->+ (case (Seq.empty) of+ { !_lhsOdescr ->+ (case ([]) of+ { !_lhsOfirstvisitvertices ->+ (case (Seq.empty) of+ { !_lhsOnewedges ->+ (case (_lhsIv) of+ { !_lhsOv ->+ (case ((sem_Interfaces_Nil_1 )) of+ { ( !sem_Interfaces_1) ->+ ( _lhsOdescr,_lhsOfirstvisitvertices,_lhsOnewedges,_lhsOv,sem_Interfaces_1) }) }) }) }) })) )+sem_Interfaces_Nil_1 :: T_Interfaces_1 +sem_Interfaces_Nil_1 =+ (T_Interfaces_1 (\ (!_lhsIprev)+ (!_lhsIvisitDescr)+ (!_lhsIvssGraph) ->+ (case (Map.empty) of+ { !_lhsOinters ->+ (case ((sem_Interfaces_Nil_2 )) of+ { ( !sem_Interfaces_2) ->+ ( _lhsOinters,sem_Interfaces_2) }) })) )+sem_Interfaces_Nil_2 :: T_Interfaces_2 +sem_Interfaces_Nil_2 =+ (T_Interfaces_2 (\ (!_lhsIallInters)+ (!_lhsIddp) ->+ (case (Seq.empty) of+ { !_lhsOedp ->+ (case (Map.empty) of+ { !_lhsOvisits ->+ ( _lhsOedp,_lhsOvisits) }) })) )+-- Segment -----------------------------------------------------+{-+ visit 0:+ inherited attribute:+ info : Info+ chained attribute:+ v : Vertex+ visit 1:+ inherited attributes:+ n : Int+ nextNewvertices : [Vertex]+ synthesized attributes:+ descr : Seq (Vertex,ChildVisit)+ groups : [([Vertex],[Vertex])]+ newedges : Seq Edge + newvertices : [Vertex]+ visit 2:+ inherited attributes:+ cons : [ConstructorIdent]+ visitDescr : Map Vertex ChildVisit+ vssGraph : Graph+ chained attribute:+ prev : [Vertex]+ synthesized attribute:+ seg : CSegment+ visit 3:+ inherited attributes:+ allInters : CInterfaceMap+ ddp : Graph+ fromLhs : [Vertex]+ isFirst : Bool+ nextInh : [Vertex]+ nextIntravisits : [IntraVisit]+ synthesized attributes:+ cvisits : [CVisit]+ edp : Seq Edge+ inh : [Vertex]+ intravisits : [IntraVisit]+ visitss : [VisitSS]+ alternatives:+ alternative Segment:+ child inh : {[Vertex]}+ child syn : {[Vertex]}+ visit 0:+ local look : {Vertex -> CRule}+ local occurAs : {(CRule -> Bool) -> [Vertex] -> [Vertex]}+ local groups : {[([Vertex],[Vertex])]}+ local v : {Int}+ visit 1:+ local newvertices : _+ local visitedges : _+ local attredges : _+ intra v : {Int}+ intra groups : {[([Vertex],[Vertex])]}+ intra look : {Vertex -> CRule}+ intra occurAs : {(CRule -> Bool) -> [Vertex] -> [Vertex]}+ visit 2:+ local synOccur : _+ local vss : _+ local visitss' : _+ local visitss : {[[Vertex]]}+ local defined : _+ local _tup1 : {(Map Identifier Type,Map Identifier Type)}+ local synmap : {Map Identifier Type}+ local inhmap : {Map Identifier Type}+ intra occurAs : {(CRule -> Bool) -> [Vertex] -> [Vertex]}+ visit 3:+ local computed : _+ local fromLhs : _+ local iv : _+ local intravisits : _+ intra visitss : {[[Vertex]]}+ intra occurAs : {(CRule -> Bool) -> [Vertex] -> [Vertex]}+ intra synmap : {Map Identifier Type}+ intra inhmap : {Map Identifier Type}+-}+-- cata+sem_Segment :: Segment ->+ T_Segment +sem_Segment !(Segment _inh _syn ) =+ (sem_Segment_Segment _inh _syn )+-- semantic domain+newtype T_Segment = T_Segment (Info ->+ Vertex ->+ ( Vertex,T_Segment_1 ))+newtype T_Segment_1 = T_Segment_1 (Int ->+ ([Vertex]) ->+ ( (Seq (Vertex,ChildVisit)),([([Vertex],[Vertex])]),(Seq Edge ),([Vertex]),T_Segment_2 ))+newtype T_Segment_2 = T_Segment_2 (([ConstructorIdent]) ->+ ([Vertex]) ->+ (Map Vertex ChildVisit) ->+ Graph ->+ ( ([Vertex]),CSegment,T_Segment_3 ))+newtype T_Segment_3 = T_Segment_3 (CInterfaceMap ->+ Graph ->+ ([Vertex]) ->+ Bool ->+ ([Vertex]) ->+ ([IntraVisit]) ->+ ( ([CVisit]),(Seq Edge),([Vertex]),([IntraVisit]),([VisitSS])))+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 ->+ Inh_Segment ->+ Syn_Segment +wrap_Segment !(T_Segment sem ) !(Inh_Segment _lhsIallInters _lhsIcons _lhsIddp _lhsIfromLhs _lhsIinfo _lhsIisFirst _lhsIn _lhsInextInh _lhsInextIntravisits _lhsInextNewvertices _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) =+ (let ( !_lhsOv,!T_Segment_1 sem_1) =+ (sem _lhsIinfo _lhsIv )+ ( !_lhsOdescr,!_lhsOgroups,!_lhsOnewedges,!_lhsOnewvertices,!T_Segment_2 sem_2) =+ (sem_1 _lhsIn _lhsInextNewvertices )+ ( !_lhsOprev,!_lhsOseg,!T_Segment_3 sem_3) =+ (sem_2 _lhsIcons _lhsIprev _lhsIvisitDescr _lhsIvssGraph )+ ( !_lhsOcvisits,!_lhsOedp,!_lhsOinh,!_lhsOintravisits,!_lhsOvisitss) =+ (sem_3 _lhsIallInters _lhsIddp _lhsIfromLhs _lhsIisFirst _lhsInextInh _lhsInextIntravisits )+ in (Syn_Segment _lhsOcvisits _lhsOdescr _lhsOedp _lhsOgroups _lhsOinh _lhsOintravisits _lhsOnewedges _lhsOnewvertices _lhsOprev _lhsOseg _lhsOv _lhsOvisitss ))+sem_Segment_Segment :: ([Vertex]) ->+ ([Vertex]) ->+ T_Segment +sem_Segment_Segment !inh_ !syn_ =+ (T_Segment (\ (!_lhsIinfo)+ (!_lhsIv) ->+ (case (\a -> ruleTable _lhsIinfo ! a) of+ { !_look ->+ (case (\p us -> [ a | u <- us+ , a <- tdsToTdp _lhsIinfo ! u+ , p (_look a)]) of+ { !_occurAs ->+ (case (let group as = gather _lhsIinfo (_occurAs isRhs as)+ in map (partition (isInh . _look)) (group (inh_ ++ syn_))) of+ { !_groups ->+ (case (_lhsIv + length _groups) of+ { !_v ->+ (case (_v) of+ { !_lhsOv ->+ (case ((sem_Segment_Segment_1 _v _lhsIv _groups _look syn_ _occurAs _lhsIinfo inh_ )) of+ { ( !sem_Segment_1) ->+ ( _lhsOv,sem_Segment_1) }) }) }) }) }) })) )+sem_Segment_Segment_1 :: Int ->+ Vertex ->+ ([([Vertex],[Vertex])]) ->+ (Vertex -> CRule) ->+ ([Vertex]) ->+ ((CRule -> Bool) -> [Vertex] -> [Vertex]) ->+ Info ->+ ([Vertex]) ->+ T_Segment_1 +sem_Segment_Segment_1 !_v !_lhsIv !_groups !_look !syn_ !_occurAs !_lhsIinfo !inh_ =+ (T_Segment_1 (\ (!_lhsIn)+ (!_lhsInextNewvertices) ->+ (case ([_lhsIv .. _v -1]) of+ { !_newvertices ->+ (case (Seq.fromList $ zipWith (cv _look _lhsIn) _newvertices _groups) of+ { !_lhsOdescr ->+ (case (_groups) of+ { !_lhsOgroups ->+ (case (zip _newvertices _lhsInextNewvertices) of+ { !_visitedges ->+ (case (concat (zipWith ed _newvertices _groups)) of+ { !_attredges ->+ (case (Seq.fromList _attredges Seq.>< Seq.fromList _visitedges) of+ { !_lhsOnewedges ->+ (case (_newvertices) of+ { !_lhsOnewvertices ->+ (case ((sem_Segment_Segment_2 syn_ _occurAs _lhsIinfo inh_ )) of+ { ( !sem_Segment_2) ->+ ( _lhsOdescr,_lhsOgroups,_lhsOnewedges,_lhsOnewvertices,sem_Segment_2) }) }) }) }) }) }) }) })) )+sem_Segment_Segment_2 :: ([Vertex]) ->+ ((CRule -> Bool) -> [Vertex] -> [Vertex]) ->+ Info ->+ ([Vertex]) ->+ T_Segment_2 +sem_Segment_Segment_2 !syn_ !_occurAs !_lhsIinfo !inh_ =+ (T_Segment_2 (\ (!_lhsIcons)+ (!_lhsIprev)+ (!_lhsIvisitDescr)+ (!_lhsIvssGraph) ->+ (case (gather _lhsIinfo (_occurAs isLhs syn_)) of+ { !_synOccur ->+ (case (let hasCode v | inRange (bounds (ruleTable _lhsIinfo)) v = getHasCode (ruleTable _lhsIinfo ! v)+ | otherwise = True+ in if null syn_+ then replicate (length _lhsIcons) []+ else map (filter hasCode . topSort' _lhsIvssGraph) _synOccur) of+ { !_vss ->+ (case (map (\\ _lhsIprev) _vss) of+ { !_visitss' ->+ (case (let rem :: [(Identifier,Identifier,Maybe Type)] -> [Vertex] -> [Vertex]+ rem prev [] = []+ rem prev (v:vs)+ | inRange (bounds table) v+ = let cr = table ! 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') of+ { !_visitss ->+ (case (let defines v = case Map.lookup v _lhsIvisitDescr of+ Nothing -> [v]+ Just (ChildVisit _ _ _ inh _) -> v:inh+ in concatMap (concatMap defines) _visitss) of+ { !_defined ->+ (case (_lhsIprev ++ _defined) of+ { !_lhsOprev ->+ (case (let makemap = Map.fromList . map findType+ findType v = getNtaNameType (attrTable _lhsIinfo ! v)+ in (makemap inh_,makemap syn_)) of+ { !__tup1 ->+ (case (__tup1) of+ { !(_,!_synmap) ->+ (case (__tup1) of+ { !(!_inhmap,_) ->+ (case (if False then undefined _lhsIvssGraph _lhsIvisitDescr _lhsIprev else CSegment _inhmap _synmap) of+ { !_lhsOseg ->+ (case ((sem_Segment_Segment_3 _visitss _lhsIinfo _lhsIvisitDescr inh_ _occurAs _synmap _inhmap syn_ )) of+ { ( !sem_Segment_3) ->+ ( _lhsOprev,_lhsOseg,sem_Segment_3) }) }) }) }) }) }) }) }) }) }) })) )+sem_Segment_Segment_3 :: ([[Vertex]]) ->+ Info ->+ (Map Vertex ChildVisit) ->+ ([Vertex]) ->+ ((CRule -> Bool) -> [Vertex] -> [Vertex]) ->+ (Map Identifier Type) ->+ (Map Identifier Type) ->+ ([Vertex]) ->+ T_Segment_3 +sem_Segment_Segment_3 !_visitss !_lhsIinfo !_lhsIvisitDescr !inh_ !_occurAs !_synmap !_inhmap !syn_ =+ (T_Segment_3 (\ (!_lhsIallInters)+ (!_lhsIddp)+ (!_lhsIfromLhs)+ (!_lhsIisFirst)+ (!_lhsInextInh)+ (!_lhsInextIntravisits) ->+ (case (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) of+ { !_computed ->+ (case (_occurAs isLhs inh_ ++ _lhsIfromLhs) of+ { !_fromLhs ->+ (case (\vs next ->+ let needed = concatMap (_lhsIddp !) vs+ in nub (needed ++ next) \\ (_fromLhs ++ _computed)) of+ { !_iv ->+ (case (zipWith _iv _visitss _lhsInextIntravisits) of+ { !_intravisits ->+ (case (let mkVisit vss intra = CVisit _inhmap _synmap (mkSequence vss) (mkSequence intra) True+ mkSequence = map mkRule+ mkRule v = case Map.lookup v _lhsIvisitDescr of+ Nothing -> ruleTable _lhsIinfo ! v+ Just (ChildVisit name nt n _ _) -> ccv name nt n _lhsIallInters+ in zipWith mkVisit _visitss _intravisits) of+ { !_lhsOcvisits ->+ (case (Seq.fromList [(i,s) | i <- inh_, s <- syn_]+ Seq.>< Seq.fromList [(s,i) | s <- syn_, i <- _lhsInextInh ]) of+ { !_lhsOedp ->+ (case (inh_) of+ { !_lhsOinh ->+ (case (_intravisits) of+ { !_lhsOintravisits ->+ (case (_visitss) of+ { !_lhsOvisitss ->+ ( _lhsOcvisits,_lhsOedp,_lhsOinh,_lhsOintravisits,_lhsOvisitss) }) }) }) }) }) }) }) }) })) )+-- Segments ----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ info : Info+ n : Int+ chained attribute:+ v : Vertex+ synthesized attributes:+ descr : Seq (Vertex,ChildVisit)+ groups : [([Vertex],[Vertex])]+ newedges : Seq Edge + newvertices : [Vertex]+ visit 1:+ inherited attributes:+ cons : [ConstructorIdent]+ prev : [Vertex]+ visitDescr : Map Vertex ChildVisit+ vssGraph : Graph+ synthesized attribute:+ segs : CSegments+ visit 2:+ inherited attributes:+ allInters : CInterfaceMap+ ddp : Graph+ fromLhs : [Vertex]+ isFirst : Bool+ synthesized attributes:+ cvisits : [[CVisit]]+ edp : Seq Edge+ firstInh : [Vertex]+ hdIntravisits : [IntraVisit]+ prev : [Vertex]+ alternatives:+ alternative Cons:+ child hd : Segment + child tl : Segments + alternative Nil:+-}+-- cata+sem_Segments :: Segments ->+ T_Segments +sem_Segments !list =+ (Prelude.foldr sem_Segments_Cons sem_Segments_Nil (Prelude.map sem_Segment list) )+-- semantic domain+newtype T_Segments = T_Segments (Info ->+ Int ->+ Vertex ->+ ( (Seq (Vertex,ChildVisit)),([([Vertex],[Vertex])]),(Seq Edge ),([Vertex]),Vertex,T_Segments_1 ))+newtype T_Segments_1 = T_Segments_1 (([ConstructorIdent]) ->+ ([Vertex]) ->+ (Map Vertex ChildVisit) ->+ Graph ->+ ( CSegments,T_Segments_2 ))+newtype T_Segments_2 = T_Segments_2 (CInterfaceMap ->+ Graph ->+ ([Vertex]) ->+ Bool ->+ ( ([[CVisit]]),(Seq Edge),([Vertex]),([IntraVisit]),([Vertex])))+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 ->+ Inh_Segments ->+ Syn_Segments +wrap_Segments !(T_Segments sem ) !(Inh_Segments _lhsIallInters _lhsIcons _lhsIddp _lhsIfromLhs _lhsIinfo _lhsIisFirst _lhsIn _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) =+ (let ( !_lhsOdescr,!_lhsOgroups,!_lhsOnewedges,!_lhsOnewvertices,!_lhsOv,!T_Segments_1 sem_1) =+ (sem _lhsIinfo _lhsIn _lhsIv )+ ( !_lhsOsegs,!T_Segments_2 sem_2) =+ (sem_1 _lhsIcons _lhsIprev _lhsIvisitDescr _lhsIvssGraph )+ ( !_lhsOcvisits,!_lhsOedp,!_lhsOfirstInh,!_lhsOhdIntravisits,!_lhsOprev) =+ (sem_2 _lhsIallInters _lhsIddp _lhsIfromLhs _lhsIisFirst )+ in (Syn_Segments _lhsOcvisits _lhsOdescr _lhsOedp _lhsOfirstInh _lhsOgroups _lhsOhdIntravisits _lhsOnewedges _lhsOnewvertices _lhsOprev _lhsOsegs _lhsOv ))+sem_Segments_Cons :: T_Segment ->+ T_Segments ->+ T_Segments +sem_Segments_Cons !(T_Segment hd_ ) !(T_Segments tl_ ) =+ (T_Segments (\ (!_lhsIinfo)+ (!_lhsIn)+ (!_lhsIv) ->+ (case (_lhsIv) of+ { !_hdOv ->+ (case (_lhsIinfo) of+ { !_hdOinfo ->+ (case ((hd_ _hdOinfo _hdOv )) of+ { ( !_hdIv,!T_Segment_1 hd_1) ->+ (case (_hdIv) of+ { !_tlOv ->+ (case (_lhsIinfo) of+ { !_tlOinfo ->+ (case (_lhsIn) of+ { !_hdOn ->+ (case (_lhsIn + 1) of+ { !_tlOn ->+ (case ((tl_ _tlOinfo _tlOn _tlOv )) of+ { ( !_tlIdescr,!_tlIgroups,!_tlInewedges,!_tlInewvertices,!_tlIv,!T_Segments_1 tl_1) ->+ (case (_tlInewvertices) of+ { !_hdOnextNewvertices ->+ (case ((hd_1 _hdOn _hdOnextNewvertices )) of+ { ( !_hdIdescr,!_hdIgroups,!_hdInewedges,!_hdInewvertices,!T_Segment_2 hd_2) ->+ (case (_hdIdescr Seq.>< _tlIdescr) of+ { !_lhsOdescr ->+ (case (_hdIgroups) of+ { !_lhsOgroups ->+ (case (_hdInewedges Seq.>< _tlInewedges) of+ { !_lhsOnewedges ->+ (case (_hdInewvertices) of+ { !_lhsOnewvertices ->+ (case (_tlIv) of+ { !_lhsOv ->+ (case ((sem_Segments_Cons_1 (T_Segment_2 hd_2 ) (T_Segments_1 tl_1 ) )) of+ { ( !sem_Segments_1) ->+ ( _lhsOdescr,_lhsOgroups,_lhsOnewedges,_lhsOnewvertices,_lhsOv,sem_Segments_1) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) )+sem_Segments_Cons_1 :: T_Segment_2 ->+ T_Segments_1 ->+ T_Segments_1 +sem_Segments_Cons_1 !(T_Segment_2 hd_2 ) !(T_Segments_1 tl_1 ) =+ (T_Segments_1 (\ (!_lhsIcons)+ (!_lhsIprev)+ (!_lhsIvisitDescr)+ (!_lhsIvssGraph) ->+ (case (_lhsIvssGraph) of+ { !_tlOvssGraph ->+ (case (_lhsIvisitDescr) of+ { !_tlOvisitDescr ->+ (case (_lhsIvssGraph) of+ { !_hdOvssGraph ->+ (case (_lhsIvisitDescr) of+ { !_hdOvisitDescr ->+ (case (_lhsIprev) of+ { !_hdOprev ->+ (case (_lhsIcons) of+ { !_hdOcons ->+ (case ((hd_2 _hdOcons _hdOprev _hdOvisitDescr _hdOvssGraph )) of+ { ( !_hdIprev,!_hdIseg,!T_Segment_3 hd_3) ->+ (case (_hdIprev) of+ { !_tlOprev ->+ (case (_lhsIcons) of+ { !_tlOcons ->+ (case ((tl_1 _tlOcons _tlOprev _tlOvisitDescr _tlOvssGraph )) of+ { ( !_tlIsegs,!T_Segments_2 tl_2) ->+ (case (_hdIseg : _tlIsegs) of+ { !_lhsOsegs ->+ (case ((sem_Segments_Cons_2 (T_Segments_2 tl_2 ) (T_Segment_3 hd_3 ) )) of+ { ( !sem_Segments_2) ->+ ( _lhsOsegs,sem_Segments_2) }) }) }) }) }) }) }) }) }) }) }) })) )+sem_Segments_Cons_2 :: T_Segments_2 ->+ T_Segment_3 ->+ T_Segments_2 +sem_Segments_Cons_2 !(T_Segments_2 tl_2 ) !(T_Segment_3 hd_3 ) =+ (T_Segments_2 (\ (!_lhsIallInters)+ (!_lhsIddp)+ (!_lhsIfromLhs)+ (!_lhsIisFirst) ->+ (case (_lhsIddp) of+ { !_tlOddp ->+ (case (_lhsIallInters) of+ { !_tlOallInters ->+ (case (_lhsIddp) of+ { !_hdOddp ->+ (case (_lhsIallInters) of+ { !_hdOallInters ->+ (case ([]) of+ { !_tlOfromLhs ->+ (case (_lhsIfromLhs) of+ { !_hdOfromLhs ->+ (case (False) of+ { !_tlOisFirst ->+ (case ((tl_2 _tlOallInters _tlOddp _tlOfromLhs _tlOisFirst )) of+ { ( !_tlIcvisits,!_tlIedp,!_tlIfirstInh,!_tlIhdIntravisits,!_tlIprev) ->+ (case (_tlIhdIntravisits) of+ { !_hdOnextIntravisits ->+ (case (_lhsIisFirst) of+ { !_hdOisFirst ->+ (case (_tlIfirstInh) of+ { !_hdOnextInh ->+ (case ((hd_3 _hdOallInters _hdOddp _hdOfromLhs _hdOisFirst _hdOnextInh _hdOnextIntravisits )) of+ { ( !_hdIcvisits,!_hdIedp,!_hdIinh,!_hdIintravisits,!_hdIvisitss) ->+ (case (_hdIcvisits : _tlIcvisits) of+ { !_lhsOcvisits ->+ (case (_hdIedp Seq.>< _tlIedp) of+ { !_lhsOedp ->+ (case (_hdIinh) of+ { !_lhsOfirstInh ->+ (case (_hdIintravisits) of+ { !_lhsOhdIntravisits ->+ (case (_tlIprev) of+ { !_lhsOprev ->+ ( _lhsOcvisits,_lhsOedp,_lhsOfirstInh,_lhsOhdIntravisits,_lhsOprev) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) )+sem_Segments_Nil :: T_Segments +sem_Segments_Nil =+ (T_Segments (\ (!_lhsIinfo)+ (!_lhsIn)+ (!_lhsIv) ->+ (case (Seq.empty) of+ { !_lhsOdescr ->+ (case ([]) of+ { !_lhsOgroups ->+ (case (Seq.empty) of+ { !_lhsOnewedges ->+ (case ([]) of+ { !_lhsOnewvertices ->+ (case (_lhsIv) of+ { !_lhsOv ->+ (case ((sem_Segments_Nil_1 )) of+ { ( !sem_Segments_1) ->+ ( _lhsOdescr,_lhsOgroups,_lhsOnewedges,_lhsOnewvertices,_lhsOv,sem_Segments_1) }) }) }) }) }) })) )+sem_Segments_Nil_1 :: T_Segments_1 +sem_Segments_Nil_1 =+ (T_Segments_1 (\ (!_lhsIcons)+ (!_lhsIprev)+ (!_lhsIvisitDescr)+ (!_lhsIvssGraph) ->+ (case ([]) of+ { !_lhsOsegs ->+ (case ((sem_Segments_Nil_2 _lhsIprev )) of+ { ( !sem_Segments_2) ->+ ( _lhsOsegs,sem_Segments_2) }) })) )+sem_Segments_Nil_2 :: ([Vertex]) ->+ T_Segments_2 +sem_Segments_Nil_2 !_lhsIprev =+ (T_Segments_2 (\ (!_lhsIallInters)+ (!_lhsIddp)+ (!_lhsIfromLhs)+ (!_lhsIisFirst) ->+ (case ([]) of+ { !_lhsOcvisits ->+ (case (Seq.empty) of+ { !_lhsOedp ->+ (case ([]) of+ { !_lhsOfirstInh ->+ (case (repeat []) of+ { !_lhsOhdIntravisits ->+ (case (_lhsIprev) of+ { !_lhsOprev -> ( _lhsOcvisits,_lhsOedp,_lhsOfirstInh,_lhsOhdIntravisits,_lhsOprev) }) }) }) }) })) )
src-derived/Order.hs view
@@ -1,3536 +1,3536 @@- - --- UUAGC 0.9.11 (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 Data.Sequence as Seq -import Data.Map(Map) -import Data.Set(Set) -import Data.Sequence(Seq, (><)) -import UU.Util.Utils -import UU.Scanner.Position(Pos(..),initPos) -import Data.Foldable(toList) - --- 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 -> - Inh_Child -> - Syn_Child -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 157, column 13) - _maptolocal = - case tp_ of - NT nt _ -> Map.null syn_ - _ -> True - -- "Order.ag"(line 160, column 13) - _lhsOgathAltAttrs = - if _maptolocal - then [ AltAttr _LOC name_ True ] - else [ AltAttr name_ syn True | syn <- Map.keys syn_ ] - -- "Order.ag"(line 175, column 13) - _lhsOnts = - Seq.singleton (name_,getNtName tp_) - -- "Order.ag"(line 176, column 13) - _lhsOinhs = - Seq.singleton (name_,inh_) - -- "Order.ag"(line 192, column 13) - _gathRules = - if _maptolocal - then Seq.singleton (cRuleTerminal name_ _lhsInt _lhsIcon tp_) - else Seq.fromList [ cRuleRhsSyn syn _lhsInt _lhsIcon tp name_ (getNtName tp_) | (syn,tp) <- Map.assocs syn_] - -- "Order.ag"(line 317, column 12) - _lhsOcollectChildrenSyns = - Map.singleton name_ syn_ - -- "Order.ag"(line 477, column 11) - _lhsOsinglevisits = - if _maptolocal - then [] - else [CChildVisit name_ (getNtName tp_) 0 inh_ syn_ True] - -- "Order.ag"(line 498, column 11) - _lhsOterminals = - if _maptolocal - then [name_] - else [] - -- "Order.ag"(line 527, column 11) - _lhsOattributes = - [(name_, inh_, syn_)] - -- "Order.ag"(line 531, column 11) - _lhsOfield = - (name_, tp_, higherOrder_) - -- use rule "Order.ag"(line 64, column 70) - _lhsOerrors = - Seq.empty - -- use rule "Order.ag"(line 186, 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 -> - Inh_Children -> - Syn_Children -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 534, column 11) - _lhsOfields = - _hdIfield : _tlIfields - -- use rule "Order.ag"(line 525, column 32) - _lhsOattributes = - _hdIattributes ++ _tlIattributes - -- use rule "Order.ag"(line 315, column 47) - _lhsOcollectChildrenSyns = - _hdIcollectChildrenSyns `Map.union` _tlIcollectChildrenSyns - -- use rule "Order.ag"(line 64, column 70) - _lhsOerrors = - _hdIerrors Seq.>< _tlIerrors - -- use rule "Order.ag"(line 150, column 68) - _lhsOgathAltAttrs = - _hdIgathAltAttrs ++ _tlIgathAltAttrs - -- use rule "Order.ag"(line 186, column 23) - _lhsOgathRules = - _hdIgathRules Seq.>< _tlIgathRules - -- use rule "Order.ag"(line 173, column 20) - _lhsOinhs = - _hdIinhs Seq.>< _tlIinhs - -- use rule "Order.ag"(line 172, column 19) - _lhsOnts = - _hdInts Seq.>< _tlInts - -- use rule "Order.ag"(line 475, column 40) - _lhsOsinglevisits = - _hdIsinglevisits ++ _tlIsinglevisits - -- use rule "Order.ag"(line 496, 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 535, column 11) - _lhsOfields = - [] - -- use rule "Order.ag"(line 525, column 32) - _lhsOattributes = - [] - -- use rule "Order.ag"(line 315, column 47) - _lhsOcollectChildrenSyns = - Map.empty - -- use rule "Order.ag"(line 64, column 70) - _lhsOerrors = - Seq.empty - -- use rule "Order.ag"(line 150, column 68) - _lhsOgathAltAttrs = - [] - -- use rule "Order.ag"(line 186, column 23) - _lhsOgathRules = - Seq.empty - -- use rule "Order.ag"(line 173, column 20) - _lhsOinhs = - Seq.empty - -- use rule "Order.ag"(line 172, column 19) - _lhsOnts = - Seq.empty - -- use rule "Order.ag"(line 475, column 40) - _lhsOsinglevisits = - [] - -- use rule "Order.ag"(line 496, 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 -> - Inh_Expression -> - Syn_Expression -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 337, 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 337, column 21) - (_errors,_,_,_,_) = - __tup1 - -- "Order.ag"(line 337, column 21) - (_,_textLines,_,_,_) = - __tup1 - -- "Order.ag"(line 337, column 21) - (_,_,_usedAttrs,_,_) = - __tup1 - -- "Order.ag"(line 337, column 21) - (_,_,_,_usedLocals,_) = - __tup1 - -- "Order.ag"(line 337, column 21) - (_,_,_,_,_usedFields) = - __tup1 - -- "Order.ag"(line 355, 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} - child uniqueMap : {UniqueMap} - 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 _uniqueMap ) = - (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts ) _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap ) --- 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 -> - Inh_Grammar -> - Syn_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 -> - UniqueMap -> - T_Grammar -sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ uniqueMap_ = - (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 103, column 17) - _nontsOo_cata = - folds _lhsIoptions - -- "Order.ag"(line 103, column 17) - _nontsOo_data = - dataTypes _lhsIoptions - -- "Order.ag"(line 103, column 17) - _nontsOo_sig = - typeSigs _lhsIoptions - -- "Order.ag"(line 103, column 17) - _nontsOo_sem = - semfuns _lhsIoptions - -- "Order.ag"(line 103, column 17) - _nontsOo_rename = - rename _lhsIoptions - -- "Order.ag"(line 103, column 17) - _nontsOo_newtypes = - newtypes _lhsIoptions - -- "Order.ag"(line 103, column 17) - _nontsOo_wantvisit = - visit _lhsIoptions - -- "Order.ag"(line 103, column 17) - _nontsOo_dovisit = - visit _lhsIoptions && null _cyclesErrors - -- "Order.ag"(line 103, column 17) - _nontsOo_unbox = - unbox _lhsIoptions - -- "Order.ag"(line 103, column 17) - _nontsOo_case = - cases _lhsIoptions - -- "Order.ag"(line 103, column 17) - _nontsOprefix = - prefix _lhsIoptions - -- "Order.ag"(line 241, column 15) - _nontsOvcount = - 0 - -- "Order.ag"(line 266, column 7) - _nontsOmanualAttrDepMap = - manualAttrOrderMap_ - -- "Order.ag"(line 369, column 13) - _nontsOacount = - 0 - -- "Order.ag"(line 407, column 13) - _ruleTable = - Array.array (0,_nontsIvcount-1) (toList _nontsIrules) - -- "Order.ag"(line 408, column 13) - _attrTable = - Array.array (0,_nontsIacount-1) (toList _nontsIntattrs) - -- "Order.ag"(line 409, column 13) - _attrVertex = - Map.fromList (map swap (toList _nontsIntattrs)) - -- "Order.ag"(line 410, column 13) - _tdpToTds = - [ (s, maybe (-1) (\v -> findWithErr1 "Grammar.tdpToTds" v _attrVertex) (ntattr cr)) - | (s,cr) <- toList _nontsIrules] - -- "Order.ag"(line 412, 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 416, column 13) - _directDep = - toList (_nontsIdirectDep Seq.>< _nontsIadditionalDep) - -- "Order.ag"(line 417, column 13) - _instDep = - toList _nontsIinstDep - -- "Order.ag"(line 418, 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 = toList _nontsIaranges - , nonts = _nontsInonts - , wraps = wrappers_ - } - -- "Order.ag"(line 429, 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 429, column 17) - (_cInterfaceMap,_,_) = - __tup2 - -- "Order.ag"(line 429, column 17) - (_,_cVisitsMap,_) = - __tup2 - -- "Order.ag"(line 429, column 17) - (_,_,_cyclesErrors) = - __tup2 - -- "Order.ag"(line 451, column 13) - _lhsOerrors = - (if withCycle _lhsIoptions then Seq.fromList _cyclesErrors else Seq.empty) - Seq.>< _nontsIerrors - -- "Order.ag"(line 483, column 15) - _lhsOoutput = - CGrammar typeSyns_ derivings_ wrappers_ _nontsIcNonterminals pragmas_ paramMap_ contextMap_ - -- "Order.ag"(line 510, 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 -> - Inh_Nonterminal -> - Syn_Nonterminal -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 77, column 17) - _prodsOnt = - nt_ - -- "Order.ag"(line 80, column 17) - _prodsOinh = - inh_ - -- "Order.ag"(line 81, column 17) - _prodsOsyn = - syn_ - -- "Order.ag"(line 372, column 17) - _ntattrs = - [ NTAInh nt_ inh tp | (inh,tp) <- Map.assocs inh_ ] - ++ [NTASyn nt_ syn tp | (syn,tp) <- Map.assocs syn_ ] - -- "Order.ag"(line 374, column 17) - _lhsOntattrs = - Seq.fromList (zip [_lhsIacount ..] _ntattrs) - -- "Order.ag"(line 375, column 17) - _lhsOacount = - _lhsIacount + Map.size inh_ + Map.size syn_ - -- "Order.ag"(line 376, column 17) - _lhsOaranges = - Seq.singleton - (_lhsIacount - ,_lhsIacount + Map.size inh_ - ,_lhsIacount + Map.size syn_ + Map.size inh_ - 1) - -- "Order.ag"(line 385, column 19) - _lhsOnonts = - [(nt_,_prodsIcons)] - -- "Order.ag"(line 460, column 19) - _cInter = - if _lhsIo_dovisit - then findWithErr1 "Nonterminal.cInter" nt_ _lhsIcInterfaceMap - else CInterface [CSegment inh_ syn_] - -- "Order.ag"(line 488, column 19) - _lhsOcNonterminal = - CNonterminal nt_ params_ inh_ syn_ _prodsIcProductions _cInter - -- use rule "Order.ag"(line 263, column 71) - _lhsOadditionalDep = - _prodsIadditionalDep - -- use rule "Order.ag"(line 249, column 33) - _lhsOdirectDep = - _prodsIdirectDep - -- use rule "Order.ag"(line 64, column 70) - _lhsOerrors = - _prodsIerrors - -- use rule "Order.ag"(line 296, column 31) - _lhsOinstDep = - _prodsIinstDep - -- use rule "Order.ag"(line 239, 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 -> - Inh_Nonterminals -> - Syn_Nonterminals -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 485, column 12) - _lhsOcNonterminals = - _hdIcNonterminal : _tlIcNonterminals - -- use rule "Order.ag"(line 263, column 71) - _lhsOadditionalDep = - _hdIadditionalDep Seq.>< _tlIadditionalDep - -- use rule "Order.ag"(line 366, column 36) - _lhsOaranges = - _hdIaranges Seq.>< _tlIaranges - -- use rule "Order.ag"(line 249, column 33) - _lhsOdirectDep = - _hdIdirectDep Seq.>< _tlIdirectDep - -- use rule "Order.ag"(line 64, column 70) - _lhsOerrors = - _hdIerrors Seq.>< _tlIerrors - -- use rule "Order.ag"(line 296, column 31) - _lhsOinstDep = - _hdIinstDep Seq.>< _tlIinstDep - -- use rule "Order.ag"(line 383, column 43) - _lhsOnonts = - _hdInonts ++ _tlInonts - -- use rule "Order.ag"(line 365, column 35) - _lhsOntattrs = - _hdIntattrs Seq.>< _tlIntattrs - -- use rule "Order.ag"(line 239, 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 486, column 12) - _lhsOcNonterminals = - [] - -- use rule "Order.ag"(line 263, column 71) - _lhsOadditionalDep = - Seq.empty - -- use rule "Order.ag"(line 366, column 36) - _lhsOaranges = - Seq.empty - -- use rule "Order.ag"(line 249, column 33) - _lhsOdirectDep = - Seq.empty - -- use rule "Order.ag"(line 64, column 70) - _lhsOerrors = - Seq.empty - -- use rule "Order.ag"(line 296, column 31) - _lhsOinstDep = - Seq.empty - -- use rule "Order.ag"(line 383, column 43) - _lhsOnonts = - [] - -- use rule "Order.ag"(line 365, column 35) - _lhsOntattrs = - Seq.empty - -- use rule "Order.ag"(line 239, 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 -> - Inh_Pattern -> - Syn_Pattern -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 164, column 12) - _lhsOgathAltAttrs = - [AltAttr field_ attr_ (field_ == _LOC || field_ == _INST)] - -- "Order.ag"(line 232, column 12) - _lhsOpatternAttrs = - [(field_,attr_,(field_ == _LOC || field_ == _INST),_partsIcopy)] - -- "Order.ag"(line 540, column 14) - _lhsOlocVars = - if field_ == _LOC - then [attr_] - else [] - -- "Order.ag"(line 543, column 14) - _lhsOinstVars = - if field_ == _INST - then [attr_] - else [] - -- use rule "Order.ag"(line 64, 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 64, column 70) - _lhsOerrors = - _patsIerrors - -- use rule "Order.ag"(line 150, column 68) - _lhsOgathAltAttrs = - _patsIgathAltAttrs - -- use rule "Order.ag"(line 537, column 86) - _lhsOinstVars = - _patsIinstVars - -- use rule "Order.ag"(line 537, column 48) - _lhsOlocVars = - _patsIlocVars - -- use rule "Order.ag"(line 229, 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 64, column 70) - _lhsOerrors = - _patIerrors - -- use rule "Order.ag"(line 150, column 68) - _lhsOgathAltAttrs = - _patIgathAltAttrs - -- use rule "Order.ag"(line 537, column 86) - _lhsOinstVars = - _patIinstVars - -- use rule "Order.ag"(line 537, column 48) - _lhsOlocVars = - _patIlocVars - -- use rule "Order.ag"(line 229, 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 64, column 70) - _lhsOerrors = - _patsIerrors - -- use rule "Order.ag"(line 150, column 68) - _lhsOgathAltAttrs = - _patsIgathAltAttrs - -- use rule "Order.ag"(line 537, column 86) - _lhsOinstVars = - _patsIinstVars - -- use rule "Order.ag"(line 537, column 48) - _lhsOlocVars = - _patsIlocVars - -- use rule "Order.ag"(line 229, 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 64, column 70) - _lhsOerrors = - Seq.empty - -- use rule "Order.ag"(line 150, column 68) - _lhsOgathAltAttrs = - [] - -- use rule "Order.ag"(line 537, column 86) - _lhsOinstVars = - [] - -- use rule "Order.ag"(line 537, column 48) - _lhsOlocVars = - [] - -- use rule "Order.ag"(line 229, 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 -> - Inh_Patterns -> - Syn_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 64, column 70) - _lhsOerrors = - _hdIerrors Seq.>< _tlIerrors - -- use rule "Order.ag"(line 150, column 68) - _lhsOgathAltAttrs = - _hdIgathAltAttrs ++ _tlIgathAltAttrs - -- use rule "Order.ag"(line 537, column 86) - _lhsOinstVars = - _hdIinstVars ++ _tlIinstVars - -- use rule "Order.ag"(line 537, column 48) - _lhsOlocVars = - _hdIlocVars ++ _tlIlocVars - -- use rule "Order.ag"(line 229, 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 64, column 70) - _lhsOerrors = - Seq.empty - -- use rule "Order.ag"(line 150, column 68) - _lhsOgathAltAttrs = - [] - -- use rule "Order.ag"(line 537, column 86) - _lhsOinstVars = - [] - -- use rule "Order.ag"(line 537, column 48) - _lhsOlocVars = - [] - -- use rule "Order.ag"(line 229, 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 -> - Inh_Production -> - Syn_Production -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 73, column 16) - _childrenOcon = - con_ - -- "Order.ag"(line 75, column 16) - _rulesOcon = - con_ - -- "Order.ag"(line 152, column 18) - _gathAltAttrs = - [ AltAttr _LHS inh True | inh <- Map.keys _lhsIinh ] - ++ _childrenIgathAltAttrs - ++ _rulesIgathAltAttrs - -- "Order.ag"(line 168, column 17) - _rulesOaltAttrs = - Map.fromList (zip _gathAltAttrs [_lhsIvcount..]) - -- "Order.ag"(line 181, column 18) - _rulesOchildNts = - Map.fromList (toList _childrenInts) - -- "Order.ag"(line 182, column 19) - _rulesOchildInhs = - Map.fromList (toList _childrenIinhs) - -- "Order.ag"(line 188, column 18) - _inhRules = - [ cRuleLhsInh inh _lhsInt con_ tp | (inh,tp) <- Map.assocs _lhsIinh ] - -- "Order.ag"(line 189, column 19) - _gathRules = - _inhRules ++ toList (_childrenIgathRules Seq.>< _rulesIgathRules) - -- "Order.ag"(line 243, column 18) - _lhsOrules = - Seq.fromList (zip [_lhsIvcount..] _gathRules) - -- "Order.ag"(line 244, column 19) - _lhsOvcount = - _lhsIvcount + length _gathRules - -- "Order.ag"(line 313, column 17) - _rulesOsynsOfChildren = - _childrenIcollectChildrenSyns - -- "Order.ag"(line 388, column 18) - _lhsOcons = - [con_] - -- "Order.ag"(line 395, column 16) - _typeSigsOtypeSigs = - Map.empty - -- "Order.ag"(line 401, column 17) - _rulesOallTypeSigs = - _typeSigsItypeSigs - -- "Order.ag"(line 467, 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 493, column 18) - _lhsOcProduction = - CProduction con_ _cVisits _childrenIfields _childrenIterminals - -- "Order.ag"(line 517, column 16) - _allfields = - _childrenIfields - -- "Order.ag"(line 517, column 16) - _attrs = - map ((,) _LOC) _rulesIlocVars ++ - map ((,) _INST) _rulesIinstVars ++ - map ((,) _LHS) _inhnames ++ - concat [map ((,) nm) (Map.keys as) | (nm,_,as) <- _childrenIattributes] - -- "Order.ag"(line 517, column 16) - _inhnames = - Map.keys _lhsIinh - -- "Order.ag"(line 517, column 16) - _synnames = - Map.keys _lhsIsyn - -- use rule "Order.ag"(line 263, column 71) - _lhsOadditionalDep = - _rulesIadditionalDep - -- use rule "Order.ag"(line 249, column 33) - _lhsOdirectDep = - _rulesIdirectDep - -- use rule "Order.ag"(line 64, column 70) - _lhsOerrors = - _childrenIerrors Seq.>< _rulesIerrors - -- use rule "Order.ag"(line 296, 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 -> - Inh_Productions -> - Syn_Productions -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 490, column 12) - _lhsOcProductions = - _hdIcProduction : _tlIcProductions - -- use rule "Order.ag"(line 263, column 71) - _lhsOadditionalDep = - _hdIadditionalDep Seq.>< _tlIadditionalDep - -- use rule "Order.ag"(line 386, column 40) - _lhsOcons = - _hdIcons ++ _tlIcons - -- use rule "Order.ag"(line 249, column 33) - _lhsOdirectDep = - _hdIdirectDep Seq.>< _tlIdirectDep - -- use rule "Order.ag"(line 64, column 70) - _lhsOerrors = - _hdIerrors Seq.>< _tlIerrors - -- use rule "Order.ag"(line 296, column 31) - _lhsOinstDep = - _hdIinstDep Seq.>< _tlIinstDep - -- use rule "Order.ag"(line 239, 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 491, column 12) - _lhsOcProductions = - [] - -- use rule "Order.ag"(line 263, column 71) - _lhsOadditionalDep = - Seq.empty - -- use rule "Order.ag"(line 386, column 40) - _lhsOcons = - [] - -- use rule "Order.ag"(line 249, column 33) - _lhsOdirectDep = - Seq.empty - -- use rule "Order.ag"(line 64, column 70) - _lhsOerrors = - Seq.empty - -- use rule "Order.ag"(line 296, column 31) - _lhsOinstDep = - Seq.empty - -- use rule "Order.ag"(line 239, 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 -> - Inh_Rule -> - Syn_Rule -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 197, 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 213, 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 251, 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 269, column 7) - _manualDeps = - Set.toList $ Map.findWithDefault Set.empty _lhsIcon $ Map.findWithDefault Map.empty _lhsInt _lhsImanualAttrDepMap - -- "Order.ag"(line 271, 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 299, 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 64, column 70) - _lhsOerrors = - _patternIerrors Seq.>< _rhsIerrors - -- use rule "Order.ag"(line 150, column 68) - _lhsOgathAltAttrs = - _patternIgathAltAttrs - -- use rule "Order.ag"(line 186, column 23) - _lhsOgathRules = - _gathRules - -- use rule "Order.ag"(line 537, column 86) - _lhsOinstVars = - _patternIinstVars - -- use rule "Order.ag"(line 537, 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 -> - Inh_Rules -> - Syn_Rules -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 263, column 71) - _lhsOadditionalDep = - _hdIadditionalDep Seq.>< _tlIadditionalDep - -- use rule "Order.ag"(line 249, column 33) - _lhsOdirectDep = - _hdIdirectDep Seq.>< _tlIdirectDep - -- use rule "Order.ag"(line 64, column 70) - _lhsOerrors = - _hdIerrors Seq.>< _tlIerrors - -- use rule "Order.ag"(line 150, column 68) - _lhsOgathAltAttrs = - _hdIgathAltAttrs ++ _tlIgathAltAttrs - -- use rule "Order.ag"(line 186, column 23) - _lhsOgathRules = - _hdIgathRules Seq.>< _tlIgathRules - -- use rule "Order.ag"(line 296, column 31) - _lhsOinstDep = - _hdIinstDep Seq.>< _tlIinstDep - -- use rule "Order.ag"(line 537, column 86) - _lhsOinstVars = - _hdIinstVars ++ _tlIinstVars - -- use rule "Order.ag"(line 537, 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 263, column 71) - _lhsOadditionalDep = - Seq.empty - -- use rule "Order.ag"(line 249, column 33) - _lhsOdirectDep = - Seq.empty - -- use rule "Order.ag"(line 64, column 70) - _lhsOerrors = - Seq.empty - -- use rule "Order.ag"(line 150, column 68) - _lhsOgathAltAttrs = - [] - -- use rule "Order.ag"(line 186, column 23) - _lhsOgathRules = - Seq.empty - -- use rule "Order.ag"(line 296, column 31) - _lhsOinstDep = - Seq.empty - -- use rule "Order.ag"(line 537, column 86) - _lhsOinstVars = - [] - -- use rule "Order.ag"(line 537, 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 -> - Inh_TypeSig -> - Syn_TypeSig -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 397, 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 -> - Inh_TypeSigs -> - Syn_TypeSigs -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 +++-- UUAGC 0.9.12 (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 Data.Sequence as Seq+import Data.Map(Map) +import Data.Set(Set)+import Data.Sequence(Seq, (><))+import UU.Util.Utils+import UU.Scanner.Position(Pos(..),initPos)+import Data.Foldable(toList)++-- 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 ->+ Inh_Child ->+ Syn_Child +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 157, column 13)+ _maptolocal =+ case tp_ of+ NT nt _ -> Map.null syn_+ _ -> True+ -- "Order.ag"(line 160, column 13)+ _lhsOgathAltAttrs =+ if _maptolocal+ then [ AltAttr _LOC name_ True ]+ else [ AltAttr name_ syn True | syn <- Map.keys syn_ ]+ -- "Order.ag"(line 175, column 13)+ _lhsOnts =+ Seq.singleton (name_,getNtName tp_)+ -- "Order.ag"(line 176, column 13)+ _lhsOinhs =+ Seq.singleton (name_,inh_)+ -- "Order.ag"(line 192, column 13)+ _gathRules =+ if _maptolocal+ then Seq.singleton (cRuleTerminal name_ _lhsInt _lhsIcon tp_)+ else Seq.fromList [ cRuleRhsSyn syn _lhsInt _lhsIcon tp name_ (getNtName tp_) | (syn,tp) <- Map.assocs syn_]+ -- "Order.ag"(line 317, column 12)+ _lhsOcollectChildrenSyns =+ Map.singleton name_ syn_+ -- "Order.ag"(line 477, column 11)+ _lhsOsinglevisits =+ if _maptolocal+ then []+ else [CChildVisit name_ (getNtName tp_) 0 inh_ syn_ True]+ -- "Order.ag"(line 498, column 11)+ _lhsOterminals =+ if _maptolocal+ then [name_]+ else []+ -- "Order.ag"(line 527, column 11)+ _lhsOattributes =+ [(name_, inh_, syn_)]+ -- "Order.ag"(line 531, column 11)+ _lhsOfield =+ (name_, tp_, higherOrder_)+ -- use rule "Order.ag"(line 64, column 70)+ _lhsOerrors =+ Seq.empty+ -- use rule "Order.ag"(line 186, 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 ->+ Inh_Children ->+ Syn_Children +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 534, column 11)+ _lhsOfields =+ _hdIfield : _tlIfields+ -- use rule "Order.ag"(line 525, column 32)+ _lhsOattributes =+ _hdIattributes ++ _tlIattributes+ -- use rule "Order.ag"(line 315, column 47)+ _lhsOcollectChildrenSyns =+ _hdIcollectChildrenSyns `Map.union` _tlIcollectChildrenSyns+ -- use rule "Order.ag"(line 64, column 70)+ _lhsOerrors =+ _hdIerrors Seq.>< _tlIerrors+ -- use rule "Order.ag"(line 150, column 68)+ _lhsOgathAltAttrs =+ _hdIgathAltAttrs ++ _tlIgathAltAttrs+ -- use rule "Order.ag"(line 186, column 23)+ _lhsOgathRules =+ _hdIgathRules Seq.>< _tlIgathRules+ -- use rule "Order.ag"(line 173, column 20)+ _lhsOinhs =+ _hdIinhs Seq.>< _tlIinhs+ -- use rule "Order.ag"(line 172, column 19)+ _lhsOnts =+ _hdInts Seq.>< _tlInts+ -- use rule "Order.ag"(line 475, column 40)+ _lhsOsinglevisits =+ _hdIsinglevisits ++ _tlIsinglevisits+ -- use rule "Order.ag"(line 496, 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 535, column 11)+ _lhsOfields =+ []+ -- use rule "Order.ag"(line 525, column 32)+ _lhsOattributes =+ []+ -- use rule "Order.ag"(line 315, column 47)+ _lhsOcollectChildrenSyns =+ Map.empty+ -- use rule "Order.ag"(line 64, column 70)+ _lhsOerrors =+ Seq.empty+ -- use rule "Order.ag"(line 150, column 68)+ _lhsOgathAltAttrs =+ []+ -- use rule "Order.ag"(line 186, column 23)+ _lhsOgathRules =+ Seq.empty+ -- use rule "Order.ag"(line 173, column 20)+ _lhsOinhs =+ Seq.empty+ -- use rule "Order.ag"(line 172, column 19)+ _lhsOnts =+ Seq.empty+ -- use rule "Order.ag"(line 475, column 40)+ _lhsOsinglevisits =+ []+ -- use rule "Order.ag"(line 496, 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 ->+ Inh_Expression ->+ Syn_Expression +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 337, 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 337, column 21)+ (_errors,_,_,_,_) =+ __tup1+ -- "Order.ag"(line 337, column 21)+ (_,_textLines,_,_,_) =+ __tup1+ -- "Order.ag"(line 337, column 21)+ (_,_,_usedAttrs,_,_) =+ __tup1+ -- "Order.ag"(line 337, column 21)+ (_,_,_,_usedLocals,_) =+ __tup1+ -- "Order.ag"(line 337, column 21)+ (_,_,_,_,_usedFields) =+ __tup1+ -- "Order.ag"(line 355, 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}+ child uniqueMap : {UniqueMap}+ 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 _uniqueMap ) =+ (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts ) _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap )+-- 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 ->+ Inh_Grammar ->+ Syn_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 ->+ UniqueMap ->+ T_Grammar +sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ uniqueMap_ =+ (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 103, column 17)+ _nontsOo_cata =+ folds _lhsIoptions+ -- "Order.ag"(line 103, column 17)+ _nontsOo_data =+ dataTypes _lhsIoptions+ -- "Order.ag"(line 103, column 17)+ _nontsOo_sig =+ typeSigs _lhsIoptions+ -- "Order.ag"(line 103, column 17)+ _nontsOo_sem =+ semfuns _lhsIoptions+ -- "Order.ag"(line 103, column 17)+ _nontsOo_rename =+ rename _lhsIoptions+ -- "Order.ag"(line 103, column 17)+ _nontsOo_newtypes =+ newtypes _lhsIoptions+ -- "Order.ag"(line 103, column 17)+ _nontsOo_wantvisit =+ visit _lhsIoptions+ -- "Order.ag"(line 103, column 17)+ _nontsOo_dovisit =+ visit _lhsIoptions && null _cyclesErrors+ -- "Order.ag"(line 103, column 17)+ _nontsOo_unbox =+ unbox _lhsIoptions+ -- "Order.ag"(line 103, column 17)+ _nontsOo_case =+ cases _lhsIoptions+ -- "Order.ag"(line 103, column 17)+ _nontsOprefix =+ prefix _lhsIoptions+ -- "Order.ag"(line 241, column 15)+ _nontsOvcount =+ 0+ -- "Order.ag"(line 266, column 7)+ _nontsOmanualAttrDepMap =+ manualAttrOrderMap_+ -- "Order.ag"(line 369, column 13)+ _nontsOacount =+ 0+ -- "Order.ag"(line 407, column 13)+ _ruleTable =+ Array.array (0,_nontsIvcount-1) (toList _nontsIrules)+ -- "Order.ag"(line 408, column 13)+ _attrTable =+ Array.array (0,_nontsIacount-1) (toList _nontsIntattrs)+ -- "Order.ag"(line 409, column 13)+ _attrVertex =+ Map.fromList (map swap (toList _nontsIntattrs))+ -- "Order.ag"(line 410, column 13)+ _tdpToTds =+ [ (s, maybe (-1) (\v -> findWithErr1 "Grammar.tdpToTds" v _attrVertex) (ntattr cr))+ | (s,cr) <- toList _nontsIrules]+ -- "Order.ag"(line 412, 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 416, column 13)+ _directDep =+ toList (_nontsIdirectDep Seq.>< _nontsIadditionalDep)+ -- "Order.ag"(line 417, column 13)+ _instDep =+ toList _nontsIinstDep+ -- "Order.ag"(line 418, 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 = toList _nontsIaranges+ , nonts = _nontsInonts+ , wraps = wrappers_+ }+ -- "Order.ag"(line 429, 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 429, column 17)+ (_cInterfaceMap,_,_) =+ __tup2+ -- "Order.ag"(line 429, column 17)+ (_,_cVisitsMap,_) =+ __tup2+ -- "Order.ag"(line 429, column 17)+ (_,_,_cyclesErrors) =+ __tup2+ -- "Order.ag"(line 451, column 13)+ _lhsOerrors =+ (if withCycle _lhsIoptions then Seq.fromList _cyclesErrors else Seq.empty)+ Seq.>< _nontsIerrors+ -- "Order.ag"(line 483, column 15)+ _lhsOoutput =+ CGrammar typeSyns_ derivings_ wrappers_ _nontsIcNonterminals pragmas_ paramMap_ contextMap_+ -- "Order.ag"(line 510, 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 ->+ Inh_Nonterminal ->+ Syn_Nonterminal +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 77, column 17)+ _prodsOnt =+ nt_+ -- "Order.ag"(line 80, column 17)+ _prodsOinh =+ inh_+ -- "Order.ag"(line 81, column 17)+ _prodsOsyn =+ syn_+ -- "Order.ag"(line 372, column 17)+ _ntattrs =+ [ NTAInh nt_ inh tp | (inh,tp) <- Map.assocs inh_ ]+ ++ [NTASyn nt_ syn tp | (syn,tp) <- Map.assocs syn_ ]+ -- "Order.ag"(line 374, column 17)+ _lhsOntattrs =+ Seq.fromList (zip [_lhsIacount ..] _ntattrs)+ -- "Order.ag"(line 375, column 17)+ _lhsOacount =+ _lhsIacount + Map.size inh_ + Map.size syn_+ -- "Order.ag"(line 376, column 17)+ _lhsOaranges =+ Seq.singleton+ (_lhsIacount+ ,_lhsIacount + Map.size inh_+ ,_lhsIacount + Map.size syn_ + Map.size inh_ - 1)+ -- "Order.ag"(line 385, column 19)+ _lhsOnonts =+ [(nt_,_prodsIcons)]+ -- "Order.ag"(line 460, column 19)+ _cInter =+ if _lhsIo_dovisit+ then findWithErr1 "Nonterminal.cInter" nt_ _lhsIcInterfaceMap+ else CInterface [CSegment inh_ syn_]+ -- "Order.ag"(line 488, column 19)+ _lhsOcNonterminal =+ CNonterminal nt_ params_ inh_ syn_ _prodsIcProductions _cInter+ -- use rule "Order.ag"(line 263, column 71)+ _lhsOadditionalDep =+ _prodsIadditionalDep+ -- use rule "Order.ag"(line 249, column 33)+ _lhsOdirectDep =+ _prodsIdirectDep+ -- use rule "Order.ag"(line 64, column 70)+ _lhsOerrors =+ _prodsIerrors+ -- use rule "Order.ag"(line 296, column 31)+ _lhsOinstDep =+ _prodsIinstDep+ -- use rule "Order.ag"(line 239, 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 ->+ Inh_Nonterminals ->+ Syn_Nonterminals +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 485, column 12)+ _lhsOcNonterminals =+ _hdIcNonterminal : _tlIcNonterminals+ -- use rule "Order.ag"(line 263, column 71)+ _lhsOadditionalDep =+ _hdIadditionalDep Seq.>< _tlIadditionalDep+ -- use rule "Order.ag"(line 366, column 36)+ _lhsOaranges =+ _hdIaranges Seq.>< _tlIaranges+ -- use rule "Order.ag"(line 249, column 33)+ _lhsOdirectDep =+ _hdIdirectDep Seq.>< _tlIdirectDep+ -- use rule "Order.ag"(line 64, column 70)+ _lhsOerrors =+ _hdIerrors Seq.>< _tlIerrors+ -- use rule "Order.ag"(line 296, column 31)+ _lhsOinstDep =+ _hdIinstDep Seq.>< _tlIinstDep+ -- use rule "Order.ag"(line 383, column 43)+ _lhsOnonts =+ _hdInonts ++ _tlInonts+ -- use rule "Order.ag"(line 365, column 35)+ _lhsOntattrs =+ _hdIntattrs Seq.>< _tlIntattrs+ -- use rule "Order.ag"(line 239, 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 486, column 12)+ _lhsOcNonterminals =+ []+ -- use rule "Order.ag"(line 263, column 71)+ _lhsOadditionalDep =+ Seq.empty+ -- use rule "Order.ag"(line 366, column 36)+ _lhsOaranges =+ Seq.empty+ -- use rule "Order.ag"(line 249, column 33)+ _lhsOdirectDep =+ Seq.empty+ -- use rule "Order.ag"(line 64, column 70)+ _lhsOerrors =+ Seq.empty+ -- use rule "Order.ag"(line 296, column 31)+ _lhsOinstDep =+ Seq.empty+ -- use rule "Order.ag"(line 383, column 43)+ _lhsOnonts =+ []+ -- use rule "Order.ag"(line 365, column 35)+ _lhsOntattrs =+ Seq.empty+ -- use rule "Order.ag"(line 239, 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 ->+ Inh_Pattern ->+ Syn_Pattern +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 164, column 12)+ _lhsOgathAltAttrs =+ [AltAttr field_ attr_ (field_ == _LOC || field_ == _INST)]+ -- "Order.ag"(line 232, column 12)+ _lhsOpatternAttrs =+ [(field_,attr_,(field_ == _LOC || field_ == _INST),_partsIcopy)]+ -- "Order.ag"(line 540, column 14)+ _lhsOlocVars =+ if field_ == _LOC+ then [attr_]+ else []+ -- "Order.ag"(line 543, column 14)+ _lhsOinstVars =+ if field_ == _INST+ then [attr_]+ else []+ -- use rule "Order.ag"(line 64, 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 64, column 70)+ _lhsOerrors =+ _patsIerrors+ -- use rule "Order.ag"(line 150, column 68)+ _lhsOgathAltAttrs =+ _patsIgathAltAttrs+ -- use rule "Order.ag"(line 537, column 86)+ _lhsOinstVars =+ _patsIinstVars+ -- use rule "Order.ag"(line 537, column 48)+ _lhsOlocVars =+ _patsIlocVars+ -- use rule "Order.ag"(line 229, 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 64, column 70)+ _lhsOerrors =+ _patIerrors+ -- use rule "Order.ag"(line 150, column 68)+ _lhsOgathAltAttrs =+ _patIgathAltAttrs+ -- use rule "Order.ag"(line 537, column 86)+ _lhsOinstVars =+ _patIinstVars+ -- use rule "Order.ag"(line 537, column 48)+ _lhsOlocVars =+ _patIlocVars+ -- use rule "Order.ag"(line 229, 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 64, column 70)+ _lhsOerrors =+ _patsIerrors+ -- use rule "Order.ag"(line 150, column 68)+ _lhsOgathAltAttrs =+ _patsIgathAltAttrs+ -- use rule "Order.ag"(line 537, column 86)+ _lhsOinstVars =+ _patsIinstVars+ -- use rule "Order.ag"(line 537, column 48)+ _lhsOlocVars =+ _patsIlocVars+ -- use rule "Order.ag"(line 229, 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 64, column 70)+ _lhsOerrors =+ Seq.empty+ -- use rule "Order.ag"(line 150, column 68)+ _lhsOgathAltAttrs =+ []+ -- use rule "Order.ag"(line 537, column 86)+ _lhsOinstVars =+ []+ -- use rule "Order.ag"(line 537, column 48)+ _lhsOlocVars =+ []+ -- use rule "Order.ag"(line 229, 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 ->+ Inh_Patterns ->+ Syn_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 64, column 70)+ _lhsOerrors =+ _hdIerrors Seq.>< _tlIerrors+ -- use rule "Order.ag"(line 150, column 68)+ _lhsOgathAltAttrs =+ _hdIgathAltAttrs ++ _tlIgathAltAttrs+ -- use rule "Order.ag"(line 537, column 86)+ _lhsOinstVars =+ _hdIinstVars ++ _tlIinstVars+ -- use rule "Order.ag"(line 537, column 48)+ _lhsOlocVars =+ _hdIlocVars ++ _tlIlocVars+ -- use rule "Order.ag"(line 229, 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 64, column 70)+ _lhsOerrors =+ Seq.empty+ -- use rule "Order.ag"(line 150, column 68)+ _lhsOgathAltAttrs =+ []+ -- use rule "Order.ag"(line 537, column 86)+ _lhsOinstVars =+ []+ -- use rule "Order.ag"(line 537, column 48)+ _lhsOlocVars =+ []+ -- use rule "Order.ag"(line 229, 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 ->+ Inh_Production ->+ Syn_Production +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 73, column 16)+ _childrenOcon =+ con_+ -- "Order.ag"(line 75, column 16)+ _rulesOcon =+ con_+ -- "Order.ag"(line 152, column 18)+ _gathAltAttrs =+ [ AltAttr _LHS inh True | inh <- Map.keys _lhsIinh ]+ ++ _childrenIgathAltAttrs+ ++ _rulesIgathAltAttrs+ -- "Order.ag"(line 168, column 17)+ _rulesOaltAttrs =+ Map.fromList (zip _gathAltAttrs [_lhsIvcount..])+ -- "Order.ag"(line 181, column 18)+ _rulesOchildNts =+ Map.fromList (toList _childrenInts)+ -- "Order.ag"(line 182, column 19)+ _rulesOchildInhs =+ Map.fromList (toList _childrenIinhs)+ -- "Order.ag"(line 188, column 18)+ _inhRules =+ [ cRuleLhsInh inh _lhsInt con_ tp | (inh,tp) <- Map.assocs _lhsIinh ]+ -- "Order.ag"(line 189, column 19)+ _gathRules =+ _inhRules ++ toList (_childrenIgathRules Seq.>< _rulesIgathRules)+ -- "Order.ag"(line 243, column 18)+ _lhsOrules =+ Seq.fromList (zip [_lhsIvcount..] _gathRules)+ -- "Order.ag"(line 244, column 19)+ _lhsOvcount =+ _lhsIvcount + length _gathRules+ -- "Order.ag"(line 313, column 17)+ _rulesOsynsOfChildren =+ _childrenIcollectChildrenSyns+ -- "Order.ag"(line 388, column 18)+ _lhsOcons =+ [con_]+ -- "Order.ag"(line 395, column 16)+ _typeSigsOtypeSigs =+ Map.empty+ -- "Order.ag"(line 401, column 17)+ _rulesOallTypeSigs =+ _typeSigsItypeSigs+ -- "Order.ag"(line 467, 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 493, column 18)+ _lhsOcProduction =+ CProduction con_ _cVisits _childrenIfields _childrenIterminals+ -- "Order.ag"(line 517, column 16)+ _allfields =+ _childrenIfields+ -- "Order.ag"(line 517, column 16)+ _attrs =+ map ((,) _LOC) _rulesIlocVars +++ map ((,) _INST) _rulesIinstVars +++ map ((,) _LHS) _inhnames +++ concat [map ((,) nm) (Map.keys as) | (nm,_,as) <- _childrenIattributes]+ -- "Order.ag"(line 517, column 16)+ _inhnames =+ Map.keys _lhsIinh+ -- "Order.ag"(line 517, column 16)+ _synnames =+ Map.keys _lhsIsyn+ -- use rule "Order.ag"(line 263, column 71)+ _lhsOadditionalDep =+ _rulesIadditionalDep+ -- use rule "Order.ag"(line 249, column 33)+ _lhsOdirectDep =+ _rulesIdirectDep+ -- use rule "Order.ag"(line 64, column 70)+ _lhsOerrors =+ _childrenIerrors Seq.>< _rulesIerrors+ -- use rule "Order.ag"(line 296, 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 ->+ Inh_Productions ->+ Syn_Productions +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 490, column 12)+ _lhsOcProductions =+ _hdIcProduction : _tlIcProductions+ -- use rule "Order.ag"(line 263, column 71)+ _lhsOadditionalDep =+ _hdIadditionalDep Seq.>< _tlIadditionalDep+ -- use rule "Order.ag"(line 386, column 40)+ _lhsOcons =+ _hdIcons ++ _tlIcons+ -- use rule "Order.ag"(line 249, column 33)+ _lhsOdirectDep =+ _hdIdirectDep Seq.>< _tlIdirectDep+ -- use rule "Order.ag"(line 64, column 70)+ _lhsOerrors =+ _hdIerrors Seq.>< _tlIerrors+ -- use rule "Order.ag"(line 296, column 31)+ _lhsOinstDep =+ _hdIinstDep Seq.>< _tlIinstDep+ -- use rule "Order.ag"(line 239, 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 491, column 12)+ _lhsOcProductions =+ []+ -- use rule "Order.ag"(line 263, column 71)+ _lhsOadditionalDep =+ Seq.empty+ -- use rule "Order.ag"(line 386, column 40)+ _lhsOcons =+ []+ -- use rule "Order.ag"(line 249, column 33)+ _lhsOdirectDep =+ Seq.empty+ -- use rule "Order.ag"(line 64, column 70)+ _lhsOerrors =+ Seq.empty+ -- use rule "Order.ag"(line 296, column 31)+ _lhsOinstDep =+ Seq.empty+ -- use rule "Order.ag"(line 239, 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 ->+ Inh_Rule ->+ Syn_Rule +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 197, 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 213, 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 251, 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 269, column 7)+ _manualDeps =+ Set.toList $ Map.findWithDefault Set.empty _lhsIcon $ Map.findWithDefault Map.empty _lhsInt _lhsImanualAttrDepMap+ -- "Order.ag"(line 271, 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 299, 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 64, column 70)+ _lhsOerrors =+ _patternIerrors Seq.>< _rhsIerrors+ -- use rule "Order.ag"(line 150, column 68)+ _lhsOgathAltAttrs =+ _patternIgathAltAttrs+ -- use rule "Order.ag"(line 186, column 23)+ _lhsOgathRules =+ _gathRules+ -- use rule "Order.ag"(line 537, column 86)+ _lhsOinstVars =+ _patternIinstVars+ -- use rule "Order.ag"(line 537, 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 ->+ Inh_Rules ->+ Syn_Rules +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 263, column 71)+ _lhsOadditionalDep =+ _hdIadditionalDep Seq.>< _tlIadditionalDep+ -- use rule "Order.ag"(line 249, column 33)+ _lhsOdirectDep =+ _hdIdirectDep Seq.>< _tlIdirectDep+ -- use rule "Order.ag"(line 64, column 70)+ _lhsOerrors =+ _hdIerrors Seq.>< _tlIerrors+ -- use rule "Order.ag"(line 150, column 68)+ _lhsOgathAltAttrs =+ _hdIgathAltAttrs ++ _tlIgathAltAttrs+ -- use rule "Order.ag"(line 186, column 23)+ _lhsOgathRules =+ _hdIgathRules Seq.>< _tlIgathRules+ -- use rule "Order.ag"(line 296, column 31)+ _lhsOinstDep =+ _hdIinstDep Seq.>< _tlIinstDep+ -- use rule "Order.ag"(line 537, column 86)+ _lhsOinstVars =+ _hdIinstVars ++ _tlIinstVars+ -- use rule "Order.ag"(line 537, 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 263, column 71)+ _lhsOadditionalDep =+ Seq.empty+ -- use rule "Order.ag"(line 249, column 33)+ _lhsOdirectDep =+ Seq.empty+ -- use rule "Order.ag"(line 64, column 70)+ _lhsOerrors =+ Seq.empty+ -- use rule "Order.ag"(line 150, column 68)+ _lhsOgathAltAttrs =+ []+ -- use rule "Order.ag"(line 186, column 23)+ _lhsOgathRules =+ Seq.empty+ -- use rule "Order.ag"(line 296, column 31)+ _lhsOinstDep =+ Seq.empty+ -- use rule "Order.ag"(line 537, column 86)+ _lhsOinstVars =+ []+ -- use rule "Order.ag"(line 537, 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 ->+ Inh_TypeSig ->+ Syn_TypeSig +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 397, 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 ->+ Inh_TypeSigs ->+ Syn_TypeSigs +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,62 +1,62 @@- - --- UUAGC 0.9.11 (Patterns.ag) -module Patterns where - --- Patterns.ag imports -import UU.Scanner.Position(Pos) -import CommonTypes (ConstructorIdent,Identifier) --- Pattern ----------------------------------------------------- -{- - visit 0: - synthesized attribute: - copy : SELF - 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 : _ --} -data Pattern = Alias (Identifier) (Identifier) (Pattern) (Patterns) - | Constr (ConstructorIdent) (Patterns) - | Irrefutable (Pattern) - | Product (Pos) (Patterns) - | Underscore (Pos) - deriving ( Show) --- Patterns ---------------------------------------------------- -{- - visit 0: - synthesized attribute: - copy : SELF - alternatives: - alternative Cons: - child hd : Pattern - child tl : Patterns - visit 0: - local copy : _ - alternative Nil: - visit 0: - local copy : _ --} +++-- UUAGC 0.9.12 (Patterns.ag)+module Patterns where++-- Patterns.ag imports+import UU.Scanner.Position(Pos)+import CommonTypes (ConstructorIdent,Identifier)+-- Pattern -----------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ copy : SELF + 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 : _+-}+data Pattern = Alias (Identifier) (Identifier) (Pattern) (Patterns) + | Constr (ConstructorIdent) (Patterns) + | Irrefutable (Pattern) + | Product (Pos) (Patterns) + | Underscore (Pos) + deriving ( Show)+-- Patterns ----------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ copy : SELF + alternatives:+ alternative Cons:+ child hd : Pattern + child tl : Patterns + visit 0:+ local copy : _+ alternative Nil:+ visit 0:+ local copy : _+-} type Patterns = [(Pattern)]
src-derived/PrintCode.hs view
@@ -1,2218 +1,2218 @@-{-# OPTIONS_GHC -fbang-patterns #-} - --- UUAGC 0.9.11 (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 CommonTypes(BlockInfo, BlockType(..), identifier) - - -import Pretty -import Patterns -import Data.List(partition) -import Data.Set(Set) -import qualified Data.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 -> - Inh_CaseAlt -> - Syn_CaseAlt -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) -> - (case (_lhsIoutputfile) of - { !_exprOoutputfile -> - (case (_lhsIoptions) of - { !_exprOoptions -> - (case (_lhsInested) of - { !_exprOnested -> - (case (_lhsIoutputfile) of - { !_leftOoutputfile -> - (case (_lhsIoptions) of - { !_leftOoptions -> - (case (_lhsInested) of - { !_leftOnested -> - (case (False) of - { !_leftOisDeclOfLet -> - (case ((expr_ _exprOnested _exprOoptions _exprOoutputfile )) of - { ( !_exprIpp) -> - (case ((left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile )) of - { ( !_leftIpp) -> - (case (["{" >#< _leftIpp >#< "->", _exprIpp >#< "}"]) of - { !_lhsOpps -> - ( _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 -> - Inh_CaseAlts -> - Syn_CaseAlts -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) -> - (case (_lhsIoutputfile) of - { !_tlOoutputfile -> - (case (_lhsIoptions) of - { !_tlOoptions -> - (case (_lhsInested) of - { !_tlOnested -> - (case (_lhsIoutputfile) of - { !_hdOoutputfile -> - (case (_lhsIoptions) of - { !_hdOoptions -> - (case (_lhsInested) of - { !_hdOnested -> - (case ((tl_ _tlOnested _tlOoptions _tlOoutputfile )) of - { ( !_tlIpps) -> - (case ((hd_ _hdOnested _hdOoptions _hdOoutputfile )) of - { ( !_hdIpps) -> - (case (_hdIpps ++ _tlIpps) of - { !_lhsOpps -> - ( _lhsOpps) }) }) }) }) }) }) }) }) })) ) -sem_CaseAlts_Nil :: T_CaseAlts -sem_CaseAlts_Nil = - (T_CaseAlts (\ (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case ([]) of - { !_lhsOpps -> - ( _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 - textBlockMap : Map BlockInfo PP_Doc - 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 -> - (Map BlockInfo PP_Doc) -> - 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),textBlockMap_Inh_Chunk :: !(Map BlockInfo PP_Doc),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 -> - Inh_Chunk -> - Syn_Chunk -wrap_Chunk !(T_Chunk sem ) !(Inh_Chunk _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks ) = - (let ( !_lhsOappendCommon,!_lhsOappendMain,!_lhsOgenSems,!_lhsOimports,!_lhsOpps) = - (sem _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _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) - (!_lhsItextBlockMap) - (!_lhsItextBlocks) -> - (case (if sepSemMods _lhsIoptions - then _lhsImainFile ++ "_" ++ name_ ++ ".hs" - else _lhsImainFile ++ ".hs") of - { !_outputfile -> - (case (_outputfile) of - { !_semDomOoutputfile -> - (case (_lhsIoptions) of - { !_semDomOoptions -> - (case (_lhsInested) of - { !_semDomOnested -> - (case (_lhsIisDeclOfLet) of - { !_semDomOisDeclOfLet -> - (case (_outputfile) of - { !_dataDefOoutputfile -> - (case (_lhsIoptions) of - { !_dataDefOoptions -> - (case (_lhsInested) of - { !_dataDefOnested -> - (case (_lhsIisDeclOfLet) of - { !_dataDefOisDeclOfLet -> - (case (_outputfile) of - { !_commentOoutputfile -> - (case (_lhsIoptions) of - { !_commentOoptions -> - (case (_lhsInested) of - { !_commentOnested -> - (case (_lhsIisDeclOfLet) of - { !_commentOisDeclOfLet -> - (case ((semDom_ _semDomOisDeclOfLet _semDomOnested _semDomOoptions _semDomOoutputfile )) of - { ( !_semDomIpps) -> - (case ((dataDef_ _dataDefOisDeclOfLet _dataDefOnested _dataDefOoptions _dataDefOoutputfile )) of - { ( !_dataDefIpps) -> - (case ((comment_ _commentOisDeclOfLet _commentOnested _commentOoptions _commentOoutputfile )) of - { ( !_commentIpp) -> - (case ([ [_commentIpp] - , _dataDefIpps - , _semDomIpps - ]) of - { !_lhsOappendCommon -> - (case (_outputfile) of - { !_semWrapperOoutputfile -> - (case (_lhsIoptions) of - { !_semWrapperOoptions -> - (case (_lhsInested) of - { !_semWrapperOnested -> - (case (_lhsIisDeclOfLet) of - { !_semWrapperOisDeclOfLet -> - (case (_outputfile) of - { !_cataFunOoutputfile -> - (case (_lhsIoptions) of - { !_cataFunOoptions -> - (case (_lhsInested) of - { !_cataFunOnested -> - (case (_lhsIisDeclOfLet) of - { !_cataFunOisDeclOfLet -> - (case ((semWrapper_ _semWrapperOisDeclOfLet _semWrapperOnested _semWrapperOoptions _semWrapperOoutputfile )) of - { ( !_semWrapperIpps) -> - (case ((cataFun_ _cataFunOisDeclOfLet _cataFunOnested _cataFunOoptions _cataFunOoutputfile )) of - { ( !_cataFunIpps) -> - (case ([ [_commentIpp] - , _cataFunIpps - , _semWrapperIpps - ]) of - { !_lhsOappendMain -> - (case (_outputfile) of - { !_semFunctionsOoutputfile -> - (case (_lhsIoptions) of - { !_semFunctionsOoptions -> - (case (_lhsInested) of - { !_semFunctionsOnested -> - (case (_lhsIisDeclOfLet) of - { !_semFunctionsOisDeclOfLet -> - (case (_outputfile) of - { !_infoOoutputfile -> - (case (_lhsIoptions) of - { !_infoOoptions -> - (case (_lhsInested) of - { !_infoOnested -> - (case (_lhsIisDeclOfLet) of - { !_infoOisDeclOfLet -> - (case (concat $ intersperse "," semNames_) of - { !_exports -> - (case ((semFunctions_ _semFunctionsOisDeclOfLet _semFunctionsOnested _semFunctionsOoptions _semFunctionsOoutputfile )) of - { ( !_semFunctionsIpps) -> - (case ((info_ _infoOisDeclOfLet _infoOnested _infoOoptions _infoOoutputfile )) of - { ( !_infoIpps) -> - (case (writeModule _outputfile - [ pp $ _lhsIpragmaBlocks - , pp $ Map.findWithDefault empty (BlockPragma, Just $ identifier name_) _lhsItextBlockMap - , pp $ _lhsIoptionsLine - , pp $ _lhsImoduleHeader _lhsImainName ("_" ++ name_) _exports True - , pp $ ("import " ++ _lhsImainName ++ "_common\n") - , pp $ Map.findWithDefault empty (BlockImport, Just $ identifier name_) _lhsItextBlockMap - , _commentIpp - , vlist_sep "" _infoIpps - , vlist_sep "" _semFunctionsIpps - , Map.findWithDefault empty (BlockOther, Just $ identifier name_) _lhsItextBlockMap - ]) of - { !_lhsOgenSems -> - (case (["import " ++ _lhsImainName ++ "_" ++ name_ ++ "\n"]) of - { !_lhsOimports -> - (case (_commentIpp - : _infoIpps - ++ _dataDefIpps - ++ _cataFunIpps - ++ _semDomIpps - ++ _semWrapperIpps - ++ _semFunctionsIpps - ++ [Map.findWithDefault empty (BlockOther, Just $ identifier name_) _lhsItextBlockMap]) of - { !_lhsOpps -> - ( _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 - textBlockMap : Map BlockInfo PP_Doc - 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 -> - (Map BlockInfo PP_Doc) -> - 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),textBlockMap_Inh_Chunks :: !(Map BlockInfo PP_Doc),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 -> - Inh_Chunks -> - Syn_Chunks -wrap_Chunks !(T_Chunks sem ) !(Inh_Chunks _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks ) = - (let ( !_lhsOappendCommon,!_lhsOappendMain,!_lhsOgenSems,!_lhsOimports,!_lhsOpps) = - (sem _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _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) - (!_lhsItextBlockMap) - (!_lhsItextBlocks) -> - (case (_lhsIoptions) of - { !_tlOoptions -> - (case (_lhsInested) of - { !_tlOnested -> - (case (_lhsImainFile) of - { !_tlOmainFile -> - (case (_lhsIisDeclOfLet) of - { !_tlOisDeclOfLet -> - (case (_lhsIoptions) of - { !_hdOoptions -> - (case (_lhsInested) of - { !_hdOnested -> - (case (_lhsImainFile) of - { !_hdOmainFile -> - (case (_lhsIisDeclOfLet) of - { !_hdOisDeclOfLet -> - (case (_lhsItextBlocks) of - { !_tlOtextBlocks -> - (case (_lhsItextBlockMap) of - { !_tlOtextBlockMap -> - (case (_lhsIpragmaBlocks) of - { !_tlOpragmaBlocks -> - (case (_lhsIoptionsLine) of - { !_tlOoptionsLine -> - (case (_lhsImoduleHeader) of - { !_tlOmoduleHeader -> - (case (_lhsImainName) of - { !_tlOmainName -> - (case (_lhsIimportBlocks) of - { !_tlOimportBlocks -> - (case ((tl_ _tlOimportBlocks _tlOisDeclOfLet _tlOmainFile _tlOmainName _tlOmoduleHeader _tlOnested _tlOoptions _tlOoptionsLine _tlOpragmaBlocks _tlOtextBlockMap _tlOtextBlocks )) of - { ( !_tlIappendCommon,!_tlIappendMain,!_tlIgenSems,!_tlIimports,!_tlIpps) -> - (case (_lhsItextBlocks) of - { !_hdOtextBlocks -> - (case (_lhsItextBlockMap) of - { !_hdOtextBlockMap -> - (case (_lhsIpragmaBlocks) of - { !_hdOpragmaBlocks -> - (case (_lhsIoptionsLine) of - { !_hdOoptionsLine -> - (case (_lhsImoduleHeader) of - { !_hdOmoduleHeader -> - (case (_lhsImainName) of - { !_hdOmainName -> - (case (_lhsIimportBlocks) of - { !_hdOimportBlocks -> - (case ((hd_ _hdOimportBlocks _hdOisDeclOfLet _hdOmainFile _hdOmainName _hdOmoduleHeader _hdOnested _hdOoptions _hdOoptionsLine _hdOpragmaBlocks _hdOtextBlockMap _hdOtextBlocks )) of - { ( !_hdIappendCommon,!_hdIappendMain,!_hdIgenSems,!_hdIimports,!_hdIpps) -> - (case (_hdIappendCommon ++ _tlIappendCommon) of - { !_lhsOappendCommon -> - (case (_hdIappendMain ++ _tlIappendMain) of - { !_lhsOappendMain -> - (case (_hdIgenSems >> _tlIgenSems) of - { !_lhsOgenSems -> - (case (_hdIimports ++ _tlIimports) of - { !_lhsOimports -> - (case (_hdIpps ++ _tlIpps) of - { !_lhsOpps -> - ( _lhsOappendCommon,_lhsOappendMain,_lhsOgenSems,_lhsOimports,_lhsOpps) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Chunks_Nil :: T_Chunks -sem_Chunks_Nil = - (T_Chunks (\ (!_lhsIimportBlocks) - (!_lhsIisDeclOfLet) - (!_lhsImainFile) - (!_lhsImainName) - (!_lhsImoduleHeader) - (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoptionsLine) - (!_lhsIpragmaBlocks) - (!_lhsItextBlockMap) - (!_lhsItextBlocks) -> - (case ([]) of - { !_lhsOappendCommon -> - (case ([]) of - { !_lhsOappendMain -> - (case (return ()) of - { !_lhsOgenSems -> - (case ([]) of - { !_lhsOimports -> - (case ([]) of - { !_lhsOpps -> - ( _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 -> - Inh_DataAlt -> - Syn_DataAlt -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) -> - (case (name_ >#< hv_sp (map ((_lhsIstrictPre >|<) . pp_parens . text) args_)) of - { !_lhsOpp -> - ( _lhsOpp) })) ) -sem_DataAlt_Record :: String -> - ([(String,String)]) -> - T_DataAlt -sem_DataAlt_Record !name_ !args_ = - (T_DataAlt (\ (!_lhsInested) - (!_lhsIstrictPre) -> - (case (name_ >#< pp_block "{" "}" "," - [ f >#< "::" >#< t | (f,t) <- args_ ]) of - { !_lhsOpp -> - ( _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 -> - Inh_DataAlts -> - Syn_DataAlts -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) -> - (case (_lhsIstrictPre) of - { !_tlOstrictPre -> - (case (_lhsIstrictPre) of - { !_hdOstrictPre -> - (case (_lhsInested) of - { !_tlOnested -> - (case ((tl_ _tlOnested _tlOstrictPre )) of - { ( !_tlIpps) -> - (case (_lhsInested) of - { !_hdOnested -> - (case ((hd_ _hdOnested _hdOstrictPre )) of - { ( !_hdIpp) -> - (case (_hdIpp : _tlIpps) of - { !_lhsOpps -> - ( _lhsOpps) }) }) }) }) }) }) })) ) -sem_DataAlts_Nil :: T_DataAlts -sem_DataAlts_Nil = - (T_DataAlts (\ (!_lhsInested) - (!_lhsIstrictPre) -> - (case ([]) of - { !_lhsOpps -> - ( _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 -> - Inh_Decl -> - Syn_Decl -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) -> - (case (if '\n' `elem` txt_ - then "{-" >-< vlist (lines txt_) >-< "-}" - else "--" >#< txt_) of - { !_lhsOpp -> - ( _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) -> - (case (if strict_ then pp "!" else empty) of - { !_altsOstrictPre -> - (case (_lhsInested) of - { !_altsOnested -> - (case ((alts_ _altsOnested _altsOstrictPre )) of - { ( !_altsIpps) -> - (case ("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_) - )) of - { !_lhsOpp -> - ( _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) -> - (case (_lhsIoutputfile) of - { !_rhsOoutputfile -> - (case (_lhsIoptions) of - { !_rhsOoptions -> - (case (_lhsInested) of - { !_rhsOnested -> - (case (_lhsIoutputfile) of - { !_leftOoutputfile -> - (case (_lhsIoptions) of - { !_leftOoptions -> - (case (_lhsInested) of - { !_leftOnested -> - (case (_lhsIisDeclOfLet) of - { !_leftOisDeclOfLet -> - (case ((rhs_ _rhsOnested _rhsOoptions _rhsOoutputfile )) of - { ( !_rhsIpp) -> - (case ((left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile )) of - { ( !_leftIpp) -> - (case (_leftIpp >#< "=" - >-< indent 4 _rhsIpp) of - { !_lhsOpp -> - ( _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) -> - (case (_lhsInested) of - { !_tpOnested -> - (case ((tp_ _tpOnested )) of - { ( !_tpIpp,!_tpIprec) -> - (case ("newtype" >#< hv_sp (name_ : params_) >#< "=" >#< con_ >#< pp_parens _tpIpp) of - { !_lhsOpp -> - ( _lhsOpp) }) }) })) ) -sem_Decl_PragmaDecl :: String -> - T_Decl -sem_Decl_PragmaDecl !txt_ = - (T_Decl (\ (!_lhsIisDeclOfLet) - (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case ("{-#" >#< text txt_ >#< "#-}") of - { !_lhsOpp -> - ( _lhsOpp) })) ) -sem_Decl_TSig :: String -> - T_Type -> - T_Decl -sem_Decl_TSig !name_ !(T_Type tp_ ) = - (T_Decl (\ (!_lhsIisDeclOfLet) - (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (_lhsInested) of - { !_tpOnested -> - (case ((tp_ _tpOnested )) of - { ( !_tpIpp,!_tpIprec) -> - (case (name_ >#< "::" >#< _tpIpp) of - { !_lhsOpp -> - ( _lhsOpp) }) }) })) ) -sem_Decl_Type :: String -> - ([String]) -> - T_Type -> - T_Decl -sem_Decl_Type !name_ !params_ !(T_Type tp_ ) = - (T_Decl (\ (!_lhsIisDeclOfLet) - (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (_lhsInested) of - { !_tpOnested -> - (case ((tp_ _tpOnested )) of - { ( !_tpIpp,!_tpIprec) -> - (case ("type" >#< hv_sp (name_ : params_) >#< "=" >#< _tpIpp) of - { !_lhsOpp -> - ( _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 -> - Inh_Decls -> - Syn_Decls -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) -> - (case (_lhsIoutputfile) of - { !_tlOoutputfile -> - (case (_lhsIoptions) of - { !_tlOoptions -> - (case (_lhsInested) of - { !_tlOnested -> - (case (_lhsIisDeclOfLet) of - { !_tlOisDeclOfLet -> - (case (_lhsIoutputfile) of - { !_hdOoutputfile -> - (case (_lhsIoptions) of - { !_hdOoptions -> - (case (_lhsInested) of - { !_hdOnested -> - (case (_lhsIisDeclOfLet) of - { !_hdOisDeclOfLet -> - (case ((tl_ _tlOisDeclOfLet _tlOnested _tlOoptions _tlOoutputfile )) of - { ( !_tlIpps) -> - (case ((hd_ _hdOisDeclOfLet _hdOnested _hdOoptions _hdOoutputfile )) of - { ( !_hdIpp) -> - (case (_hdIpp : _tlIpps) of - { !_lhsOpps -> - ( _lhsOpps) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Decls_Nil :: T_Decls -sem_Decls_Nil = - (T_Decls (\ (!_lhsIisDeclOfLet) - (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case ([]) of - { !_lhsOpps -> - ( _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 addBang : _ - local strictParams : _ - 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 -> - Inh_Expr -> - Syn_Expr -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) -> - (case (_lhsIoutputfile) of - { !_argsOoutputfile -> - (case (_lhsIoptions) of - { !_argsOoptions -> - (case (_lhsInested) of - { !_argsOnested -> - (case ((args_ _argsOnested _argsOoptions _argsOoutputfile )) of - { ( !_argsIpps) -> - (case (pp_parens $ name_ >#< hv_sp _argsIpps) of - { !_lhsOpp -> - ( _lhsOpp) }) }) }) }) })) ) -sem_Expr_Case :: T_Expr -> - T_CaseAlts -> - T_Expr -sem_Expr_Case !(T_Expr expr_ ) !(T_CaseAlts alts_ ) = - (T_Expr (\ (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (_lhsIoutputfile) of - { !_altsOoutputfile -> - (case (_lhsIoptions) of - { !_altsOoptions -> - (case (_lhsInested) of - { !_altsOnested -> - (case (_lhsIoutputfile) of - { !_exprOoutputfile -> - (case (_lhsIoptions) of - { !_exprOoptions -> - (case (_lhsInested) of - { !_exprOnested -> - (case ((alts_ _altsOnested _altsOoptions _altsOoutputfile )) of - { ( !_altsIpps) -> - (case ((expr_ _exprOnested _exprOoptions _exprOoutputfile )) of - { ( !_exprIpp) -> - (case (pp_parens ( "case" >#< pp_parens _exprIpp >#< "of" - >-< (vlist _altsIpps) - )) of - { !_lhsOpp -> - ( _lhsOpp) }) }) }) }) }) }) }) }) })) ) -sem_Expr_Lambda :: T_Exprs -> - T_Expr -> - T_Expr -sem_Expr_Lambda !(T_Exprs args_ ) !(T_Expr body_ ) = - (T_Expr (\ (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (_lhsIoutputfile) of - { !_bodyOoutputfile -> - (case (_lhsIoptions) of - { !_bodyOoptions -> - (case (_lhsInested) of - { !_bodyOnested -> - (case (_lhsIoutputfile) of - { !_argsOoutputfile -> - (case (_lhsIoptions) of - { !_argsOoptions -> - (case (_lhsInested) of - { !_argsOnested -> - (case (if bangpats _lhsIoptions - then \p -> pp_parens ("!" >|< p) - else id) of - { !_addBang -> - (case ((args_ _argsOnested _argsOoptions _argsOoutputfile )) of - { ( !_argsIpps) -> - (case (if strictSems _lhsIoptions - then _argsIpps - else []) of - { !_strictParams -> - (case ((body_ _bodyOnested _bodyOoptions _bodyOoutputfile )) of - { ( !_bodyIpp) -> - (case (pp_parens ( "\\" >#< (vlist (map _addBang _argsIpps)) >#< "->" - >-< indent 4 (_strictParams `ppMultiSeqV` _bodyIpp) - )) of - { !_lhsOpp -> - ( _lhsOpp) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Expr_Let :: T_Decls -> - T_Expr -> - T_Expr -sem_Expr_Let !(T_Decls decls_ ) !(T_Expr body_ ) = - (T_Expr (\ (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (_lhsIoutputfile) of - { !_bodyOoutputfile -> - (case (_lhsIoptions) of - { !_bodyOoptions -> - (case (_lhsInested) of - { !_bodyOnested -> - (case (_lhsIoutputfile) of - { !_declsOoutputfile -> - (case (_lhsIoptions) of - { !_declsOoptions -> - (case (_lhsInested) of - { !_declsOnested -> - (case (True) of - { !_declsOisDeclOfLet -> - (case ((body_ _bodyOnested _bodyOoptions _bodyOoutputfile )) of - { ( !_bodyIpp) -> - (case ((decls_ _declsOisDeclOfLet _declsOnested _declsOoptions _declsOoutputfile )) of - { ( !_declsIpps) -> - (case (pp_parens ( "let" >#< (vlist _declsIpps) - >-< "in " >#< _bodyIpp - )) of - { !_lhsOpp -> - ( _lhsOpp) }) }) }) }) }) }) }) }) }) })) ) -sem_Expr_LineExpr :: T_Expr -> - T_Expr -sem_Expr_LineExpr !(T_Expr expr_ ) = - (T_Expr (\ (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (_lhsIoutputfile) of - { !_exprOoutputfile -> - (case (_lhsIoptions) of - { !_exprOoptions -> - (case (_lhsInested) of - { !_exprOnested -> - (case ((expr_ _exprOnested _exprOoptions _exprOoutputfile )) of - { ( !_exprIpp) -> - (case (_exprIpp >-< "{-# LINE" >#< ppWithLineNr (\n -> pp $ show $ n + 1) >#< show _lhsIoutputfile >#< "#-}") of - { !_lhsOpp -> - ( _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) -> - (case (_lhsIoutputfile) of - { !_exprOoutputfile -> - (case (_lhsIoptions) of - { !_exprOoptions -> - (case (_lhsInested) of - { !_exprOnested -> - (case ((expr_ _exprOnested _exprOoptions _exprOoutputfile )) of - { ( !_exprIpp) -> - (case (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) of - { !_lhsOpp -> - ( _lhsOpp) }) }) }) }) })) ) -sem_Expr_SimpleExpr :: String -> - T_Expr -sem_Expr_SimpleExpr !txt_ = - (T_Expr (\ (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (text txt_) of - { !_lhsOpp -> - ( _lhsOpp) })) ) -sem_Expr_TextExpr :: ([String]) -> - T_Expr -sem_Expr_TextExpr !lns_ = - (T_Expr (\ (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (vlist (map text lns_)) of - { !_lhsOpp -> - ( _lhsOpp) })) ) -sem_Expr_Trace :: String -> - T_Expr -> - T_Expr -sem_Expr_Trace !txt_ !(T_Expr expr_ ) = - (T_Expr (\ (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (_lhsIoutputfile) of - { !_exprOoutputfile -> - (case (_lhsIoptions) of - { !_exprOoptions -> - (case (_lhsInested) of - { !_exprOnested -> - (case ((expr_ _exprOnested _exprOoptions _exprOoutputfile )) of - { ( !_exprIpp) -> - (case ("trace" >#< ( pp_parens ("\"" >|< text txt_ >|< "\"") - >-< pp_parens _exprIpp - )) of - { !_lhsOpp -> - ( _lhsOpp) }) }) }) }) })) ) -sem_Expr_TupleExpr :: T_Exprs -> - T_Expr -sem_Expr_TupleExpr !(T_Exprs exprs_ ) = - (T_Expr (\ (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (_lhsIoutputfile) of - { !_exprsOoutputfile -> - (case (_lhsIoptions) of - { !_exprsOoptions -> - (case (_lhsInested) of - { !_exprsOnested -> - (case ((exprs_ _exprsOnested _exprsOoptions _exprsOoutputfile )) of - { ( !_exprsIpps) -> - (case (ppTuple _lhsInested _exprsIpps) of - { !_lhsOpp -> - ( _lhsOpp) }) }) }) }) })) ) -sem_Expr_TypedExpr :: T_Expr -> - T_Type -> - T_Expr -sem_Expr_TypedExpr !(T_Expr expr_ ) !(T_Type tp_ ) = - (T_Expr (\ (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (_lhsInested) of - { !_tpOnested -> - (case (_lhsIoutputfile) of - { !_exprOoutputfile -> - (case (_lhsIoptions) of - { !_exprOoptions -> - (case (_lhsInested) of - { !_exprOnested -> - (case ((tp_ _tpOnested )) of - { ( !_tpIpp,!_tpIprec) -> - (case ((expr_ _exprOnested _exprOoptions _exprOoutputfile )) of - { ( !_exprIpp) -> - (case (pp_parens (_exprIpp >#< "::" >#< _tpIpp)) of - { !_lhsOpp -> - ( _lhsOpp) }) }) }) }) }) }) })) ) -sem_Expr_UnboxedTupleExpr :: T_Exprs -> - T_Expr -sem_Expr_UnboxedTupleExpr !(T_Exprs exprs_ ) = - (T_Expr (\ (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (_lhsIoutputfile) of - { !_exprsOoutputfile -> - (case (_lhsIoptions) of - { !_exprsOoptions -> - (case (_lhsInested) of - { !_exprsOnested -> - (case ((exprs_ _exprsOnested _exprsOoptions _exprsOoutputfile )) of - { ( !_exprsIpps) -> - (case (ppUnboxedTuple _lhsInested _exprsIpps) of - { !_lhsOpp -> - ( _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 -> - Inh_Exprs -> - Syn_Exprs -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) -> - (case (_lhsIoutputfile) of - { !_tlOoutputfile -> - (case (_lhsIoptions) of - { !_tlOoptions -> - (case (_lhsInested) of - { !_tlOnested -> - (case (_lhsIoutputfile) of - { !_hdOoutputfile -> - (case (_lhsIoptions) of - { !_hdOoptions -> - (case (_lhsInested) of - { !_hdOnested -> - (case ((tl_ _tlOnested _tlOoptions _tlOoutputfile )) of - { ( !_tlIpps) -> - (case ((hd_ _hdOnested _hdOoptions _hdOoutputfile )) of - { ( !_hdIpp) -> - (case (_hdIpp : _tlIpps) of - { !_lhsOpps -> - ( _lhsOpps) }) }) }) }) }) }) }) }) })) ) -sem_Exprs_Nil :: T_Exprs -sem_Exprs_Nil = - (T_Exprs (\ (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case ([]) of - { !_lhsOpps -> - ( _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 addBang : _ - local strictGuard : _ - local hasStrictVars : _ - local addStrictGuard : _ - alternative Pattern3: - child pat3 : Pattern - visit 0: - local hasStrictVars : _ - local strictGuard : _ - local addStrictGuard : _ - alternative Pattern3SM: - child pat3 : Pattern - alternative TupleLhs: - child comps : {[String]} - visit 0: - local addBang : _ - local hasStrictVars : _ - local strictGuard : _ - local addStrictGuard : _ - alternative UnboxedTupleLhs: - child comps : {[String]} - visit 0: - local addBang : _ - local hasStrictVars : _ - local strictGuard : _ - local addStrictGuard : _ --} --- 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 -> - Inh_Lhs -> - Syn_Lhs -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) -> - (case (_lhsIoutputfile) of - { !_argsOoutputfile -> - (case (_lhsIoptions) of - { !_argsOoptions -> - (case (_lhsInested) of - { !_argsOnested -> - (case (if bangpats _lhsIoptions - then \p -> "!" >|< p - else id) of - { !_addBang -> - (case ((args_ _argsOnested _argsOoptions _argsOoutputfile )) of - { ( !_argsIpps) -> - (case (_argsIpps `ppMultiSeqH` (pp "True")) of - { !_strictGuard -> - (case (not (null _argsIpps)) of - { !_hasStrictVars -> - (case (if strictSems _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id) of - { !_addStrictGuard -> - (case (_addStrictGuard (name_ >#< hv_sp (map _addBang _argsIpps))) of - { !_lhsOpp -> - ( _lhsOpp) }) }) }) }) }) }) }) }) })) ) -sem_Lhs_Pattern3 :: T_Pattern -> - T_Lhs -sem_Lhs_Pattern3 !(T_Pattern pat3_ ) = - (T_Lhs (\ (!_lhsIisDeclOfLet) - (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (_lhsIoptions) of - { !_pat3Ooptions -> - (case (_lhsIisDeclOfLet) of - { !_pat3OisDeclOfLet -> - (case (False) of - { !_pat3ObelowIrrefutable -> - (case ((pat3_ _pat3ObelowIrrefutable _pat3OisDeclOfLet _pat3Ooptions )) of - { ( !_pat3Icopy,!_pat3IisUnderscore,!_pat3Ipp,!_pat3Ipp',!_pat3IstrictVars) -> - (case (not (null _pat3IstrictVars)) of - { !_hasStrictVars -> - (case (_pat3IstrictVars `ppMultiSeqH` (pp "True")) of - { !_strictGuard -> - (case (if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id) of - { !_addStrictGuard -> - (case (_addStrictGuard _pat3Ipp) of - { !_lhsOpp -> - ( _lhsOpp) }) }) }) }) }) }) }) })) ) -sem_Lhs_Pattern3SM :: T_Pattern -> - T_Lhs -sem_Lhs_Pattern3SM !(T_Pattern pat3_ ) = - (T_Lhs (\ (!_lhsIisDeclOfLet) - (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (_lhsIoptions) of - { !_pat3Ooptions -> - (case (_lhsIisDeclOfLet) of - { !_pat3OisDeclOfLet -> - (case (False) of - { !_pat3ObelowIrrefutable -> - (case ((pat3_ _pat3ObelowIrrefutable _pat3OisDeclOfLet _pat3Ooptions )) of - { ( !_pat3Icopy,!_pat3IisUnderscore,!_pat3Ipp,!_pat3Ipp',!_pat3IstrictVars) -> - (case (_pat3Ipp') of - { !_lhsOpp -> - ( _lhsOpp) }) }) }) }) })) ) -sem_Lhs_TupleLhs :: ([String]) -> - T_Lhs -sem_Lhs_TupleLhs !comps_ = - (T_Lhs (\ (!_lhsIisDeclOfLet) - (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (if bangpats _lhsIoptions - then \p -> "!" >|< p - else id) of - { !_addBang -> - (case (not (null comps_)) of - { !_hasStrictVars -> - (case (if stricterCases _lhsIoptions && not _lhsIisDeclOfLet - then map text comps_ `ppMultiSeqH` (pp "True") - else pp "True") of - { !_strictGuard -> - (case (if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id) of - { !_addStrictGuard -> - (case (_addStrictGuard $ ppTuple _lhsInested (map (_addBang . text) comps_)) of - { !_lhsOpp -> - ( _lhsOpp) }) }) }) }) })) ) -sem_Lhs_UnboxedTupleLhs :: ([String]) -> - T_Lhs -sem_Lhs_UnboxedTupleLhs !comps_ = - (T_Lhs (\ (!_lhsIisDeclOfLet) - (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (if bangpats _lhsIoptions - then \p -> "!" >|< p - else id) of - { !_addBang -> - (case (not (null comps_)) of - { !_hasStrictVars -> - (case (if stricterCases _lhsIoptions && not _lhsIisDeclOfLet - then map text comps_ `ppMultiSeqH` (pp "True") - else pp "True") of - { !_strictGuard -> - (case (if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id) of - { !_addStrictGuard -> - (case (_addStrictGuard $ ppUnboxedTuple _lhsInested (map (_addBang . text) comps_)) of - { !_lhsOpp -> - ( _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 copy : _ - local ppVar : _ - local addBang : _ - local ppVarBang : _ - local strictPatVars : _ - local strictVar : _ - alternative Constr: - child name : {ConstructorIdent} - child pats : Patterns - visit 0: - local copy : _ - local addBang : _ - alternative Irrefutable: - child pat : Pattern - visit 0: - local copy : _ - alternative Product: - child pos : {Pos} - child pats : Patterns - visit 0: - local copy : _ - local addBang : _ - 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 -> - Inh_Pattern -> - Syn_Pattern -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) -> - (case (_lhsIoptions) of - { !_partsOoptions -> - (case (_lhsIisDeclOfLet) of - { !_partsOisDeclOfLet -> - (case (_lhsIbelowIrrefutable) of - { !_partsObelowIrrefutable -> - (case ((parts_ _partsObelowIrrefutable _partsOisDeclOfLet _partsOoptions )) of - { ( !_partsIcopy,!_partsIpps,!_partsIpps',!_partsIstrictVars) -> - (case (_lhsIoptions) of - { !_patOoptions -> - (case (_lhsIisDeclOfLet) of - { !_patOisDeclOfLet -> - (case (_lhsIbelowIrrefutable) of - { !_patObelowIrrefutable -> - (case ((pat_ _patObelowIrrefutable _patOisDeclOfLet _patOoptions )) of - { ( !_patIcopy,!_patIisUnderscore,!_patIpp,!_patIpp',!_patIstrictVars) -> - (case (Alias field_ attr_ _patIcopy _partsIcopy) of - { !_copy -> - (case (_copy) of - { !_lhsOcopy -> - (case (False) of - { !_lhsOisUnderscore -> - (case (pp (attrname False field_ attr_)) of - { !_ppVar -> - (case (if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable - then \p -> "!" >|< p - else id) of - { !_addBang -> - (case (_addBang $ _ppVar) of - { !_ppVarBang -> - (case (if _patIisUnderscore - then _ppVarBang - else _ppVarBang >|< "@" >|< _patIpp) of - { !_lhsOpp -> - (case (let attribute | field_ == _LOC || field_ == nullIdent = locname' attr_ - | otherwise = attrname False field_ attr_ - in attribute >|< "@" >|< _patIpp') of - { !_lhsOpp' -> - (case (if stricterCases _lhsIoptions && not _lhsIisDeclOfLet - then _patIstrictVars - else []) of - { !_strictPatVars -> - (case (if strictCases _lhsIoptions && not _lhsIisDeclOfLet - then [_ppVar ] - else []) of - { !_strictVar -> - (case (_strictVar ++ _strictPatVars) of - { !_lhsOstrictVars -> - ( _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) -> - (case (_lhsIoptions) of - { !_patsOoptions -> - (case (_lhsIisDeclOfLet) of - { !_patsOisDeclOfLet -> - (case (_lhsIbelowIrrefutable) of - { !_patsObelowIrrefutable -> - (case ((pats_ _patsObelowIrrefutable _patsOisDeclOfLet _patsOoptions )) of - { ( !_patsIcopy,!_patsIpps,!_patsIpps',!_patsIstrictVars) -> - (case (Constr name_ _patsIcopy) of - { !_copy -> - (case (_copy) of - { !_lhsOcopy -> - (case (False) of - { !_lhsOisUnderscore -> - (case (if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable - then \p -> "!" >|< p - else id) of - { !_addBang -> - (case (_addBang $ pp_parens $ name_ >#< hv_sp _patsIpps) of - { !_lhsOpp -> - (case (pp_parens $ name_ >#< hv_sp (map pp_parens _patsIpps')) of - { !_lhsOpp' -> - (case (_patsIstrictVars) of - { !_lhsOstrictVars -> - ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Pattern_Irrefutable :: T_Pattern -> - T_Pattern -sem_Pattern_Irrefutable !(T_Pattern pat_ ) = - (T_Pattern (\ (!_lhsIbelowIrrefutable) - (!_lhsIisDeclOfLet) - (!_lhsIoptions) -> - (case (_lhsIoptions) of - { !_patOoptions -> - (case (_lhsIisDeclOfLet) of - { !_patOisDeclOfLet -> - (case (True) of - { !_patObelowIrrefutable -> - (case ((pat_ _patObelowIrrefutable _patOisDeclOfLet _patOoptions )) of - { ( !_patIcopy,!_patIisUnderscore,!_patIpp,!_patIpp',!_patIstrictVars) -> - (case (Irrefutable _patIcopy) of - { !_copy -> - (case (_copy) of - { !_lhsOcopy -> - (case (_patIisUnderscore) of - { !_lhsOisUnderscore -> - (case (text "~" >|< pp_parens _patIpp) of - { !_lhsOpp -> - (case (text "~" >|< pp_parens _patIpp) of - { !_lhsOpp' -> - (case ([]) of - { !_lhsOstrictVars -> - ( _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) -> - (case (_lhsIoptions) of - { !_patsOoptions -> - (case (_lhsIisDeclOfLet) of - { !_patsOisDeclOfLet -> - (case (_lhsIbelowIrrefutable) of - { !_patsObelowIrrefutable -> - (case ((pats_ _patsObelowIrrefutable _patsOisDeclOfLet _patsOoptions )) of - { ( !_patsIcopy,!_patsIpps,!_patsIpps',!_patsIstrictVars) -> - (case (Product pos_ _patsIcopy) of - { !_copy -> - (case (_copy) of - { !_lhsOcopy -> - (case (False) of - { !_lhsOisUnderscore -> - (case (if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable - then \p -> "!" >|< p - else id) of - { !_addBang -> - (case (_addBang $ pp_block "(" ")" "," _patsIpps) of - { !_lhsOpp -> - (case (pp_block "(" ")" "," _patsIpps') of - { !_lhsOpp' -> - (case (_patsIstrictVars) of - { !_lhsOstrictVars -> - ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Pattern_Underscore :: Pos -> - T_Pattern -sem_Pattern_Underscore !pos_ = - (T_Pattern (\ (!_lhsIbelowIrrefutable) - (!_lhsIisDeclOfLet) - (!_lhsIoptions) -> - (case (Underscore pos_) of - { !_copy -> - (case (_copy) of - { !_lhsOcopy -> - (case (True) of - { !_lhsOisUnderscore -> - (case (text "_") of - { !_lhsOpp -> - (case (text "_") of - { !_lhsOpp' -> - (case ([]) of - { !_lhsOstrictVars -> - ( _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 -> - Inh_Patterns -> - Syn_Patterns -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) -> - (case (_lhsIoptions) of - { !_tlOoptions -> - (case (_lhsIisDeclOfLet) of - { !_tlOisDeclOfLet -> - (case (_lhsIbelowIrrefutable) of - { !_tlObelowIrrefutable -> - (case ((tl_ _tlObelowIrrefutable _tlOisDeclOfLet _tlOoptions )) of - { ( !_tlIcopy,!_tlIpps,!_tlIpps',!_tlIstrictVars) -> - (case (_lhsIoptions) of - { !_hdOoptions -> - (case (_lhsIisDeclOfLet) of - { !_hdOisDeclOfLet -> - (case (_lhsIbelowIrrefutable) of - { !_hdObelowIrrefutable -> - (case ((hd_ _hdObelowIrrefutable _hdOisDeclOfLet _hdOoptions )) of - { ( !_hdIcopy,!_hdIisUnderscore,!_hdIpp,!_hdIpp',!_hdIstrictVars) -> - (case ((:) _hdIcopy _tlIcopy) of - { !_copy -> - (case (_copy) of - { !_lhsOcopy -> - (case (_hdIpp : _tlIpps) of - { !_lhsOpps -> - (case (_hdIpp' : _tlIpps') of - { !_lhsOpps' -> - (case (_hdIstrictVars ++ _tlIstrictVars) of - { !_lhsOstrictVars -> - ( _lhsOcopy,_lhsOpps,_lhsOpps',_lhsOstrictVars) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Patterns_Nil :: T_Patterns -sem_Patterns_Nil = - (T_Patterns (\ (!_lhsIbelowIrrefutable) - (!_lhsIisDeclOfLet) - (!_lhsIoptions) -> - (case ([]) of - { !_copy -> - (case (_copy) of - { !_lhsOcopy -> - (case ([]) of - { !_lhsOpps -> - (case ([]) of - { !_lhsOpps' -> - (case ([]) of - { !_lhsOstrictVars -> - ( _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 - textBlockMap : Map BlockInfo PP_Doc - textBlocks : PP_Doc - synthesized attributes: - genIO : IO () - output : PP_Docs - alternatives: - alternative Program: - child chunks : Chunks - visit 0: - local commonFile : _ - local genCommonModule : _ - local mainModuleFile : _ - local genMainModule : _ --} --- 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 -> - (Map BlockInfo PP_Doc) -> - 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),textBlockMap_Inh_Program :: !(Map BlockInfo PP_Doc),textBlocks_Inh_Program :: !(PP_Doc)} -data Syn_Program = Syn_Program {genIO_Syn_Program :: !(IO ()),output_Syn_Program :: !(PP_Docs)} -wrap_Program :: T_Program -> - Inh_Program -> - Syn_Program -wrap_Program !(T_Program sem ) !(Inh_Program _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks ) = - (let ( !_lhsOgenIO,!_lhsOoutput) = - (sem _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _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) - (!_lhsItextBlockMap) - (!_lhsItextBlocks) -> - (case (_lhsItextBlockMap) of - { !_chunksOtextBlockMap -> - (case (_lhsIpragmaBlocks) of - { !_chunksOpragmaBlocks -> - (case (_lhsIoptionsLine) of - { !_chunksOoptionsLine -> - (case (_lhsIoptions) of - { !_chunksOoptions -> - (case (_lhsImoduleHeader) of - { !_chunksOmoduleHeader -> - (case (_lhsImainName) of - { !_chunksOmainName -> - (case (_lhsImainFile) of - { !_chunksOmainFile -> - (case (_lhsImainFile ++ "_common.hs") of - { !_commonFile -> - (case (False) of - { !_chunksOisDeclOfLet -> - (case (nest _lhsIoptions) of - { !_chunksOnested -> - (case (_lhsItextBlocks) of - { !_chunksOtextBlocks -> - (case (_lhsIimportBlocks) of - { !_chunksOimportBlocks -> - (case ((chunks_ _chunksOimportBlocks _chunksOisDeclOfLet _chunksOmainFile _chunksOmainName _chunksOmoduleHeader _chunksOnested _chunksOoptions _chunksOoptionsLine _chunksOpragmaBlocks _chunksOtextBlockMap _chunksOtextBlocks )) of - { ( !_chunksIappendCommon,!_chunksIappendMain,!_chunksIgenSems,!_chunksIimports,!_chunksIpps) -> - (case (writeModule _commonFile - ( [ pp $ _lhsIpragmaBlocks - , pp $ _lhsIoptionsLine - , pp $ _lhsImoduleHeader _lhsImainName "_common" "" True - , _lhsIimportBlocks - , _lhsItextBlocks - ] - ++ map vlist _chunksIappendCommon - )) of - { !_genCommonModule -> - (case (_lhsImainFile ++ ".hs") of - { !_mainModuleFile -> - (case (writeModule _mainModuleFile - ( [ pp $ _lhsIpragmaBlocks - , pp $ _lhsIoptionsLine - , pp $ _lhsImoduleHeader _lhsImainName "" "" False - , pp $ ("import " ++ _lhsImainName ++ "_common\n") - ] - ++ map pp _chunksIimports - ++ map vlist _chunksIappendMain - )) of - { !_genMainModule -> - (case (do _genMainModule - _genCommonModule - _chunksIgenSems) of - { !_lhsOgenIO -> - (case (_chunksIpps) of - { !_lhsOoutput -> - ( _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 r : _ - local l : _ - 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 -> - Inh_Type -> - Syn_Type -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) -> - (case (_lhsInested) of - { !_rightOnested -> - (case (_lhsInested) of - { !_leftOnested -> - (case ((right_ _rightOnested )) of - { ( !_rightIpp,!_rightIprec) -> - (case (if _rightIprec < 2 then pp_parens _rightIpp else _rightIpp) of - { !_r -> - (case ((left_ _leftOnested )) of - { ( !_leftIpp,!_leftIprec) -> - (case (if _leftIprec <= 2 then pp_parens _leftIpp else _leftIpp) of - { !_l -> - (case (_l >#< "->" >-< _r) of - { !_lhsOpp -> - (case (2) of - { !_lhsOprec -> - ( _lhsOpp,_lhsOprec) }) }) }) }) }) }) }) })) ) -sem_Type_CtxApp :: ([(String, [String])]) -> - T_Type -> - T_Type -sem_Type_CtxApp !left_ !(T_Type right_ ) = - (T_Type (\ (!_lhsInested) -> - (case (_lhsInested) of - { !_rightOnested -> - (case ((right_ _rightOnested )) of - { ( !_rightIpp,!_rightIprec) -> - (case ((pp_block "(" ")" "," $ map (\(n,ns) -> hv_sp $ map pp (n:ns)) left_) >#< "=>" >#< _rightIpp) of - { !_lhsOpp -> - (case (_rightIprec) of - { !_lhsOprec -> - ( _lhsOpp,_lhsOprec) }) }) }) })) ) -sem_Type_List :: T_Type -> - T_Type -sem_Type_List !(T_Type tp_ ) = - (T_Type (\ (!_lhsInested) -> - (case (_lhsInested) of - { !_tpOnested -> - (case ((tp_ _tpOnested )) of - { ( !_tpIpp,!_tpIprec) -> - (case ("[" >|< _tpIpp >|< "]") of - { !_lhsOpp -> - (case (5) of - { !_lhsOprec -> - ( _lhsOpp,_lhsOprec) }) }) }) })) ) -sem_Type_SimpleType :: String -> - T_Type -sem_Type_SimpleType !txt_ = - (T_Type (\ (!_lhsInested) -> - (case (if reallySimple txt_ then text txt_ else pp_parens (text txt_)) of - { !_lhsOpp -> - (case (5) of - { !_lhsOprec -> - ( _lhsOpp,_lhsOprec) }) })) ) -sem_Type_TupleType :: T_Types -> - T_Type -sem_Type_TupleType !(T_Types tps_ ) = - (T_Type (\ (!_lhsInested) -> - (case (_lhsInested) of - { !_tpsOnested -> - (case ((tps_ _tpsOnested )) of - { ( !_tpsIpps) -> - (case (ppTuple _lhsInested _tpsIpps) of - { !_lhsOpp -> - (case (5) of - { !_lhsOprec -> - ( _lhsOpp,_lhsOprec) }) }) }) })) ) -sem_Type_TypeApp :: T_Type -> - T_Types -> - T_Type -sem_Type_TypeApp !(T_Type func_ ) !(T_Types args_ ) = - (T_Type (\ (!_lhsInested) -> - (case (_lhsInested) of - { !_argsOnested -> - (case (_lhsInested) of - { !_funcOnested -> - (case ((args_ _argsOnested )) of - { ( !_argsIpps) -> - (case ((func_ _funcOnested )) of - { ( !_funcIpp,!_funcIprec) -> - (case (hv_sp (_funcIpp : _argsIpps)) of - { !_lhsOpp -> - (case (_funcIprec) of - { !_lhsOprec -> - ( _lhsOpp,_lhsOprec) }) }) }) }) }) })) ) -sem_Type_UnboxedTupleType :: T_Types -> - T_Type -sem_Type_UnboxedTupleType !(T_Types tps_ ) = - (T_Type (\ (!_lhsInested) -> - (case (_lhsInested) of - { !_tpsOnested -> - (case ((tps_ _tpsOnested )) of - { ( !_tpsIpps) -> - (case (ppUnboxedTuple _lhsInested _tpsIpps) of - { !_lhsOpp -> - (case (5) of - { !_lhsOprec -> - ( _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 -> - Inh_Types -> - Syn_Types -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) -> - (case (_lhsInested) of - { !_tlOnested -> - (case (_lhsInested) of - { !_hdOnested -> - (case ((tl_ _tlOnested )) of - { ( !_tlIpps) -> - (case ((hd_ _hdOnested )) of - { ( !_hdIpp,!_hdIprec) -> - (case (_hdIpp : _tlIpps) of - { !_lhsOpps -> - ( _lhsOpps) }) }) }) }) })) ) -sem_Types_Nil :: T_Types -sem_Types_Nil = - (T_Types (\ (!_lhsInested) -> - (case ([]) of - { !_lhsOpps -> +{-# OPTIONS_GHC -fbang-patterns #-}++-- UUAGC 0.9.12 (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 CommonTypes(BlockInfo, BlockType(..), identifier)+++import Pretty+import Patterns+import Data.List(partition)+import Data.Set(Set)+import qualified Data.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 ->+ Inh_CaseAlt ->+ Syn_CaseAlt +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) ->+ (case (_lhsIoutputfile) of+ { !_exprOoutputfile ->+ (case (_lhsIoptions) of+ { !_exprOoptions ->+ (case (_lhsInested) of+ { !_exprOnested ->+ (case (_lhsIoutputfile) of+ { !_leftOoutputfile ->+ (case (_lhsIoptions) of+ { !_leftOoptions ->+ (case (_lhsInested) of+ { !_leftOnested ->+ (case (False) of+ { !_leftOisDeclOfLet ->+ (case ((expr_ _exprOnested _exprOoptions _exprOoutputfile )) of+ { ( !_exprIpp) ->+ (case ((left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile )) of+ { ( !_leftIpp) ->+ (case (["{" >#< _leftIpp >#< "->", _exprIpp >#< "}"]) of+ { !_lhsOpps ->+ ( _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 ->+ Inh_CaseAlts ->+ Syn_CaseAlts +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) ->+ (case (_lhsIoutputfile) of+ { !_tlOoutputfile ->+ (case (_lhsIoptions) of+ { !_tlOoptions ->+ (case (_lhsInested) of+ { !_tlOnested ->+ (case (_lhsIoutputfile) of+ { !_hdOoutputfile ->+ (case (_lhsIoptions) of+ { !_hdOoptions ->+ (case (_lhsInested) of+ { !_hdOnested ->+ (case ((tl_ _tlOnested _tlOoptions _tlOoutputfile )) of+ { ( !_tlIpps) ->+ (case ((hd_ _hdOnested _hdOoptions _hdOoutputfile )) of+ { ( !_hdIpps) ->+ (case (_hdIpps ++ _tlIpps) of+ { !_lhsOpps ->+ ( _lhsOpps) }) }) }) }) }) }) }) }) })) )+sem_CaseAlts_Nil :: T_CaseAlts +sem_CaseAlts_Nil =+ (T_CaseAlts (\ (!_lhsInested)+ (!_lhsIoptions)+ (!_lhsIoutputfile) ->+ (case ([]) of+ { !_lhsOpps ->+ ( _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+ textBlockMap : Map BlockInfo PP_Doc+ 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 ->+ (Map BlockInfo PP_Doc) ->+ 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),textBlockMap_Inh_Chunk :: !(Map BlockInfo PP_Doc),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 ->+ Inh_Chunk ->+ Syn_Chunk +wrap_Chunk !(T_Chunk sem ) !(Inh_Chunk _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks ) =+ (let ( !_lhsOappendCommon,!_lhsOappendMain,!_lhsOgenSems,!_lhsOimports,!_lhsOpps) =+ (sem _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _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)+ (!_lhsItextBlockMap)+ (!_lhsItextBlocks) ->+ (case (if sepSemMods _lhsIoptions+ then _lhsImainFile ++ "_" ++ name_ ++ ".hs"+ else _lhsImainFile ++ ".hs") of+ { !_outputfile ->+ (case (_outputfile) of+ { !_semDomOoutputfile ->+ (case (_lhsIoptions) of+ { !_semDomOoptions ->+ (case (_lhsInested) of+ { !_semDomOnested ->+ (case (_lhsIisDeclOfLet) of+ { !_semDomOisDeclOfLet ->+ (case (_outputfile) of+ { !_dataDefOoutputfile ->+ (case (_lhsIoptions) of+ { !_dataDefOoptions ->+ (case (_lhsInested) of+ { !_dataDefOnested ->+ (case (_lhsIisDeclOfLet) of+ { !_dataDefOisDeclOfLet ->+ (case (_outputfile) of+ { !_commentOoutputfile ->+ (case (_lhsIoptions) of+ { !_commentOoptions ->+ (case (_lhsInested) of+ { !_commentOnested ->+ (case (_lhsIisDeclOfLet) of+ { !_commentOisDeclOfLet ->+ (case ((semDom_ _semDomOisDeclOfLet _semDomOnested _semDomOoptions _semDomOoutputfile )) of+ { ( !_semDomIpps) ->+ (case ((dataDef_ _dataDefOisDeclOfLet _dataDefOnested _dataDefOoptions _dataDefOoutputfile )) of+ { ( !_dataDefIpps) ->+ (case ((comment_ _commentOisDeclOfLet _commentOnested _commentOoptions _commentOoutputfile )) of+ { ( !_commentIpp) ->+ (case ([ [_commentIpp]+ , _dataDefIpps+ , _semDomIpps+ ]) of+ { !_lhsOappendCommon ->+ (case (_outputfile) of+ { !_semWrapperOoutputfile ->+ (case (_lhsIoptions) of+ { !_semWrapperOoptions ->+ (case (_lhsInested) of+ { !_semWrapperOnested ->+ (case (_lhsIisDeclOfLet) of+ { !_semWrapperOisDeclOfLet ->+ (case (_outputfile) of+ { !_cataFunOoutputfile ->+ (case (_lhsIoptions) of+ { !_cataFunOoptions ->+ (case (_lhsInested) of+ { !_cataFunOnested ->+ (case (_lhsIisDeclOfLet) of+ { !_cataFunOisDeclOfLet ->+ (case ((semWrapper_ _semWrapperOisDeclOfLet _semWrapperOnested _semWrapperOoptions _semWrapperOoutputfile )) of+ { ( !_semWrapperIpps) ->+ (case ((cataFun_ _cataFunOisDeclOfLet _cataFunOnested _cataFunOoptions _cataFunOoutputfile )) of+ { ( !_cataFunIpps) ->+ (case ([ [_commentIpp]+ , _cataFunIpps+ , _semWrapperIpps+ ]) of+ { !_lhsOappendMain ->+ (case (_outputfile) of+ { !_semFunctionsOoutputfile ->+ (case (_lhsIoptions) of+ { !_semFunctionsOoptions ->+ (case (_lhsInested) of+ { !_semFunctionsOnested ->+ (case (_lhsIisDeclOfLet) of+ { !_semFunctionsOisDeclOfLet ->+ (case (_outputfile) of+ { !_infoOoutputfile ->+ (case (_lhsIoptions) of+ { !_infoOoptions ->+ (case (_lhsInested) of+ { !_infoOnested ->+ (case (_lhsIisDeclOfLet) of+ { !_infoOisDeclOfLet ->+ (case (concat $ intersperse "," semNames_) of+ { !_exports ->+ (case ((semFunctions_ _semFunctionsOisDeclOfLet _semFunctionsOnested _semFunctionsOoptions _semFunctionsOoutputfile )) of+ { ( !_semFunctionsIpps) ->+ (case ((info_ _infoOisDeclOfLet _infoOnested _infoOoptions _infoOoutputfile )) of+ { ( !_infoIpps) ->+ (case (writeModule _outputfile+ [ pp $ _lhsIpragmaBlocks+ , pp $ Map.findWithDefault empty (BlockPragma, Just $ identifier name_) _lhsItextBlockMap+ , pp $ _lhsIoptionsLine+ , pp $ _lhsImoduleHeader _lhsImainName ("_" ++ name_) _exports True+ , pp $ ("import " ++ _lhsImainName ++ "_common\n")+ , pp $ Map.findWithDefault empty (BlockImport, Just $ identifier name_) _lhsItextBlockMap+ , _commentIpp+ , vlist_sep "" _infoIpps+ , vlist_sep "" _semFunctionsIpps+ , Map.findWithDefault empty (BlockOther, Just $ identifier name_) _lhsItextBlockMap+ ]) of+ { !_lhsOgenSems ->+ (case (["import " ++ _lhsImainName ++ "_" ++ name_ ++ "\n"]) of+ { !_lhsOimports ->+ (case (_commentIpp+ : _infoIpps+ ++ _dataDefIpps+ ++ _cataFunIpps+ ++ _semDomIpps+ ++ _semWrapperIpps+ ++ _semFunctionsIpps+ ++ [Map.findWithDefault empty (BlockOther, Just $ identifier name_) _lhsItextBlockMap]) of+ { !_lhsOpps ->+ ( _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+ textBlockMap : Map BlockInfo PP_Doc+ 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 ->+ (Map BlockInfo PP_Doc) ->+ 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),textBlockMap_Inh_Chunks :: !(Map BlockInfo PP_Doc),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 ->+ Inh_Chunks ->+ Syn_Chunks +wrap_Chunks !(T_Chunks sem ) !(Inh_Chunks _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks ) =+ (let ( !_lhsOappendCommon,!_lhsOappendMain,!_lhsOgenSems,!_lhsOimports,!_lhsOpps) =+ (sem _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _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)+ (!_lhsItextBlockMap)+ (!_lhsItextBlocks) ->+ (case (_lhsIoptions) of+ { !_tlOoptions ->+ (case (_lhsInested) of+ { !_tlOnested ->+ (case (_lhsImainFile) of+ { !_tlOmainFile ->+ (case (_lhsIisDeclOfLet) of+ { !_tlOisDeclOfLet ->+ (case (_lhsIoptions) of+ { !_hdOoptions ->+ (case (_lhsInested) of+ { !_hdOnested ->+ (case (_lhsImainFile) of+ { !_hdOmainFile ->+ (case (_lhsIisDeclOfLet) of+ { !_hdOisDeclOfLet ->+ (case (_lhsItextBlocks) of+ { !_tlOtextBlocks ->+ (case (_lhsItextBlockMap) of+ { !_tlOtextBlockMap ->+ (case (_lhsIpragmaBlocks) of+ { !_tlOpragmaBlocks ->+ (case (_lhsIoptionsLine) of+ { !_tlOoptionsLine ->+ (case (_lhsImoduleHeader) of+ { !_tlOmoduleHeader ->+ (case (_lhsImainName) of+ { !_tlOmainName ->+ (case (_lhsIimportBlocks) of+ { !_tlOimportBlocks ->+ (case ((tl_ _tlOimportBlocks _tlOisDeclOfLet _tlOmainFile _tlOmainName _tlOmoduleHeader _tlOnested _tlOoptions _tlOoptionsLine _tlOpragmaBlocks _tlOtextBlockMap _tlOtextBlocks )) of+ { ( !_tlIappendCommon,!_tlIappendMain,!_tlIgenSems,!_tlIimports,!_tlIpps) ->+ (case (_lhsItextBlocks) of+ { !_hdOtextBlocks ->+ (case (_lhsItextBlockMap) of+ { !_hdOtextBlockMap ->+ (case (_lhsIpragmaBlocks) of+ { !_hdOpragmaBlocks ->+ (case (_lhsIoptionsLine) of+ { !_hdOoptionsLine ->+ (case (_lhsImoduleHeader) of+ { !_hdOmoduleHeader ->+ (case (_lhsImainName) of+ { !_hdOmainName ->+ (case (_lhsIimportBlocks) of+ { !_hdOimportBlocks ->+ (case ((hd_ _hdOimportBlocks _hdOisDeclOfLet _hdOmainFile _hdOmainName _hdOmoduleHeader _hdOnested _hdOoptions _hdOoptionsLine _hdOpragmaBlocks _hdOtextBlockMap _hdOtextBlocks )) of+ { ( !_hdIappendCommon,!_hdIappendMain,!_hdIgenSems,!_hdIimports,!_hdIpps) ->+ (case (_hdIappendCommon ++ _tlIappendCommon) of+ { !_lhsOappendCommon ->+ (case (_hdIappendMain ++ _tlIappendMain) of+ { !_lhsOappendMain ->+ (case (_hdIgenSems >> _tlIgenSems) of+ { !_lhsOgenSems ->+ (case (_hdIimports ++ _tlIimports) of+ { !_lhsOimports ->+ (case (_hdIpps ++ _tlIpps) of+ { !_lhsOpps ->+ ( _lhsOappendCommon,_lhsOappendMain,_lhsOgenSems,_lhsOimports,_lhsOpps) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) )+sem_Chunks_Nil :: T_Chunks +sem_Chunks_Nil =+ (T_Chunks (\ (!_lhsIimportBlocks)+ (!_lhsIisDeclOfLet)+ (!_lhsImainFile)+ (!_lhsImainName)+ (!_lhsImoduleHeader)+ (!_lhsInested)+ (!_lhsIoptions)+ (!_lhsIoptionsLine)+ (!_lhsIpragmaBlocks)+ (!_lhsItextBlockMap)+ (!_lhsItextBlocks) ->+ (case ([]) of+ { !_lhsOappendCommon ->+ (case ([]) of+ { !_lhsOappendMain ->+ (case (return ()) of+ { !_lhsOgenSems ->+ (case ([]) of+ { !_lhsOimports ->+ (case ([]) of+ { !_lhsOpps ->+ ( _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 ->+ Inh_DataAlt ->+ Syn_DataAlt +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) ->+ (case (name_ >#< hv_sp (map ((_lhsIstrictPre >|<) . pp_parens . text) args_)) of+ { !_lhsOpp ->+ ( _lhsOpp) })) )+sem_DataAlt_Record :: String ->+ ([(String,String)]) ->+ T_DataAlt +sem_DataAlt_Record !name_ !args_ =+ (T_DataAlt (\ (!_lhsInested)+ (!_lhsIstrictPre) ->+ (case (name_ >#< pp_block "{" "}" ","+ [ f >#< "::" >#< t | (f,t) <- args_ ]) of+ { !_lhsOpp ->+ ( _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 ->+ Inh_DataAlts ->+ Syn_DataAlts +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) ->+ (case (_lhsIstrictPre) of+ { !_tlOstrictPre ->+ (case (_lhsIstrictPre) of+ { !_hdOstrictPre ->+ (case (_lhsInested) of+ { !_tlOnested ->+ (case ((tl_ _tlOnested _tlOstrictPre )) of+ { ( !_tlIpps) ->+ (case (_lhsInested) of+ { !_hdOnested ->+ (case ((hd_ _hdOnested _hdOstrictPre )) of+ { ( !_hdIpp) ->+ (case (_hdIpp : _tlIpps) of+ { !_lhsOpps ->+ ( _lhsOpps) }) }) }) }) }) }) })) )+sem_DataAlts_Nil :: T_DataAlts +sem_DataAlts_Nil =+ (T_DataAlts (\ (!_lhsInested)+ (!_lhsIstrictPre) ->+ (case ([]) of+ { !_lhsOpps ->+ ( _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 ->+ Inh_Decl ->+ Syn_Decl +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) ->+ (case (if '\n' `elem` txt_+ then "{-" >-< vlist (lines txt_) >-< "-}"+ else "--" >#< txt_) of+ { !_lhsOpp ->+ ( _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) ->+ (case (if strict_ then pp "!" else empty) of+ { !_altsOstrictPre ->+ (case (_lhsInested) of+ { !_altsOnested ->+ (case ((alts_ _altsOnested _altsOstrictPre )) of+ { ( !_altsIpps) ->+ (case ("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_)+ )) of+ { !_lhsOpp ->+ ( _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) ->+ (case (_lhsIoutputfile) of+ { !_rhsOoutputfile ->+ (case (_lhsIoptions) of+ { !_rhsOoptions ->+ (case (_lhsInested) of+ { !_rhsOnested ->+ (case (_lhsIoutputfile) of+ { !_leftOoutputfile ->+ (case (_lhsIoptions) of+ { !_leftOoptions ->+ (case (_lhsInested) of+ { !_leftOnested ->+ (case (_lhsIisDeclOfLet) of+ { !_leftOisDeclOfLet ->+ (case ((rhs_ _rhsOnested _rhsOoptions _rhsOoutputfile )) of+ { ( !_rhsIpp) ->+ (case ((left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile )) of+ { ( !_leftIpp) ->+ (case (_leftIpp >#< "="+ >-< indent 4 _rhsIpp) of+ { !_lhsOpp ->+ ( _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) ->+ (case (_lhsInested) of+ { !_tpOnested ->+ (case ((tp_ _tpOnested )) of+ { ( !_tpIpp,!_tpIprec) ->+ (case ("newtype" >#< hv_sp (name_ : params_) >#< "=" >#< con_ >#< pp_parens _tpIpp) of+ { !_lhsOpp ->+ ( _lhsOpp) }) }) })) )+sem_Decl_PragmaDecl :: String ->+ T_Decl +sem_Decl_PragmaDecl !txt_ =+ (T_Decl (\ (!_lhsIisDeclOfLet)+ (!_lhsInested)+ (!_lhsIoptions)+ (!_lhsIoutputfile) ->+ (case ("{-#" >#< text txt_ >#< "#-}") of+ { !_lhsOpp ->+ ( _lhsOpp) })) )+sem_Decl_TSig :: String ->+ T_Type ->+ T_Decl +sem_Decl_TSig !name_ !(T_Type tp_ ) =+ (T_Decl (\ (!_lhsIisDeclOfLet)+ (!_lhsInested)+ (!_lhsIoptions)+ (!_lhsIoutputfile) ->+ (case (_lhsInested) of+ { !_tpOnested ->+ (case ((tp_ _tpOnested )) of+ { ( !_tpIpp,!_tpIprec) ->+ (case (name_ >#< "::" >#< _tpIpp) of+ { !_lhsOpp ->+ ( _lhsOpp) }) }) })) )+sem_Decl_Type :: String ->+ ([String]) ->+ T_Type ->+ T_Decl +sem_Decl_Type !name_ !params_ !(T_Type tp_ ) =+ (T_Decl (\ (!_lhsIisDeclOfLet)+ (!_lhsInested)+ (!_lhsIoptions)+ (!_lhsIoutputfile) ->+ (case (_lhsInested) of+ { !_tpOnested ->+ (case ((tp_ _tpOnested )) of+ { ( !_tpIpp,!_tpIprec) ->+ (case ("type" >#< hv_sp (name_ : params_) >#< "=" >#< _tpIpp) of+ { !_lhsOpp ->+ ( _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 ->+ Inh_Decls ->+ Syn_Decls +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) ->+ (case (_lhsIoutputfile) of+ { !_tlOoutputfile ->+ (case (_lhsIoptions) of+ { !_tlOoptions ->+ (case (_lhsInested) of+ { !_tlOnested ->+ (case (_lhsIisDeclOfLet) of+ { !_tlOisDeclOfLet ->+ (case (_lhsIoutputfile) of+ { !_hdOoutputfile ->+ (case (_lhsIoptions) of+ { !_hdOoptions ->+ (case (_lhsInested) of+ { !_hdOnested ->+ (case (_lhsIisDeclOfLet) of+ { !_hdOisDeclOfLet ->+ (case ((tl_ _tlOisDeclOfLet _tlOnested _tlOoptions _tlOoutputfile )) of+ { ( !_tlIpps) ->+ (case ((hd_ _hdOisDeclOfLet _hdOnested _hdOoptions _hdOoutputfile )) of+ { ( !_hdIpp) ->+ (case (_hdIpp : _tlIpps) of+ { !_lhsOpps ->+ ( _lhsOpps) }) }) }) }) }) }) }) }) }) }) })) )+sem_Decls_Nil :: T_Decls +sem_Decls_Nil =+ (T_Decls (\ (!_lhsIisDeclOfLet)+ (!_lhsInested)+ (!_lhsIoptions)+ (!_lhsIoutputfile) ->+ (case ([]) of+ { !_lhsOpps ->+ ( _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 addBang : _+ local strictParams : _+ 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 ->+ Inh_Expr ->+ Syn_Expr +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) ->+ (case (_lhsIoutputfile) of+ { !_argsOoutputfile ->+ (case (_lhsIoptions) of+ { !_argsOoptions ->+ (case (_lhsInested) of+ { !_argsOnested ->+ (case ((args_ _argsOnested _argsOoptions _argsOoutputfile )) of+ { ( !_argsIpps) ->+ (case (pp_parens $ name_ >#< hv_sp _argsIpps) of+ { !_lhsOpp ->+ ( _lhsOpp) }) }) }) }) })) )+sem_Expr_Case :: T_Expr ->+ T_CaseAlts ->+ T_Expr +sem_Expr_Case !(T_Expr expr_ ) !(T_CaseAlts alts_ ) =+ (T_Expr (\ (!_lhsInested)+ (!_lhsIoptions)+ (!_lhsIoutputfile) ->+ (case (_lhsIoutputfile) of+ { !_altsOoutputfile ->+ (case (_lhsIoptions) of+ { !_altsOoptions ->+ (case (_lhsInested) of+ { !_altsOnested ->+ (case (_lhsIoutputfile) of+ { !_exprOoutputfile ->+ (case (_lhsIoptions) of+ { !_exprOoptions ->+ (case (_lhsInested) of+ { !_exprOnested ->+ (case ((alts_ _altsOnested _altsOoptions _altsOoutputfile )) of+ { ( !_altsIpps) ->+ (case ((expr_ _exprOnested _exprOoptions _exprOoutputfile )) of+ { ( !_exprIpp) ->+ (case (pp_parens ( "case" >#< pp_parens _exprIpp >#< "of"+ >-< (vlist _altsIpps)+ )) of+ { !_lhsOpp ->+ ( _lhsOpp) }) }) }) }) }) }) }) }) })) )+sem_Expr_Lambda :: T_Exprs ->+ T_Expr ->+ T_Expr +sem_Expr_Lambda !(T_Exprs args_ ) !(T_Expr body_ ) =+ (T_Expr (\ (!_lhsInested)+ (!_lhsIoptions)+ (!_lhsIoutputfile) ->+ (case (_lhsIoutputfile) of+ { !_bodyOoutputfile ->+ (case (_lhsIoptions) of+ { !_bodyOoptions ->+ (case (_lhsInested) of+ { !_bodyOnested ->+ (case (_lhsIoutputfile) of+ { !_argsOoutputfile ->+ (case (_lhsIoptions) of+ { !_argsOoptions ->+ (case (_lhsInested) of+ { !_argsOnested ->+ (case (if bangpats _lhsIoptions+ then \p -> pp_parens ("!" >|< p)+ else id) of+ { !_addBang ->+ (case ((args_ _argsOnested _argsOoptions _argsOoutputfile )) of+ { ( !_argsIpps) ->+ (case (if strictSems _lhsIoptions+ then _argsIpps+ else []) of+ { !_strictParams ->+ (case ((body_ _bodyOnested _bodyOoptions _bodyOoutputfile )) of+ { ( !_bodyIpp) ->+ (case (pp_parens ( "\\" >#< (vlist (map _addBang _argsIpps)) >#< "->"+ >-< indent 4 (_strictParams `ppMultiSeqV` _bodyIpp)+ )) of+ { !_lhsOpp ->+ ( _lhsOpp) }) }) }) }) }) }) }) }) }) }) })) )+sem_Expr_Let :: T_Decls ->+ T_Expr ->+ T_Expr +sem_Expr_Let !(T_Decls decls_ ) !(T_Expr body_ ) =+ (T_Expr (\ (!_lhsInested)+ (!_lhsIoptions)+ (!_lhsIoutputfile) ->+ (case (_lhsIoutputfile) of+ { !_bodyOoutputfile ->+ (case (_lhsIoptions) of+ { !_bodyOoptions ->+ (case (_lhsInested) of+ { !_bodyOnested ->+ (case (_lhsIoutputfile) of+ { !_declsOoutputfile ->+ (case (_lhsIoptions) of+ { !_declsOoptions ->+ (case (_lhsInested) of+ { !_declsOnested ->+ (case (True) of+ { !_declsOisDeclOfLet ->+ (case ((body_ _bodyOnested _bodyOoptions _bodyOoutputfile )) of+ { ( !_bodyIpp) ->+ (case ((decls_ _declsOisDeclOfLet _declsOnested _declsOoptions _declsOoutputfile )) of+ { ( !_declsIpps) ->+ (case (pp_parens ( "let" >#< (vlist _declsIpps)+ >-< "in " >#< _bodyIpp+ )) of+ { !_lhsOpp ->+ ( _lhsOpp) }) }) }) }) }) }) }) }) }) })) )+sem_Expr_LineExpr :: T_Expr ->+ T_Expr +sem_Expr_LineExpr !(T_Expr expr_ ) =+ (T_Expr (\ (!_lhsInested)+ (!_lhsIoptions)+ (!_lhsIoutputfile) ->+ (case (_lhsIoutputfile) of+ { !_exprOoutputfile ->+ (case (_lhsIoptions) of+ { !_exprOoptions ->+ (case (_lhsInested) of+ { !_exprOnested ->+ (case ((expr_ _exprOnested _exprOoptions _exprOoutputfile )) of+ { ( !_exprIpp) ->+ (case (_exprIpp >-< "{-# LINE" >#< ppWithLineNr (\n -> pp $ show $ n + 1) >#< show _lhsIoutputfile >#< "#-}") of+ { !_lhsOpp ->+ ( _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) ->+ (case (_lhsIoutputfile) of+ { !_exprOoutputfile ->+ (case (_lhsIoptions) of+ { !_exprOoptions ->+ (case (_lhsInested) of+ { !_exprOnested ->+ (case ((expr_ _exprOnested _exprOoptions _exprOoutputfile )) of+ { ( !_exprIpp) ->+ (case (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) of+ { !_lhsOpp ->+ ( _lhsOpp) }) }) }) }) })) )+sem_Expr_SimpleExpr :: String ->+ T_Expr +sem_Expr_SimpleExpr !txt_ =+ (T_Expr (\ (!_lhsInested)+ (!_lhsIoptions)+ (!_lhsIoutputfile) ->+ (case (text txt_) of+ { !_lhsOpp ->+ ( _lhsOpp) })) )+sem_Expr_TextExpr :: ([String]) ->+ T_Expr +sem_Expr_TextExpr !lns_ =+ (T_Expr (\ (!_lhsInested)+ (!_lhsIoptions)+ (!_lhsIoutputfile) ->+ (case (vlist (map text lns_)) of+ { !_lhsOpp ->+ ( _lhsOpp) })) )+sem_Expr_Trace :: String ->+ T_Expr ->+ T_Expr +sem_Expr_Trace !txt_ !(T_Expr expr_ ) =+ (T_Expr (\ (!_lhsInested)+ (!_lhsIoptions)+ (!_lhsIoutputfile) ->+ (case (_lhsIoutputfile) of+ { !_exprOoutputfile ->+ (case (_lhsIoptions) of+ { !_exprOoptions ->+ (case (_lhsInested) of+ { !_exprOnested ->+ (case ((expr_ _exprOnested _exprOoptions _exprOoutputfile )) of+ { ( !_exprIpp) ->+ (case ("trace" >#< ( pp_parens ("\"" >|< text txt_ >|< "\"")+ >-< pp_parens _exprIpp+ )) of+ { !_lhsOpp ->+ ( _lhsOpp) }) }) }) }) })) )+sem_Expr_TupleExpr :: T_Exprs ->+ T_Expr +sem_Expr_TupleExpr !(T_Exprs exprs_ ) =+ (T_Expr (\ (!_lhsInested)+ (!_lhsIoptions)+ (!_lhsIoutputfile) ->+ (case (_lhsIoutputfile) of+ { !_exprsOoutputfile ->+ (case (_lhsIoptions) of+ { !_exprsOoptions ->+ (case (_lhsInested) of+ { !_exprsOnested ->+ (case ((exprs_ _exprsOnested _exprsOoptions _exprsOoutputfile )) of+ { ( !_exprsIpps) ->+ (case (ppTuple _lhsInested _exprsIpps) of+ { !_lhsOpp ->+ ( _lhsOpp) }) }) }) }) })) )+sem_Expr_TypedExpr :: T_Expr ->+ T_Type ->+ T_Expr +sem_Expr_TypedExpr !(T_Expr expr_ ) !(T_Type tp_ ) =+ (T_Expr (\ (!_lhsInested)+ (!_lhsIoptions)+ (!_lhsIoutputfile) ->+ (case (_lhsInested) of+ { !_tpOnested ->+ (case (_lhsIoutputfile) of+ { !_exprOoutputfile ->+ (case (_lhsIoptions) of+ { !_exprOoptions ->+ (case (_lhsInested) of+ { !_exprOnested ->+ (case ((tp_ _tpOnested )) of+ { ( !_tpIpp,!_tpIprec) ->+ (case ((expr_ _exprOnested _exprOoptions _exprOoutputfile )) of+ { ( !_exprIpp) ->+ (case (pp_parens (_exprIpp >#< "::" >#< _tpIpp)) of+ { !_lhsOpp ->+ ( _lhsOpp) }) }) }) }) }) }) })) )+sem_Expr_UnboxedTupleExpr :: T_Exprs ->+ T_Expr +sem_Expr_UnboxedTupleExpr !(T_Exprs exprs_ ) =+ (T_Expr (\ (!_lhsInested)+ (!_lhsIoptions)+ (!_lhsIoutputfile) ->+ (case (_lhsIoutputfile) of+ { !_exprsOoutputfile ->+ (case (_lhsIoptions) of+ { !_exprsOoptions ->+ (case (_lhsInested) of+ { !_exprsOnested ->+ (case ((exprs_ _exprsOnested _exprsOoptions _exprsOoutputfile )) of+ { ( !_exprsIpps) ->+ (case (ppUnboxedTuple _lhsInested _exprsIpps) of+ { !_lhsOpp ->+ ( _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 ->+ Inh_Exprs ->+ Syn_Exprs +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) ->+ (case (_lhsIoutputfile) of+ { !_tlOoutputfile ->+ (case (_lhsIoptions) of+ { !_tlOoptions ->+ (case (_lhsInested) of+ { !_tlOnested ->+ (case (_lhsIoutputfile) of+ { !_hdOoutputfile ->+ (case (_lhsIoptions) of+ { !_hdOoptions ->+ (case (_lhsInested) of+ { !_hdOnested ->+ (case ((tl_ _tlOnested _tlOoptions _tlOoutputfile )) of+ { ( !_tlIpps) ->+ (case ((hd_ _hdOnested _hdOoptions _hdOoutputfile )) of+ { ( !_hdIpp) ->+ (case (_hdIpp : _tlIpps) of+ { !_lhsOpps ->+ ( _lhsOpps) }) }) }) }) }) }) }) }) })) )+sem_Exprs_Nil :: T_Exprs +sem_Exprs_Nil =+ (T_Exprs (\ (!_lhsInested)+ (!_lhsIoptions)+ (!_lhsIoutputfile) ->+ (case ([]) of+ { !_lhsOpps ->+ ( _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 addBang : _+ local strictGuard : _+ local hasStrictVars : _+ local addStrictGuard : _+ alternative Pattern3:+ child pat3 : Pattern + visit 0:+ local hasStrictVars : _+ local strictGuard : _+ local addStrictGuard : _+ alternative Pattern3SM:+ child pat3 : Pattern + alternative TupleLhs:+ child comps : {[String]}+ visit 0:+ local addBang : _+ local hasStrictVars : _+ local strictGuard : _+ local addStrictGuard : _+ alternative UnboxedTupleLhs:+ child comps : {[String]}+ visit 0:+ local addBang : _+ local hasStrictVars : _+ local strictGuard : _+ local addStrictGuard : _+-}+-- 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 ->+ Inh_Lhs ->+ Syn_Lhs +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) ->+ (case (_lhsIoutputfile) of+ { !_argsOoutputfile ->+ (case (_lhsIoptions) of+ { !_argsOoptions ->+ (case (_lhsInested) of+ { !_argsOnested ->+ (case (if bangpats _lhsIoptions+ then \p -> "!" >|< p+ else id) of+ { !_addBang ->+ (case ((args_ _argsOnested _argsOoptions _argsOoutputfile )) of+ { ( !_argsIpps) ->+ (case (_argsIpps `ppMultiSeqH` (pp "True")) of+ { !_strictGuard ->+ (case (not (null _argsIpps)) of+ { !_hasStrictVars ->+ (case (if strictSems _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id) of+ { !_addStrictGuard ->+ (case (_addStrictGuard (name_ >#< hv_sp (map _addBang _argsIpps))) of+ { !_lhsOpp ->+ ( _lhsOpp) }) }) }) }) }) }) }) }) })) )+sem_Lhs_Pattern3 :: T_Pattern ->+ T_Lhs +sem_Lhs_Pattern3 !(T_Pattern pat3_ ) =+ (T_Lhs (\ (!_lhsIisDeclOfLet)+ (!_lhsInested)+ (!_lhsIoptions)+ (!_lhsIoutputfile) ->+ (case (_lhsIoptions) of+ { !_pat3Ooptions ->+ (case (_lhsIisDeclOfLet) of+ { !_pat3OisDeclOfLet ->+ (case (False) of+ { !_pat3ObelowIrrefutable ->+ (case ((pat3_ _pat3ObelowIrrefutable _pat3OisDeclOfLet _pat3Ooptions )) of+ { ( !_pat3Icopy,!_pat3IisUnderscore,!_pat3Ipp,!_pat3Ipp',!_pat3IstrictVars) ->+ (case (not (null _pat3IstrictVars)) of+ { !_hasStrictVars ->+ (case (_pat3IstrictVars `ppMultiSeqH` (pp "True")) of+ { !_strictGuard ->+ (case (if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id) of+ { !_addStrictGuard ->+ (case (_addStrictGuard _pat3Ipp) of+ { !_lhsOpp ->+ ( _lhsOpp) }) }) }) }) }) }) }) })) )+sem_Lhs_Pattern3SM :: T_Pattern ->+ T_Lhs +sem_Lhs_Pattern3SM !(T_Pattern pat3_ ) =+ (T_Lhs (\ (!_lhsIisDeclOfLet)+ (!_lhsInested)+ (!_lhsIoptions)+ (!_lhsIoutputfile) ->+ (case (_lhsIoptions) of+ { !_pat3Ooptions ->+ (case (_lhsIisDeclOfLet) of+ { !_pat3OisDeclOfLet ->+ (case (False) of+ { !_pat3ObelowIrrefutable ->+ (case ((pat3_ _pat3ObelowIrrefutable _pat3OisDeclOfLet _pat3Ooptions )) of+ { ( !_pat3Icopy,!_pat3IisUnderscore,!_pat3Ipp,!_pat3Ipp',!_pat3IstrictVars) ->+ (case (_pat3Ipp') of+ { !_lhsOpp ->+ ( _lhsOpp) }) }) }) }) })) )+sem_Lhs_TupleLhs :: ([String]) ->+ T_Lhs +sem_Lhs_TupleLhs !comps_ =+ (T_Lhs (\ (!_lhsIisDeclOfLet)+ (!_lhsInested)+ (!_lhsIoptions)+ (!_lhsIoutputfile) ->+ (case (if bangpats _lhsIoptions+ then \p -> "!" >|< p+ else id) of+ { !_addBang ->+ (case (not (null comps_)) of+ { !_hasStrictVars ->+ (case (if stricterCases _lhsIoptions && not _lhsIisDeclOfLet+ then map text comps_ `ppMultiSeqH` (pp "True")+ else pp "True") of+ { !_strictGuard ->+ (case (if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id) of+ { !_addStrictGuard ->+ (case (_addStrictGuard $ ppTuple _lhsInested (map (_addBang . text) comps_)) of+ { !_lhsOpp ->+ ( _lhsOpp) }) }) }) }) })) )+sem_Lhs_UnboxedTupleLhs :: ([String]) ->+ T_Lhs +sem_Lhs_UnboxedTupleLhs !comps_ =+ (T_Lhs (\ (!_lhsIisDeclOfLet)+ (!_lhsInested)+ (!_lhsIoptions)+ (!_lhsIoutputfile) ->+ (case (if bangpats _lhsIoptions+ then \p -> "!" >|< p+ else id) of+ { !_addBang ->+ (case (not (null comps_)) of+ { !_hasStrictVars ->+ (case (if stricterCases _lhsIoptions && not _lhsIisDeclOfLet+ then map text comps_ `ppMultiSeqH` (pp "True")+ else pp "True") of+ { !_strictGuard ->+ (case (if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id) of+ { !_addStrictGuard ->+ (case (_addStrictGuard $ ppUnboxedTuple _lhsInested (map (_addBang . text) comps_)) of+ { !_lhsOpp ->+ ( _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 copy : _+ local ppVar : _+ local addBang : _+ local ppVarBang : _+ local strictPatVars : _+ local strictVar : _+ alternative Constr:+ child name : {ConstructorIdent}+ child pats : Patterns + visit 0:+ local copy : _+ local addBang : _+ alternative Irrefutable:+ child pat : Pattern + visit 0:+ local copy : _+ alternative Product:+ child pos : {Pos}+ child pats : Patterns + visit 0:+ local copy : _+ local addBang : _+ 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 ->+ Inh_Pattern ->+ Syn_Pattern +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) ->+ (case (_lhsIoptions) of+ { !_partsOoptions ->+ (case (_lhsIisDeclOfLet) of+ { !_partsOisDeclOfLet ->+ (case (_lhsIbelowIrrefutable) of+ { !_partsObelowIrrefutable ->+ (case ((parts_ _partsObelowIrrefutable _partsOisDeclOfLet _partsOoptions )) of+ { ( !_partsIcopy,!_partsIpps,!_partsIpps',!_partsIstrictVars) ->+ (case (_lhsIoptions) of+ { !_patOoptions ->+ (case (_lhsIisDeclOfLet) of+ { !_patOisDeclOfLet ->+ (case (_lhsIbelowIrrefutable) of+ { !_patObelowIrrefutable ->+ (case ((pat_ _patObelowIrrefutable _patOisDeclOfLet _patOoptions )) of+ { ( !_patIcopy,!_patIisUnderscore,!_patIpp,!_patIpp',!_patIstrictVars) ->+ (case (Alias field_ attr_ _patIcopy _partsIcopy) of+ { !_copy ->+ (case (_copy) of+ { !_lhsOcopy ->+ (case (False) of+ { !_lhsOisUnderscore ->+ (case (pp (attrname False field_ attr_)) of+ { !_ppVar ->+ (case (if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable+ then \p -> "!" >|< p+ else id) of+ { !_addBang ->+ (case (_addBang $ _ppVar) of+ { !_ppVarBang ->+ (case (if _patIisUnderscore+ then _ppVarBang+ else _ppVarBang >|< "@" >|< _patIpp) of+ { !_lhsOpp ->+ (case (let attribute | field_ == _LOC || field_ == nullIdent = locname' attr_+ | otherwise = attrname False field_ attr_+ in attribute >|< "@" >|< _patIpp') of+ { !_lhsOpp' ->+ (case (if stricterCases _lhsIoptions && not _lhsIisDeclOfLet+ then _patIstrictVars+ else []) of+ { !_strictPatVars ->+ (case (if strictCases _lhsIoptions && not _lhsIisDeclOfLet+ then [_ppVar ]+ else []) of+ { !_strictVar ->+ (case (_strictVar ++ _strictPatVars) of+ { !_lhsOstrictVars ->+ ( _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) ->+ (case (_lhsIoptions) of+ { !_patsOoptions ->+ (case (_lhsIisDeclOfLet) of+ { !_patsOisDeclOfLet ->+ (case (_lhsIbelowIrrefutable) of+ { !_patsObelowIrrefutable ->+ (case ((pats_ _patsObelowIrrefutable _patsOisDeclOfLet _patsOoptions )) of+ { ( !_patsIcopy,!_patsIpps,!_patsIpps',!_patsIstrictVars) ->+ (case (Constr name_ _patsIcopy) of+ { !_copy ->+ (case (_copy) of+ { !_lhsOcopy ->+ (case (False) of+ { !_lhsOisUnderscore ->+ (case (if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable+ then \p -> "!" >|< p+ else id) of+ { !_addBang ->+ (case (_addBang $ pp_parens $ name_ >#< hv_sp _patsIpps) of+ { !_lhsOpp ->+ (case (pp_parens $ name_ >#< hv_sp (map pp_parens _patsIpps')) of+ { !_lhsOpp' ->+ (case (_patsIstrictVars) of+ { !_lhsOstrictVars ->+ ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars) }) }) }) }) }) }) }) }) }) }) })) )+sem_Pattern_Irrefutable :: T_Pattern ->+ T_Pattern +sem_Pattern_Irrefutable !(T_Pattern pat_ ) =+ (T_Pattern (\ (!_lhsIbelowIrrefutable)+ (!_lhsIisDeclOfLet)+ (!_lhsIoptions) ->+ (case (_lhsIoptions) of+ { !_patOoptions ->+ (case (_lhsIisDeclOfLet) of+ { !_patOisDeclOfLet ->+ (case (True) of+ { !_patObelowIrrefutable ->+ (case ((pat_ _patObelowIrrefutable _patOisDeclOfLet _patOoptions )) of+ { ( !_patIcopy,!_patIisUnderscore,!_patIpp,!_patIpp',!_patIstrictVars) ->+ (case (Irrefutable _patIcopy) of+ { !_copy ->+ (case (_copy) of+ { !_lhsOcopy ->+ (case (_patIisUnderscore) of+ { !_lhsOisUnderscore ->+ (case (text "~" >|< pp_parens _patIpp) of+ { !_lhsOpp ->+ (case (text "~" >|< pp_parens _patIpp) of+ { !_lhsOpp' ->+ (case ([]) of+ { !_lhsOstrictVars ->+ ( _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) ->+ (case (_lhsIoptions) of+ { !_patsOoptions ->+ (case (_lhsIisDeclOfLet) of+ { !_patsOisDeclOfLet ->+ (case (_lhsIbelowIrrefutable) of+ { !_patsObelowIrrefutable ->+ (case ((pats_ _patsObelowIrrefutable _patsOisDeclOfLet _patsOoptions )) of+ { ( !_patsIcopy,!_patsIpps,!_patsIpps',!_patsIstrictVars) ->+ (case (Product pos_ _patsIcopy) of+ { !_copy ->+ (case (_copy) of+ { !_lhsOcopy ->+ (case (False) of+ { !_lhsOisUnderscore ->+ (case (if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable+ then \p -> "!" >|< p+ else id) of+ { !_addBang ->+ (case (_addBang $ pp_block "(" ")" "," _patsIpps) of+ { !_lhsOpp ->+ (case (pp_block "(" ")" "," _patsIpps') of+ { !_lhsOpp' ->+ (case (_patsIstrictVars) of+ { !_lhsOstrictVars ->+ ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars) }) }) }) }) }) }) }) }) }) }) })) )+sem_Pattern_Underscore :: Pos ->+ T_Pattern +sem_Pattern_Underscore !pos_ =+ (T_Pattern (\ (!_lhsIbelowIrrefutable)+ (!_lhsIisDeclOfLet)+ (!_lhsIoptions) ->+ (case (Underscore pos_) of+ { !_copy ->+ (case (_copy) of+ { !_lhsOcopy ->+ (case (True) of+ { !_lhsOisUnderscore ->+ (case (text "_") of+ { !_lhsOpp ->+ (case (text "_") of+ { !_lhsOpp' ->+ (case ([]) of+ { !_lhsOstrictVars ->+ ( _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 ->+ Inh_Patterns ->+ Syn_Patterns +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) ->+ (case (_lhsIoptions) of+ { !_tlOoptions ->+ (case (_lhsIisDeclOfLet) of+ { !_tlOisDeclOfLet ->+ (case (_lhsIbelowIrrefutable) of+ { !_tlObelowIrrefutable ->+ (case ((tl_ _tlObelowIrrefutable _tlOisDeclOfLet _tlOoptions )) of+ { ( !_tlIcopy,!_tlIpps,!_tlIpps',!_tlIstrictVars) ->+ (case (_lhsIoptions) of+ { !_hdOoptions ->+ (case (_lhsIisDeclOfLet) of+ { !_hdOisDeclOfLet ->+ (case (_lhsIbelowIrrefutable) of+ { !_hdObelowIrrefutable ->+ (case ((hd_ _hdObelowIrrefutable _hdOisDeclOfLet _hdOoptions )) of+ { ( !_hdIcopy,!_hdIisUnderscore,!_hdIpp,!_hdIpp',!_hdIstrictVars) ->+ (case ((:) _hdIcopy _tlIcopy) of+ { !_copy ->+ (case (_copy) of+ { !_lhsOcopy ->+ (case (_hdIpp : _tlIpps) of+ { !_lhsOpps ->+ (case (_hdIpp' : _tlIpps') of+ { !_lhsOpps' ->+ (case (_hdIstrictVars ++ _tlIstrictVars) of+ { !_lhsOstrictVars ->+ ( _lhsOcopy,_lhsOpps,_lhsOpps',_lhsOstrictVars) }) }) }) }) }) }) }) }) }) }) }) }) })) )+sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil =+ (T_Patterns (\ (!_lhsIbelowIrrefutable)+ (!_lhsIisDeclOfLet)+ (!_lhsIoptions) ->+ (case ([]) of+ { !_copy ->+ (case (_copy) of+ { !_lhsOcopy ->+ (case ([]) of+ { !_lhsOpps ->+ (case ([]) of+ { !_lhsOpps' ->+ (case ([]) of+ { !_lhsOstrictVars ->+ ( _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+ textBlockMap : Map BlockInfo PP_Doc+ textBlocks : PP_Doc+ synthesized attributes:+ genIO : IO ()+ output : PP_Docs+ alternatives:+ alternative Program:+ child chunks : Chunks + visit 0:+ local commonFile : _+ local genCommonModule : _+ local mainModuleFile : _+ local genMainModule : _+-}+-- 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 ->+ (Map BlockInfo PP_Doc) ->+ 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),textBlockMap_Inh_Program :: !(Map BlockInfo PP_Doc),textBlocks_Inh_Program :: !(PP_Doc)}+data Syn_Program = Syn_Program {genIO_Syn_Program :: !(IO ()),output_Syn_Program :: !(PP_Docs)}+wrap_Program :: T_Program ->+ Inh_Program ->+ Syn_Program +wrap_Program !(T_Program sem ) !(Inh_Program _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks ) =+ (let ( !_lhsOgenIO,!_lhsOoutput) =+ (sem _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _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)+ (!_lhsItextBlockMap)+ (!_lhsItextBlocks) ->+ (case (_lhsItextBlockMap) of+ { !_chunksOtextBlockMap ->+ (case (_lhsIpragmaBlocks) of+ { !_chunksOpragmaBlocks ->+ (case (_lhsIoptionsLine) of+ { !_chunksOoptionsLine ->+ (case (_lhsIoptions) of+ { !_chunksOoptions ->+ (case (_lhsImoduleHeader) of+ { !_chunksOmoduleHeader ->+ (case (_lhsImainName) of+ { !_chunksOmainName ->+ (case (_lhsImainFile) of+ { !_chunksOmainFile ->+ (case (_lhsImainFile ++ "_common.hs") of+ { !_commonFile ->+ (case (False) of+ { !_chunksOisDeclOfLet ->+ (case (nest _lhsIoptions) of+ { !_chunksOnested ->+ (case (_lhsItextBlocks) of+ { !_chunksOtextBlocks ->+ (case (_lhsIimportBlocks) of+ { !_chunksOimportBlocks ->+ (case ((chunks_ _chunksOimportBlocks _chunksOisDeclOfLet _chunksOmainFile _chunksOmainName _chunksOmoduleHeader _chunksOnested _chunksOoptions _chunksOoptionsLine _chunksOpragmaBlocks _chunksOtextBlockMap _chunksOtextBlocks )) of+ { ( !_chunksIappendCommon,!_chunksIappendMain,!_chunksIgenSems,!_chunksIimports,!_chunksIpps) ->+ (case (writeModule _commonFile+ ( [ pp $ _lhsIpragmaBlocks+ , pp $ _lhsIoptionsLine+ , pp $ _lhsImoduleHeader _lhsImainName "_common" "" True+ , _lhsIimportBlocks+ , _lhsItextBlocks+ ]+ ++ map vlist _chunksIappendCommon+ )) of+ { !_genCommonModule ->+ (case (_lhsImainFile ++ ".hs") of+ { !_mainModuleFile ->+ (case (writeModule _mainModuleFile+ ( [ pp $ _lhsIpragmaBlocks+ , pp $ _lhsIoptionsLine+ , pp $ _lhsImoduleHeader _lhsImainName "" "" False+ , pp $ ("import " ++ _lhsImainName ++ "_common\n")+ ]+ ++ map pp _chunksIimports+ ++ map vlist _chunksIappendMain+ )) of+ { !_genMainModule ->+ (case (do _genMainModule+ _genCommonModule+ _chunksIgenSems) of+ { !_lhsOgenIO ->+ (case (_chunksIpps) of+ { !_lhsOoutput ->+ ( _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 r : _+ local l : _+ 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 ->+ Inh_Type ->+ Syn_Type +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) ->+ (case (_lhsInested) of+ { !_rightOnested ->+ (case (_lhsInested) of+ { !_leftOnested ->+ (case ((right_ _rightOnested )) of+ { ( !_rightIpp,!_rightIprec) ->+ (case (if _rightIprec < 2 then pp_parens _rightIpp else _rightIpp) of+ { !_r ->+ (case ((left_ _leftOnested )) of+ { ( !_leftIpp,!_leftIprec) ->+ (case (if _leftIprec <= 2 then pp_parens _leftIpp else _leftIpp) of+ { !_l ->+ (case (_l >#< "->" >-< _r) of+ { !_lhsOpp ->+ (case (2) of+ { !_lhsOprec ->+ ( _lhsOpp,_lhsOprec) }) }) }) }) }) }) }) })) )+sem_Type_CtxApp :: ([(String, [String])]) ->+ T_Type ->+ T_Type +sem_Type_CtxApp !left_ !(T_Type right_ ) =+ (T_Type (\ (!_lhsInested) ->+ (case (_lhsInested) of+ { !_rightOnested ->+ (case ((right_ _rightOnested )) of+ { ( !_rightIpp,!_rightIprec) ->+ (case ((pp_block "(" ")" "," $ map (\(n,ns) -> hv_sp $ map pp (n:ns)) left_) >#< "=>" >#< _rightIpp) of+ { !_lhsOpp ->+ (case (_rightIprec) of+ { !_lhsOprec ->+ ( _lhsOpp,_lhsOprec) }) }) }) })) )+sem_Type_List :: T_Type ->+ T_Type +sem_Type_List !(T_Type tp_ ) =+ (T_Type (\ (!_lhsInested) ->+ (case (_lhsInested) of+ { !_tpOnested ->+ (case ((tp_ _tpOnested )) of+ { ( !_tpIpp,!_tpIprec) ->+ (case ("[" >|< _tpIpp >|< "]") of+ { !_lhsOpp ->+ (case (5) of+ { !_lhsOprec ->+ ( _lhsOpp,_lhsOprec) }) }) }) })) )+sem_Type_SimpleType :: String ->+ T_Type +sem_Type_SimpleType !txt_ =+ (T_Type (\ (!_lhsInested) ->+ (case (if reallySimple txt_ then text txt_ else pp_parens (text txt_)) of+ { !_lhsOpp ->+ (case (5) of+ { !_lhsOprec ->+ ( _lhsOpp,_lhsOprec) }) })) )+sem_Type_TupleType :: T_Types ->+ T_Type +sem_Type_TupleType !(T_Types tps_ ) =+ (T_Type (\ (!_lhsInested) ->+ (case (_lhsInested) of+ { !_tpsOnested ->+ (case ((tps_ _tpsOnested )) of+ { ( !_tpsIpps) ->+ (case (ppTuple _lhsInested _tpsIpps) of+ { !_lhsOpp ->+ (case (5) of+ { !_lhsOprec ->+ ( _lhsOpp,_lhsOprec) }) }) }) })) )+sem_Type_TypeApp :: T_Type ->+ T_Types ->+ T_Type +sem_Type_TypeApp !(T_Type func_ ) !(T_Types args_ ) =+ (T_Type (\ (!_lhsInested) ->+ (case (_lhsInested) of+ { !_argsOnested ->+ (case (_lhsInested) of+ { !_funcOnested ->+ (case ((args_ _argsOnested )) of+ { ( !_argsIpps) ->+ (case ((func_ _funcOnested )) of+ { ( !_funcIpp,!_funcIprec) ->+ (case (hv_sp (_funcIpp : _argsIpps)) of+ { !_lhsOpp ->+ (case (_funcIprec) of+ { !_lhsOprec ->+ ( _lhsOpp,_lhsOprec) }) }) }) }) }) })) )+sem_Type_UnboxedTupleType :: T_Types ->+ T_Type +sem_Type_UnboxedTupleType !(T_Types tps_ ) =+ (T_Type (\ (!_lhsInested) ->+ (case (_lhsInested) of+ { !_tpsOnested ->+ (case ((tps_ _tpsOnested )) of+ { ( !_tpsIpps) ->+ (case (ppUnboxedTuple _lhsInested _tpsIpps) of+ { !_lhsOpp ->+ (case (5) of+ { !_lhsOprec ->+ ( _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 ->+ Inh_Types ->+ Syn_Types +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) ->+ (case (_lhsInested) of+ { !_tlOnested ->+ (case (_lhsInested) of+ { !_hdOnested ->+ (case ((tl_ _tlOnested )) of+ { ( !_tlIpps) ->+ (case ((hd_ _hdOnested )) of+ { ( !_hdIpp,!_hdIprec) ->+ (case (_hdIpp : _tlIpps) of+ { !_lhsOpps ->+ ( _lhsOpps) }) }) }) }) })) )+sem_Types_Nil :: T_Types +sem_Types_Nil =+ (T_Types (\ (!_lhsInested) ->+ (case ([]) of+ { !_lhsOpps -> ( _lhsOpps) })) )
src-derived/PrintErrorMessages.hs view
@@ -1,1303 +1,1303 @@- - --- UUAGC 0.9.11 (PrintErrorMessages.ag) -module PrintErrorMessages where - -import Pretty -import UU.Scanner.Position(Pos(..), noPos) -import ErrorMessages -import DepTypes -import Options -import Data.List(mapAccumL,intersect,(\\)) -import GrammarInfo - - -import UU.Scanner.Position(Pos) -import Pretty -import DepTypes(Trace) -import CodeSyntax -import CommonTypes - -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 _ _ _ ) = False -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 -isError opts (DupUnique _ _ _ ) = False -isError opts (MissingUnique _ _ ) = 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 - -showEdge ((inh,syn),_,_) - = text ("inherited attribute " ++ toWidth 20 (getName inh) ++ " with synthesized attribute " ++ getName syn) - -showEdgeLong ((inh,syn),path1,path2) - = text ("inherited attribute " ++ getName inh ++ " is needed for " ++ "synthesized attribute " ++ getName syn) - >-< indent 4 (vlist (map text path2)) - >-< text "and back: " - >-< indent 4 (vlist (map text path1)) - -attrText inh syn - = if inh == syn - then "threaded attribute " ++ getName inh - else "inherited attribute " ++ getName inh ++ " and synthesized attribute " ++getName syn - - -ppTrace :: Trace -> PP_Doc -ppTrace (tr:rest) = wfill [showLineNr (lineNr tr) ++ ":", "SEM", getName (nt tr), "|", getName (prod tr) - , lhsFld tr +.+ lhsAttr tr, "=", "..." +#+ showRhs tr +#+ "..."] - >-< ppTrace rest -ppTrace [] = empty - -showRhs :: TraceElem -> String -showRhs tr = if null (getName field) - then "@" ++ getName attr - else "@" ++ (field +.+ attr) - where field = rhsFld tr - attr = rhsAttr tr - -showLineNr :: Int -> String -showLineNr i | i==(-1) = "CR" - | otherwise = show i - -showAttrDef f a | f == _LHS = "synthesized attribute " ++ getName a - | f == _LOC = "local attribute " ++ getName a - | f == _INST = "inst attribute " ++ getName a - | otherwise = "inherited attribute " ++ getName a ++ " of field " ++ getName f - -showAttrUse f a | f == _LHS = "inherited attribute " ++ getName a - | f == _LOC = "local attribute " ++ getName a - | f == _INST = "inst attribute " ++ getName a - | otherwise = "synthesized attribute " ++ getName a ++ " of field " ++ getName f - -ppAttr f a = text (getName f++"."++getName a) -ppAttrUse f a = "@" >|< ppAttr f a - - -infixr 5 +#+ -(+#+) :: String -> String -> String -(+#+) s t = s ++ " " ++ t - -infixr 5 +.+ -(+.+) :: Identifier -> Identifier -> String -(+.+) s t = getName s ++ "." ++ getName t - -wfill = fill . addSpaces. concat . map words - where addSpaces (x:xs) = x:map addSpace xs - addSpaces [] = [] - addSpace [x] | x `elem` ".,;:!?" = [x] - addSpace xs = ' ':xs - -ppError :: Bool -- class of the error, True:error False:warning - -> Pos -- source position - -> PP_Doc -- error message - -> PP_Doc -- pattern - -> PP_Doc -- help, more info - -> PP_Doc -- action taken by AG - -> Bool -- verbose? show help and action? - -> PP_Doc -ppError isError pos mesg pat hlp act verbose - = let position = case pos of - Pos l c f | l >= 0 -> f >|< ":" >|< show l >|< ":" >|< show c - | otherwise -> pp "uuagc" - tp = if isError then "error" else "warning" - header = position >|< ":" >#< tp >|< ":" >#< mesg - pattern = "pattern :" >#< pat - help = "help :" >#< hlp - action = "action :" >#< act - in if verbose - then vlist [text "",header,pattern,help,action] - else header - -{- --- old error reporting code - = let - cl = if isError then "ERROR" else "Warning" - position = case pos of - (Pos l c f) | l >= 0 -> f >|< ": line " >|< show l >|< ", column " >|< show c - | otherwise -> empty - header = "*** UU.AG" >#< cl >#< position >#< "***" - message = "problem :" >#< mesg - pattern = "pattern :" >#< pat - help = "help :" >#< hlp - action = "action :" >#< act - in - if verbose - then vlist [text "",header,message,pattern,help,action] - else vlist [text "",header,message] --} - -showPos = show . getPos - -ppInterface inter = wfill ["interface:", show inter] - --- Error ------------------------------------------------------- -{- - visit 0: - inherited attributes: - options : Options - verbose : Bool - synthesized attributes: - me : SELF - pp : PP_Doc - alternatives: - alternative ChildAsLocal: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child var : {Identifier} - visit 0: - local me : _ - alternative CustomError: - child isWarning : {Bool} - child pos : {Pos} - child mesg : {PP_Doc} - visit 0: - local me : _ - alternative CyclicSet: - child name : {Identifier} - visit 0: - local me : _ - alternative DirectCirc: - child nt : {NontermIdent} - child o_visit : {Bool} - child cyclic : {[((Identifier,Identifier),[String],[String])]} - visit 0: - local me : _ - alternative DupAlt: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child occ1 : {ConstructorIdent} - visit 0: - local me : _ - alternative DupChild: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child name : {Identifier} - child occ1 : {Identifier} - visit 0: - local me : _ - alternative DupInhAttr: - child nt : {NontermIdent} - child attr : {Identifier} - child occ1 : {Identifier} - visit 0: - local me : _ - alternative DupRule: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child field : {Identifier} - child attr : {Identifier} - child occ1 : {Identifier} - visit 0: - local me : _ - alternative DupSet: - child name : {NontermIdent} - child occ1 : {NontermIdent} - visit 0: - local me : _ - alternative DupSig: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child attr : {Identifier} - visit 0: - local me : _ - alternative DupSynAttr: - child nt : {NontermIdent} - child attr : {Identifier} - child occ1 : {Identifier} - visit 0: - local me : _ - alternative DupSynonym: - child nt : {NontermIdent} - child occ1 : {NontermIdent} - visit 0: - local me : _ - alternative DupUnique: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child attr : {Identifier} - visit 0: - local me : _ - alternative InducedCirc: - child nt : {NontermIdent} - child cinter : {CInterface} - child cyclic : {[((Identifier,Identifier),[String],[String])]} - visit 0: - local me : _ - alternative InstCirc: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child attr : {Identifier} - child o_visit : {Bool} - child path : {[String]} - visit 0: - local me : _ - alternative LocalCirc: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child attr : {Identifier} - child o_visit : {Bool} - child path : {[String]} - visit 0: - local me : _ - alternative MissingInstSig: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child attr : {Identifier} - visit 0: - local me : _ - alternative MissingRule: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child field : {Identifier} - child attr : {Identifier} - visit 0: - local me : _ - alternative MissingTypeSig: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child attr : {Identifier} - visit 0: - local me : _ - alternative MissingUnique: - child nt : {NontermIdent} - child attr : {Identifier} - visit 0: - local me : _ - alternative ParserError: - child pos : {Pos} - child problem : {String} - child action : {String} - visit 0: - local me : _ - alternative SuperfluousRule: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child field : {Identifier} - child attr : {Identifier} - visit 0: - local me : _ - alternative UndefAlt: - child nt : {NontermIdent} - child con : {ConstructorIdent} - visit 0: - local me : _ - alternative UndefAttr: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child field : {Identifier} - child attr : {Identifier} - child isOut : {Bool} - visit 0: - local me : _ - alternative UndefChild: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child name : {Identifier} - visit 0: - local me : _ - alternative UndefLocal: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child var : {Identifier} - visit 0: - local me : _ - alternative UndefNont: - 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 (DupUnique _nt _con _attr ) = - (sem_Error_DupUnique _nt _con _attr ) -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 (MissingUnique _nt _attr ) = - (sem_Error_MissingUnique _nt _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 (Options -> - Bool -> - ( Error,PP_Doc)) -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 -> - Inh_Error -> - Syn_Error -wrap_Error (T_Error sem ) (Inh_Error _lhsIoptions _lhsIverbose ) = - (let ( _lhsOme,_lhsOpp) = - (sem _lhsIoptions _lhsIverbose ) - in (Syn_Error _lhsOme _lhsOpp )) -sem_Error_ChildAsLocal :: NontermIdent -> - ConstructorIdent -> - Identifier -> - T_Error -sem_Error_ChildAsLocal nt_ con_ var_ = - (T_Error (\ _lhsIoptions - _lhsIverbose -> - (let _lhsOpp :: PP_Doc - _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 302, column 21) - _lhsOpp = - let mesg = wfill ["Nontrivial field ",getName var_, "is used as local at constructor" - , getName con_ , "of nonterminal",getName nt_, "." - ] - pat = "SEM" >#< getName nt_ - >-< indent 2 ("|" >#< getName con_ >#< "... = " - >#< "..." >#< "@" >|< getName var_ >#< "..." ) - help = wfill ["A rule in the definitions for alternative" , getName con_ ,"of nonterminal" - , getName nt_ , "contains a nontrivial field name", getName var_, "." - ,"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 _lhsIoptions _me) (getPos var_) mesg pat help act _lhsIverbose - -- self rule - _me = - ChildAsLocal nt_ con_ var_ - -- self rule - _lhsOme = - _me - in ( _lhsOme,_lhsOpp))) ) -sem_Error_CustomError :: Bool -> - Pos -> - PP_Doc -> - T_Error -sem_Error_CustomError isWarning_ pos_ mesg_ = - (T_Error (\ _lhsIoptions - _lhsIverbose -> - (let _lhsOpp :: PP_Doc - _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 344, column 21) - _lhsOpp = - let pat = text "unknown" - help = wfill ["not available."] - act = wfill ["unknown"] - 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 :: Identifier -> - T_Error -sem_Error_CyclicSet name_ = - (T_Error (\ _lhsIoptions - _lhsIverbose -> - (let _lhsOpp :: PP_Doc - _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 335, column 21) - _lhsOpp = - let mesg = wfill ["Cyclic definition for nonterminal set", getName name_] - pat = "SET" >#< getName name_ >#< "=" >#< "..." >#< getName name_ >#< "..." - help = wfill ["The defintion for a nonterminal set named" , getName name_ - ,"directly or indirectly refers to itself." - ,"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 _lhsIoptions _me) (getPos name_) mesg pat help act _lhsIverbose - -- self rule - _me = - CyclicSet name_ - -- self rule - _lhsOme = - _me - in ( _lhsOme,_lhsOpp))) ) -sem_Error_DirectCirc :: NontermIdent -> - Bool -> - ([((Identifier,Identifier),[String],[String])]) -> - T_Error -sem_Error_DirectCirc nt_ o_visit_ cyclic_ = - (T_Error (\ _lhsIoptions - _lhsIverbose -> - (let _lhsOpp :: PP_Doc - _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 373, column 21) - _lhsOpp = - let mesg = wfill ["In nonterminal", getName nt_, "synthesized and inherited attributes are mutually dependent" ] - >-< vlist (map showEdge cyclic_) - pat = text "" - 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 _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 :: NontermIdent -> - ConstructorIdent -> - ConstructorIdent -> - T_Error -sem_Error_DupAlt nt_ con_ occ1_ = - (T_Error (\ _lhsIoptions - _lhsIverbose -> - (let _lhsOpp :: PP_Doc - _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 75, column 21) - _lhsOpp = - let mesg = wfill ["Repeated definition for alternative", getName con_ - ,"of nonterminal", getName nt_, "." - ] >-< - wfill ["First definition:", (showPos occ1_),"."] >-< - wfill ["Other definition:", (showPos con_),"."] - pat = "DATA" >#< getName nt_ - >-< indent 2 ("|" >#< getName con_ >#< "...") - >-< indent 2 ("|" >#< getName con_ >#< "...") - help = wfill ["The nonterminal",getName nt_,"has more than one alternative that" - ,"is labelled with the constructor name",getName con_,"." - ,"You should either rename or remove enough of them to make all" - ,"constructors of",getName nt_,"uniquely named." - ] - act = wfill [ "The first alternative of name",getName con_ - ,"you have given for nonterminal",getName nt_ - ,"is considered valid. All other alternatives have been discarded." - ] - 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 :: NontermIdent -> - ConstructorIdent -> - Identifier -> - Identifier -> - T_Error -sem_Error_DupChild nt_ con_ name_ occ1_ = - (T_Error (\ _lhsIoptions - _lhsIverbose -> - (let _lhsOpp :: PP_Doc - _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 168, column 21) - _lhsOpp = - let mesg = wfill ["Repeated declaration for field", getName name_, "of alternative" - ,getName con_, "of nonterminal", getName nt_, "." - ] >-< - wfill ["First definition:", (showPos occ1_),"."] >-< - wfill ["Other definition:", (showPos name_),"."] - pat = "DATA" >#< getName nt_ - >-< indent 2 ("|" >#< getName con_ >#< (getName name_ >|< ":..." >-< getName name_ >|< ":...")) - help = wfill ["The alternative" ,getName con_ , "of nonterminal" ,getName nt_ - ,"has more than one field that is named" - , getName name_ ++ ". Possibly they have different types." - ,"You should either rename or remove enough of them to make all fields of" - ,getName con_ , "for nonterminal " , getName nt_ , "uniquely named." - ] - act = wfill ["The last declaration with its corresponding type is considered valid." - ,"All others have been discarded." - ] - 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 :: NontermIdent -> - Identifier -> - Identifier -> - T_Error -sem_Error_DupInhAttr nt_ attr_ occ1_ = - (T_Error (\ _lhsIoptions - _lhsIverbose -> - (let _lhsOpp :: PP_Doc - _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 130, column 21) - _lhsOpp = - let mesg = wfill ["Repeated declaration of inherited attribute", getName attr_ - , "of nonterminal", getName nt_, "." - ] >-< - wfill ["First definition:", (showPos occ1_),"."] >-< - wfill ["Other definition:", (showPos attr_),"."] - pat = "ATTR" >#< getName nt_ >#< "[" >#< getName attr_ >|< ":...," - >#< getName attr_ >|< ":... | | ]" - help = wfill ["The identifier" , getName attr_ ,"has been declared" - ,"as an inherited (or chained) attribute for nonterminal" - ,getName nt_ , "more than once, with possibly different types." - ,"Delete all but one or rename them to make them unique." - ] - 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 _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 :: NontermIdent -> - ConstructorIdent -> - Identifier -> - Identifier -> - Identifier -> - T_Error -sem_Error_DupRule nt_ con_ field_ attr_ occ1_ = - (T_Error (\ _lhsIoptions - _lhsIverbose -> - (let _lhsOpp :: PP_Doc - _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 188, column 21) - _lhsOpp = - let mesg = wfill ["At constructor",getName con_, "of nonterminal", getName nt_, "there are two or more rules for" - ,showAttrDef field_ attr_,"." - ] >-< - wfill ["First rule:", (showPos occ1_),"."] >-< - wfill ["Other rule:", (showPos attr_),"."] - pat = "SEM" >#< getName nt_ - >-< indent 2 ("|" >#< getName con_ >#< ppAttr field_ attr_ >#< "= ...") - >-< indent 2 ("|" >#< getName con_ >#< ppAttr field_ attr_ >#< "= ...") - help = wfill ["In the rules for alternative" , getName con_ , "of nonterminal" , getName nt_ - ,", there is more than one rule for the" , showAttrDef field_ attr_ - ,". You should either rename or remove enough of them to make all rules for alternative" - ,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 _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 :: NontermIdent -> - NontermIdent -> - T_Error -sem_Error_DupSet name_ occ1_ = - (T_Error (\ _lhsIoptions - _lhsIverbose -> - (let _lhsOpp :: PP_Doc - _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 114, column 21) - _lhsOpp = - let mesg = wfill ["Definition of nonterminal set", getName name_, "clashes with another" - ,"set, a type synonym or a data definition." - ] >-< - wfill ["First definition:", (showPos occ1_),"."] >-< - wfill ["Set definition:" , (showPos name_),"."] - pat = "SET" >#< getName name_ >#< "=" >#< "..." - >-< "SET" >#< getName name_ >#< "=" >#< "..." - help = wfill ["A nonterminal set with name", getName name_ - ,"has been given while there already is a SET, DATA, or TYPE" - ,"definition with the same name." - ,"You should either rename or remove the nonterminal set." - ] - act = wfill [ "The clashing nonterminal set will be ignored." - ] - 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 :: NontermIdent -> - ConstructorIdent -> - Identifier -> - T_Error -sem_Error_DupSig nt_ con_ attr_ = - (T_Error (\ _lhsIoptions - _lhsIverbose -> - (let _lhsOpp :: PP_Doc - _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 206, column 21) - _lhsOpp = - let mesg = wfill ["At constructor",getName con_, "of nonterminal", getName nt_, "there are two or more typesignatures for" - ,showAttrDef _LOC attr_,"." - ] >-< - wfill ["First signature:", (showPos attr_),"."] - pat = "SEM" >#< getName nt_ - >-< indent 2 ("|" >#< getName con_ >#< ppAttr _LOC attr_ >#< "= ...") - >-< indent 2 ("|" >#< getName con_ >#< ppAttr _LOC attr_ >#< "= ...") - help = wfill ["In the rules for alternative" , getName con_ , "of nonterminal" , getName nt_ - ,", there is more than one rule for the" , showAttrDef _LOC attr_ - ,". You should remove enough of them to make all typesignatures for alternative" - ,getName con_ , "of nonterminal " ,getName nt_ , "unique." - ] - act = wfill ["The last typesignature given is considered valid. All others have been discarded."] - 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 :: NontermIdent -> - Identifier -> - Identifier -> - T_Error -sem_Error_DupSynAttr nt_ attr_ occ1_ = - (T_Error (\ _lhsIoptions - _lhsIverbose -> - (let _lhsOpp :: PP_Doc - _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 149, column 21) - _lhsOpp = - let mesg = wfill ["Repeated declaration of synthesized attribute", getName attr_ - , "of nonterminal", getName nt_, "." - ] >-< - wfill ["First definition:", (showPos occ1_),"."] >-< - wfill ["Other definition:", (showPos attr_),"."] - pat = "ATTR" >#< getName nt_ >#< "[ | |" >#< getName attr_ >|< ":...," - >#< getName attr_ >|< ":... ]" - help = wfill ["The identifier" , getName attr_ ,"has been declared" - ,"as a synthesized (or chained) attribute for nonterminal" - ,getName nt_ , "more than once, with possibly different types." - ,"Delete all but one or rename them to make them unique." - ] - 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 _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 :: NontermIdent -> - NontermIdent -> - T_Error -sem_Error_DupSynonym nt_ occ1_ = - (T_Error (\ _lhsIoptions - _lhsIverbose -> - (let _lhsOpp :: PP_Doc - _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 97, column 21) - _lhsOpp = - let mesg = wfill ["Definition of type synonym", getName nt_, "clashes with another" - ,"type synonym." - ] >-< - wfill ["First definition:", (showPos occ1_),"."] >-< - wfill ["Type synonym :" , (showPos nt_),"."] - pat = "DATA" >#< getName nt_ - >-< indent 2 ("|" >#< "...") - >-< "TYPE" >#< getName nt_ >#< "=" >#< "..." - help = wfill ["A type synonym with name", getName nt_ - ,"has been given while there already is TYPE" - ,"definition with the same name." - ,"You should either rename or remove the type synonym." - ] - act = wfill [ "The clashing type synonym will be ignored." - ] - 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_DupUnique :: NontermIdent -> - ConstructorIdent -> - Identifier -> - T_Error -sem_Error_DupUnique nt_ con_ attr_ = - (T_Error (\ _lhsIoptions - _lhsIverbose -> - (let _lhsOpp :: PP_Doc - _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 434, column 21) - _lhsOpp = - let mesg = wfill ["At constructor",getName con_, "of nonterminal", getName nt_, "there are two or more unique-attribute signatures for" - ,showAttrDef _LOC attr_,"." - ] >-< - wfill ["First signature:", (showPos attr_),"."] - pat = "SEM" >#< getName nt_ - >-< indent 2 ("|" >#< getName con_ >#< ppAttr _LOC attr_ >#< " : UNIQUEREF ...") - >-< indent 2 ("|" >#< getName con_ >#< ppAttr _LOC attr_ >#< " : UNIQUEREF ...") - help = wfill ["In the rules for alternative" , getName con_ , "of nonterminal" , getName nt_ - ,", there is more than one unique-attribute signature for the" , showAttrDef _LOC attr_ - ,". You should remove enough of them to make all unique-signatures for alternative" - ,getName con_ , "of nonterminal " ,getName nt_ , "unique." - ] - act = wfill ["Unpredicatable sharing of unique numbers may occur."] - in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose - -- self rule - _me = - DupUnique nt_ con_ attr_ - -- self rule - _lhsOme = - _me - in ( _lhsOme,_lhsOpp))) ) -sem_Error_InducedCirc :: NontermIdent -> - CInterface -> - ([((Identifier,Identifier),[String],[String])]) -> - T_Error -sem_Error_InducedCirc nt_ cinter_ cyclic_ = - (T_Error (\ _lhsIoptions - _lhsIverbose -> - (let _lhsOpp :: PP_Doc - _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 381, 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_) - pat = text "" - showInter (CInterface segs) = concat (snd (mapAccumL (\i c -> (i+1,("visit " ++ show i) : map ind (showsSegment c))) 0 segs)) - 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 _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 :: NontermIdent -> - ConstructorIdent -> - Identifier -> - Bool -> - ([String]) -> - T_Error -sem_Error_InstCirc nt_ con_ attr_ o_visit_ path_ = - (T_Error (\ _lhsIoptions - _lhsIverbose -> - (let _lhsOpp :: PP_Doc - _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 361, column 21) - _lhsOpp = - let mesg = wfill ["Circular dependency for inst attribute", getName attr_ - , "of alternative", getName con_, "of nonterminal", getName nt_] - pat = "SEM" >#< getName nt_ - >-< indent 2 ("|" >#< getName con_ >#< "inst." >|< getName attr_ >#< "=" - >#< "..." >#< "@s.<some attribte>" >#< "...") - help = if null path_ - then text "the definition is directly circular" - 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 _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 :: NontermIdent -> - ConstructorIdent -> - Identifier -> - Bool -> - ([String]) -> - T_Error -sem_Error_LocalCirc nt_ con_ attr_ o_visit_ path_ = - (T_Error (\ _lhsIoptions - _lhsIverbose -> - (let _lhsOpp :: PP_Doc - _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 349, column 21) - _lhsOpp = - let mesg = wfill ["Circular dependency for local attribute", getName attr_ - , "of alternative", getName con_, "of nonterminal", getName nt_] - pat = "SEM" >#< getName nt_ - >-< indent 2 ("|" >#< getName con_ >#< "loc." >|< getName attr_ >#< "=" - >#< "..." >#< "@loc." >|< getName attr_ >#< "...") - help = if null path_ - then text "the definition is directly circular" - 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 _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 :: NontermIdent -> - ConstructorIdent -> - Identifier -> - T_Error -sem_Error_MissingInstSig nt_ con_ attr_ = - (T_Error (\ _lhsIoptions - _lhsIverbose -> - (let _lhsOpp :: PP_Doc - _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 404, column 21) - _lhsOpp = - let mesg = wfill ["Type signature needed, but not found for", showAttrDef _INST attr_ , "in alternative" - , getName con_ , "of nonterminal",getName nt_ ,"." - ]>-< - wfill ["Location:", (showPos attr_),"."] - pat = "SEM" >#< nt_ - >-< indent 2 ("|" >#< getName con_ >#< ppAttr _INST attr_ >#< ": ...") - help = wfill ["The", showAttrDef _INST attr_, "in alternative", getName con_ - ,"of nonterminal", getName nt_, "is a non-terminal attribute, so " - ,"its type is needed to attribute its value." - ,"Please supply its type." - ] - act = wfill ["It is not possible to proceed without this signature."] - 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 :: NontermIdent -> - ConstructorIdent -> - Identifier -> - Identifier -> - T_Error -sem_Error_MissingRule nt_ con_ field_ attr_ = - (T_Error (\ _lhsIoptions - _lhsIverbose -> - (let _lhsOpp :: PP_Doc - _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 260, column 21) - _lhsOpp = - let mesg = wfill ["Missing rule for", showAttrDef field_ attr_ , "in alternative" - , getName con_ , "of nonterminal",getName nt_ ,"." - ] - pat = "SEM" >#< nt_ - >-< indent 2 ("|" >#< getName con_ >#< ppAttr field_ attr_ >#< "= ...") - help = wfill ["The", showAttrDef field_ attr_, "in alternative", getName con_ - , "of nonterminal", getName nt_, "is missing and cannot be inferred" - ,"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 _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 :: NontermIdent -> - ConstructorIdent -> - Identifier -> - T_Error -sem_Error_MissingTypeSig nt_ con_ attr_ = - (T_Error (\ _lhsIoptions - _lhsIverbose -> - (let _lhsOpp :: PP_Doc - _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 390, column 21) - _lhsOpp = - let mesg = wfill ["Type signature needed, but not found for", showAttrDef _LOC attr_ , "in alternative" - , getName con_ , "of nonterminal",getName nt_ ,"." - ]>-< - wfill ["Location:", (showPos attr_),"."] - pat = "SEM" >#< nt_ - >-< indent 2 ("|" >#< getName con_ >#< ppAttr _LOC attr_ >#< ": ...") - help = wfill ["The", showAttrDef _LOC attr_, "in alternative", getName con_ - ,"of nonterminal", getName nt_, "is needed in two separate visits to", getName nt_ - ,"so its type is needed to generate type signatures." - ,"Please supply its type." - ] - act = wfill ["The type signatures of semantic functions are not generated."] - 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))) ) -sem_Error_MissingUnique :: NontermIdent -> - Identifier -> - T_Error -sem_Error_MissingUnique nt_ attr_ = - (T_Error (\ _lhsIoptions - _lhsIverbose -> - (let _lhsOpp :: PP_Doc - _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 418, column 21) - _lhsOpp = - let mesg = wfill ["Missing unique counter (chained attribute)" - , getName attr_ - , "at nonterminal" - , getName nt_, "." - ] - pat = "ATTR" >#< getName nt_ >#< "[ |" >#< getName attr_ >#< " : ... | ]" - help = wfill ["A unique attribute signature in a constructor for nonterminal" , getName nt_ - , "refers to an unique counter (chained attribute) named " - , getName attr_ - ,"Maybe you misspelled it?" - ,"Otherwise either remove the signature or add an appropriate attribute definition." - ] - act = wfill ["It is not possible to proceed without this declaration."] - in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose - -- self rule - _me = - MissingUnique nt_ attr_ - -- self rule - _lhsOme = - _me - in ( _lhsOme,_lhsOpp))) ) -sem_Error_ParserError :: Pos -> - String -> - String -> - T_Error -sem_Error_ParserError pos_ problem_ action_ = - (T_Error (\ _lhsIoptions - _lhsIverbose -> - (let _lhsOpp :: PP_Doc - _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 69, column 21) - _lhsOpp = - let mesg = text ("parser expecting " ++ problem_) - pat = text "" - help = text "" - act = text action_ - 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 :: NontermIdent -> - ConstructorIdent -> - Identifier -> - Identifier -> - T_Error -sem_Error_SuperfluousRule nt_ con_ field_ attr_ = - (T_Error (\ _lhsIoptions - _lhsIverbose -> - (let _lhsOpp :: PP_Doc - _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 273, column 21) - _lhsOpp = - let mesg = wfill ["Rule for non-existing", showAttrDef field_ attr_ , "at alternative" - , getName con_ , "of nonterminal",getName nt_, "." - ] - pat = "SEM" >#< getName nt_ - >-< indent 2 ("|" >#< getName con_ >#< ppAttr field_ attr_ >#< "= ...") - help = wfill ["There is a rule for" , showAttrDef field_ attr_ , "in the definitions for alternative" , getName con_ - ,"of nonterminal" , getName nt_, ", but this attribute does not exist. Maybe you misspelled it?" - ,"Otherwise either remove the rule or add an appropriate attribute definition." - ] - act = wfill ["The rule has been ignored."] - 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 :: NontermIdent -> - ConstructorIdent -> - T_Error -sem_Error_UndefAlt nt_ con_ = - (T_Error (\ _lhsIoptions - _lhsIverbose -> - (let _lhsOpp :: PP_Doc - _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 233, column 21) - _lhsOpp = - let mesg = wfill ["Constructor", getName con_, "of nonterminal" ,getName nt_, "is not defined." - ] - pat = "DATA" >#< getName nt_ - >-< indent 2 ("|" >#< getName con_ >#< "...") - help = wfill ["There are rules for alternative", getName con_ , "of nonterminal" ,getName nt_ - ,", but there is no definition for this alternative in the definitions of the" - ,"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 _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 :: NontermIdent -> - ConstructorIdent -> - Identifier -> - Identifier -> - Bool -> - T_Error -sem_Error_UndefAttr nt_ con_ field_ attr_ isOut_ = - (T_Error (\ _lhsIoptions - _lhsIverbose -> - (let _lhsOpp :: PP_Doc - _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 316, column 21) - _lhsOpp = - 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_ - >-< indent 2 ("|" >#< getName con_ >#< "<field>.<attr> = " - >#< "..." >#< ppAttrUse field_ attr_ >#< "...") - help = wfill ["A rule in the definitions for alternative" , getName con_ ,"of nonterminal" - ,getName nt_ , "contains an attribute that is not defined" - ,"Maybe you misspelled it?" - ,"Otherwise either remove the rule or add an appropriate attribute definition." - ] - act = wfill ["The generated program will not run."] - in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose - -- self rule - _me = - UndefAttr nt_ con_ field_ attr_ isOut_ - -- self rule - _lhsOme = - _me - in ( _lhsOme,_lhsOpp))) ) -sem_Error_UndefChild :: NontermIdent -> - ConstructorIdent -> - Identifier -> - T_Error -sem_Error_UndefChild nt_ con_ name_ = - (T_Error (\ _lhsIoptions - _lhsIverbose -> - (let _lhsOpp :: PP_Doc - _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 245, column 21) - _lhsOpp = - let mesg = wfill ["Constructor", getName con_, "of nonterminal" ,getName nt_ - , "does not have a nontrivial field named", getName name_ , "." - ] - pat = "SEM" >#< nt_ - >-< indent 2 ("|" >#< getName con_ >#< ppAttr name_ (identifier "<attr>") >#< "= ...") - help = wfill ["There are rules that define or use attributes of field" , getName name_ - ,"in alternative" , getName con_ , "of nonterminal" , getName nt_ - ,", but there is no field with AG-type in the definition of the alternative." - ,"Maybe you misspelled it? Otherwise insert the field into the definition," - ,"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 _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 :: NontermIdent -> - ConstructorIdent -> - Identifier -> - T_Error -sem_Error_UndefLocal nt_ con_ var_ = - (T_Error (\ _lhsIoptions - _lhsIverbose -> - (let _lhsOpp :: PP_Doc - _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 287, column 21) - _lhsOpp = - let mesg = wfill ["Undefined local variable or field",getName var_, "at constructor" - , getName con_ , "of nonterminal",getName nt_, "." - ] - pat = "SEM" >#< getName nt_ - >-< 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. " - ,"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 _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 :: NontermIdent -> - T_Error -sem_Error_UndefNont nt_ = - (T_Error (\ _lhsIoptions - _lhsIverbose -> - (let _lhsOpp :: PP_Doc - _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 223, column 21) - _lhsOpp = - let mesg = wfill ["Nonterminal", getName nt_, "is not defined." - ] - pat = "DATA" >#< getName nt_ >#< "..." - help = wfill ["There are attributes and/or rules for nonterminal" , getName nt_ ,", but there is no definition" - , "for" ,getName nt_, ". Maybe you misspelled it? Otherwise insert a definition." - ] - act = wfill ["Everything regarding the unknown nonterminal has been ignored."] - in ppError (isError _lhsIoptions _me) (getPos nt_) mesg pat help act _lhsIverbose - -- self rule - _me = - UndefNont nt_ - -- self rule - _lhsOme = - _me - in ( _lhsOme,_lhsOpp))) ) --- Errors ------------------------------------------------------ -{- - visit 0: - inherited attribute: - options : Options - synthesized attribute: - pp : PP_Doc - alternatives: - alternative Cons: - child hd : Error - child tl : Errors - visit 0: - local verbose : _ - alternative Nil: - visit 0: - local verbose : _ --} --- cata -sem_Errors :: Errors -> - T_Errors -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 -> - Inh_Errors -> - Syn_Errors -wrap_Errors (T_Errors sem ) (Inh_Errors _lhsIoptions ) = - (let ( _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_ ) = - (T_Errors (\ _lhsIoptions -> - (let _lhsOpp :: PP_Doc - _hdOoptions :: Options - _hdOverbose :: Bool - _tlOoptions :: Options - _hdIme :: Error - _hdIpp :: PP_Doc - _tlIpp :: PP_Doc - -- "PrintErrorMessages.ag"(line 64, column 8) - _verbose = - verbose _lhsIoptions - -- use rule "PrintErrorMessages.ag"(line 60, column 49) - _lhsOpp = - _hdIpp >-< _tlIpp - -- copy rule (down) - _hdOoptions = - _lhsIoptions - -- copy rule (from local) - _hdOverbose = - _verbose - -- copy rule (down) - _tlOoptions = - _lhsIoptions - ( _hdIme,_hdIpp) = - (hd_ _hdOoptions _hdOverbose ) - ( _tlIpp) = - (tl_ _tlOoptions ) - in ( _lhsOpp))) ) -sem_Errors_Nil :: T_Errors -sem_Errors_Nil = - (T_Errors (\ _lhsIoptions -> - (let _lhsOpp :: PP_Doc - -- "PrintErrorMessages.ag"(line 64, column 8) - _verbose = - verbose _lhsIoptions - -- use rule "PrintErrorMessages.ag"(line 60, column 49) - _lhsOpp = - text "" +++-- UUAGC 0.9.12 (PrintErrorMessages.ag)+module PrintErrorMessages where++import Pretty+import UU.Scanner.Position(Pos(..), noPos)+import ErrorMessages+import DepTypes+import Options+import Data.List(mapAccumL,intersect,(\\))+import GrammarInfo+++import UU.Scanner.Position(Pos)+import Pretty+import DepTypes(Trace)+import CodeSyntax+import CommonTypes++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 _ _ _ ) = False+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+isError opts (DupUnique _ _ _ ) = False+isError opts (MissingUnique _ _ ) = 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+ +showEdge ((inh,syn),_,_) + = text ("inherited attribute " ++ toWidth 20 (getName inh) ++ " with synthesized attribute " ++ getName syn)++showEdgeLong ((inh,syn),path1,path2) + = text ("inherited attribute " ++ getName inh ++ " is needed for " ++ "synthesized attribute " ++ getName syn)+ >-< indent 4 (vlist (map text path2))+ >-< text "and back: "+ >-< indent 4 (vlist (map text path1))+ +attrText inh syn+ = if inh == syn + then "threaded attribute " ++ getName inh+ else "inherited attribute " ++ getName inh ++ " and synthesized attribute " ++getName syn ++ +ppTrace :: Trace -> PP_Doc+ppTrace (tr:rest) = wfill [showLineNr (lineNr tr) ++ ":", "SEM", getName (nt tr), "|", getName (prod tr)+ , lhsFld tr +.+ lhsAttr tr, "=", "..." +#+ showRhs tr +#+ "..."]+ >-< ppTrace rest+ppTrace [] = empty++showRhs :: TraceElem -> String+showRhs tr = if null (getName field)+ then "@" ++ getName attr+ else "@" ++ (field +.+ attr)+ where field = rhsFld tr+ attr = rhsAttr tr+ +showLineNr :: Int -> String+showLineNr i | i==(-1) = "CR"+ | otherwise = show i++showAttrDef f a | f == _LHS = "synthesized attribute " ++ getName a+ | f == _LOC = "local attribute " ++ getName a+ | f == _INST = "inst attribute " ++ getName a+ | otherwise = "inherited attribute " ++ getName a ++ " of field " ++ getName f++showAttrUse f a | f == _LHS = "inherited attribute " ++ getName a+ | f == _LOC = "local attribute " ++ getName a + | f == _INST = "inst attribute " ++ getName a+ | otherwise = "synthesized attribute " ++ getName a ++ " of field " ++ getName f++ppAttr f a = text (getName f++"."++getName a)+ppAttrUse f a = "@" >|< ppAttr f a+++infixr 5 +#++(+#+) :: String -> String -> String+(+#+) s t = s ++ " " ++ t++infixr 5 +.++(+.+) :: Identifier -> Identifier -> String+(+.+) s t = getName s ++ "." ++ getName t++wfill = fill . addSpaces. concat . map words+ where addSpaces (x:xs) = x:map addSpace xs+ addSpaces [] = []+ addSpace [x] | x `elem` ".,;:!?" = [x]+ addSpace xs = ' ':xs++ppError :: Bool -- class of the error, True:error False:warning+ -> Pos -- source position+ -> PP_Doc -- error message+ -> PP_Doc -- pattern+ -> PP_Doc -- help, more info+ -> PP_Doc -- action taken by AG+ -> Bool -- verbose? show help and action?+ -> PP_Doc+ppError isError pos mesg pat hlp act verbose+ = let position = case pos of+ Pos l c f | l >= 0 -> f >|< ":" >|< show l >|< ":" >|< show c+ | otherwise -> pp "uuagc"+ tp = if isError then "error" else "warning"+ header = position >|< ":" >#< tp >|< ":" >#< mesg+ pattern = "pattern :" >#< pat+ help = "help :" >#< hlp+ action = "action :" >#< act+ in if verbose+ then vlist [text "",header,pattern,help,action]+ else header++{-+-- old error reporting code+ = let + cl = if isError then "ERROR" else "Warning"+ position = case pos of+ (Pos l c f) | l >= 0 -> f >|< ": line " >|< show l >|< ", column " >|< show c+ | otherwise -> empty+ header = "*** UU.AG" >#< cl >#< position >#< "***"+ message = "problem :" >#< mesg+ pattern = "pattern :" >#< pat+ help = "help :" >#< hlp+ action = "action :" >#< act+ in+ if verbose+ then vlist [text "",header,message,pattern,help,action]+ else vlist [text "",header,message]+-}++showPos = show . getPos++ppInterface inter = wfill ["interface:", show inter]++-- Error -------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ options : Options+ verbose : Bool+ synthesized attributes:+ me : SELF + pp : PP_Doc+ alternatives:+ alternative ChildAsLocal:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child var : {Identifier}+ visit 0:+ local me : _+ alternative CustomError:+ child isWarning : {Bool}+ child pos : {Pos}+ child mesg : {PP_Doc}+ visit 0:+ local me : _+ alternative CyclicSet:+ child name : {Identifier}+ visit 0:+ local me : _+ alternative DirectCirc:+ child nt : {NontermIdent}+ child o_visit : {Bool}+ child cyclic : {[((Identifier,Identifier),[String],[String])]}+ visit 0:+ local me : _+ alternative DupAlt:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child occ1 : {ConstructorIdent}+ visit 0:+ local me : _+ alternative DupChild:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child name : {Identifier}+ child occ1 : {Identifier}+ visit 0:+ local me : _+ alternative DupInhAttr:+ child nt : {NontermIdent}+ child attr : {Identifier}+ child occ1 : {Identifier}+ visit 0:+ local me : _+ alternative DupRule:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child field : {Identifier}+ child attr : {Identifier}+ child occ1 : {Identifier}+ visit 0:+ local me : _+ alternative DupSet:+ child name : {NontermIdent}+ child occ1 : {NontermIdent}+ visit 0:+ local me : _+ alternative DupSig:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child attr : {Identifier}+ visit 0:+ local me : _+ alternative DupSynAttr:+ child nt : {NontermIdent}+ child attr : {Identifier}+ child occ1 : {Identifier}+ visit 0:+ local me : _+ alternative DupSynonym:+ child nt : {NontermIdent}+ child occ1 : {NontermIdent}+ visit 0:+ local me : _+ alternative DupUnique:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child attr : {Identifier}+ visit 0:+ local me : _+ alternative InducedCirc:+ child nt : {NontermIdent}+ child cinter : {CInterface}+ child cyclic : {[((Identifier,Identifier),[String],[String])]}+ visit 0:+ local me : _+ alternative InstCirc:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child attr : {Identifier}+ child o_visit : {Bool}+ child path : {[String]}+ visit 0:+ local me : _+ alternative LocalCirc:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child attr : {Identifier}+ child o_visit : {Bool}+ child path : {[String]}+ visit 0:+ local me : _+ alternative MissingInstSig:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child attr : {Identifier}+ visit 0:+ local me : _+ alternative MissingRule:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child field : {Identifier}+ child attr : {Identifier}+ visit 0:+ local me : _+ alternative MissingTypeSig:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child attr : {Identifier}+ visit 0:+ local me : _+ alternative MissingUnique:+ child nt : {NontermIdent}+ child attr : {Identifier}+ visit 0:+ local me : _+ alternative ParserError:+ child pos : {Pos}+ child problem : {String}+ child action : {String}+ visit 0:+ local me : _+ alternative SuperfluousRule:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child field : {Identifier}+ child attr : {Identifier}+ visit 0:+ local me : _+ alternative UndefAlt:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ visit 0:+ local me : _+ alternative UndefAttr:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child field : {Identifier}+ child attr : {Identifier}+ child isOut : {Bool}+ visit 0:+ local me : _+ alternative UndefChild:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child name : {Identifier}+ visit 0:+ local me : _+ alternative UndefLocal:+ child nt : {NontermIdent}+ child con : {ConstructorIdent}+ child var : {Identifier}+ visit 0:+ local me : _+ alternative UndefNont:+ 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 (DupUnique _nt _con _attr ) =+ (sem_Error_DupUnique _nt _con _attr )+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 (MissingUnique _nt _attr ) =+ (sem_Error_MissingUnique _nt _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 (Options ->+ Bool ->+ ( Error,PP_Doc))+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 ->+ Inh_Error ->+ Syn_Error +wrap_Error (T_Error sem ) (Inh_Error _lhsIoptions _lhsIverbose ) =+ (let ( _lhsOme,_lhsOpp) =+ (sem _lhsIoptions _lhsIverbose )+ in (Syn_Error _lhsOme _lhsOpp ))+sem_Error_ChildAsLocal :: NontermIdent ->+ ConstructorIdent ->+ Identifier ->+ T_Error +sem_Error_ChildAsLocal nt_ con_ var_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose ->+ (let _lhsOpp :: PP_Doc+ _lhsOme :: Error+ -- "PrintErrorMessages.ag"(line 302, column 21)+ _lhsOpp =+ let mesg = wfill ["Nontrivial field ",getName var_, "is used as local at constructor"+ , getName con_ , "of nonterminal",getName nt_, "."+ ]+ pat = "SEM" >#< getName nt_+ >-< indent 2 ("|" >#< getName con_ >#< "... = "+ >#< "..." >#< "@" >|< getName var_ >#< "..." )+ help = wfill ["A rule in the definitions for alternative" , getName con_ ,"of nonterminal"+ , getName nt_ , "contains a nontrivial field name", getName var_, "."+ ,"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 _lhsIoptions _me) (getPos var_) mesg pat help act _lhsIverbose+ -- self rule+ _me =+ ChildAsLocal nt_ con_ var_+ -- self rule+ _lhsOme =+ _me+ in ( _lhsOme,_lhsOpp))) )+sem_Error_CustomError :: Bool ->+ Pos ->+ PP_Doc ->+ T_Error +sem_Error_CustomError isWarning_ pos_ mesg_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose ->+ (let _lhsOpp :: PP_Doc+ _lhsOme :: Error+ -- "PrintErrorMessages.ag"(line 344, column 21)+ _lhsOpp =+ let pat = text "unknown"+ help = wfill ["not available."]+ act = wfill ["unknown"]+ 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 :: Identifier ->+ T_Error +sem_Error_CyclicSet name_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose ->+ (let _lhsOpp :: PP_Doc+ _lhsOme :: Error+ -- "PrintErrorMessages.ag"(line 335, column 21)+ _lhsOpp =+ let mesg = wfill ["Cyclic definition for nonterminal set", getName name_]+ pat = "SET" >#< getName name_ >#< "=" >#< "..." >#< getName name_ >#< "..."+ help = wfill ["The defintion for a nonterminal set named" , getName name_+ ,"directly or indirectly refers to itself."+ ,"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 _lhsIoptions _me) (getPos name_) mesg pat help act _lhsIverbose+ -- self rule+ _me =+ CyclicSet name_+ -- self rule+ _lhsOme =+ _me+ in ( _lhsOme,_lhsOpp))) )+sem_Error_DirectCirc :: NontermIdent ->+ Bool ->+ ([((Identifier,Identifier),[String],[String])]) ->+ T_Error +sem_Error_DirectCirc nt_ o_visit_ cyclic_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose ->+ (let _lhsOpp :: PP_Doc+ _lhsOme :: Error+ -- "PrintErrorMessages.ag"(line 373, column 21)+ _lhsOpp =+ let mesg = wfill ["In nonterminal", getName nt_, "synthesized and inherited attributes are mutually dependent" ]+ >-< vlist (map showEdge cyclic_)+ pat = text ""+ 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 _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 :: NontermIdent ->+ ConstructorIdent ->+ ConstructorIdent ->+ T_Error +sem_Error_DupAlt nt_ con_ occ1_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose ->+ (let _lhsOpp :: PP_Doc+ _lhsOme :: Error+ -- "PrintErrorMessages.ag"(line 75, column 21)+ _lhsOpp =+ let mesg = wfill ["Repeated definition for alternative", getName con_+ ,"of nonterminal", getName nt_, "."+ ] >-<+ wfill ["First definition:", (showPos occ1_),"."] >-<+ wfill ["Other definition:", (showPos con_),"."]+ pat = "DATA" >#< getName nt_+ >-< indent 2 ("|" >#< getName con_ >#< "...")+ >-< indent 2 ("|" >#< getName con_ >#< "...")+ help = wfill ["The nonterminal",getName nt_,"has more than one alternative that"+ ,"is labelled with the constructor name",getName con_,"."+ ,"You should either rename or remove enough of them to make all"+ ,"constructors of",getName nt_,"uniquely named."+ ]+ act = wfill [ "The first alternative of name",getName con_+ ,"you have given for nonterminal",getName nt_+ ,"is considered valid. All other alternatives have been discarded."+ ]+ 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 :: NontermIdent ->+ ConstructorIdent ->+ Identifier ->+ Identifier ->+ T_Error +sem_Error_DupChild nt_ con_ name_ occ1_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose ->+ (let _lhsOpp :: PP_Doc+ _lhsOme :: Error+ -- "PrintErrorMessages.ag"(line 168, column 21)+ _lhsOpp =+ let mesg = wfill ["Repeated declaration for field", getName name_, "of alternative"+ ,getName con_, "of nonterminal", getName nt_, "."+ ] >-<+ wfill ["First definition:", (showPos occ1_),"."] >-<+ wfill ["Other definition:", (showPos name_),"."]+ pat = "DATA" >#< getName nt_+ >-< indent 2 ("|" >#< getName con_ >#< (getName name_ >|< ":..." >-< getName name_ >|< ":..."))+ help = wfill ["The alternative" ,getName con_ , "of nonterminal" ,getName nt_+ ,"has more than one field that is named"+ , getName name_ ++ ". Possibly they have different types."+ ,"You should either rename or remove enough of them to make all fields of"+ ,getName con_ , "for nonterminal " , getName nt_ , "uniquely named."+ ]+ act = wfill ["The last declaration with its corresponding type is considered valid."+ ,"All others have been discarded."+ ]+ 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 :: NontermIdent ->+ Identifier ->+ Identifier ->+ T_Error +sem_Error_DupInhAttr nt_ attr_ occ1_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose ->+ (let _lhsOpp :: PP_Doc+ _lhsOme :: Error+ -- "PrintErrorMessages.ag"(line 130, column 21)+ _lhsOpp =+ let mesg = wfill ["Repeated declaration of inherited attribute", getName attr_+ , "of nonterminal", getName nt_, "."+ ] >-<+ wfill ["First definition:", (showPos occ1_),"."] >-<+ wfill ["Other definition:", (showPos attr_),"."]+ pat = "ATTR" >#< getName nt_ >#< "[" >#< getName attr_ >|< ":...,"+ >#< getName attr_ >|< ":... | | ]"+ help = wfill ["The identifier" , getName attr_ ,"has been declared"+ ,"as an inherited (or chained) attribute for nonterminal"+ ,getName nt_ , "more than once, with possibly different types."+ ,"Delete all but one or rename them to make them unique."+ ]+ 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 _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 :: NontermIdent ->+ ConstructorIdent ->+ Identifier ->+ Identifier ->+ Identifier ->+ T_Error +sem_Error_DupRule nt_ con_ field_ attr_ occ1_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose ->+ (let _lhsOpp :: PP_Doc+ _lhsOme :: Error+ -- "PrintErrorMessages.ag"(line 188, column 21)+ _lhsOpp =+ let mesg = wfill ["At constructor",getName con_, "of nonterminal", getName nt_, "there are two or more rules for"+ ,showAttrDef field_ attr_,"."+ ] >-<+ wfill ["First rule:", (showPos occ1_),"."] >-<+ wfill ["Other rule:", (showPos attr_),"."]+ pat = "SEM" >#< getName nt_+ >-< indent 2 ("|" >#< getName con_ >#< ppAttr field_ attr_ >#< "= ...")+ >-< indent 2 ("|" >#< getName con_ >#< ppAttr field_ attr_ >#< "= ...")+ help = wfill ["In the rules for alternative" , getName con_ , "of nonterminal" , getName nt_+ ,", there is more than one rule for the" , showAttrDef field_ attr_+ ,". You should either rename or remove enough of them to make all rules for alternative"+ ,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 _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 :: NontermIdent ->+ NontermIdent ->+ T_Error +sem_Error_DupSet name_ occ1_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose ->+ (let _lhsOpp :: PP_Doc+ _lhsOme :: Error+ -- "PrintErrorMessages.ag"(line 114, column 21)+ _lhsOpp =+ let mesg = wfill ["Definition of nonterminal set", getName name_, "clashes with another"+ ,"set, a type synonym or a data definition."+ ] >-<+ wfill ["First definition:", (showPos occ1_),"."] >-<+ wfill ["Set definition:" , (showPos name_),"."]+ pat = "SET" >#< getName name_ >#< "=" >#< "..."+ >-< "SET" >#< getName name_ >#< "=" >#< "..."+ help = wfill ["A nonterminal set with name", getName name_+ ,"has been given while there already is a SET, DATA, or TYPE"+ ,"definition with the same name."+ ,"You should either rename or remove the nonterminal set."+ ]+ act = wfill [ "The clashing nonterminal set will be ignored."+ ]+ 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 :: NontermIdent ->+ ConstructorIdent ->+ Identifier ->+ T_Error +sem_Error_DupSig nt_ con_ attr_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose ->+ (let _lhsOpp :: PP_Doc+ _lhsOme :: Error+ -- "PrintErrorMessages.ag"(line 206, column 21)+ _lhsOpp =+ let mesg = wfill ["At constructor",getName con_, "of nonterminal", getName nt_, "there are two or more typesignatures for"+ ,showAttrDef _LOC attr_,"."+ ] >-<+ wfill ["First signature:", (showPos attr_),"."]+ pat = "SEM" >#< getName nt_+ >-< indent 2 ("|" >#< getName con_ >#< ppAttr _LOC attr_ >#< "= ...")+ >-< indent 2 ("|" >#< getName con_ >#< ppAttr _LOC attr_ >#< "= ...")+ help = wfill ["In the rules for alternative" , getName con_ , "of nonterminal" , getName nt_+ ,", there is more than one rule for the" , showAttrDef _LOC attr_+ ,". You should remove enough of them to make all typesignatures for alternative"+ ,getName con_ , "of nonterminal " ,getName nt_ , "unique."+ ]+ act = wfill ["The last typesignature given is considered valid. All others have been discarded."]+ 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 :: NontermIdent ->+ Identifier ->+ Identifier ->+ T_Error +sem_Error_DupSynAttr nt_ attr_ occ1_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose ->+ (let _lhsOpp :: PP_Doc+ _lhsOme :: Error+ -- "PrintErrorMessages.ag"(line 149, column 21)+ _lhsOpp =+ let mesg = wfill ["Repeated declaration of synthesized attribute", getName attr_+ , "of nonterminal", getName nt_, "."+ ] >-<+ wfill ["First definition:", (showPos occ1_),"."] >-<+ wfill ["Other definition:", (showPos attr_),"."]+ pat = "ATTR" >#< getName nt_ >#< "[ | |" >#< getName attr_ >|< ":...,"+ >#< getName attr_ >|< ":... ]"+ help = wfill ["The identifier" , getName attr_ ,"has been declared"+ ,"as a synthesized (or chained) attribute for nonterminal"+ ,getName nt_ , "more than once, with possibly different types."+ ,"Delete all but one or rename them to make them unique."+ ]+ 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 _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 :: NontermIdent ->+ NontermIdent ->+ T_Error +sem_Error_DupSynonym nt_ occ1_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose ->+ (let _lhsOpp :: PP_Doc+ _lhsOme :: Error+ -- "PrintErrorMessages.ag"(line 97, column 21)+ _lhsOpp =+ let mesg = wfill ["Definition of type synonym", getName nt_, "clashes with another"+ ,"type synonym."+ ] >-<+ wfill ["First definition:", (showPos occ1_),"."] >-<+ wfill ["Type synonym :" , (showPos nt_),"."]+ pat = "DATA" >#< getName nt_+ >-< indent 2 ("|" >#< "...")+ >-< "TYPE" >#< getName nt_ >#< "=" >#< "..."+ help = wfill ["A type synonym with name", getName nt_+ ,"has been given while there already is TYPE"+ ,"definition with the same name."+ ,"You should either rename or remove the type synonym."+ ]+ act = wfill [ "The clashing type synonym will be ignored."+ ]+ 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_DupUnique :: NontermIdent ->+ ConstructorIdent ->+ Identifier ->+ T_Error +sem_Error_DupUnique nt_ con_ attr_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose ->+ (let _lhsOpp :: PP_Doc+ _lhsOme :: Error+ -- "PrintErrorMessages.ag"(line 434, column 21)+ _lhsOpp =+ let mesg = wfill ["At constructor",getName con_, "of nonterminal", getName nt_, "there are two or more unique-attribute signatures for"+ ,showAttrDef _LOC attr_,"."+ ] >-<+ wfill ["First signature:", (showPos attr_),"."]+ pat = "SEM" >#< getName nt_+ >-< indent 2 ("|" >#< getName con_ >#< ppAttr _LOC attr_ >#< " : UNIQUEREF ...")+ >-< indent 2 ("|" >#< getName con_ >#< ppAttr _LOC attr_ >#< " : UNIQUEREF ...")+ help = wfill ["In the rules for alternative" , getName con_ , "of nonterminal" , getName nt_+ ,", there is more than one unique-attribute signature for the" , showAttrDef _LOC attr_+ ,". You should remove enough of them to make all unique-signatures for alternative"+ ,getName con_ , "of nonterminal " ,getName nt_ , "unique."+ ]+ act = wfill ["Unpredicatable sharing of unique numbers may occur."]+ in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose+ -- self rule+ _me =+ DupUnique nt_ con_ attr_+ -- self rule+ _lhsOme =+ _me+ in ( _lhsOme,_lhsOpp))) )+sem_Error_InducedCirc :: NontermIdent ->+ CInterface ->+ ([((Identifier,Identifier),[String],[String])]) ->+ T_Error +sem_Error_InducedCirc nt_ cinter_ cyclic_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose ->+ (let _lhsOpp :: PP_Doc+ _lhsOme :: Error+ -- "PrintErrorMessages.ag"(line 381, 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_)+ pat = text ""+ showInter (CInterface segs) = concat (snd (mapAccumL (\i c -> (i+1,("visit " ++ show i) : map ind (showsSegment c))) 0 segs))+ 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 _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 :: NontermIdent ->+ ConstructorIdent ->+ Identifier ->+ Bool ->+ ([String]) ->+ T_Error +sem_Error_InstCirc nt_ con_ attr_ o_visit_ path_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose ->+ (let _lhsOpp :: PP_Doc+ _lhsOme :: Error+ -- "PrintErrorMessages.ag"(line 361, column 21)+ _lhsOpp =+ let mesg = wfill ["Circular dependency for inst attribute", getName attr_+ , "of alternative", getName con_, "of nonterminal", getName nt_]+ pat = "SEM" >#< getName nt_+ >-< indent 2 ("|" >#< getName con_ >#< "inst." >|< getName attr_ >#< "="+ >#< "..." >#< "@s.<some attribte>" >#< "...")+ help = if null path_+ then text "the definition is directly circular"+ 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 _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 :: NontermIdent ->+ ConstructorIdent ->+ Identifier ->+ Bool ->+ ([String]) ->+ T_Error +sem_Error_LocalCirc nt_ con_ attr_ o_visit_ path_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose ->+ (let _lhsOpp :: PP_Doc+ _lhsOme :: Error+ -- "PrintErrorMessages.ag"(line 349, column 21)+ _lhsOpp =+ let mesg = wfill ["Circular dependency for local attribute", getName attr_+ , "of alternative", getName con_, "of nonterminal", getName nt_]+ pat = "SEM" >#< getName nt_+ >-< indent 2 ("|" >#< getName con_ >#< "loc." >|< getName attr_ >#< "="+ >#< "..." >#< "@loc." >|< getName attr_ >#< "...")+ help = if null path_+ then text "the definition is directly circular"+ 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 _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 :: NontermIdent ->+ ConstructorIdent ->+ Identifier ->+ T_Error +sem_Error_MissingInstSig nt_ con_ attr_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose ->+ (let _lhsOpp :: PP_Doc+ _lhsOme :: Error+ -- "PrintErrorMessages.ag"(line 404, column 21)+ _lhsOpp =+ let mesg = wfill ["Type signature needed, but not found for", showAttrDef _INST attr_ , "in alternative"+ , getName con_ , "of nonterminal",getName nt_ ,"."+ ]>-<+ wfill ["Location:", (showPos attr_),"."]+ pat = "SEM" >#< nt_+ >-< indent 2 ("|" >#< getName con_ >#< ppAttr _INST attr_ >#< ": ...")+ help = wfill ["The", showAttrDef _INST attr_, "in alternative", getName con_+ ,"of nonterminal", getName nt_, "is a non-terminal attribute, so "+ ,"its type is needed to attribute its value."+ ,"Please supply its type."+ ]+ act = wfill ["It is not possible to proceed without this signature."]+ 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 :: NontermIdent ->+ ConstructorIdent ->+ Identifier ->+ Identifier ->+ T_Error +sem_Error_MissingRule nt_ con_ field_ attr_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose ->+ (let _lhsOpp :: PP_Doc+ _lhsOme :: Error+ -- "PrintErrorMessages.ag"(line 260, column 21)+ _lhsOpp =+ let mesg = wfill ["Missing rule for", showAttrDef field_ attr_ , "in alternative"+ , getName con_ , "of nonterminal",getName nt_ ,"."+ ]+ pat = "SEM" >#< nt_+ >-< indent 2 ("|" >#< getName con_ >#< ppAttr field_ attr_ >#< "= ...")+ help = wfill ["The", showAttrDef field_ attr_, "in alternative", getName con_+ , "of nonterminal", getName nt_, "is missing and cannot be inferred"+ ,"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 _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 :: NontermIdent ->+ ConstructorIdent ->+ Identifier ->+ T_Error +sem_Error_MissingTypeSig nt_ con_ attr_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose ->+ (let _lhsOpp :: PP_Doc+ _lhsOme :: Error+ -- "PrintErrorMessages.ag"(line 390, column 21)+ _lhsOpp =+ let mesg = wfill ["Type signature needed, but not found for", showAttrDef _LOC attr_ , "in alternative"+ , getName con_ , "of nonterminal",getName nt_ ,"."+ ]>-<+ wfill ["Location:", (showPos attr_),"."]+ pat = "SEM" >#< nt_+ >-< indent 2 ("|" >#< getName con_ >#< ppAttr _LOC attr_ >#< ": ...")+ help = wfill ["The", showAttrDef _LOC attr_, "in alternative", getName con_+ ,"of nonterminal", getName nt_, "is needed in two separate visits to", getName nt_+ ,"so its type is needed to generate type signatures."+ ,"Please supply its type."+ ]+ act = wfill ["The type signatures of semantic functions are not generated."]+ 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))) )+sem_Error_MissingUnique :: NontermIdent ->+ Identifier ->+ T_Error +sem_Error_MissingUnique nt_ attr_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose ->+ (let _lhsOpp :: PP_Doc+ _lhsOme :: Error+ -- "PrintErrorMessages.ag"(line 418, column 21)+ _lhsOpp =+ let mesg = wfill ["Missing unique counter (chained attribute)"+ , getName attr_+ , "at nonterminal"+ , getName nt_, "."+ ]+ pat = "ATTR" >#< getName nt_ >#< "[ |" >#< getName attr_ >#< " : ... | ]"+ help = wfill ["A unique attribute signature in a constructor for nonterminal" , getName nt_+ , "refers to an unique counter (chained attribute) named "+ , getName attr_+ ,"Maybe you misspelled it?"+ ,"Otherwise either remove the signature or add an appropriate attribute definition."+ ]+ act = wfill ["It is not possible to proceed without this declaration."]+ in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose+ -- self rule+ _me =+ MissingUnique nt_ attr_+ -- self rule+ _lhsOme =+ _me+ in ( _lhsOme,_lhsOpp))) )+sem_Error_ParserError :: Pos ->+ String ->+ String ->+ T_Error +sem_Error_ParserError pos_ problem_ action_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose ->+ (let _lhsOpp :: PP_Doc+ _lhsOme :: Error+ -- "PrintErrorMessages.ag"(line 69, column 21)+ _lhsOpp =+ let mesg = text ("parser expecting " ++ problem_)+ pat = text ""+ help = text ""+ act = text action_+ 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 :: NontermIdent ->+ ConstructorIdent ->+ Identifier ->+ Identifier ->+ T_Error +sem_Error_SuperfluousRule nt_ con_ field_ attr_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose ->+ (let _lhsOpp :: PP_Doc+ _lhsOme :: Error+ -- "PrintErrorMessages.ag"(line 273, column 21)+ _lhsOpp =+ let mesg = wfill ["Rule for non-existing", showAttrDef field_ attr_ , "at alternative"+ , getName con_ , "of nonterminal",getName nt_, "."+ ]+ pat = "SEM" >#< getName nt_+ >-< indent 2 ("|" >#< getName con_ >#< ppAttr field_ attr_ >#< "= ...")+ help = wfill ["There is a rule for" , showAttrDef field_ attr_ , "in the definitions for alternative" , getName con_+ ,"of nonterminal" , getName nt_, ", but this attribute does not exist. Maybe you misspelled it?"+ ,"Otherwise either remove the rule or add an appropriate attribute definition."+ ]+ act = wfill ["The rule has been ignored."]+ 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 :: NontermIdent ->+ ConstructorIdent ->+ T_Error +sem_Error_UndefAlt nt_ con_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose ->+ (let _lhsOpp :: PP_Doc+ _lhsOme :: Error+ -- "PrintErrorMessages.ag"(line 233, column 21)+ _lhsOpp =+ let mesg = wfill ["Constructor", getName con_, "of nonterminal" ,getName nt_, "is not defined."+ ]+ pat = "DATA" >#< getName nt_+ >-< indent 2 ("|" >#< getName con_ >#< "...")+ help = wfill ["There are rules for alternative", getName con_ , "of nonterminal" ,getName nt_+ ,", but there is no definition for this alternative in the definitions of the"+ ,"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 _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 :: NontermIdent ->+ ConstructorIdent ->+ Identifier ->+ Identifier ->+ Bool ->+ T_Error +sem_Error_UndefAttr nt_ con_ field_ attr_ isOut_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose ->+ (let _lhsOpp :: PP_Doc+ _lhsOme :: Error+ -- "PrintErrorMessages.ag"(line 316, column 21)+ _lhsOpp =+ 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_+ >-< indent 2 ("|" >#< getName con_ >#< "<field>.<attr> = "+ >#< "..." >#< ppAttrUse field_ attr_ >#< "...")+ help = wfill ["A rule in the definitions for alternative" , getName con_ ,"of nonterminal"+ ,getName nt_ , "contains an attribute that is not defined"+ ,"Maybe you misspelled it?"+ ,"Otherwise either remove the rule or add an appropriate attribute definition."+ ]+ act = wfill ["The generated program will not run."]+ in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose+ -- self rule+ _me =+ UndefAttr nt_ con_ field_ attr_ isOut_+ -- self rule+ _lhsOme =+ _me+ in ( _lhsOme,_lhsOpp))) )+sem_Error_UndefChild :: NontermIdent ->+ ConstructorIdent ->+ Identifier ->+ T_Error +sem_Error_UndefChild nt_ con_ name_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose ->+ (let _lhsOpp :: PP_Doc+ _lhsOme :: Error+ -- "PrintErrorMessages.ag"(line 245, column 21)+ _lhsOpp =+ let mesg = wfill ["Constructor", getName con_, "of nonterminal" ,getName nt_+ , "does not have a nontrivial field named", getName name_ , "."+ ]+ pat = "SEM" >#< nt_+ >-< indent 2 ("|" >#< getName con_ >#< ppAttr name_ (identifier "<attr>") >#< "= ...")+ help = wfill ["There are rules that define or use attributes of field" , getName name_+ ,"in alternative" , getName con_ , "of nonterminal" , getName nt_+ ,", but there is no field with AG-type in the definition of the alternative."+ ,"Maybe you misspelled it? Otherwise insert the field into the definition,"+ ,"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 _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 :: NontermIdent ->+ ConstructorIdent ->+ Identifier ->+ T_Error +sem_Error_UndefLocal nt_ con_ var_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose ->+ (let _lhsOpp :: PP_Doc+ _lhsOme :: Error+ -- "PrintErrorMessages.ag"(line 287, column 21)+ _lhsOpp =+ let mesg = wfill ["Undefined local variable or field",getName var_, "at constructor"+ , getName con_ , "of nonterminal",getName nt_, "."+ ]+ pat = "SEM" >#< getName nt_+ >-< 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. "+ ,"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 _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 :: NontermIdent ->+ T_Error +sem_Error_UndefNont nt_ =+ (T_Error (\ _lhsIoptions+ _lhsIverbose ->+ (let _lhsOpp :: PP_Doc+ _lhsOme :: Error+ -- "PrintErrorMessages.ag"(line 223, column 21)+ _lhsOpp =+ let mesg = wfill ["Nonterminal", getName nt_, "is not defined."+ ]+ pat = "DATA" >#< getName nt_ >#< "..."+ help = wfill ["There are attributes and/or rules for nonterminal" , getName nt_ ,", but there is no definition"+ , "for" ,getName nt_, ". Maybe you misspelled it? Otherwise insert a definition."+ ]+ act = wfill ["Everything regarding the unknown nonterminal has been ignored."]+ in ppError (isError _lhsIoptions _me) (getPos nt_) mesg pat help act _lhsIverbose+ -- self rule+ _me =+ UndefNont nt_+ -- self rule+ _lhsOme =+ _me+ in ( _lhsOme,_lhsOpp))) )+-- Errors ------------------------------------------------------+{-+ visit 0:+ inherited attribute:+ options : Options+ synthesized attribute:+ pp : PP_Doc+ alternatives:+ alternative Cons:+ child hd : Error + child tl : Errors + visit 0:+ local verbose : _+ alternative Nil:+ visit 0:+ local verbose : _+-}+-- cata+sem_Errors :: Errors ->+ T_Errors +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 ->+ Inh_Errors ->+ Syn_Errors +wrap_Errors (T_Errors sem ) (Inh_Errors _lhsIoptions ) =+ (let ( _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_ ) =+ (T_Errors (\ _lhsIoptions ->+ (let _lhsOpp :: PP_Doc+ _hdOoptions :: Options+ _hdOverbose :: Bool+ _tlOoptions :: Options+ _hdIme :: Error+ _hdIpp :: PP_Doc+ _tlIpp :: PP_Doc+ -- "PrintErrorMessages.ag"(line 64, column 8)+ _verbose =+ verbose _lhsIoptions+ -- use rule "PrintErrorMessages.ag"(line 60, column 49)+ _lhsOpp =+ _hdIpp >-< _tlIpp+ -- copy rule (down)+ _hdOoptions =+ _lhsIoptions+ -- copy rule (from local)+ _hdOverbose =+ _verbose+ -- copy rule (down)+ _tlOoptions =+ _lhsIoptions+ ( _hdIme,_hdIpp) =+ (hd_ _hdOoptions _hdOverbose )+ ( _tlIpp) =+ (tl_ _tlOoptions )+ in ( _lhsOpp))) )+sem_Errors_Nil :: T_Errors +sem_Errors_Nil =+ (T_Errors (\ _lhsIoptions ->+ (let _lhsOpp :: PP_Doc+ -- "PrintErrorMessages.ag"(line 64, column 8)+ _verbose =+ verbose _lhsIoptions+ -- use rule "PrintErrorMessages.ag"(line 60, column 49)+ _lhsOpp =+ text "" in ( _lhsOpp))) )
src-derived/SemHsTokens.hs view
@@ -1,586 +1,586 @@- - --- UUAGC 0.9.11 (SemHsTokens.ag) -module SemHsTokens where - -import qualified Data.Sequence as Seq -import Data.Sequence(Seq,empty,singleton,(><)) -import Data.Foldable(toList) -import Pretty - -import TokenDef -import HsToken -import ErrorMessages - - -import CommonTypes -import UU.Scanner.Position(Pos) - -isNTname allnts (Just (NT nt _)) = nt `elem` allnts -isNTname allnts _ = False --- HsToken ----------------------------------------------------- -{- - visit 0: - inherited attributes: - allfields : [(Identifier,Type,Bool)] - allnts : [Identifier] - attrs : [(Identifier,Identifier)] - con : Identifier - fieldnames : [Identifier] - nt : Identifier - synthesized attributes: - errors : Seq Error - tok : (Pos,String) - usedAttrs : [(Identifier,Identifier)] - usedFields : Seq Identifier - usedLocals : [Identifier] - alternatives: - alternative AGField: - child field : {Identifier} - child attr : {Identifier} - child pos : {Pos} - child rdesc : {Maybe String} - visit 0: - local addTrace : _ - alternative AGLocal: - child var : {Identifier} - child pos : {Pos} - child rdesc : {Maybe String} - visit 0: - local _tup1 : _ - local errors : _ - local tok : _ - local usedLocals : _ - alternative CharToken: - child value : {String} - child pos : {Pos} - alternative Err: - child mesg : {String} - child pos : {Pos} - alternative HsToken: - child value : {String} - child pos : {Pos} - alternative StrToken: - child value : {String} - child pos : {Pos} --} --- cata -sem_HsToken :: HsToken -> - T_HsToken -sem_HsToken (AGField _field _attr _pos _rdesc ) = - (sem_HsToken_AGField _field _attr _pos _rdesc ) -sem_HsToken (AGLocal _var _pos _rdesc ) = - (sem_HsToken_AGLocal _var _pos _rdesc ) -sem_HsToken (CharToken _value _pos ) = - (sem_HsToken_CharToken _value _pos ) -sem_HsToken (Err _mesg _pos ) = - (sem_HsToken_Err _mesg _pos ) -sem_HsToken (HsToken _value _pos ) = - (sem_HsToken_HsToken _value _pos ) -sem_HsToken (StrToken _value _pos ) = - (sem_HsToken_StrToken _value _pos ) --- semantic domain -newtype T_HsToken = T_HsToken (([(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 :: [(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 -> - Inh_HsToken -> - Syn_HsToken -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 :: Identifier -> - Identifier -> - Pos -> - (Maybe String) -> - T_HsToken -sem_HsToken_AGField field_ attr_ pos_ rdesc_ = - (T_HsToken (\ _lhsIallfields - _lhsIallnts - _lhsIattrs - _lhsIcon - _lhsIfieldnames - _lhsInt -> - (let _lhsOerrors :: (Seq Error) - _lhsOusedAttrs :: ([(Identifier,Identifier)]) - _lhsOtok :: ((Pos,String)) - _lhsOusedFields :: (Seq Identifier) - _lhsOusedLocals :: ([Identifier]) - -- "SemHsTokens.ag"(line 74, column 15) - _lhsOerrors = - if (field_,attr_) `elem` _lhsIattrs - then Seq.empty - else if not(field_ `elem` (_LHS : _LOC: _lhsIfieldnames)) - then Seq.singleton (UndefChild _lhsInt _lhsIcon field_) - else Seq.singleton (UndefAttr _lhsInt _lhsIcon field_ attr_ False) - -- "SemHsTokens.ag"(line 88, column 13) - _lhsOusedAttrs = - [(field_,attr_)] - -- "SemHsTokens.ag"(line 115, column 8) - _addTrace = - case rdesc_ of - Just d -> \x -> "(trace " ++ show (d ++ " -> " ++ show field_ ++ "." ++ show attr_) ++ " (" ++ x ++ "))" - Nothing -> id - -- "SemHsTokens.ag"(line 118, column 8) - _lhsOtok = - (pos_, _addTrace $ attrname True field_ attr_) - -- use rule "SemHsTokens.ag"(line 93, column 40) - _lhsOusedFields = - Seq.empty - -- use rule "SemHsTokens.ag"(line 84, column 40) - _lhsOusedLocals = - [] - in ( _lhsOerrors,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) ) -sem_HsToken_AGLocal :: Identifier -> - Pos -> - (Maybe String) -> - T_HsToken -sem_HsToken_AGLocal var_ pos_ rdesc_ = - (T_HsToken (\ _lhsIallfields - _lhsIallnts - _lhsIattrs - _lhsIcon - _lhsIfieldnames - _lhsInt -> - (let _lhsOusedFields :: (Seq Identifier) - _lhsOerrors :: (Seq Error) - _lhsOusedAttrs :: ([(Identifier,Identifier)]) - _lhsOusedLocals :: ([Identifier]) - _lhsOtok :: ((Pos,String)) - -- "SemHsTokens.ag"(line 64, column 19) - __tup1 = - if var_ `elem` _lhsIfieldnames - then if isNTname _lhsIallnts (lookup var_ (map (\(n,t,_) -> (n,t)) _lhsIallfields)) - then (Seq.singleton(ChildAsLocal _lhsInt _lhsIcon var_), (pos_,fieldname var_), [] ) - else (Seq.empty, (pos_,fieldname var_), [] ) - else if (_LOC,var_) `elem` _lhsIattrs - then (Seq.empty , (pos_,locname var_), [var_]) - else (Seq.singleton(UndefLocal _lhsInt _lhsIcon var_), (pos_,locname var_), [] ) - -- "SemHsTokens.ag"(line 64, column 19) - (_errors,_,_) = - __tup1 - -- "SemHsTokens.ag"(line 64, column 19) - (_,_tok,_) = - __tup1 - -- "SemHsTokens.ag"(line 64, column 19) - (_,_,_usedLocals) = - __tup1 - -- "SemHsTokens.ag"(line 96, column 13) - _lhsOusedFields = - if var_ `elem` _lhsIfieldnames - then Seq.singleton var_ - else Seq.empty - -- use rule "SemHsTokens.ag"(line 43, column 37) - _lhsOerrors = - _errors - -- use rule "SemHsTokens.ag"(line 85, column 40) - _lhsOusedAttrs = - [] - -- use rule "SemHsTokens.ag"(line 84, column 40) - _lhsOusedLocals = - _usedLocals - -- copy rule (from local) - _lhsOtok = - _tok - in ( _lhsOerrors,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) ) -sem_HsToken_CharToken :: String -> - Pos -> - T_HsToken -sem_HsToken_CharToken value_ pos_ = - (T_HsToken (\ _lhsIallfields - _lhsIallnts - _lhsIattrs - _lhsIcon - _lhsIfieldnames - _lhsInt -> - (let _lhsOtok :: ((Pos,String)) - _lhsOerrors :: (Seq Error) - _lhsOusedAttrs :: ([(Identifier,Identifier)]) - _lhsOusedFields :: (Seq Identifier) - _lhsOusedLocals :: ([Identifier]) - -- "SemHsTokens.ag"(line 122, column 16) - _lhsOtok = - (pos_, if null value_ - then "" - else showCharShort (head value_) - ) - -- use rule "SemHsTokens.ag"(line 43, column 37) - _lhsOerrors = - Seq.empty - -- use rule "SemHsTokens.ag"(line 85, column 40) - _lhsOusedAttrs = - [] - -- use rule "SemHsTokens.ag"(line 93, column 40) - _lhsOusedFields = - Seq.empty - -- use rule "SemHsTokens.ag"(line 84, column 40) - _lhsOusedLocals = - [] - in ( _lhsOerrors,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) ) -sem_HsToken_Err :: String -> - Pos -> - T_HsToken -sem_HsToken_Err mesg_ pos_ = - (T_HsToken (\ _lhsIallfields - _lhsIallnts - _lhsIattrs - _lhsIcon - _lhsIfieldnames - _lhsInt -> - (let _lhsOerrors :: (Seq Error) - _lhsOtok :: ((Pos,String)) - _lhsOusedAttrs :: ([(Identifier,Identifier)]) - _lhsOusedFields :: (Seq Identifier) - _lhsOusedLocals :: ([Identifier]) - -- "SemHsTokens.ag"(line 50, column 9) - _lhsOerrors = - let m = text mesg_ - in Seq.singleton (CustomError False pos_ m) - -- "SemHsTokens.ag"(line 128, column 16) - _lhsOtok = - (pos_, "") - -- use rule "SemHsTokens.ag"(line 85, column 40) - _lhsOusedAttrs = - [] - -- use rule "SemHsTokens.ag"(line 93, column 40) - _lhsOusedFields = - Seq.empty - -- use rule "SemHsTokens.ag"(line 84, column 40) - _lhsOusedLocals = - [] - in ( _lhsOerrors,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) ) -sem_HsToken_HsToken :: String -> - Pos -> - T_HsToken -sem_HsToken_HsToken value_ pos_ = - (T_HsToken (\ _lhsIallfields - _lhsIallnts - _lhsIattrs - _lhsIcon - _lhsIfieldnames - _lhsInt -> - (let _lhsOtok :: ((Pos,String)) - _lhsOerrors :: (Seq Error) - _lhsOusedAttrs :: ([(Identifier,Identifier)]) - _lhsOusedFields :: (Seq Identifier) - _lhsOusedLocals :: ([Identifier]) - -- "SemHsTokens.ag"(line 120, column 14) - _lhsOtok = - (pos_, value_) - -- use rule "SemHsTokens.ag"(line 43, column 37) - _lhsOerrors = - Seq.empty - -- use rule "SemHsTokens.ag"(line 85, column 40) - _lhsOusedAttrs = - [] - -- use rule "SemHsTokens.ag"(line 93, column 40) - _lhsOusedFields = - Seq.empty - -- use rule "SemHsTokens.ag"(line 84, column 40) - _lhsOusedLocals = - [] - in ( _lhsOerrors,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) ) -sem_HsToken_StrToken :: String -> - Pos -> - T_HsToken -sem_HsToken_StrToken value_ pos_ = - (T_HsToken (\ _lhsIallfields - _lhsIallnts - _lhsIattrs - _lhsIcon - _lhsIfieldnames - _lhsInt -> - (let _lhsOtok :: ((Pos,String)) - _lhsOerrors :: (Seq Error) - _lhsOusedAttrs :: ([(Identifier,Identifier)]) - _lhsOusedFields :: (Seq Identifier) - _lhsOusedLocals :: ([Identifier]) - -- "SemHsTokens.ag"(line 127, column 16) - _lhsOtok = - (pos_, showStrShort value_) - -- use rule "SemHsTokens.ag"(line 43, column 37) - _lhsOerrors = - Seq.empty - -- use rule "SemHsTokens.ag"(line 85, column 40) - _lhsOusedAttrs = - [] - -- use rule "SemHsTokens.ag"(line 93, column 40) - _lhsOusedFields = - Seq.empty - -- use rule "SemHsTokens.ag"(line 84, column 40) - _lhsOusedLocals = - [] - in ( _lhsOerrors,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) ) --- HsTokens ---------------------------------------------------- -{- - visit 0: - inherited attributes: - allfields : [(Identifier,Type,Bool)] - allnts : [Identifier] - attrs : [(Identifier,Identifier)] - con : Identifier - fieldnames : [Identifier] - nt : Identifier - synthesized attributes: - errors : Seq Error - tks : [(Pos,String)] - usedAttrs : [(Identifier,Identifier)] - usedFields : Seq Identifier - usedLocals : [Identifier] - 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 (([(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 :: [(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 -> - Inh_HsTokens -> - Syn_HsTokens -wrap_HsTokens (T_HsTokens sem ) (Inh_HsTokens _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt ) = - (let ( _lhsOerrors,_lhsOtks,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals) = - (sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt ) - in (Syn_HsTokens _lhsOerrors _lhsOtks _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals )) -sem_HsTokens_Cons :: T_HsToken -> - T_HsTokens -> - T_HsTokens -sem_HsTokens_Cons (T_HsToken hd_ ) (T_HsTokens tl_ ) = - (T_HsTokens (\ _lhsIallfields - _lhsIallnts - _lhsIattrs - _lhsIcon - _lhsIfieldnames - _lhsInt -> - (let _lhsOtks :: ([(Pos,String)]) - _lhsOerrors :: (Seq Error) - _lhsOusedAttrs :: ([(Identifier,Identifier)]) - _lhsOusedFields :: (Seq Identifier) - _lhsOusedLocals :: ([Identifier]) - _hdOallfields :: ([(Identifier,Type,Bool)]) - _hdOallnts :: ([Identifier]) - _hdOattrs :: ([(Identifier,Identifier)]) - _hdOcon :: Identifier - _hdOfieldnames :: ([Identifier]) - _hdOnt :: Identifier - _tlOallfields :: ([(Identifier,Type,Bool)]) - _tlOallnts :: ([Identifier]) - _tlOattrs :: ([(Identifier,Identifier)]) - _tlOcon :: Identifier - _tlOfieldnames :: ([Identifier]) - _tlOnt :: Identifier - _hdIerrors :: (Seq Error) - _hdItok :: ((Pos,String)) - _hdIusedAttrs :: ([(Identifier,Identifier)]) - _hdIusedFields :: (Seq Identifier) - _hdIusedLocals :: ([Identifier]) - _tlIerrors :: (Seq Error) - _tlItks :: ([(Pos,String)]) - _tlIusedAttrs :: ([(Identifier,Identifier)]) - _tlIusedFields :: (Seq Identifier) - _tlIusedLocals :: ([Identifier]) - -- "SemHsTokens.ag"(line 110, column 10) - _lhsOtks = - _hdItok : _tlItks - -- use rule "SemHsTokens.ag"(line 43, column 37) - _lhsOerrors = - _hdIerrors Seq.>< _tlIerrors - -- use rule "SemHsTokens.ag"(line 85, column 40) - _lhsOusedAttrs = - _hdIusedAttrs ++ _tlIusedAttrs - -- use rule "SemHsTokens.ag"(line 93, column 40) - _lhsOusedFields = - _hdIusedFields Seq.>< _tlIusedFields - -- use rule "SemHsTokens.ag"(line 84, column 40) - _lhsOusedLocals = - _hdIusedLocals ++ _tlIusedLocals - -- copy rule (down) - _hdOallfields = - _lhsIallfields - -- copy rule (down) - _hdOallnts = - _lhsIallnts - -- copy rule (down) - _hdOattrs = - _lhsIattrs - -- copy rule (down) - _hdOcon = - _lhsIcon - -- copy rule (down) - _hdOfieldnames = - _lhsIfieldnames - -- copy rule (down) - _hdOnt = - _lhsInt - -- copy rule (down) - _tlOallfields = - _lhsIallfields - -- copy rule (down) - _tlOallnts = - _lhsIallnts - -- copy rule (down) - _tlOattrs = - _lhsIattrs - -- copy rule (down) - _tlOcon = - _lhsIcon - -- copy rule (down) - _tlOfieldnames = - _lhsIfieldnames - -- copy rule (down) - _tlOnt = - _lhsInt - ( _hdIerrors,_hdItok,_hdIusedAttrs,_hdIusedFields,_hdIusedLocals) = - (hd_ _hdOallfields _hdOallnts _hdOattrs _hdOcon _hdOfieldnames _hdOnt ) - ( _tlIerrors,_tlItks,_tlIusedAttrs,_tlIusedFields,_tlIusedLocals) = - (tl_ _tlOallfields _tlOallnts _tlOattrs _tlOcon _tlOfieldnames _tlOnt ) - in ( _lhsOerrors,_lhsOtks,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) ) -sem_HsTokens_Nil :: T_HsTokens -sem_HsTokens_Nil = - (T_HsTokens (\ _lhsIallfields - _lhsIallnts - _lhsIattrs - _lhsIcon - _lhsIfieldnames - _lhsInt -> - (let _lhsOtks :: ([(Pos,String)]) - _lhsOerrors :: (Seq Error) - _lhsOusedAttrs :: ([(Identifier,Identifier)]) - _lhsOusedFields :: (Seq Identifier) - _lhsOusedLocals :: ([Identifier]) - -- "SemHsTokens.ag"(line 111, column 10) - _lhsOtks = - [] - -- use rule "SemHsTokens.ag"(line 43, column 37) - _lhsOerrors = - Seq.empty - -- use rule "SemHsTokens.ag"(line 85, column 40) - _lhsOusedAttrs = - [] - -- use rule "SemHsTokens.ag"(line 93, column 40) - _lhsOusedFields = - Seq.empty - -- use rule "SemHsTokens.ag"(line 84, column 40) - _lhsOusedLocals = - [] - in ( _lhsOerrors,_lhsOtks,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) ) --- HsTokensRoot ------------------------------------------------ -{- - visit 0: - inherited attributes: - allfields : [(Identifier,Type,Bool)] - allnts : [Identifier] - attrs : [(Identifier,Identifier)] - con : Identifier - nt : Identifier - synthesized attributes: - errors : Seq Error - textLines : [String] - usedAttrs : [(Identifier,Identifier)] - usedFields : [Identifier] - usedLocals : [Identifier] - 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,Type,Bool)]) -> - ([Identifier]) -> - ([(Identifier,Identifier)]) -> - Identifier -> - Identifier -> - ( (Seq Error),([String]),([(Identifier,Identifier)]),([Identifier]),([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 -> - Inh_HsTokensRoot -> - Syn_HsTokensRoot -wrap_HsTokensRoot (T_HsTokensRoot sem ) (Inh_HsTokensRoot _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsInt ) = - (let ( _lhsOerrors,_lhsOtextLines,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals) = - (sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsInt ) - in (Syn_HsTokensRoot _lhsOerrors _lhsOtextLines _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals )) -sem_HsTokensRoot_HsTokensRoot :: T_HsTokens -> - T_HsTokensRoot -sem_HsTokensRoot_HsTokensRoot (T_HsTokens tokens_ ) = - (T_HsTokensRoot (\ _lhsIallfields - _lhsIallnts - _lhsIattrs - _lhsIcon - _lhsInt -> - (let _tokensOfieldnames :: ([Identifier]) - _lhsOusedFields :: ([Identifier]) - _lhsOtextLines :: ([String]) - _lhsOerrors :: (Seq Error) - _lhsOusedAttrs :: ([(Identifier,Identifier)]) - _lhsOusedLocals :: ([Identifier]) - _tokensOallfields :: ([(Identifier,Type,Bool)]) - _tokensOallnts :: ([Identifier]) - _tokensOattrs :: ([(Identifier,Identifier)]) - _tokensOcon :: Identifier - _tokensOnt :: Identifier - _tokensIerrors :: (Seq Error) - _tokensItks :: ([(Pos,String)]) - _tokensIusedAttrs :: ([(Identifier,Identifier)]) - _tokensIusedFields :: (Seq Identifier) - _tokensIusedLocals :: ([Identifier]) - -- "SemHsTokens.ag"(line 38, column 18) - _tokensOfieldnames = - map (\(n,_,_) -> n) _lhsIallfields - -- "SemHsTokens.ag"(line 100, column 18) - _lhsOusedFields = - toList _tokensIusedFields - -- "SemHsTokens.ag"(line 107, column 18) - _lhsOtextLines = - showTokens _tokensItks - -- use rule "SemHsTokens.ag"(line 18, column 18) - _lhsOerrors = - _tokensIerrors - -- copy rule (up) - _lhsOusedAttrs = - _tokensIusedAttrs - -- copy rule (up) - _lhsOusedLocals = - _tokensIusedLocals - -- copy rule (down) - _tokensOallfields = - _lhsIallfields - -- copy rule (down) - _tokensOallnts = - _lhsIallnts - -- copy rule (down) - _tokensOattrs = - _lhsIattrs - -- copy rule (down) - _tokensOcon = - _lhsIcon - -- copy rule (down) - _tokensOnt = - _lhsInt - ( _tokensIerrors,_tokensItks,_tokensIusedAttrs,_tokensIusedFields,_tokensIusedLocals) = - (tokens_ _tokensOallfields _tokensOallnts _tokensOattrs _tokensOcon _tokensOfieldnames _tokensOnt ) +++-- UUAGC 0.9.12 (SemHsTokens.ag)+module SemHsTokens where++import qualified Data.Sequence as Seq+import Data.Sequence(Seq,empty,singleton,(><))+import Data.Foldable(toList)+import Pretty++import TokenDef+import HsToken+import ErrorMessages+++import CommonTypes+import UU.Scanner.Position(Pos)++isNTname allnts (Just (NT nt _)) = nt `elem` allnts+isNTname allnts _ = False+-- HsToken -----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allfields : [(Identifier,Type,Bool)]+ allnts : [Identifier]+ attrs : [(Identifier,Identifier)]+ con : Identifier+ fieldnames : [Identifier]+ nt : Identifier+ synthesized attributes:+ errors : Seq Error+ tok : (Pos,String)+ usedAttrs : [(Identifier,Identifier)]+ usedFields : Seq Identifier+ usedLocals : [Identifier]+ alternatives:+ alternative AGField:+ child field : {Identifier}+ child attr : {Identifier}+ child pos : {Pos}+ child rdesc : {Maybe String}+ visit 0:+ local addTrace : _+ alternative AGLocal:+ child var : {Identifier}+ child pos : {Pos}+ child rdesc : {Maybe String}+ visit 0:+ local _tup1 : _+ local errors : _+ local tok : _+ local usedLocals : _+ alternative CharToken:+ child value : {String}+ child pos : {Pos}+ alternative Err:+ child mesg : {String}+ child pos : {Pos}+ alternative HsToken:+ child value : {String}+ child pos : {Pos}+ alternative StrToken:+ child value : {String}+ child pos : {Pos}+-}+-- cata+sem_HsToken :: HsToken ->+ T_HsToken +sem_HsToken (AGField _field _attr _pos _rdesc ) =+ (sem_HsToken_AGField _field _attr _pos _rdesc )+sem_HsToken (AGLocal _var _pos _rdesc ) =+ (sem_HsToken_AGLocal _var _pos _rdesc )+sem_HsToken (CharToken _value _pos ) =+ (sem_HsToken_CharToken _value _pos )+sem_HsToken (Err _mesg _pos ) =+ (sem_HsToken_Err _mesg _pos )+sem_HsToken (HsToken _value _pos ) =+ (sem_HsToken_HsToken _value _pos )+sem_HsToken (StrToken _value _pos ) =+ (sem_HsToken_StrToken _value _pos )+-- semantic domain+newtype T_HsToken = T_HsToken (([(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 :: [(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 ->+ Inh_HsToken ->+ Syn_HsToken +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 :: Identifier ->+ Identifier ->+ Pos ->+ (Maybe String) ->+ T_HsToken +sem_HsToken_AGField field_ attr_ pos_ rdesc_ =+ (T_HsToken (\ _lhsIallfields+ _lhsIallnts+ _lhsIattrs+ _lhsIcon+ _lhsIfieldnames+ _lhsInt ->+ (let _lhsOerrors :: (Seq Error)+ _lhsOusedAttrs :: ([(Identifier,Identifier)])+ _lhsOtok :: ((Pos,String))+ _lhsOusedFields :: (Seq Identifier)+ _lhsOusedLocals :: ([Identifier])+ -- "SemHsTokens.ag"(line 74, column 15)+ _lhsOerrors =+ if (field_,attr_) `elem` _lhsIattrs+ then Seq.empty+ else if not(field_ `elem` (_LHS : _LOC: _lhsIfieldnames))+ then Seq.singleton (UndefChild _lhsInt _lhsIcon field_)+ else Seq.singleton (UndefAttr _lhsInt _lhsIcon field_ attr_ False)+ -- "SemHsTokens.ag"(line 88, column 13)+ _lhsOusedAttrs =+ [(field_,attr_)]+ -- "SemHsTokens.ag"(line 115, column 8)+ _addTrace =+ case rdesc_ of+ Just d -> \x -> "(trace " ++ show (d ++ " -> " ++ show field_ ++ "." ++ show attr_) ++ " (" ++ x ++ "))"+ Nothing -> id+ -- "SemHsTokens.ag"(line 118, column 8)+ _lhsOtok =+ (pos_, _addTrace $ attrname True field_ attr_)+ -- use rule "SemHsTokens.ag"(line 93, column 40)+ _lhsOusedFields =+ Seq.empty+ -- use rule "SemHsTokens.ag"(line 84, column 40)+ _lhsOusedLocals =+ []+ in ( _lhsOerrors,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) )+sem_HsToken_AGLocal :: Identifier ->+ Pos ->+ (Maybe String) ->+ T_HsToken +sem_HsToken_AGLocal var_ pos_ rdesc_ =+ (T_HsToken (\ _lhsIallfields+ _lhsIallnts+ _lhsIattrs+ _lhsIcon+ _lhsIfieldnames+ _lhsInt ->+ (let _lhsOusedFields :: (Seq Identifier)+ _lhsOerrors :: (Seq Error)+ _lhsOusedAttrs :: ([(Identifier,Identifier)])+ _lhsOusedLocals :: ([Identifier])+ _lhsOtok :: ((Pos,String))+ -- "SemHsTokens.ag"(line 64, column 19)+ __tup1 =+ if var_ `elem` _lhsIfieldnames+ then if isNTname _lhsIallnts (lookup var_ (map (\(n,t,_) -> (n,t)) _lhsIallfields))+ then (Seq.singleton(ChildAsLocal _lhsInt _lhsIcon var_), (pos_,fieldname var_), [] )+ else (Seq.empty, (pos_,fieldname var_), [] )+ else if (_LOC,var_) `elem` _lhsIattrs+ then (Seq.empty , (pos_,locname var_), [var_])+ else (Seq.singleton(UndefLocal _lhsInt _lhsIcon var_), (pos_,locname var_), [] )+ -- "SemHsTokens.ag"(line 64, column 19)+ (_errors,_,_) =+ __tup1+ -- "SemHsTokens.ag"(line 64, column 19)+ (_,_tok,_) =+ __tup1+ -- "SemHsTokens.ag"(line 64, column 19)+ (_,_,_usedLocals) =+ __tup1+ -- "SemHsTokens.ag"(line 96, column 13)+ _lhsOusedFields =+ if var_ `elem` _lhsIfieldnames+ then Seq.singleton var_+ else Seq.empty+ -- use rule "SemHsTokens.ag"(line 43, column 37)+ _lhsOerrors =+ _errors+ -- use rule "SemHsTokens.ag"(line 85, column 40)+ _lhsOusedAttrs =+ []+ -- use rule "SemHsTokens.ag"(line 84, column 40)+ _lhsOusedLocals =+ _usedLocals+ -- copy rule (from local)+ _lhsOtok =+ _tok+ in ( _lhsOerrors,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) )+sem_HsToken_CharToken :: String ->+ Pos ->+ T_HsToken +sem_HsToken_CharToken value_ pos_ =+ (T_HsToken (\ _lhsIallfields+ _lhsIallnts+ _lhsIattrs+ _lhsIcon+ _lhsIfieldnames+ _lhsInt ->+ (let _lhsOtok :: ((Pos,String))+ _lhsOerrors :: (Seq Error)+ _lhsOusedAttrs :: ([(Identifier,Identifier)])+ _lhsOusedFields :: (Seq Identifier)+ _lhsOusedLocals :: ([Identifier])+ -- "SemHsTokens.ag"(line 122, column 16)+ _lhsOtok =+ (pos_, if null value_+ then ""+ else showCharShort (head value_)+ )+ -- use rule "SemHsTokens.ag"(line 43, column 37)+ _lhsOerrors =+ Seq.empty+ -- use rule "SemHsTokens.ag"(line 85, column 40)+ _lhsOusedAttrs =+ []+ -- use rule "SemHsTokens.ag"(line 93, column 40)+ _lhsOusedFields =+ Seq.empty+ -- use rule "SemHsTokens.ag"(line 84, column 40)+ _lhsOusedLocals =+ []+ in ( _lhsOerrors,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) )+sem_HsToken_Err :: String ->+ Pos ->+ T_HsToken +sem_HsToken_Err mesg_ pos_ =+ (T_HsToken (\ _lhsIallfields+ _lhsIallnts+ _lhsIattrs+ _lhsIcon+ _lhsIfieldnames+ _lhsInt ->+ (let _lhsOerrors :: (Seq Error)+ _lhsOtok :: ((Pos,String))+ _lhsOusedAttrs :: ([(Identifier,Identifier)])+ _lhsOusedFields :: (Seq Identifier)+ _lhsOusedLocals :: ([Identifier])+ -- "SemHsTokens.ag"(line 50, column 9)+ _lhsOerrors =+ let m = text mesg_+ in Seq.singleton (CustomError False pos_ m)+ -- "SemHsTokens.ag"(line 128, column 16)+ _lhsOtok =+ (pos_, "")+ -- use rule "SemHsTokens.ag"(line 85, column 40)+ _lhsOusedAttrs =+ []+ -- use rule "SemHsTokens.ag"(line 93, column 40)+ _lhsOusedFields =+ Seq.empty+ -- use rule "SemHsTokens.ag"(line 84, column 40)+ _lhsOusedLocals =+ []+ in ( _lhsOerrors,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) )+sem_HsToken_HsToken :: String ->+ Pos ->+ T_HsToken +sem_HsToken_HsToken value_ pos_ =+ (T_HsToken (\ _lhsIallfields+ _lhsIallnts+ _lhsIattrs+ _lhsIcon+ _lhsIfieldnames+ _lhsInt ->+ (let _lhsOtok :: ((Pos,String))+ _lhsOerrors :: (Seq Error)+ _lhsOusedAttrs :: ([(Identifier,Identifier)])+ _lhsOusedFields :: (Seq Identifier)+ _lhsOusedLocals :: ([Identifier])+ -- "SemHsTokens.ag"(line 120, column 14)+ _lhsOtok =+ (pos_, value_)+ -- use rule "SemHsTokens.ag"(line 43, column 37)+ _lhsOerrors =+ Seq.empty+ -- use rule "SemHsTokens.ag"(line 85, column 40)+ _lhsOusedAttrs =+ []+ -- use rule "SemHsTokens.ag"(line 93, column 40)+ _lhsOusedFields =+ Seq.empty+ -- use rule "SemHsTokens.ag"(line 84, column 40)+ _lhsOusedLocals =+ []+ in ( _lhsOerrors,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) )+sem_HsToken_StrToken :: String ->+ Pos ->+ T_HsToken +sem_HsToken_StrToken value_ pos_ =+ (T_HsToken (\ _lhsIallfields+ _lhsIallnts+ _lhsIattrs+ _lhsIcon+ _lhsIfieldnames+ _lhsInt ->+ (let _lhsOtok :: ((Pos,String))+ _lhsOerrors :: (Seq Error)+ _lhsOusedAttrs :: ([(Identifier,Identifier)])+ _lhsOusedFields :: (Seq Identifier)+ _lhsOusedLocals :: ([Identifier])+ -- "SemHsTokens.ag"(line 127, column 16)+ _lhsOtok =+ (pos_, showStrShort value_)+ -- use rule "SemHsTokens.ag"(line 43, column 37)+ _lhsOerrors =+ Seq.empty+ -- use rule "SemHsTokens.ag"(line 85, column 40)+ _lhsOusedAttrs =+ []+ -- use rule "SemHsTokens.ag"(line 93, column 40)+ _lhsOusedFields =+ Seq.empty+ -- use rule "SemHsTokens.ag"(line 84, column 40)+ _lhsOusedLocals =+ []+ in ( _lhsOerrors,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) )+-- HsTokens ----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allfields : [(Identifier,Type,Bool)]+ allnts : [Identifier]+ attrs : [(Identifier,Identifier)]+ con : Identifier+ fieldnames : [Identifier]+ nt : Identifier+ synthesized attributes:+ errors : Seq Error+ tks : [(Pos,String)]+ usedAttrs : [(Identifier,Identifier)]+ usedFields : Seq Identifier+ usedLocals : [Identifier]+ 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 (([(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 :: [(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 ->+ Inh_HsTokens ->+ Syn_HsTokens +wrap_HsTokens (T_HsTokens sem ) (Inh_HsTokens _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt ) =+ (let ( _lhsOerrors,_lhsOtks,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals) =+ (sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt )+ in (Syn_HsTokens _lhsOerrors _lhsOtks _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals ))+sem_HsTokens_Cons :: T_HsToken ->+ T_HsTokens ->+ T_HsTokens +sem_HsTokens_Cons (T_HsToken hd_ ) (T_HsTokens tl_ ) =+ (T_HsTokens (\ _lhsIallfields+ _lhsIallnts+ _lhsIattrs+ _lhsIcon+ _lhsIfieldnames+ _lhsInt ->+ (let _lhsOtks :: ([(Pos,String)])+ _lhsOerrors :: (Seq Error)+ _lhsOusedAttrs :: ([(Identifier,Identifier)])+ _lhsOusedFields :: (Seq Identifier)+ _lhsOusedLocals :: ([Identifier])+ _hdOallfields :: ([(Identifier,Type,Bool)])+ _hdOallnts :: ([Identifier])+ _hdOattrs :: ([(Identifier,Identifier)])+ _hdOcon :: Identifier+ _hdOfieldnames :: ([Identifier])+ _hdOnt :: Identifier+ _tlOallfields :: ([(Identifier,Type,Bool)])+ _tlOallnts :: ([Identifier])+ _tlOattrs :: ([(Identifier,Identifier)])+ _tlOcon :: Identifier+ _tlOfieldnames :: ([Identifier])+ _tlOnt :: Identifier+ _hdIerrors :: (Seq Error)+ _hdItok :: ((Pos,String))+ _hdIusedAttrs :: ([(Identifier,Identifier)])+ _hdIusedFields :: (Seq Identifier)+ _hdIusedLocals :: ([Identifier])+ _tlIerrors :: (Seq Error)+ _tlItks :: ([(Pos,String)])+ _tlIusedAttrs :: ([(Identifier,Identifier)])+ _tlIusedFields :: (Seq Identifier)+ _tlIusedLocals :: ([Identifier])+ -- "SemHsTokens.ag"(line 110, column 10)+ _lhsOtks =+ _hdItok : _tlItks+ -- use rule "SemHsTokens.ag"(line 43, column 37)+ _lhsOerrors =+ _hdIerrors Seq.>< _tlIerrors+ -- use rule "SemHsTokens.ag"(line 85, column 40)+ _lhsOusedAttrs =+ _hdIusedAttrs ++ _tlIusedAttrs+ -- use rule "SemHsTokens.ag"(line 93, column 40)+ _lhsOusedFields =+ _hdIusedFields Seq.>< _tlIusedFields+ -- use rule "SemHsTokens.ag"(line 84, column 40)+ _lhsOusedLocals =+ _hdIusedLocals ++ _tlIusedLocals+ -- copy rule (down)+ _hdOallfields =+ _lhsIallfields+ -- copy rule (down)+ _hdOallnts =+ _lhsIallnts+ -- copy rule (down)+ _hdOattrs =+ _lhsIattrs+ -- copy rule (down)+ _hdOcon =+ _lhsIcon+ -- copy rule (down)+ _hdOfieldnames =+ _lhsIfieldnames+ -- copy rule (down)+ _hdOnt =+ _lhsInt+ -- copy rule (down)+ _tlOallfields =+ _lhsIallfields+ -- copy rule (down)+ _tlOallnts =+ _lhsIallnts+ -- copy rule (down)+ _tlOattrs =+ _lhsIattrs+ -- copy rule (down)+ _tlOcon =+ _lhsIcon+ -- copy rule (down)+ _tlOfieldnames =+ _lhsIfieldnames+ -- copy rule (down)+ _tlOnt =+ _lhsInt+ ( _hdIerrors,_hdItok,_hdIusedAttrs,_hdIusedFields,_hdIusedLocals) =+ (hd_ _hdOallfields _hdOallnts _hdOattrs _hdOcon _hdOfieldnames _hdOnt )+ ( _tlIerrors,_tlItks,_tlIusedAttrs,_tlIusedFields,_tlIusedLocals) =+ (tl_ _tlOallfields _tlOallnts _tlOattrs _tlOcon _tlOfieldnames _tlOnt )+ in ( _lhsOerrors,_lhsOtks,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) )+sem_HsTokens_Nil :: T_HsTokens +sem_HsTokens_Nil =+ (T_HsTokens (\ _lhsIallfields+ _lhsIallnts+ _lhsIattrs+ _lhsIcon+ _lhsIfieldnames+ _lhsInt ->+ (let _lhsOtks :: ([(Pos,String)])+ _lhsOerrors :: (Seq Error)+ _lhsOusedAttrs :: ([(Identifier,Identifier)])+ _lhsOusedFields :: (Seq Identifier)+ _lhsOusedLocals :: ([Identifier])+ -- "SemHsTokens.ag"(line 111, column 10)+ _lhsOtks =+ []+ -- use rule "SemHsTokens.ag"(line 43, column 37)+ _lhsOerrors =+ Seq.empty+ -- use rule "SemHsTokens.ag"(line 85, column 40)+ _lhsOusedAttrs =+ []+ -- use rule "SemHsTokens.ag"(line 93, column 40)+ _lhsOusedFields =+ Seq.empty+ -- use rule "SemHsTokens.ag"(line 84, column 40)+ _lhsOusedLocals =+ []+ in ( _lhsOerrors,_lhsOtks,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) )+-- HsTokensRoot ------------------------------------------------+{-+ visit 0:+ inherited attributes:+ allfields : [(Identifier,Type,Bool)]+ allnts : [Identifier]+ attrs : [(Identifier,Identifier)]+ con : Identifier+ nt : Identifier+ synthesized attributes:+ errors : Seq Error+ textLines : [String]+ usedAttrs : [(Identifier,Identifier)]+ usedFields : [Identifier]+ usedLocals : [Identifier]+ 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,Type,Bool)]) ->+ ([Identifier]) ->+ ([(Identifier,Identifier)]) ->+ Identifier ->+ Identifier ->+ ( (Seq Error),([String]),([(Identifier,Identifier)]),([Identifier]),([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 ->+ Inh_HsTokensRoot ->+ Syn_HsTokensRoot +wrap_HsTokensRoot (T_HsTokensRoot sem ) (Inh_HsTokensRoot _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsInt ) =+ (let ( _lhsOerrors,_lhsOtextLines,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals) =+ (sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsInt )+ in (Syn_HsTokensRoot _lhsOerrors _lhsOtextLines _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals ))+sem_HsTokensRoot_HsTokensRoot :: T_HsTokens ->+ T_HsTokensRoot +sem_HsTokensRoot_HsTokensRoot (T_HsTokens tokens_ ) =+ (T_HsTokensRoot (\ _lhsIallfields+ _lhsIallnts+ _lhsIattrs+ _lhsIcon+ _lhsInt ->+ (let _tokensOfieldnames :: ([Identifier])+ _lhsOusedFields :: ([Identifier])+ _lhsOtextLines :: ([String])+ _lhsOerrors :: (Seq Error)+ _lhsOusedAttrs :: ([(Identifier,Identifier)])+ _lhsOusedLocals :: ([Identifier])+ _tokensOallfields :: ([(Identifier,Type,Bool)])+ _tokensOallnts :: ([Identifier])+ _tokensOattrs :: ([(Identifier,Identifier)])+ _tokensOcon :: Identifier+ _tokensOnt :: Identifier+ _tokensIerrors :: (Seq Error)+ _tokensItks :: ([(Pos,String)])+ _tokensIusedAttrs :: ([(Identifier,Identifier)])+ _tokensIusedFields :: (Seq Identifier)+ _tokensIusedLocals :: ([Identifier])+ -- "SemHsTokens.ag"(line 38, column 18)+ _tokensOfieldnames =+ map (\(n,_,_) -> n) _lhsIallfields+ -- "SemHsTokens.ag"(line 100, column 18)+ _lhsOusedFields =+ toList _tokensIusedFields+ -- "SemHsTokens.ag"(line 107, column 18)+ _lhsOtextLines =+ showTokens _tokensItks+ -- use rule "SemHsTokens.ag"(line 18, column 18)+ _lhsOerrors =+ _tokensIerrors+ -- copy rule (up)+ _lhsOusedAttrs =+ _tokensIusedAttrs+ -- copy rule (up)+ _lhsOusedLocals =+ _tokensIusedLocals+ -- copy rule (down)+ _tokensOallfields =+ _lhsIallfields+ -- copy rule (down)+ _tokensOallnts =+ _lhsIallnts+ -- copy rule (down)+ _tokensOattrs =+ _lhsIattrs+ -- copy rule (down)+ _tokensOcon =+ _lhsIcon+ -- copy rule (down)+ _tokensOnt =+ _lhsInt+ ( _tokensIerrors,_tokensItks,_tokensIusedAttrs,_tokensIusedFields,_tokensIusedLocals) =+ (tokens_ _tokensOallfields _tokensOallnts _tokensOattrs _tokensOcon _tokensOfieldnames _tokensOnt ) in ( _lhsOerrors,_lhsOtextLines,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) )
src-derived/TfmToVisage.hs view
@@ -1,975 +1,975 @@- - --- UUAGC 0.9.11 (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 -> - Inh_Child -> - Syn_Child -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 -> - Inh_Children -> - Syn_Children -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 -> - Inh_Expression -> - Syn_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} - child uniqueMap : {UniqueMap} --} --- cata -sem_Grammar :: Grammar -> - T_Grammar -sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap ) = - (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts ) _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap ) --- 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 -> - Inh_Grammar -> - Syn_Grammar -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 -> - UniqueMap -> - T_Grammar -sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ uniqueMap_ = - (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 -> - Inh_Nonterminal -> - Syn_Nonterminal -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 -> - Inh_Nonterminals -> - Syn_Nonterminals -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 -> - Inh_Pattern -> - Syn_Pattern -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 -> - Inh_Patterns -> - Syn_Patterns -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 -> - Inh_Production -> - Syn_Production -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 -> - Inh_Productions -> - Syn_Productions -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 -> - Inh_Rule -> - Syn_Rule -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 -> - Inh_Rules -> - Syn_Rules -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 -> - Inh_TypeSig -> - Syn_TypeSig -wrap_TypeSig (T_TypeSig sem ) (Inh_TypeSig ) = - (let ( ) = - (sem ) - in (Syn_TypeSig )) -sem_TypeSig_TypeSig :: Identifier -> - Type -> - T_TypeSig -sem_TypeSig_TypeSig name_ tp_ = - (T_TypeSig (let - in ( )) ) --- TypeSigs ---------------------------------------------------- -{- - alternatives: - alternative Cons: - child hd : TypeSig - child tl : TypeSigs - alternative Nil: --} --- cata -sem_TypeSigs :: TypeSigs -> - T_TypeSigs -sem_TypeSigs list = - (Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) ) --- semantic domain -newtype T_TypeSigs = T_TypeSigs (( )) -data Inh_TypeSigs = Inh_TypeSigs {} -data Syn_TypeSigs = Syn_TypeSigs {} -wrap_TypeSigs :: T_TypeSigs -> - Inh_TypeSigs -> - Syn_TypeSigs -wrap_TypeSigs (T_TypeSigs sem ) (Inh_TypeSigs ) = - (let ( ) = - (sem ) - in (Syn_TypeSigs )) -sem_TypeSigs_Cons :: T_TypeSig -> - T_TypeSigs -> - T_TypeSigs -sem_TypeSigs_Cons (T_TypeSig hd_ ) (T_TypeSigs tl_ ) = - (T_TypeSigs (let - in ( )) ) -sem_TypeSigs_Nil :: T_TypeSigs -sem_TypeSigs_Nil = - (T_TypeSigs (let +++-- UUAGC 0.9.12 (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 ->+ Inh_Child ->+ Syn_Child +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 ->+ Inh_Children ->+ Syn_Children +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 ->+ Inh_Expression ->+ Syn_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}+ child uniqueMap : {UniqueMap}+-}+-- cata+sem_Grammar :: Grammar ->+ T_Grammar +sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap ) =+ (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts ) _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap )+-- 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 ->+ Inh_Grammar ->+ Syn_Grammar +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 ->+ UniqueMap ->+ T_Grammar +sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ uniqueMap_ =+ (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 ->+ Inh_Nonterminal ->+ Syn_Nonterminal +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 ->+ Inh_Nonterminals ->+ Syn_Nonterminals +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 ->+ Inh_Pattern ->+ Syn_Pattern +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 ->+ Inh_Patterns ->+ Syn_Patterns +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 ->+ Inh_Production ->+ Syn_Production +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 ->+ Inh_Productions ->+ Syn_Productions +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 ->+ Inh_Rule ->+ Syn_Rule +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 ->+ Inh_Rules ->+ Syn_Rules +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 ->+ Inh_TypeSig ->+ Syn_TypeSig +wrap_TypeSig (T_TypeSig sem ) (Inh_TypeSig ) =+ (let ( ) =+ (sem )+ in (Syn_TypeSig ))+sem_TypeSig_TypeSig :: Identifier ->+ Type ->+ T_TypeSig +sem_TypeSig_TypeSig name_ tp_ =+ (T_TypeSig (let + in ( )) )+-- TypeSigs ----------------------------------------------------+{-+ alternatives:+ alternative Cons:+ child hd : TypeSig + child tl : TypeSigs + alternative Nil:+-}+-- cata+sem_TypeSigs :: TypeSigs ->+ T_TypeSigs +sem_TypeSigs list =+ (Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) )+-- semantic domain+newtype T_TypeSigs = T_TypeSigs (( ))+data Inh_TypeSigs = Inh_TypeSigs {}+data Syn_TypeSigs = Syn_TypeSigs {}+wrap_TypeSigs :: T_TypeSigs ->+ Inh_TypeSigs ->+ Syn_TypeSigs +wrap_TypeSigs (T_TypeSigs sem ) (Inh_TypeSigs ) =+ (let ( ) =+ (sem )+ in (Syn_TypeSigs ))+sem_TypeSigs_Cons :: T_TypeSig ->+ T_TypeSigs ->+ T_TypeSigs +sem_TypeSigs_Cons (T_TypeSig hd_ ) (T_TypeSigs tl_ ) =+ (T_TypeSigs (let + in ( )) )+sem_TypeSigs_Nil :: T_TypeSigs +sem_TypeSigs_Nil =+ (T_TypeSigs (let in ( )) )
src-derived/Transform.hs view
@@ -1,3990 +1,3990 @@- - --- UUAGC 0.9.11 (Transform.ag) -module Transform where - -import Control.Monad(mplus,mzero) -import List (partition, elem, nub,intersperse) -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 qualified Data.Sequence as Seq -import Data.Sequence(Seq, empty, (><),fromList) -import Data.Foldable(toList) -import UU.Scanner.Position(noPos) - -import ConcreteSyntax -import AbstractSyntax -import ErrorMessages -import Patterns (Patterns(..),Pattern(..)) -import Expression (Expression(..)) -import HsToken - -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) - -type UniqueInfo = (Identifier,Identifier) - - - -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.singleton (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 UniquesAndErrors = (Map Identifier Identifier, 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.<|)) (DupRule nt con field attr2 attr) e, m, fa:u, bs) - Nothing -> ( e, Map.insert fa owrt m, u, fa:bs) - else (((Seq.<|)) (SuperfluousRule nt con field attr) e, m, fa:u, bs) - _ -> (((Seq.<|)) (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.<|)) (DupSig nt con ide) errs) - -- else if not (ide `elem` locattrdefs) - -- then (sigs, ((Seq.<|)) (SupSig nt con ide) errs) - else (TypeSig ide typ:sigs, errs) - in foldr checkSig ([],Seq.empty) sis - -checkInsts :: Set NontermIdent -> Map NontermIdent (Map ConstructorIdent [SigInfo]) -> NontermIdent -> ConstructorIdent -> [Identifier] -> InstsAndErrors -checkInsts allNts sigMap nt con - = foldr (\inst (insts, errs) -> - maybe (insts, Seq.singleton (MissingInstSig nt con inst) >< errs) - (\info@(_, NT nm _) -> case nm `Set.member` allNts of - True -> (info : insts, errs) - False | take 2 (getName nm) == "T_" -> let nm' = Ident (drop 2 (getName nm)) (getPos nm) - in case nm' `Set.member` allNts of - True -> (info : insts, errs) - False -> (insts, Seq.singleton (UndefNont nm') >< errs) - | otherwise -> (insts, Seq.singleton (UndefNont nm) >< 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) - -checkUniques :: Map NontermIdent (Attributes, Attributes) -> NontermIdent -> ConstructorIdent -> [UniqueInfo] -> UniquesAndErrors -checkUniques allAttrs nt con uniques - = let checkUnique (ident,ref) (us,errs) - = if ident `Map.member` us - then (us, ((Seq.<|)) (DupUnique nt con ident) errs) - else if Map.member ref inhs && Map.member ref syns - then (Map.insert ident ref us, errs) - else (us, ((Seq.<|)) (MissingUnique nt ref) errs) - - (inhs,syns) = Map.findWithDefault (Map.empty,Map.empty) nt allAttrs - in foldr checkUnique (Map.empty, Seq.empty) uniques - - -mkUniqueRules :: Options -> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) -> Map NontermIdent (Attributes,Attributes) -> NontermIdent -> ConstructorIdent -> Map Identifier Identifier -> [Rule] -mkUniqueRules opts allFields allAttrDecls nt con usMap - = map apply groups - where - fields = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allFields) - - groups = Map.assocs $ Map.foldWithKey (\i r m -> Map.insertWith (++) r [i] m) Map.empty usMap - apply (ref,us) = mkRule ref (findOutField ref) us - findOutField ref = case [ chld | (chld,NT tp _) <- fields, tp `hasSyn` ref] of - [] -> _LHS - (x:_) -> x - hasSyn tp ref = Map.member ref $ snd $ Map.findWithDefault (Map.empty,Map.empty) tp allAttrDecls - mkRule ref outFld locAttrs - = let pat = Product noPos (attr outFld ref : [attr _LOC u | u <- locAttrs ]) - rhs = Expression noPos $ wrap ref $ foldr gencase (finalout locAttrs) locAttrs - -- [HsToken ("mkUniques" ++ show (length locAttrs) ++ " ") noPos, AGField _LHS ref noPos Nothing] - in Rule pat rhs False "-- generated by the unique rule mechanism." - attr fld a = Alias fld a (Underscore noPos) [] - gencase nm outp - = h ("case " ++ uniqueDispenser opts ++ " __cont of { (__cont, " ++ getName nm ++ ") -> ") ++ outp ++ h "}" - h s = [HsToken s noPos] - finalout us = h ("(__cont, " ++ concat (intersperse "," (map getName us)) ++ ")") - wrap ref inp = h "case " ++ [AGField _LHS ref noPos Nothing] ++ h " of { __cont | __cont `seq` True -> " ++ inp ++ h "}" - - -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.singleton(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 - -> UniqueMap - -> Grammar - -constructGrammar nts ntParams gram attrs uses derivings wrappers allrules tsigs allinsts tsyns pragmaMap orderMap contextMap uniqueMap = - 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 uniqueMap - - -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 allUniques : _ - local allRulesErrs : _ - local allSigsErrs : _ - local allInstsErrs : _ - local allUniquesErrs : _ - local checkedRulesPre : _ - local checkedSigs : _ - local checkedInsts : _ - local checkedUniques : _ - local checkedRules : _ - local errs1 : _ - local errs2 : _ - local errs3 : _ - local errs4 : _ - local errs5 : _ - local errs6 : _ - local errs7 : _ - 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 -> - Inh_AG -> - Syn_AG -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) ]) - _elemsIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) - _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 51, column 8) - _lhsOoutput = - constructGrammar _allNonterminals - _elemsIparamsCollect - _allFields - _allAttrDecls - _elemsIuseMap - _elemsIderivings - (if wrappers _lhsIoptions then _allNonterminals else _elemsIwrappers) - _checkedRules - _checkedSigs - _checkedInsts - _elemsItypeSyns - _elemsIsemPragmasCollect - _elemsIattrOrderCollect - _elemsIctxCollect - _checkedUniques - -- "Transform.ag"(line 237, 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 240, column 10) - _allConstrs = - let f (nt,con,_) = Map.insertWith (++) nt [con] - in foldr f (Map.empty) _elemsIcollectedFields - -- "Transform.ag"(line 243, 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 246, column 10) - _allSigs = - let f (nt,con,t) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con [t]) - typeof nt r = Map.findWithDefault (Haskell "<unknown>") r $ fst $ Map.findWithDefault (Map.empty,Map.empty) nt _allAttrDecls - in foldr f (Map.empty) ( _elemsIcollectedSigs - ++ [ (nt, con, (ident,typeof nt ref)) | (nt, con, us) <- _elemsIcollectedUniques, (ident,ref) <- us ] - ) - -- "Transform.ag"(line 252, 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 255, column 10) - _allUniques = - let f (nt,con,us) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con us) - in foldr f (Map.empty) _elemsIcollectedUniques - -- "Transform.ag"(line 258, column 10) - _allRulesErrs = - Map.mapWithKey (Map.mapWithKey . (checkRules _allAttrDecls _allFields _allInsts _allSigs )) _allRules - -- "Transform.ag"(line 259, column 10) - _allSigsErrs = - Map.mapWithKey (Map.mapWithKey . (checkSigs )) _allSigs - -- "Transform.ag"(line 260, column 10) - _allInstsErrs = - Map.mapWithKey (Map.mapWithKey . (checkInsts _allNonterminals _allSigs )) _allInsts - -- "Transform.ag"(line 261, column 10) - _allUniquesErrs = - Map.mapWithKey (Map.mapWithKey . (checkUniques _allAttrDecls )) _allUniques - -- "Transform.ag"(line 263, column 10) - _checkedRulesPre = - Map.map (Map.map fst) _allRulesErrs - -- "Transform.ag"(line 264, column 10) - _checkedSigs = - Map.map (Map.map fst) _allSigsErrs - -- "Transform.ag"(line 265, column 10) - _checkedInsts = - Map.map (Map.map fst) _allInstsErrs - -- "Transform.ag"(line 266, column 10) - _checkedUniques = - Map.map (Map.map fst) _allUniquesErrs - -- "Transform.ag"(line 267, column 10) - _checkedRules = - Map.unionWith (Map.unionWith (++)) _checkedRulesPre (Map.mapWithKey (Map.mapWithKey . (mkUniqueRules _lhsIoptions _allFields _allAttrDecls )) _checkedUniques ) - -- "Transform.ag"(line 269, column 10) - _errs1 = - let f = checkForDuplicates (DupSynonym) - in Seq.fromList . f . map fst $ _elemsItypeSyns - -- "Transform.ag"(line 272, 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 276, column 10) - _errs3 = - let f (nt,cons) = checkForDuplicates (DupAlt nt) cons - in Seq.empty - -- "Transform.ag"(line 280, column 10) - _errs4 = - let f m s = Map.fold ((><) . snd) s m - in Map.fold f Seq.empty _allRulesErrs - -- "Transform.ag"(line 283, column 10) - _errs5 = - let f m s = Map.fold ((><) . snd) s m - in Map.fold f Seq.empty _allSigsErrs - -- "Transform.ag"(line 286, column 10) - _errs6 = - let f m s = Map.fold ((><) . snd) s m - in Map.fold f Seq.empty _allInstsErrs - -- "Transform.ag"(line 289, column 10) - _errs7 = - let f m s = Map.fold ((><) . snd) s m - in Map.fold f Seq.empty _allUniquesErrs - -- "Transform.ag"(line 292, column 10) - _lhsOerrors = - _elemsIerrors >< _errs1 >< _errs2 >< _errs3 >< _errs4 >< _errs5 >< _errs6 >< _errs7 - -- "Transform.ag"(line 425, column 10) - _allNonterminals = - _elemsIcollectedNames `Set.difference` _elemsIcollectedSetNames - -- "Transform.ag"(line 445, column 8) - _elemsOallConstructors = - _elemsIcollectedConstructorsMap - -- "Transform.ag"(line 518, column 8) - _elemsOdefSets = - Map.fromList (map (\x->(x,(Set.singleton x, Set.empty))) (Set.toList _allNonterminals )) - -- "Transform.ag"(line 519, column 8) - _elemsOdefinedSets = - Map.map fst _elemsIdefSets - -- "Transform.ag"(line 771, column 8) - _elemsOattrDecls = - Map.empty - -- "Transform.ag"(line 810, column 9) - _allAttrDecls = - if withSelf _lhsIoptions - then foldr addSelf _elemsIattrDecls (Set.toList _allNonterminals ) - else _elemsIattrDecls - -- use rule "Transform.ag"(line 44, column 19) - _lhsOblocks = - _elemsIblocks - -- use rule "Transform.ag"(line 904, column 37) - _lhsOmoduleDecl = - _elemsImoduleDecl - -- use rule "Transform.ag"(line 600, 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,_elemsIcollectedUniques,_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 -> - Inh_Alt -> - Syn_Alt -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 222, 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 89, 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 -> - Inh_Alts -> - Syn_Alts -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 89, column 62) - _lhsOcollectedConstructorNames = - _hdIcollectedConstructorNames `Set.union` _tlIcollectedConstructorNames - -- use rule "Transform.ag"(line 121, 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 89, column 62) - _lhsOcollectedConstructorNames = - Set.empty - -- use rule "Transform.ag"(line 121, 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 -> - Inh_Attrs -> - Syn_Attrs -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 779, column 15) - __tup1 = - checkAttrs _lhsIallFields (Set.toList _lhsInts) _inherited _synthesized _lhsIattrDecls - -- "Transform.ag"(line 779, column 15) - (_attrDecls,_) = - __tup1 - -- "Transform.ag"(line 779, column 15) - (_,_errors) = - __tup1 - -- "Transform.ag"(line 781, 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 781, column 15) - (_inherited,_,_) = - __tup2 - -- "Transform.ag"(line 781, column 15) - (_,_synthesized,_) = - __tup2 - -- "Transform.ag"(line 781, column 15) - (_,_,_useMap) = - __tup2 - -- "Transform.ag"(line 789, column 11) - _lhsOuseMap = - Map.fromList (zip (Set.toList _lhsInts) (repeat _useMap)) - -- use rule "Transform.ag"(line 42, 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 -> - Inh_ConstructorSet -> - Syn_ConstructorSet -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 585, column 17) - _lhsOconstructors = - \ds -> ds - -- use rule "Transform.ag"(line 89, column 62) - _lhsOcollectedConstructorNames = - Set.empty - -- use rule "Transform.ag"(line 42, 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 584, column 17) - _lhsOconstructors = - \ds -> _set1Iconstructors ds `Set.difference` _set2Iconstructors ds - -- use rule "Transform.ag"(line 89, column 62) - _lhsOcollectedConstructorNames = - _set1IcollectedConstructorNames `Set.union` _set2IcollectedConstructorNames - -- use rule "Transform.ag"(line 42, 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 433, column 11) - _lhsOcollectedConstructorNames = - Set.singleton name_ - -- "Transform.ag"(line 582, column 17) - _lhsOconstructors = - \ds -> Set.singleton name_ - -- use rule "Transform.ag"(line 42, 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 583, column 17) - _lhsOconstructors = - \ds -> _set1Iconstructors ds `Set.union` _set2Iconstructors ds - -- use rule "Transform.ag"(line 89, column 62) - _lhsOcollectedConstructorNames = - _set1IcollectedConstructorNames `Set.union` _set2IcollectedConstructorNames - -- use rule "Transform.ag"(line 42, 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) ] - collectedUniques : [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ] - 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 : {Identifier} - child mbNt : {Maybe NontermIdent} - child lines : {[String]} - visit 0: - local blockInfo : _ - local blockValue : _ - 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 _mbNt _lines ) = - (sem_Elem_Txt _pos _name _mbNt _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) ]),([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),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) ]),collectedUniques_Syn_Elem :: !([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),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 -> - Inh_Elem -> - Syn_Elem -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,_lhsOcollectedUniques,_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 _lhsOcollectedUniques _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) ]) - _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) - _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 731, column 7) - _lhsOctxCollect = - if null ctx_ - then Map.empty - else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet] - -- "Transform.ag"(line 775, column 10) - _attrsOnts = - _namesInontSet - -- use rule "Transform.ag"(line 672, column 55) - _lhsOattrOrderCollect = - Map.empty - -- use rule "Transform.ag"(line 44, column 19) - _lhsOblocks = - Map.empty - -- use rule "Transform.ag"(line 90, column 48) - _lhsOcollectedConstructorsMap = - Map.empty - -- use rule "Transform.ag"(line 121, column 28) - _lhsOcollectedFields = - [] - -- use rule "Transform.ag"(line 146, column 31) - _lhsOcollectedInsts = - [] - -- use rule "Transform.ag"(line 82, column 50) - _lhsOcollectedNames = - _namesIcollectedNames - -- use rule "Transform.ag"(line 144, column 31) - _lhsOcollectedRules = - [] - -- use rule "Transform.ag"(line 81, column 50) - _lhsOcollectedSetNames = - Set.empty - -- use rule "Transform.ag"(line 145, column 31) - _lhsOcollectedSigs = - [] - -- use rule "Transform.ag"(line 147, column 31) - _lhsOcollectedUniques = - [] - -- use rule "Transform.ag"(line 752, column 33) - _lhsOderivings = - Map.empty - -- use rule "Transform.ag"(line 42, column 19) - _lhsOerrors = - _namesIerrors Seq.>< _attrsIerrors - -- use rule "Transform.ag"(line 904, column 37) - _lhsOmoduleDecl = - mzero - -- use rule "Transform.ag"(line 704, column 37) - _lhsOparamsCollect = - Map.empty - -- use rule "Transform.ag"(line 600, column 34) - _lhsOpragmas = - id - -- use rule "Transform.ag"(line 644, column 56) - _lhsOsemPragmasCollect = - Map.empty - -- use rule "Transform.ag"(line 460, column 32) - _lhsOtypeSyns = - [] - -- use rule "Transform.ag"(line 133, column 15) - _lhsOuseMap = - _attrsIuseMap - -- use rule "Transform.ag"(line 591, 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,_lhsOcollectedUniques,_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) ]) - _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) - _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 160, column 10) - _altsOnts = - _namesInontSet - -- "Transform.ag"(line 439, column 11) - _lhsOcollectedConstructorsMap = - Map.fromList - [ (n, _altsIcollectedConstructorNames) - | n <- Set.toList _namesInontSet - ] - -- "Transform.ag"(line 708, column 7) - _lhsOparamsCollect = - if null params_ - then Map.empty - else Map.fromList [(nt, params_) | nt <- Set.toList _namesInontSet] - -- "Transform.ag"(line 731, column 7) - _lhsOctxCollect = - if null ctx_ - then Map.empty - else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet] - -- "Transform.ag"(line 774, column 10) - _attrsOnts = - _namesInontSet - -- use rule "Transform.ag"(line 672, column 55) - _lhsOattrOrderCollect = - Map.empty - -- use rule "Transform.ag"(line 44, column 19) - _lhsOblocks = - Map.empty - -- use rule "Transform.ag"(line 121, column 28) - _lhsOcollectedFields = - _altsIcollectedFields - -- use rule "Transform.ag"(line 146, column 31) - _lhsOcollectedInsts = - [] - -- use rule "Transform.ag"(line 82, column 50) - _lhsOcollectedNames = - _namesIcollectedNames - -- use rule "Transform.ag"(line 144, column 31) - _lhsOcollectedRules = - [] - -- use rule "Transform.ag"(line 81, column 50) - _lhsOcollectedSetNames = - Set.empty - -- use rule "Transform.ag"(line 145, column 31) - _lhsOcollectedSigs = - [] - -- use rule "Transform.ag"(line 147, column 31) - _lhsOcollectedUniques = - [] - -- use rule "Transform.ag"(line 752, column 33) - _lhsOderivings = - Map.empty - -- use rule "Transform.ag"(line 42, column 19) - _lhsOerrors = - _namesIerrors Seq.>< _attrsIerrors - -- use rule "Transform.ag"(line 904, column 37) - _lhsOmoduleDecl = - mzero - -- use rule "Transform.ag"(line 600, column 34) - _lhsOpragmas = - id - -- use rule "Transform.ag"(line 644, column 56) - _lhsOsemPragmasCollect = - Map.empty - -- use rule "Transform.ag"(line 460, column 32) - _lhsOtypeSyns = - [] - -- use rule "Transform.ag"(line 133, column 15) - _lhsOuseMap = - _attrsIuseMap - -- use rule "Transform.ag"(line 591, 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,_lhsOcollectedUniques,_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) ]) - _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) - _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 759, column 14) - _lhsOderivings = - Map.fromList [(nt,Set.fromList classes_) | nt <- Set.toList _setInontSet] - -- use rule "Transform.ag"(line 672, column 55) - _lhsOattrOrderCollect = - Map.empty - -- use rule "Transform.ag"(line 44, column 19) - _lhsOblocks = - Map.empty - -- use rule "Transform.ag"(line 90, column 48) - _lhsOcollectedConstructorsMap = - Map.empty - -- use rule "Transform.ag"(line 121, column 28) - _lhsOcollectedFields = - [] - -- use rule "Transform.ag"(line 146, column 31) - _lhsOcollectedInsts = - [] - -- use rule "Transform.ag"(line 82, column 50) - _lhsOcollectedNames = - _setIcollectedNames - -- use rule "Transform.ag"(line 144, column 31) - _lhsOcollectedRules = - [] - -- use rule "Transform.ag"(line 81, column 50) - _lhsOcollectedSetNames = - Set.empty - -- use rule "Transform.ag"(line 145, column 31) - _lhsOcollectedSigs = - [] - -- use rule "Transform.ag"(line 147, column 31) - _lhsOcollectedUniques = - [] - -- use rule "Transform.ag"(line 727, column 34) - _lhsOctxCollect = - Map.empty - -- use rule "Transform.ag"(line 42, column 19) - _lhsOerrors = - _setIerrors - -- use rule "Transform.ag"(line 904, column 37) - _lhsOmoduleDecl = - mzero - -- use rule "Transform.ag"(line 704, column 37) - _lhsOparamsCollect = - Map.empty - -- use rule "Transform.ag"(line 600, column 34) - _lhsOpragmas = - id - -- use rule "Transform.ag"(line 644, column 56) - _lhsOsemPragmasCollect = - Map.empty - -- use rule "Transform.ag"(line 460, column 32) - _lhsOtypeSyns = - [] - -- use rule "Transform.ag"(line 133, column 15) - _lhsOuseMap = - Map.empty - -- use rule "Transform.ag"(line 591, 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,_lhsOcollectedUniques,_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) ]) - _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) - _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 908, column 7) - _lhsOmoduleDecl = - Just (name_, exports_, imports_) - -- use rule "Transform.ag"(line 672, column 55) - _lhsOattrOrderCollect = - Map.empty - -- use rule "Transform.ag"(line 44, column 19) - _lhsOblocks = - Map.empty - -- use rule "Transform.ag"(line 90, column 48) - _lhsOcollectedConstructorsMap = - Map.empty - -- use rule "Transform.ag"(line 121, column 28) - _lhsOcollectedFields = - [] - -- use rule "Transform.ag"(line 146, column 31) - _lhsOcollectedInsts = - [] - -- use rule "Transform.ag"(line 82, column 50) - _lhsOcollectedNames = - Set.empty - -- use rule "Transform.ag"(line 144, column 31) - _lhsOcollectedRules = - [] - -- use rule "Transform.ag"(line 81, column 50) - _lhsOcollectedSetNames = - Set.empty - -- use rule "Transform.ag"(line 145, column 31) - _lhsOcollectedSigs = - [] - -- use rule "Transform.ag"(line 147, column 31) - _lhsOcollectedUniques = - [] - -- use rule "Transform.ag"(line 727, column 34) - _lhsOctxCollect = - Map.empty - -- use rule "Transform.ag"(line 752, column 33) - _lhsOderivings = - Map.empty - -- use rule "Transform.ag"(line 42, column 19) - _lhsOerrors = - Seq.empty - -- use rule "Transform.ag"(line 704, column 37) - _lhsOparamsCollect = - Map.empty - -- use rule "Transform.ag"(line 600, column 34) - _lhsOpragmas = - id - -- use rule "Transform.ag"(line 644, column 56) - _lhsOsemPragmasCollect = - Map.empty - -- use rule "Transform.ag"(line 460, column 32) - _lhsOtypeSyns = - [] - -- use rule "Transform.ag"(line 133, column 15) - _lhsOuseMap = - Map.empty - -- use rule "Transform.ag"(line 591, 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,_lhsOcollectedUniques,_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) ]) - _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) - _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 603, column 13) - _lhsOpragmas = - let mk n o = case getName n of - "gencatas" -> o { folds = True } - "nogencatas" -> o { folds = False } - "gendatas" -> o { dataTypes = True } - "nogendatas" -> o { dataTypes = False } - "gensems" -> o { semfuns = True } - "nogensems" -> o { semfuns = False } - "gentypesigs" -> o { typeSigs = True } - "nogentypesigs"-> o { typeSigs = False } - "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 672, column 55) - _lhsOattrOrderCollect = - Map.empty - -- use rule "Transform.ag"(line 44, column 19) - _lhsOblocks = - Map.empty - -- use rule "Transform.ag"(line 90, column 48) - _lhsOcollectedConstructorsMap = - Map.empty - -- use rule "Transform.ag"(line 121, column 28) - _lhsOcollectedFields = - [] - -- use rule "Transform.ag"(line 146, column 31) - _lhsOcollectedInsts = - [] - -- use rule "Transform.ag"(line 82, column 50) - _lhsOcollectedNames = - Set.empty - -- use rule "Transform.ag"(line 144, column 31) - _lhsOcollectedRules = - [] - -- use rule "Transform.ag"(line 81, column 50) - _lhsOcollectedSetNames = - Set.empty - -- use rule "Transform.ag"(line 145, column 31) - _lhsOcollectedSigs = - [] - -- use rule "Transform.ag"(line 147, column 31) - _lhsOcollectedUniques = - [] - -- use rule "Transform.ag"(line 727, column 34) - _lhsOctxCollect = - Map.empty - -- use rule "Transform.ag"(line 752, column 33) - _lhsOderivings = - Map.empty - -- use rule "Transform.ag"(line 42, column 19) - _lhsOerrors = - Seq.empty - -- use rule "Transform.ag"(line 904, column 37) - _lhsOmoduleDecl = - mzero - -- use rule "Transform.ag"(line 704, column 37) - _lhsOparamsCollect = - Map.empty - -- use rule "Transform.ag"(line 644, column 56) - _lhsOsemPragmasCollect = - Map.empty - -- use rule "Transform.ag"(line 460, column 32) - _lhsOtypeSyns = - [] - -- use rule "Transform.ag"(line 133, column 15) - _lhsOuseMap = - Map.empty - -- use rule "Transform.ag"(line 591, 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,_lhsOcollectedUniques,_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) ]) - _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) - _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) ]) - _altsIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) - _altsIerrors :: (Seq Error) - _altsIsemPragmasCollect :: PragmaMap - -- "Transform.ag"(line 161, column 10) - _altsOnts = - _namesInontSet - -- "Transform.ag"(line 731, column 7) - _lhsOctxCollect = - if null ctx_ - then Map.empty - else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet] - -- "Transform.ag"(line 776, column 10) - _attrsOnts = - _namesInontSet - -- use rule "Transform.ag"(line 672, column 55) - _lhsOattrOrderCollect = - _altsIattrOrderCollect - -- use rule "Transform.ag"(line 44, column 19) - _lhsOblocks = - Map.empty - -- use rule "Transform.ag"(line 90, column 48) - _lhsOcollectedConstructorsMap = - Map.empty - -- use rule "Transform.ag"(line 121, column 28) - _lhsOcollectedFields = - [] - -- use rule "Transform.ag"(line 146, column 31) - _lhsOcollectedInsts = - _altsIcollectedInsts - -- use rule "Transform.ag"(line 82, column 50) - _lhsOcollectedNames = - _namesIcollectedNames - -- use rule "Transform.ag"(line 144, column 31) - _lhsOcollectedRules = - _altsIcollectedRules - -- use rule "Transform.ag"(line 81, column 50) - _lhsOcollectedSetNames = - Set.empty - -- use rule "Transform.ag"(line 145, column 31) - _lhsOcollectedSigs = - _altsIcollectedSigs - -- use rule "Transform.ag"(line 147, column 31) - _lhsOcollectedUniques = - _altsIcollectedUniques - -- use rule "Transform.ag"(line 752, column 33) - _lhsOderivings = - Map.empty - -- use rule "Transform.ag"(line 42, column 19) - _lhsOerrors = - _namesIerrors Seq.>< _attrsIerrors Seq.>< _altsIerrors - -- use rule "Transform.ag"(line 904, column 37) - _lhsOmoduleDecl = - mzero - -- use rule "Transform.ag"(line 704, column 37) - _lhsOparamsCollect = - Map.empty - -- use rule "Transform.ag"(line 600, column 34) - _lhsOpragmas = - id - -- use rule "Transform.ag"(line 644, column 56) - _lhsOsemPragmasCollect = - _altsIsemPragmasCollect - -- use rule "Transform.ag"(line 460, column 32) - _lhsOtypeSyns = - [] - -- use rule "Transform.ag"(line 133, column 15) - _lhsOuseMap = - _attrsIuseMap - -- use rule "Transform.ag"(line 591, 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,_altsIcollectedUniques,_altsIerrors,_altsIsemPragmasCollect) = - (alts_ _altsOallAttrDecls _altsOallFields _altsOnts ) - in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_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) ]) - _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) - _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 416, column 10) - _lhsOcollectedSetNames = - Set.singleton name_ - -- "Transform.ag"(line 523, 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.singleton(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 523, column 13) - (_defSets2,_) = - __tup3 - -- "Transform.ag"(line 523, column 13) - (_,_errs) = - __tup3 - -- "Transform.ag"(line 533, column 9) - _lhsOdefSets = - _defSets2 - -- "Transform.ag"(line 533, column 9) - _lhsOerrors = - _errs >< _setIerrors - -- use rule "Transform.ag"(line 672, column 55) - _lhsOattrOrderCollect = - Map.empty - -- use rule "Transform.ag"(line 44, column 19) - _lhsOblocks = - Map.empty - -- use rule "Transform.ag"(line 90, column 48) - _lhsOcollectedConstructorsMap = - Map.empty - -- use rule "Transform.ag"(line 121, column 28) - _lhsOcollectedFields = - [] - -- use rule "Transform.ag"(line 146, column 31) - _lhsOcollectedInsts = - [] - -- use rule "Transform.ag"(line 82, column 50) - _lhsOcollectedNames = - _setIcollectedNames - -- use rule "Transform.ag"(line 144, column 31) - _lhsOcollectedRules = - [] - -- use rule "Transform.ag"(line 145, column 31) - _lhsOcollectedSigs = - [] - -- use rule "Transform.ag"(line 147, column 31) - _lhsOcollectedUniques = - [] - -- use rule "Transform.ag"(line 727, column 34) - _lhsOctxCollect = - Map.empty - -- use rule "Transform.ag"(line 752, column 33) - _lhsOderivings = - Map.empty - -- use rule "Transform.ag"(line 904, column 37) - _lhsOmoduleDecl = - mzero - -- use rule "Transform.ag"(line 704, column 37) - _lhsOparamsCollect = - Map.empty - -- use rule "Transform.ag"(line 600, column 34) - _lhsOpragmas = - id - -- use rule "Transform.ag"(line 644, column 56) - _lhsOsemPragmasCollect = - Map.empty - -- use rule "Transform.ag"(line 460, column 32) - _lhsOtypeSyns = - [] - -- use rule "Transform.ag"(line 133, column 15) - _lhsOuseMap = - Map.empty - -- use rule "Transform.ag"(line 591, 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,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))) ) -sem_Elem_Txt :: Pos -> - Identifier -> - (Maybe NontermIdent) -> - ([String]) -> - T_Elem -sem_Elem_Txt pos_ name_ mbNt_ 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) ]) - _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) - _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 170, column 10) - _blockInfo = - ( let nm = getName name_ - in if nm == "imports" - then BlockImport - else if nm == "optpragmas" - then BlockPragma - else BlockOther - , mbNt_ - ) - -- "Transform.ag"(line 178, column 10) - _blockValue = - [(lines_, pos_)] - -- "Transform.ag"(line 179, column 10) - _lhsOblocks = - Map.singleton _blockInfo _blockValue - -- use rule "Transform.ag"(line 672, column 55) - _lhsOattrOrderCollect = - Map.empty - -- use rule "Transform.ag"(line 90, column 48) - _lhsOcollectedConstructorsMap = - Map.empty - -- use rule "Transform.ag"(line 121, column 28) - _lhsOcollectedFields = - [] - -- use rule "Transform.ag"(line 146, column 31) - _lhsOcollectedInsts = - [] - -- use rule "Transform.ag"(line 82, column 50) - _lhsOcollectedNames = - Set.empty - -- use rule "Transform.ag"(line 144, column 31) - _lhsOcollectedRules = - [] - -- use rule "Transform.ag"(line 81, column 50) - _lhsOcollectedSetNames = - Set.empty - -- use rule "Transform.ag"(line 145, column 31) - _lhsOcollectedSigs = - [] - -- use rule "Transform.ag"(line 147, column 31) - _lhsOcollectedUniques = - [] - -- use rule "Transform.ag"(line 727, column 34) - _lhsOctxCollect = - Map.empty - -- use rule "Transform.ag"(line 752, column 33) - _lhsOderivings = - Map.empty - -- use rule "Transform.ag"(line 42, column 19) - _lhsOerrors = - Seq.empty - -- use rule "Transform.ag"(line 904, column 37) - _lhsOmoduleDecl = - mzero - -- use rule "Transform.ag"(line 704, column 37) - _lhsOparamsCollect = - Map.empty - -- use rule "Transform.ag"(line 600, column 34) - _lhsOpragmas = - id - -- use rule "Transform.ag"(line 644, column 56) - _lhsOsemPragmasCollect = - Map.empty - -- use rule "Transform.ag"(line 460, column 32) - _lhsOtypeSyns = - [] - -- use rule "Transform.ag"(line 133, column 15) - _lhsOuseMap = - Map.empty - -- use rule "Transform.ag"(line 591, 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,_lhsOcollectedUniques,_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) ]) - _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) - _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 232, column 10) - _lhsOcollectedFields = - map (\(x,y)->(name_, x, y)) _expanded - -- "Transform.ag"(line 419, column 11) - _lhsOcollectedNames = - Set.singleton name_ - -- "Transform.ag"(line 473, 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_, []) - ] - Either tp1 tp2 -> [ - (Ident "Left" pos_, [(Ident "left" pos_, tp1) ]) - , (Ident "Right" pos_, [(Ident "right" pos_, tp2) ]) - ] - Map tp1 tp2 -> [ (Ident "Entry" pos_, [ (Ident "key" pos_, tp1) - , (Ident "val" pos_, tp2) - , (Ident "tl" pos_, NT name_ (map getName params_)) - ]) - , (Ident "Nil" pos_, []) - ] - IntMap tp -> [ (Ident "Entry" pos_, [ (Ident "key" pos_, Haskell "Int") - , (Ident "val" pos_, tp) - , (Ident "tl" pos_, NT name_ (map getName params_)) - ]) - , (Ident "Nil" pos_, []) - ] - Tuple xs -> [(Ident "Tuple" pos_, xs)] - -- "Transform.ag"(line 502, column 11) - _argType = - case type_ of - Maybe tp -> Maybe ( makeType _lhsIallNonterminals tp) - Either tp1 tp2 -> Either ( makeType _lhsIallNonterminals tp1) (makeType _lhsIallNonterminals tp2) - List tp -> List ( makeType _lhsIallNonterminals tp) - Tuple xs -> Tuple [(f,makeType _lhsIallNonterminals tp) | (f,tp) <- xs] - Map tp1 tp2 -> Map ( makeType _lhsIallNonterminals tp1) (makeType _lhsIallNonterminals tp2) - IntMap tp -> IntMap ( makeType _lhsIallNonterminals tp) - -- "Transform.ag"(line 509, column 11) - _lhsOtypeSyns = - [(name_,_argType)] - -- "Transform.ag"(line 714, column 7) - _lhsOparamsCollect = - if null params_ - then Map.empty - else Map.singleton name_ params_ - -- "Transform.ag"(line 737, column 7) - _lhsOctxCollect = - if null ctx_ - then Map.empty - else Map.singleton name_ ctx_ - -- use rule "Transform.ag"(line 672, column 55) - _lhsOattrOrderCollect = - Map.empty - -- use rule "Transform.ag"(line 44, column 19) - _lhsOblocks = - Map.empty - -- use rule "Transform.ag"(line 90, column 48) - _lhsOcollectedConstructorsMap = - Map.empty - -- use rule "Transform.ag"(line 146, column 31) - _lhsOcollectedInsts = - [] - -- use rule "Transform.ag"(line 144, column 31) - _lhsOcollectedRules = - [] - -- use rule "Transform.ag"(line 81, column 50) - _lhsOcollectedSetNames = - Set.empty - -- use rule "Transform.ag"(line 145, column 31) - _lhsOcollectedSigs = - [] - -- use rule "Transform.ag"(line 147, column 31) - _lhsOcollectedUniques = - [] - -- use rule "Transform.ag"(line 752, column 33) - _lhsOderivings = - Map.empty - -- use rule "Transform.ag"(line 42, column 19) - _lhsOerrors = - Seq.empty - -- use rule "Transform.ag"(line 904, column 37) - _lhsOmoduleDecl = - mzero - -- use rule "Transform.ag"(line 600, column 34) - _lhsOpragmas = - id - -- use rule "Transform.ag"(line 644, column 56) - _lhsOsemPragmasCollect = - Map.empty - -- use rule "Transform.ag"(line 133, column 15) - _lhsOuseMap = - Map.empty - -- use rule "Transform.ag"(line 591, 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,_lhsOcollectedUniques,_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) ]) - _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) - _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 594, column 13) - _lhsOwrappers = - _setInontSet - -- use rule "Transform.ag"(line 672, column 55) - _lhsOattrOrderCollect = - Map.empty - -- use rule "Transform.ag"(line 44, column 19) - _lhsOblocks = - Map.empty - -- use rule "Transform.ag"(line 90, column 48) - _lhsOcollectedConstructorsMap = - Map.empty - -- use rule "Transform.ag"(line 121, column 28) - _lhsOcollectedFields = - [] - -- use rule "Transform.ag"(line 146, column 31) - _lhsOcollectedInsts = - [] - -- use rule "Transform.ag"(line 82, column 50) - _lhsOcollectedNames = - _setIcollectedNames - -- use rule "Transform.ag"(line 144, column 31) - _lhsOcollectedRules = - [] - -- use rule "Transform.ag"(line 81, column 50) - _lhsOcollectedSetNames = - Set.empty - -- use rule "Transform.ag"(line 145, column 31) - _lhsOcollectedSigs = - [] - -- use rule "Transform.ag"(line 147, column 31) - _lhsOcollectedUniques = - [] - -- use rule "Transform.ag"(line 727, column 34) - _lhsOctxCollect = - Map.empty - -- use rule "Transform.ag"(line 752, column 33) - _lhsOderivings = - Map.empty - -- use rule "Transform.ag"(line 42, column 19) - _lhsOerrors = - _setIerrors - -- use rule "Transform.ag"(line 904, column 37) - _lhsOmoduleDecl = - mzero - -- use rule "Transform.ag"(line 704, column 37) - _lhsOparamsCollect = - Map.empty - -- use rule "Transform.ag"(line 600, column 34) - _lhsOpragmas = - id - -- use rule "Transform.ag"(line 644, column 56) - _lhsOsemPragmasCollect = - Map.empty - -- use rule "Transform.ag"(line 460, column 32) - _lhsOtypeSyns = - [] - -- use rule "Transform.ag"(line 133, 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,_lhsOcollectedUniques,_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) ] - collectedUniques : [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ] - 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) ]),([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),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) ]),collectedUniques_Syn_Elems :: !([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),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 -> - Inh_Elems -> - Syn_Elems -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,_lhsOcollectedUniques,_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 _lhsOcollectedUniques _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) ]) - _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) - _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) ]) - _hdIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) - _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) ]) - _tlIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) - _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 672, column 55) - _lhsOattrOrderCollect = - _hdIattrOrderCollect `orderMapUnion` _tlIattrOrderCollect - -- use rule "Transform.ag"(line 44, column 19) - _lhsOblocks = - _hdIblocks `mapUnionWithPlusPlus` _tlIblocks - -- use rule "Transform.ag"(line 90, column 48) - _lhsOcollectedConstructorsMap = - _hdIcollectedConstructorsMap `mapUnionWithSetUnion` _tlIcollectedConstructorsMap - -- use rule "Transform.ag"(line 121, column 28) - _lhsOcollectedFields = - _hdIcollectedFields ++ _tlIcollectedFields - -- use rule "Transform.ag"(line 146, column 31) - _lhsOcollectedInsts = - _hdIcollectedInsts ++ _tlIcollectedInsts - -- use rule "Transform.ag"(line 82, column 50) - _lhsOcollectedNames = - _hdIcollectedNames `Set.union` _tlIcollectedNames - -- use rule "Transform.ag"(line 144, column 31) - _lhsOcollectedRules = - _hdIcollectedRules ++ _tlIcollectedRules - -- use rule "Transform.ag"(line 81, column 50) - _lhsOcollectedSetNames = - _hdIcollectedSetNames `Set.union` _tlIcollectedSetNames - -- use rule "Transform.ag"(line 145, column 31) - _lhsOcollectedSigs = - _hdIcollectedSigs ++ _tlIcollectedSigs - -- use rule "Transform.ag"(line 147, column 31) - _lhsOcollectedUniques = - _hdIcollectedUniques ++ _tlIcollectedUniques - -- use rule "Transform.ag"(line 727, column 34) - _lhsOctxCollect = - _hdIctxCollect `mergeCtx` _tlIctxCollect - -- use rule "Transform.ag"(line 752, column 33) - _lhsOderivings = - _hdIderivings `mergeDerivings` _tlIderivings - -- use rule "Transform.ag"(line 42, column 19) - _lhsOerrors = - _hdIerrors Seq.>< _tlIerrors - -- use rule "Transform.ag"(line 904, column 37) - _lhsOmoduleDecl = - _hdImoduleDecl `mplus` _tlImoduleDecl - -- use rule "Transform.ag"(line 704, column 37) - _lhsOparamsCollect = - _hdIparamsCollect `mergeParams` _tlIparamsCollect - -- use rule "Transform.ag"(line 600, column 34) - _lhsOpragmas = - _hdIpragmas . _tlIpragmas - -- use rule "Transform.ag"(line 644, column 56) - _lhsOsemPragmasCollect = - _hdIsemPragmasCollect `pragmaMapUnion` _tlIsemPragmasCollect - -- use rule "Transform.ag"(line 460, column 32) - _lhsOtypeSyns = - _hdItypeSyns ++ _tlItypeSyns - -- use rule "Transform.ag"(line 133, column 15) - _lhsOuseMap = - _hdIuseMap `merge` _tlIuseMap - -- use rule "Transform.ag"(line 591, 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,_hdIcollectedUniques,_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,_tlIcollectedUniques,_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,_lhsOcollectedUniques,_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) ]) - _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) - _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 672, column 55) - _lhsOattrOrderCollect = - Map.empty - -- use rule "Transform.ag"(line 44, column 19) - _lhsOblocks = - Map.empty - -- use rule "Transform.ag"(line 90, column 48) - _lhsOcollectedConstructorsMap = - Map.empty - -- use rule "Transform.ag"(line 121, column 28) - _lhsOcollectedFields = - [] - -- use rule "Transform.ag"(line 146, column 31) - _lhsOcollectedInsts = - [] - -- use rule "Transform.ag"(line 82, column 50) - _lhsOcollectedNames = - Set.empty - -- use rule "Transform.ag"(line 144, column 31) - _lhsOcollectedRules = - [] - -- use rule "Transform.ag"(line 81, column 50) - _lhsOcollectedSetNames = - Set.empty - -- use rule "Transform.ag"(line 145, column 31) - _lhsOcollectedSigs = - [] - -- use rule "Transform.ag"(line 147, column 31) - _lhsOcollectedUniques = - [] - -- use rule "Transform.ag"(line 727, column 34) - _lhsOctxCollect = - Map.empty - -- use rule "Transform.ag"(line 752, column 33) - _lhsOderivings = - Map.empty - -- use rule "Transform.ag"(line 42, column 19) - _lhsOerrors = - Seq.empty - -- use rule "Transform.ag"(line 904, column 37) - _lhsOmoduleDecl = - mzero - -- use rule "Transform.ag"(line 704, column 37) - _lhsOparamsCollect = - Map.empty - -- use rule "Transform.ag"(line 600, column 34) - _lhsOpragmas = - id - -- use rule "Transform.ag"(line 644, column 56) - _lhsOsemPragmasCollect = - Map.empty - -- use rule "Transform.ag"(line 460, column 32) - _lhsOtypeSyns = - [] - -- use rule "Transform.ag"(line 133, column 15) - _lhsOuseMap = - Map.empty - -- use rule "Transform.ag"(line 591, 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,_lhsOcollectedUniques,_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 -> - Inh_NontSet -> - Syn_NontSet -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 537, column 16) - _lhsOnontSet = - _lhsIallNonterminals - -- use rule "Transform.ag"(line 82, column 50) - _lhsOcollectedNames = - Set.empty - -- use rule "Transform.ag"(line 42, 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 543, column 16) - _lhsOnontSet = - Set.difference _set1InontSet _set2InontSet - -- use rule "Transform.ag"(line 82, column 50) - _lhsOcollectedNames = - _set1IcollectedNames `Set.union` _set2IcollectedNames - -- use rule "Transform.ag"(line 42, 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 542, column 16) - _lhsOnontSet = - Set.intersection _set1InontSet _set2InontSet - -- use rule "Transform.ag"(line 82, column 50) - _lhsOcollectedNames = - _set1IcollectedNames `Set.union` _set2IcollectedNames - -- use rule "Transform.ag"(line 42, 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 422, column 14) - _lhsOcollectedNames = - Set.singleton name_ - -- "Transform.ag"(line 538, column 20) - __tup4 = - case Map.lookup name_ _lhsIdefinedSets of - Nothing -> (Set.empty, Seq.singleton (UndefNont name_)) - Just set -> (set, Seq.empty) - -- "Transform.ag"(line 538, column 20) - (_nontSet,_) = - __tup4 - -- "Transform.ag"(line 538, column 20) - (_,_errors) = - __tup4 - -- use rule "Transform.ag"(line 42, 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 544, column 16) - _lhsOnontSet = - let table = flattenDatas _lhsIallFields - in path table from_ to_ - -- "Transform.ag"(line 546, column 16) - _lhsOerrors = - let check name | Set.member name _lhsIallNonterminals - = Seq.empty - | otherwise = Seq.singleton (UndefNont name) - in check from_ >< check to_ - -- use rule "Transform.ag"(line 82, 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 541, column 16) - _lhsOnontSet = - Set.union _set1InontSet _set2InontSet - -- use rule "Transform.ag"(line 82, column 50) - _lhsOcollectedNames = - _set1IcollectedNames `Set.union` _set2IcollectedNames - -- use rule "Transform.ag"(line 42, 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 -> - Inh_Pattern -> - Syn_Pattern -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 880, column 11) - _lhsOdefinedAttrs = - (field_, attr_) : _patIdefinedAttrs - -- "Transform.ag"(line 881, column 11) - _lhsOpatunder = - \us -> if ((field_,attr_) `elem` us) then Underscore noPos else _copy - -- "Transform.ag"(line 882, column 11) - _lhsOdefinedInsts = - (if field_ == _INST then [attr_] else []) ++ _patIdefinedInsts - -- "Transform.ag"(line 897, 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 884, column 12) - _lhsOpatunder = - \us -> Constr name_ (_patsIpatunder us) - -- "Transform.ag"(line 895, column 16) - _lhsOstpos = - getPos name_ - -- use rule "Transform.ag"(line 875, column 42) - _lhsOdefinedAttrs = - _patsIdefinedAttrs - -- use rule "Transform.ag"(line 874, 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 886, column 17) - _lhsOpatunder = - \us -> Irrefutable (_patIpatunder us) - -- use rule "Transform.ag"(line 875, column 42) - _lhsOdefinedAttrs = - _patIdefinedAttrs - -- use rule "Transform.ag"(line 874, 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 885, column 13) - _lhsOpatunder = - \us -> Product pos_ (_patsIpatunder us) - -- "Transform.ag"(line 896, column 16) - _lhsOstpos = - pos_ - -- use rule "Transform.ag"(line 875, column 42) - _lhsOdefinedAttrs = - _patsIdefinedAttrs - -- use rule "Transform.ag"(line 874, 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 883, column 16) - _lhsOpatunder = - \us -> _copy - -- "Transform.ag"(line 898, column 16) - _lhsOstpos = - pos_ - -- use rule "Transform.ag"(line 875, column 42) - _lhsOdefinedAttrs = - [] - -- use rule "Transform.ag"(line 874, 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 -> - Inh_Patterns -> - Syn_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 890, column 10) - _lhsOpatunder = - \us -> (_hdIpatunder us) : (_tlIpatunder us) - -- use rule "Transform.ag"(line 875, column 42) - _lhsOdefinedAttrs = - _hdIdefinedAttrs ++ _tlIdefinedAttrs - -- use rule "Transform.ag"(line 874, 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 889, column 9) - _lhsOpatunder = - \us -> [] - -- use rule "Transform.ag"(line 875, column 42) - _lhsOdefinedAttrs = - [] - -- use rule "Transform.ag"(line 874, 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) ] - collectedUniques : [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ] - 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) ]),([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),(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) ]),collectedUniques_Syn_SemAlt :: !([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),errors_Syn_SemAlt :: !(Seq Error),semPragmasCollect_Syn_SemAlt :: !(PragmaMap)} -wrap_SemAlt :: T_SemAlt -> - Inh_SemAlt -> - Syn_SemAlt -wrap_SemAlt (T_SemAlt sem ) (Inh_SemAlt _lhsIallAttrDecls _lhsIallFields _lhsInts ) = - (let ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOerrors,_lhsOsemPragmasCollect) = - (sem _lhsIallAttrDecls _lhsIallFields _lhsInts ) - in (Syn_SemAlt _lhsOattrOrderCollect _lhsOcollectedInsts _lhsOcollectedRules _lhsOcollectedSigs _lhsOcollectedUniques _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]) ]) - _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) - _constructorSetIcollectedConstructorNames :: (Set ConstructorIdent) - _constructorSetIconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) - _constructorSetIerrors :: (Seq Error) - _rulesIdefinedInsts :: ([Identifier]) - _rulesIorderDepsCollect :: (Set Dependency) - _rulesIpragmaNamesCollect :: ([Identifier]) - _rulesIruleInfos :: ([RuleInfo]) - _rulesIsigInfos :: ([SigInfo]) - _rulesIuniqueInfos :: ([UniqueInfo]) - -- "Transform.ag"(line 648, column 7) - _pragmaNames = - Set.fromList _rulesIpragmaNamesCollect - -- "Transform.ag"(line 649, column 7) - _lhsOsemPragmasCollect = - foldr pragmaMapUnion Map.empty [ pragmaMapSingle nt con _pragmaNames - | (nt, conset, _) <- _coninfo - , con <- Set.toList conset - ] - -- "Transform.ag"(line 677, column 7) - _attrOrders = - [ orderMapSingle nt con _rulesIorderDepsCollect - | (nt, conset, _) <- _coninfo - , con <- Set.toList conset - ] - -- "Transform.ag"(line 683, column 7) - _lhsOattrOrderCollect = - foldr orderMapUnion Map.empty _attrOrders - -- "Transform.ag"(line 826, 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 833, column 12) - _lhsOerrors = - Seq.fromList - [ UndefAlt nt con - | (nt, conset, conkeys) <- _coninfo - , con <- Set.toList (Set.difference conset conkeys) - ] - -- "Transform.ag"(line 838, column 12) - _lhsOcollectedRules = - [ (nt,con,r) - | (nt, conset, _) <- _coninfo - , con <- Set.toList conset - , r <- _rulesIruleInfos - ] - -- "Transform.ag"(line 844, column 12) - _lhsOcollectedSigs = - [ (nt,con,ts) - | (nt, conset, _) <- _coninfo - , con <- Set.toList conset - , ts <- _rulesIsigInfos - ] - -- "Transform.ag"(line 851, column 12) - _lhsOcollectedInsts = - [ (nt,con,_rulesIdefinedInsts) - | (nt, conset, _) <- _coninfo - , con <- Set.toList conset - ] - -- "Transform.ag"(line 857, column 12) - _lhsOcollectedUniques = - [ (nt,con,_rulesIuniqueInfos) - | (nt, conset, _) <- _coninfo - , con <- Set.toList conset - ] - ( _constructorSetIcollectedConstructorNames,_constructorSetIconstructors,_constructorSetIerrors) = - (constructorSet_ ) - ( _rulesIdefinedInsts,_rulesIorderDepsCollect,_rulesIpragmaNamesCollect,_rulesIruleInfos,_rulesIsigInfos,_rulesIuniqueInfos) = - (rules_ ) - in ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_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) ] - collectedUniques : [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ] - 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) ]),([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),(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) ]),collectedUniques_Syn_SemAlts :: !([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),errors_Syn_SemAlts :: !(Seq Error),semPragmasCollect_Syn_SemAlts :: !(PragmaMap)} -wrap_SemAlts :: T_SemAlts -> - Inh_SemAlts -> - Syn_SemAlts -wrap_SemAlts (T_SemAlts sem ) (Inh_SemAlts _lhsIallAttrDecls _lhsIallFields _lhsInts ) = - (let ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOerrors,_lhsOsemPragmasCollect) = - (sem _lhsIallAttrDecls _lhsIallFields _lhsInts ) - in (Syn_SemAlts _lhsOattrOrderCollect _lhsOcollectedInsts _lhsOcollectedRules _lhsOcollectedSigs _lhsOcollectedUniques _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) ]) - _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) - _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) ]) - _hdIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) - _hdIerrors :: (Seq Error) - _hdIsemPragmasCollect :: PragmaMap - _tlIattrOrderCollect :: AttrOrderMap - _tlIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _tlIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) - _tlIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) - _tlIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) - _tlIerrors :: (Seq Error) - _tlIsemPragmasCollect :: PragmaMap - -- use rule "Transform.ag"(line 672, column 55) - _lhsOattrOrderCollect = - _hdIattrOrderCollect `orderMapUnion` _tlIattrOrderCollect - -- use rule "Transform.ag"(line 146, column 31) - _lhsOcollectedInsts = - _hdIcollectedInsts ++ _tlIcollectedInsts - -- use rule "Transform.ag"(line 144, column 31) - _lhsOcollectedRules = - _hdIcollectedRules ++ _tlIcollectedRules - -- use rule "Transform.ag"(line 145, column 31) - _lhsOcollectedSigs = - _hdIcollectedSigs ++ _tlIcollectedSigs - -- use rule "Transform.ag"(line 147, column 31) - _lhsOcollectedUniques = - _hdIcollectedUniques ++ _tlIcollectedUniques - -- use rule "Transform.ag"(line 42, column 19) - _lhsOerrors = - _hdIerrors Seq.>< _tlIerrors - -- use rule "Transform.ag"(line 644, 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,_hdIcollectedUniques,_hdIerrors,_hdIsemPragmasCollect) = - (hd_ _hdOallAttrDecls _hdOallFields _hdOnts ) - ( _tlIattrOrderCollect,_tlIcollectedInsts,_tlIcollectedRules,_tlIcollectedSigs,_tlIcollectedUniques,_tlIerrors,_tlIsemPragmasCollect) = - (tl_ _tlOallAttrDecls _tlOallFields _tlOnts ) - in ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_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) ]) - _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) - _lhsOerrors :: (Seq Error) - _lhsOsemPragmasCollect :: PragmaMap - -- use rule "Transform.ag"(line 672, column 55) - _lhsOattrOrderCollect = - Map.empty - -- use rule "Transform.ag"(line 146, column 31) - _lhsOcollectedInsts = - [] - -- use rule "Transform.ag"(line 144, column 31) - _lhsOcollectedRules = - [] - -- use rule "Transform.ag"(line 145, column 31) - _lhsOcollectedSigs = - [] - -- use rule "Transform.ag"(line 147, column 31) - _lhsOcollectedUniques = - [] - -- use rule "Transform.ag"(line 42, column 19) - _lhsOerrors = - Seq.empty - -- use rule "Transform.ag"(line 644, column 56) - _lhsOsemPragmasCollect = - Map.empty - in ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOerrors,_lhsOsemPragmasCollect))) ) --- SemDef ------------------------------------------------------ -{- - visit 0: - synthesized attributes: - definedInsts : [Identifier] - orderDepsCollect : Set Dependency - pragmaNamesCollect : [Identifier] - ruleInfos : [RuleInfo] - sigInfos : [SigInfo] - uniqueInfos : [UniqueInfo] - 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} - alternative UniqueDef: - child ident : {Identifier} - child ref : {Identifier} --} --- 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 ) -sem_SemDef (UniqueDef _ident _ref ) = - (sem_SemDef_UniqueDef _ident _ref ) --- semantic domain -newtype T_SemDef = T_SemDef (( ([Identifier]),(Set Dependency),([Identifier]),([RuleInfo]),([SigInfo]),([UniqueInfo]))) -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]),uniqueInfos_Syn_SemDef :: !([UniqueInfo])} -wrap_SemDef :: T_SemDef -> - Inh_SemDef -> - Syn_SemDef -wrap_SemDef (T_SemDef sem ) (Inh_SemDef ) = - (let ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos) = - (sem ) - in (Syn_SemDef _lhsOdefinedInsts _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos _lhsOuniqueInfos )) -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]) - _lhsOuniqueInfos :: ([UniqueInfo]) - -- "Transform.ag"(line 689, column 7) - _dependency = - [ Dependency b a | b <- before_, a <- after_ ] - -- "Transform.ag"(line 690, column 7) - _lhsOorderDepsCollect = - Set.fromList _dependency - -- use rule "Transform.ag"(line 874, column 55) - _lhsOdefinedInsts = - [] - -- use rule "Transform.ag"(line 654, column 46) - _lhsOpragmaNamesCollect = - [] - -- use rule "Transform.ag"(line 819, column 39) - _lhsOruleInfos = - [] - -- use rule "Transform.ag"(line 820, column 39) - _lhsOsigInfos = - [] - -- use rule "Transform.ag"(line 821, column 39) - _lhsOuniqueInfos = - [] - in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos)) ) -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]) - _lhsOuniqueInfos :: ([UniqueInfo]) - _patternIcopy :: Pattern - _patternIdefinedAttrs :: ([AttrName]) - _patternIdefinedInsts :: ([Identifier]) - _patternIpatunder :: ([AttrName]->Pattern) - _patternIstpos :: Pos - -- "Transform.ag"(line 865, column 10) - _lhsOruleInfos = - [ (_patternIpatunder, rhs_, _patternIdefinedAttrs, owrt_, show _patternIstpos) ] - -- use rule "Transform.ag"(line 874, column 55) - _lhsOdefinedInsts = - _patternIdefinedInsts - -- use rule "Transform.ag"(line 685, column 44) - _lhsOorderDepsCollect = - Set.empty - -- use rule "Transform.ag"(line 654, column 46) - _lhsOpragmaNamesCollect = - [] - -- use rule "Transform.ag"(line 820, column 39) - _lhsOsigInfos = - [] - -- use rule "Transform.ag"(line 821, column 39) - _lhsOuniqueInfos = - [] - ( _patternIcopy,_patternIdefinedAttrs,_patternIdefinedInsts,_patternIpatunder,_patternIstpos) = - (pattern_ ) - in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos)) ) -sem_SemDef_SemPragma :: ([NontermIdent]) -> - T_SemDef -sem_SemDef_SemPragma names_ = - (T_SemDef (let _lhsOpragmaNamesCollect :: ([Identifier]) - _lhsOdefinedInsts :: ([Identifier]) - _lhsOorderDepsCollect :: (Set Dependency) - _lhsOruleInfos :: ([RuleInfo]) - _lhsOsigInfos :: ([SigInfo]) - _lhsOuniqueInfos :: ([UniqueInfo]) - -- "Transform.ag"(line 658, column 7) - _lhsOpragmaNamesCollect = - names_ - -- use rule "Transform.ag"(line 874, column 55) - _lhsOdefinedInsts = - [] - -- use rule "Transform.ag"(line 685, column 44) - _lhsOorderDepsCollect = - Set.empty - -- use rule "Transform.ag"(line 819, column 39) - _lhsOruleInfos = - [] - -- use rule "Transform.ag"(line 820, column 39) - _lhsOsigInfos = - [] - -- use rule "Transform.ag"(line 821, column 39) - _lhsOuniqueInfos = - [] - in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos)) ) -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]) - _lhsOuniqueInfos :: ([UniqueInfo]) - -- "Transform.ag"(line 868, column 14) - _lhsOsigInfos = - [ (ident_, tp_) ] - -- use rule "Transform.ag"(line 874, column 55) - _lhsOdefinedInsts = - [] - -- use rule "Transform.ag"(line 685, column 44) - _lhsOorderDepsCollect = - Set.empty - -- use rule "Transform.ag"(line 654, column 46) - _lhsOpragmaNamesCollect = - [] - -- use rule "Transform.ag"(line 819, column 39) - _lhsOruleInfos = - [] - -- use rule "Transform.ag"(line 821, column 39) - _lhsOuniqueInfos = - [] - in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos)) ) -sem_SemDef_UniqueDef :: Identifier -> - Identifier -> - T_SemDef -sem_SemDef_UniqueDef ident_ ref_ = - (T_SemDef (let _lhsOuniqueInfos :: ([UniqueInfo]) - _lhsOdefinedInsts :: ([Identifier]) - _lhsOorderDepsCollect :: (Set Dependency) - _lhsOpragmaNamesCollect :: ([Identifier]) - _lhsOruleInfos :: ([RuleInfo]) - _lhsOsigInfos :: ([SigInfo]) - -- "Transform.ag"(line 871, column 16) - _lhsOuniqueInfos = - [ (ident_, ref_) ] - -- use rule "Transform.ag"(line 874, column 55) - _lhsOdefinedInsts = - [] - -- use rule "Transform.ag"(line 685, column 44) - _lhsOorderDepsCollect = - Set.empty - -- use rule "Transform.ag"(line 654, column 46) - _lhsOpragmaNamesCollect = - [] - -- use rule "Transform.ag"(line 819, column 39) - _lhsOruleInfos = - [] - -- use rule "Transform.ag"(line 820, column 39) - _lhsOsigInfos = - [] - in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos)) ) --- SemDefs ----------------------------------------------------- -{- - visit 0: - synthesized attributes: - definedInsts : [Identifier] - orderDepsCollect : Set Dependency - pragmaNamesCollect : [Identifier] - ruleInfos : [RuleInfo] - sigInfos : [SigInfo] - uniqueInfos : [UniqueInfo] - 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]),([UniqueInfo]))) -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]),uniqueInfos_Syn_SemDefs :: !([UniqueInfo])} -wrap_SemDefs :: T_SemDefs -> - Inh_SemDefs -> - Syn_SemDefs -wrap_SemDefs (T_SemDefs sem ) (Inh_SemDefs ) = - (let ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos) = - (sem ) - in (Syn_SemDefs _lhsOdefinedInsts _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos _lhsOuniqueInfos )) -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]) - _lhsOuniqueInfos :: ([UniqueInfo]) - _hdIdefinedInsts :: ([Identifier]) - _hdIorderDepsCollect :: (Set Dependency) - _hdIpragmaNamesCollect :: ([Identifier]) - _hdIruleInfos :: ([RuleInfo]) - _hdIsigInfos :: ([SigInfo]) - _hdIuniqueInfos :: ([UniqueInfo]) - _tlIdefinedInsts :: ([Identifier]) - _tlIorderDepsCollect :: (Set Dependency) - _tlIpragmaNamesCollect :: ([Identifier]) - _tlIruleInfos :: ([RuleInfo]) - _tlIsigInfos :: ([SigInfo]) - _tlIuniqueInfos :: ([UniqueInfo]) - -- use rule "Transform.ag"(line 874, column 55) - _lhsOdefinedInsts = - _hdIdefinedInsts ++ _tlIdefinedInsts - -- use rule "Transform.ag"(line 685, column 44) - _lhsOorderDepsCollect = - _hdIorderDepsCollect `Set.union` _tlIorderDepsCollect - -- use rule "Transform.ag"(line 654, column 46) - _lhsOpragmaNamesCollect = - _hdIpragmaNamesCollect ++ _tlIpragmaNamesCollect - -- use rule "Transform.ag"(line 819, column 39) - _lhsOruleInfos = - _hdIruleInfos ++ _tlIruleInfos - -- use rule "Transform.ag"(line 820, column 39) - _lhsOsigInfos = - _hdIsigInfos ++ _tlIsigInfos - -- use rule "Transform.ag"(line 821, column 39) - _lhsOuniqueInfos = - _hdIuniqueInfos ++ _tlIuniqueInfos - ( _hdIdefinedInsts,_hdIorderDepsCollect,_hdIpragmaNamesCollect,_hdIruleInfos,_hdIsigInfos,_hdIuniqueInfos) = - (hd_ ) - ( _tlIdefinedInsts,_tlIorderDepsCollect,_tlIpragmaNamesCollect,_tlIruleInfos,_tlIsigInfos,_tlIuniqueInfos) = - (tl_ ) - in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos)) ) -sem_SemDefs_Nil :: T_SemDefs -sem_SemDefs_Nil = - (T_SemDefs (let _lhsOdefinedInsts :: ([Identifier]) - _lhsOorderDepsCollect :: (Set Dependency) - _lhsOpragmaNamesCollect :: ([Identifier]) - _lhsOruleInfos :: ([RuleInfo]) - _lhsOsigInfos :: ([SigInfo]) - _lhsOuniqueInfos :: ([UniqueInfo]) - -- use rule "Transform.ag"(line 874, column 55) - _lhsOdefinedInsts = - [] - -- use rule "Transform.ag"(line 685, column 44) - _lhsOorderDepsCollect = - Set.empty - -- use rule "Transform.ag"(line 654, column 46) - _lhsOpragmaNamesCollect = - [] - -- use rule "Transform.ag"(line 819, column 39) - _lhsOruleInfos = - [] - -- use rule "Transform.ag"(line 820, column 39) - _lhsOsigInfos = - [] - -- use rule "Transform.ag"(line 821, column 39) - _lhsOuniqueInfos = - [] +++-- UUAGC 0.9.12 (Transform.ag)+module Transform where++import Control.Monad(mplus,mzero)+import List (partition, elem, nub,intersperse)+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 qualified Data.Sequence as Seq+import Data.Sequence(Seq, empty, (><),fromList)+import Data.Foldable(toList)+import UU.Scanner.Position(noPos)++import ConcreteSyntax+import AbstractSyntax+import ErrorMessages+import Patterns (Patterns(..),Pattern(..))+import Expression (Expression(..))+import HsToken++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) ++type UniqueInfo = (Identifier,Identifier) ++++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.singleton (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 UniquesAndErrors = (Map Identifier Identifier, 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.<|)) (DupRule nt con field attr2 attr) e, m, fa:u, bs)+ Nothing -> ( e, Map.insert fa owrt m, u, fa:bs)+ else (((Seq.<|)) (SuperfluousRule nt con field attr) e, m, fa:u, bs)+ _ -> (((Seq.<|)) (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.<|)) (DupSig nt con ide) errs)+ -- else if not (ide `elem` locattrdefs)+ -- then (sigs, ((Seq.<|)) (SupSig nt con ide) errs)+ else (TypeSig ide typ:sigs, errs)+ in foldr checkSig ([],Seq.empty) sis++checkInsts :: Set NontermIdent -> Map NontermIdent (Map ConstructorIdent [SigInfo]) -> NontermIdent -> ConstructorIdent -> [Identifier] -> InstsAndErrors+checkInsts allNts sigMap nt con+ = foldr (\inst (insts, errs) ->+ maybe (insts, Seq.singleton (MissingInstSig nt con inst) >< errs)+ (\info@(_, NT nm _) -> case nm `Set.member` allNts of+ True -> (info : insts, errs)+ False | take 2 (getName nm) == "T_" -> let nm' = Ident (drop 2 (getName nm)) (getPos nm)+ in case nm' `Set.member` allNts of+ True -> (info : insts, errs)+ False -> (insts, Seq.singleton (UndefNont nm') >< errs)+ | otherwise -> (insts, Seq.singleton (UndefNont nm) >< 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)++checkUniques :: Map NontermIdent (Attributes, Attributes) -> NontermIdent -> ConstructorIdent -> [UniqueInfo] -> UniquesAndErrors+checkUniques allAttrs nt con uniques+ = let checkUnique (ident,ref) (us,errs)+ = if ident `Map.member` us+ then (us, ((Seq.<|)) (DupUnique nt con ident) errs)+ else if Map.member ref inhs && Map.member ref syns+ then (Map.insert ident ref us, errs)+ else (us, ((Seq.<|)) (MissingUnique nt ref) errs)++ (inhs,syns) = Map.findWithDefault (Map.empty,Map.empty) nt allAttrs+ in foldr checkUnique (Map.empty, Seq.empty) uniques+++mkUniqueRules :: Options -> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) -> Map NontermIdent (Attributes,Attributes) -> NontermIdent -> ConstructorIdent -> Map Identifier Identifier -> [Rule]+mkUniqueRules opts allFields allAttrDecls nt con usMap+ = map apply groups+ where+ fields = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allFields)++ groups = Map.assocs $ Map.foldWithKey (\i r m -> Map.insertWith (++) r [i] m) Map.empty usMap+ apply (ref,us) = mkRule ref (findOutField ref) us+ findOutField ref = case [ chld | (chld,NT tp _) <- fields, tp `hasSyn` ref] of+ [] -> _LHS+ (x:_) -> x+ hasSyn tp ref = Map.member ref $ snd $ Map.findWithDefault (Map.empty,Map.empty) tp allAttrDecls+ mkRule ref outFld locAttrs+ = let pat = Product noPos (attr outFld ref : [attr _LOC u | u <- locAttrs ])+ rhs = Expression noPos $ wrap ref $ foldr gencase (finalout locAttrs) locAttrs+ -- [HsToken ("mkUniques" ++ show (length locAttrs) ++ " ") noPos, AGField _LHS ref noPos Nothing]+ in Rule pat rhs False "-- generated by the unique rule mechanism."+ attr fld a = Alias fld a (Underscore noPos) []+ gencase nm outp+ = h ("case " ++ uniqueDispenser opts ++ " __cont of { (__cont, " ++ getName nm ++ ") -> ") ++ outp ++ h "}"+ h s = [HsToken s noPos]+ finalout us = h ("(__cont, " ++ concat (intersperse "," (map getName us)) ++ ")")+ wrap ref inp = h "case " ++ [AGField _LHS ref noPos Nothing] ++ h " of { __cont | __cont `seq` True -> " ++ inp ++ h "}"+++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.singleton(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+ -> UniqueMap+ -> Grammar++constructGrammar nts ntParams gram attrs uses derivings wrappers allrules tsigs allinsts tsyns pragmaMap orderMap contextMap uniqueMap =+ 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 uniqueMap+++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 allUniques : _+ local allRulesErrs : _+ local allSigsErrs : _+ local allInstsErrs : _+ local allUniquesErrs : _+ local checkedRulesPre : _+ local checkedSigs : _+ local checkedInsts : _+ local checkedUniques : _+ local checkedRules : _+ local errs1 : _+ local errs2 : _+ local errs3 : _+ local errs4 : _+ local errs5 : _+ local errs6 : _+ local errs7 : _+ 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 ->+ Inh_AG ->+ Syn_AG +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) ])+ _elemsIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])+ _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 51, column 8)+ _lhsOoutput =+ constructGrammar _allNonterminals+ _elemsIparamsCollect+ _allFields+ _allAttrDecls+ _elemsIuseMap+ _elemsIderivings+ (if wrappers _lhsIoptions then _allNonterminals else _elemsIwrappers)+ _checkedRules+ _checkedSigs+ _checkedInsts+ _elemsItypeSyns+ _elemsIsemPragmasCollect+ _elemsIattrOrderCollect+ _elemsIctxCollect+ _checkedUniques+ -- "Transform.ag"(line 237, 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 240, column 10)+ _allConstrs =+ let f (nt,con,_) = Map.insertWith (++) nt [con]+ in foldr f (Map.empty) _elemsIcollectedFields+ -- "Transform.ag"(line 243, 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 246, column 10)+ _allSigs =+ let f (nt,con,t) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con [t])+ typeof nt r = Map.findWithDefault (Haskell "<unknown>") r $ fst $ Map.findWithDefault (Map.empty,Map.empty) nt _allAttrDecls+ in foldr f (Map.empty) ( _elemsIcollectedSigs+ ++ [ (nt, con, (ident,typeof nt ref)) | (nt, con, us) <- _elemsIcollectedUniques, (ident,ref) <- us ]+ )+ -- "Transform.ag"(line 252, 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 255, column 10)+ _allUniques =+ let f (nt,con,us) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con us)+ in foldr f (Map.empty) _elemsIcollectedUniques+ -- "Transform.ag"(line 258, column 10)+ _allRulesErrs =+ Map.mapWithKey (Map.mapWithKey . (checkRules _allAttrDecls _allFields _allInsts _allSigs )) _allRules+ -- "Transform.ag"(line 259, column 10)+ _allSigsErrs =+ Map.mapWithKey (Map.mapWithKey . (checkSigs )) _allSigs+ -- "Transform.ag"(line 260, column 10)+ _allInstsErrs =+ Map.mapWithKey (Map.mapWithKey . (checkInsts _allNonterminals _allSigs )) _allInsts+ -- "Transform.ag"(line 261, column 10)+ _allUniquesErrs =+ Map.mapWithKey (Map.mapWithKey . (checkUniques _allAttrDecls )) _allUniques+ -- "Transform.ag"(line 263, column 10)+ _checkedRulesPre =+ Map.map (Map.map fst) _allRulesErrs+ -- "Transform.ag"(line 264, column 10)+ _checkedSigs =+ Map.map (Map.map fst) _allSigsErrs+ -- "Transform.ag"(line 265, column 10)+ _checkedInsts =+ Map.map (Map.map fst) _allInstsErrs+ -- "Transform.ag"(line 266, column 10)+ _checkedUniques =+ Map.map (Map.map fst) _allUniquesErrs+ -- "Transform.ag"(line 267, column 10)+ _checkedRules =+ Map.unionWith (Map.unionWith (++)) _checkedRulesPre (Map.mapWithKey (Map.mapWithKey . (mkUniqueRules _lhsIoptions _allFields _allAttrDecls )) _checkedUniques )+ -- "Transform.ag"(line 269, column 10)+ _errs1 =+ let f = checkForDuplicates (DupSynonym)+ in Seq.fromList . f . map fst $ _elemsItypeSyns+ -- "Transform.ag"(line 272, 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 276, column 10)+ _errs3 =+ let f (nt,cons) = checkForDuplicates (DupAlt nt) cons+ in Seq.empty+ -- "Transform.ag"(line 280, column 10)+ _errs4 =+ let f m s = Map.fold ((><) . snd) s m+ in Map.fold f Seq.empty _allRulesErrs+ -- "Transform.ag"(line 283, column 10)+ _errs5 =+ let f m s = Map.fold ((><) . snd) s m+ in Map.fold f Seq.empty _allSigsErrs+ -- "Transform.ag"(line 286, column 10)+ _errs6 =+ let f m s = Map.fold ((><) . snd) s m+ in Map.fold f Seq.empty _allInstsErrs+ -- "Transform.ag"(line 289, column 10)+ _errs7 =+ let f m s = Map.fold ((><) . snd) s m+ in Map.fold f Seq.empty _allUniquesErrs+ -- "Transform.ag"(line 292, column 10)+ _lhsOerrors =+ _elemsIerrors >< _errs1 >< _errs2 >< _errs3 >< _errs4 >< _errs5 >< _errs6 >< _errs7+ -- "Transform.ag"(line 425, column 10)+ _allNonterminals =+ _elemsIcollectedNames `Set.difference` _elemsIcollectedSetNames+ -- "Transform.ag"(line 445, column 8)+ _elemsOallConstructors =+ _elemsIcollectedConstructorsMap+ -- "Transform.ag"(line 518, column 8)+ _elemsOdefSets =+ Map.fromList (map (\x->(x,(Set.singleton x, Set.empty))) (Set.toList _allNonterminals ))+ -- "Transform.ag"(line 519, column 8)+ _elemsOdefinedSets =+ Map.map fst _elemsIdefSets+ -- "Transform.ag"(line 771, column 8)+ _elemsOattrDecls =+ Map.empty+ -- "Transform.ag"(line 810, column 9)+ _allAttrDecls =+ if withSelf _lhsIoptions+ then foldr addSelf _elemsIattrDecls (Set.toList _allNonterminals )+ else _elemsIattrDecls+ -- use rule "Transform.ag"(line 44, column 19)+ _lhsOblocks =+ _elemsIblocks+ -- use rule "Transform.ag"(line 904, column 37)+ _lhsOmoduleDecl =+ _elemsImoduleDecl+ -- use rule "Transform.ag"(line 600, 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,_elemsIcollectedUniques,_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 ->+ Inh_Alt ->+ Syn_Alt +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 222, 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 89, 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 ->+ Inh_Alts ->+ Syn_Alts +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 89, column 62)+ _lhsOcollectedConstructorNames =+ _hdIcollectedConstructorNames `Set.union` _tlIcollectedConstructorNames+ -- use rule "Transform.ag"(line 121, 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 89, column 62)+ _lhsOcollectedConstructorNames =+ Set.empty+ -- use rule "Transform.ag"(line 121, 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 ->+ Inh_Attrs ->+ Syn_Attrs +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 779, column 15)+ __tup1 =+ checkAttrs _lhsIallFields (Set.toList _lhsInts) _inherited _synthesized _lhsIattrDecls+ -- "Transform.ag"(line 779, column 15)+ (_attrDecls,_) =+ __tup1+ -- "Transform.ag"(line 779, column 15)+ (_,_errors) =+ __tup1+ -- "Transform.ag"(line 781, 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 781, column 15)+ (_inherited,_,_) =+ __tup2+ -- "Transform.ag"(line 781, column 15)+ (_,_synthesized,_) =+ __tup2+ -- "Transform.ag"(line 781, column 15)+ (_,_,_useMap) =+ __tup2+ -- "Transform.ag"(line 789, column 11)+ _lhsOuseMap =+ Map.fromList (zip (Set.toList _lhsInts) (repeat _useMap))+ -- use rule "Transform.ag"(line 42, 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 ->+ Inh_ConstructorSet ->+ Syn_ConstructorSet +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 585, column 17)+ _lhsOconstructors =+ \ds -> ds+ -- use rule "Transform.ag"(line 89, column 62)+ _lhsOcollectedConstructorNames =+ Set.empty+ -- use rule "Transform.ag"(line 42, 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 584, column 17)+ _lhsOconstructors =+ \ds -> _set1Iconstructors ds `Set.difference` _set2Iconstructors ds+ -- use rule "Transform.ag"(line 89, column 62)+ _lhsOcollectedConstructorNames =+ _set1IcollectedConstructorNames `Set.union` _set2IcollectedConstructorNames+ -- use rule "Transform.ag"(line 42, 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 433, column 11)+ _lhsOcollectedConstructorNames =+ Set.singleton name_+ -- "Transform.ag"(line 582, column 17)+ _lhsOconstructors =+ \ds -> Set.singleton name_+ -- use rule "Transform.ag"(line 42, 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 583, column 17)+ _lhsOconstructors =+ \ds -> _set1Iconstructors ds `Set.union` _set2Iconstructors ds+ -- use rule "Transform.ag"(line 89, column 62)+ _lhsOcollectedConstructorNames =+ _set1IcollectedConstructorNames `Set.union` _set2IcollectedConstructorNames+ -- use rule "Transform.ag"(line 42, 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) ]+ collectedUniques : [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]+ 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 : {Identifier}+ child mbNt : {Maybe NontermIdent}+ child lines : {[String]}+ visit 0:+ local blockInfo : _+ local blockValue : _+ 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 _mbNt _lines ) =+ (sem_Elem_Txt _pos _name _mbNt _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) ]),([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),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) ]),collectedUniques_Syn_Elem :: !([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),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 ->+ Inh_Elem ->+ Syn_Elem +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,_lhsOcollectedUniques,_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 _lhsOcollectedUniques _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) ])+ _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])+ _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 731, column 7)+ _lhsOctxCollect =+ if null ctx_+ then Map.empty+ else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet]+ -- "Transform.ag"(line 775, column 10)+ _attrsOnts =+ _namesInontSet+ -- use rule "Transform.ag"(line 672, column 55)+ _lhsOattrOrderCollect =+ Map.empty+ -- use rule "Transform.ag"(line 44, column 19)+ _lhsOblocks =+ Map.empty+ -- use rule "Transform.ag"(line 90, column 48)+ _lhsOcollectedConstructorsMap =+ Map.empty+ -- use rule "Transform.ag"(line 121, column 28)+ _lhsOcollectedFields =+ []+ -- use rule "Transform.ag"(line 146, column 31)+ _lhsOcollectedInsts =+ []+ -- use rule "Transform.ag"(line 82, column 50)+ _lhsOcollectedNames =+ _namesIcollectedNames+ -- use rule "Transform.ag"(line 144, column 31)+ _lhsOcollectedRules =+ []+ -- use rule "Transform.ag"(line 81, column 50)+ _lhsOcollectedSetNames =+ Set.empty+ -- use rule "Transform.ag"(line 145, column 31)+ _lhsOcollectedSigs =+ []+ -- use rule "Transform.ag"(line 147, column 31)+ _lhsOcollectedUniques =+ []+ -- use rule "Transform.ag"(line 752, column 33)+ _lhsOderivings =+ Map.empty+ -- use rule "Transform.ag"(line 42, column 19)+ _lhsOerrors =+ _namesIerrors Seq.>< _attrsIerrors+ -- use rule "Transform.ag"(line 904, column 37)+ _lhsOmoduleDecl =+ mzero+ -- use rule "Transform.ag"(line 704, column 37)+ _lhsOparamsCollect =+ Map.empty+ -- use rule "Transform.ag"(line 600, column 34)+ _lhsOpragmas =+ id+ -- use rule "Transform.ag"(line 644, column 56)+ _lhsOsemPragmasCollect =+ Map.empty+ -- use rule "Transform.ag"(line 460, column 32)+ _lhsOtypeSyns =+ []+ -- use rule "Transform.ag"(line 133, column 15)+ _lhsOuseMap =+ _attrsIuseMap+ -- use rule "Transform.ag"(line 591, 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,_lhsOcollectedUniques,_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) ])+ _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])+ _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 160, column 10)+ _altsOnts =+ _namesInontSet+ -- "Transform.ag"(line 439, column 11)+ _lhsOcollectedConstructorsMap =+ Map.fromList+ [ (n, _altsIcollectedConstructorNames)+ | n <- Set.toList _namesInontSet+ ]+ -- "Transform.ag"(line 708, column 7)+ _lhsOparamsCollect =+ if null params_+ then Map.empty+ else Map.fromList [(nt, params_) | nt <- Set.toList _namesInontSet]+ -- "Transform.ag"(line 731, column 7)+ _lhsOctxCollect =+ if null ctx_+ then Map.empty+ else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet]+ -- "Transform.ag"(line 774, column 10)+ _attrsOnts =+ _namesInontSet+ -- use rule "Transform.ag"(line 672, column 55)+ _lhsOattrOrderCollect =+ Map.empty+ -- use rule "Transform.ag"(line 44, column 19)+ _lhsOblocks =+ Map.empty+ -- use rule "Transform.ag"(line 121, column 28)+ _lhsOcollectedFields =+ _altsIcollectedFields+ -- use rule "Transform.ag"(line 146, column 31)+ _lhsOcollectedInsts =+ []+ -- use rule "Transform.ag"(line 82, column 50)+ _lhsOcollectedNames =+ _namesIcollectedNames+ -- use rule "Transform.ag"(line 144, column 31)+ _lhsOcollectedRules =+ []+ -- use rule "Transform.ag"(line 81, column 50)+ _lhsOcollectedSetNames =+ Set.empty+ -- use rule "Transform.ag"(line 145, column 31)+ _lhsOcollectedSigs =+ []+ -- use rule "Transform.ag"(line 147, column 31)+ _lhsOcollectedUniques =+ []+ -- use rule "Transform.ag"(line 752, column 33)+ _lhsOderivings =+ Map.empty+ -- use rule "Transform.ag"(line 42, column 19)+ _lhsOerrors =+ _namesIerrors Seq.>< _attrsIerrors+ -- use rule "Transform.ag"(line 904, column 37)+ _lhsOmoduleDecl =+ mzero+ -- use rule "Transform.ag"(line 600, column 34)+ _lhsOpragmas =+ id+ -- use rule "Transform.ag"(line 644, column 56)+ _lhsOsemPragmasCollect =+ Map.empty+ -- use rule "Transform.ag"(line 460, column 32)+ _lhsOtypeSyns =+ []+ -- use rule "Transform.ag"(line 133, column 15)+ _lhsOuseMap =+ _attrsIuseMap+ -- use rule "Transform.ag"(line 591, 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,_lhsOcollectedUniques,_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) ])+ _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])+ _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 759, column 14)+ _lhsOderivings =+ Map.fromList [(nt,Set.fromList classes_) | nt <- Set.toList _setInontSet]+ -- use rule "Transform.ag"(line 672, column 55)+ _lhsOattrOrderCollect =+ Map.empty+ -- use rule "Transform.ag"(line 44, column 19)+ _lhsOblocks =+ Map.empty+ -- use rule "Transform.ag"(line 90, column 48)+ _lhsOcollectedConstructorsMap =+ Map.empty+ -- use rule "Transform.ag"(line 121, column 28)+ _lhsOcollectedFields =+ []+ -- use rule "Transform.ag"(line 146, column 31)+ _lhsOcollectedInsts =+ []+ -- use rule "Transform.ag"(line 82, column 50)+ _lhsOcollectedNames =+ _setIcollectedNames+ -- use rule "Transform.ag"(line 144, column 31)+ _lhsOcollectedRules =+ []+ -- use rule "Transform.ag"(line 81, column 50)+ _lhsOcollectedSetNames =+ Set.empty+ -- use rule "Transform.ag"(line 145, column 31)+ _lhsOcollectedSigs =+ []+ -- use rule "Transform.ag"(line 147, column 31)+ _lhsOcollectedUniques =+ []+ -- use rule "Transform.ag"(line 727, column 34)+ _lhsOctxCollect =+ Map.empty+ -- use rule "Transform.ag"(line 42, column 19)+ _lhsOerrors =+ _setIerrors+ -- use rule "Transform.ag"(line 904, column 37)+ _lhsOmoduleDecl =+ mzero+ -- use rule "Transform.ag"(line 704, column 37)+ _lhsOparamsCollect =+ Map.empty+ -- use rule "Transform.ag"(line 600, column 34)+ _lhsOpragmas =+ id+ -- use rule "Transform.ag"(line 644, column 56)+ _lhsOsemPragmasCollect =+ Map.empty+ -- use rule "Transform.ag"(line 460, column 32)+ _lhsOtypeSyns =+ []+ -- use rule "Transform.ag"(line 133, column 15)+ _lhsOuseMap =+ Map.empty+ -- use rule "Transform.ag"(line 591, 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,_lhsOcollectedUniques,_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) ])+ _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])+ _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 908, column 7)+ _lhsOmoduleDecl =+ Just (name_, exports_, imports_)+ -- use rule "Transform.ag"(line 672, column 55)+ _lhsOattrOrderCollect =+ Map.empty+ -- use rule "Transform.ag"(line 44, column 19)+ _lhsOblocks =+ Map.empty+ -- use rule "Transform.ag"(line 90, column 48)+ _lhsOcollectedConstructorsMap =+ Map.empty+ -- use rule "Transform.ag"(line 121, column 28)+ _lhsOcollectedFields =+ []+ -- use rule "Transform.ag"(line 146, column 31)+ _lhsOcollectedInsts =+ []+ -- use rule "Transform.ag"(line 82, column 50)+ _lhsOcollectedNames =+ Set.empty+ -- use rule "Transform.ag"(line 144, column 31)+ _lhsOcollectedRules =+ []+ -- use rule "Transform.ag"(line 81, column 50)+ _lhsOcollectedSetNames =+ Set.empty+ -- use rule "Transform.ag"(line 145, column 31)+ _lhsOcollectedSigs =+ []+ -- use rule "Transform.ag"(line 147, column 31)+ _lhsOcollectedUniques =+ []+ -- use rule "Transform.ag"(line 727, column 34)+ _lhsOctxCollect =+ Map.empty+ -- use rule "Transform.ag"(line 752, column 33)+ _lhsOderivings =+ Map.empty+ -- use rule "Transform.ag"(line 42, column 19)+ _lhsOerrors =+ Seq.empty+ -- use rule "Transform.ag"(line 704, column 37)+ _lhsOparamsCollect =+ Map.empty+ -- use rule "Transform.ag"(line 600, column 34)+ _lhsOpragmas =+ id+ -- use rule "Transform.ag"(line 644, column 56)+ _lhsOsemPragmasCollect =+ Map.empty+ -- use rule "Transform.ag"(line 460, column 32)+ _lhsOtypeSyns =+ []+ -- use rule "Transform.ag"(line 133, column 15)+ _lhsOuseMap =+ Map.empty+ -- use rule "Transform.ag"(line 591, 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,_lhsOcollectedUniques,_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) ])+ _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])+ _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 603, column 13)+ _lhsOpragmas =+ let mk n o = case getName n of+ "gencatas" -> o { folds = True }+ "nogencatas" -> o { folds = False }+ "gendatas" -> o { dataTypes = True }+ "nogendatas" -> o { dataTypes = False }+ "gensems" -> o { semfuns = True }+ "nogensems" -> o { semfuns = False }+ "gentypesigs" -> o { typeSigs = True }+ "nogentypesigs"-> o { typeSigs = False }+ "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 672, column 55)+ _lhsOattrOrderCollect =+ Map.empty+ -- use rule "Transform.ag"(line 44, column 19)+ _lhsOblocks =+ Map.empty+ -- use rule "Transform.ag"(line 90, column 48)+ _lhsOcollectedConstructorsMap =+ Map.empty+ -- use rule "Transform.ag"(line 121, column 28)+ _lhsOcollectedFields =+ []+ -- use rule "Transform.ag"(line 146, column 31)+ _lhsOcollectedInsts =+ []+ -- use rule "Transform.ag"(line 82, column 50)+ _lhsOcollectedNames =+ Set.empty+ -- use rule "Transform.ag"(line 144, column 31)+ _lhsOcollectedRules =+ []+ -- use rule "Transform.ag"(line 81, column 50)+ _lhsOcollectedSetNames =+ Set.empty+ -- use rule "Transform.ag"(line 145, column 31)+ _lhsOcollectedSigs =+ []+ -- use rule "Transform.ag"(line 147, column 31)+ _lhsOcollectedUniques =+ []+ -- use rule "Transform.ag"(line 727, column 34)+ _lhsOctxCollect =+ Map.empty+ -- use rule "Transform.ag"(line 752, column 33)+ _lhsOderivings =+ Map.empty+ -- use rule "Transform.ag"(line 42, column 19)+ _lhsOerrors =+ Seq.empty+ -- use rule "Transform.ag"(line 904, column 37)+ _lhsOmoduleDecl =+ mzero+ -- use rule "Transform.ag"(line 704, column 37)+ _lhsOparamsCollect =+ Map.empty+ -- use rule "Transform.ag"(line 644, column 56)+ _lhsOsemPragmasCollect =+ Map.empty+ -- use rule "Transform.ag"(line 460, column 32)+ _lhsOtypeSyns =+ []+ -- use rule "Transform.ag"(line 133, column 15)+ _lhsOuseMap =+ Map.empty+ -- use rule "Transform.ag"(line 591, 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,_lhsOcollectedUniques,_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) ])+ _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])+ _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) ])+ _altsIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])+ _altsIerrors :: (Seq Error)+ _altsIsemPragmasCollect :: PragmaMap+ -- "Transform.ag"(line 161, column 10)+ _altsOnts =+ _namesInontSet+ -- "Transform.ag"(line 731, column 7)+ _lhsOctxCollect =+ if null ctx_+ then Map.empty+ else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet]+ -- "Transform.ag"(line 776, column 10)+ _attrsOnts =+ _namesInontSet+ -- use rule "Transform.ag"(line 672, column 55)+ _lhsOattrOrderCollect =+ _altsIattrOrderCollect+ -- use rule "Transform.ag"(line 44, column 19)+ _lhsOblocks =+ Map.empty+ -- use rule "Transform.ag"(line 90, column 48)+ _lhsOcollectedConstructorsMap =+ Map.empty+ -- use rule "Transform.ag"(line 121, column 28)+ _lhsOcollectedFields =+ []+ -- use rule "Transform.ag"(line 146, column 31)+ _lhsOcollectedInsts =+ _altsIcollectedInsts+ -- use rule "Transform.ag"(line 82, column 50)+ _lhsOcollectedNames =+ _namesIcollectedNames+ -- use rule "Transform.ag"(line 144, column 31)+ _lhsOcollectedRules =+ _altsIcollectedRules+ -- use rule "Transform.ag"(line 81, column 50)+ _lhsOcollectedSetNames =+ Set.empty+ -- use rule "Transform.ag"(line 145, column 31)+ _lhsOcollectedSigs =+ _altsIcollectedSigs+ -- use rule "Transform.ag"(line 147, column 31)+ _lhsOcollectedUniques =+ _altsIcollectedUniques+ -- use rule "Transform.ag"(line 752, column 33)+ _lhsOderivings =+ Map.empty+ -- use rule "Transform.ag"(line 42, column 19)+ _lhsOerrors =+ _namesIerrors Seq.>< _attrsIerrors Seq.>< _altsIerrors+ -- use rule "Transform.ag"(line 904, column 37)+ _lhsOmoduleDecl =+ mzero+ -- use rule "Transform.ag"(line 704, column 37)+ _lhsOparamsCollect =+ Map.empty+ -- use rule "Transform.ag"(line 600, column 34)+ _lhsOpragmas =+ id+ -- use rule "Transform.ag"(line 644, column 56)+ _lhsOsemPragmasCollect =+ _altsIsemPragmasCollect+ -- use rule "Transform.ag"(line 460, column 32)+ _lhsOtypeSyns =+ []+ -- use rule "Transform.ag"(line 133, column 15)+ _lhsOuseMap =+ _attrsIuseMap+ -- use rule "Transform.ag"(line 591, 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,_altsIcollectedUniques,_altsIerrors,_altsIsemPragmasCollect) =+ (alts_ _altsOallAttrDecls _altsOallFields _altsOnts )+ in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_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) ])+ _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])+ _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 416, column 10)+ _lhsOcollectedSetNames =+ Set.singleton name_+ -- "Transform.ag"(line 523, 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.singleton(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 523, column 13)+ (_defSets2,_) =+ __tup3+ -- "Transform.ag"(line 523, column 13)+ (_,_errs) =+ __tup3+ -- "Transform.ag"(line 533, column 9)+ _lhsOdefSets =+ _defSets2+ -- "Transform.ag"(line 533, column 9)+ _lhsOerrors =+ _errs >< _setIerrors+ -- use rule "Transform.ag"(line 672, column 55)+ _lhsOattrOrderCollect =+ Map.empty+ -- use rule "Transform.ag"(line 44, column 19)+ _lhsOblocks =+ Map.empty+ -- use rule "Transform.ag"(line 90, column 48)+ _lhsOcollectedConstructorsMap =+ Map.empty+ -- use rule "Transform.ag"(line 121, column 28)+ _lhsOcollectedFields =+ []+ -- use rule "Transform.ag"(line 146, column 31)+ _lhsOcollectedInsts =+ []+ -- use rule "Transform.ag"(line 82, column 50)+ _lhsOcollectedNames =+ _setIcollectedNames+ -- use rule "Transform.ag"(line 144, column 31)+ _lhsOcollectedRules =+ []+ -- use rule "Transform.ag"(line 145, column 31)+ _lhsOcollectedSigs =+ []+ -- use rule "Transform.ag"(line 147, column 31)+ _lhsOcollectedUniques =+ []+ -- use rule "Transform.ag"(line 727, column 34)+ _lhsOctxCollect =+ Map.empty+ -- use rule "Transform.ag"(line 752, column 33)+ _lhsOderivings =+ Map.empty+ -- use rule "Transform.ag"(line 904, column 37)+ _lhsOmoduleDecl =+ mzero+ -- use rule "Transform.ag"(line 704, column 37)+ _lhsOparamsCollect =+ Map.empty+ -- use rule "Transform.ag"(line 600, column 34)+ _lhsOpragmas =+ id+ -- use rule "Transform.ag"(line 644, column 56)+ _lhsOsemPragmasCollect =+ Map.empty+ -- use rule "Transform.ag"(line 460, column 32)+ _lhsOtypeSyns =+ []+ -- use rule "Transform.ag"(line 133, column 15)+ _lhsOuseMap =+ Map.empty+ -- use rule "Transform.ag"(line 591, 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,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))) )+sem_Elem_Txt :: Pos ->+ Identifier ->+ (Maybe NontermIdent) ->+ ([String]) ->+ T_Elem +sem_Elem_Txt pos_ name_ mbNt_ 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) ])+ _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])+ _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 170, column 10)+ _blockInfo =+ ( let nm = getName name_+ in if nm == "imports"+ then BlockImport+ else if nm == "optpragmas"+ then BlockPragma+ else BlockOther+ , mbNt_+ )+ -- "Transform.ag"(line 178, column 10)+ _blockValue =+ [(lines_, pos_)]+ -- "Transform.ag"(line 179, column 10)+ _lhsOblocks =+ Map.singleton _blockInfo _blockValue+ -- use rule "Transform.ag"(line 672, column 55)+ _lhsOattrOrderCollect =+ Map.empty+ -- use rule "Transform.ag"(line 90, column 48)+ _lhsOcollectedConstructorsMap =+ Map.empty+ -- use rule "Transform.ag"(line 121, column 28)+ _lhsOcollectedFields =+ []+ -- use rule "Transform.ag"(line 146, column 31)+ _lhsOcollectedInsts =+ []+ -- use rule "Transform.ag"(line 82, column 50)+ _lhsOcollectedNames =+ Set.empty+ -- use rule "Transform.ag"(line 144, column 31)+ _lhsOcollectedRules =+ []+ -- use rule "Transform.ag"(line 81, column 50)+ _lhsOcollectedSetNames =+ Set.empty+ -- use rule "Transform.ag"(line 145, column 31)+ _lhsOcollectedSigs =+ []+ -- use rule "Transform.ag"(line 147, column 31)+ _lhsOcollectedUniques =+ []+ -- use rule "Transform.ag"(line 727, column 34)+ _lhsOctxCollect =+ Map.empty+ -- use rule "Transform.ag"(line 752, column 33)+ _lhsOderivings =+ Map.empty+ -- use rule "Transform.ag"(line 42, column 19)+ _lhsOerrors =+ Seq.empty+ -- use rule "Transform.ag"(line 904, column 37)+ _lhsOmoduleDecl =+ mzero+ -- use rule "Transform.ag"(line 704, column 37)+ _lhsOparamsCollect =+ Map.empty+ -- use rule "Transform.ag"(line 600, column 34)+ _lhsOpragmas =+ id+ -- use rule "Transform.ag"(line 644, column 56)+ _lhsOsemPragmasCollect =+ Map.empty+ -- use rule "Transform.ag"(line 460, column 32)+ _lhsOtypeSyns =+ []+ -- use rule "Transform.ag"(line 133, column 15)+ _lhsOuseMap =+ Map.empty+ -- use rule "Transform.ag"(line 591, 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,_lhsOcollectedUniques,_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) ])+ _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])+ _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 232, column 10)+ _lhsOcollectedFields =+ map (\(x,y)->(name_, x, y)) _expanded+ -- "Transform.ag"(line 419, column 11)+ _lhsOcollectedNames =+ Set.singleton name_+ -- "Transform.ag"(line 473, 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_, [])+ ]+ Either tp1 tp2 -> [+ (Ident "Left" pos_, [(Ident "left" pos_, tp1) ])+ , (Ident "Right" pos_, [(Ident "right" pos_, tp2) ])+ ]+ Map tp1 tp2 -> [ (Ident "Entry" pos_, [ (Ident "key" pos_, tp1)+ , (Ident "val" pos_, tp2)+ , (Ident "tl" pos_, NT name_ (map getName params_))+ ])+ , (Ident "Nil" pos_, [])+ ]+ IntMap tp -> [ (Ident "Entry" pos_, [ (Ident "key" pos_, Haskell "Int")+ , (Ident "val" pos_, tp)+ , (Ident "tl" pos_, NT name_ (map getName params_))+ ])+ , (Ident "Nil" pos_, [])+ ]+ Tuple xs -> [(Ident "Tuple" pos_, xs)]+ -- "Transform.ag"(line 502, column 11)+ _argType =+ case type_ of+ Maybe tp -> Maybe ( makeType _lhsIallNonterminals tp)+ Either tp1 tp2 -> Either ( makeType _lhsIallNonterminals tp1) (makeType _lhsIallNonterminals tp2)+ List tp -> List ( makeType _lhsIallNonterminals tp)+ Tuple xs -> Tuple [(f,makeType _lhsIallNonterminals tp) | (f,tp) <- xs]+ Map tp1 tp2 -> Map ( makeType _lhsIallNonterminals tp1) (makeType _lhsIallNonterminals tp2)+ IntMap tp -> IntMap ( makeType _lhsIallNonterminals tp)+ -- "Transform.ag"(line 509, column 11)+ _lhsOtypeSyns =+ [(name_,_argType)]+ -- "Transform.ag"(line 714, column 7)+ _lhsOparamsCollect =+ if null params_+ then Map.empty+ else Map.singleton name_ params_+ -- "Transform.ag"(line 737, column 7)+ _lhsOctxCollect =+ if null ctx_+ then Map.empty+ else Map.singleton name_ ctx_+ -- use rule "Transform.ag"(line 672, column 55)+ _lhsOattrOrderCollect =+ Map.empty+ -- use rule "Transform.ag"(line 44, column 19)+ _lhsOblocks =+ Map.empty+ -- use rule "Transform.ag"(line 90, column 48)+ _lhsOcollectedConstructorsMap =+ Map.empty+ -- use rule "Transform.ag"(line 146, column 31)+ _lhsOcollectedInsts =+ []+ -- use rule "Transform.ag"(line 144, column 31)+ _lhsOcollectedRules =+ []+ -- use rule "Transform.ag"(line 81, column 50)+ _lhsOcollectedSetNames =+ Set.empty+ -- use rule "Transform.ag"(line 145, column 31)+ _lhsOcollectedSigs =+ []+ -- use rule "Transform.ag"(line 147, column 31)+ _lhsOcollectedUniques =+ []+ -- use rule "Transform.ag"(line 752, column 33)+ _lhsOderivings =+ Map.empty+ -- use rule "Transform.ag"(line 42, column 19)+ _lhsOerrors =+ Seq.empty+ -- use rule "Transform.ag"(line 904, column 37)+ _lhsOmoduleDecl =+ mzero+ -- use rule "Transform.ag"(line 600, column 34)+ _lhsOpragmas =+ id+ -- use rule "Transform.ag"(line 644, column 56)+ _lhsOsemPragmasCollect =+ Map.empty+ -- use rule "Transform.ag"(line 133, column 15)+ _lhsOuseMap =+ Map.empty+ -- use rule "Transform.ag"(line 591, 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,_lhsOcollectedUniques,_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) ])+ _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])+ _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 594, column 13)+ _lhsOwrappers =+ _setInontSet+ -- use rule "Transform.ag"(line 672, column 55)+ _lhsOattrOrderCollect =+ Map.empty+ -- use rule "Transform.ag"(line 44, column 19)+ _lhsOblocks =+ Map.empty+ -- use rule "Transform.ag"(line 90, column 48)+ _lhsOcollectedConstructorsMap =+ Map.empty+ -- use rule "Transform.ag"(line 121, column 28)+ _lhsOcollectedFields =+ []+ -- use rule "Transform.ag"(line 146, column 31)+ _lhsOcollectedInsts =+ []+ -- use rule "Transform.ag"(line 82, column 50)+ _lhsOcollectedNames =+ _setIcollectedNames+ -- use rule "Transform.ag"(line 144, column 31)+ _lhsOcollectedRules =+ []+ -- use rule "Transform.ag"(line 81, column 50)+ _lhsOcollectedSetNames =+ Set.empty+ -- use rule "Transform.ag"(line 145, column 31)+ _lhsOcollectedSigs =+ []+ -- use rule "Transform.ag"(line 147, column 31)+ _lhsOcollectedUniques =+ []+ -- use rule "Transform.ag"(line 727, column 34)+ _lhsOctxCollect =+ Map.empty+ -- use rule "Transform.ag"(line 752, column 33)+ _lhsOderivings =+ Map.empty+ -- use rule "Transform.ag"(line 42, column 19)+ _lhsOerrors =+ _setIerrors+ -- use rule "Transform.ag"(line 904, column 37)+ _lhsOmoduleDecl =+ mzero+ -- use rule "Transform.ag"(line 704, column 37)+ _lhsOparamsCollect =+ Map.empty+ -- use rule "Transform.ag"(line 600, column 34)+ _lhsOpragmas =+ id+ -- use rule "Transform.ag"(line 644, column 56)+ _lhsOsemPragmasCollect =+ Map.empty+ -- use rule "Transform.ag"(line 460, column 32)+ _lhsOtypeSyns =+ []+ -- use rule "Transform.ag"(line 133, 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,_lhsOcollectedUniques,_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) ]+ collectedUniques : [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]+ 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) ]),([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),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) ]),collectedUniques_Syn_Elems :: !([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),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 ->+ Inh_Elems ->+ Syn_Elems +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,_lhsOcollectedUniques,_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 _lhsOcollectedUniques _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) ])+ _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])+ _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) ])+ _hdIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])+ _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) ])+ _tlIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])+ _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 672, column 55)+ _lhsOattrOrderCollect =+ _hdIattrOrderCollect `orderMapUnion` _tlIattrOrderCollect+ -- use rule "Transform.ag"(line 44, column 19)+ _lhsOblocks =+ _hdIblocks `mapUnionWithPlusPlus` _tlIblocks+ -- use rule "Transform.ag"(line 90, column 48)+ _lhsOcollectedConstructorsMap =+ _hdIcollectedConstructorsMap `mapUnionWithSetUnion` _tlIcollectedConstructorsMap+ -- use rule "Transform.ag"(line 121, column 28)+ _lhsOcollectedFields =+ _hdIcollectedFields ++ _tlIcollectedFields+ -- use rule "Transform.ag"(line 146, column 31)+ _lhsOcollectedInsts =+ _hdIcollectedInsts ++ _tlIcollectedInsts+ -- use rule "Transform.ag"(line 82, column 50)+ _lhsOcollectedNames =+ _hdIcollectedNames `Set.union` _tlIcollectedNames+ -- use rule "Transform.ag"(line 144, column 31)+ _lhsOcollectedRules =+ _hdIcollectedRules ++ _tlIcollectedRules+ -- use rule "Transform.ag"(line 81, column 50)+ _lhsOcollectedSetNames =+ _hdIcollectedSetNames `Set.union` _tlIcollectedSetNames+ -- use rule "Transform.ag"(line 145, column 31)+ _lhsOcollectedSigs =+ _hdIcollectedSigs ++ _tlIcollectedSigs+ -- use rule "Transform.ag"(line 147, column 31)+ _lhsOcollectedUniques =+ _hdIcollectedUniques ++ _tlIcollectedUniques+ -- use rule "Transform.ag"(line 727, column 34)+ _lhsOctxCollect =+ _hdIctxCollect `mergeCtx` _tlIctxCollect+ -- use rule "Transform.ag"(line 752, column 33)+ _lhsOderivings =+ _hdIderivings `mergeDerivings` _tlIderivings+ -- use rule "Transform.ag"(line 42, column 19)+ _lhsOerrors =+ _hdIerrors Seq.>< _tlIerrors+ -- use rule "Transform.ag"(line 904, column 37)+ _lhsOmoduleDecl =+ _hdImoduleDecl `mplus` _tlImoduleDecl+ -- use rule "Transform.ag"(line 704, column 37)+ _lhsOparamsCollect =+ _hdIparamsCollect `mergeParams` _tlIparamsCollect+ -- use rule "Transform.ag"(line 600, column 34)+ _lhsOpragmas =+ _hdIpragmas . _tlIpragmas+ -- use rule "Transform.ag"(line 644, column 56)+ _lhsOsemPragmasCollect =+ _hdIsemPragmasCollect `pragmaMapUnion` _tlIsemPragmasCollect+ -- use rule "Transform.ag"(line 460, column 32)+ _lhsOtypeSyns =+ _hdItypeSyns ++ _tlItypeSyns+ -- use rule "Transform.ag"(line 133, column 15)+ _lhsOuseMap =+ _hdIuseMap `merge` _tlIuseMap+ -- use rule "Transform.ag"(line 591, 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,_hdIcollectedUniques,_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,_tlIcollectedUniques,_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,_lhsOcollectedUniques,_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) ])+ _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])+ _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 672, column 55)+ _lhsOattrOrderCollect =+ Map.empty+ -- use rule "Transform.ag"(line 44, column 19)+ _lhsOblocks =+ Map.empty+ -- use rule "Transform.ag"(line 90, column 48)+ _lhsOcollectedConstructorsMap =+ Map.empty+ -- use rule "Transform.ag"(line 121, column 28)+ _lhsOcollectedFields =+ []+ -- use rule "Transform.ag"(line 146, column 31)+ _lhsOcollectedInsts =+ []+ -- use rule "Transform.ag"(line 82, column 50)+ _lhsOcollectedNames =+ Set.empty+ -- use rule "Transform.ag"(line 144, column 31)+ _lhsOcollectedRules =+ []+ -- use rule "Transform.ag"(line 81, column 50)+ _lhsOcollectedSetNames =+ Set.empty+ -- use rule "Transform.ag"(line 145, column 31)+ _lhsOcollectedSigs =+ []+ -- use rule "Transform.ag"(line 147, column 31)+ _lhsOcollectedUniques =+ []+ -- use rule "Transform.ag"(line 727, column 34)+ _lhsOctxCollect =+ Map.empty+ -- use rule "Transform.ag"(line 752, column 33)+ _lhsOderivings =+ Map.empty+ -- use rule "Transform.ag"(line 42, column 19)+ _lhsOerrors =+ Seq.empty+ -- use rule "Transform.ag"(line 904, column 37)+ _lhsOmoduleDecl =+ mzero+ -- use rule "Transform.ag"(line 704, column 37)+ _lhsOparamsCollect =+ Map.empty+ -- use rule "Transform.ag"(line 600, column 34)+ _lhsOpragmas =+ id+ -- use rule "Transform.ag"(line 644, column 56)+ _lhsOsemPragmasCollect =+ Map.empty+ -- use rule "Transform.ag"(line 460, column 32)+ _lhsOtypeSyns =+ []+ -- use rule "Transform.ag"(line 133, column 15)+ _lhsOuseMap =+ Map.empty+ -- use rule "Transform.ag"(line 591, 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,_lhsOcollectedUniques,_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 ->+ Inh_NontSet ->+ Syn_NontSet +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 537, column 16)+ _lhsOnontSet =+ _lhsIallNonterminals+ -- use rule "Transform.ag"(line 82, column 50)+ _lhsOcollectedNames =+ Set.empty+ -- use rule "Transform.ag"(line 42, 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 543, column 16)+ _lhsOnontSet =+ Set.difference _set1InontSet _set2InontSet+ -- use rule "Transform.ag"(line 82, column 50)+ _lhsOcollectedNames =+ _set1IcollectedNames `Set.union` _set2IcollectedNames+ -- use rule "Transform.ag"(line 42, 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 542, column 16)+ _lhsOnontSet =+ Set.intersection _set1InontSet _set2InontSet+ -- use rule "Transform.ag"(line 82, column 50)+ _lhsOcollectedNames =+ _set1IcollectedNames `Set.union` _set2IcollectedNames+ -- use rule "Transform.ag"(line 42, 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 422, column 14)+ _lhsOcollectedNames =+ Set.singleton name_+ -- "Transform.ag"(line 538, column 20)+ __tup4 =+ case Map.lookup name_ _lhsIdefinedSets of+ Nothing -> (Set.empty, Seq.singleton (UndefNont name_))+ Just set -> (set, Seq.empty)+ -- "Transform.ag"(line 538, column 20)+ (_nontSet,_) =+ __tup4+ -- "Transform.ag"(line 538, column 20)+ (_,_errors) =+ __tup4+ -- use rule "Transform.ag"(line 42, 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 544, column 16)+ _lhsOnontSet =+ let table = flattenDatas _lhsIallFields+ in path table from_ to_+ -- "Transform.ag"(line 546, column 16)+ _lhsOerrors =+ let check name | Set.member name _lhsIallNonterminals+ = Seq.empty+ | otherwise = Seq.singleton (UndefNont name)+ in check from_ >< check to_+ -- use rule "Transform.ag"(line 82, 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 541, column 16)+ _lhsOnontSet =+ Set.union _set1InontSet _set2InontSet+ -- use rule "Transform.ag"(line 82, column 50)+ _lhsOcollectedNames =+ _set1IcollectedNames `Set.union` _set2IcollectedNames+ -- use rule "Transform.ag"(line 42, 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 ->+ Inh_Pattern ->+ Syn_Pattern +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 880, column 11)+ _lhsOdefinedAttrs =+ (field_, attr_) : _patIdefinedAttrs+ -- "Transform.ag"(line 881, column 11)+ _lhsOpatunder =+ \us -> if ((field_,attr_) `elem` us) then Underscore noPos else _copy+ -- "Transform.ag"(line 882, column 11)+ _lhsOdefinedInsts =+ (if field_ == _INST then [attr_] else []) ++ _patIdefinedInsts+ -- "Transform.ag"(line 897, 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 884, column 12)+ _lhsOpatunder =+ \us -> Constr name_ (_patsIpatunder us)+ -- "Transform.ag"(line 895, column 16)+ _lhsOstpos =+ getPos name_+ -- use rule "Transform.ag"(line 875, column 42)+ _lhsOdefinedAttrs =+ _patsIdefinedAttrs+ -- use rule "Transform.ag"(line 874, 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 886, column 17)+ _lhsOpatunder =+ \us -> Irrefutable (_patIpatunder us)+ -- use rule "Transform.ag"(line 875, column 42)+ _lhsOdefinedAttrs =+ _patIdefinedAttrs+ -- use rule "Transform.ag"(line 874, 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 885, column 13)+ _lhsOpatunder =+ \us -> Product pos_ (_patsIpatunder us)+ -- "Transform.ag"(line 896, column 16)+ _lhsOstpos =+ pos_+ -- use rule "Transform.ag"(line 875, column 42)+ _lhsOdefinedAttrs =+ _patsIdefinedAttrs+ -- use rule "Transform.ag"(line 874, 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 883, column 16)+ _lhsOpatunder =+ \us -> _copy+ -- "Transform.ag"(line 898, column 16)+ _lhsOstpos =+ pos_+ -- use rule "Transform.ag"(line 875, column 42)+ _lhsOdefinedAttrs =+ []+ -- use rule "Transform.ag"(line 874, 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 ->+ Inh_Patterns ->+ Syn_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 890, column 10)+ _lhsOpatunder =+ \us -> (_hdIpatunder us) : (_tlIpatunder us)+ -- use rule "Transform.ag"(line 875, column 42)+ _lhsOdefinedAttrs =+ _hdIdefinedAttrs ++ _tlIdefinedAttrs+ -- use rule "Transform.ag"(line 874, 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 889, column 9)+ _lhsOpatunder =+ \us -> []+ -- use rule "Transform.ag"(line 875, column 42)+ _lhsOdefinedAttrs =+ []+ -- use rule "Transform.ag"(line 874, 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) ]+ collectedUniques : [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]+ 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) ]),([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),(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) ]),collectedUniques_Syn_SemAlt :: !([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),errors_Syn_SemAlt :: !(Seq Error),semPragmasCollect_Syn_SemAlt :: !(PragmaMap)}+wrap_SemAlt :: T_SemAlt ->+ Inh_SemAlt ->+ Syn_SemAlt +wrap_SemAlt (T_SemAlt sem ) (Inh_SemAlt _lhsIallAttrDecls _lhsIallFields _lhsInts ) =+ (let ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOerrors,_lhsOsemPragmasCollect) =+ (sem _lhsIallAttrDecls _lhsIallFields _lhsInts )+ in (Syn_SemAlt _lhsOattrOrderCollect _lhsOcollectedInsts _lhsOcollectedRules _lhsOcollectedSigs _lhsOcollectedUniques _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]) ])+ _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])+ _constructorSetIcollectedConstructorNames :: (Set ConstructorIdent)+ _constructorSetIconstructors :: ((Set ConstructorIdent->Set ConstructorIdent))+ _constructorSetIerrors :: (Seq Error)+ _rulesIdefinedInsts :: ([Identifier])+ _rulesIorderDepsCollect :: (Set Dependency)+ _rulesIpragmaNamesCollect :: ([Identifier])+ _rulesIruleInfos :: ([RuleInfo])+ _rulesIsigInfos :: ([SigInfo])+ _rulesIuniqueInfos :: ([UniqueInfo])+ -- "Transform.ag"(line 648, column 7)+ _pragmaNames =+ Set.fromList _rulesIpragmaNamesCollect+ -- "Transform.ag"(line 649, column 7)+ _lhsOsemPragmasCollect =+ foldr pragmaMapUnion Map.empty [ pragmaMapSingle nt con _pragmaNames+ | (nt, conset, _) <- _coninfo+ , con <- Set.toList conset+ ]+ -- "Transform.ag"(line 677, column 7)+ _attrOrders =+ [ orderMapSingle nt con _rulesIorderDepsCollect+ | (nt, conset, _) <- _coninfo+ , con <- Set.toList conset+ ]+ -- "Transform.ag"(line 683, column 7)+ _lhsOattrOrderCollect =+ foldr orderMapUnion Map.empty _attrOrders+ -- "Transform.ag"(line 826, 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 833, column 12)+ _lhsOerrors =+ Seq.fromList+ [ UndefAlt nt con+ | (nt, conset, conkeys) <- _coninfo+ , con <- Set.toList (Set.difference conset conkeys)+ ]+ -- "Transform.ag"(line 838, column 12)+ _lhsOcollectedRules =+ [ (nt,con,r)+ | (nt, conset, _) <- _coninfo+ , con <- Set.toList conset+ , r <- _rulesIruleInfos+ ]+ -- "Transform.ag"(line 844, column 12)+ _lhsOcollectedSigs =+ [ (nt,con,ts)+ | (nt, conset, _) <- _coninfo+ , con <- Set.toList conset+ , ts <- _rulesIsigInfos+ ]+ -- "Transform.ag"(line 851, column 12)+ _lhsOcollectedInsts =+ [ (nt,con,_rulesIdefinedInsts)+ | (nt, conset, _) <- _coninfo+ , con <- Set.toList conset+ ]+ -- "Transform.ag"(line 857, column 12)+ _lhsOcollectedUniques =+ [ (nt,con,_rulesIuniqueInfos)+ | (nt, conset, _) <- _coninfo+ , con <- Set.toList conset+ ]+ ( _constructorSetIcollectedConstructorNames,_constructorSetIconstructors,_constructorSetIerrors) =+ (constructorSet_ )+ ( _rulesIdefinedInsts,_rulesIorderDepsCollect,_rulesIpragmaNamesCollect,_rulesIruleInfos,_rulesIsigInfos,_rulesIuniqueInfos) =+ (rules_ )+ in ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_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) ]+ collectedUniques : [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]+ 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) ]),([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),(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) ]),collectedUniques_Syn_SemAlts :: !([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),errors_Syn_SemAlts :: !(Seq Error),semPragmasCollect_Syn_SemAlts :: !(PragmaMap)}+wrap_SemAlts :: T_SemAlts ->+ Inh_SemAlts ->+ Syn_SemAlts +wrap_SemAlts (T_SemAlts sem ) (Inh_SemAlts _lhsIallAttrDecls _lhsIallFields _lhsInts ) =+ (let ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOerrors,_lhsOsemPragmasCollect) =+ (sem _lhsIallAttrDecls _lhsIallFields _lhsInts )+ in (Syn_SemAlts _lhsOattrOrderCollect _lhsOcollectedInsts _lhsOcollectedRules _lhsOcollectedSigs _lhsOcollectedUniques _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) ])+ _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])+ _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) ])+ _hdIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])+ _hdIerrors :: (Seq Error)+ _hdIsemPragmasCollect :: PragmaMap+ _tlIattrOrderCollect :: AttrOrderMap+ _tlIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])+ _tlIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])+ _tlIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])+ _tlIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])+ _tlIerrors :: (Seq Error)+ _tlIsemPragmasCollect :: PragmaMap+ -- use rule "Transform.ag"(line 672, column 55)+ _lhsOattrOrderCollect =+ _hdIattrOrderCollect `orderMapUnion` _tlIattrOrderCollect+ -- use rule "Transform.ag"(line 146, column 31)+ _lhsOcollectedInsts =+ _hdIcollectedInsts ++ _tlIcollectedInsts+ -- use rule "Transform.ag"(line 144, column 31)+ _lhsOcollectedRules =+ _hdIcollectedRules ++ _tlIcollectedRules+ -- use rule "Transform.ag"(line 145, column 31)+ _lhsOcollectedSigs =+ _hdIcollectedSigs ++ _tlIcollectedSigs+ -- use rule "Transform.ag"(line 147, column 31)+ _lhsOcollectedUniques =+ _hdIcollectedUniques ++ _tlIcollectedUniques+ -- use rule "Transform.ag"(line 42, column 19)+ _lhsOerrors =+ _hdIerrors Seq.>< _tlIerrors+ -- use rule "Transform.ag"(line 644, 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,_hdIcollectedUniques,_hdIerrors,_hdIsemPragmasCollect) =+ (hd_ _hdOallAttrDecls _hdOallFields _hdOnts )+ ( _tlIattrOrderCollect,_tlIcollectedInsts,_tlIcollectedRules,_tlIcollectedSigs,_tlIcollectedUniques,_tlIerrors,_tlIsemPragmasCollect) =+ (tl_ _tlOallAttrDecls _tlOallFields _tlOnts )+ in ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_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) ])+ _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])+ _lhsOerrors :: (Seq Error)+ _lhsOsemPragmasCollect :: PragmaMap+ -- use rule "Transform.ag"(line 672, column 55)+ _lhsOattrOrderCollect =+ Map.empty+ -- use rule "Transform.ag"(line 146, column 31)+ _lhsOcollectedInsts =+ []+ -- use rule "Transform.ag"(line 144, column 31)+ _lhsOcollectedRules =+ []+ -- use rule "Transform.ag"(line 145, column 31)+ _lhsOcollectedSigs =+ []+ -- use rule "Transform.ag"(line 147, column 31)+ _lhsOcollectedUniques =+ []+ -- use rule "Transform.ag"(line 42, column 19)+ _lhsOerrors =+ Seq.empty+ -- use rule "Transform.ag"(line 644, column 56)+ _lhsOsemPragmasCollect =+ Map.empty+ in ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOerrors,_lhsOsemPragmasCollect))) )+-- SemDef ------------------------------------------------------+{-+ visit 0:+ synthesized attributes:+ definedInsts : [Identifier]+ orderDepsCollect : Set Dependency+ pragmaNamesCollect : [Identifier]+ ruleInfos : [RuleInfo]+ sigInfos : [SigInfo]+ uniqueInfos : [UniqueInfo]+ 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}+ alternative UniqueDef:+ child ident : {Identifier}+ child ref : {Identifier}+-}+-- 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 )+sem_SemDef (UniqueDef _ident _ref ) =+ (sem_SemDef_UniqueDef _ident _ref )+-- semantic domain+newtype T_SemDef = T_SemDef (( ([Identifier]),(Set Dependency),([Identifier]),([RuleInfo]),([SigInfo]),([UniqueInfo])))+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]),uniqueInfos_Syn_SemDef :: !([UniqueInfo])}+wrap_SemDef :: T_SemDef ->+ Inh_SemDef ->+ Syn_SemDef +wrap_SemDef (T_SemDef sem ) (Inh_SemDef ) =+ (let ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos) =+ (sem )+ in (Syn_SemDef _lhsOdefinedInsts _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos _lhsOuniqueInfos ))+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])+ _lhsOuniqueInfos :: ([UniqueInfo])+ -- "Transform.ag"(line 689, column 7)+ _dependency =+ [ Dependency b a | b <- before_, a <- after_ ]+ -- "Transform.ag"(line 690, column 7)+ _lhsOorderDepsCollect =+ Set.fromList _dependency+ -- use rule "Transform.ag"(line 874, column 55)+ _lhsOdefinedInsts =+ []+ -- use rule "Transform.ag"(line 654, column 46)+ _lhsOpragmaNamesCollect =+ []+ -- use rule "Transform.ag"(line 819, column 39)+ _lhsOruleInfos =+ []+ -- use rule "Transform.ag"(line 820, column 39)+ _lhsOsigInfos =+ []+ -- use rule "Transform.ag"(line 821, column 39)+ _lhsOuniqueInfos =+ []+ in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos)) )+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])+ _lhsOuniqueInfos :: ([UniqueInfo])+ _patternIcopy :: Pattern+ _patternIdefinedAttrs :: ([AttrName])+ _patternIdefinedInsts :: ([Identifier])+ _patternIpatunder :: ([AttrName]->Pattern)+ _patternIstpos :: Pos+ -- "Transform.ag"(line 865, column 10)+ _lhsOruleInfos =+ [ (_patternIpatunder, rhs_, _patternIdefinedAttrs, owrt_, show _patternIstpos) ]+ -- use rule "Transform.ag"(line 874, column 55)+ _lhsOdefinedInsts =+ _patternIdefinedInsts+ -- use rule "Transform.ag"(line 685, column 44)+ _lhsOorderDepsCollect =+ Set.empty+ -- use rule "Transform.ag"(line 654, column 46)+ _lhsOpragmaNamesCollect =+ []+ -- use rule "Transform.ag"(line 820, column 39)+ _lhsOsigInfos =+ []+ -- use rule "Transform.ag"(line 821, column 39)+ _lhsOuniqueInfos =+ []+ ( _patternIcopy,_patternIdefinedAttrs,_patternIdefinedInsts,_patternIpatunder,_patternIstpos) =+ (pattern_ )+ in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos)) )+sem_SemDef_SemPragma :: ([NontermIdent]) ->+ T_SemDef +sem_SemDef_SemPragma names_ =+ (T_SemDef (let _lhsOpragmaNamesCollect :: ([Identifier])+ _lhsOdefinedInsts :: ([Identifier])+ _lhsOorderDepsCollect :: (Set Dependency)+ _lhsOruleInfos :: ([RuleInfo])+ _lhsOsigInfos :: ([SigInfo])+ _lhsOuniqueInfos :: ([UniqueInfo])+ -- "Transform.ag"(line 658, column 7)+ _lhsOpragmaNamesCollect =+ names_+ -- use rule "Transform.ag"(line 874, column 55)+ _lhsOdefinedInsts =+ []+ -- use rule "Transform.ag"(line 685, column 44)+ _lhsOorderDepsCollect =+ Set.empty+ -- use rule "Transform.ag"(line 819, column 39)+ _lhsOruleInfos =+ []+ -- use rule "Transform.ag"(line 820, column 39)+ _lhsOsigInfos =+ []+ -- use rule "Transform.ag"(line 821, column 39)+ _lhsOuniqueInfos =+ []+ in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos)) )+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])+ _lhsOuniqueInfos :: ([UniqueInfo])+ -- "Transform.ag"(line 868, column 14)+ _lhsOsigInfos =+ [ (ident_, tp_) ]+ -- use rule "Transform.ag"(line 874, column 55)+ _lhsOdefinedInsts =+ []+ -- use rule "Transform.ag"(line 685, column 44)+ _lhsOorderDepsCollect =+ Set.empty+ -- use rule "Transform.ag"(line 654, column 46)+ _lhsOpragmaNamesCollect =+ []+ -- use rule "Transform.ag"(line 819, column 39)+ _lhsOruleInfos =+ []+ -- use rule "Transform.ag"(line 821, column 39)+ _lhsOuniqueInfos =+ []+ in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos)) )+sem_SemDef_UniqueDef :: Identifier ->+ Identifier ->+ T_SemDef +sem_SemDef_UniqueDef ident_ ref_ =+ (T_SemDef (let _lhsOuniqueInfos :: ([UniqueInfo])+ _lhsOdefinedInsts :: ([Identifier])+ _lhsOorderDepsCollect :: (Set Dependency)+ _lhsOpragmaNamesCollect :: ([Identifier])+ _lhsOruleInfos :: ([RuleInfo])+ _lhsOsigInfos :: ([SigInfo])+ -- "Transform.ag"(line 871, column 16)+ _lhsOuniqueInfos =+ [ (ident_, ref_) ]+ -- use rule "Transform.ag"(line 874, column 55)+ _lhsOdefinedInsts =+ []+ -- use rule "Transform.ag"(line 685, column 44)+ _lhsOorderDepsCollect =+ Set.empty+ -- use rule "Transform.ag"(line 654, column 46)+ _lhsOpragmaNamesCollect =+ []+ -- use rule "Transform.ag"(line 819, column 39)+ _lhsOruleInfos =+ []+ -- use rule "Transform.ag"(line 820, column 39)+ _lhsOsigInfos =+ []+ in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos)) )+-- SemDefs -----------------------------------------------------+{-+ visit 0:+ synthesized attributes:+ definedInsts : [Identifier]+ orderDepsCollect : Set Dependency+ pragmaNamesCollect : [Identifier]+ ruleInfos : [RuleInfo]+ sigInfos : [SigInfo]+ uniqueInfos : [UniqueInfo]+ 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]),([UniqueInfo])))+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]),uniqueInfos_Syn_SemDefs :: !([UniqueInfo])}+wrap_SemDefs :: T_SemDefs ->+ Inh_SemDefs ->+ Syn_SemDefs +wrap_SemDefs (T_SemDefs sem ) (Inh_SemDefs ) =+ (let ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos) =+ (sem )+ in (Syn_SemDefs _lhsOdefinedInsts _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos _lhsOuniqueInfos ))+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])+ _lhsOuniqueInfos :: ([UniqueInfo])+ _hdIdefinedInsts :: ([Identifier])+ _hdIorderDepsCollect :: (Set Dependency)+ _hdIpragmaNamesCollect :: ([Identifier])+ _hdIruleInfos :: ([RuleInfo])+ _hdIsigInfos :: ([SigInfo])+ _hdIuniqueInfos :: ([UniqueInfo])+ _tlIdefinedInsts :: ([Identifier])+ _tlIorderDepsCollect :: (Set Dependency)+ _tlIpragmaNamesCollect :: ([Identifier])+ _tlIruleInfos :: ([RuleInfo])+ _tlIsigInfos :: ([SigInfo])+ _tlIuniqueInfos :: ([UniqueInfo])+ -- use rule "Transform.ag"(line 874, column 55)+ _lhsOdefinedInsts =+ _hdIdefinedInsts ++ _tlIdefinedInsts+ -- use rule "Transform.ag"(line 685, column 44)+ _lhsOorderDepsCollect =+ _hdIorderDepsCollect `Set.union` _tlIorderDepsCollect+ -- use rule "Transform.ag"(line 654, column 46)+ _lhsOpragmaNamesCollect =+ _hdIpragmaNamesCollect ++ _tlIpragmaNamesCollect+ -- use rule "Transform.ag"(line 819, column 39)+ _lhsOruleInfos =+ _hdIruleInfos ++ _tlIruleInfos+ -- use rule "Transform.ag"(line 820, column 39)+ _lhsOsigInfos =+ _hdIsigInfos ++ _tlIsigInfos+ -- use rule "Transform.ag"(line 821, column 39)+ _lhsOuniqueInfos =+ _hdIuniqueInfos ++ _tlIuniqueInfos+ ( _hdIdefinedInsts,_hdIorderDepsCollect,_hdIpragmaNamesCollect,_hdIruleInfos,_hdIsigInfos,_hdIuniqueInfos) =+ (hd_ )+ ( _tlIdefinedInsts,_tlIorderDepsCollect,_tlIpragmaNamesCollect,_tlIruleInfos,_tlIsigInfos,_tlIuniqueInfos) =+ (tl_ )+ in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos)) )+sem_SemDefs_Nil :: T_SemDefs +sem_SemDefs_Nil =+ (T_SemDefs (let _lhsOdefinedInsts :: ([Identifier])+ _lhsOorderDepsCollect :: (Set Dependency)+ _lhsOpragmaNamesCollect :: ([Identifier])+ _lhsOruleInfos :: ([RuleInfo])+ _lhsOsigInfos :: ([SigInfo])+ _lhsOuniqueInfos :: ([UniqueInfo])+ -- use rule "Transform.ag"(line 874, column 55)+ _lhsOdefinedInsts =+ []+ -- use rule "Transform.ag"(line 685, column 44)+ _lhsOorderDepsCollect =+ Set.empty+ -- use rule "Transform.ag"(line 654, column 46)+ _lhsOpragmaNamesCollect =+ []+ -- use rule "Transform.ag"(line 819, column 39)+ _lhsOruleInfos =+ []+ -- use rule "Transform.ag"(line 820, column 39)+ _lhsOsigInfos =+ []+ -- use rule "Transform.ag"(line 821, column 39)+ _lhsOuniqueInfos =+ [] in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos)) )
src-derived/Visage.hs view
@@ -1,692 +1,692 @@- - --- UUAGC 0.9.11 (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 -> - Inh_Expression -> - Syn_Expression -wrap_Expression (T_Expression sem ) (Inh_Expression ) = - (let ( _lhsOaterm) = - (sem ) - in (Syn_Expression _lhsOaterm )) -sem_Expression_Expression :: Pos -> - ([HsToken]) -> - T_Expression -sem_Expression_Expression pos_ tks_ = - (T_Expression (let _lhsOaterm :: ATerm - -- "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 -> - Inh_VisageChild -> - Syn_VisageChild -wrap_VisageChild (T_VisageChild sem ) (Inh_VisageChild ) = - (let ( _lhsOaterm) = - (sem ) - in (Syn_VisageChild _lhsOaterm )) -sem_VisageChild_VChild :: Identifier -> - Type -> - Attributes -> - Attributes -> - T_VisageRules -> - T_VisageChild -sem_VisageChild_VChild name_ tp_ inh_ syn_ (T_VisageRules rules_ ) = - (T_VisageChild (let _lhsOaterm :: ATerm - _rulesOisLoc :: Bool - _rulesIaterms :: ([ATerm]) - -- "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 -> - Inh_VisageChildren -> - Syn_VisageChildren -wrap_VisageChildren (T_VisageChildren sem ) (Inh_VisageChildren ) = - (let ( _lhsOaterms) = - (sem ) - in (Syn_VisageChildren _lhsOaterms )) -sem_VisageChildren_Cons :: T_VisageChild -> - T_VisageChildren -> - T_VisageChildren -sem_VisageChildren_Cons (T_VisageChild hd_ ) (T_VisageChildren tl_ ) = - (T_VisageChildren (let _lhsOaterms :: ([ATerm]) - _hdIaterm :: ATerm - _tlIaterms :: ([ATerm]) - -- "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 -> - Inh_VisageGrammar -> - Syn_VisageGrammar -wrap_VisageGrammar (T_VisageGrammar sem ) (Inh_VisageGrammar ) = - (let ( _lhsOaterm) = - (sem ) - in (Syn_VisageGrammar _lhsOaterm )) -sem_VisageGrammar_VGrammar :: T_VisageNonterminals -> - T_VisageGrammar -sem_VisageGrammar_VGrammar (T_VisageNonterminals nonts_ ) = - (T_VisageGrammar (let _lhsOaterm :: ATerm - _nontsIaterms :: ([ATerm]) - -- "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 -> - Inh_VisageNonterminal -> - Syn_VisageNonterminal -wrap_VisageNonterminal (T_VisageNonterminal sem ) (Inh_VisageNonterminal ) = - (let ( _lhsOaterm) = - (sem ) - in (Syn_VisageNonterminal _lhsOaterm )) -sem_VisageNonterminal_VNonterminal :: NontermIdent -> - Attributes -> - Attributes -> - T_VisageProductions -> - T_VisageNonterminal -sem_VisageNonterminal_VNonterminal nt_ inh_ syn_ (T_VisageProductions alts_ ) = - (T_VisageNonterminal (let _lhsOaterm :: ATerm - _altsIaterms :: ([ATerm]) - -- "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 -> - Inh_VisageNonterminals -> - Syn_VisageNonterminals -wrap_VisageNonterminals (T_VisageNonterminals sem ) (Inh_VisageNonterminals ) = - (let ( _lhsOaterms) = - (sem ) - in (Syn_VisageNonterminals _lhsOaterms )) -sem_VisageNonterminals_Cons :: T_VisageNonterminal -> - T_VisageNonterminals -> - T_VisageNonterminals -sem_VisageNonterminals_Cons (T_VisageNonterminal hd_ ) (T_VisageNonterminals tl_ ) = - (T_VisageNonterminals (let _lhsOaterms :: ([ATerm]) - _hdIaterm :: ATerm - _tlIaterms :: ([ATerm]) - -- "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 -> - Inh_VisagePattern -> - Syn_VisagePattern -wrap_VisagePattern (T_VisagePattern sem ) (Inh_VisagePattern ) = - (let ( _lhsOaterm) = - (sem ) - in (Syn_VisagePattern _lhsOaterm )) -sem_VisagePattern_VAlias :: Identifier -> - Identifier -> - T_VisagePattern -> - T_VisagePattern -sem_VisagePattern_VAlias field_ attr_ (T_VisagePattern pat_ ) = - (T_VisagePattern (let _lhsOaterm :: ATerm - _patIaterm :: ATerm - -- "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 -> - Inh_VisagePatterns -> - Syn_VisagePatterns -wrap_VisagePatterns (T_VisagePatterns sem ) (Inh_VisagePatterns ) = - (let ( _lhsOaterms) = - (sem ) - in (Syn_VisagePatterns _lhsOaterms )) -sem_VisagePatterns_Cons :: T_VisagePattern -> - T_VisagePatterns -> - T_VisagePatterns -sem_VisagePatterns_Cons (T_VisagePattern hd_ ) (T_VisagePatterns tl_ ) = - (T_VisagePatterns (let _lhsOaterms :: ([ATerm]) - _hdIaterm :: ATerm - _tlIaterms :: ([ATerm]) - -- "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 -> - Inh_VisageProduction -> - Syn_VisageProduction -wrap_VisageProduction (T_VisageProduction sem ) (Inh_VisageProduction ) = - (let ( _lhsOaterm) = - (sem ) - in (Syn_VisageProduction _lhsOaterm )) -sem_VisageProduction_VProduction :: ConstructorIdent -> - T_VisageChildren -> - T_VisageRules -> - T_VisageRules -> - T_VisageProduction -sem_VisageProduction_VProduction con_ (T_VisageChildren children_ ) (T_VisageRules rules_ ) (T_VisageRules locrules_ ) = - (T_VisageProduction (let _lhsOaterm :: ATerm - _locrulesOisLoc :: Bool - _rulesOisLoc :: Bool - _childrenIaterms :: ([ATerm]) - _rulesIaterms :: ([ATerm]) - _locrulesIaterms :: ([ATerm]) - -- "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 -> - Inh_VisageProductions -> - Syn_VisageProductions -wrap_VisageProductions (T_VisageProductions sem ) (Inh_VisageProductions ) = - (let ( _lhsOaterms) = - (sem ) - in (Syn_VisageProductions _lhsOaterms )) -sem_VisageProductions_Cons :: T_VisageProduction -> - T_VisageProductions -> - T_VisageProductions -sem_VisageProductions_Cons (T_VisageProduction hd_ ) (T_VisageProductions tl_ ) = - (T_VisageProductions (let _lhsOaterms :: ([ATerm]) - _hdIaterm :: ATerm - _tlIaterms :: ([ATerm]) - -- "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 -> - Inh_VisageRule -> - Syn_VisageRule -wrap_VisageRule (T_VisageRule sem ) (Inh_VisageRule _lhsIisLoc ) = - (let ( _lhsOaterm) = - (sem _lhsIisLoc ) - in (Syn_VisageRule _lhsOaterm )) -sem_VisageRule_VRule :: ([(Identifier,Identifier)]) -> - Identifier -> - T_VisagePattern -> - T_Expression -> - Bool -> - T_VisageRule -sem_VisageRule_VRule fieldattrs_ attr_ (T_VisagePattern pat_ ) (T_Expression rhs_ ) owrt_ = - (T_VisageRule (\ _lhsIisLoc -> - (let _lhsOaterm :: ATerm - _patIaterm :: ATerm - _rhsIaterm :: ATerm - -- "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 -> - Inh_VisageRules -> - Syn_VisageRules -wrap_VisageRules (T_VisageRules sem ) (Inh_VisageRules _lhsIisLoc ) = - (let ( _lhsOaterms) = - (sem _lhsIisLoc ) - in (Syn_VisageRules _lhsOaterms )) -sem_VisageRules_Cons :: T_VisageRule -> - T_VisageRules -> - T_VisageRules -sem_VisageRules_Cons (T_VisageRule hd_ ) (T_VisageRules tl_ ) = - (T_VisageRules (\ _lhsIisLoc -> - (let _lhsOaterms :: ([ATerm]) - _hdOisLoc :: Bool - _tlOisLoc :: Bool - _hdIaterm :: ATerm - _tlIaterms :: ([ATerm]) - -- "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 = - [] +++-- UUAGC 0.9.12 (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 ->+ Inh_Expression ->+ Syn_Expression +wrap_Expression (T_Expression sem ) (Inh_Expression ) =+ (let ( _lhsOaterm) =+ (sem )+ in (Syn_Expression _lhsOaterm ))+sem_Expression_Expression :: Pos ->+ ([HsToken]) ->+ T_Expression +sem_Expression_Expression pos_ tks_ =+ (T_Expression (let _lhsOaterm :: ATerm+ -- "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 ->+ Inh_VisageChild ->+ Syn_VisageChild +wrap_VisageChild (T_VisageChild sem ) (Inh_VisageChild ) =+ (let ( _lhsOaterm) =+ (sem )+ in (Syn_VisageChild _lhsOaterm ))+sem_VisageChild_VChild :: Identifier ->+ Type ->+ Attributes ->+ Attributes ->+ T_VisageRules ->+ T_VisageChild +sem_VisageChild_VChild name_ tp_ inh_ syn_ (T_VisageRules rules_ ) =+ (T_VisageChild (let _lhsOaterm :: ATerm+ _rulesOisLoc :: Bool+ _rulesIaterms :: ([ATerm])+ -- "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 ->+ Inh_VisageChildren ->+ Syn_VisageChildren +wrap_VisageChildren (T_VisageChildren sem ) (Inh_VisageChildren ) =+ (let ( _lhsOaterms) =+ (sem )+ in (Syn_VisageChildren _lhsOaterms ))+sem_VisageChildren_Cons :: T_VisageChild ->+ T_VisageChildren ->+ T_VisageChildren +sem_VisageChildren_Cons (T_VisageChild hd_ ) (T_VisageChildren tl_ ) =+ (T_VisageChildren (let _lhsOaterms :: ([ATerm])+ _hdIaterm :: ATerm+ _tlIaterms :: ([ATerm])+ -- "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 ->+ Inh_VisageGrammar ->+ Syn_VisageGrammar +wrap_VisageGrammar (T_VisageGrammar sem ) (Inh_VisageGrammar ) =+ (let ( _lhsOaterm) =+ (sem )+ in (Syn_VisageGrammar _lhsOaterm ))+sem_VisageGrammar_VGrammar :: T_VisageNonterminals ->+ T_VisageGrammar +sem_VisageGrammar_VGrammar (T_VisageNonterminals nonts_ ) =+ (T_VisageGrammar (let _lhsOaterm :: ATerm+ _nontsIaterms :: ([ATerm])+ -- "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 ->+ Inh_VisageNonterminal ->+ Syn_VisageNonterminal +wrap_VisageNonterminal (T_VisageNonterminal sem ) (Inh_VisageNonterminal ) =+ (let ( _lhsOaterm) =+ (sem )+ in (Syn_VisageNonterminal _lhsOaterm ))+sem_VisageNonterminal_VNonterminal :: NontermIdent ->+ Attributes ->+ Attributes ->+ T_VisageProductions ->+ T_VisageNonterminal +sem_VisageNonterminal_VNonterminal nt_ inh_ syn_ (T_VisageProductions alts_ ) =+ (T_VisageNonterminal (let _lhsOaterm :: ATerm+ _altsIaterms :: ([ATerm])+ -- "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 ->+ Inh_VisageNonterminals ->+ Syn_VisageNonterminals +wrap_VisageNonterminals (T_VisageNonterminals sem ) (Inh_VisageNonterminals ) =+ (let ( _lhsOaterms) =+ (sem )+ in (Syn_VisageNonterminals _lhsOaterms ))+sem_VisageNonterminals_Cons :: T_VisageNonterminal ->+ T_VisageNonterminals ->+ T_VisageNonterminals +sem_VisageNonterminals_Cons (T_VisageNonterminal hd_ ) (T_VisageNonterminals tl_ ) =+ (T_VisageNonterminals (let _lhsOaterms :: ([ATerm])+ _hdIaterm :: ATerm+ _tlIaterms :: ([ATerm])+ -- "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 ->+ Inh_VisagePattern ->+ Syn_VisagePattern +wrap_VisagePattern (T_VisagePattern sem ) (Inh_VisagePattern ) =+ (let ( _lhsOaterm) =+ (sem )+ in (Syn_VisagePattern _lhsOaterm ))+sem_VisagePattern_VAlias :: Identifier ->+ Identifier ->+ T_VisagePattern ->+ T_VisagePattern +sem_VisagePattern_VAlias field_ attr_ (T_VisagePattern pat_ ) =+ (T_VisagePattern (let _lhsOaterm :: ATerm+ _patIaterm :: ATerm+ -- "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 ->+ Inh_VisagePatterns ->+ Syn_VisagePatterns +wrap_VisagePatterns (T_VisagePatterns sem ) (Inh_VisagePatterns ) =+ (let ( _lhsOaterms) =+ (sem )+ in (Syn_VisagePatterns _lhsOaterms ))+sem_VisagePatterns_Cons :: T_VisagePattern ->+ T_VisagePatterns ->+ T_VisagePatterns +sem_VisagePatterns_Cons (T_VisagePattern hd_ ) (T_VisagePatterns tl_ ) =+ (T_VisagePatterns (let _lhsOaterms :: ([ATerm])+ _hdIaterm :: ATerm+ _tlIaterms :: ([ATerm])+ -- "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 ->+ Inh_VisageProduction ->+ Syn_VisageProduction +wrap_VisageProduction (T_VisageProduction sem ) (Inh_VisageProduction ) =+ (let ( _lhsOaterm) =+ (sem )+ in (Syn_VisageProduction _lhsOaterm ))+sem_VisageProduction_VProduction :: ConstructorIdent ->+ T_VisageChildren ->+ T_VisageRules ->+ T_VisageRules ->+ T_VisageProduction +sem_VisageProduction_VProduction con_ (T_VisageChildren children_ ) (T_VisageRules rules_ ) (T_VisageRules locrules_ ) =+ (T_VisageProduction (let _lhsOaterm :: ATerm+ _locrulesOisLoc :: Bool+ _rulesOisLoc :: Bool+ _childrenIaterms :: ([ATerm])+ _rulesIaterms :: ([ATerm])+ _locrulesIaterms :: ([ATerm])+ -- "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 ->+ Inh_VisageProductions ->+ Syn_VisageProductions +wrap_VisageProductions (T_VisageProductions sem ) (Inh_VisageProductions ) =+ (let ( _lhsOaterms) =+ (sem )+ in (Syn_VisageProductions _lhsOaterms ))+sem_VisageProductions_Cons :: T_VisageProduction ->+ T_VisageProductions ->+ T_VisageProductions +sem_VisageProductions_Cons (T_VisageProduction hd_ ) (T_VisageProductions tl_ ) =+ (T_VisageProductions (let _lhsOaterms :: ([ATerm])+ _hdIaterm :: ATerm+ _tlIaterms :: ([ATerm])+ -- "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 ->+ Inh_VisageRule ->+ Syn_VisageRule +wrap_VisageRule (T_VisageRule sem ) (Inh_VisageRule _lhsIisLoc ) =+ (let ( _lhsOaterm) =+ (sem _lhsIisLoc )+ in (Syn_VisageRule _lhsOaterm ))+sem_VisageRule_VRule :: ([(Identifier,Identifier)]) ->+ Identifier ->+ T_VisagePattern ->+ T_Expression ->+ Bool ->+ T_VisageRule +sem_VisageRule_VRule fieldattrs_ attr_ (T_VisagePattern pat_ ) (T_Expression rhs_ ) owrt_ =+ (T_VisageRule (\ _lhsIisLoc ->+ (let _lhsOaterm :: ATerm+ _patIaterm :: ATerm+ _rhsIaterm :: ATerm+ -- "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 ->+ Inh_VisageRules ->+ Syn_VisageRules +wrap_VisageRules (T_VisageRules sem ) (Inh_VisageRules _lhsIisLoc ) =+ (let ( _lhsOaterms) =+ (sem _lhsIisLoc )+ in (Syn_VisageRules _lhsOaterms ))+sem_VisageRules_Cons :: T_VisageRule ->+ T_VisageRules ->+ T_VisageRules +sem_VisageRules_Cons (T_VisageRule hd_ ) (T_VisageRules tl_ ) =+ (T_VisageRules (\ _lhsIisLoc ->+ (let _lhsOaterms :: ([ATerm])+ _hdOisLoc :: Bool+ _tlOisLoc :: Bool+ _hdIaterm :: ATerm+ _tlIaterms :: ([ATerm])+ -- "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
@@ -1,40 +1,40 @@- - --- UUAGC 0.9.11 (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: --} +++-- UUAGC 0.9.12 (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
@@ -1,95 +1,95 @@- - --- UUAGC 0.9.11 (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: --} +++-- UUAGC 0.9.12 (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/Scanner.hs view
@@ -161,7 +161,7 @@ in (p2,xs2,x:sc) --Literate Mode scanLit xs = (fs, foldr insNL (const "") codeLns 1) - where insNL (n,line) rec = \n1 -> replicate (n-n1) '\n' ++ line ++ rec n + where insNL (n,line) r = \n1 -> replicate (n-n1) '\n' ++ line ++ r n (fs,codeLns,_) = getBlocks ([1..] `zip` toLines xs) getBlocks [] = ([],[],[]) getBlocks xs = let (files1,txt1,r1) = getBlock xs
src/Version.hs view
@@ -1,4 +1,4 @@-module Version where--banner :: String-banner = "Attribute Grammar compiler / HUT project. Version 0.9.12"+module Version where + +banner :: String +banner = "Attribute Grammar compiler / HUT project. Version 0.9.13"
uuagc.cabal view
@@ -1,7 +1,7 @@ cabal-version: >=1.2 build-type: Simple name: uuagc-version: 0.9.12+version: 0.9.13 license: GPL license-file: LICENSE maintainer: Arie Middelkoop <ariem@cs.uu.nl>
uuagc.cabal-for-ghc-6.6 view
@@ -1,5 +1,5 @@ name: uuagc-version: 0.9.12+version: 0.9.13 license: GPL license-file: LICENSE maintainer: Arie Middelkoop <ariem@cs.uu.nl>