uuagc 0.9.10 → 0.9.11
raw patch · 30 files changed
+26156/−25556 lines, 30 filesdep ~base
Dependency ranges changed: base
Files
- src-derived/AbstractSyntax.hs +122/−120
- src-derived/AbstractSyntaxDump.hs +879/−832
- src-derived/Code.hs +260/−258
- src-derived/CodeSyntax.hs +143/−141
- src-derived/CodeSyntaxDump.hs +924/−878
- src-derived/ConcreteSyntax.hs +209/−207
- src-derived/DeclBlocks.hs +26/−24
- src-derived/DefaultRules.hs +1679/−1635
- src-derived/Desugar.hs +1869/−1811
- src-derived/ErrorMessages.hs +161/−159
- src-derived/Expression.hs +15/−13
- src-derived/GenerateCode.hs +5257/−5196
- src-derived/HsToken.hs +54/−52
- src-derived/Interfaces.hs +49/−47
- src-derived/InterfacesRules.hs +977/−951
- src-derived/Order.hs +3536/−3483
- src-derived/Patterns.hs +62/−60
- src-derived/PrintCode.hs +2218/−2161
- src-derived/PrintErrorMessages.hs +1303/−1292
- src-derived/SemHsTokens.hs +586/−572
- src-derived/TfmToVisage.hs +975/−928
- src-derived/Transform.hs +3990/−3921
- src-derived/Visage.hs +692/−651
- src-derived/VisagePatterns.hs +40/−38
- src-derived/VisageSyntax.hs +95/−93
- src/Ag.hs +10/−8
- src/Scanner.hs +17/−17
- src/Version.hs +4/−4
- uuagc.cabal +3/−3
- uuagc.cabal-for-ghc-6.6 +1/−1
src-derived/AbstractSyntax.hs view
@@ -1,120 +1,122 @@--- UUAGC 0.9.5 (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]+ + +-- UUAGC 0.9.10 (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,832 +1,879 @@--- UUAGC 0.9.5 (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 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 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 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 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 sem) (Inh_Nonterminal ) =- (let ( _lhsOpp) =- (sem )- in (Syn_Nonterminal _lhsOpp))-sem_Nonterminal_Nonterminal :: NontermIdent ->- ([Identifier]) ->- Attributes ->- Attributes ->- T_Productions ->- T_Nonterminal-sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ (T_Productions prods_) =- (T_Nonterminal (let _lhsOpp :: PP_Doc- _prodsIpp :: PP_Doc- _prodsIppL :: ([PP_Doc])- -- "AbstractSyntaxDump.ag"(line 29, column 25)- _lhsOpp =- ppNestInfo ["Nonterminal","Nonterminal"] (pp nt_ : map pp params_) [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_, ppF "prods" $ ppVList _prodsIppL] []- ( _prodsIpp,_prodsIppL) =- (prods_ )- in ( _lhsOpp)))--- Nonterminals -------------------------------------------------{-- visit 0:- synthesized attributes:- pp : PP_Doc- ppL : [PP_Doc]- alternatives:- alternative Cons:- child hd : Nonterminal- child tl : Nonterminals- alternative Nil:--}--- cata-sem_Nonterminals :: Nonterminals ->- T_Nonterminals-sem_Nonterminals list =- (Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list))--- semantic domain-newtype T_Nonterminals = T_Nonterminals (( PP_Doc,([PP_Doc])))-data Inh_Nonterminals = Inh_Nonterminals {}-data Syn_Nonterminals = Syn_Nonterminals {pp_Syn_Nonterminals :: PP_Doc,ppL_Syn_Nonterminals :: [PP_Doc]}-wrap_Nonterminals (T_Nonterminals sem) (Inh_Nonterminals ) =- (let ( _lhsOpp,_lhsOppL) =- (sem )- in (Syn_Nonterminals _lhsOpp _lhsOppL))-sem_Nonterminals_Cons :: T_Nonterminal ->- T_Nonterminals ->- T_Nonterminals-sem_Nonterminals_Cons (T_Nonterminal hd_) (T_Nonterminals tl_) =- (T_Nonterminals (let _lhsOppL :: ([PP_Doc])- _lhsOpp :: PP_Doc- _hdIpp :: PP_Doc- _tlIpp :: PP_Doc- _tlIppL :: ([PP_Doc])- -- "AbstractSyntaxDump.ag"(line 75, column 33)- _lhsOppL =- _hdIpp : _tlIppL- -- use rule "AbstractSyntaxDump.ag"(line 17, column 58)- _lhsOpp =- _hdIpp >-< _tlIpp- ( _hdIpp) =- (hd_ )- ( _tlIpp,_tlIppL) =- (tl_ )- in ( _lhsOpp,_lhsOppL)))-sem_Nonterminals_Nil :: T_Nonterminals-sem_Nonterminals_Nil =- (T_Nonterminals (let _lhsOppL :: ([PP_Doc])- _lhsOpp :: PP_Doc- -- "AbstractSyntaxDump.ag"(line 76, column 33)- _lhsOppL =- []- -- use rule "AbstractSyntaxDump.ag"(line 17, column 58)- _lhsOpp =- empty- in ( _lhsOpp,_lhsOppL)))--- Pattern ------------------------------------------------------{-- visit 0:- 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 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 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 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 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 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 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 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 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)))+ + +-- UUAGC 0.9.10 (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,258 +1,260 @@--- UUAGC 0.9.5 (Code.ag)-module Code where--import Pretty-import Patterns-import Data.List(partition)-import Data.Set(Set)-import qualified UU.DData.Set as Set-import Data.Map(Map)-import qualified Data.Map as Map---- 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]+ + +-- UUAGC 0.9.10 (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,141 +1,143 @@--- UUAGC 0.9.5 (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]+ + +-- UUAGC 0.9.10 (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,878 +1,924 @@--- UUAGC 0.9.5 (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 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 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 sem) (Inh_CNonterminal ) =- (let ( _lhsOpp) =- (sem )- in (Syn_CNonterminal _lhsOpp))-sem_CNonterminal_CNonterminal :: NontermIdent ->- ([Identifier]) ->- Attributes ->- Attributes ->- T_CProductions ->- T_CInterface ->- T_CNonterminal-sem_CNonterminal_CNonterminal nt_ params_ inh_ syn_ (T_CProductions prods_) (T_CInterface inter_) =- (T_CNonterminal (let _lhsOpp :: PP_Doc- _prodsIpp :: PP_Doc- _prodsIppL :: ([PP_Doc])- _interIpp :: PP_Doc- -- "CodeSyntaxDump.ag"(line 54, column 33)- _lhsOpp =- ppNestInfo ["CNonterminal","CNonterminal"] (pp nt_ : map pp params_) [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_, ppF "prods" $ ppVList _prodsIppL, ppF "inter" _interIpp] []- ( _prodsIpp,_prodsIppL) =- (prods_ )- ( _interIpp) =- (inter_ )- in ( _lhsOpp)))--- CNonterminals ------------------------------------------------{-- visit 0:- synthesized attributes:- pp : PP_Doc- ppL : [PP_Doc]- alternatives:- alternative Cons:- child hd : CNonterminal- child tl : CNonterminals- alternative Nil:--}--- cata-sem_CNonterminals :: CNonterminals ->- T_CNonterminals-sem_CNonterminals list =- (Prelude.foldr sem_CNonterminals_Cons sem_CNonterminals_Nil (Prelude.map sem_CNonterminal list))--- semantic domain-newtype T_CNonterminals = T_CNonterminals (( PP_Doc,([PP_Doc])))-data Inh_CNonterminals = Inh_CNonterminals {}-data Syn_CNonterminals = Syn_CNonterminals {pp_Syn_CNonterminals :: PP_Doc,ppL_Syn_CNonterminals :: [PP_Doc]}-wrap_CNonterminals (T_CNonterminals sem) (Inh_CNonterminals ) =- (let ( _lhsOpp,_lhsOppL) =- (sem )- in (Syn_CNonterminals _lhsOpp _lhsOppL))-sem_CNonterminals_Cons :: T_CNonterminal ->- T_CNonterminals ->- T_CNonterminals-sem_CNonterminals_Cons (T_CNonterminal hd_) (T_CNonterminals tl_) =- (T_CNonterminals (let _lhsOppL :: ([PP_Doc])- _lhsOpp :: PP_Doc- _hdIpp :: PP_Doc- _tlIpp :: PP_Doc- _tlIppL :: ([PP_Doc])- -- "CodeSyntaxDump.ag"(line 102, column 33)- _lhsOppL =- _hdIpp : _tlIppL- -- use rule "CodeSyntaxDump.ag"(line 44, column 40)- _lhsOpp =- _hdIpp >-< _tlIpp- ( _hdIpp) =- (hd_ )- ( _tlIpp,_tlIppL) =- (tl_ )- in ( _lhsOpp,_lhsOppL)))-sem_CNonterminals_Nil :: T_CNonterminals-sem_CNonterminals_Nil =- (T_CNonterminals (let _lhsOppL :: ([PP_Doc])- _lhsOpp :: PP_Doc- -- "CodeSyntaxDump.ag"(line 103, column 33)- _lhsOppL =- []- -- use rule "CodeSyntaxDump.ag"(line 44, column 40)- _lhsOpp =- empty- in ( _lhsOpp,_lhsOppL)))--- CProduction --------------------------------------------------{-- visit 0:- synthesized attribute:- pp : PP_Doc- alternatives:- alternative CProduction:- child con : {ConstructorIdent}- child visits : CVisits- child children : {[(Identifier,Type,Bool)]}- child terminals : {[Identifier]}--}--- cata-sem_CProduction :: CProduction ->- T_CProduction-sem_CProduction (CProduction _con _visits _children _terminals) =- (sem_CProduction_CProduction _con (sem_CVisits _visits) _children _terminals)--- semantic domain-newtype T_CProduction = T_CProduction (( PP_Doc))-data Inh_CProduction = Inh_CProduction {}-data Syn_CProduction = Syn_CProduction {pp_Syn_CProduction :: PP_Doc}-wrap_CProduction (T_CProduction sem) (Inh_CProduction ) =- (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 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 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 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 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 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 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 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 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 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)))+ + +-- UUAGC 0.9.10 (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,207 +1,209 @@--- UUAGC 0.9.5 (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]+ + +-- UUAGC 0.9.10 (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,24 +1,26 @@--- UUAGC 0.9.5 (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)+ + +-- UUAGC 0.9.10 (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,1635 +1,1679 @@-{-# OPTIONS_GHC -fbang-patterns #-}--- UUAGC 0.9.5 (DefaultRules.ag)-module DefaultRules where--import qualified List (delete,intersperse)--import qualified Data.Set as Set-import qualified Data.Map as Map-import Data.Map(Map)-import qualified UU.DData.Seq as Seq-import UU.DData.Seq(Seq,(<>))-import UU.Scanner.Position(noPos)-import Pretty-import Maybe-import HsToken-import HsTokenScanner--import AbstractSyntax-import ErrorMessages--import Options(Options,modcopy,rename)---- AbstractSyntax.ag imports-import Data.Set(Set)-import Data.Map(Map)-import Patterns (Pattern(..),Patterns)-import Expression (Expression(..))-import CommonTypes---- Patterns.ag imports-import UU.Scanner.Position(Pos)-import CommonTypes (ConstructorIdent,Identifier)--fieldName n = '@' : getName n- -locName n = '@' : getName n--attrName fld attr- | fld == _LOC = '@' : getName attr - | otherwise = '@' : getName fld ++ "." ++ getName attr--_ACHILD = Ident "(" noPos -- hack- - -getConName typeSyns rename nt con1 - | nt `elem` map fst typeSyns = synonym- | otherwise = normalName- where con = getName con1- normalName | rename = getName nt++"_"++ con- | otherwise = con- synonym | con == "Cons" = "(:)"- | con == "Nil" = "[]"- | con == "Just" = "Just"- | con == "Nothing" = "Nothing"- | otherwise = normalName----concatSeq = foldr Seq.append Seq.empty--splitAttrs :: Map Identifier a -> [Identifier] -> ([(Identifier,a)],[Identifier]) -- a used as (String,String)-splitAttrs _ [] - = ([],[])-splitAttrs useMap (n:rest) - = let (uses,normals) = splitAttrs useMap rest- in case Map.lookup n useMap of- Just x -> ((n,x):uses , normals ) - Nothing -> ( uses , n:normals )--removeDefined :: Set (Identifier,Identifier) -> (Identifier,Attributes) -> (Identifier,[Identifier])-removeDefined defined (fld,as) - = ( fld- , [ a - | a <- Map.keys as- , not (Set.member (fld,a) defined) - ]- )--- - - -deprecatedCopyRuleError nt con fld a- = let mesg = - "In the definitions for alternative" - >#< getName con - >#< "of nonterminal" - >#< getName nt - >|< "," - >-< "the value of field" - >#< getName a - >#< "is copied by a copy-rule." - >-< "Copying the value of a field using a copy-rule is deprecated"- >-< "Please add the following lines to your code:"- >-< ( "SEM" - >#< getName nt- >-< indent 2 ( "|" - >#< getName con - >#< getName fld - >#< "." - >#< a - >#< "=" - >#< "@" - >|< a- )- ) - in CustomError True (getPos a) mesg- - -missingRuleErrorExpr nt con fld a- = "error \"missing rule: " - ++ show nt ++ "." ++ show con ++ "." - ++ show fld ++ "." ++ show a ++ "\""- - - -makeRule :: (Identifier,Identifier) -> Expression -> String -> Rule-makeRule (f1,a1) expr origin - = Rule (Alias f1 a1 (Underscore noPos) []) - expr - False - origin---useRule :: Set Identifier -> [(Identifier,Attributes)] -> (Identifier,(String,String,String)) -> Rule-useRule locals ch_outs (n,(op,e,pos)) - = let elems = [ fld - | (fld,as) <- ch_outs- , Map.member n as- ]-- expr | Set.member n locals = attrName _LOC n- | null elems = e- | otherwise = foldr1 (\x y -> x ++ " " ++ op ++ " " ++ y) - (map (flip attrName n) elems)-- tks | Set.member n locals = [AGLocal n noPos Nothing]- | null elems = lexTokens noPos e- | otherwise = lexTokens noPos str- where- str = foldr1 (\x y -> x ++ " " ++ op ++ " " ++ y) - (map (flip attrName n) elems)-- in makeRule (_LHS,n) - (Expression noPos tks)- ("use rule " ++ pos)-----selfRule lhsNecLoc attr x - = let expr | lhsNecLoc = locName attr- | otherwise = x-- tks | lhsNecLoc = [AGLocal attr noPos Nothing]- | otherwise = lexTokens noPos x-- in makeRule (if lhsNecLoc then _LHS else _LOC,attr)- (Expression noPos tks)- "self rule"- ----concatRE rsess = let (rss,ess) = unzip rsess- in (concat rss, concatSeq ess)---copyRule :: Identifier -> Identifier -> Bool -> Set Identifier -> (Map Identifier Identifier, (Identifier,[Identifier])) -> ([Rule], Seq Error)-copyRule nt con modcopy locals (env,(fld,as)) - = concatRE (map copyRu as)- - where - copyRu a- = ( [ makeRule (fld,a) - (Expression noPos tks)- (cruletxt sel)- ]- , err- )- - where - sel - | not modcopy - && Set.member a locals = Just _LOC- | otherwise = Map.lookup a env-- (expr,err) - = case sel of- Nothing -> ( missingRuleErrorExpr nt con fld a- , Seq.single (MissingRule nt con fld a)- )- Just f - | f == _ACHILD -> ( fieldName a- , Seq.single (deprecatedCopyRuleError nt con fld a)- )- | otherwise -> ( attrName f a- , Seq.empty- )- - (tks,err')- = case sel of- Nothing -> ( [HsToken (missingRuleErrorExpr nt con fld a) noPos]- , Seq.single (MissingRule nt con fld a)- )- Just f - | f == _ACHILD -> ( [AGLocal a noPos Nothing]- , Seq.single (deprecatedCopyRuleError nt con fld a)- )- | otherwise -> ( [AGField f a noPos Nothing]- , Seq.empty- )-- cruletxt sel- | local = "copy rule (from local)"- | deprChild = "deprecated child copy"- | Set.member a locals && nonlocal = "modified copy rule"- | incoming && outgoing = "copy rule (chain)"- | incoming = "copy rule (down)"- | outgoing = "copy rule (up)"- | otherwise = "copy rule (chain)"- where outgoing = fld == _LHS- incoming = maybe False (== _LHS) sel- nonlocal = maybe False (/= _LOC) sel- local = maybe False (== _LOC) sel- deprChild = maybe False (== _ACHILD) sel--{- -multiRule replaces- loc.(a,b) = e-by - loc.tup1 = e- loc.(a,_) = @loc.tup1- loc.(_,b) = @loc.tup1-It needs to thread a unique number for inventing names for the tuples.--It also works for nested tuples:- loc.(a,(b,c)) = e-becomes- loc.tup1 = e- loc.(a,_) = @loc.tup1- loc.(_,tup2) = @loc.tup1- loc.(b,_) = @loc.tup2- loc.(_,c) = @loc.tup2--}--multiRule :: Rule -> Int -> ([Rule], Int) -multiRule (Rule pat expr owrt origin) uniq- = let f :: (Pattern->Pattern) -> Expression -> Pattern -> Int -> (Pattern, ([Rule], Int))- f w e (Product pos pats) n - = let freshName = Ident ("_tup" ++ show n) pos - freshExpr = Expression pos freshTks- freshTks = [AGField _LOC freshName pos Nothing]- freshPat = Alias _LOC freshName (Underscore pos) pats- a = length pats - 1- us b p = Product pos (replicate (a-b) (Underscore pos) ++ [p] ++ replicate b (Underscore pos))- g :: Pattern -> ([Pattern],[Rule],Int) -> ([Pattern],[Rule],Int)- g p (xs1,rs1,n1) = let (x2,(rs2,n2)) = f (us (length xs1)) freshExpr p n1- in (x2:xs1, rs2++rs1, n2)- (xs9,rs9,n9) = foldr g ([], [], n+1) pats- in ( freshPat- , ( Rule (w freshPat) e owrt origin : rs9- , n9- )- )- f w e p n - = ( p- , ( [Rule (w p) e owrt origin]- , n- )- )- in snd (f id expr pat uniq)---- Child --------------------------------------------------------{-- visit 0:- inherited attributes:- con : ConstructorIdent- cr : Bool- nt : NontermIdent- synthesized attributes:- errors : Seq Error- field : (Identifier,Type,Bool) - inherited : Attributes- name : Identifier- output : SELF- synthesized : Attributes- alternatives:- alternative Child:- child name : {Identifier}- child tp : {Type}- child inh : {Attributes}- child syn : {Attributes}- child higherOrder : {Bool}- visit 0:- local output : _--}--- cata-sem_Child :: Child ->- T_Child-sem_Child !(Child _name _tp _inh _syn _higherOrder) =- (sem_Child_Child _name _tp _inh _syn _higherOrder)--- semantic domain-newtype T_Child = T_Child (ConstructorIdent ->- Bool ->- NontermIdent ->- ( (Seq Error),( (Identifier,Type,Bool) ),Attributes,Identifier,Child,Attributes))-data Inh_Child = Inh_Child {con_Inh_Child :: !(ConstructorIdent),cr_Inh_Child :: !(Bool),nt_Inh_Child :: !(NontermIdent)}-data Syn_Child = Syn_Child {errors_Syn_Child :: !(Seq Error),field_Syn_Child :: !( (Identifier,Type,Bool) ),inherited_Syn_Child :: !(Attributes),name_Syn_Child :: !(Identifier),output_Syn_Child :: !(Child),synthesized_Syn_Child :: !(Attributes)}-wrap_Child !(T_Child sem) !(Inh_Child _lhsIcon _lhsIcr _lhsInt) =- (let ( !_lhsOerrors,!_lhsOfield,!_lhsOinherited,!_lhsOname,!_lhsOoutput,!_lhsOsynthesized) =- (sem _lhsIcon _lhsIcr _lhsInt)- in (Syn_Child _lhsOerrors _lhsOfield _lhsOinherited _lhsOname _lhsOoutput _lhsOsynthesized))-sem_Child_Child :: Identifier ->- Type ->- Attributes ->- Attributes ->- Bool ->- T_Child-sem_Child_Child !name_ !tp_ !inh_ !syn_ !higherOrder_ =- (T_Child (\ (!_lhsIcon)- (!_lhsIcr)- (!_lhsInt) ->- (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 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 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 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 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 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 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 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 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 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 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 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 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) }) }))+{-# OPTIONS_GHC -fbang-patterns #-} + +-- UUAGC 0.9.10 (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,1811 +1,1869 @@-{-# OPTIONS_GHC -fbang-patterns #-}--- UUAGC 0.9.5 (Desugar.ag)-module Desugar where--import qualified Data.Set as Set-import qualified Data.Map as Map-import Data.Map(Map)-import qualified UU.DData.Seq as Seq-import UU.DData.Seq(Seq,(<>))-import UU.Scanner.Position(Pos(..))-import Maybe-import Data.List(intersperse)--import AbstractSyntax-import ErrorMessages-import Options-import HsToken-import HsTokenScanner-import TokenDef---- AbstractSyntax.ag imports-import Data.Set(Set)-import Data.Map(Map)-import Patterns (Pattern(..),Patterns)-import Expression (Expression(..))-import CommonTypes---- Patterns.ag imports-import UU.Scanner.Position(Pos)-import CommonTypes (ConstructorIdent,Identifier)--import UU.Scanner.Position(Pos)-import HsToken--import CommonTypes-import UU.Scanner.Position(Pos)--addl :: Int -> Pos -> Pos-addl n (Pos l c f) = Pos (l+n) c f--maybeError :: a -> Error -> Maybe a -> (a, Seq Error)-maybeError def err mb- = maybe (def, Seq.single err) (\r -> (r, Seq.empty)) mb--findField :: Identifier -> Identifier -> [(Identifier,Identifier)] -> Maybe Identifier-findField fld attr list- | fld == _FIRST = f list- | fld == _LAST = f (reverse list)- | otherwise = Just fld- where- f = lookup attr--mergeAttributes :: AttrMap -> AttrMap -> AttrMap-mergeAttributes = Map.unionWith $ Map.unionWith $ Set.union--- Child --------------------------------------------------------{-- visit 0:- synthesized attributes:- childInhs : [(Identifier, Identifier)]- childSyns : [(Identifier, Identifier)]- output : SELF- alternatives:- alternative Child:- child name : {Identifier}- child tp : {Type}- child inh : {Attributes}- child syn : {Attributes}- child higherOrder : {Bool}- visit 0:- local output : _--}--- cata-sem_Child :: Child ->- T_Child-sem_Child !(Child _name _tp _inh _syn _higherOrder) =- (sem_Child_Child _name _tp _inh _syn _higherOrder)--- semantic domain-newtype T_Child = T_Child (( ([(Identifier, Identifier)]),([(Identifier, Identifier)]),Child))-data Inh_Child = Inh_Child {}-data Syn_Child = Syn_Child {childInhs_Syn_Child :: !([(Identifier, Identifier)]),childSyns_Syn_Child :: !([(Identifier, Identifier)]),output_Syn_Child :: !(Child)}-wrap_Child !(T_Child sem) !(Inh_Child ) =- (let ( !_lhsOchildInhs,!_lhsOchildSyns,!_lhsOoutput) =- (sem )- in (Syn_Child _lhsOchildInhs _lhsOchildSyns _lhsOoutput))-sem_Child_Child :: Identifier ->- Type ->- Attributes ->- Attributes ->- Bool ->- T_Child-sem_Child_Child !name_ !tp_ !inh_ !syn_ !higherOrder_ =- (T_Child (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 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 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 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 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.single (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 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 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 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 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 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.single $ DupRule _lhsInt _lhsIcon field_ attr_ _field'- else Seq.empty) of- { !_err2 ->- (case (__tup2) of- { !(_,!_err1) ->- (case (_err1 Seq.<> _err2 Seq.<> _patIerrors <> _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 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 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 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 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 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 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 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) }) }))+{-# OPTIONS_GHC -fbang-patterns #-} + +-- UUAGC 0.9.10 (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,159 +1,161 @@--- UUAGC 0.9.5 (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]+ + +-- UUAGC 0.9.10 (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,13 +1,15 @@--- UUAGC 0.9.5 (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])+ + +-- UUAGC 0.9.10 (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,5196 +1,5257 @@--- UUAGC 0.9.5 (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 UU.DData.Seq as Seq-import UU.DData.Seq(Seq)-import UU.Scanner.Position-import TokenDef-import HsToken-import HsTokenScanner--import Data.List(partition,intersperse,intersect,(\\))-import Maybe(fromJust,isJust)--import Patterns-import CommonTypes-import Data.Map(Map)-import Data.Set(Set)---- Patterns.ag imports-import UU.Scanner.Position(Pos)-import CommonTypes (ConstructorIdent,Identifier)--import Code (Decl,Expr)---- remove possible @v references in the types of a data type.-cleanupArg :: String -> String-cleanupArg s- = case idEvalType (SimpleType s) of- SimpleType s' -> s'--appContext :: ContextMap -> NontermIdent -> Code.Type -> Code.Type-appContext mp nt tp- = maybe tp (\ctx -> CtxApp (map (\(n,ns) -> (getName n, ns)) ctx) tp) $ Map.lookup nt mp--substSelf nt tp = case tp of- NT t tps | t == _SELF -> Haskell (getName nt ++ " " ++ unwords tps)- _ -> tp--mkLambdaArg :: String -> Maybe Code.Type -> Expr-mkLambdaArg nm Nothing = SimpleExpr nm-mkLambdaArg nm (Just tp) = TypedExpr (SimpleExpr nm) tp--mkLambda :: Exprs -> Expr -> Expr-mkLambda [] e = e-mkLambda xs e = Lambda xs e--typeAppStrs nm params = TypeApp (SimpleType nm) (map SimpleType params)---- dead code - replaced by mkPartitionedFunction-{--localCpsToExpr :: Bool -> [Decl] -> DeclBlocks -> Expr-localCpsToExpr o_case nextVisitDecl- = rec- where- rec cps- = case cps of- DeclTerminator decls expr- -> mkLet o_case (decls ++ nextVisitDecl) expr- DeclBlock decls (Decl lhs rhs _ _) remainder- -> let inDecls = [ PragmaDecl ("NOINLINE " ++ internalCpsName)- , Decl (Fun internalCpsName [SimpleExpr internalCpsVarName])- (mkLet o_case [Decl lhs (SimpleExpr internalCpsVarName) Set.empty Set.empty] (rec remainder))- Set.empty Set.empty- ]- inBody = App "head" [App "(:)" [App internalCpsName [rhs], App "(:)" [App internalCpsName [rhs], SimpleExpr "[]"]]]- outerBody = Let inDecls inBody- block = mkLet o_case decls outerBody- in block--internalCpsName :: String-internalCpsName = "internalCps_"--internalCpsVarName :: String-internalCpsVarName = "internalCps_var_"--}--mkPartitionedFunction :: String -> Bool -> [Decl] -> [String] -> DeclBlocks -> ([Decl], Expr)-mkPartitionedFunction prefix optCase nextVisitDecls lastExprVars cpsTree- = let inh = Inh_DeclBlocksRoot { prefix_Inh_DeclBlocksRoot = prefix- , optCase_Inh_DeclBlocksRoot = optCase- , nextVisitDecls_Inh_DeclBlocksRoot = nextVisitDecls- , lastExprVars_Inh_DeclBlocksRoot = lastExprVars- }- sem = sem_DeclBlocksRoot (DeclBlocksRoot cpsTree)- syn = wrap_DeclBlocksRoot sem inh- in (lambdas_Syn_DeclBlocksRoot syn, firstCall_Syn_DeclBlocksRoot syn)--freevars :: [String] -> [Decl] -> [String]-freevars additional decls- = Set.toList (allused `Set.difference` alldefined)- where- allused = Set.unions (Set.fromList additional : map usedvars decls)- alldefined = Set.unions (map definedvars decls)- - usedvars (Decl _ _ _ uses) = uses- usedvars _ = Set.empty- - definedvars (Decl _ _ defs _) = defs- definedvars _ = Set.empty--mkBlockLambda :: Bool -> String -> [String] -> [Decl] -> Expr -> Decl-mkBlockLambda optCase name args decls expr- = Decl lhs rhs Set.empty Set.empty- where- lhs = Fun name (map SimpleExpr args)- rhs = mkLet optCase decls expr--evalType :: (String -> String) -> Code.Type -> Code.Type-evalType replf t- = chase t- where- chase t- = case t of- Arr l r -> Arr (chase l) (chase r)- TypeApp f as -> TypeApp (chase f) (map chase as)- TupleType tps -> TupleType (map chase tps)- UnboxedTupleType tps -> UnboxedTupleType (map chase tps)- Code.List tp -> Code.List (chase tp)- SimpleType txt -> let tks = lexTokens (initPos txt) txt- tks' = map replaceTok tks- txt' = unlines . showTokens . tokensToStrings $ tks'- in SimpleType txt'-- replaceTok t- = case t of- AGLocal v p _ -> HsToken (replf $ getName v) p- _ -> t--idEvalType :: Code.Type -> Code.Type-idEvalType = evalType id--makeLocalComment :: Int -> String -> Identifier -> Maybe Type -> String-makeLocalComment width what name tp = let x = getName name- y = maybe "_" (\t -> case t of (NT nt tps) -> getName nt ++ " " ++ unwords tps; Haskell t -> '{':t++"}") tp- in ( what ++ " " ++ x ++ replicate ((width - length x) `max` 0) ' ' ++ " : " ++ y )----- Lets or nested Cases?-mkLet :: Bool -> Decls -> Expr -> Expr-mkLet False decls body = Let decls body-mkLet True decls body = foldr oneCase body decls--oneCase :: Decl -> Expr -> Expr-oneCase (Decl left rhs _ _) exp = Case rhs [CaseAlt left exp]-oneCase _ exp = exp---- Gives the name of the visit function-funname field 0 = show field ++ "_"-funname field nr = show field ++ "_" ++ show nr---- Gives the name of a semantic function-seqSemname :: String -> NontermIdent -> ConstructorIdent -> Int -> String-seqSemname pre nt con 0 = semname pre nt con-seqSemname pre nt con nr = semname pre nt con ++ "_" ++ show nr---- Gives the name of a type-typeName :: NontermIdent -> Int -> String-typeName nt 0 = "T_" ++ show nt-typeName nt n = "T_" ++ show nt ++ "_" ++ show n--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 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 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 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 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 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 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 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.single (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 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 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 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 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 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 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 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 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 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))))+ + +-- UUAGC 0.9.10 (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 + in ( _lhsOallTpsFound,_lhsOblockDecls,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOerrors,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars))) )
src-derived/HsToken.hs view
@@ -1,52 +1,54 @@--- UUAGC 0.9.5 (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)+ + +-- UUAGC 0.9.10 (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,47 +1,49 @@--- UUAGC 0.9.5 (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]+ + +-- UUAGC 0.9.10 (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,951 +1,977 @@-{-# OPTIONS_GHC -fbang-patterns #-}--- UUAGC 0.9.5 (InterfacesRules.lag)-module InterfacesRules where--import Interfaces-import SequentialTypes-import CodeSyntax-import GrammarInfo--import UU.DData.Seq as 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 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 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 (Seq.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 (Seq.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 (Seq.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 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 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 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 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) }) }) }) }) })))+{-# OPTIONS_GHC -fbang-patterns #-} + +-- UUAGC 0.9.10 (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,3483 +1,3536 @@--- UUAGC 0.9.5 (Order.ag)-module Order where---- From uuagc-import CommonTypes-import Patterns-import ErrorMessages-import AbstractSyntax-import Code hiding (Type)-import qualified Code-import Expression-import Options-import SequentialComputation-import SequentialTypes-import CodeSyntax-import GrammarInfo-import HsToken(HsTokensRoot(HsTokensRoot))-import HsTokenScanner(lexTokens)-import SemHsTokens(sem_HsTokensRoot,wrap_HsTokensRoot, Syn_HsTokensRoot(..),Inh_HsTokensRoot(..))--- From uulib-import qualified Data.Map as Map-import qualified Data.Set as Set-import qualified UU.DData.Seq as Seq-import Data.Map(Map) -import Data.Set(Set)-import UU.DData.Seq(Seq, (<>)) -import UU.Util.Utils-import UU.Scanner.Position(Pos(..),initPos)---- From haskell libraries-import Control.Monad(liftM)-import qualified Data.Array as Array-import Data.Array((!),bounds,inRange)-import Data.List(elemIndex,partition,sort,mapAccumL,find,nubBy,intersperse,groupBy,transpose)-import qualified Data.Tree as Tree-import Maybe---- Patterns.ag imports-import UU.Scanner.Position(Pos)-import CommonTypes (ConstructorIdent,Identifier)--import UU.Scanner.Position(Pos)-import HsToken---- AbstractSyntax.ag imports-import Data.Set(Set)-import Data.Map(Map)-import Patterns (Pattern(..),Patterns)-import Expression (Expression(..))-import CommonTypes---- Terminates with an error if the key is not in the map-findWithErr1 :: (Ord k, Show k) => String -> k -> Map k a -> a-findWithErr1 s k- = Map.findWithDefault (error ("findWithErr1 " ++ s ++ ": key " ++ show k ++ " not in map.")) k--findWithErr2 :: (Ord k, Show k, Show a) => k -> Map k a -> a-findWithErr2 k m- = Map.findWithDefault (error ("findWithErr2: key " ++ show k ++ " not in map: " ++ show m)) k m--getNtName :: Type -> NontermIdent-getNtName (NT nt _) = nt-getNtName _ = nullIdent--data AltAttr = AltAttr Identifier Identifier Bool - deriving (Eq, Ord, Show)--substSelf nt tp- = case tp of- NT n tps | n == _SELF -> NT nt tps- _ -> tp- -haskellTupel :: [Type] -> Maybe Type-haskellTupel ts = Just ( Haskell ( '(' : (concat (intersperse "," (map show ts))) ++ ")" ))--lookupVertices :: Identifier -> Identifier -> Map AltAttr Int -> [Int]-lookupVertices fld nm attrs- = catMaybes ( [Map.lookup (AltAttr fld nm False) attrs] -- look for all "out" attributes- ++ if fld == _LOC- then [Map.lookup (AltAttr fld nm True) attrs]- else []- )--swap (a,b) = (b,a)--showPath :: Table CRule -> [Vertex] -> [String]-showPath ruleTable path- = let look a | inRange (bounds ruleTable) a = [showOrigin (ruleTable ! a)]- | otherwise = ["Vertex " ++ show a]- showOrigin cr | getHasCode cr && getName (getAttr cr) /= "self" = prettyCRule cr ++ " (" ++ show (getPos (getAttr cr)) ++ ")"- | otherwise = prettyCRule cr- in concatMap look path---showPathLocal :: Table CRule -> [Vertex] -> [String]-showPathLocal _ [] = []-showPathLocal ruleTable xs = showP (xs++[-1])- where showP [] = []- showP (v1:v2:vs) = let line = step v1 v2- lines = showP vs- in line:lines- step v1 v2 = " - " ++ a1- where r1 = ruleTable ! v1- a1 = show (getAttr r1)---limitTo :: Int -> [String] -> [String]-limitTo _ [] = [] -limitTo 0 _ = ["....etcetera, etcetera...."]-limitTo n (x:xs) = x : limitTo (n-1) xs--showPathNice :: Table CRule -> [Vertex] -> [String]-showPathNice _ [] = []-showPathNice ruleTable xs = limitTo 100 (showP ((-1):xs++[-1]))- where [maxf, maxa, maxn, maxc] = maxWidths ruleTable (take 100 xs)- showP [] = []- showP (v1:v2:vs) = let line = step v1 v2- lines = showP vs- in if null line then lines else line:lines- step v1 v2 | last && first = induced- | last && isSyn r1 = "pass up " ++ alignR maxf "" ++ " " ++ alignL maxa a1 ++ " in " ++ alignR maxn n1 ++ "|" ++ c1 ++ induced- | first&& not(isSyn r2) = "get from above " ++ alignR maxf "" ++ " " ++ alignL maxa a2 ++ " in " ++ alignR maxn n2 ++ "|" ++ c2- | last = "pass down " ++ alignR maxf f1 ++ "." ++ a1 ++ induced- | isSyn r2 = "get from below " ++ alignR maxf f2 ++ "." ++ alignL maxa a2 ++ " in " ++ alignR maxn n2 ++ "|" ++ c2- | isLocal r1 = if head a1 == '_' - then ""- else "calculate " ++ alignR maxf "loc" ++ "." ++ a1- | otherwise = "pass down " ++ alignR maxf f1 ++ "." ++ alignL maxa a1 ++ " to " ++ alignR maxn n2 ++ "|" ++ c2- where- first = v1<0- last = v2<0- r1 = ruleTable ! v1- r2 = ruleTable ! v2- a1 = show (getAttr r1)- a2 = show (getAttr r2)- f1 = show (getField r1)- f2 = show (getField r2)- n1 = show (getLhsNt r1)- n2 = show (getLhsNt r2)- c1 = show (getCon r1)- c2 = show (getCon r2)- induced | v2== -2 = " INDUCED dependency to "- | otherwise = ""---maxWidths ruleTable vs- = map maximum (transpose (map getWidth vs))- where getWidth v | v<0 = [0,0,0,0]- | otherwise = map (length . show . ($ (ruleTable!v))) [getField, getAttr, getLhsNt, getCon]--alignL n xs | k<n = xs ++ replicate (n-k) ' '- | otherwise = xs- where k = length xs--alignR n xs | k<n = replicate (n-k) ' ' ++ xs- | otherwise = xs- where k = length xs--localCycleErr :: Table CRule -> Bool -> Route -> Error-localCycleErr ruleTable o_visit (s:path)- = let cr = ruleTable ! s- attr = getAttr cr- nt = getLhsNt cr- con = getCon cr- in LocalCirc nt con attr o_visit (showPathLocal ruleTable path)--instCycleErr :: Table CRule -> Bool -> Route -> Error-instCycleErr ruleTable o_visit (s:path)- = let cr = ruleTable ! s- attr = getAttr cr- nt = getLhsNt cr- con = getCon cr- in InstCirc nt con attr o_visit (showPathLocal ruleTable path)--directCycleErrs :: Table NTAttr -> Table CRule -> Bool -> [EdgeRoutes] -> [Error]-directCycleErrs attrTable ruleTable o_visit xs- = let getNont v = case attrTable ! v of- NTASyn nt _ _ -> nt- NTAInh nt _ _ -> nt- getAttr v = case attrTable ! v of- NTASyn _ a _ -> a- NTAInh _ a _ -> a- sameNont ((v1,_),_,_) ((v2,_),_,_) = getNont v1 == getNont v2- procCycle ((v1,v2),p1,p2) = ((getAttr v1, getAttr v2), showPathNice ruleTable p1, showPathNice ruleTable p2)- wrapGroup gr@(((v1,_),_,_):_) = DirectCirc (getNont v1) o_visit (map procCycle gr)- in map wrapGroup (groupBy sameNont xs)--inducedCycleErrs :: Table NTAttr -> Table CRule -> CInterfaceMap -> [EdgeRoutes] -> [Error]-inducedCycleErrs attrTable ruleTable cim xs- = let getNont v = case attrTable ! v of- NTASyn nt _ _ -> nt- NTAInh nt _ _ -> nt- getAttr v = case attrTable ! v of- NTASyn _ a _ -> a- NTAInh _ a _ -> a- sameNont ((v1,_),_,_) ((v2,_),_,_) = getNont v1 == getNont v2- procCycle ((v1,v2),p1,p2) = ((getAttr v1, getAttr v2), showPathNice ruleTable p1, showPathNice ruleTable p2)- wrapGroup gr@(((v1,_),_,_):_) = InducedCirc (getNont v1) (findWithErr1 "inducedCycleErr.cinter" (getNont v1) cim) (map procCycle gr)- in map wrapGroup (groupBy sameNont xs)--- Child --------------------------------------------------------{-- visit 0:- inherited attributes:- allfields : [(Identifier,Type,Bool)]- allnts : [Identifier]- attrs : [(Identifier,Identifier)]- con : Identifier- inh : Attributes- nt : Identifier- o_unbox : Bool- syn : Attributes- synthesized attributes:- attributes : [(Identifier,Attributes,Attributes)]- collectChildrenSyns : Map Identifier Attributes - errors : Seq Error- field : (Identifier,Type,Bool)- gathAltAttrs : [AltAttr]- gathRules : Seq CRule- inhs : Seq (Identifier,Attributes)- nts : Seq (Identifier,NontermIdent)- singlevisits : [CRule]- terminals : [Identifier]- alternatives:- alternative Child:- child name : {Identifier}- child tp : {Type}- child inh : {Attributes}- child syn : {Attributes}- child higherOrder : {Bool}- visit 0:- local maptolocal : _- local gathRules : _--}--- cata-sem_Child :: Child ->- T_Child-sem_Child (Child _name _tp _inh _syn _higherOrder) =- (sem_Child_Child _name _tp _inh _syn _higherOrder)--- semantic domain-newtype T_Child = T_Child (([(Identifier,Type,Bool)]) ->- ([Identifier]) ->- ([(Identifier,Identifier)]) ->- Identifier ->- Attributes ->- Identifier ->- Bool ->- Attributes ->- ( ([(Identifier,Attributes,Attributes)]),(Map Identifier Attributes ),(Seq Error),((Identifier,Type,Bool)),([AltAttr]),(Seq CRule),(Seq (Identifier,Attributes)),(Seq (Identifier,NontermIdent)),([CRule]),([Identifier])))-data Inh_Child = Inh_Child {allfields_Inh_Child :: !([(Identifier,Type,Bool)]),allnts_Inh_Child :: !([Identifier]),attrs_Inh_Child :: !([(Identifier,Identifier)]),con_Inh_Child :: !(Identifier),inh_Inh_Child :: !(Attributes),nt_Inh_Child :: !(Identifier),o_unbox_Inh_Child :: !(Bool),syn_Inh_Child :: !(Attributes)}-data Syn_Child = Syn_Child {attributes_Syn_Child :: !([(Identifier,Attributes,Attributes)]),collectChildrenSyns_Syn_Child :: !(Map Identifier Attributes ),errors_Syn_Child :: !(Seq Error),field_Syn_Child :: !((Identifier,Type,Bool)),gathAltAttrs_Syn_Child :: !([AltAttr]),gathRules_Syn_Child :: !(Seq CRule),inhs_Syn_Child :: !(Seq (Identifier,Attributes)),nts_Syn_Child :: !(Seq (Identifier,NontermIdent)),singlevisits_Syn_Child :: !([CRule]),terminals_Syn_Child :: !([Identifier])}-wrap_Child (T_Child sem) (Inh_Child _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsInt _lhsIo_unbox _lhsIsyn) =- (let ( _lhsOattributes,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfield,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals) =- (sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsInt _lhsIo_unbox _lhsIsyn)- in (Syn_Child _lhsOattributes _lhsOcollectChildrenSyns _lhsOerrors _lhsOfield _lhsOgathAltAttrs _lhsOgathRules _lhsOinhs _lhsOnts _lhsOsinglevisits _lhsOterminals))-sem_Child_Child :: Identifier ->- Type ->- Attributes ->- Attributes ->- Bool ->- T_Child-sem_Child_Child name_ tp_ inh_ syn_ higherOrder_ =- (T_Child (\ _lhsIallfields- _lhsIallnts- _lhsIattrs- _lhsIcon- _lhsIinh- _lhsInt- _lhsIo_unbox- _lhsIsyn ->- (let _lhsOgathAltAttrs :: ([AltAttr])- _lhsOnts :: (Seq (Identifier,NontermIdent))- _lhsOinhs :: (Seq (Identifier,Attributes))- _lhsOcollectChildrenSyns :: (Map Identifier Attributes )- _lhsOsinglevisits :: ([CRule])- _lhsOterminals :: ([Identifier])- _lhsOattributes :: ([(Identifier,Attributes,Attributes)])- _lhsOfield :: ((Identifier,Type,Bool))- _lhsOerrors :: (Seq Error)- _lhsOgathRules :: (Seq CRule)- -- "Order.ag"(line 156, column 13)- _maptolocal =- case tp_ of- NT nt _ -> Map.null syn_- _ -> True- -- "Order.ag"(line 159, column 13)- _lhsOgathAltAttrs =- if _maptolocal- then [ AltAttr _LOC name_ True ]- else [ AltAttr name_ syn True | syn <- Map.keys syn_ ]- -- "Order.ag"(line 174, column 13)- _lhsOnts =- Seq.single (name_,getNtName tp_)- -- "Order.ag"(line 175, column 13)- _lhsOinhs =- Seq.single (name_,inh_)- -- "Order.ag"(line 191, column 13)- _gathRules =- if _maptolocal- then Seq.single (cRuleTerminal name_ _lhsInt _lhsIcon tp_)- else Seq.fromList [ cRuleRhsSyn syn _lhsInt _lhsIcon tp name_ (getNtName tp_) | (syn,tp) <- Map.assocs syn_]- -- "Order.ag"(line 316, column 12)- _lhsOcollectChildrenSyns =- Map.singleton name_ syn_- -- "Order.ag"(line 476, column 11)- _lhsOsinglevisits =- if _maptolocal- then []- else [CChildVisit name_ (getNtName tp_) 0 inh_ syn_ True]- -- "Order.ag"(line 497, column 11)- _lhsOterminals =- if _maptolocal- then [name_]- else []- -- "Order.ag"(line 526, column 11)- _lhsOattributes =- [(name_, inh_, syn_)]- -- "Order.ag"(line 530, column 11)- _lhsOfield =- (name_, tp_, higherOrder_)- -- use rule "Order.ag"(line 63, column 70)- _lhsOerrors =- Seq.empty- -- use rule "Order.ag"(line 185, column 23)- _lhsOgathRules =- _gathRules- in ( _lhsOattributes,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfield,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals))))--- Children -----------------------------------------------------{-- visit 0:- inherited attributes:- allfields : [(Identifier,Type,Bool)]- allnts : [Identifier]- attrs : [(Identifier,Identifier)]- con : Identifier- inh : Attributes- nt : Identifier- o_unbox : Bool- syn : Attributes- synthesized attributes:- attributes : [(Identifier,Attributes,Attributes)]- collectChildrenSyns : Map Identifier Attributes - errors : Seq Error- fields : [(Identifier,Type,Bool)]- gathAltAttrs : [AltAttr]- gathRules : Seq CRule- inhs : Seq (Identifier,Attributes)- nts : Seq (Identifier,NontermIdent)- singlevisits : [CRule]- terminals : [Identifier]- alternatives:- alternative Cons:- child hd : Child- child tl : Children- alternative Nil:--}--- cata-sem_Children :: Children ->- T_Children-sem_Children list =- (Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list))--- semantic domain-newtype T_Children = T_Children (([(Identifier,Type,Bool)]) ->- ([Identifier]) ->- ([(Identifier,Identifier)]) ->- Identifier ->- Attributes ->- Identifier ->- Bool ->- Attributes ->- ( ([(Identifier,Attributes,Attributes)]),(Map Identifier Attributes ),(Seq Error),([(Identifier,Type,Bool)]),([AltAttr]),(Seq CRule),(Seq (Identifier,Attributes)),(Seq (Identifier,NontermIdent)),([CRule]),([Identifier])))-data Inh_Children = Inh_Children {allfields_Inh_Children :: !([(Identifier,Type,Bool)]),allnts_Inh_Children :: !([Identifier]),attrs_Inh_Children :: !([(Identifier,Identifier)]),con_Inh_Children :: !(Identifier),inh_Inh_Children :: !(Attributes),nt_Inh_Children :: !(Identifier),o_unbox_Inh_Children :: !(Bool),syn_Inh_Children :: !(Attributes)}-data Syn_Children = Syn_Children {attributes_Syn_Children :: !([(Identifier,Attributes,Attributes)]),collectChildrenSyns_Syn_Children :: !(Map Identifier Attributes ),errors_Syn_Children :: !(Seq Error),fields_Syn_Children :: !([(Identifier,Type,Bool)]),gathAltAttrs_Syn_Children :: !([AltAttr]),gathRules_Syn_Children :: !(Seq CRule),inhs_Syn_Children :: !(Seq (Identifier,Attributes)),nts_Syn_Children :: !(Seq (Identifier,NontermIdent)),singlevisits_Syn_Children :: !([CRule]),terminals_Syn_Children :: !([Identifier])}-wrap_Children (T_Children sem) (Inh_Children _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsInt _lhsIo_unbox _lhsIsyn) =- (let ( _lhsOattributes,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfields,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals) =- (sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsInt _lhsIo_unbox _lhsIsyn)- in (Syn_Children _lhsOattributes _lhsOcollectChildrenSyns _lhsOerrors _lhsOfields _lhsOgathAltAttrs _lhsOgathRules _lhsOinhs _lhsOnts _lhsOsinglevisits _lhsOterminals))-sem_Children_Cons :: T_Child ->- T_Children ->- T_Children-sem_Children_Cons (T_Child hd_) (T_Children tl_) =- (T_Children (\ _lhsIallfields- _lhsIallnts- _lhsIattrs- _lhsIcon- _lhsIinh- _lhsInt- _lhsIo_unbox- _lhsIsyn ->- (let _lhsOfields :: ([(Identifier,Type,Bool)])- _lhsOattributes :: ([(Identifier,Attributes,Attributes)])- _lhsOcollectChildrenSyns :: (Map Identifier Attributes )- _lhsOerrors :: (Seq Error)- _lhsOgathAltAttrs :: ([AltAttr])- _lhsOgathRules :: (Seq CRule)- _lhsOinhs :: (Seq (Identifier,Attributes))- _lhsOnts :: (Seq (Identifier,NontermIdent))- _lhsOsinglevisits :: ([CRule])- _lhsOterminals :: ([Identifier])- _hdOallfields :: ([(Identifier,Type,Bool)])- _hdOallnts :: ([Identifier])- _hdOattrs :: ([(Identifier,Identifier)])- _hdOcon :: Identifier- _hdOinh :: Attributes- _hdOnt :: Identifier- _hdOo_unbox :: Bool- _hdOsyn :: Attributes- _tlOallfields :: ([(Identifier,Type,Bool)])- _tlOallnts :: ([Identifier])- _tlOattrs :: ([(Identifier,Identifier)])- _tlOcon :: Identifier- _tlOinh :: Attributes- _tlOnt :: Identifier- _tlOo_unbox :: Bool- _tlOsyn :: Attributes- _hdIattributes :: ([(Identifier,Attributes,Attributes)])- _hdIcollectChildrenSyns :: (Map Identifier Attributes )- _hdIerrors :: (Seq Error)- _hdIfield :: ((Identifier,Type,Bool))- _hdIgathAltAttrs :: ([AltAttr])- _hdIgathRules :: (Seq CRule)- _hdIinhs :: (Seq (Identifier,Attributes))- _hdInts :: (Seq (Identifier,NontermIdent))- _hdIsinglevisits :: ([CRule])- _hdIterminals :: ([Identifier])- _tlIattributes :: ([(Identifier,Attributes,Attributes)])- _tlIcollectChildrenSyns :: (Map Identifier Attributes )- _tlIerrors :: (Seq Error)- _tlIfields :: ([(Identifier,Type,Bool)])- _tlIgathAltAttrs :: ([AltAttr])- _tlIgathRules :: (Seq CRule)- _tlIinhs :: (Seq (Identifier,Attributes))- _tlInts :: (Seq (Identifier,NontermIdent))- _tlIsinglevisits :: ([CRule])- _tlIterminals :: ([Identifier])- -- "Order.ag"(line 533, column 11)- _lhsOfields =- _hdIfield : _tlIfields- -- use rule "Order.ag"(line 524, column 32)- _lhsOattributes =- _hdIattributes ++ _tlIattributes- -- use rule "Order.ag"(line 314, column 47)- _lhsOcollectChildrenSyns =- _hdIcollectChildrenSyns `Map.union` _tlIcollectChildrenSyns- -- use rule "Order.ag"(line 63, column 70)- _lhsOerrors =- _hdIerrors Seq.<> _tlIerrors- -- use rule "Order.ag"(line 149, column 68)- _lhsOgathAltAttrs =- _hdIgathAltAttrs ++ _tlIgathAltAttrs- -- use rule "Order.ag"(line 185, column 23)- _lhsOgathRules =- _hdIgathRules Seq.<> _tlIgathRules- -- use rule "Order.ag"(line 172, column 20)- _lhsOinhs =- _hdIinhs Seq.<> _tlIinhs- -- use rule "Order.ag"(line 171, column 19)- _lhsOnts =- _hdInts Seq.<> _tlInts- -- use rule "Order.ag"(line 474, column 40)- _lhsOsinglevisits =- _hdIsinglevisits ++ _tlIsinglevisits- -- use rule "Order.ag"(line 495, 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 534, column 11)- _lhsOfields =- []- -- use rule "Order.ag"(line 524, column 32)- _lhsOattributes =- []- -- use rule "Order.ag"(line 314, column 47)- _lhsOcollectChildrenSyns =- Map.empty- -- use rule "Order.ag"(line 63, column 70)- _lhsOerrors =- Seq.empty- -- use rule "Order.ag"(line 149, column 68)- _lhsOgathAltAttrs =- []- -- use rule "Order.ag"(line 185, column 23)- _lhsOgathRules =- Seq.empty- -- use rule "Order.ag"(line 172, column 20)- _lhsOinhs =- Seq.empty- -- use rule "Order.ag"(line 171, column 19)- _lhsOnts =- Seq.empty- -- use rule "Order.ag"(line 474, column 40)- _lhsOsinglevisits =- []- -- use rule "Order.ag"(line 495, column 38)- _lhsOterminals =- []- in ( _lhsOattributes,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfields,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals))))--- Expression ---------------------------------------------------{-- visit 0:- inherited attributes:- allfields : [(Identifier,Type,Bool)]- allnts : [Identifier]- attrs : [(Identifier,Identifier)]- con : Identifier- nt : Identifier- synthesized attributes:- allRhsVars : Set (Identifier,Identifier)- copy : SELF- errors : Seq Error- textLines : [String]- usedAttrs : [(Identifier,Identifier)]- usedFields : [Identifier]- usedLocals : [Identifier]- alternatives:- alternative Expression:- child pos : {Pos}- child tks : {[HsToken]}- visit 0:- local _tup1 : _- local errors : _- local textLines : _- local usedAttrs : _- local usedLocals : _- local usedFields : _- local copy : _--}--- cata-sem_Expression :: Expression ->- T_Expression-sem_Expression (Expression _pos _tks) =- (sem_Expression_Expression _pos _tks)--- semantic domain-newtype T_Expression = T_Expression (([(Identifier,Type,Bool)]) ->- ([Identifier]) ->- ([(Identifier,Identifier)]) ->- Identifier ->- Identifier ->- ( (Set (Identifier,Identifier)),Expression,(Seq Error),([String]),([(Identifier,Identifier)]),([Identifier]),([Identifier])))-data Inh_Expression = Inh_Expression {allfields_Inh_Expression :: !([(Identifier,Type,Bool)]),allnts_Inh_Expression :: !([Identifier]),attrs_Inh_Expression :: !([(Identifier,Identifier)]),con_Inh_Expression :: !(Identifier),nt_Inh_Expression :: !(Identifier)}-data Syn_Expression = Syn_Expression {allRhsVars_Syn_Expression :: !(Set (Identifier,Identifier)),copy_Syn_Expression :: !(Expression),errors_Syn_Expression :: !(Seq Error),textLines_Syn_Expression :: !([String]),usedAttrs_Syn_Expression :: !([(Identifier,Identifier)]),usedFields_Syn_Expression :: !([Identifier]),usedLocals_Syn_Expression :: !([Identifier])}-wrap_Expression (T_Expression sem) (Inh_Expression _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsInt) =- (let ( _lhsOallRhsVars,_lhsOcopy,_lhsOerrors,_lhsOtextLines,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals) =- (sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsInt)- in (Syn_Expression _lhsOallRhsVars _lhsOcopy _lhsOerrors _lhsOtextLines _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals))-sem_Expression_Expression :: Pos ->- ([HsToken]) ->- T_Expression-sem_Expression_Expression pos_ tks_ =- (T_Expression (\ _lhsIallfields- _lhsIallnts- _lhsIattrs- _lhsIcon- _lhsInt ->- (let _lhsOallRhsVars :: (Set (Identifier,Identifier))- _lhsOcopy :: Expression- _lhsOerrors :: (Seq Error)- _lhsOtextLines :: ([String])- _lhsOusedAttrs :: ([(Identifier,Identifier)])- _lhsOusedFields :: ([Identifier])- _lhsOusedLocals :: ([Identifier])- -- "Order.ag"(line 336, 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 336, column 21)- (_errors,_,_,_,_) =- __tup1- -- "Order.ag"(line 336, column 21)- (_,_textLines,_,_,_) =- __tup1- -- "Order.ag"(line 336, column 21)- (_,_,_usedAttrs,_,_) =- __tup1- -- "Order.ag"(line 336, column 21)- (_,_,_,_usedLocals,_) =- __tup1- -- "Order.ag"(line 336, column 21)- (_,_,_,_,_usedFields) =- __tup1- -- "Order.ag"(line 354, 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 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 102, column 17)- _nontsOo_cata =- folds _lhsIoptions- -- "Order.ag"(line 102, column 17)- _nontsOo_data =- dataTypes _lhsIoptions- -- "Order.ag"(line 102, column 17)- _nontsOo_sig =- typeSigs _lhsIoptions- -- "Order.ag"(line 102, column 17)- _nontsOo_sem =- semfuns _lhsIoptions- -- "Order.ag"(line 102, column 17)- _nontsOo_rename =- rename _lhsIoptions- -- "Order.ag"(line 102, column 17)- _nontsOo_newtypes =- newtypes _lhsIoptions- -- "Order.ag"(line 102, column 17)- _nontsOo_wantvisit =- visit _lhsIoptions- -- "Order.ag"(line 102, column 17)- _nontsOo_dovisit =- visit _lhsIoptions && null _cyclesErrors- -- "Order.ag"(line 102, column 17)- _nontsOo_unbox =- unbox _lhsIoptions- -- "Order.ag"(line 102, column 17)- _nontsOo_case =- cases _lhsIoptions- -- "Order.ag"(line 102, column 17)- _nontsOprefix =- prefix _lhsIoptions- -- "Order.ag"(line 240, column 15)- _nontsOvcount =- 0- -- "Order.ag"(line 265, column 7)- _nontsOmanualAttrDepMap =- manualAttrOrderMap_- -- "Order.ag"(line 368, column 13)- _nontsOacount =- 0- -- "Order.ag"(line 406, column 13)- _ruleTable =- Array.array (0,_nontsIvcount-1) (Seq.toList _nontsIrules)- -- "Order.ag"(line 407, column 13)- _attrTable =- Array.array (0,_nontsIacount-1) (Seq.toList _nontsIntattrs)- -- "Order.ag"(line 408, column 13)- _attrVertex =- Map.fromList (map swap (Seq.toList _nontsIntattrs))- -- "Order.ag"(line 409, column 13)- _tdpToTds =- [ (s, maybe (-1) (\v -> findWithErr1 "Grammar.tdpToTds" v _attrVertex) (ntattr cr))- | (s,cr) <- Seq.toList _nontsIrules]- -- "Order.ag"(line 411, 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 415, column 13)- _directDep =- Seq.toList (_nontsIdirectDep Seq.<> _nontsIadditionalDep)- -- "Order.ag"(line 416, column 13)- _instDep =- Seq.toList _nontsIinstDep- -- "Order.ag"(line 417, column 13)- _info =- let def [] = -1- def (v:vs) = v- in Info { tdsToTdp = Array.array (0,_nontsIacount-1) _tdsToTdp- , tdpToTds = Array.array (0,_nontsIvcount-1) _tdpToTds- , attrTable = _attrTable- , ruleTable = _ruleTable- , lmh = Seq.toList _nontsIaranges- , nonts = _nontsInonts- , wraps = wrappers_- }- -- "Order.ag"(line 428, 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 428, column 17)- (_cInterfaceMap,_,_) =- __tup2- -- "Order.ag"(line 428, column 17)- (_,_cVisitsMap,_) =- __tup2- -- "Order.ag"(line 428, column 17)- (_,_,_cyclesErrors) =- __tup2- -- "Order.ag"(line 450, column 13)- _lhsOerrors =- (if withCycle _lhsIoptions then Seq.fromList _cyclesErrors else Seq.empty)- Seq.<> _nontsIerrors- -- "Order.ag"(line 482, column 15)- _lhsOoutput =- CGrammar typeSyns_ derivings_ wrappers_ _nontsIcNonterminals pragmas_ paramMap_ contextMap_- -- "Order.ag"(line 509, column 13)- _nontsOallnts =- map fst (_nontsInonts)- -- copy rule (from local)- _nontsOcInterfaceMap =- _cInterfaceMap- -- copy rule (from local)- _nontsOcVisitsMap =- _cVisitsMap- ( _nontsIacount,_nontsIadditionalDep,_nontsIaranges,_nontsIcNonterminals,_nontsIdirectDep,_nontsIerrors,_nontsIinstDep,_nontsInonts,_nontsIntattrs,_nontsIrules,_nontsIvcount) =- (nonts_ _nontsOacount _nontsOallnts _nontsOcInterfaceMap _nontsOcVisitsMap _nontsOmanualAttrDepMap _nontsOo_case _nontsOo_cata _nontsOo_data _nontsOo_dovisit _nontsOo_newtypes _nontsOo_rename _nontsOo_sem _nontsOo_sig _nontsOo_unbox _nontsOo_wantvisit _nontsOprefix _nontsOvcount)- in ( _lhsOerrors,_lhsOoutput))))--- Nonterminal --------------------------------------------------{-- visit 0:- inherited attributes:- allnts : [Identifier]- cInterfaceMap : CInterfaceMap- cVisitsMap : CVisitsMap- manualAttrDepMap : AttrOrderMap- o_case : Bool- o_cata : Bool- o_data : Bool- o_dovisit : Bool- o_newtypes : Bool- o_rename : Bool- o_sem : Bool- o_sig : Bool- o_unbox : Bool- o_wantvisit : Bool- prefix : String- chained attributes:- acount : Int- vcount : Int- synthesized attributes:- additionalDep : Seq Edge- aranges : Seq (Int,Int,Int)- cNonterminal : CNonterminal- directDep : Seq Edge- errors : Seq Error- instDep : Seq Edge- nonts : [(NontermIdent,[ConstructorIdent])]- ntattrs : Seq (Vertex,NTAttr)- rules : Seq (Vertex,CRule)- alternatives:- alternative Nonterminal:- child nt : {NontermIdent}- child params : {[Identifier]}- child inh : {Attributes}- child syn : {Attributes}- child prods : Productions- visit 0:- local ntattrs : _- local cInter : _--}--- cata-sem_Nonterminal :: Nonterminal ->- T_Nonterminal-sem_Nonterminal (Nonterminal _nt _params _inh _syn _prods) =- (sem_Nonterminal_Nonterminal _nt _params _inh _syn (sem_Productions _prods))--- semantic domain-newtype T_Nonterminal = T_Nonterminal (Int ->- ([Identifier]) ->- CInterfaceMap ->- CVisitsMap ->- AttrOrderMap ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- String ->- Int ->- ( Int,(Seq Edge),(Seq (Int,Int,Int)),CNonterminal,(Seq Edge),(Seq Error),(Seq Edge),([(NontermIdent,[ConstructorIdent])]),(Seq (Vertex,NTAttr)),(Seq (Vertex,CRule)),Int))-data Inh_Nonterminal = Inh_Nonterminal {acount_Inh_Nonterminal :: !(Int),allnts_Inh_Nonterminal :: !([Identifier]),cInterfaceMap_Inh_Nonterminal :: !(CInterfaceMap),cVisitsMap_Inh_Nonterminal :: !(CVisitsMap),manualAttrDepMap_Inh_Nonterminal :: !(AttrOrderMap),o_case_Inh_Nonterminal :: !(Bool),o_cata_Inh_Nonterminal :: !(Bool),o_data_Inh_Nonterminal :: !(Bool),o_dovisit_Inh_Nonterminal :: !(Bool),o_newtypes_Inh_Nonterminal :: !(Bool),o_rename_Inh_Nonterminal :: !(Bool),o_sem_Inh_Nonterminal :: !(Bool),o_sig_Inh_Nonterminal :: !(Bool),o_unbox_Inh_Nonterminal :: !(Bool),o_wantvisit_Inh_Nonterminal :: !(Bool),prefix_Inh_Nonterminal :: !(String),vcount_Inh_Nonterminal :: !(Int)}-data Syn_Nonterminal = Syn_Nonterminal {acount_Syn_Nonterminal :: !(Int),additionalDep_Syn_Nonterminal :: !(Seq Edge),aranges_Syn_Nonterminal :: !(Seq (Int,Int,Int)),cNonterminal_Syn_Nonterminal :: !(CNonterminal),directDep_Syn_Nonterminal :: !(Seq Edge),errors_Syn_Nonterminal :: !(Seq Error),instDep_Syn_Nonterminal :: !(Seq Edge),nonts_Syn_Nonterminal :: !([(NontermIdent,[ConstructorIdent])]),ntattrs_Syn_Nonterminal :: !(Seq (Vertex,NTAttr)),rules_Syn_Nonterminal :: !(Seq (Vertex,CRule)),vcount_Syn_Nonterminal :: !(Int)}-wrap_Nonterminal (T_Nonterminal sem) (Inh_Nonterminal _lhsIacount _lhsIallnts _lhsIcInterfaceMap _lhsIcVisitsMap _lhsImanualAttrDepMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIvcount) =- (let ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOcNonterminal,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOnonts,_lhsOntattrs,_lhsOrules,_lhsOvcount) =- (sem _lhsIacount _lhsIallnts _lhsIcInterfaceMap _lhsIcVisitsMap _lhsImanualAttrDepMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIvcount)- in (Syn_Nonterminal _lhsOacount _lhsOadditionalDep _lhsOaranges _lhsOcNonterminal _lhsOdirectDep _lhsOerrors _lhsOinstDep _lhsOnonts _lhsOntattrs _lhsOrules _lhsOvcount))-sem_Nonterminal_Nonterminal :: NontermIdent ->- ([Identifier]) ->- Attributes ->- Attributes ->- T_Productions ->- T_Nonterminal-sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ (T_Productions prods_) =- (T_Nonterminal (\ _lhsIacount- _lhsIallnts- _lhsIcInterfaceMap- _lhsIcVisitsMap- _lhsImanualAttrDepMap- _lhsIo_case- _lhsIo_cata- _lhsIo_data- _lhsIo_dovisit- _lhsIo_newtypes- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_unbox- _lhsIo_wantvisit- _lhsIprefix- _lhsIvcount ->- (let _prodsOnt :: Identifier- _prodsOinh :: Attributes- _prodsOsyn :: Attributes- _lhsOntattrs :: (Seq (Vertex,NTAttr))- _lhsOacount :: Int- _lhsOaranges :: (Seq (Int,Int,Int))- _lhsOnonts :: ([(NontermIdent,[ConstructorIdent])])- _lhsOcNonterminal :: CNonterminal- _lhsOadditionalDep :: (Seq Edge)- _lhsOdirectDep :: (Seq Edge)- _lhsOerrors :: (Seq Error)- _lhsOinstDep :: (Seq Edge)- _lhsOrules :: (Seq (Vertex,CRule))- _lhsOvcount :: Int- _prodsOallnts :: ([Identifier])- _prodsOcVisitsMap :: CVisitsMap- _prodsOmanualAttrDepMap :: AttrOrderMap- _prodsOo_case :: Bool- _prodsOo_cata :: Bool- _prodsOo_dovisit :: Bool- _prodsOo_newtypes :: Bool- _prodsOo_rename :: Bool- _prodsOo_sem :: Bool- _prodsOo_sig :: Bool- _prodsOo_unbox :: Bool- _prodsOo_wantvisit :: Bool- _prodsOprefix :: String- _prodsOvcount :: Int- _prodsIadditionalDep :: (Seq Edge)- _prodsIcProductions :: CProductions- _prodsIcons :: ([ConstructorIdent])- _prodsIdirectDep :: (Seq Edge)- _prodsIerrors :: (Seq Error)- _prodsIinstDep :: (Seq Edge)- _prodsIrules :: (Seq (Vertex,CRule))- _prodsIvcount :: Int- -- "Order.ag"(line 76, column 17)- _prodsOnt =- nt_- -- "Order.ag"(line 79, column 17)- _prodsOinh =- inh_- -- "Order.ag"(line 80, column 17)- _prodsOsyn =- syn_- -- "Order.ag"(line 371, column 17)- _ntattrs =- [ NTAInh nt_ inh tp | (inh,tp) <- Map.assocs inh_ ]- ++ [NTASyn nt_ syn tp | (syn,tp) <- Map.assocs syn_ ]- -- "Order.ag"(line 373, column 17)- _lhsOntattrs =- Seq.fromList (zip [_lhsIacount ..] _ntattrs)- -- "Order.ag"(line 374, column 17)- _lhsOacount =- _lhsIacount + Map.size inh_ + Map.size syn_- -- "Order.ag"(line 375, column 17)- _lhsOaranges =- Seq.single- (_lhsIacount- ,_lhsIacount + Map.size inh_- ,_lhsIacount + Map.size syn_ + Map.size inh_ - 1)- -- "Order.ag"(line 384, column 19)- _lhsOnonts =- [(nt_,_prodsIcons)]- -- "Order.ag"(line 459, column 19)- _cInter =- if _lhsIo_dovisit- then findWithErr1 "Nonterminal.cInter" nt_ _lhsIcInterfaceMap- else CInterface [CSegment inh_ syn_]- -- "Order.ag"(line 487, column 19)- _lhsOcNonterminal =- CNonterminal nt_ params_ inh_ syn_ _prodsIcProductions _cInter- -- use rule "Order.ag"(line 262, column 71)- _lhsOadditionalDep =- _prodsIadditionalDep- -- use rule "Order.ag"(line 248, column 33)- _lhsOdirectDep =- _prodsIdirectDep- -- use rule "Order.ag"(line 63, column 70)- _lhsOerrors =- _prodsIerrors- -- use rule "Order.ag"(line 295, column 31)- _lhsOinstDep =- _prodsIinstDep- -- use rule "Order.ag"(line 238, column 18)- _lhsOrules =- _prodsIrules- -- copy rule (up)- _lhsOvcount =- _prodsIvcount- -- copy rule (down)- _prodsOallnts =- _lhsIallnts- -- copy rule (down)- _prodsOcVisitsMap =- _lhsIcVisitsMap- -- copy rule (down)- _prodsOmanualAttrDepMap =- _lhsImanualAttrDepMap- -- copy rule (down)- _prodsOo_case =- _lhsIo_case- -- copy rule (down)- _prodsOo_cata =- _lhsIo_cata- -- copy rule (down)- _prodsOo_dovisit =- _lhsIo_dovisit- -- copy rule (down)- _prodsOo_newtypes =- _lhsIo_newtypes- -- copy rule (down)- _prodsOo_rename =- _lhsIo_rename- -- copy rule (down)- _prodsOo_sem =- _lhsIo_sem- -- copy rule (down)- _prodsOo_sig =- _lhsIo_sig- -- copy rule (down)- _prodsOo_unbox =- _lhsIo_unbox- -- copy rule (down)- _prodsOo_wantvisit =- _lhsIo_wantvisit- -- copy rule (down)- _prodsOprefix =- _lhsIprefix- -- copy rule (down)- _prodsOvcount =- _lhsIvcount- ( _prodsIadditionalDep,_prodsIcProductions,_prodsIcons,_prodsIdirectDep,_prodsIerrors,_prodsIinstDep,_prodsIrules,_prodsIvcount) =- (prods_ _prodsOallnts _prodsOcVisitsMap _prodsOinh _prodsOmanualAttrDepMap _prodsOnt _prodsOo_case _prodsOo_cata _prodsOo_dovisit _prodsOo_newtypes _prodsOo_rename _prodsOo_sem _prodsOo_sig _prodsOo_unbox _prodsOo_wantvisit _prodsOprefix _prodsOsyn _prodsOvcount)- in ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOcNonterminal,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOnonts,_lhsOntattrs,_lhsOrules,_lhsOvcount))))--- Nonterminals -------------------------------------------------{-- visit 0:- inherited attributes:- allnts : [Identifier]- cInterfaceMap : CInterfaceMap- cVisitsMap : CVisitsMap- manualAttrDepMap : AttrOrderMap- o_case : Bool- o_cata : Bool- o_data : Bool- o_dovisit : Bool- o_newtypes : Bool- o_rename : Bool- o_sem : Bool- o_sig : Bool- o_unbox : Bool- o_wantvisit : Bool- prefix : String- chained attributes:- acount : Int- vcount : Int- synthesized attributes:- additionalDep : Seq Edge- aranges : Seq (Int,Int,Int)- cNonterminals : CNonterminals- directDep : Seq Edge- errors : Seq Error- instDep : Seq Edge- nonts : [(NontermIdent,[ConstructorIdent])]- ntattrs : Seq (Vertex,NTAttr)- rules : Seq (Vertex,CRule)- alternatives:- alternative Cons:- child hd : Nonterminal- child tl : Nonterminals- alternative Nil:--}--- cata-sem_Nonterminals :: Nonterminals ->- T_Nonterminals-sem_Nonterminals list =- (Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list))--- semantic domain-newtype T_Nonterminals = T_Nonterminals (Int ->- ([Identifier]) ->- CInterfaceMap ->- CVisitsMap ->- AttrOrderMap ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- String ->- Int ->- ( Int,(Seq Edge),(Seq (Int,Int,Int)),CNonterminals,(Seq Edge),(Seq Error),(Seq Edge),([(NontermIdent,[ConstructorIdent])]),(Seq (Vertex,NTAttr)),(Seq (Vertex,CRule)),Int))-data Inh_Nonterminals = Inh_Nonterminals {acount_Inh_Nonterminals :: !(Int),allnts_Inh_Nonterminals :: !([Identifier]),cInterfaceMap_Inh_Nonterminals :: !(CInterfaceMap),cVisitsMap_Inh_Nonterminals :: !(CVisitsMap),manualAttrDepMap_Inh_Nonterminals :: !(AttrOrderMap),o_case_Inh_Nonterminals :: !(Bool),o_cata_Inh_Nonterminals :: !(Bool),o_data_Inh_Nonterminals :: !(Bool),o_dovisit_Inh_Nonterminals :: !(Bool),o_newtypes_Inh_Nonterminals :: !(Bool),o_rename_Inh_Nonterminals :: !(Bool),o_sem_Inh_Nonterminals :: !(Bool),o_sig_Inh_Nonterminals :: !(Bool),o_unbox_Inh_Nonterminals :: !(Bool),o_wantvisit_Inh_Nonterminals :: !(Bool),prefix_Inh_Nonterminals :: !(String),vcount_Inh_Nonterminals :: !(Int)}-data Syn_Nonterminals = Syn_Nonterminals {acount_Syn_Nonterminals :: !(Int),additionalDep_Syn_Nonterminals :: !(Seq Edge),aranges_Syn_Nonterminals :: !(Seq (Int,Int,Int)),cNonterminals_Syn_Nonterminals :: !(CNonterminals),directDep_Syn_Nonterminals :: !(Seq Edge),errors_Syn_Nonterminals :: !(Seq Error),instDep_Syn_Nonterminals :: !(Seq Edge),nonts_Syn_Nonterminals :: !([(NontermIdent,[ConstructorIdent])]),ntattrs_Syn_Nonterminals :: !(Seq (Vertex,NTAttr)),rules_Syn_Nonterminals :: !(Seq (Vertex,CRule)),vcount_Syn_Nonterminals :: !(Int)}-wrap_Nonterminals (T_Nonterminals sem) (Inh_Nonterminals _lhsIacount _lhsIallnts _lhsIcInterfaceMap _lhsIcVisitsMap _lhsImanualAttrDepMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIvcount) =- (let ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOcNonterminals,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOnonts,_lhsOntattrs,_lhsOrules,_lhsOvcount) =- (sem _lhsIacount _lhsIallnts _lhsIcInterfaceMap _lhsIcVisitsMap _lhsImanualAttrDepMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIvcount)- in (Syn_Nonterminals _lhsOacount _lhsOadditionalDep _lhsOaranges _lhsOcNonterminals _lhsOdirectDep _lhsOerrors _lhsOinstDep _lhsOnonts _lhsOntattrs _lhsOrules _lhsOvcount))-sem_Nonterminals_Cons :: T_Nonterminal ->- T_Nonterminals ->- T_Nonterminals-sem_Nonterminals_Cons (T_Nonterminal hd_) (T_Nonterminals tl_) =- (T_Nonterminals (\ _lhsIacount- _lhsIallnts- _lhsIcInterfaceMap- _lhsIcVisitsMap- _lhsImanualAttrDepMap- _lhsIo_case- _lhsIo_cata- _lhsIo_data- _lhsIo_dovisit- _lhsIo_newtypes- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_unbox- _lhsIo_wantvisit- _lhsIprefix- _lhsIvcount ->- (let _lhsOcNonterminals :: CNonterminals- _lhsOadditionalDep :: (Seq Edge)- _lhsOaranges :: (Seq (Int,Int,Int))- _lhsOdirectDep :: (Seq Edge)- _lhsOerrors :: (Seq Error)- _lhsOinstDep :: (Seq Edge)- _lhsOnonts :: ([(NontermIdent,[ConstructorIdent])])- _lhsOntattrs :: (Seq (Vertex,NTAttr))- _lhsOrules :: (Seq (Vertex,CRule))- _lhsOacount :: Int- _lhsOvcount :: Int- _hdOacount :: Int- _hdOallnts :: ([Identifier])- _hdOcInterfaceMap :: CInterfaceMap- _hdOcVisitsMap :: CVisitsMap- _hdOmanualAttrDepMap :: AttrOrderMap- _hdOo_case :: Bool- _hdOo_cata :: Bool- _hdOo_data :: Bool- _hdOo_dovisit :: Bool- _hdOo_newtypes :: Bool- _hdOo_rename :: Bool- _hdOo_sem :: Bool- _hdOo_sig :: Bool- _hdOo_unbox :: Bool- _hdOo_wantvisit :: Bool- _hdOprefix :: String- _hdOvcount :: Int- _tlOacount :: Int- _tlOallnts :: ([Identifier])- _tlOcInterfaceMap :: CInterfaceMap- _tlOcVisitsMap :: CVisitsMap- _tlOmanualAttrDepMap :: AttrOrderMap- _tlOo_case :: Bool- _tlOo_cata :: Bool- _tlOo_data :: Bool- _tlOo_dovisit :: Bool- _tlOo_newtypes :: Bool- _tlOo_rename :: Bool- _tlOo_sem :: Bool- _tlOo_sig :: Bool- _tlOo_unbox :: Bool- _tlOo_wantvisit :: Bool- _tlOprefix :: String- _tlOvcount :: Int- _hdIacount :: Int- _hdIadditionalDep :: (Seq Edge)- _hdIaranges :: (Seq (Int,Int,Int))- _hdIcNonterminal :: CNonterminal- _hdIdirectDep :: (Seq Edge)- _hdIerrors :: (Seq Error)- _hdIinstDep :: (Seq Edge)- _hdInonts :: ([(NontermIdent,[ConstructorIdent])])- _hdIntattrs :: (Seq (Vertex,NTAttr))- _hdIrules :: (Seq (Vertex,CRule))- _hdIvcount :: Int- _tlIacount :: Int- _tlIadditionalDep :: (Seq Edge)- _tlIaranges :: (Seq (Int,Int,Int))- _tlIcNonterminals :: CNonterminals- _tlIdirectDep :: (Seq Edge)- _tlIerrors :: (Seq Error)- _tlIinstDep :: (Seq Edge)- _tlInonts :: ([(NontermIdent,[ConstructorIdent])])- _tlIntattrs :: (Seq (Vertex,NTAttr))- _tlIrules :: (Seq (Vertex,CRule))- _tlIvcount :: Int- -- "Order.ag"(line 484, column 12)- _lhsOcNonterminals =- _hdIcNonterminal : _tlIcNonterminals- -- use rule "Order.ag"(line 262, column 71)- _lhsOadditionalDep =- _hdIadditionalDep Seq.<> _tlIadditionalDep- -- use rule "Order.ag"(line 365, column 36)- _lhsOaranges =- _hdIaranges Seq.<> _tlIaranges- -- use rule "Order.ag"(line 248, column 33)- _lhsOdirectDep =- _hdIdirectDep Seq.<> _tlIdirectDep- -- use rule "Order.ag"(line 63, column 70)- _lhsOerrors =- _hdIerrors Seq.<> _tlIerrors- -- use rule "Order.ag"(line 295, column 31)- _lhsOinstDep =- _hdIinstDep Seq.<> _tlIinstDep- -- use rule "Order.ag"(line 382, column 43)- _lhsOnonts =- _hdInonts ++ _tlInonts- -- use rule "Order.ag"(line 364, column 35)- _lhsOntattrs =- _hdIntattrs Seq.<> _tlIntattrs- -- use rule "Order.ag"(line 238, 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 485, column 12)- _lhsOcNonterminals =- []- -- use rule "Order.ag"(line 262, column 71)- _lhsOadditionalDep =- Seq.empty- -- use rule "Order.ag"(line 365, column 36)- _lhsOaranges =- Seq.empty- -- use rule "Order.ag"(line 248, column 33)- _lhsOdirectDep =- Seq.empty- -- use rule "Order.ag"(line 63, column 70)- _lhsOerrors =- Seq.empty- -- use rule "Order.ag"(line 295, column 31)- _lhsOinstDep =- Seq.empty- -- use rule "Order.ag"(line 382, column 43)- _lhsOnonts =- []- -- use rule "Order.ag"(line 364, column 35)- _lhsOntattrs =- Seq.empty- -- use rule "Order.ag"(line 238, column 18)- _lhsOrules =- Seq.empty- -- copy rule (chain)- _lhsOacount =- _lhsIacount- -- copy rule (chain)- _lhsOvcount =- _lhsIvcount- in ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOcNonterminals,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOnonts,_lhsOntattrs,_lhsOrules,_lhsOvcount))))--- Pattern ------------------------------------------------------{-- visit 0:- inherited attributes:- allTypeSigs : Map Identifier Type- altAttrs : Map AltAttr Vertex- con : Identifier- inh : Attributes- nt : Identifier- syn : Attributes- synthesized attributes:- copy : SELF- errors : Seq Error- gathAltAttrs : [AltAttr]- instVars : [Identifier]- locVars : [Identifier]- patternAttrs : [(Identifier,Identifier,Bool,Patterns)]- alternatives:- alternative Alias:- child field : {Identifier}- child attr : {Identifier}- child pat : Pattern- child parts : Patterns- visit 0:- local copy : _- alternative Constr:- child name : {ConstructorIdent}- child pats : Patterns- visit 0:- local copy : _- alternative Irrefutable:- child pat : Pattern- visit 0:- local copy : _- alternative Product:- child pos : {Pos}- child pats : Patterns- visit 0:- local copy : _- alternative Underscore:- child pos : {Pos}- visit 0:- local copy : _--}--- cata-sem_Pattern :: Pattern ->- T_Pattern-sem_Pattern (Alias _field _attr _pat _parts) =- (sem_Pattern_Alias _field _attr (sem_Pattern _pat) (sem_Patterns _parts))-sem_Pattern (Constr _name _pats) =- (sem_Pattern_Constr _name (sem_Patterns _pats))-sem_Pattern (Irrefutable _pat) =- (sem_Pattern_Irrefutable (sem_Pattern _pat))-sem_Pattern (Product _pos _pats) =- (sem_Pattern_Product _pos (sem_Patterns _pats))-sem_Pattern (Underscore _pos) =- (sem_Pattern_Underscore _pos)--- semantic domain-newtype T_Pattern = T_Pattern ((Map Identifier Type) ->- (Map AltAttr Vertex) ->- Identifier ->- Attributes ->- Identifier ->- Attributes ->- ( Pattern,(Seq Error),([AltAttr]),([Identifier]),([Identifier]),([(Identifier,Identifier,Bool,Patterns)])))-data Inh_Pattern = Inh_Pattern {allTypeSigs_Inh_Pattern :: !(Map Identifier Type),altAttrs_Inh_Pattern :: !(Map AltAttr Vertex),con_Inh_Pattern :: !(Identifier),inh_Inh_Pattern :: !(Attributes),nt_Inh_Pattern :: !(Identifier),syn_Inh_Pattern :: !(Attributes)}-data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: !(Pattern),errors_Syn_Pattern :: !(Seq Error),gathAltAttrs_Syn_Pattern :: !([AltAttr]),instVars_Syn_Pattern :: !([Identifier]),locVars_Syn_Pattern :: !([Identifier]),patternAttrs_Syn_Pattern :: !([(Identifier,Identifier,Bool,Patterns)])}-wrap_Pattern (T_Pattern sem) (Inh_Pattern _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn) =- (let ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs) =- (sem _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn)- in (Syn_Pattern _lhsOcopy _lhsOerrors _lhsOgathAltAttrs _lhsOinstVars _lhsOlocVars _lhsOpatternAttrs))-sem_Pattern_Alias :: Identifier ->- Identifier ->- T_Pattern ->- T_Patterns ->- T_Pattern-sem_Pattern_Alias field_ attr_ (T_Pattern pat_) (T_Patterns parts_) =- (T_Pattern (\ _lhsIallTypeSigs- _lhsIaltAttrs- _lhsIcon- _lhsIinh- _lhsInt- _lhsIsyn ->- (let _lhsOgathAltAttrs :: ([AltAttr])- _lhsOpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)])- _lhsOlocVars :: ([Identifier])- _lhsOinstVars :: ([Identifier])- _lhsOerrors :: (Seq Error)- _lhsOcopy :: Pattern- _patOallTypeSigs :: (Map Identifier Type)- _patOaltAttrs :: (Map AltAttr Vertex)- _patOcon :: Identifier- _patOinh :: Attributes- _patOnt :: Identifier- _patOsyn :: Attributes- _partsOallTypeSigs :: (Map Identifier Type)- _partsOaltAttrs :: (Map AltAttr Vertex)- _partsOcon :: Identifier- _partsOinh :: Attributes- _partsOnt :: Identifier- _partsOsyn :: Attributes- _patIcopy :: Pattern- _patIerrors :: (Seq Error)- _patIgathAltAttrs :: ([AltAttr])- _patIinstVars :: ([Identifier])- _patIlocVars :: ([Identifier])- _patIpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)])- _partsIcopy :: Patterns- _partsIerrors :: (Seq Error)- _partsIgathAltAttrs :: ([AltAttr])- _partsIinstVars :: ([Identifier])- _partsIlocVars :: ([Identifier])- _partsIpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)])- -- "Order.ag"(line 163, column 12)- _lhsOgathAltAttrs =- [AltAttr field_ attr_ (field_ == _LOC || field_ == _INST)]- -- "Order.ag"(line 231, column 12)- _lhsOpatternAttrs =- [(field_,attr_,(field_ == _LOC || field_ == _INST),_partsIcopy)]- -- "Order.ag"(line 539, column 14)- _lhsOlocVars =- if field_ == _LOC- then [attr_]- else []- -- "Order.ag"(line 542, column 14)- _lhsOinstVars =- if field_ == _INST- then [attr_]- else []- -- use rule "Order.ag"(line 63, 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 63, column 70)- _lhsOerrors =- _patsIerrors- -- use rule "Order.ag"(line 149, column 68)- _lhsOgathAltAttrs =- _patsIgathAltAttrs- -- use rule "Order.ag"(line 536, column 86)- _lhsOinstVars =- _patsIinstVars- -- use rule "Order.ag"(line 536, column 48)- _lhsOlocVars =- _patsIlocVars- -- use rule "Order.ag"(line 228, 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 63, column 70)- _lhsOerrors =- _patIerrors- -- use rule "Order.ag"(line 149, column 68)- _lhsOgathAltAttrs =- _patIgathAltAttrs- -- use rule "Order.ag"(line 536, column 86)- _lhsOinstVars =- _patIinstVars- -- use rule "Order.ag"(line 536, column 48)- _lhsOlocVars =- _patIlocVars- -- use rule "Order.ag"(line 228, 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 63, column 70)- _lhsOerrors =- _patsIerrors- -- use rule "Order.ag"(line 149, column 68)- _lhsOgathAltAttrs =- _patsIgathAltAttrs- -- use rule "Order.ag"(line 536, column 86)- _lhsOinstVars =- _patsIinstVars- -- use rule "Order.ag"(line 536, column 48)- _lhsOlocVars =- _patsIlocVars- -- use rule "Order.ag"(line 228, 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 63, column 70)- _lhsOerrors =- Seq.empty- -- use rule "Order.ag"(line 149, column 68)- _lhsOgathAltAttrs =- []- -- use rule "Order.ag"(line 536, column 86)- _lhsOinstVars =- []- -- use rule "Order.ag"(line 536, column 48)- _lhsOlocVars =- []- -- use rule "Order.ag"(line 228, column 42)- _lhsOpatternAttrs =- []- -- self rule- _copy =- Underscore pos_- -- self rule- _lhsOcopy =- _copy- in ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs))))--- Patterns -----------------------------------------------------{-- visit 0:- inherited attributes:- allTypeSigs : Map Identifier Type- altAttrs : Map AltAttr Vertex- con : Identifier- inh : Attributes- nt : Identifier- syn : Attributes- synthesized attributes:- copy : SELF- errors : Seq Error- gathAltAttrs : [AltAttr]- instVars : [Identifier]- locVars : [Identifier]- patternAttrs : [(Identifier,Identifier,Bool,Patterns)]- alternatives:- alternative Cons:- child hd : Pattern- child tl : Patterns- visit 0:- local copy : _- alternative Nil:- visit 0:- local copy : _--}--- cata-sem_Patterns :: Patterns ->- T_Patterns-sem_Patterns list =- (Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list))--- semantic domain-newtype T_Patterns = T_Patterns ((Map Identifier Type) ->- (Map AltAttr Vertex) ->- Identifier ->- Attributes ->- Identifier ->- Attributes ->- ( Patterns,(Seq Error),([AltAttr]),([Identifier]),([Identifier]),([(Identifier,Identifier,Bool,Patterns)])))-data Inh_Patterns = Inh_Patterns {allTypeSigs_Inh_Patterns :: !(Map Identifier Type),altAttrs_Inh_Patterns :: !(Map AltAttr Vertex),con_Inh_Patterns :: !(Identifier),inh_Inh_Patterns :: !(Attributes),nt_Inh_Patterns :: !(Identifier),syn_Inh_Patterns :: !(Attributes)}-data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: !(Patterns),errors_Syn_Patterns :: !(Seq Error),gathAltAttrs_Syn_Patterns :: !([AltAttr]),instVars_Syn_Patterns :: !([Identifier]),locVars_Syn_Patterns :: !([Identifier]),patternAttrs_Syn_Patterns :: !([(Identifier,Identifier,Bool,Patterns)])}-wrap_Patterns (T_Patterns sem) (Inh_Patterns _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn) =- (let ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs) =- (sem _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn)- in (Syn_Patterns _lhsOcopy _lhsOerrors _lhsOgathAltAttrs _lhsOinstVars _lhsOlocVars _lhsOpatternAttrs))-sem_Patterns_Cons :: T_Pattern ->- T_Patterns ->- T_Patterns-sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) =- (T_Patterns (\ _lhsIallTypeSigs- _lhsIaltAttrs- _lhsIcon- _lhsIinh- _lhsInt- _lhsIsyn ->- (let _lhsOerrors :: (Seq Error)- _lhsOgathAltAttrs :: ([AltAttr])- _lhsOinstVars :: ([Identifier])- _lhsOlocVars :: ([Identifier])- _lhsOpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)])- _lhsOcopy :: Patterns- _hdOallTypeSigs :: (Map Identifier Type)- _hdOaltAttrs :: (Map AltAttr Vertex)- _hdOcon :: Identifier- _hdOinh :: Attributes- _hdOnt :: Identifier- _hdOsyn :: Attributes- _tlOallTypeSigs :: (Map Identifier Type)- _tlOaltAttrs :: (Map AltAttr Vertex)- _tlOcon :: Identifier- _tlOinh :: Attributes- _tlOnt :: Identifier- _tlOsyn :: Attributes- _hdIcopy :: Pattern- _hdIerrors :: (Seq Error)- _hdIgathAltAttrs :: ([AltAttr])- _hdIinstVars :: ([Identifier])- _hdIlocVars :: ([Identifier])- _hdIpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)])- _tlIcopy :: Patterns- _tlIerrors :: (Seq Error)- _tlIgathAltAttrs :: ([AltAttr])- _tlIinstVars :: ([Identifier])- _tlIlocVars :: ([Identifier])- _tlIpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)])- -- use rule "Order.ag"(line 63, column 70)- _lhsOerrors =- _hdIerrors Seq.<> _tlIerrors- -- use rule "Order.ag"(line 149, column 68)- _lhsOgathAltAttrs =- _hdIgathAltAttrs ++ _tlIgathAltAttrs- -- use rule "Order.ag"(line 536, column 86)- _lhsOinstVars =- _hdIinstVars ++ _tlIinstVars- -- use rule "Order.ag"(line 536, column 48)- _lhsOlocVars =- _hdIlocVars ++ _tlIlocVars- -- use rule "Order.ag"(line 228, 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 63, column 70)- _lhsOerrors =- Seq.empty- -- use rule "Order.ag"(line 149, column 68)- _lhsOgathAltAttrs =- []- -- use rule "Order.ag"(line 536, column 86)- _lhsOinstVars =- []- -- use rule "Order.ag"(line 536, column 48)- _lhsOlocVars =- []- -- use rule "Order.ag"(line 228, column 42)- _lhsOpatternAttrs =- []- -- self rule- _copy =- []- -- self rule- _lhsOcopy =- _copy- in ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs))))--- Production ---------------------------------------------------{-- visit 0:- inherited attributes:- allnts : [Identifier]- cVisitsMap : CVisitsMap- inh : Attributes- manualAttrDepMap : AttrOrderMap- nt : Identifier- o_case : Bool- o_cata : Bool- o_dovisit : Bool- o_newtypes : Bool- o_rename : Bool- o_sem : Bool- o_sig : Bool- o_unbox : Bool- o_wantvisit : Bool- prefix : String- syn : Attributes- chained attribute:- vcount : Int- synthesized attributes:- additionalDep : Seq Edge- cProduction : CProduction- cons : [ConstructorIdent]- directDep : Seq Edge- errors : Seq Error- instDep : Seq Edge- rules : Seq (Vertex,CRule)- alternatives:- alternative Production:- child con : {ConstructorIdent}- child children : Children- child rules : Rules- child typeSigs : TypeSigs- visit 0:- local gathAltAttrs : _- local inhRules : _- local gathRules : _- local cVisits : _- local allfields : _- local attrs : _- local inhnames : _- local synnames : _--}--- cata-sem_Production :: Production ->- T_Production-sem_Production (Production _con _children _rules _typeSigs) =- (sem_Production_Production _con (sem_Children _children) (sem_Rules _rules) (sem_TypeSigs _typeSigs))--- semantic domain-newtype T_Production = T_Production (([Identifier]) ->- CVisitsMap ->- Attributes ->- AttrOrderMap ->- Identifier ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- String ->- Attributes ->- Int ->- ( (Seq Edge),CProduction,([ConstructorIdent]),(Seq Edge),(Seq Error),(Seq Edge),(Seq (Vertex,CRule)),Int))-data Inh_Production = Inh_Production {allnts_Inh_Production :: !([Identifier]),cVisitsMap_Inh_Production :: !(CVisitsMap),inh_Inh_Production :: !(Attributes),manualAttrDepMap_Inh_Production :: !(AttrOrderMap),nt_Inh_Production :: !(Identifier),o_case_Inh_Production :: !(Bool),o_cata_Inh_Production :: !(Bool),o_dovisit_Inh_Production :: !(Bool),o_newtypes_Inh_Production :: !(Bool),o_rename_Inh_Production :: !(Bool),o_sem_Inh_Production :: !(Bool),o_sig_Inh_Production :: !(Bool),o_unbox_Inh_Production :: !(Bool),o_wantvisit_Inh_Production :: !(Bool),prefix_Inh_Production :: !(String),syn_Inh_Production :: !(Attributes),vcount_Inh_Production :: !(Int)}-data Syn_Production = Syn_Production {additionalDep_Syn_Production :: !(Seq Edge),cProduction_Syn_Production :: !(CProduction),cons_Syn_Production :: !([ConstructorIdent]),directDep_Syn_Production :: !(Seq Edge),errors_Syn_Production :: !(Seq Error),instDep_Syn_Production :: !(Seq Edge),rules_Syn_Production :: !(Seq (Vertex,CRule)),vcount_Syn_Production :: !(Int)}-wrap_Production (T_Production sem) (Inh_Production _lhsIallnts _lhsIcVisitsMap _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIvcount) =- (let ( _lhsOadditionalDep,_lhsOcProduction,_lhsOcons,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOrules,_lhsOvcount) =- (sem _lhsIallnts _lhsIcVisitsMap _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIvcount)- in (Syn_Production _lhsOadditionalDep _lhsOcProduction _lhsOcons _lhsOdirectDep _lhsOerrors _lhsOinstDep _lhsOrules _lhsOvcount))-sem_Production_Production :: ConstructorIdent ->- T_Children ->- T_Rules ->- T_TypeSigs ->- T_Production-sem_Production_Production con_ (T_Children children_) (T_Rules rules_) (T_TypeSigs typeSigs_) =- (T_Production (\ _lhsIallnts- _lhsIcVisitsMap- _lhsIinh- _lhsImanualAttrDepMap- _lhsInt- _lhsIo_case- _lhsIo_cata- _lhsIo_dovisit- _lhsIo_newtypes- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_unbox- _lhsIo_wantvisit- _lhsIprefix- _lhsIsyn- _lhsIvcount ->- (let _childrenOcon :: Identifier- _rulesOcon :: Identifier- _rulesOaltAttrs :: (Map AltAttr Vertex)- _rulesOchildNts :: (Map Identifier NontermIdent)- _rulesOchildInhs :: (Map Identifier Attributes)- _lhsOrules :: (Seq (Vertex,CRule))- _lhsOvcount :: Int- _rulesOsynsOfChildren :: (Map Identifier Attributes)- _lhsOcons :: ([ConstructorIdent])- _typeSigsOtypeSigs :: (Map Identifier Type)- _rulesOallTypeSigs :: (Map Identifier Type)- _lhsOcProduction :: CProduction- _lhsOadditionalDep :: (Seq Edge)- _lhsOdirectDep :: (Seq Edge)- _lhsOerrors :: (Seq Error)- _lhsOinstDep :: (Seq Edge)- _childrenOallfields :: ([(Identifier,Type,Bool)])- _childrenOallnts :: ([Identifier])- _childrenOattrs :: ([(Identifier,Identifier)])- _childrenOinh :: Attributes- _childrenOnt :: Identifier- _childrenOo_unbox :: Bool- _childrenOsyn :: Attributes- _rulesOallfields :: ([(Identifier,Type,Bool)])- _rulesOallnts :: ([Identifier])- _rulesOattrs :: ([(Identifier,Identifier)])- _rulesOinh :: Attributes- _rulesOmanualAttrDepMap :: AttrOrderMap- _rulesOnt :: Identifier- _rulesOo_case :: Bool- _rulesOo_cata :: Bool- _rulesOo_dovisit :: Bool- _rulesOo_newtypes :: Bool- _rulesOo_rename :: Bool- _rulesOo_sem :: Bool- _rulesOo_sig :: Bool- _rulesOo_wantvisit :: Bool- _rulesOprefix :: String- _rulesOsyn :: Attributes- _childrenIattributes :: ([(Identifier,Attributes,Attributes)])- _childrenIcollectChildrenSyns :: (Map Identifier Attributes )- _childrenIerrors :: (Seq Error)- _childrenIfields :: ([(Identifier,Type,Bool)])- _childrenIgathAltAttrs :: ([AltAttr])- _childrenIgathRules :: (Seq CRule)- _childrenIinhs :: (Seq (Identifier,Attributes))- _childrenInts :: (Seq (Identifier,NontermIdent))- _childrenIsinglevisits :: ([CRule])- _childrenIterminals :: ([Identifier])- _rulesIadditionalDep :: (Seq Edge)- _rulesIdirectDep :: (Seq Edge)- _rulesIerrors :: (Seq Error)- _rulesIgathAltAttrs :: ([AltAttr])- _rulesIgathRules :: (Seq CRule)- _rulesIinstDep :: (Seq Edge)- _rulesIinstVars :: ([Identifier])- _rulesIlocVars :: ([Identifier])- _typeSigsItypeSigs :: (Map Identifier Type)- -- "Order.ag"(line 72, column 16)- _childrenOcon =- con_- -- "Order.ag"(line 74, column 16)- _rulesOcon =- con_- -- "Order.ag"(line 151, column 18)- _gathAltAttrs =- [ AltAttr _LHS inh True | inh <- Map.keys _lhsIinh ]- ++ _childrenIgathAltAttrs- ++ _rulesIgathAltAttrs- -- "Order.ag"(line 167, column 17)- _rulesOaltAttrs =- Map.fromList (zip _gathAltAttrs [_lhsIvcount..])- -- "Order.ag"(line 180, column 18)- _rulesOchildNts =- Map.fromList (Seq.toList _childrenInts)- -- "Order.ag"(line 181, column 19)- _rulesOchildInhs =- Map.fromList (Seq.toList _childrenIinhs)- -- "Order.ag"(line 187, column 18)- _inhRules =- [ cRuleLhsInh inh _lhsInt con_ tp | (inh,tp) <- Map.assocs _lhsIinh ]- -- "Order.ag"(line 188, column 19)- _gathRules =- _inhRules ++ Seq.toList (_childrenIgathRules Seq.<> _rulesIgathRules)- -- "Order.ag"(line 242, column 18)- _lhsOrules =- Seq.fromList (zip [_lhsIvcount..] _gathRules)- -- "Order.ag"(line 243, column 19)- _lhsOvcount =- _lhsIvcount + length _gathRules- -- "Order.ag"(line 312, column 17)- _rulesOsynsOfChildren =- _childrenIcollectChildrenSyns- -- "Order.ag"(line 387, column 18)- _lhsOcons =- [con_]- -- "Order.ag"(line 394, column 16)- _typeSigsOtypeSigs =- Map.empty- -- "Order.ag"(line 400, column 17)- _rulesOallTypeSigs =- _typeSigsItypeSigs- -- "Order.ag"(line 466, 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 492, column 18)- _lhsOcProduction =- CProduction con_ _cVisits _childrenIfields _childrenIterminals- -- "Order.ag"(line 516, column 16)- _allfields =- _childrenIfields- -- "Order.ag"(line 516, column 16)- _attrs =- map ((,) _LOC) _rulesIlocVars ++- map ((,) _INST) _rulesIinstVars ++- map ((,) _LHS) _inhnames ++- concat [map ((,) nm) (Map.keys as) | (nm,_,as) <- _childrenIattributes]- -- "Order.ag"(line 516, column 16)- _inhnames =- Map.keys _lhsIinh- -- "Order.ag"(line 516, column 16)- _synnames =- Map.keys _lhsIsyn- -- use rule "Order.ag"(line 262, column 71)- _lhsOadditionalDep =- _rulesIadditionalDep- -- use rule "Order.ag"(line 248, column 33)- _lhsOdirectDep =- _rulesIdirectDep- -- use rule "Order.ag"(line 63, column 70)- _lhsOerrors =- _childrenIerrors Seq.<> _rulesIerrors- -- use rule "Order.ag"(line 295, column 31)- _lhsOinstDep =- _rulesIinstDep- -- copy rule (from local)- _childrenOallfields =- _allfields- -- copy rule (down)- _childrenOallnts =- _lhsIallnts- -- copy rule (from local)- _childrenOattrs =- _attrs- -- copy rule (down)- _childrenOinh =- _lhsIinh- -- copy rule (down)- _childrenOnt =- _lhsInt- -- copy rule (down)- _childrenOo_unbox =- _lhsIo_unbox- -- copy rule (down)- _childrenOsyn =- _lhsIsyn- -- copy rule (from local)- _rulesOallfields =- _allfields- -- copy rule (down)- _rulesOallnts =- _lhsIallnts- -- copy rule (from local)- _rulesOattrs =- _attrs- -- copy rule (down)- _rulesOinh =- _lhsIinh- -- copy rule (down)- _rulesOmanualAttrDepMap =- _lhsImanualAttrDepMap- -- copy rule (down)- _rulesOnt =- _lhsInt- -- copy rule (down)- _rulesOo_case =- _lhsIo_case- -- copy rule (down)- _rulesOo_cata =- _lhsIo_cata- -- copy rule (down)- _rulesOo_dovisit =- _lhsIo_dovisit- -- copy rule (down)- _rulesOo_newtypes =- _lhsIo_newtypes- -- copy rule (down)- _rulesOo_rename =- _lhsIo_rename- -- copy rule (down)- _rulesOo_sem =- _lhsIo_sem- -- copy rule (down)- _rulesOo_sig =- _lhsIo_sig- -- copy rule (down)- _rulesOo_wantvisit =- _lhsIo_wantvisit- -- copy rule (down)- _rulesOprefix =- _lhsIprefix- -- copy rule (down)- _rulesOsyn =- _lhsIsyn- ( _childrenIattributes,_childrenIcollectChildrenSyns,_childrenIerrors,_childrenIfields,_childrenIgathAltAttrs,_childrenIgathRules,_childrenIinhs,_childrenInts,_childrenIsinglevisits,_childrenIterminals) =- (children_ _childrenOallfields _childrenOallnts _childrenOattrs _childrenOcon _childrenOinh _childrenOnt _childrenOo_unbox _childrenOsyn)- ( _rulesIadditionalDep,_rulesIdirectDep,_rulesIerrors,_rulesIgathAltAttrs,_rulesIgathRules,_rulesIinstDep,_rulesIinstVars,_rulesIlocVars) =- (rules_ _rulesOallTypeSigs _rulesOallfields _rulesOallnts _rulesOaltAttrs _rulesOattrs _rulesOchildInhs _rulesOchildNts _rulesOcon _rulesOinh _rulesOmanualAttrDepMap _rulesOnt _rulesOo_case _rulesOo_cata _rulesOo_dovisit _rulesOo_newtypes _rulesOo_rename _rulesOo_sem _rulesOo_sig _rulesOo_wantvisit _rulesOprefix _rulesOsyn _rulesOsynsOfChildren)- ( _typeSigsItypeSigs) =- (typeSigs_ _typeSigsOtypeSigs)- in ( _lhsOadditionalDep,_lhsOcProduction,_lhsOcons,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOrules,_lhsOvcount))))--- Productions --------------------------------------------------{-- visit 0:- inherited attributes:- allnts : [Identifier]- cVisitsMap : CVisitsMap- inh : Attributes- manualAttrDepMap : AttrOrderMap- nt : Identifier- o_case : Bool- o_cata : Bool- o_dovisit : Bool- o_newtypes : Bool- o_rename : Bool- o_sem : Bool- o_sig : Bool- o_unbox : Bool- o_wantvisit : Bool- prefix : String- syn : Attributes- chained attribute:- vcount : Int- synthesized attributes:- additionalDep : Seq Edge- cProductions : CProductions- cons : [ConstructorIdent]- directDep : Seq Edge- errors : Seq Error- instDep : Seq Edge- rules : Seq (Vertex,CRule)- alternatives:- alternative Cons:- child hd : Production- child tl : Productions- alternative Nil:--}--- cata-sem_Productions :: Productions ->- T_Productions-sem_Productions list =- (Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list))--- semantic domain-newtype T_Productions = T_Productions (([Identifier]) ->- CVisitsMap ->- Attributes ->- AttrOrderMap ->- Identifier ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- String ->- Attributes ->- Int ->- ( (Seq Edge),CProductions,([ConstructorIdent]),(Seq Edge),(Seq Error),(Seq Edge),(Seq (Vertex,CRule)),Int))-data Inh_Productions = Inh_Productions {allnts_Inh_Productions :: !([Identifier]),cVisitsMap_Inh_Productions :: !(CVisitsMap),inh_Inh_Productions :: !(Attributes),manualAttrDepMap_Inh_Productions :: !(AttrOrderMap),nt_Inh_Productions :: !(Identifier),o_case_Inh_Productions :: !(Bool),o_cata_Inh_Productions :: !(Bool),o_dovisit_Inh_Productions :: !(Bool),o_newtypes_Inh_Productions :: !(Bool),o_rename_Inh_Productions :: !(Bool),o_sem_Inh_Productions :: !(Bool),o_sig_Inh_Productions :: !(Bool),o_unbox_Inh_Productions :: !(Bool),o_wantvisit_Inh_Productions :: !(Bool),prefix_Inh_Productions :: !(String),syn_Inh_Productions :: !(Attributes),vcount_Inh_Productions :: !(Int)}-data Syn_Productions = Syn_Productions {additionalDep_Syn_Productions :: !(Seq Edge),cProductions_Syn_Productions :: !(CProductions),cons_Syn_Productions :: !([ConstructorIdent]),directDep_Syn_Productions :: !(Seq Edge),errors_Syn_Productions :: !(Seq Error),instDep_Syn_Productions :: !(Seq Edge),rules_Syn_Productions :: !(Seq (Vertex,CRule)),vcount_Syn_Productions :: !(Int)}-wrap_Productions (T_Productions sem) (Inh_Productions _lhsIallnts _lhsIcVisitsMap _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIvcount) =- (let ( _lhsOadditionalDep,_lhsOcProductions,_lhsOcons,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOrules,_lhsOvcount) =- (sem _lhsIallnts _lhsIcVisitsMap _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIvcount)- in (Syn_Productions _lhsOadditionalDep _lhsOcProductions _lhsOcons _lhsOdirectDep _lhsOerrors _lhsOinstDep _lhsOrules _lhsOvcount))-sem_Productions_Cons :: T_Production ->- T_Productions ->- T_Productions-sem_Productions_Cons (T_Production hd_) (T_Productions tl_) =- (T_Productions (\ _lhsIallnts- _lhsIcVisitsMap- _lhsIinh- _lhsImanualAttrDepMap- _lhsInt- _lhsIo_case- _lhsIo_cata- _lhsIo_dovisit- _lhsIo_newtypes- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_unbox- _lhsIo_wantvisit- _lhsIprefix- _lhsIsyn- _lhsIvcount ->- (let _lhsOcProductions :: CProductions- _lhsOadditionalDep :: (Seq Edge)- _lhsOcons :: ([ConstructorIdent])- _lhsOdirectDep :: (Seq Edge)- _lhsOerrors :: (Seq Error)- _lhsOinstDep :: (Seq Edge)- _lhsOrules :: (Seq (Vertex,CRule))- _lhsOvcount :: Int- _hdOallnts :: ([Identifier])- _hdOcVisitsMap :: CVisitsMap- _hdOinh :: Attributes- _hdOmanualAttrDepMap :: AttrOrderMap- _hdOnt :: Identifier- _hdOo_case :: Bool- _hdOo_cata :: Bool- _hdOo_dovisit :: Bool- _hdOo_newtypes :: Bool- _hdOo_rename :: Bool- _hdOo_sem :: Bool- _hdOo_sig :: Bool- _hdOo_unbox :: Bool- _hdOo_wantvisit :: Bool- _hdOprefix :: String- _hdOsyn :: Attributes- _hdOvcount :: Int- _tlOallnts :: ([Identifier])- _tlOcVisitsMap :: CVisitsMap- _tlOinh :: Attributes- _tlOmanualAttrDepMap :: AttrOrderMap- _tlOnt :: Identifier- _tlOo_case :: Bool- _tlOo_cata :: Bool- _tlOo_dovisit :: Bool- _tlOo_newtypes :: Bool- _tlOo_rename :: Bool- _tlOo_sem :: Bool- _tlOo_sig :: Bool- _tlOo_unbox :: Bool- _tlOo_wantvisit :: Bool- _tlOprefix :: String- _tlOsyn :: Attributes- _tlOvcount :: Int- _hdIadditionalDep :: (Seq Edge)- _hdIcProduction :: CProduction- _hdIcons :: ([ConstructorIdent])- _hdIdirectDep :: (Seq Edge)- _hdIerrors :: (Seq Error)- _hdIinstDep :: (Seq Edge)- _hdIrules :: (Seq (Vertex,CRule))- _hdIvcount :: Int- _tlIadditionalDep :: (Seq Edge)- _tlIcProductions :: CProductions- _tlIcons :: ([ConstructorIdent])- _tlIdirectDep :: (Seq Edge)- _tlIerrors :: (Seq Error)- _tlIinstDep :: (Seq Edge)- _tlIrules :: (Seq (Vertex,CRule))- _tlIvcount :: Int- -- "Order.ag"(line 489, column 12)- _lhsOcProductions =- _hdIcProduction : _tlIcProductions- -- use rule "Order.ag"(line 262, column 71)- _lhsOadditionalDep =- _hdIadditionalDep Seq.<> _tlIadditionalDep- -- use rule "Order.ag"(line 385, column 40)- _lhsOcons =- _hdIcons ++ _tlIcons- -- use rule "Order.ag"(line 248, column 33)- _lhsOdirectDep =- _hdIdirectDep Seq.<> _tlIdirectDep- -- use rule "Order.ag"(line 63, column 70)- _lhsOerrors =- _hdIerrors Seq.<> _tlIerrors- -- use rule "Order.ag"(line 295, column 31)- _lhsOinstDep =- _hdIinstDep Seq.<> _tlIinstDep- -- use rule "Order.ag"(line 238, 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 490, column 12)- _lhsOcProductions =- []- -- use rule "Order.ag"(line 262, column 71)- _lhsOadditionalDep =- Seq.empty- -- use rule "Order.ag"(line 385, column 40)- _lhsOcons =- []- -- use rule "Order.ag"(line 248, column 33)- _lhsOdirectDep =- Seq.empty- -- use rule "Order.ag"(line 63, column 70)- _lhsOerrors =- Seq.empty- -- use rule "Order.ag"(line 295, column 31)- _lhsOinstDep =- Seq.empty- -- use rule "Order.ag"(line 238, column 18)- _lhsOrules =- Seq.empty- -- copy rule (chain)- _lhsOvcount =- _lhsIvcount- in ( _lhsOadditionalDep,_lhsOcProductions,_lhsOcons,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOrules,_lhsOvcount))))--- Rule ---------------------------------------------------------{-- visit 0:- inherited attributes:- allTypeSigs : Map Identifier Type- allfields : [(Identifier,Type,Bool)]- allnts : [Identifier]- altAttrs : Map AltAttr Vertex- attrs : [(Identifier,Identifier)]- childInhs : Map Identifier Attributes- childNts : Map Identifier NontermIdent- con : Identifier- inh : Attributes- manualAttrDepMap : AttrOrderMap- nt : Identifier- o_case : Bool- o_cata : Bool- o_dovisit : Bool- o_newtypes : Bool- o_rename : Bool- o_sem : Bool- o_sig : Bool- o_wantvisit : Bool- prefix : String- syn : Attributes- synsOfChildren : Map Identifier Attributes- synthesized attributes:- additionalDep : Seq Edge- directDep : Seq Edge- errors : Seq Error- gathAltAttrs : [AltAttr]- gathRules : Seq CRule- instDep : Seq Edge- instVars : [Identifier]- locVars : [Identifier]- alternatives:- alternative Rule:- child pattern : Pattern- child rhs : Expression- child owrt : {Bool}- child origin : {String}- visit 0:- local defines : _- local gathRules : _- local manualDeps : _--}--- cata-sem_Rule :: Rule ->- T_Rule-sem_Rule (Rule _pattern _rhs _owrt _origin) =- (sem_Rule_Rule (sem_Pattern _pattern) (sem_Expression _rhs) _owrt _origin)--- semantic domain-newtype T_Rule = T_Rule ((Map Identifier Type) ->- ([(Identifier,Type,Bool)]) ->- ([Identifier]) ->- (Map AltAttr Vertex) ->- ([(Identifier,Identifier)]) ->- (Map Identifier Attributes) ->- (Map Identifier NontermIdent) ->- Identifier ->- Attributes ->- AttrOrderMap ->- Identifier ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- String ->- Attributes ->- (Map Identifier Attributes) ->- ( (Seq Edge),(Seq Edge),(Seq Error),([AltAttr]),(Seq CRule),(Seq Edge),([Identifier]),([Identifier])))-data Inh_Rule = Inh_Rule {allTypeSigs_Inh_Rule :: !(Map Identifier Type),allfields_Inh_Rule :: !([(Identifier,Type,Bool)]),allnts_Inh_Rule :: !([Identifier]),altAttrs_Inh_Rule :: !(Map AltAttr Vertex),attrs_Inh_Rule :: !([(Identifier,Identifier)]),childInhs_Inh_Rule :: !(Map Identifier Attributes),childNts_Inh_Rule :: !(Map Identifier NontermIdent),con_Inh_Rule :: !(Identifier),inh_Inh_Rule :: !(Attributes),manualAttrDepMap_Inh_Rule :: !(AttrOrderMap),nt_Inh_Rule :: !(Identifier),o_case_Inh_Rule :: !(Bool),o_cata_Inh_Rule :: !(Bool),o_dovisit_Inh_Rule :: !(Bool),o_newtypes_Inh_Rule :: !(Bool),o_rename_Inh_Rule :: !(Bool),o_sem_Inh_Rule :: !(Bool),o_sig_Inh_Rule :: !(Bool),o_wantvisit_Inh_Rule :: !(Bool),prefix_Inh_Rule :: !(String),syn_Inh_Rule :: !(Attributes),synsOfChildren_Inh_Rule :: !(Map Identifier Attributes)}-data Syn_Rule = Syn_Rule {additionalDep_Syn_Rule :: !(Seq Edge),directDep_Syn_Rule :: !(Seq Edge),errors_Syn_Rule :: !(Seq Error),gathAltAttrs_Syn_Rule :: !([AltAttr]),gathRules_Syn_Rule :: !(Seq CRule),instDep_Syn_Rule :: !(Seq Edge),instVars_Syn_Rule :: !([Identifier]),locVars_Syn_Rule :: !([Identifier])}-wrap_Rule (T_Rule sem) (Inh_Rule _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIsynsOfChildren) =- (let ( _lhsOadditionalDep,_lhsOdirectDep,_lhsOerrors,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinstDep,_lhsOinstVars,_lhsOlocVars) =- (sem _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIsynsOfChildren)- in (Syn_Rule _lhsOadditionalDep _lhsOdirectDep _lhsOerrors _lhsOgathAltAttrs _lhsOgathRules _lhsOinstDep _lhsOinstVars _lhsOlocVars))-sem_Rule_Rule :: T_Pattern ->- T_Expression ->- Bool ->- String ->- T_Rule-sem_Rule_Rule (T_Pattern pattern_) (T_Expression rhs_) owrt_ origin_ =- (T_Rule (\ _lhsIallTypeSigs- _lhsIallfields- _lhsIallnts- _lhsIaltAttrs- _lhsIattrs- _lhsIchildInhs- _lhsIchildNts- _lhsIcon- _lhsIinh- _lhsImanualAttrDepMap- _lhsInt- _lhsIo_case- _lhsIo_cata- _lhsIo_dovisit- _lhsIo_newtypes- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_wantvisit- _lhsIprefix- _lhsIsyn- _lhsIsynsOfChildren ->- (let _lhsOdirectDep :: (Seq Edge)- _lhsOadditionalDep :: (Seq Edge)- _lhsOinstDep :: (Seq Edge)- _lhsOerrors :: (Seq Error)- _lhsOgathAltAttrs :: ([AltAttr])- _lhsOgathRules :: (Seq CRule)- _lhsOinstVars :: ([Identifier])- _lhsOlocVars :: ([Identifier])- _patternOallTypeSigs :: (Map Identifier Type)- _patternOaltAttrs :: (Map AltAttr Vertex)- _patternOcon :: Identifier- _patternOinh :: Attributes- _patternOnt :: Identifier- _patternOsyn :: Attributes- _rhsOallfields :: ([(Identifier,Type,Bool)])- _rhsOallnts :: ([Identifier])- _rhsOattrs :: ([(Identifier,Identifier)])- _rhsOcon :: Identifier- _rhsOnt :: Identifier- _patternIcopy :: Pattern- _patternIerrors :: (Seq Error)- _patternIgathAltAttrs :: ([AltAttr])- _patternIinstVars :: ([Identifier])- _patternIlocVars :: ([Identifier])- _patternIpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)])- _rhsIallRhsVars :: (Set (Identifier,Identifier))- _rhsIcopy :: Expression- _rhsIerrors :: (Seq Error)- _rhsItextLines :: ([String])- _rhsIusedAttrs :: ([(Identifier,Identifier)])- _rhsIusedFields :: ([Identifier])- _rhsIusedLocals :: ([Identifier])- -- "Order.ag"(line 196, 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 212, 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 250, 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 268, column 7)- _manualDeps =- Set.toList $ Map.findWithDefault Set.empty _lhsIcon $ Map.findWithDefault Map.empty _lhsInt _lhsImanualAttrDepMap- -- "Order.ag"(line 270, 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 298, 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 63, column 70)- _lhsOerrors =- _patternIerrors Seq.<> _rhsIerrors- -- use rule "Order.ag"(line 149, column 68)- _lhsOgathAltAttrs =- _patternIgathAltAttrs- -- use rule "Order.ag"(line 185, column 23)- _lhsOgathRules =- _gathRules- -- use rule "Order.ag"(line 536, column 86)- _lhsOinstVars =- _patternIinstVars- -- use rule "Order.ag"(line 536, column 48)- _lhsOlocVars =- _patternIlocVars- -- copy rule (down)- _patternOallTypeSigs =- _lhsIallTypeSigs- -- copy rule (down)- _patternOaltAttrs =- _lhsIaltAttrs- -- copy rule (down)- _patternOcon =- _lhsIcon- -- copy rule (down)- _patternOinh =- _lhsIinh- -- copy rule (down)- _patternOnt =- _lhsInt- -- copy rule (down)- _patternOsyn =- _lhsIsyn- -- copy rule (down)- _rhsOallfields =- _lhsIallfields- -- copy rule (down)- _rhsOallnts =- _lhsIallnts- -- copy rule (down)- _rhsOattrs =- _lhsIattrs- -- copy rule (down)- _rhsOcon =- _lhsIcon- -- copy rule (down)- _rhsOnt =- _lhsInt- ( _patternIcopy,_patternIerrors,_patternIgathAltAttrs,_patternIinstVars,_patternIlocVars,_patternIpatternAttrs) =- (pattern_ _patternOallTypeSigs _patternOaltAttrs _patternOcon _patternOinh _patternOnt _patternOsyn)- ( _rhsIallRhsVars,_rhsIcopy,_rhsIerrors,_rhsItextLines,_rhsIusedAttrs,_rhsIusedFields,_rhsIusedLocals) =- (rhs_ _rhsOallfields _rhsOallnts _rhsOattrs _rhsOcon _rhsOnt)- in ( _lhsOadditionalDep,_lhsOdirectDep,_lhsOerrors,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinstDep,_lhsOinstVars,_lhsOlocVars))))--- Rules --------------------------------------------------------{-- visit 0:- inherited attributes:- allTypeSigs : Map Identifier Type- allfields : [(Identifier,Type,Bool)]- allnts : [Identifier]- altAttrs : Map AltAttr Vertex- attrs : [(Identifier,Identifier)]- childInhs : Map Identifier Attributes- childNts : Map Identifier NontermIdent- con : Identifier- inh : Attributes- manualAttrDepMap : AttrOrderMap- nt : Identifier- o_case : Bool- o_cata : Bool- o_dovisit : Bool- o_newtypes : Bool- o_rename : Bool- o_sem : Bool- o_sig : Bool- o_wantvisit : Bool- prefix : String- syn : Attributes- synsOfChildren : Map Identifier Attributes- synthesized attributes:- additionalDep : Seq Edge- directDep : Seq Edge- errors : Seq Error- gathAltAttrs : [AltAttr]- gathRules : Seq CRule- instDep : Seq Edge- instVars : [Identifier]- locVars : [Identifier]- alternatives:- alternative Cons:- child hd : Rule- child tl : Rules- alternative Nil:--}--- cata-sem_Rules :: Rules ->- T_Rules-sem_Rules list =- (Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list))--- semantic domain-newtype T_Rules = T_Rules ((Map Identifier Type) ->- ([(Identifier,Type,Bool)]) ->- ([Identifier]) ->- (Map AltAttr Vertex) ->- ([(Identifier,Identifier)]) ->- (Map Identifier Attributes) ->- (Map Identifier NontermIdent) ->- Identifier ->- Attributes ->- AttrOrderMap ->- Identifier ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- Bool ->- String ->- Attributes ->- (Map Identifier Attributes) ->- ( (Seq Edge),(Seq Edge),(Seq Error),([AltAttr]),(Seq CRule),(Seq Edge),([Identifier]),([Identifier])))-data Inh_Rules = Inh_Rules {allTypeSigs_Inh_Rules :: !(Map Identifier Type),allfields_Inh_Rules :: !([(Identifier,Type,Bool)]),allnts_Inh_Rules :: !([Identifier]),altAttrs_Inh_Rules :: !(Map AltAttr Vertex),attrs_Inh_Rules :: !([(Identifier,Identifier)]),childInhs_Inh_Rules :: !(Map Identifier Attributes),childNts_Inh_Rules :: !(Map Identifier NontermIdent),con_Inh_Rules :: !(Identifier),inh_Inh_Rules :: !(Attributes),manualAttrDepMap_Inh_Rules :: !(AttrOrderMap),nt_Inh_Rules :: !(Identifier),o_case_Inh_Rules :: !(Bool),o_cata_Inh_Rules :: !(Bool),o_dovisit_Inh_Rules :: !(Bool),o_newtypes_Inh_Rules :: !(Bool),o_rename_Inh_Rules :: !(Bool),o_sem_Inh_Rules :: !(Bool),o_sig_Inh_Rules :: !(Bool),o_wantvisit_Inh_Rules :: !(Bool),prefix_Inh_Rules :: !(String),syn_Inh_Rules :: !(Attributes),synsOfChildren_Inh_Rules :: !(Map Identifier Attributes)}-data Syn_Rules = Syn_Rules {additionalDep_Syn_Rules :: !(Seq Edge),directDep_Syn_Rules :: !(Seq Edge),errors_Syn_Rules :: !(Seq Error),gathAltAttrs_Syn_Rules :: !([AltAttr]),gathRules_Syn_Rules :: !(Seq CRule),instDep_Syn_Rules :: !(Seq Edge),instVars_Syn_Rules :: !([Identifier]),locVars_Syn_Rules :: !([Identifier])}-wrap_Rules (T_Rules sem) (Inh_Rules _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIsynsOfChildren) =- (let ( _lhsOadditionalDep,_lhsOdirectDep,_lhsOerrors,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinstDep,_lhsOinstVars,_lhsOlocVars) =- (sem _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIsynsOfChildren)- in (Syn_Rules _lhsOadditionalDep _lhsOdirectDep _lhsOerrors _lhsOgathAltAttrs _lhsOgathRules _lhsOinstDep _lhsOinstVars _lhsOlocVars))-sem_Rules_Cons :: T_Rule ->- T_Rules ->- T_Rules-sem_Rules_Cons (T_Rule hd_) (T_Rules tl_) =- (T_Rules (\ _lhsIallTypeSigs- _lhsIallfields- _lhsIallnts- _lhsIaltAttrs- _lhsIattrs- _lhsIchildInhs- _lhsIchildNts- _lhsIcon- _lhsIinh- _lhsImanualAttrDepMap- _lhsInt- _lhsIo_case- _lhsIo_cata- _lhsIo_dovisit- _lhsIo_newtypes- _lhsIo_rename- _lhsIo_sem- _lhsIo_sig- _lhsIo_wantvisit- _lhsIprefix- _lhsIsyn- _lhsIsynsOfChildren ->- (let _lhsOadditionalDep :: (Seq Edge)- _lhsOdirectDep :: (Seq Edge)- _lhsOerrors :: (Seq Error)- _lhsOgathAltAttrs :: ([AltAttr])- _lhsOgathRules :: (Seq CRule)- _lhsOinstDep :: (Seq Edge)- _lhsOinstVars :: ([Identifier])- _lhsOlocVars :: ([Identifier])- _hdOallTypeSigs :: (Map Identifier Type)- _hdOallfields :: ([(Identifier,Type,Bool)])- _hdOallnts :: ([Identifier])- _hdOaltAttrs :: (Map AltAttr Vertex)- _hdOattrs :: ([(Identifier,Identifier)])- _hdOchildInhs :: (Map Identifier Attributes)- _hdOchildNts :: (Map Identifier NontermIdent)- _hdOcon :: Identifier- _hdOinh :: Attributes- _hdOmanualAttrDepMap :: AttrOrderMap- _hdOnt :: Identifier- _hdOo_case :: Bool- _hdOo_cata :: Bool- _hdOo_dovisit :: Bool- _hdOo_newtypes :: Bool- _hdOo_rename :: Bool- _hdOo_sem :: Bool- _hdOo_sig :: Bool- _hdOo_wantvisit :: Bool- _hdOprefix :: String- _hdOsyn :: Attributes- _hdOsynsOfChildren :: (Map Identifier Attributes)- _tlOallTypeSigs :: (Map Identifier Type)- _tlOallfields :: ([(Identifier,Type,Bool)])- _tlOallnts :: ([Identifier])- _tlOaltAttrs :: (Map AltAttr Vertex)- _tlOattrs :: ([(Identifier,Identifier)])- _tlOchildInhs :: (Map Identifier Attributes)- _tlOchildNts :: (Map Identifier NontermIdent)- _tlOcon :: Identifier- _tlOinh :: Attributes- _tlOmanualAttrDepMap :: AttrOrderMap- _tlOnt :: Identifier- _tlOo_case :: Bool- _tlOo_cata :: Bool- _tlOo_dovisit :: Bool- _tlOo_newtypes :: Bool- _tlOo_rename :: Bool- _tlOo_sem :: Bool- _tlOo_sig :: Bool- _tlOo_wantvisit :: Bool- _tlOprefix :: String- _tlOsyn :: Attributes- _tlOsynsOfChildren :: (Map Identifier Attributes)- _hdIadditionalDep :: (Seq Edge)- _hdIdirectDep :: (Seq Edge)- _hdIerrors :: (Seq Error)- _hdIgathAltAttrs :: ([AltAttr])- _hdIgathRules :: (Seq CRule)- _hdIinstDep :: (Seq Edge)- _hdIinstVars :: ([Identifier])- _hdIlocVars :: ([Identifier])- _tlIadditionalDep :: (Seq Edge)- _tlIdirectDep :: (Seq Edge)- _tlIerrors :: (Seq Error)- _tlIgathAltAttrs :: ([AltAttr])- _tlIgathRules :: (Seq CRule)- _tlIinstDep :: (Seq Edge)- _tlIinstVars :: ([Identifier])- _tlIlocVars :: ([Identifier])- -- use rule "Order.ag"(line 262, column 71)- _lhsOadditionalDep =- _hdIadditionalDep Seq.<> _tlIadditionalDep- -- use rule "Order.ag"(line 248, column 33)- _lhsOdirectDep =- _hdIdirectDep Seq.<> _tlIdirectDep- -- use rule "Order.ag"(line 63, column 70)- _lhsOerrors =- _hdIerrors Seq.<> _tlIerrors- -- use rule "Order.ag"(line 149, column 68)- _lhsOgathAltAttrs =- _hdIgathAltAttrs ++ _tlIgathAltAttrs- -- use rule "Order.ag"(line 185, column 23)- _lhsOgathRules =- _hdIgathRules Seq.<> _tlIgathRules- -- use rule "Order.ag"(line 295, column 31)- _lhsOinstDep =- _hdIinstDep Seq.<> _tlIinstDep- -- use rule "Order.ag"(line 536, column 86)- _lhsOinstVars =- _hdIinstVars ++ _tlIinstVars- -- use rule "Order.ag"(line 536, 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 262, column 71)- _lhsOadditionalDep =- Seq.empty- -- use rule "Order.ag"(line 248, column 33)- _lhsOdirectDep =- Seq.empty- -- use rule "Order.ag"(line 63, column 70)- _lhsOerrors =- Seq.empty- -- use rule "Order.ag"(line 149, column 68)- _lhsOgathAltAttrs =- []- -- use rule "Order.ag"(line 185, column 23)- _lhsOgathRules =- Seq.empty- -- use rule "Order.ag"(line 295, column 31)- _lhsOinstDep =- Seq.empty- -- use rule "Order.ag"(line 536, column 86)- _lhsOinstVars =- []- -- use rule "Order.ag"(line 536, column 48)- _lhsOlocVars =- []- in ( _lhsOadditionalDep,_lhsOdirectDep,_lhsOerrors,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinstDep,_lhsOinstVars,_lhsOlocVars))))--- TypeSig ------------------------------------------------------{-- visit 0:- chained attribute:- typeSigs : Map Identifier Type- alternatives:- alternative TypeSig:- child name : {Identifier}- child tp : {Type}--}--- cata-sem_TypeSig :: TypeSig ->- T_TypeSig-sem_TypeSig (TypeSig _name _tp) =- (sem_TypeSig_TypeSig _name _tp)--- semantic domain-newtype T_TypeSig = T_TypeSig ((Map Identifier Type) ->- ( (Map Identifier Type)))-data Inh_TypeSig = Inh_TypeSig {typeSigs_Inh_TypeSig :: !(Map Identifier Type)}-data Syn_TypeSig = Syn_TypeSig {typeSigs_Syn_TypeSig :: !(Map Identifier Type)}-wrap_TypeSig (T_TypeSig sem) (Inh_TypeSig _lhsItypeSigs) =- (let ( _lhsOtypeSigs) =- (sem _lhsItypeSigs)- in (Syn_TypeSig _lhsOtypeSigs))-sem_TypeSig_TypeSig :: Identifier ->- Type ->- T_TypeSig-sem_TypeSig_TypeSig name_ tp_ =- (T_TypeSig (\ _lhsItypeSigs ->- (let _lhsOtypeSigs :: (Map Identifier Type)- -- "Order.ag"(line 396, column 13)- _lhsOtypeSigs =- Map.insert name_ tp_ _lhsItypeSigs- in ( _lhsOtypeSigs))))--- TypeSigs -----------------------------------------------------{-- visit 0:- chained attribute:- typeSigs : Map Identifier Type- alternatives:- alternative Cons:- child hd : TypeSig- child tl : TypeSigs- alternative Nil:--}--- cata-sem_TypeSigs :: TypeSigs ->- T_TypeSigs-sem_TypeSigs list =- (Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list))--- semantic domain-newtype T_TypeSigs = T_TypeSigs ((Map Identifier Type) ->- ( (Map Identifier Type)))-data Inh_TypeSigs = Inh_TypeSigs {typeSigs_Inh_TypeSigs :: !(Map Identifier Type)}-data Syn_TypeSigs = Syn_TypeSigs {typeSigs_Syn_TypeSigs :: !(Map Identifier Type)}-wrap_TypeSigs (T_TypeSigs sem) (Inh_TypeSigs _lhsItypeSigs) =- (let ( _lhsOtypeSigs) =- (sem _lhsItypeSigs)- in (Syn_TypeSigs _lhsOtypeSigs))-sem_TypeSigs_Cons :: T_TypeSig ->- T_TypeSigs ->- T_TypeSigs-sem_TypeSigs_Cons (T_TypeSig hd_) (T_TypeSigs tl_) =- (T_TypeSigs (\ _lhsItypeSigs ->- (let _lhsOtypeSigs :: (Map Identifier Type)- _hdOtypeSigs :: (Map Identifier Type)- _tlOtypeSigs :: (Map Identifier Type)- _hdItypeSigs :: (Map Identifier Type)- _tlItypeSigs :: (Map Identifier Type)- -- copy rule (up)- _lhsOtypeSigs =- _tlItypeSigs- -- copy rule (down)- _hdOtypeSigs =- _lhsItypeSigs- -- copy rule (chain)- _tlOtypeSigs =- _hdItypeSigs- ( _hdItypeSigs) =- (hd_ _hdOtypeSigs)- ( _tlItypeSigs) =- (tl_ _tlOtypeSigs)- in ( _lhsOtypeSigs))))-sem_TypeSigs_Nil :: T_TypeSigs-sem_TypeSigs_Nil =- (T_TypeSigs (\ _lhsItypeSigs ->- (let _lhsOtypeSigs :: (Map Identifier Type)- -- copy rule (chain)- _lhsOtypeSigs =- _lhsItypeSigs- in ( _lhsOtypeSigs))))+ + +-- UUAGC 0.9.10 (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,60 +1,62 @@--- UUAGC 0.9.5 (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]+ + +-- UUAGC 0.9.10 (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,2161 +1,2218 @@-{-# OPTIONS_GHC -fbang-patterns #-}--- UUAGC 0.9.5 (PrintCode.ag)-module PrintCode where--import Char (isAlphaNum)-import Pretty-import Code-import Patterns-import Options-import CommonTypes (attrname, _LOC, getName, nullIdent)-import Data.List(intersperse)-import System.IO-import System.Directory-import CommonTypes(BlockInfo, BlockType(..), identifier)--import Pretty-import Patterns-import Data.List(partition)-import Data.Set(Set)-import qualified UU.DData.Set as Set-import Data.Map(Map)-import qualified Data.Map as Map---- Patterns.ag imports-import UU.Scanner.Position(Pos)-import CommonTypes (ConstructorIdent,Identifier)--type PP_Docs = [PP_Doc]--ppMultiSeqH :: [PP_Doc] -> PP_Doc -> PP_Doc-ppMultiSeqH = ppMultiSeq' (>#<)--ppMultiSeqV :: [PP_Doc] -> PP_Doc -> PP_Doc-ppMultiSeqV = ppMultiSeq' (>-<)--ppMultiSeq' :: (PP_Doc -> PP_Doc -> PP_Doc) -> [PP_Doc] -> PP_Doc -> PP_Doc-ppMultiSeq' next strictArgs expr- = foldr (\v r -> (v >#< "`seq`") `next` pp_parens r) expr strictArgs---reallySimple :: String -> Bool-reallySimple = and . map (\x -> isAlphaNum x || x=='_')--ppTuple True pps = "(" >|< pp_block " " (replicate (length pps `max` 1) ')') ",(" pps-ppTuple False pps = "(" >|< pp_block " " ")" "," pps-ppUnboxedTuple True pps = "(# " >|< pp_block " " (concat $ replicate (length pps `max` 1) " #)") ",(# " pps-ppUnboxedTuple False pps = "(# " >|< pp_block " " " #)" "," pps---locname' n = "_loc_" ++ getName n--renderDocs :: [PP_Doc] -> String-renderDocs pps = foldr (.) id (map (\d -> (disp d 50000) . ( '\n':) ) pps) ""--writeModule :: FilePath -> [PP_Doc] -> IO ()-writeModule path docs- = do bExists <- doesFileExist path- if bExists- then do input <- readFile path- seq (length input) (return ())- if input /= output- then dumpIt- else return ()- else dumpIt- where- output = renderDocs docs- dumpIt = writeFile path output---- Unboxed tuples--- unbox Whether unboxed tuples are wanted or not--- inh The inherited attributes. --- If there are none, no unboxing can take place, --- because in that case the semantic function (a top-level identifier) would have an unboxed type.--- Of course we can't have an unboxed 1-tuple-mkTupleExpr :: Bool -> Bool -> Exprs -> Expr-mkTupleExpr unbox noInh exprs | not unbox || noInh || length exprs == 1 = TupleExpr exprs- | otherwise = UnboxedTupleExpr exprs-mkTupleType :: Bool -> Bool -> Types -> Type-mkTupleType unbox noInh tps | not unbox || noInh || length tps == 1 = TupleType tps- | otherwise = UnboxedTupleType tps-mkTupleLhs :: Bool -> Bool -> [String] -> Lhs-mkTupleLhs unbox noInh comps | not unbox || noInh || length comps == 1 = TupleLhs comps- | otherwise = UnboxedTupleLhs comps--- CaseAlt ------------------------------------------------------{-- visit 0:- inherited attributes:- nested : Bool- options : Options- outputfile : String- synthesized attribute:- pps : PP_Docs- alternatives:- alternative CaseAlt:- child left : Lhs- child expr : Expr--}--- cata-sem_CaseAlt :: CaseAlt ->- T_CaseAlt-sem_CaseAlt !(CaseAlt _left _expr) =- (sem_CaseAlt_CaseAlt (sem_Lhs _left) (sem_Expr _expr))--- semantic domain-newtype T_CaseAlt = T_CaseAlt (Bool ->- Options ->- String ->- ( PP_Docs))-data Inh_CaseAlt = Inh_CaseAlt {nested_Inh_CaseAlt :: !(Bool),options_Inh_CaseAlt :: !(Options),outputfile_Inh_CaseAlt :: !(String)}-data Syn_CaseAlt = Syn_CaseAlt {pps_Syn_CaseAlt :: !(PP_Docs)}-wrap_CaseAlt !(T_CaseAlt sem) !(Inh_CaseAlt _lhsInested _lhsIoptions _lhsIoutputfile) =- (let ( !_lhsOpps) =- (sem _lhsInested _lhsIoptions _lhsIoutputfile)- in (Syn_CaseAlt _lhsOpps))-sem_CaseAlt_CaseAlt :: T_Lhs ->- T_Expr ->- T_CaseAlt-sem_CaseAlt_CaseAlt !(T_Lhs left_) !(T_Expr expr_) =- (T_CaseAlt (\ (!_lhsInested)- (!_lhsIoptions)- (!_lhsIoutputfile) ->- (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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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) })))+{-# OPTIONS_GHC -fbang-patterns #-} + +-- UUAGC 0.9.10 (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,1292 +1,1303 @@--- UUAGC 0.9.5 (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 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 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))))+ + +-- UUAGC 0.9.10 (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,572 +1,586 @@--- UUAGC 0.9.5 (SemHsTokens.ag)-module SemHsTokens where--import UU.DData.Seq as Seq(Seq,empty,single,(<>),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 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 72, column 15)- _lhsOerrors =- if (field_,attr_) `elem` _lhsIattrs- then Seq.empty- else if not(field_ `elem` (_LHS : _LOC: _lhsIfieldnames))- then Seq.single (UndefChild _lhsInt _lhsIcon field_)- else Seq.single (UndefAttr _lhsInt _lhsIcon field_ attr_ False)- -- "SemHsTokens.ag"(line 86, column 13)- _lhsOusedAttrs =- [(field_,attr_)]- -- "SemHsTokens.ag"(line 113, column 8)- _addTrace =- case rdesc_ of- Just d -> \x -> "(trace " ++ show (d ++ " -> " ++ show field_ ++ "." ++ show attr_) ++ " (" ++ x ++ "))"- Nothing -> id- -- "SemHsTokens.ag"(line 116, column 8)- _lhsOtok =- (pos_, _addTrace $ attrname True field_ attr_)- -- use rule "SemHsTokens.ag"(line 91, column 40)- _lhsOusedFields =- Seq.empty- -- use rule "SemHsTokens.ag"(line 82, 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 62, column 19)- __tup1 =- if var_ `elem` _lhsIfieldnames- then if isNTname _lhsIallnts (lookup var_ (map (\(n,t,_) -> (n,t)) _lhsIallfields))- then (Seq.single(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.single(UndefLocal _lhsInt _lhsIcon var_), (pos_,locname var_), [] )- -- "SemHsTokens.ag"(line 62, column 19)- (_errors,_,_) =- __tup1- -- "SemHsTokens.ag"(line 62, column 19)- (_,_tok,_) =- __tup1- -- "SemHsTokens.ag"(line 62, column 19)- (_,_,_usedLocals) =- __tup1- -- "SemHsTokens.ag"(line 94, column 13)- _lhsOusedFields =- if var_ `elem` _lhsIfieldnames- then Seq.single var_- else Seq.empty- -- use rule "SemHsTokens.ag"(line 41, column 37)- _lhsOerrors =- _errors- -- use rule "SemHsTokens.ag"(line 83, column 40)- _lhsOusedAttrs =- []- -- use rule "SemHsTokens.ag"(line 82, 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 120, column 16)- _lhsOtok =- (pos_, if null value_- then ""- else showCharShort (head value_)- )- -- use rule "SemHsTokens.ag"(line 41, column 37)- _lhsOerrors =- Seq.empty- -- use rule "SemHsTokens.ag"(line 83, column 40)- _lhsOusedAttrs =- []- -- use rule "SemHsTokens.ag"(line 91, column 40)- _lhsOusedFields =- Seq.empty- -- use rule "SemHsTokens.ag"(line 82, 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 48, column 9)- _lhsOerrors =- let m = text mesg_- in Seq.single (CustomError False pos_ m)- -- "SemHsTokens.ag"(line 126, column 16)- _lhsOtok =- (pos_, "")- -- use rule "SemHsTokens.ag"(line 83, column 40)- _lhsOusedAttrs =- []- -- use rule "SemHsTokens.ag"(line 91, column 40)- _lhsOusedFields =- Seq.empty- -- use rule "SemHsTokens.ag"(line 82, 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 118, column 14)- _lhsOtok =- (pos_, value_)- -- use rule "SemHsTokens.ag"(line 41, column 37)- _lhsOerrors =- Seq.empty- -- use rule "SemHsTokens.ag"(line 83, column 40)- _lhsOusedAttrs =- []- -- use rule "SemHsTokens.ag"(line 91, column 40)- _lhsOusedFields =- Seq.empty- -- use rule "SemHsTokens.ag"(line 82, 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 125, column 16)- _lhsOtok =- (pos_, showStrShort value_)- -- use rule "SemHsTokens.ag"(line 41, column 37)- _lhsOerrors =- Seq.empty- -- use rule "SemHsTokens.ag"(line 83, column 40)- _lhsOusedAttrs =- []- -- use rule "SemHsTokens.ag"(line 91, column 40)- _lhsOusedFields =- Seq.empty- -- use rule "SemHsTokens.ag"(line 82, 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 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 108, column 10)- _lhsOtks =- _hdItok : _tlItks- -- use rule "SemHsTokens.ag"(line 41, column 37)- _lhsOerrors =- _hdIerrors Seq.<> _tlIerrors- -- use rule "SemHsTokens.ag"(line 83, column 40)- _lhsOusedAttrs =- _hdIusedAttrs ++ _tlIusedAttrs- -- use rule "SemHsTokens.ag"(line 91, column 40)- _lhsOusedFields =- _hdIusedFields Seq.<> _tlIusedFields- -- use rule "SemHsTokens.ag"(line 82, 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 109, column 10)- _lhsOtks =- []- -- use rule "SemHsTokens.ag"(line 41, column 37)- _lhsOerrors =- Seq.empty- -- use rule "SemHsTokens.ag"(line 83, column 40)- _lhsOusedAttrs =- []- -- use rule "SemHsTokens.ag"(line 91, column 40)- _lhsOusedFields =- Seq.empty- -- use rule "SemHsTokens.ag"(line 82, 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 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 36, column 18)- _tokensOfieldnames =- map (\(n,_,_) -> n) _lhsIallfields- -- "SemHsTokens.ag"(line 98, column 18)- _lhsOusedFields =- Seq.toList _tokensIusedFields- -- "SemHsTokens.ag"(line 105, column 18)- _lhsOtextLines =- showTokens _tokensItks- -- use rule "SemHsTokens.ag"(line 16, 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))))+ + +-- UUAGC 0.9.10 (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,928 +1,975 @@--- UUAGC 0.9.5 (TfmToVisage.ag)-module TfmToVisage where--import AbstractSyntax-import VisagePatterns-import VisageSyntax---- AbstractSyntax.ag imports-import Data.Set(Set)-import Data.Map(Map)-import Patterns (Pattern(..),Patterns)-import Expression (Expression(..))-import CommonTypes---- Patterns.ag imports-import UU.Scanner.Position(Pos)-import CommonTypes (ConstructorIdent,Identifier)--import UU.Scanner.Position(Pos)-import HsToken---- Maps a rule to a pair --- Later, I expect to map to a list of rules, because we might need to unfold.----- Checks that a certain alias is in fact a Var in the old representation of the AG system-isVar (Alias _ _ (Underscore _) _) = True-isVar _ = False--type VisageRuleMap = [(String, VisageRule)]--splitVRules :: [VisageRule] -> VisageRuleMap-splitVRules vrs = concat (map unfoldvrs vrs)--unfoldvrs :: VisageRule -> VisageRuleMap-unfoldvrs vr@(VRule attrfields _ _ _ _) = zip (map (getName . fst) attrfields) (map (copyRule vr) attrfields)--copyRule :: VisageRule -> (Identifier,Identifier) -> VisageRule-copyRule (VRule attrfields _ pat expr owrt) (field,attr) = VRule attrfields attr pat expr owrt--getForField :: String -> VisageRuleMap -> [VisageRule]-getForField field xs = map snd (filter ((field ==) . fst) xs)--{-- Delivers a map from fieldname to VisageRule with all references to others underscored.- So, (lhs.x, rt.y, loc.z) = (0,1,2) becomes something like- [("lhs", (lhs.x,_,_) = (0,1,2)-- At this point, we do not use this anymore.- -allways :: VisageRule -> VisageRuleMap-allways vr@(VRule vrfields _ _ _ _) = zip vrfields (map (underScoreRule vr) (nub vrfields))--splitVRules :: [VisageRule] -> VisageRuleMap-splitVRules vrs = concat (map allways vrs)--underScoreRule :: VisageRule -> String -> VisageRule-underScoreRule (VRule fields pat expr owrt rule) s = VRule fields (underScore s pat) expr owrt rule--underScore :: String -> VisagePattern -> VisagePattern-underScore field (VConstr name pats) = VConstr name (map (underScore field) pats) -underScore field (VProduct pos pats) = VProduct pos (map (underScore field) pats)-underScore field vp@(VVar vfield attr) = - if (field == getName vfield) - then vp- else (VUnderscore (getPos vfield))--- Should I recurse into the pat of VAlias?-underScore field vp@(VAlias afield attr pat) =- if (field == getName afield) - then vp- else (VUnderscore (getPos afield))-underScore field vp@(VUnderscore pos) = vp- --}--- Child --------------------------------------------------------{-- visit 0:- inherited attribute:- rulemap : VisageRuleMap- synthesized attribute:- vchild : VisageChild- alternatives:- alternative Child:- child name : {Identifier}- child tp : {Type}- child inh : {Attributes}- child syn : {Attributes}- child higherOrder : {Bool}--}--- cata-sem_Child :: Child ->- T_Child-sem_Child (Child _name _tp _inh _syn _higherOrder) =- (sem_Child_Child _name _tp _inh _syn _higherOrder)--- semantic domain-newtype T_Child = T_Child (VisageRuleMap ->- ( VisageChild))-data Inh_Child = Inh_Child {rulemap_Inh_Child :: VisageRuleMap}-data Syn_Child = Syn_Child {vchild_Syn_Child :: VisageChild}-wrap_Child (T_Child sem) (Inh_Child _lhsIrulemap) =- (let ( _lhsOvchild) =- (sem _lhsIrulemap)- in (Syn_Child _lhsOvchild))-sem_Child_Child :: Identifier ->- Type ->- Attributes ->- Attributes ->- Bool ->- T_Child-sem_Child_Child name_ tp_ inh_ syn_ higherOrder_ =- (T_Child (\ _lhsIrulemap ->- (let _lhsOvchild :: VisageChild- -- "TfmToVisage.ag"(line 111, column 11)- _lhsOvchild =- VChild name_ tp_ inh_ syn_ (getForField (getName name_) _lhsIrulemap)- in ( _lhsOvchild))))--- Children -----------------------------------------------------{-- visit 0:- inherited attribute:- rulemap : VisageRuleMap- synthesized attribute:- vchildren : [VisageChild]- alternatives:- alternative Cons:- child hd : Child- child tl : Children- alternative Nil:--}--- cata-sem_Children :: Children ->- T_Children-sem_Children list =- (Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list))--- semantic domain-newtype T_Children = T_Children (VisageRuleMap ->- ( ([VisageChild])))-data Inh_Children = Inh_Children {rulemap_Inh_Children :: VisageRuleMap}-data Syn_Children = Syn_Children {vchildren_Syn_Children :: [VisageChild]}-wrap_Children (T_Children sem) (Inh_Children _lhsIrulemap) =- (let ( _lhsOvchildren) =- (sem _lhsIrulemap)- in (Syn_Children _lhsOvchildren))-sem_Children_Cons :: T_Child ->- T_Children ->- T_Children-sem_Children_Cons (T_Child hd_) (T_Children tl_) =- (T_Children (\ _lhsIrulemap ->- (let _lhsOvchildren :: ([VisageChild])- _hdOrulemap :: VisageRuleMap- _tlOrulemap :: VisageRuleMap- _hdIvchild :: VisageChild- _tlIvchildren :: ([VisageChild])- -- "TfmToVisage.ag"(line 107, column 17)- _lhsOvchildren =- _hdIvchild : _tlIvchildren- -- copy rule (down)- _hdOrulemap =- _lhsIrulemap- -- copy rule (down)- _tlOrulemap =- _lhsIrulemap- ( _hdIvchild) =- (hd_ _hdOrulemap)- ( _tlIvchildren) =- (tl_ _tlOrulemap)- in ( _lhsOvchildren))))-sem_Children_Nil :: T_Children-sem_Children_Nil =- (T_Children (\ _lhsIrulemap ->- (let _lhsOvchildren :: ([VisageChild])- -- "TfmToVisage.ag"(line 108, column 17)- _lhsOvchildren =- []- in ( _lhsOvchildren))))--- Expression ---------------------------------------------------{-- visit 0:- synthesized attribute:- self : SELF- alternatives:- alternative Expression:- child pos : {Pos}- child tks : {[HsToken]}- visit 0:- local self : _--}--- cata-sem_Expression :: Expression ->- T_Expression-sem_Expression (Expression _pos _tks) =- (sem_Expression_Expression _pos _tks)--- semantic domain-newtype T_Expression = T_Expression (( Expression))-data Inh_Expression = Inh_Expression {}-data Syn_Expression = Syn_Expression {self_Syn_Expression :: Expression}-wrap_Expression (T_Expression sem) (Inh_Expression ) =- (let ( _lhsOself) =- (sem )- in (Syn_Expression _lhsOself))-sem_Expression_Expression :: Pos ->- ([HsToken]) ->- T_Expression-sem_Expression_Expression pos_ tks_ =- (T_Expression (let _lhsOself :: Expression- -- self rule- _self =- Expression pos_ tks_- -- self rule- _lhsOself =- _self- in ( _lhsOself)))--- Grammar ------------------------------------------------------{-- visit 0:- synthesized attribute:- visage : VisageGrammar- alternatives:- alternative Grammar:- child typeSyns : {TypeSyns}- child useMap : {UseMap}- child derivings : {Derivings}- child wrappers : {Set NontermIdent}- child nonts : Nonterminals- child pragmas : {PragmaMap}- child manualAttrOrderMap : {AttrOrderMap}- child paramMap : {ParamMap}- child contextMap : {ContextMap}- 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 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 sem) (Inh_Nonterminal ) =- (let ( _lhsOvnont) =- (sem )- in (Syn_Nonterminal _lhsOvnont))-sem_Nonterminal_Nonterminal :: NontermIdent ->- ([Identifier]) ->- Attributes ->- Attributes ->- T_Productions ->- T_Nonterminal-sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ (T_Productions prods_) =- (T_Nonterminal (let _lhsOvnont :: VisageNonterminal- _prodsIvprods :: ([VisageProduction])- -- "TfmToVisage.ag"(line 93, column 18)- _lhsOvnont =- VNonterminal nt_ inh_ syn_ _prodsIvprods- ( _prodsIvprods) =- (prods_ )- in ( _lhsOvnont)))--- Nonterminals -------------------------------------------------{-- visit 0:- synthesized attribute:- vnonts : [VisageNonterminal]- alternatives:- alternative Cons:- child hd : Nonterminal- child tl : Nonterminals- alternative Nil:--}--- cata-sem_Nonterminals :: Nonterminals ->- T_Nonterminals-sem_Nonterminals list =- (Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list))--- semantic domain-newtype T_Nonterminals = T_Nonterminals (( ([VisageNonterminal])))-data Inh_Nonterminals = Inh_Nonterminals {}-data Syn_Nonterminals = Syn_Nonterminals {vnonts_Syn_Nonterminals :: [VisageNonterminal]}-wrap_Nonterminals (T_Nonterminals sem) (Inh_Nonterminals ) =- (let ( _lhsOvnonts) =- (sem )- in (Syn_Nonterminals _lhsOvnonts))-sem_Nonterminals_Cons :: T_Nonterminal ->- T_Nonterminals ->- T_Nonterminals-sem_Nonterminals_Cons (T_Nonterminal hd_) (T_Nonterminals tl_) =- (T_Nonterminals (let _lhsOvnonts :: ([VisageNonterminal])- _hdIvnont :: VisageNonterminal- _tlIvnonts :: ([VisageNonterminal])- -- "TfmToVisage.ag"(line 89, column 17)- _lhsOvnonts =- _hdIvnont : _tlIvnonts- ( _hdIvnont) =- (hd_ )- ( _tlIvnonts) =- (tl_ )- in ( _lhsOvnonts)))-sem_Nonterminals_Nil :: T_Nonterminals-sem_Nonterminals_Nil =- (T_Nonterminals (let _lhsOvnonts :: ([VisageNonterminal])- -- "TfmToVisage.ag"(line 90, column 17)- _lhsOvnonts =- []- in ( _lhsOvnonts)))--- Pattern ------------------------------------------------------{-- visit 0:- synthesized attributes:- copy : SELF- fieldattrs : [(Identifier,Identifier)] - self : SELF- vpat : VisagePattern- alternatives:- alternative Alias:- child field : {Identifier}- child attr : {Identifier}- child pat : Pattern- child parts : Patterns- visit 0:- local copy : _- local self : _- alternative Constr:- child name : {ConstructorIdent}- child pats : Patterns- visit 0:- local copy : _- local self : _- alternative Irrefutable:- child pat : Pattern- visit 0:- local copy : _- local self : _- alternative Product:- child pos : {Pos}- child pats : Patterns- visit 0:- local copy : _- local self : _- alternative Underscore:- child pos : {Pos}- visit 0:- local copy : _- local self : _--}--- cata-sem_Pattern :: Pattern ->- T_Pattern-sem_Pattern (Alias _field _attr _pat _parts) =- (sem_Pattern_Alias _field _attr (sem_Pattern _pat) (sem_Patterns _parts))-sem_Pattern (Constr _name _pats) =- (sem_Pattern_Constr _name (sem_Patterns _pats))-sem_Pattern (Irrefutable _pat) =- (sem_Pattern_Irrefutable (sem_Pattern _pat))-sem_Pattern (Product _pos _pats) =- (sem_Pattern_Product _pos (sem_Patterns _pats))-sem_Pattern (Underscore _pos) =- (sem_Pattern_Underscore _pos)--- semantic domain-newtype T_Pattern = T_Pattern (( Pattern,( [(Identifier,Identifier)] ),Pattern,VisagePattern))-data Inh_Pattern = Inh_Pattern {}-data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern,fieldattrs_Syn_Pattern :: [(Identifier,Identifier)] ,self_Syn_Pattern :: Pattern,vpat_Syn_Pattern :: VisagePattern}-wrap_Pattern (T_Pattern sem) (Inh_Pattern ) =- (let ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpat) =- (sem )- in (Syn_Pattern _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpat))-sem_Pattern_Alias :: Identifier ->- Identifier ->- T_Pattern ->- T_Patterns ->- T_Pattern-sem_Pattern_Alias field_ attr_ (T_Pattern pat_) (T_Patterns parts_) =- (T_Pattern (let _lhsOvpat :: VisagePattern- _lhsOfieldattrs :: ( [(Identifier,Identifier)] )- _lhsOcopy :: Pattern- _lhsOself :: Pattern- _patIcopy :: Pattern- _patIfieldattrs :: ( [(Identifier,Identifier)] )- _patIself :: Pattern- _patIvpat :: VisagePattern- _partsIcopy :: Patterns- _partsIfieldattrs :: ( [(Identifier,Identifier)] )- _partsIself :: Patterns- _partsIvpats :: ([VisagePattern])- -- "TfmToVisage.ag"(line 128, column 17)- _lhsOvpat =- if (isVar _self)- then VVar field_ attr_- else VAlias field_ attr_ _patIvpat- -- "TfmToVisage.ag"(line 137, column 17)- _lhsOfieldattrs =- [(field_, attr_)]- -- self rule- _copy =- Alias field_ attr_ _patIcopy _partsIcopy- -- self rule- _self =- Alias field_ attr_ _patIself _partsIself- -- self rule- _lhsOcopy =- _copy- -- self rule- _lhsOself =- _self- ( _patIcopy,_patIfieldattrs,_patIself,_patIvpat) =- (pat_ )- ( _partsIcopy,_partsIfieldattrs,_partsIself,_partsIvpats) =- (parts_ )- in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpat)))-sem_Pattern_Constr :: ConstructorIdent ->- T_Patterns ->- T_Pattern-sem_Pattern_Constr name_ (T_Patterns pats_) =- (T_Pattern (let _lhsOvpat :: VisagePattern- _lhsOfieldattrs :: ( [(Identifier,Identifier)] )- _lhsOcopy :: Pattern- _lhsOself :: Pattern- _patsIcopy :: Patterns- _patsIfieldattrs :: ( [(Identifier,Identifier)] )- _patsIself :: Patterns- _patsIvpats :: ([VisagePattern])- -- "TfmToVisage.ag"(line 126, column 17)- _lhsOvpat =- VConstr name_ _patsIvpats- -- use rule "TfmToVisage.ag"(line 134, column 43)- _lhsOfieldattrs =- _patsIfieldattrs- -- self rule- _copy =- Constr name_ _patsIcopy- -- self rule- _self =- Constr name_ _patsIself- -- self rule- _lhsOcopy =- _copy- -- self rule- _lhsOself =- _self- ( _patsIcopy,_patsIfieldattrs,_patsIself,_patsIvpats) =- (pats_ )- in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpat)))-sem_Pattern_Irrefutable :: T_Pattern ->- T_Pattern-sem_Pattern_Irrefutable (T_Pattern pat_) =- (T_Pattern (let _lhsOfieldattrs :: ( [(Identifier,Identifier)] )- _lhsOcopy :: Pattern- _lhsOself :: Pattern- _lhsOvpat :: VisagePattern- _patIcopy :: Pattern- _patIfieldattrs :: ( [(Identifier,Identifier)] )- _patIself :: Pattern- _patIvpat :: VisagePattern- -- use rule "TfmToVisage.ag"(line 134, column 43)- _lhsOfieldattrs =- _patIfieldattrs- -- self rule- _copy =- Irrefutable _patIcopy- -- self rule- _self =- Irrefutable _patIself- -- self rule- _lhsOcopy =- _copy- -- self rule- _lhsOself =- _self- -- copy rule (up)- _lhsOvpat =- _patIvpat- ( _patIcopy,_patIfieldattrs,_patIself,_patIvpat) =- (pat_ )- in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpat)))-sem_Pattern_Product :: Pos ->- T_Patterns ->- T_Pattern-sem_Pattern_Product pos_ (T_Patterns pats_) =- (T_Pattern (let _lhsOvpat :: VisagePattern- _lhsOfieldattrs :: ( [(Identifier,Identifier)] )- _lhsOcopy :: Pattern- _lhsOself :: Pattern- _patsIcopy :: Patterns- _patsIfieldattrs :: ( [(Identifier,Identifier)] )- _patsIself :: Patterns- _patsIvpats :: ([VisagePattern])- -- "TfmToVisage.ag"(line 127, column 17)- _lhsOvpat =- VProduct pos_ _patsIvpats- -- use rule "TfmToVisage.ag"(line 134, column 43)- _lhsOfieldattrs =- _patsIfieldattrs- -- self rule- _copy =- Product pos_ _patsIcopy- -- self rule- _self =- Product pos_ _patsIself- -- self rule- _lhsOcopy =- _copy- -- self rule- _lhsOself =- _self- ( _patsIcopy,_patsIfieldattrs,_patsIself,_patsIvpats) =- (pats_ )- in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpat)))-sem_Pattern_Underscore :: Pos ->- T_Pattern-sem_Pattern_Underscore pos_ =- (T_Pattern (let _lhsOvpat :: VisagePattern- _lhsOfieldattrs :: ( [(Identifier,Identifier)] )- _lhsOcopy :: Pattern- _lhsOself :: Pattern- -- "TfmToVisage.ag"(line 131, column 17)- _lhsOvpat =- VUnderscore pos_- -- use rule "TfmToVisage.ag"(line 134, column 43)- _lhsOfieldattrs =- []- -- self rule- _copy =- Underscore pos_- -- self rule- _self =- Underscore pos_- -- self rule- _lhsOcopy =- _copy- -- self rule- _lhsOself =- _self- in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpat)))--- Patterns -----------------------------------------------------{-- visit 0:- synthesized attributes:- copy : SELF- fieldattrs : [(Identifier,Identifier)] - self : SELF- vpats : [VisagePattern]- alternatives:- alternative Cons:- child hd : Pattern- child tl : Patterns- visit 0:- local copy : _- local self : _- alternative Nil:- visit 0:- local copy : _- local self : _--}--- cata-sem_Patterns :: Patterns ->- T_Patterns-sem_Patterns list =- (Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list))--- semantic domain-newtype T_Patterns = T_Patterns (( Patterns,( [(Identifier,Identifier)] ),Patterns,([VisagePattern])))-data Inh_Patterns = Inh_Patterns {}-data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns,fieldattrs_Syn_Patterns :: [(Identifier,Identifier)] ,self_Syn_Patterns :: Patterns,vpats_Syn_Patterns :: [VisagePattern]}-wrap_Patterns (T_Patterns sem) (Inh_Patterns ) =- (let ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpats) =- (sem )- in (Syn_Patterns _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpats))-sem_Patterns_Cons :: T_Pattern ->- T_Patterns ->- T_Patterns-sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) =- (T_Patterns (let _lhsOvpats :: ([VisagePattern])- _lhsOfieldattrs :: ( [(Identifier,Identifier)] )- _lhsOcopy :: Patterns- _lhsOself :: Patterns- _hdIcopy :: Pattern- _hdIfieldattrs :: ( [(Identifier,Identifier)] )- _hdIself :: Pattern- _hdIvpat :: VisagePattern- _tlIcopy :: Patterns- _tlIfieldattrs :: ( [(Identifier,Identifier)] )- _tlIself :: Patterns- _tlIvpats :: ([VisagePattern])- -- "TfmToVisage.ag"(line 122, column 17)- _lhsOvpats =- _hdIvpat : _tlIvpats- -- use rule "TfmToVisage.ag"(line 134, column 43)- _lhsOfieldattrs =- _hdIfieldattrs ++ _tlIfieldattrs- -- self rule- _copy =- (:) _hdIcopy _tlIcopy- -- self rule- _self =- (:) _hdIself _tlIself- -- self rule- _lhsOcopy =- _copy- -- self rule- _lhsOself =- _self- ( _hdIcopy,_hdIfieldattrs,_hdIself,_hdIvpat) =- (hd_ )- ( _tlIcopy,_tlIfieldattrs,_tlIself,_tlIvpats) =- (tl_ )- in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpats)))-sem_Patterns_Nil :: T_Patterns-sem_Patterns_Nil =- (T_Patterns (let _lhsOvpats :: ([VisagePattern])- _lhsOfieldattrs :: ( [(Identifier,Identifier)] )- _lhsOcopy :: Patterns- _lhsOself :: Patterns- -- "TfmToVisage.ag"(line 123, column 17)- _lhsOvpats =- []- -- use rule "TfmToVisage.ag"(line 134, column 43)- _lhsOfieldattrs =- []- -- self rule- _copy =- []- -- self rule- _self =- []- -- self rule- _lhsOcopy =- _copy- -- self rule- _lhsOself =- _self- in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpats)))--- Production ---------------------------------------------------{-- visit 0:- synthesized attribute:- vprod : VisageProduction- alternatives:- alternative Production:- child con : {ConstructorIdent}- child children : Children- child rules : Rules- child typeSigs : TypeSigs- visit 0:- local splitVRules : _- local locrules : _- local lhsrules : _--}--- cata-sem_Production :: Production ->- T_Production-sem_Production (Production _con _children _rules _typeSigs) =- (sem_Production_Production _con (sem_Children _children) (sem_Rules _rules) (sem_TypeSigs _typeSigs))--- semantic domain-newtype T_Production = T_Production (( VisageProduction))-data Inh_Production = Inh_Production {}-data Syn_Production = Syn_Production {vprod_Syn_Production :: VisageProduction}-wrap_Production (T_Production sem) (Inh_Production ) =- (let ( _lhsOvprod) =- (sem )- in (Syn_Production _lhsOvprod))-sem_Production_Production :: ConstructorIdent ->- T_Children ->- T_Rules ->- T_TypeSigs ->- T_Production-sem_Production_Production con_ (T_Children children_) (T_Rules rules_) (T_TypeSigs typeSigs_) =- (T_Production (let _lhsOvprod :: VisageProduction- _childrenOrulemap :: VisageRuleMap- _childrenIvchildren :: ([VisageChild])- _rulesIvrules :: ([VisageRule])- -- "TfmToVisage.ag"(line 100, column 17)- _lhsOvprod =- VProduction con_ _childrenIvchildren _lhsrules _locrules- -- "TfmToVisage.ag"(line 101, column 17)- _splitVRules =- splitVRules _rulesIvrules- -- "TfmToVisage.ag"(line 102, column 17)- _locrules =- getForField "loc" _splitVRules- -- "TfmToVisage.ag"(line 103, column 17)- _lhsrules =- getForField "lhs" _splitVRules- -- "TfmToVisage.ag"(line 104, column 17)- _childrenOrulemap =- _splitVRules- ( _childrenIvchildren) =- (children_ _childrenOrulemap)- ( _rulesIvrules) =- (rules_ )- in ( _lhsOvprod)))--- Productions --------------------------------------------------{-- visit 0:- synthesized attribute:- vprods : [VisageProduction]- alternatives:- alternative Cons:- child hd : Production- child tl : Productions- alternative Nil:--}--- cata-sem_Productions :: Productions ->- T_Productions-sem_Productions list =- (Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list))--- semantic domain-newtype T_Productions = T_Productions (( ([VisageProduction])))-data Inh_Productions = Inh_Productions {}-data Syn_Productions = Syn_Productions {vprods_Syn_Productions :: [VisageProduction]}-wrap_Productions (T_Productions sem) (Inh_Productions ) =- (let ( _lhsOvprods) =- (sem )- in (Syn_Productions _lhsOvprods))-sem_Productions_Cons :: T_Production ->- T_Productions ->- T_Productions-sem_Productions_Cons (T_Production hd_) (T_Productions tl_) =- (T_Productions (let _lhsOvprods :: ([VisageProduction])- _hdIvprod :: VisageProduction- _tlIvprods :: ([VisageProduction])- -- "TfmToVisage.ag"(line 96, column 17)- _lhsOvprods =- _hdIvprod : _tlIvprods- ( _hdIvprod) =- (hd_ )- ( _tlIvprods) =- (tl_ )- in ( _lhsOvprods)))-sem_Productions_Nil :: T_Productions-sem_Productions_Nil =- (T_Productions (let _lhsOvprods :: ([VisageProduction])- -- "TfmToVisage.ag"(line 97, column 17)- _lhsOvprods =- []- in ( _lhsOvprods)))--- Rule ---------------------------------------------------------{-- visit 0:- synthesized attribute:- vrule : VisageRule- alternatives:- alternative Rule:- child pattern : Pattern- child rhs : Expression- child owrt : {Bool}- child origin : {String}--}--- cata-sem_Rule :: Rule ->- T_Rule-sem_Rule (Rule _pattern _rhs _owrt _origin) =- (sem_Rule_Rule (sem_Pattern _pattern) (sem_Expression _rhs) _owrt _origin)--- semantic domain-newtype T_Rule = T_Rule (( VisageRule))-data Inh_Rule = Inh_Rule {}-data Syn_Rule = Syn_Rule {vrule_Syn_Rule :: VisageRule}-wrap_Rule (T_Rule sem) (Inh_Rule ) =- (let ( _lhsOvrule) =- (sem )- in (Syn_Rule _lhsOvrule))-sem_Rule_Rule :: T_Pattern ->- T_Expression ->- Bool ->- String ->- T_Rule-sem_Rule_Rule (T_Pattern pattern_) (T_Expression rhs_) owrt_ origin_ =- (T_Rule (let _lhsOvrule :: VisageRule- _patternIcopy :: Pattern- _patternIfieldattrs :: ( [(Identifier,Identifier)] )- _patternIself :: Pattern- _patternIvpat :: VisagePattern- _rhsIself :: Expression- -- "TfmToVisage.ag"(line 119, column 11)- _lhsOvrule =- VRule _patternIfieldattrs undefined _patternIvpat _rhsIself owrt_- ( _patternIcopy,_patternIfieldattrs,_patternIself,_patternIvpat) =- (pattern_ )- ( _rhsIself) =- (rhs_ )- in ( _lhsOvrule)))--- Rules --------------------------------------------------------{-- visit 0:- synthesized attribute:- vrules : [VisageRule]- alternatives:- alternative Cons:- child hd : Rule- child tl : Rules- alternative Nil:--}--- cata-sem_Rules :: Rules ->- T_Rules-sem_Rules list =- (Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list))--- semantic domain-newtype T_Rules = T_Rules (( ([VisageRule])))-data Inh_Rules = Inh_Rules {}-data Syn_Rules = Syn_Rules {vrules_Syn_Rules :: [VisageRule]}-wrap_Rules (T_Rules sem) (Inh_Rules ) =- (let ( _lhsOvrules) =- (sem )- in (Syn_Rules _lhsOvrules))-sem_Rules_Cons :: T_Rule ->- T_Rules ->- T_Rules-sem_Rules_Cons (T_Rule hd_) (T_Rules tl_) =- (T_Rules (let _lhsOvrules :: ([VisageRule])- _hdIvrule :: VisageRule- _tlIvrules :: ([VisageRule])- -- "TfmToVisage.ag"(line 114, column 17)- _lhsOvrules =- _hdIvrule : _tlIvrules- ( _hdIvrule) =- (hd_ )- ( _tlIvrules) =- (tl_ )- in ( _lhsOvrules)))-sem_Rules_Nil :: T_Rules-sem_Rules_Nil =- (T_Rules (let _lhsOvrules :: ([VisageRule])- -- "TfmToVisage.ag"(line 115, column 17)- _lhsOvrules =- []- in ( _lhsOvrules)))--- TypeSig ------------------------------------------------------{-- alternatives:- alternative TypeSig:- child name : {Identifier}- child tp : {Type}--}--- cata-sem_TypeSig :: TypeSig ->- T_TypeSig-sem_TypeSig (TypeSig _name _tp) =- (sem_TypeSig_TypeSig _name _tp)--- semantic domain-newtype T_TypeSig = T_TypeSig (( ))-data Inh_TypeSig = Inh_TypeSig {}-data Syn_TypeSig = Syn_TypeSig {}-wrap_TypeSig (T_TypeSig sem) (Inh_TypeSig ) =- (let ( ) =- (sem )- in (Syn_TypeSig ))-sem_TypeSig_TypeSig :: Identifier ->- Type ->- T_TypeSig-sem_TypeSig_TypeSig name_ tp_ =- (T_TypeSig (let - in ( )))--- TypeSigs -----------------------------------------------------{-- alternatives:- alternative Cons:- child hd : TypeSig- child tl : TypeSigs- alternative Nil:--}--- cata-sem_TypeSigs :: TypeSigs ->- T_TypeSigs-sem_TypeSigs list =- (Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list))--- semantic domain-newtype T_TypeSigs = T_TypeSigs (( ))-data Inh_TypeSigs = Inh_TypeSigs {}-data Syn_TypeSigs = Syn_TypeSigs {}-wrap_TypeSigs (T_TypeSigs sem) (Inh_TypeSigs ) =- (let ( ) =- (sem )- in (Syn_TypeSigs ))-sem_TypeSigs_Cons :: T_TypeSig ->- T_TypeSigs ->- T_TypeSigs-sem_TypeSigs_Cons (T_TypeSig hd_) (T_TypeSigs tl_) =- (T_TypeSigs (let - in ( )))-sem_TypeSigs_Nil :: T_TypeSigs-sem_TypeSigs_Nil =- (T_TypeSigs (let - in ( )))+ + +-- UUAGC 0.9.10 (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,3921 +1,3990 @@--- UUAGC 0.9.5 (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 UU.DData.Seq as Seq (Seq, empty, (<>), single, cons, toList, fromList)-import UU.Scanner.Position(noPos)--import ConcreteSyntax-import AbstractSyntax-import ErrorMessages-import Patterns (Patterns(..),Pattern(..))-import Expression (Expression(..))-import 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.single (dupError key key'))- Nothing -> (Map.insert key val m,Seq.empty)--checkDuplicates :: (Identifier -> Identifier -> Error)- -> [(Identifier, val)] -> Map Identifier val -> (Map Identifier val,Seq Error)-checkDuplicates dupError new m = foldErrors check m new- where check = uncurry (checkDuplicate dupError)--foldErrors f e xs = foldl g (e,Seq.empty) xs- where g ~(e,es) x = let (e',es') = f x e- in (e', es <> es')---checkForDuplicates :: (Identifier -> Identifier -> Error) -> [Identifier] -> [Error]-checkForDuplicates err [] = []-checkForDuplicates err (x:xs) = let (same,other) = List.partition (equalId x) xs- in map (err x) same ++ checkForDuplicates err other--equalId :: Identifier -> Identifier -> Bool-equalId x y = getName x == getName y---type RulesAndErrors = ([Rule], Seq Error)-type SigsAndErrors = ([TypeSig], Seq Error)-type InstsAndErrors = ([(Identifier, Type)], Seq Error)-type 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.cons (DupRule nt con field attr2 attr) e, m, fa:u, bs)- Nothing -> ( e, Map.insert fa owrt m, u, fa:bs)- else (Seq.cons (SuperfluousRule nt con field attr) e, m, fa:u, bs)- _ -> (Seq.cons (UndefChild nt con field) e, m, fa:u, bs )-- in fst (foldr checkRule (([],Seq.empty),Map.empty) rs)--checkSigs :: NontermIdent -> ConstructorIdent -> [SigInfo] -> SigsAndErrors-checkSigs nt con sis - = let checkSig (ide,typ) (sigs,errs)- = if ide `elem` map (\(TypeSig n t)-> n) sigs- then (sigs, Seq.cons (DupSig nt con ide) errs)- -- else if not (ide `elem` locattrdefs)- -- then (sigs, Seq.cons (SupSig nt con ide) errs)- else (TypeSig ide typ:sigs, errs)- in foldr checkSig ([],Seq.empty) sis--checkInsts :: Set NontermIdent -> Map NontermIdent (Map ConstructorIdent [SigInfo]) -> NontermIdent -> ConstructorIdent -> [Identifier] -> InstsAndErrors-checkInsts allNts sigMap nt con- = foldr (\inst (insts, errs) ->- maybe (insts, Seq.single (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.single (UndefNont nm') <> errs)- | otherwise -> (insts, Seq.single (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.cons (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.cons (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.single(UndefNont nt))- | otherwise = let (inh,syn) = Map.findWithDefault (Map.empty,Map.empty) nt decls- (inh',einh) = checkDuplicates (DupInhAttr nt) inherited inh- (syn',esyn) = checkDuplicates (DupSynAttr nt) synthesized syn- in (Map.insert nt (inh',syn') decls,einh <> esyn)--addSelf name atMap = let (eInh,eSyn) = Map.findWithDefault(Map.empty,Map.empty) name atMap- in Map.insert name (eInh, Map.insert (Ident "self" noPos) (NT _SELF []) eSyn)atMap--makeType :: Set NontermIdent -> Type -> Type-makeType nts tp@(NT x _) | x == _SELF = tp- | Set.member x nts = tp- | otherwise = Haskell (typeToHaskellString Nothing [] tp)-makeType _ tp = tp--constructGrammar :: Set NontermIdent- -> ParamMap- -> DataTypes- -> Map NontermIdent (Attributes, Attributes)- -> Map NontermIdent (Map Identifier (String, String, String))- -> Derivings- -> Set NontermIdent- -> Map NontermIdent (Map ConstructorIdent [Rule])- -> Map NontermIdent (Map ConstructorIdent [TypeSig])- -> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)])- -> TypeSyns- -> PragmaMap- -> AttrOrderMap- -> ContextMap- -> 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 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 49, 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 235, 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 238, column 10)- _allConstrs =- let f (nt,con,_) = Map.insertWith (++) nt [con]- in foldr f (Map.empty) _elemsIcollectedFields- -- "Transform.ag"(line 241, 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 244, 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 250, 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 253, 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 256, column 10)- _allRulesErrs =- Map.mapWithKey (Map.mapWithKey . (checkRules _allAttrDecls _allFields _allInsts _allSigs )) _allRules- -- "Transform.ag"(line 257, column 10)- _allSigsErrs =- Map.mapWithKey (Map.mapWithKey . (checkSigs )) _allSigs- -- "Transform.ag"(line 258, column 10)- _allInstsErrs =- Map.mapWithKey (Map.mapWithKey . (checkInsts _allNonterminals _allSigs )) _allInsts- -- "Transform.ag"(line 259, column 10)- _allUniquesErrs =- Map.mapWithKey (Map.mapWithKey . (checkUniques _allAttrDecls )) _allUniques- -- "Transform.ag"(line 261, column 10)- _checkedRulesPre =- Map.map (Map.map fst) _allRulesErrs- -- "Transform.ag"(line 262, column 10)- _checkedSigs =- Map.map (Map.map fst) _allSigsErrs- -- "Transform.ag"(line 263, column 10)- _checkedInsts =- Map.map (Map.map fst) _allInstsErrs- -- "Transform.ag"(line 264, column 10)- _checkedUniques =- Map.map (Map.map fst) _allUniquesErrs- -- "Transform.ag"(line 265, column 10)- _checkedRules =- Map.unionWith (Map.unionWith (++)) _checkedRulesPre (Map.mapWithKey (Map.mapWithKey . (mkUniqueRules _lhsIoptions _allFields _allAttrDecls )) _checkedUniques )- -- "Transform.ag"(line 267, column 10)- _errs1 =- let f = checkForDuplicates (DupSynonym)- in Seq.fromList . f . map fst $ _elemsItypeSyns- -- "Transform.ag"(line 270, 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 274, column 10)- _errs3 =- let f (nt,cons) = checkForDuplicates (DupAlt nt) cons- in Seq.empty- -- "Transform.ag"(line 278, column 10)- _errs4 =- let f m s = Map.fold ((<>) . snd) s m- in Map.fold f Seq.empty _allRulesErrs- -- "Transform.ag"(line 281, column 10)- _errs5 =- let f m s = Map.fold ((<>) . snd) s m- in Map.fold f Seq.empty _allSigsErrs- -- "Transform.ag"(line 284, column 10)- _errs6 =- let f m s = Map.fold ((<>) . snd) s m- in Map.fold f Seq.empty _allInstsErrs- -- "Transform.ag"(line 287, column 10)- _errs7 =- let f m s = Map.fold ((<>) . snd) s m- in Map.fold f Seq.empty _allUniquesErrs- -- "Transform.ag"(line 290, column 10)- _lhsOerrors =- _elemsIerrors <> _errs1 <> _errs2 <> _errs3 <> _errs4 <> _errs5 <> _errs6 <> _errs7- -- "Transform.ag"(line 423, column 10)- _allNonterminals =- _elemsIcollectedNames `Set.difference` _elemsIcollectedSetNames- -- "Transform.ag"(line 443, column 8)- _elemsOallConstructors =- _elemsIcollectedConstructorsMap- -- "Transform.ag"(line 516, column 8)- _elemsOdefSets =- Map.fromList (map (\x->(x,(Set.singleton x, Set.empty))) (Set.toList _allNonterminals ))- -- "Transform.ag"(line 517, column 8)- _elemsOdefinedSets =- Map.map fst _elemsIdefSets- -- "Transform.ag"(line 769, column 8)- _elemsOattrDecls =- Map.empty- -- "Transform.ag"(line 808, column 9)- _allAttrDecls =- if withSelf _lhsIoptions- then foldr addSelf _elemsIattrDecls (Set.toList _allNonterminals )- else _elemsIattrDecls- -- use rule "Transform.ag"(line 42, column 19)- _lhsOblocks =- _elemsIblocks- -- use rule "Transform.ag"(line 902, column 37)- _lhsOmoduleDecl =- _elemsImoduleDecl- -- use rule "Transform.ag"(line 598, 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 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 220, 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 87, column 62)- _lhsOcollectedConstructorNames =- _namesIcollectedConstructorNames- ( _namesIcollectedConstructorNames,_namesIconstructors,_namesIerrors) =- (names_ )- in ( _lhsOcollectedConstructorNames,_lhsOcollectedFields))))--- Alts ---------------------------------------------------------{-- visit 0:- inherited attributes:- allConstructors : Map NontermIdent (Set ConstructorIdent)- allNonterminals : Set NontermIdent- nts : Set NontermIdent- synthesized attributes:- collectedConstructorNames : Set ConstructorIdent- collectedFields : [(NontermIdent, ConstructorIdent, FieldMap)]- alternatives:- alternative Cons:- child hd : Alt- child tl : Alts- alternative Nil:--}--- cata-sem_Alts :: Alts ->- T_Alts-sem_Alts list =- (Prelude.foldr sem_Alts_Cons sem_Alts_Nil (Prelude.map sem_Alt list))--- semantic domain-newtype T_Alts = T_Alts ((Map NontermIdent (Set ConstructorIdent)) ->- (Set NontermIdent) ->- (Set NontermIdent) ->- ( (Set ConstructorIdent),([(NontermIdent, ConstructorIdent, FieldMap)])))-data Inh_Alts = Inh_Alts {allConstructors_Inh_Alts :: !(Map NontermIdent (Set ConstructorIdent)),allNonterminals_Inh_Alts :: !(Set NontermIdent),nts_Inh_Alts :: !(Set NontermIdent)}-data Syn_Alts = Syn_Alts {collectedConstructorNames_Syn_Alts :: !(Set ConstructorIdent),collectedFields_Syn_Alts :: !([(NontermIdent, ConstructorIdent, FieldMap)])}-wrap_Alts (T_Alts sem) (Inh_Alts _lhsIallConstructors _lhsIallNonterminals _lhsInts) =- (let ( _lhsOcollectedConstructorNames,_lhsOcollectedFields) =- (sem _lhsIallConstructors _lhsIallNonterminals _lhsInts)- in (Syn_Alts _lhsOcollectedConstructorNames _lhsOcollectedFields))-sem_Alts_Cons :: T_Alt ->- T_Alts ->- T_Alts-sem_Alts_Cons (T_Alt hd_) (T_Alts tl_) =- (T_Alts (\ _lhsIallConstructors- _lhsIallNonterminals- _lhsInts ->- (let _lhsOcollectedConstructorNames :: (Set ConstructorIdent)- _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])- _hdOallConstructors :: (Map NontermIdent (Set ConstructorIdent))- _hdOallNonterminals :: (Set NontermIdent)- _hdOnts :: (Set NontermIdent)- _tlOallConstructors :: (Map NontermIdent (Set ConstructorIdent))- _tlOallNonterminals :: (Set NontermIdent)- _tlOnts :: (Set NontermIdent)- _hdIcollectedConstructorNames :: (Set ConstructorIdent)- _hdIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])- _tlIcollectedConstructorNames :: (Set ConstructorIdent)- _tlIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])- -- use rule "Transform.ag"(line 87, column 62)- _lhsOcollectedConstructorNames =- _hdIcollectedConstructorNames `Set.union` _tlIcollectedConstructorNames- -- use rule "Transform.ag"(line 119, 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 87, column 62)- _lhsOcollectedConstructorNames =- Set.empty- -- use rule "Transform.ag"(line 119, column 28)- _lhsOcollectedFields =- []- in ( _lhsOcollectedConstructorNames,_lhsOcollectedFields))))--- Attrs --------------------------------------------------------{-- visit 0:- inherited attributes:- allFields : DataTypes- allNonterminals : Set NontermIdent- nts : Set NontermIdent- chained attribute:- attrDecls : Map NontermIdent (Attributes, Attributes)- synthesized attributes:- errors : Seq Error- useMap : Map NontermIdent (Map Identifier (String,String,String))- alternatives:- alternative Attrs:- child pos : {Pos}- child inh : {AttrNames}- child chn : {AttrNames}- child syn : {AttrNames}- visit 0:- local _tup1 : _- local attrDecls : _- local errors : _- local _tup2 : _- local inherited : _- local synthesized : _- local useMap : _--}--- cata-sem_Attrs :: Attrs ->- T_Attrs-sem_Attrs (Attrs _pos _inh _chn _syn) =- (sem_Attrs_Attrs _pos _inh _chn _syn)--- semantic domain-newtype T_Attrs = T_Attrs (DataTypes ->- (Set NontermIdent) ->- (Map NontermIdent (Attributes, Attributes)) ->- (Set NontermIdent) ->- ( (Map NontermIdent (Attributes, Attributes)),(Seq Error),(Map NontermIdent (Map Identifier (String,String,String)))))-data Inh_Attrs = Inh_Attrs {allFields_Inh_Attrs :: !(DataTypes),allNonterminals_Inh_Attrs :: !(Set NontermIdent),attrDecls_Inh_Attrs :: !(Map NontermIdent (Attributes, Attributes)),nts_Inh_Attrs :: !(Set NontermIdent)}-data Syn_Attrs = Syn_Attrs {attrDecls_Syn_Attrs :: !(Map NontermIdent (Attributes, Attributes)),errors_Syn_Attrs :: !(Seq Error),useMap_Syn_Attrs :: !(Map NontermIdent (Map Identifier (String,String,String)))}-wrap_Attrs (T_Attrs sem) (Inh_Attrs _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsInts) =- (let ( _lhsOattrDecls,_lhsOerrors,_lhsOuseMap) =- (sem _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsInts)- in (Syn_Attrs _lhsOattrDecls _lhsOerrors _lhsOuseMap))-sem_Attrs_Attrs :: Pos ->- AttrNames ->- AttrNames ->- AttrNames ->- T_Attrs-sem_Attrs_Attrs pos_ inh_ chn_ syn_ =- (T_Attrs (\ _lhsIallFields- _lhsIallNonterminals- _lhsIattrDecls- _lhsInts ->- (let _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))- _lhsOerrors :: (Seq Error)- _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes))- -- "Transform.ag"(line 777, column 15)- __tup1 =- checkAttrs _lhsIallFields (Set.toList _lhsInts) _inherited _synthesized _lhsIattrDecls- -- "Transform.ag"(line 777, column 15)- (_attrDecls,_) =- __tup1- -- "Transform.ag"(line 777, column 15)- (_,_errors) =- __tup1- -- "Transform.ag"(line 779, 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 779, column 15)- (_inherited,_,_) =- __tup2- -- "Transform.ag"(line 779, column 15)- (_,_synthesized,_) =- __tup2- -- "Transform.ag"(line 779, column 15)- (_,_,_useMap) =- __tup2- -- "Transform.ag"(line 787, column 11)- _lhsOuseMap =- Map.fromList (zip (Set.toList _lhsInts) (repeat _useMap))- -- use rule "Transform.ag"(line 40, column 19)- _lhsOerrors =- _errors- -- copy rule (from local)- _lhsOattrDecls =- _attrDecls- in ( _lhsOattrDecls,_lhsOerrors,_lhsOuseMap))))--- ConstructorSet -----------------------------------------------{-- visit 0:- synthesized attributes:- collectedConstructorNames : Set ConstructorIdent- constructors : (Set ConstructorIdent->Set ConstructorIdent)- errors : Seq Error- alternatives:- alternative CAll:- alternative CDifference:- child set1 : ConstructorSet- child set2 : ConstructorSet- alternative CName:- child name : {ConstructorIdent}- alternative CUnion:- child set1 : ConstructorSet- child set2 : ConstructorSet--}--- cata-sem_ConstructorSet :: ConstructorSet ->- T_ConstructorSet-sem_ConstructorSet (CAll ) =- (sem_ConstructorSet_CAll )-sem_ConstructorSet (CDifference _set1 _set2) =- (sem_ConstructorSet_CDifference (sem_ConstructorSet _set1) (sem_ConstructorSet _set2))-sem_ConstructorSet (CName _name) =- (sem_ConstructorSet_CName _name)-sem_ConstructorSet (CUnion _set1 _set2) =- (sem_ConstructorSet_CUnion (sem_ConstructorSet _set1) (sem_ConstructorSet _set2))--- semantic domain-newtype T_ConstructorSet = T_ConstructorSet (( (Set ConstructorIdent),((Set ConstructorIdent->Set ConstructorIdent)),(Seq Error)))-data Inh_ConstructorSet = Inh_ConstructorSet {}-data Syn_ConstructorSet = Syn_ConstructorSet {collectedConstructorNames_Syn_ConstructorSet :: !(Set ConstructorIdent),constructors_Syn_ConstructorSet :: !((Set ConstructorIdent->Set ConstructorIdent)),errors_Syn_ConstructorSet :: !(Seq Error)}-wrap_ConstructorSet (T_ConstructorSet sem) (Inh_ConstructorSet ) =- (let ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors) =- (sem )- in (Syn_ConstructorSet _lhsOcollectedConstructorNames _lhsOconstructors _lhsOerrors))-sem_ConstructorSet_CAll :: T_ConstructorSet-sem_ConstructorSet_CAll =- (T_ConstructorSet (let _lhsOconstructors :: ((Set ConstructorIdent->Set ConstructorIdent))- _lhsOcollectedConstructorNames :: (Set ConstructorIdent)- _lhsOerrors :: (Seq Error)- -- "Transform.ag"(line 583, column 17)- _lhsOconstructors =- \ds -> ds- -- use rule "Transform.ag"(line 87, column 62)- _lhsOcollectedConstructorNames =- Set.empty- -- use rule "Transform.ag"(line 40, 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 582, column 17)- _lhsOconstructors =- \ds -> _set1Iconstructors ds `Set.difference` _set2Iconstructors ds- -- use rule "Transform.ag"(line 87, column 62)- _lhsOcollectedConstructorNames =- _set1IcollectedConstructorNames `Set.union` _set2IcollectedConstructorNames- -- use rule "Transform.ag"(line 40, 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 431, column 11)- _lhsOcollectedConstructorNames =- Set.singleton name_- -- "Transform.ag"(line 580, column 17)- _lhsOconstructors =- \ds -> Set.singleton name_- -- use rule "Transform.ag"(line 40, 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 581, column 17)- _lhsOconstructors =- \ds -> _set1Iconstructors ds `Set.union` _set2Iconstructors ds- -- use rule "Transform.ag"(line 87, column 62)- _lhsOcollectedConstructorNames =- _set1IcollectedConstructorNames `Set.union` _set2IcollectedConstructorNames- -- use rule "Transform.ag"(line 40, 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 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 729, column 7)- _lhsOctxCollect =- if null ctx_- then Map.empty- else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet]- -- "Transform.ag"(line 773, column 10)- _attrsOnts =- _namesInontSet- -- use rule "Transform.ag"(line 670, column 55)- _lhsOattrOrderCollect =- Map.empty- -- use rule "Transform.ag"(line 42, column 19)- _lhsOblocks =- Map.empty- -- use rule "Transform.ag"(line 88, column 48)- _lhsOcollectedConstructorsMap =- Map.empty- -- use rule "Transform.ag"(line 119, column 28)- _lhsOcollectedFields =- []- -- use rule "Transform.ag"(line 144, column 31)- _lhsOcollectedInsts =- []- -- use rule "Transform.ag"(line 80, column 50)- _lhsOcollectedNames =- _namesIcollectedNames- -- use rule "Transform.ag"(line 142, column 31)- _lhsOcollectedRules =- []- -- use rule "Transform.ag"(line 79, column 50)- _lhsOcollectedSetNames =- Set.empty- -- use rule "Transform.ag"(line 143, column 31)- _lhsOcollectedSigs =- []- -- use rule "Transform.ag"(line 145, column 31)- _lhsOcollectedUniques =- []- -- use rule "Transform.ag"(line 750, column 33)- _lhsOderivings =- Map.empty- -- use rule "Transform.ag"(line 40, column 19)- _lhsOerrors =- _namesIerrors Seq.<> _attrsIerrors- -- use rule "Transform.ag"(line 902, column 37)- _lhsOmoduleDecl =- mzero- -- use rule "Transform.ag"(line 702, column 37)- _lhsOparamsCollect =- Map.empty- -- use rule "Transform.ag"(line 598, column 34)- _lhsOpragmas =- id- -- use rule "Transform.ag"(line 642, column 56)- _lhsOsemPragmasCollect =- Map.empty- -- use rule "Transform.ag"(line 458, column 32)- _lhsOtypeSyns =- []- -- use rule "Transform.ag"(line 131, column 15)- _lhsOuseMap =- _attrsIuseMap- -- use rule "Transform.ag"(line 589, 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 158, column 10)- _altsOnts =- _namesInontSet- -- "Transform.ag"(line 437, column 11)- _lhsOcollectedConstructorsMap =- Map.fromList- [ (n, _altsIcollectedConstructorNames)- | n <- Set.toList _namesInontSet- ]- -- "Transform.ag"(line 706, column 7)- _lhsOparamsCollect =- if null params_- then Map.empty- else Map.fromList [(nt, params_) | nt <- Set.toList _namesInontSet]- -- "Transform.ag"(line 729, column 7)- _lhsOctxCollect =- if null ctx_- then Map.empty- else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet]- -- "Transform.ag"(line 772, column 10)- _attrsOnts =- _namesInontSet- -- use rule "Transform.ag"(line 670, column 55)- _lhsOattrOrderCollect =- Map.empty- -- use rule "Transform.ag"(line 42, column 19)- _lhsOblocks =- Map.empty- -- use rule "Transform.ag"(line 119, column 28)- _lhsOcollectedFields =- _altsIcollectedFields- -- use rule "Transform.ag"(line 144, column 31)- _lhsOcollectedInsts =- []- -- use rule "Transform.ag"(line 80, column 50)- _lhsOcollectedNames =- _namesIcollectedNames- -- use rule "Transform.ag"(line 142, column 31)- _lhsOcollectedRules =- []- -- use rule "Transform.ag"(line 79, column 50)- _lhsOcollectedSetNames =- Set.empty- -- use rule "Transform.ag"(line 143, column 31)- _lhsOcollectedSigs =- []- -- use rule "Transform.ag"(line 145, column 31)- _lhsOcollectedUniques =- []- -- use rule "Transform.ag"(line 750, column 33)- _lhsOderivings =- Map.empty- -- use rule "Transform.ag"(line 40, column 19)- _lhsOerrors =- _namesIerrors Seq.<> _attrsIerrors- -- use rule "Transform.ag"(line 902, column 37)- _lhsOmoduleDecl =- mzero- -- use rule "Transform.ag"(line 598, column 34)- _lhsOpragmas =- id- -- use rule "Transform.ag"(line 642, column 56)- _lhsOsemPragmasCollect =- Map.empty- -- use rule "Transform.ag"(line 458, column 32)- _lhsOtypeSyns =- []- -- use rule "Transform.ag"(line 131, column 15)- _lhsOuseMap =- _attrsIuseMap- -- use rule "Transform.ag"(line 589, 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 757, column 14)- _lhsOderivings =- Map.fromList [(nt,Set.fromList classes_) | nt <- Set.toList _setInontSet]- -- use rule "Transform.ag"(line 670, column 55)- _lhsOattrOrderCollect =- Map.empty- -- use rule "Transform.ag"(line 42, column 19)- _lhsOblocks =- Map.empty- -- use rule "Transform.ag"(line 88, column 48)- _lhsOcollectedConstructorsMap =- Map.empty- -- use rule "Transform.ag"(line 119, column 28)- _lhsOcollectedFields =- []- -- use rule "Transform.ag"(line 144, column 31)- _lhsOcollectedInsts =- []- -- use rule "Transform.ag"(line 80, column 50)- _lhsOcollectedNames =- _setIcollectedNames- -- use rule "Transform.ag"(line 142, column 31)- _lhsOcollectedRules =- []- -- use rule "Transform.ag"(line 79, column 50)- _lhsOcollectedSetNames =- Set.empty- -- use rule "Transform.ag"(line 143, column 31)- _lhsOcollectedSigs =- []- -- use rule "Transform.ag"(line 145, column 31)- _lhsOcollectedUniques =- []- -- use rule "Transform.ag"(line 725, column 34)- _lhsOctxCollect =- Map.empty- -- use rule "Transform.ag"(line 40, column 19)- _lhsOerrors =- _setIerrors- -- use rule "Transform.ag"(line 902, column 37)- _lhsOmoduleDecl =- mzero- -- use rule "Transform.ag"(line 702, column 37)- _lhsOparamsCollect =- Map.empty- -- use rule "Transform.ag"(line 598, column 34)- _lhsOpragmas =- id- -- use rule "Transform.ag"(line 642, column 56)- _lhsOsemPragmasCollect =- Map.empty- -- use rule "Transform.ag"(line 458, column 32)- _lhsOtypeSyns =- []- -- use rule "Transform.ag"(line 131, column 15)- _lhsOuseMap =- Map.empty- -- use rule "Transform.ag"(line 589, 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 906, column 7)- _lhsOmoduleDecl =- Just (name_, exports_, imports_)- -- use rule "Transform.ag"(line 670, column 55)- _lhsOattrOrderCollect =- Map.empty- -- use rule "Transform.ag"(line 42, column 19)- _lhsOblocks =- Map.empty- -- use rule "Transform.ag"(line 88, column 48)- _lhsOcollectedConstructorsMap =- Map.empty- -- use rule "Transform.ag"(line 119, column 28)- _lhsOcollectedFields =- []- -- use rule "Transform.ag"(line 144, column 31)- _lhsOcollectedInsts =- []- -- use rule "Transform.ag"(line 80, column 50)- _lhsOcollectedNames =- Set.empty- -- use rule "Transform.ag"(line 142, column 31)- _lhsOcollectedRules =- []- -- use rule "Transform.ag"(line 79, column 50)- _lhsOcollectedSetNames =- Set.empty- -- use rule "Transform.ag"(line 143, column 31)- _lhsOcollectedSigs =- []- -- use rule "Transform.ag"(line 145, column 31)- _lhsOcollectedUniques =- []- -- use rule "Transform.ag"(line 725, column 34)- _lhsOctxCollect =- Map.empty- -- use rule "Transform.ag"(line 750, column 33)- _lhsOderivings =- Map.empty- -- use rule "Transform.ag"(line 40, column 19)- _lhsOerrors =- Seq.empty- -- use rule "Transform.ag"(line 702, column 37)- _lhsOparamsCollect =- Map.empty- -- use rule "Transform.ag"(line 598, column 34)- _lhsOpragmas =- id- -- use rule "Transform.ag"(line 642, column 56)- _lhsOsemPragmasCollect =- Map.empty- -- use rule "Transform.ag"(line 458, column 32)- _lhsOtypeSyns =- []- -- use rule "Transform.ag"(line 131, column 15)- _lhsOuseMap =- Map.empty- -- use rule "Transform.ag"(line 589, 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 601, 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 670, column 55)- _lhsOattrOrderCollect =- Map.empty- -- use rule "Transform.ag"(line 42, column 19)- _lhsOblocks =- Map.empty- -- use rule "Transform.ag"(line 88, column 48)- _lhsOcollectedConstructorsMap =- Map.empty- -- use rule "Transform.ag"(line 119, column 28)- _lhsOcollectedFields =- []- -- use rule "Transform.ag"(line 144, column 31)- _lhsOcollectedInsts =- []- -- use rule "Transform.ag"(line 80, column 50)- _lhsOcollectedNames =- Set.empty- -- use rule "Transform.ag"(line 142, column 31)- _lhsOcollectedRules =- []- -- use rule "Transform.ag"(line 79, column 50)- _lhsOcollectedSetNames =- Set.empty- -- use rule "Transform.ag"(line 143, column 31)- _lhsOcollectedSigs =- []- -- use rule "Transform.ag"(line 145, column 31)- _lhsOcollectedUniques =- []- -- use rule "Transform.ag"(line 725, column 34)- _lhsOctxCollect =- Map.empty- -- use rule "Transform.ag"(line 750, column 33)- _lhsOderivings =- Map.empty- -- use rule "Transform.ag"(line 40, column 19)- _lhsOerrors =- Seq.empty- -- use rule "Transform.ag"(line 902, column 37)- _lhsOmoduleDecl =- mzero- -- use rule "Transform.ag"(line 702, column 37)- _lhsOparamsCollect =- Map.empty- -- use rule "Transform.ag"(line 642, column 56)- _lhsOsemPragmasCollect =- Map.empty- -- use rule "Transform.ag"(line 458, column 32)- _lhsOtypeSyns =- []- -- use rule "Transform.ag"(line 131, column 15)- _lhsOuseMap =- Map.empty- -- use rule "Transform.ag"(line 589, 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 159, column 10)- _altsOnts =- _namesInontSet- -- "Transform.ag"(line 729, 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 670, column 55)- _lhsOattrOrderCollect =- _altsIattrOrderCollect- -- use rule "Transform.ag"(line 42, column 19)- _lhsOblocks =- Map.empty- -- use rule "Transform.ag"(line 88, column 48)- _lhsOcollectedConstructorsMap =- Map.empty- -- use rule "Transform.ag"(line 119, column 28)- _lhsOcollectedFields =- []- -- use rule "Transform.ag"(line 144, column 31)- _lhsOcollectedInsts =- _altsIcollectedInsts- -- use rule "Transform.ag"(line 80, column 50)- _lhsOcollectedNames =- _namesIcollectedNames- -- use rule "Transform.ag"(line 142, column 31)- _lhsOcollectedRules =- _altsIcollectedRules- -- use rule "Transform.ag"(line 79, column 50)- _lhsOcollectedSetNames =- Set.empty- -- use rule "Transform.ag"(line 143, column 31)- _lhsOcollectedSigs =- _altsIcollectedSigs- -- use rule "Transform.ag"(line 145, column 31)- _lhsOcollectedUniques =- _altsIcollectedUniques- -- use rule "Transform.ag"(line 750, column 33)- _lhsOderivings =- Map.empty- -- use rule "Transform.ag"(line 40, column 19)- _lhsOerrors =- _namesIerrors Seq.<> _attrsIerrors Seq.<> _altsIerrors- -- use rule "Transform.ag"(line 902, column 37)- _lhsOmoduleDecl =- mzero- -- use rule "Transform.ag"(line 702, column 37)- _lhsOparamsCollect =- Map.empty- -- use rule "Transform.ag"(line 598, column 34)- _lhsOpragmas =- id- -- use rule "Transform.ag"(line 642, column 56)- _lhsOsemPragmasCollect =- _altsIsemPragmasCollect- -- use rule "Transform.ag"(line 458, column 32)- _lhsOtypeSyns =- []- -- use rule "Transform.ag"(line 131, column 15)- _lhsOuseMap =- _attrsIuseMap- -- use rule "Transform.ag"(line 589, 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 414, column 10)- _lhsOcollectedSetNames =- Set.singleton name_- -- "Transform.ag"(line 521, column 13)- __tup3 =- let allUsedNames = Set.unions [ maybe (Set.singleton n)- snd- (Map.lookup n _lhsIdefSets)- | n <- Set.toList _setIcollectedNames- ]- (nontSet,e1) | Set.member name_ allUsedNames- = (Set.empty, Seq.single(CyclicSet name_))- | otherwise = (_setInontSet, Seq.empty)- (res, e2) = checkDuplicate DupSet name_ (nontSet,Set.insert name_ allUsedNames) _lhsIdefSets- in (res, e1 Seq.<> e2)- -- "Transform.ag"(line 521, column 13)- (_defSets2,_) =- __tup3- -- "Transform.ag"(line 521, column 13)- (_,_errs) =- __tup3- -- "Transform.ag"(line 531, column 9)- _lhsOdefSets =- _defSets2- -- "Transform.ag"(line 531, column 9)- _lhsOerrors =- _errs <> _setIerrors- -- use rule "Transform.ag"(line 670, column 55)- _lhsOattrOrderCollect =- Map.empty- -- use rule "Transform.ag"(line 42, column 19)- _lhsOblocks =- Map.empty- -- use rule "Transform.ag"(line 88, column 48)- _lhsOcollectedConstructorsMap =- Map.empty- -- use rule "Transform.ag"(line 119, column 28)- _lhsOcollectedFields =- []- -- use rule "Transform.ag"(line 144, column 31)- _lhsOcollectedInsts =- []- -- use rule "Transform.ag"(line 80, column 50)- _lhsOcollectedNames =- _setIcollectedNames- -- use rule "Transform.ag"(line 142, column 31)- _lhsOcollectedRules =- []- -- use rule "Transform.ag"(line 143, column 31)- _lhsOcollectedSigs =- []- -- use rule "Transform.ag"(line 145, column 31)- _lhsOcollectedUniques =- []- -- use rule "Transform.ag"(line 725, column 34)- _lhsOctxCollect =- Map.empty- -- use rule "Transform.ag"(line 750, column 33)- _lhsOderivings =- Map.empty- -- use rule "Transform.ag"(line 902, column 37)- _lhsOmoduleDecl =- mzero- -- use rule "Transform.ag"(line 702, column 37)- _lhsOparamsCollect =- Map.empty- -- use rule "Transform.ag"(line 598, column 34)- _lhsOpragmas =- id- -- use rule "Transform.ag"(line 642, column 56)- _lhsOsemPragmasCollect =- Map.empty- -- use rule "Transform.ag"(line 458, column 32)- _lhsOtypeSyns =- []- -- use rule "Transform.ag"(line 131, column 15)- _lhsOuseMap =- Map.empty- -- use rule "Transform.ag"(line 589, 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 168, 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 176, column 10)- _blockValue =- [(lines_, pos_)]- -- "Transform.ag"(line 177, column 10)- _lhsOblocks =- Map.singleton _blockInfo _blockValue- -- use rule "Transform.ag"(line 670, column 55)- _lhsOattrOrderCollect =- Map.empty- -- use rule "Transform.ag"(line 88, column 48)- _lhsOcollectedConstructorsMap =- Map.empty- -- use rule "Transform.ag"(line 119, column 28)- _lhsOcollectedFields =- []- -- use rule "Transform.ag"(line 144, column 31)- _lhsOcollectedInsts =- []- -- use rule "Transform.ag"(line 80, column 50)- _lhsOcollectedNames =- Set.empty- -- use rule "Transform.ag"(line 142, column 31)- _lhsOcollectedRules =- []- -- use rule "Transform.ag"(line 79, column 50)- _lhsOcollectedSetNames =- Set.empty- -- use rule "Transform.ag"(line 143, column 31)- _lhsOcollectedSigs =- []- -- use rule "Transform.ag"(line 145, column 31)- _lhsOcollectedUniques =- []- -- use rule "Transform.ag"(line 725, column 34)- _lhsOctxCollect =- Map.empty- -- use rule "Transform.ag"(line 750, column 33)- _lhsOderivings =- Map.empty- -- use rule "Transform.ag"(line 40, column 19)- _lhsOerrors =- Seq.empty- -- use rule "Transform.ag"(line 902, column 37)- _lhsOmoduleDecl =- mzero- -- use rule "Transform.ag"(line 702, column 37)- _lhsOparamsCollect =- Map.empty- -- use rule "Transform.ag"(line 598, column 34)- _lhsOpragmas =- id- -- use rule "Transform.ag"(line 642, column 56)- _lhsOsemPragmasCollect =- Map.empty- -- use rule "Transform.ag"(line 458, column 32)- _lhsOtypeSyns =- []- -- use rule "Transform.ag"(line 131, column 15)- _lhsOuseMap =- Map.empty- -- use rule "Transform.ag"(line 589, 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 230, column 10)- _lhsOcollectedFields =- map (\(x,y)->(name_, x, y)) _expanded- -- "Transform.ag"(line 417, column 11)- _lhsOcollectedNames =- Set.singleton name_- -- "Transform.ag"(line 471, 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 500, 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 507, column 11)- _lhsOtypeSyns =- [(name_,_argType)]- -- "Transform.ag"(line 712, column 7)- _lhsOparamsCollect =- if null params_- then Map.empty- else Map.singleton name_ params_- -- "Transform.ag"(line 735, column 7)- _lhsOctxCollect =- if null ctx_- then Map.empty- else Map.singleton name_ ctx_- -- use rule "Transform.ag"(line 670, column 55)- _lhsOattrOrderCollect =- Map.empty- -- use rule "Transform.ag"(line 42, column 19)- _lhsOblocks =- Map.empty- -- use rule "Transform.ag"(line 88, column 48)- _lhsOcollectedConstructorsMap =- Map.empty- -- use rule "Transform.ag"(line 144, column 31)- _lhsOcollectedInsts =- []- -- use rule "Transform.ag"(line 142, column 31)- _lhsOcollectedRules =- []- -- use rule "Transform.ag"(line 79, column 50)- _lhsOcollectedSetNames =- Set.empty- -- use rule "Transform.ag"(line 143, column 31)- _lhsOcollectedSigs =- []- -- use rule "Transform.ag"(line 145, column 31)- _lhsOcollectedUniques =- []- -- use rule "Transform.ag"(line 750, column 33)- _lhsOderivings =- Map.empty- -- use rule "Transform.ag"(line 40, column 19)- _lhsOerrors =- Seq.empty- -- use rule "Transform.ag"(line 902, column 37)- _lhsOmoduleDecl =- mzero- -- use rule "Transform.ag"(line 598, column 34)- _lhsOpragmas =- id- -- use rule "Transform.ag"(line 642, column 56)- _lhsOsemPragmasCollect =- Map.empty- -- use rule "Transform.ag"(line 131, column 15)- _lhsOuseMap =- Map.empty- -- use rule "Transform.ag"(line 589, 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 592, column 13)- _lhsOwrappers =- _setInontSet- -- use rule "Transform.ag"(line 670, column 55)- _lhsOattrOrderCollect =- Map.empty- -- use rule "Transform.ag"(line 42, column 19)- _lhsOblocks =- Map.empty- -- use rule "Transform.ag"(line 88, column 48)- _lhsOcollectedConstructorsMap =- Map.empty- -- use rule "Transform.ag"(line 119, column 28)- _lhsOcollectedFields =- []- -- use rule "Transform.ag"(line 144, column 31)- _lhsOcollectedInsts =- []- -- use rule "Transform.ag"(line 80, column 50)- _lhsOcollectedNames =- _setIcollectedNames- -- use rule "Transform.ag"(line 142, column 31)- _lhsOcollectedRules =- []- -- use rule "Transform.ag"(line 79, column 50)- _lhsOcollectedSetNames =- Set.empty- -- use rule "Transform.ag"(line 143, column 31)- _lhsOcollectedSigs =- []- -- use rule "Transform.ag"(line 145, column 31)- _lhsOcollectedUniques =- []- -- use rule "Transform.ag"(line 725, column 34)- _lhsOctxCollect =- Map.empty- -- use rule "Transform.ag"(line 750, column 33)- _lhsOderivings =- Map.empty- -- use rule "Transform.ag"(line 40, column 19)- _lhsOerrors =- _setIerrors- -- use rule "Transform.ag"(line 902, column 37)- _lhsOmoduleDecl =- mzero- -- use rule "Transform.ag"(line 702, column 37)- _lhsOparamsCollect =- Map.empty- -- use rule "Transform.ag"(line 598, column 34)- _lhsOpragmas =- id- -- use rule "Transform.ag"(line 642, column 56)- _lhsOsemPragmasCollect =- Map.empty- -- use rule "Transform.ag"(line 458, column 32)- _lhsOtypeSyns =- []- -- use rule "Transform.ag"(line 131, 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 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 670, column 55)- _lhsOattrOrderCollect =- _hdIattrOrderCollect `orderMapUnion` _tlIattrOrderCollect- -- use rule "Transform.ag"(line 42, column 19)- _lhsOblocks =- _hdIblocks `mapUnionWithPlusPlus` _tlIblocks- -- use rule "Transform.ag"(line 88, column 48)- _lhsOcollectedConstructorsMap =- _hdIcollectedConstructorsMap `mapUnionWithSetUnion` _tlIcollectedConstructorsMap- -- use rule "Transform.ag"(line 119, column 28)- _lhsOcollectedFields =- _hdIcollectedFields ++ _tlIcollectedFields- -- use rule "Transform.ag"(line 144, column 31)- _lhsOcollectedInsts =- _hdIcollectedInsts ++ _tlIcollectedInsts- -- use rule "Transform.ag"(line 80, column 50)- _lhsOcollectedNames =- _hdIcollectedNames `Set.union` _tlIcollectedNames- -- use rule "Transform.ag"(line 142, column 31)- _lhsOcollectedRules =- _hdIcollectedRules ++ _tlIcollectedRules- -- use rule "Transform.ag"(line 79, column 50)- _lhsOcollectedSetNames =- _hdIcollectedSetNames `Set.union` _tlIcollectedSetNames- -- use rule "Transform.ag"(line 143, column 31)- _lhsOcollectedSigs =- _hdIcollectedSigs ++ _tlIcollectedSigs- -- use rule "Transform.ag"(line 145, column 31)- _lhsOcollectedUniques =- _hdIcollectedUniques ++ _tlIcollectedUniques- -- use rule "Transform.ag"(line 725, column 34)- _lhsOctxCollect =- _hdIctxCollect `mergeCtx` _tlIctxCollect- -- use rule "Transform.ag"(line 750, column 33)- _lhsOderivings =- _hdIderivings `mergeDerivings` _tlIderivings- -- use rule "Transform.ag"(line 40, column 19)- _lhsOerrors =- _hdIerrors Seq.<> _tlIerrors- -- use rule "Transform.ag"(line 902, column 37)- _lhsOmoduleDecl =- _hdImoduleDecl `mplus` _tlImoduleDecl- -- use rule "Transform.ag"(line 702, column 37)- _lhsOparamsCollect =- _hdIparamsCollect `mergeParams` _tlIparamsCollect- -- use rule "Transform.ag"(line 598, column 34)- _lhsOpragmas =- _hdIpragmas . _tlIpragmas- -- use rule "Transform.ag"(line 642, column 56)- _lhsOsemPragmasCollect =- _hdIsemPragmasCollect `pragmaMapUnion` _tlIsemPragmasCollect- -- use rule "Transform.ag"(line 458, column 32)- _lhsOtypeSyns =- _hdItypeSyns ++ _tlItypeSyns- -- use rule "Transform.ag"(line 131, column 15)- _lhsOuseMap =- _hdIuseMap `merge` _tlIuseMap- -- use rule "Transform.ag"(line 589, 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 670, column 55)- _lhsOattrOrderCollect =- Map.empty- -- use rule "Transform.ag"(line 42, column 19)- _lhsOblocks =- Map.empty- -- use rule "Transform.ag"(line 88, column 48)- _lhsOcollectedConstructorsMap =- Map.empty- -- use rule "Transform.ag"(line 119, column 28)- _lhsOcollectedFields =- []- -- use rule "Transform.ag"(line 144, column 31)- _lhsOcollectedInsts =- []- -- use rule "Transform.ag"(line 80, column 50)- _lhsOcollectedNames =- Set.empty- -- use rule "Transform.ag"(line 142, column 31)- _lhsOcollectedRules =- []- -- use rule "Transform.ag"(line 79, column 50)- _lhsOcollectedSetNames =- Set.empty- -- use rule "Transform.ag"(line 143, column 31)- _lhsOcollectedSigs =- []- -- use rule "Transform.ag"(line 145, column 31)- _lhsOcollectedUniques =- []- -- use rule "Transform.ag"(line 725, column 34)- _lhsOctxCollect =- Map.empty- -- use rule "Transform.ag"(line 750, column 33)- _lhsOderivings =- Map.empty- -- use rule "Transform.ag"(line 40, column 19)- _lhsOerrors =- Seq.empty- -- use rule "Transform.ag"(line 902, column 37)- _lhsOmoduleDecl =- mzero- -- use rule "Transform.ag"(line 702, column 37)- _lhsOparamsCollect =- Map.empty- -- use rule "Transform.ag"(line 598, column 34)- _lhsOpragmas =- id- -- use rule "Transform.ag"(line 642, column 56)- _lhsOsemPragmasCollect =- Map.empty- -- use rule "Transform.ag"(line 458, column 32)- _lhsOtypeSyns =- []- -- use rule "Transform.ag"(line 131, column 15)- _lhsOuseMap =- Map.empty- -- use rule "Transform.ag"(line 589, 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 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 535, column 16)- _lhsOnontSet =- _lhsIallNonterminals- -- use rule "Transform.ag"(line 80, column 50)- _lhsOcollectedNames =- Set.empty- -- use rule "Transform.ag"(line 40, 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 541, column 16)- _lhsOnontSet =- Set.difference _set1InontSet _set2InontSet- -- use rule "Transform.ag"(line 80, column 50)- _lhsOcollectedNames =- _set1IcollectedNames `Set.union` _set2IcollectedNames- -- use rule "Transform.ag"(line 40, 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 540, column 16)- _lhsOnontSet =- Set.intersection _set1InontSet _set2InontSet- -- use rule "Transform.ag"(line 80, column 50)- _lhsOcollectedNames =- _set1IcollectedNames `Set.union` _set2IcollectedNames- -- use rule "Transform.ag"(line 40, 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 420, column 14)- _lhsOcollectedNames =- Set.singleton name_- -- "Transform.ag"(line 536, column 20)- __tup4 =- case Map.lookup name_ _lhsIdefinedSets of- Nothing -> (Set.empty, Seq.single (UndefNont name_))- Just set -> (set, Seq.empty)- -- "Transform.ag"(line 536, column 20)- (_nontSet,_) =- __tup4- -- "Transform.ag"(line 536, column 20)- (_,_errors) =- __tup4- -- use rule "Transform.ag"(line 40, 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 542, column 16)- _lhsOnontSet =- let table = flattenDatas _lhsIallFields- in path table from_ to_- -- "Transform.ag"(line 544, column 16)- _lhsOerrors =- let check name | Set.member name _lhsIallNonterminals- = Seq.empty- | otherwise = Seq.single (UndefNont name)- in check from_ <> check to_- -- use rule "Transform.ag"(line 80, 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 539, column 16)- _lhsOnontSet =- Set.union _set1InontSet _set2InontSet- -- use rule "Transform.ag"(line 80, column 50)- _lhsOcollectedNames =- _set1IcollectedNames `Set.union` _set2IcollectedNames- -- use rule "Transform.ag"(line 40, column 19)- _lhsOerrors =- _set1Ierrors Seq.<> _set2Ierrors- -- copy rule (down)- _set1OallFields =- _lhsIallFields- -- copy rule (down)- _set1OallNonterminals =- _lhsIallNonterminals- -- copy rule (down)- _set1OdefinedSets =- _lhsIdefinedSets- -- copy rule (down)- _set2OallFields =- _lhsIallFields- -- copy rule (down)- _set2OallNonterminals =- _lhsIallNonterminals- -- copy rule (down)- _set2OdefinedSets =- _lhsIdefinedSets- ( _set1IcollectedNames,_set1Ierrors,_set1InontSet) =- (set1_ _set1OallFields _set1OallNonterminals _set1OdefinedSets)- ( _set2IcollectedNames,_set2Ierrors,_set2InontSet) =- (set2_ _set2OallFields _set2OallNonterminals _set2OdefinedSets)- in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet))))--- Pattern ------------------------------------------------------{-- visit 0:- synthesized attributes:- copy : SELF- definedAttrs : [AttrName]- definedInsts : [Identifier]- patunder : [AttrName]->Pattern- stpos : Pos- alternatives:- alternative Alias:- child field : {Identifier}- child attr : {Identifier}- child pat : Pattern- child parts : Patterns- visit 0:- local copy : _- alternative Constr:- child name : {ConstructorIdent}- child pats : Patterns- visit 0:- local copy : _- alternative Irrefutable:- child pat : Pattern- visit 0:- local copy : _- alternative Product:- child pos : {Pos}- child pats : Patterns- visit 0:- local copy : _- alternative Underscore:- child pos : {Pos}- visit 0:- local copy : _--}--- cata-sem_Pattern :: Pattern ->- T_Pattern-sem_Pattern (Alias _field _attr _pat _parts) =- (sem_Pattern_Alias _field _attr (sem_Pattern _pat) (sem_Patterns _parts))-sem_Pattern (Constr _name _pats) =- (sem_Pattern_Constr _name (sem_Patterns _pats))-sem_Pattern (Irrefutable _pat) =- (sem_Pattern_Irrefutable (sem_Pattern _pat))-sem_Pattern (Product _pos _pats) =- (sem_Pattern_Product _pos (sem_Patterns _pats))-sem_Pattern (Underscore _pos) =- (sem_Pattern_Underscore _pos)--- semantic domain-newtype T_Pattern = T_Pattern (( Pattern,([AttrName]),([Identifier]),([AttrName]->Pattern),Pos))-data Inh_Pattern = Inh_Pattern {}-data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: !(Pattern),definedAttrs_Syn_Pattern :: !([AttrName]),definedInsts_Syn_Pattern :: !([Identifier]),patunder_Syn_Pattern :: !([AttrName]->Pattern),stpos_Syn_Pattern :: !(Pos)}-wrap_Pattern (T_Pattern sem) (Inh_Pattern ) =- (let ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos) =- (sem )- in (Syn_Pattern _lhsOcopy _lhsOdefinedAttrs _lhsOdefinedInsts _lhsOpatunder _lhsOstpos))-sem_Pattern_Alias :: Identifier ->- Identifier ->- T_Pattern ->- T_Patterns ->- T_Pattern-sem_Pattern_Alias field_ attr_ (T_Pattern pat_) (T_Patterns parts_) =- (T_Pattern (let _lhsOdefinedAttrs :: ([AttrName])- _lhsOpatunder :: ([AttrName]->Pattern)- _lhsOdefinedInsts :: ([Identifier])- _lhsOstpos :: Pos- _lhsOcopy :: Pattern- _patIcopy :: Pattern- _patIdefinedAttrs :: ([AttrName])- _patIdefinedInsts :: ([Identifier])- _patIpatunder :: ([AttrName]->Pattern)- _patIstpos :: Pos- _partsIcopy :: Patterns- _partsIdefinedAttrs :: ([AttrName])- _partsIdefinedInsts :: ([Identifier])- _partsIpatunder :: ([AttrName]->Patterns)- -- "Transform.ag"(line 878, column 11)- _lhsOdefinedAttrs =- (field_, attr_) : _patIdefinedAttrs- -- "Transform.ag"(line 879, column 11)- _lhsOpatunder =- \us -> if ((field_,attr_) `elem` us) then Underscore noPos else _copy- -- "Transform.ag"(line 880, column 11)- _lhsOdefinedInsts =- (if field_ == _INST then [attr_] else []) ++ _patIdefinedInsts- -- "Transform.ag"(line 895, 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 882, column 12)- _lhsOpatunder =- \us -> Constr name_ (_patsIpatunder us)- -- "Transform.ag"(line 893, column 16)- _lhsOstpos =- getPos name_- -- use rule "Transform.ag"(line 873, column 42)- _lhsOdefinedAttrs =- _patsIdefinedAttrs- -- use rule "Transform.ag"(line 872, 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 884, column 17)- _lhsOpatunder =- \us -> Irrefutable (_patIpatunder us)- -- use rule "Transform.ag"(line 873, column 42)- _lhsOdefinedAttrs =- _patIdefinedAttrs- -- use rule "Transform.ag"(line 872, 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 883, column 13)- _lhsOpatunder =- \us -> Product pos_ (_patsIpatunder us)- -- "Transform.ag"(line 894, column 16)- _lhsOstpos =- pos_- -- use rule "Transform.ag"(line 873, column 42)- _lhsOdefinedAttrs =- _patsIdefinedAttrs- -- use rule "Transform.ag"(line 872, 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 881, column 16)- _lhsOpatunder =- \us -> _copy- -- "Transform.ag"(line 896, column 16)- _lhsOstpos =- pos_- -- use rule "Transform.ag"(line 873, column 42)- _lhsOdefinedAttrs =- []- -- use rule "Transform.ag"(line 872, column 55)- _lhsOdefinedInsts =- []- -- self rule- _copy =- Underscore pos_- -- self rule- _lhsOcopy =- _copy- in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos)))--- Patterns -----------------------------------------------------{-- visit 0:- synthesized attributes:- copy : SELF- definedAttrs : [AttrName]- definedInsts : [Identifier]- patunder : [AttrName]->Patterns- alternatives:- alternative Cons:- child hd : Pattern- child tl : Patterns- visit 0:- local copy : _- alternative Nil:- visit 0:- local copy : _--}--- cata-sem_Patterns :: Patterns ->- T_Patterns-sem_Patterns list =- (Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list))--- semantic domain-newtype T_Patterns = T_Patterns (( Patterns,([AttrName]),([Identifier]),([AttrName]->Patterns)))-data Inh_Patterns = Inh_Patterns {}-data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: !(Patterns),definedAttrs_Syn_Patterns :: !([AttrName]),definedInsts_Syn_Patterns :: !([Identifier]),patunder_Syn_Patterns :: !([AttrName]->Patterns)}-wrap_Patterns (T_Patterns sem) (Inh_Patterns ) =- (let ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder) =- (sem )- in (Syn_Patterns _lhsOcopy _lhsOdefinedAttrs _lhsOdefinedInsts _lhsOpatunder))-sem_Patterns_Cons :: T_Pattern ->- T_Patterns ->- T_Patterns-sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) =- (T_Patterns (let _lhsOpatunder :: ([AttrName]->Patterns)- _lhsOdefinedAttrs :: ([AttrName])- _lhsOdefinedInsts :: ([Identifier])- _lhsOcopy :: Patterns- _hdIcopy :: Pattern- _hdIdefinedAttrs :: ([AttrName])- _hdIdefinedInsts :: ([Identifier])- _hdIpatunder :: ([AttrName]->Pattern)- _hdIstpos :: Pos- _tlIcopy :: Patterns- _tlIdefinedAttrs :: ([AttrName])- _tlIdefinedInsts :: ([Identifier])- _tlIpatunder :: ([AttrName]->Patterns)- -- "Transform.ag"(line 888, column 10)- _lhsOpatunder =- \us -> (_hdIpatunder us) : (_tlIpatunder us)- -- use rule "Transform.ag"(line 873, column 42)- _lhsOdefinedAttrs =- _hdIdefinedAttrs ++ _tlIdefinedAttrs- -- use rule "Transform.ag"(line 872, 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 887, column 9)- _lhsOpatunder =- \us -> []- -- use rule "Transform.ag"(line 873, column 42)- _lhsOdefinedAttrs =- []- -- use rule "Transform.ag"(line 872, 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 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 646, column 7)- _pragmaNames =- Set.fromList _rulesIpragmaNamesCollect- -- "Transform.ag"(line 647, column 7)- _lhsOsemPragmasCollect =- foldr pragmaMapUnion Map.empty [ pragmaMapSingle nt con _pragmaNames- | (nt, conset, _) <- _coninfo- , con <- Set.toList conset- ]- -- "Transform.ag"(line 675, column 7)- _attrOrders =- [ orderMapSingle nt con _rulesIorderDepsCollect- | (nt, conset, _) <- _coninfo- , con <- Set.toList conset- ]- -- "Transform.ag"(line 681, column 7)- _lhsOattrOrderCollect =- foldr orderMapUnion Map.empty _attrOrders- -- "Transform.ag"(line 824, 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 831, column 12)- _lhsOerrors =- Seq.fromList- [ UndefAlt nt con- | (nt, conset, conkeys) <- _coninfo- , con <- Set.toList (Set.difference conset conkeys)- ]- -- "Transform.ag"(line 836, column 12)- _lhsOcollectedRules =- [ (nt,con,r)- | (nt, conset, _) <- _coninfo- , con <- Set.toList conset- , r <- _rulesIruleInfos- ]- -- "Transform.ag"(line 842, column 12)- _lhsOcollectedSigs =- [ (nt,con,ts)- | (nt, conset, _) <- _coninfo- , con <- Set.toList conset- , ts <- _rulesIsigInfos- ]- -- "Transform.ag"(line 849, column 12)- _lhsOcollectedInsts =- [ (nt,con,_rulesIdefinedInsts)- | (nt, conset, _) <- _coninfo- , con <- Set.toList conset- ]- -- "Transform.ag"(line 855, 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 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 670, column 55)- _lhsOattrOrderCollect =- _hdIattrOrderCollect `orderMapUnion` _tlIattrOrderCollect- -- use rule "Transform.ag"(line 144, column 31)- _lhsOcollectedInsts =- _hdIcollectedInsts ++ _tlIcollectedInsts- -- use rule "Transform.ag"(line 142, column 31)- _lhsOcollectedRules =- _hdIcollectedRules ++ _tlIcollectedRules- -- use rule "Transform.ag"(line 143, column 31)- _lhsOcollectedSigs =- _hdIcollectedSigs ++ _tlIcollectedSigs- -- use rule "Transform.ag"(line 145, column 31)- _lhsOcollectedUniques =- _hdIcollectedUniques ++ _tlIcollectedUniques- -- use rule "Transform.ag"(line 40, column 19)- _lhsOerrors =- _hdIerrors Seq.<> _tlIerrors- -- use rule "Transform.ag"(line 642, 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 670, column 55)- _lhsOattrOrderCollect =- Map.empty- -- use rule "Transform.ag"(line 144, column 31)- _lhsOcollectedInsts =- []- -- use rule "Transform.ag"(line 142, column 31)- _lhsOcollectedRules =- []- -- use rule "Transform.ag"(line 143, column 31)- _lhsOcollectedSigs =- []- -- use rule "Transform.ag"(line 145, column 31)- _lhsOcollectedUniques =- []- -- use rule "Transform.ag"(line 40, column 19)- _lhsOerrors =- Seq.empty- -- use rule "Transform.ag"(line 642, 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 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 687, column 7)- _dependency =- [ Dependency b a | b <- before_, a <- after_ ]- -- "Transform.ag"(line 688, column 7)- _lhsOorderDepsCollect =- Set.fromList _dependency- -- use rule "Transform.ag"(line 872, column 55)- _lhsOdefinedInsts =- []- -- use rule "Transform.ag"(line 652, column 46)- _lhsOpragmaNamesCollect =- []- -- use rule "Transform.ag"(line 817, column 39)- _lhsOruleInfos =- []- -- use rule "Transform.ag"(line 818, column 39)- _lhsOsigInfos =- []- -- use rule "Transform.ag"(line 819, 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 863, column 10)- _lhsOruleInfos =- [ (_patternIpatunder, rhs_, _patternIdefinedAttrs, owrt_, show _patternIstpos) ]- -- use rule "Transform.ag"(line 872, column 55)- _lhsOdefinedInsts =- _patternIdefinedInsts- -- use rule "Transform.ag"(line 683, column 44)- _lhsOorderDepsCollect =- Set.empty- -- use rule "Transform.ag"(line 652, column 46)- _lhsOpragmaNamesCollect =- []- -- use rule "Transform.ag"(line 818, column 39)- _lhsOsigInfos =- []- -- use rule "Transform.ag"(line 819, 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 656, column 7)- _lhsOpragmaNamesCollect =- names_- -- use rule "Transform.ag"(line 872, column 55)- _lhsOdefinedInsts =- []- -- use rule "Transform.ag"(line 683, column 44)- _lhsOorderDepsCollect =- Set.empty- -- use rule "Transform.ag"(line 817, column 39)- _lhsOruleInfos =- []- -- use rule "Transform.ag"(line 818, column 39)- _lhsOsigInfos =- []- -- use rule "Transform.ag"(line 819, 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 866, column 14)- _lhsOsigInfos =- [ (ident_, tp_) ]- -- use rule "Transform.ag"(line 872, column 55)- _lhsOdefinedInsts =- []- -- use rule "Transform.ag"(line 683, column 44)- _lhsOorderDepsCollect =- Set.empty- -- use rule "Transform.ag"(line 652, column 46)- _lhsOpragmaNamesCollect =- []- -- use rule "Transform.ag"(line 817, column 39)- _lhsOruleInfos =- []- -- use rule "Transform.ag"(line 819, 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 869, column 16)- _lhsOuniqueInfos =- [ (ident_, ref_) ]- -- use rule "Transform.ag"(line 872, column 55)- _lhsOdefinedInsts =- []- -- use rule "Transform.ag"(line 683, column 44)- _lhsOorderDepsCollect =- Set.empty- -- use rule "Transform.ag"(line 652, column 46)- _lhsOpragmaNamesCollect =- []- -- use rule "Transform.ag"(line 817, column 39)- _lhsOruleInfos =- []- -- use rule "Transform.ag"(line 818, 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 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 872, column 55)- _lhsOdefinedInsts =- _hdIdefinedInsts ++ _tlIdefinedInsts- -- use rule "Transform.ag"(line 683, column 44)- _lhsOorderDepsCollect =- _hdIorderDepsCollect `Set.union` _tlIorderDepsCollect- -- use rule "Transform.ag"(line 652, column 46)- _lhsOpragmaNamesCollect =- _hdIpragmaNamesCollect ++ _tlIpragmaNamesCollect- -- use rule "Transform.ag"(line 817, column 39)- _lhsOruleInfos =- _hdIruleInfos ++ _tlIruleInfos- -- use rule "Transform.ag"(line 818, column 39)- _lhsOsigInfos =- _hdIsigInfos ++ _tlIsigInfos- -- use rule "Transform.ag"(line 819, 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 872, column 55)- _lhsOdefinedInsts =- []- -- use rule "Transform.ag"(line 683, column 44)- _lhsOorderDepsCollect =- Set.empty- -- use rule "Transform.ag"(line 652, column 46)- _lhsOpragmaNamesCollect =- []- -- use rule "Transform.ag"(line 817, column 39)- _lhsOruleInfos =- []- -- use rule "Transform.ag"(line 818, column 39)- _lhsOsigInfos =- []- -- use rule "Transform.ag"(line 819, column 39)- _lhsOuniqueInfos =- []- in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos)))+ + +-- UUAGC 0.9.10 (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,651 +1,692 @@--- UUAGC 0.9.5 (Visage.ag)-module Visage where--import UU.Scanner.Position(Pos(..))-import CommonTypes-import ATermAbstractSyntax-import Expression-import VisagePatterns-import VisageSyntax-import qualified Data.Map as Map-import Data.Map(Map)-import Data.List(intersperse)-import TokenDef--import CommonTypes-import UU.Pretty-import AbstractSyntax-import VisagePatterns-import Expression--import UU.Scanner.Position(Pos)-import CommonTypes--import UU.Scanner.Position(Pos)-import HsToken--convert :: String -> String-convert [] = []-convert (c:ct) | c == '\n' = '\\' : 'n' : convert ct- | otherwise = c : convert ct- -sQ :: String -> String-sQ [] = []-sQ (x:xs) = if (x=='"') then rest else x:rest- where- rest = if not (null xs) && last xs == '"' then init xs else xs--showAGPos :: Pos -> String-showAGPos (Pos l c f) | l == (-1) = ""- | otherwise = let file = if null f then "" else f -- No show of f- lc = "(line " ++ show l ++ ", column " ++ show c ++")"- in file ++ lc--showMap :: (Show a, Show b) => Map a b -> String-showMap- = braces . concat . intersperse "," . map (uncurry assign) . Map.assocs- where- braces s = "{" ++ s ++ "}"- assign a b = show a ++ ":=" ++ show b--- Expression ---------------------------------------------------{-- visit 0:- synthesized attribute:- aterm : ATerm- alternatives:- alternative Expression:- child pos : {Pos}- child tks : {[HsToken]}--}--- cata-sem_Expression :: Expression ->- T_Expression-sem_Expression (Expression _pos _tks) =- (sem_Expression_Expression _pos _tks)--- semantic domain-newtype T_Expression = T_Expression (( ATerm))-data Inh_Expression = Inh_Expression {}-data Syn_Expression = Syn_Expression {aterm_Syn_Expression :: ATerm}-wrap_Expression (T_Expression sem) (Inh_Expression ) =- (let ( _lhsOaterm) =- (sem )- in (Syn_Expression _lhsOaterm))-sem_Expression_Expression :: Pos ->- ([HsToken]) ->- T_Expression-sem_Expression_Expression pos_ tks_ =- (T_Expression (let _lhsOaterm :: ATerm- -- "Visage.ag"(line 103, column 17)- _lhsOaterm =- AAppl "Expression" [AString (sQ (showAGPos pos_)), AString (sQ (unlines . showTokens . tokensToStrings $ tks_))]- in ( _lhsOaterm)))--- VisageChild --------------------------------------------------{-- visit 0:- synthesized attribute:- aterm : ATerm- alternatives:- alternative VChild:- child name : {Identifier}- child tp : {Type}- child inh : {Attributes}- child syn : {Attributes}- child rules : VisageRules--}--- cata-sem_VisageChild :: VisageChild ->- T_VisageChild-sem_VisageChild (VChild _name _tp _inh _syn _rules) =- (sem_VisageChild_VChild _name _tp _inh _syn (sem_VisageRules _rules))--- semantic domain-newtype T_VisageChild = T_VisageChild (( ATerm))-data Inh_VisageChild = Inh_VisageChild {}-data Syn_VisageChild = Syn_VisageChild {aterm_Syn_VisageChild :: ATerm}-wrap_VisageChild (T_VisageChild sem) (Inh_VisageChild ) =- (let ( _lhsOaterm) =- (sem )- in (Syn_VisageChild _lhsOaterm))-sem_VisageChild_VChild :: Identifier ->- Type ->- Attributes ->- Attributes ->- T_VisageRules ->- T_VisageChild-sem_VisageChild_VChild name_ tp_ inh_ syn_ (T_VisageRules rules_) =- (T_VisageChild (let _lhsOaterm :: ATerm- _rulesOisLoc :: Bool- _rulesIaterms :: ([ATerm])- -- "Visage.ag"(line 85, column 18)- _lhsOaterm =- AAppl "Child" [AString (sQ (getName name_)), AString (sQ (show tp_)),- AString (sQ (showMap inh_)),- AString (sQ (showMap syn_)),- AAppl "Rules" _rulesIaterms]- -- "Visage.ag"(line 89, column 18)- _rulesOisLoc =- False- ( _rulesIaterms) =- (rules_ _rulesOisLoc)- in ( _lhsOaterm)))--- VisageChildren -----------------------------------------------{-- visit 0:- synthesized attribute:- aterms : [ATerm]- alternatives:- alternative Cons:- child hd : VisageChild- child tl : VisageChildren- alternative Nil:--}--- cata-sem_VisageChildren :: VisageChildren ->- T_VisageChildren-sem_VisageChildren list =- (Prelude.foldr sem_VisageChildren_Cons sem_VisageChildren_Nil (Prelude.map sem_VisageChild list))--- semantic domain-newtype T_VisageChildren = T_VisageChildren (( ([ATerm])))-data Inh_VisageChildren = Inh_VisageChildren {}-data Syn_VisageChildren = Syn_VisageChildren {aterms_Syn_VisageChildren :: [ATerm]}-wrap_VisageChildren (T_VisageChildren sem) (Inh_VisageChildren ) =- (let ( _lhsOaterms) =- (sem )- in (Syn_VisageChildren _lhsOaterms))-sem_VisageChildren_Cons :: T_VisageChild ->- T_VisageChildren ->- T_VisageChildren-sem_VisageChildren_Cons (T_VisageChild hd_) (T_VisageChildren tl_) =- (T_VisageChildren (let _lhsOaterms :: ([ATerm])- _hdIaterm :: ATerm- _tlIaterms :: ([ATerm])- -- "Visage.ag"(line 80, column 17)- _lhsOaterms =- _hdIaterm : _tlIaterms- ( _hdIaterm) =- (hd_ )- ( _tlIaterms) =- (tl_ )- in ( _lhsOaterms)))-sem_VisageChildren_Nil :: T_VisageChildren-sem_VisageChildren_Nil =- (T_VisageChildren (let _lhsOaterms :: ([ATerm])- -- "Visage.ag"(line 81, column 17)- _lhsOaterms =- []- in ( _lhsOaterms)))--- VisageGrammar ------------------------------------------------{-- visit 0:- synthesized attribute:- aterm : ATerm- alternatives:- alternative VGrammar:- child nonts : VisageNonterminals--}--- cata-sem_VisageGrammar :: VisageGrammar ->- T_VisageGrammar-sem_VisageGrammar (VGrammar _nonts) =- (sem_VisageGrammar_VGrammar (sem_VisageNonterminals _nonts))--- semantic domain-newtype T_VisageGrammar = T_VisageGrammar (( ATerm))-data Inh_VisageGrammar = Inh_VisageGrammar {}-data Syn_VisageGrammar = Syn_VisageGrammar {aterm_Syn_VisageGrammar :: ATerm}-wrap_VisageGrammar (T_VisageGrammar sem) (Inh_VisageGrammar ) =- (let ( _lhsOaterm) =- (sem )- in (Syn_VisageGrammar _lhsOaterm))-sem_VisageGrammar_VGrammar :: T_VisageNonterminals ->- T_VisageGrammar-sem_VisageGrammar_VGrammar (T_VisageNonterminals nonts_) =- (T_VisageGrammar (let _lhsOaterm :: ATerm- _nontsIaterms :: ([ATerm])- -- "Visage.ag"(line 54, column 18)- _lhsOaterm =- AAppl "Productions" _nontsIaterms- ( _nontsIaterms) =- (nonts_ )- in ( _lhsOaterm)))--- VisageNonterminal --------------------------------------------{-- visit 0:- synthesized attribute:- aterm : ATerm- alternatives:- alternative VNonterminal:- child nt : {NontermIdent}- child inh : {Attributes}- child syn : {Attributes}- child alts : VisageProductions--}--- cata-sem_VisageNonterminal :: VisageNonterminal ->- T_VisageNonterminal-sem_VisageNonterminal (VNonterminal _nt _inh _syn _alts) =- (sem_VisageNonterminal_VNonterminal _nt _inh _syn (sem_VisageProductions _alts))--- semantic domain-newtype T_VisageNonterminal = T_VisageNonterminal (( ATerm))-data Inh_VisageNonterminal = Inh_VisageNonterminal {}-data Syn_VisageNonterminal = Syn_VisageNonterminal {aterm_Syn_VisageNonterminal :: ATerm}-wrap_VisageNonterminal (T_VisageNonterminal sem) (Inh_VisageNonterminal ) =- (let ( _lhsOaterm) =- (sem )- in (Syn_VisageNonterminal _lhsOaterm))-sem_VisageNonterminal_VNonterminal :: NontermIdent ->- Attributes ->- Attributes ->- T_VisageProductions ->- T_VisageNonterminal-sem_VisageNonterminal_VNonterminal nt_ inh_ syn_ (T_VisageProductions alts_) =- (T_VisageNonterminal (let _lhsOaterm :: ATerm- _altsIaterms :: ([ATerm])- -- "Visage.ag"(line 63, column 19)- _lhsOaterm =- AAppl "Production" [AString (sQ (getName nt_)), AString (sQ(showMap inh_)),- AString (sQ(showMap syn_)), AAppl "Alternatives" _altsIaterms]- ( _altsIaterms) =- (alts_ )- in ( _lhsOaterm)))--- VisageNonterminals -------------------------------------------{-- visit 0:- synthesized attribute:- aterms : [ATerm]- alternatives:- alternative Cons:- child hd : VisageNonterminal- child tl : VisageNonterminals- alternative Nil:--}--- cata-sem_VisageNonterminals :: VisageNonterminals ->- T_VisageNonterminals-sem_VisageNonterminals list =- (Prelude.foldr sem_VisageNonterminals_Cons sem_VisageNonterminals_Nil (Prelude.map sem_VisageNonterminal list))--- semantic domain-newtype T_VisageNonterminals = T_VisageNonterminals (( ([ATerm])))-data Inh_VisageNonterminals = Inh_VisageNonterminals {}-data Syn_VisageNonterminals = Syn_VisageNonterminals {aterms_Syn_VisageNonterminals :: [ATerm]}-wrap_VisageNonterminals (T_VisageNonterminals sem) (Inh_VisageNonterminals ) =- (let ( _lhsOaterms) =- (sem )- in (Syn_VisageNonterminals _lhsOaterms))-sem_VisageNonterminals_Cons :: T_VisageNonterminal ->- T_VisageNonterminals ->- T_VisageNonterminals-sem_VisageNonterminals_Cons (T_VisageNonterminal hd_) (T_VisageNonterminals tl_) =- (T_VisageNonterminals (let _lhsOaterms :: ([ATerm])- _hdIaterm :: ATerm- _tlIaterms :: ([ATerm])- -- "Visage.ag"(line 58, column 17)- _lhsOaterms =- _hdIaterm : _tlIaterms- ( _hdIaterm) =- (hd_ )- ( _tlIaterms) =- (tl_ )- in ( _lhsOaterms)))-sem_VisageNonterminals_Nil :: T_VisageNonterminals-sem_VisageNonterminals_Nil =- (T_VisageNonterminals (let _lhsOaterms :: ([ATerm])- -- "Visage.ag"(line 59, column 17)- _lhsOaterms =- []- in ( _lhsOaterms)))--- VisagePattern ------------------------------------------------{-- visit 0:- synthesized attribute:- aterm : ATerm- alternatives:- alternative VAlias:- child field : {Identifier}- child attr : {Identifier}- child pat : VisagePattern- alternative VConstr:- child name : {ConstructorIdent}- child pats : VisagePatterns- alternative VProduct:- child pos : {Pos}- child pats : VisagePatterns- alternative VUnderscore:- child pos : {Pos}- alternative VVar:- child field : {Identifier}- child attr : {Identifier}--}--- cata-sem_VisagePattern :: VisagePattern ->- T_VisagePattern-sem_VisagePattern (VAlias _field _attr _pat) =- (sem_VisagePattern_VAlias _field _attr (sem_VisagePattern _pat))-sem_VisagePattern (VConstr _name _pats) =- (sem_VisagePattern_VConstr _name (sem_VisagePatterns _pats))-sem_VisagePattern (VProduct _pos _pats) =- (sem_VisagePattern_VProduct _pos (sem_VisagePatterns _pats))-sem_VisagePattern (VUnderscore _pos) =- (sem_VisagePattern_VUnderscore _pos)-sem_VisagePattern (VVar _field _attr) =- (sem_VisagePattern_VVar _field _attr)--- semantic domain-newtype T_VisagePattern = T_VisagePattern (( ATerm))-data Inh_VisagePattern = Inh_VisagePattern {}-data Syn_VisagePattern = Syn_VisagePattern {aterm_Syn_VisagePattern :: ATerm}-wrap_VisagePattern (T_VisagePattern sem) (Inh_VisagePattern ) =- (let ( _lhsOaterm) =- (sem )- in (Syn_VisagePattern _lhsOaterm))-sem_VisagePattern_VAlias :: Identifier ->- Identifier ->- T_VisagePattern ->- T_VisagePattern-sem_VisagePattern_VAlias field_ attr_ (T_VisagePattern pat_) =- (T_VisagePattern (let _lhsOaterm :: ATerm- _patIaterm :: ATerm- -- "Visage.ag"(line 119, column 18)- _lhsOaterm =- AAppl "Pattern" [AAppl "Alias" [AString (sQ (showAGPos (getPos field_))),- AString (sQ (getName field_ ++ "." ++ getName attr_)), _patIaterm]]- ( _patIaterm) =- (pat_ )- in ( _lhsOaterm)))-sem_VisagePattern_VConstr :: ConstructorIdent ->- T_VisagePatterns ->- T_VisagePattern-sem_VisagePattern_VConstr name_ (T_VisagePatterns pats_) =- (T_VisagePattern (let _lhsOaterm :: ATerm- _patsIaterms :: ([ATerm])- -- "Visage.ag"(line 112, column 18)- _lhsOaterm =- AAppl "Pattern" [AAppl "Constr" [AString (sQ (showAGPos (getPos name_))),- AString (sQ (getName name_)),- AAppl "Patterns" _patsIaterms]]- ( _patsIaterms) =- (pats_ )- in ( _lhsOaterm)))-sem_VisagePattern_VProduct :: Pos ->- T_VisagePatterns ->- T_VisagePattern-sem_VisagePattern_VProduct pos_ (T_VisagePatterns pats_) =- (T_VisagePattern (let _lhsOaterm :: ATerm- _patsIaterms :: ([ATerm])- -- "Visage.ag"(line 115, column 18)- _lhsOaterm =- AAppl "Pattern" [AAppl "Product" [AString (sQ (showAGPos pos_)),- AAppl "Patterns" _patsIaterms]]- ( _patsIaterms) =- (pats_ )- in ( _lhsOaterm)))-sem_VisagePattern_VUnderscore :: Pos ->- T_VisagePattern-sem_VisagePattern_VUnderscore pos_ =- (T_VisagePattern (let _lhsOaterm :: ATerm- -- "Visage.ag"(line 121, column 18)- _lhsOaterm =- AAppl "Pattern" [AAppl "Underscore" [AString (sQ (showAGPos pos_))]]- in ( _lhsOaterm)))-sem_VisagePattern_VVar :: Identifier ->- Identifier ->- T_VisagePattern-sem_VisagePattern_VVar field_ attr_ =- (T_VisagePattern (let _lhsOaterm :: ATerm- -- "Visage.ag"(line 117, column 18)- _lhsOaterm =- AAppl "Pattern" [AAppl "Var" [AString (sQ (showAGPos (getPos field_))),- AString (sQ (getName field_ ++ "." ++ getName attr_))]]- in ( _lhsOaterm)))--- VisagePatterns -----------------------------------------------{-- visit 0:- synthesized attribute:- aterms : [ATerm]- alternatives:- alternative Cons:- child hd : VisagePattern- child tl : VisagePatterns- alternative Nil:--}--- cata-sem_VisagePatterns :: VisagePatterns ->- T_VisagePatterns-sem_VisagePatterns list =- (Prelude.foldr sem_VisagePatterns_Cons sem_VisagePatterns_Nil (Prelude.map sem_VisagePattern list))--- semantic domain-newtype T_VisagePatterns = T_VisagePatterns (( ([ATerm])))-data Inh_VisagePatterns = Inh_VisagePatterns {}-data Syn_VisagePatterns = Syn_VisagePatterns {aterms_Syn_VisagePatterns :: [ATerm]}-wrap_VisagePatterns (T_VisagePatterns sem) (Inh_VisagePatterns ) =- (let ( _lhsOaterms) =- (sem )- in (Syn_VisagePatterns _lhsOaterms))-sem_VisagePatterns_Cons :: T_VisagePattern ->- T_VisagePatterns ->- T_VisagePatterns-sem_VisagePatterns_Cons (T_VisagePattern hd_) (T_VisagePatterns tl_) =- (T_VisagePatterns (let _lhsOaterms :: ([ATerm])- _hdIaterm :: ATerm- _tlIaterms :: ([ATerm])- -- "Visage.ag"(line 107, column 17)- _lhsOaterms =- _hdIaterm : _tlIaterms- ( _hdIaterm) =- (hd_ )- ( _tlIaterms) =- (tl_ )- in ( _lhsOaterms)))-sem_VisagePatterns_Nil :: T_VisagePatterns-sem_VisagePatterns_Nil =- (T_VisagePatterns (let _lhsOaterms :: ([ATerm])- -- "Visage.ag"(line 108, column 17)- _lhsOaterms =- []- in ( _lhsOaterms)))--- VisageProduction ---------------------------------------------{-- visit 0:- synthesized attribute:- aterm : ATerm- alternatives:- alternative VProduction:- child con : {ConstructorIdent}- child children : VisageChildren- child rules : VisageRules- child locrules : VisageRules--}--- cata-sem_VisageProduction :: VisageProduction ->- T_VisageProduction-sem_VisageProduction (VProduction _con _children _rules _locrules) =- (sem_VisageProduction_VProduction _con (sem_VisageChildren _children) (sem_VisageRules _rules) (sem_VisageRules _locrules))--- semantic domain-newtype T_VisageProduction = T_VisageProduction (( ATerm))-data Inh_VisageProduction = Inh_VisageProduction {}-data Syn_VisageProduction = Syn_VisageProduction {aterm_Syn_VisageProduction :: ATerm}-wrap_VisageProduction (T_VisageProduction sem) (Inh_VisageProduction ) =- (let ( _lhsOaterm) =- (sem )- in (Syn_VisageProduction _lhsOaterm))-sem_VisageProduction_VProduction :: ConstructorIdent ->- T_VisageChildren ->- T_VisageRules ->- T_VisageRules ->- T_VisageProduction-sem_VisageProduction_VProduction con_ (T_VisageChildren children_) (T_VisageRules rules_) (T_VisageRules locrules_) =- (T_VisageProduction (let _lhsOaterm :: ATerm- _locrulesOisLoc :: Bool- _rulesOisLoc :: Bool- _childrenIaterms :: ([ATerm])- _rulesIaterms :: ([ATerm])- _locrulesIaterms :: ([ATerm])- -- "Visage.ag"(line 73, column 17)- _lhsOaterm =- AAppl "Alternative" [AString (sQ (getName con_)), AAppl "Children" _childrenIaterms,- AAppl "Rules" _rulesIaterms,- AAppl "LocRules" _locrulesIaterms]- -- "Visage.ag"(line 76, column 18)- _locrulesOisLoc =- True- -- "Visage.ag"(line 77, column 18)- _rulesOisLoc =- False- ( _childrenIaterms) =- (children_ )- ( _rulesIaterms) =- (rules_ _rulesOisLoc)- ( _locrulesIaterms) =- (locrules_ _locrulesOisLoc)- in ( _lhsOaterm)))--- VisageProductions --------------------------------------------{-- visit 0:- synthesized attribute:- aterms : [ATerm]- alternatives:- alternative Cons:- child hd : VisageProduction- child tl : VisageProductions- alternative Nil:--}--- cata-sem_VisageProductions :: VisageProductions ->- T_VisageProductions-sem_VisageProductions list =- (Prelude.foldr sem_VisageProductions_Cons sem_VisageProductions_Nil (Prelude.map sem_VisageProduction list))--- semantic domain-newtype T_VisageProductions = T_VisageProductions (( ([ATerm])))-data Inh_VisageProductions = Inh_VisageProductions {}-data Syn_VisageProductions = Syn_VisageProductions {aterms_Syn_VisageProductions :: [ATerm]}-wrap_VisageProductions (T_VisageProductions sem) (Inh_VisageProductions ) =- (let ( _lhsOaterms) =- (sem )- in (Syn_VisageProductions _lhsOaterms))-sem_VisageProductions_Cons :: T_VisageProduction ->- T_VisageProductions ->- T_VisageProductions-sem_VisageProductions_Cons (T_VisageProduction hd_) (T_VisageProductions tl_) =- (T_VisageProductions (let _lhsOaterms :: ([ATerm])- _hdIaterm :: ATerm- _tlIaterms :: ([ATerm])- -- "Visage.ag"(line 68, column 17)- _lhsOaterms =- _hdIaterm : _tlIaterms- ( _hdIaterm) =- (hd_ )- ( _tlIaterms) =- (tl_ )- in ( _lhsOaterms)))-sem_VisageProductions_Nil :: T_VisageProductions-sem_VisageProductions_Nil =- (T_VisageProductions (let _lhsOaterms :: ([ATerm])- -- "Visage.ag"(line 69, column 17)- _lhsOaterms =- []- in ( _lhsOaterms)))--- VisageRule ---------------------------------------------------{-- visit 0:- inherited attribute:- isLoc : Bool- synthesized attribute:- aterm : ATerm- alternatives:- alternative VRule:- child fieldattrs : {[(Identifier,Identifier)]}- child attr : {Identifier}- child pat : VisagePattern- child rhs : Expression- child owrt : {Bool}--}--- cata-sem_VisageRule :: VisageRule ->- T_VisageRule-sem_VisageRule (VRule _fieldattrs _attr _pat _rhs _owrt) =- (sem_VisageRule_VRule _fieldattrs _attr (sem_VisagePattern _pat) (sem_Expression _rhs) _owrt)--- semantic domain-newtype T_VisageRule = T_VisageRule (Bool ->- ( ATerm))-data Inh_VisageRule = Inh_VisageRule {isLoc_Inh_VisageRule :: Bool}-data Syn_VisageRule = Syn_VisageRule {aterm_Syn_VisageRule :: ATerm}-wrap_VisageRule (T_VisageRule sem) (Inh_VisageRule _lhsIisLoc) =- (let ( _lhsOaterm) =- (sem _lhsIisLoc)- in (Syn_VisageRule _lhsOaterm))-sem_VisageRule_VRule :: ([(Identifier,Identifier)]) ->- Identifier ->- T_VisagePattern ->- T_Expression ->- Bool ->- T_VisageRule-sem_VisageRule_VRule fieldattrs_ attr_ (T_VisagePattern pat_) (T_Expression rhs_) owrt_ =- (T_VisageRule (\ _lhsIisLoc ->- (let _lhsOaterm :: ATerm- _patIaterm :: ATerm- _rhsIaterm :: ATerm- -- "Visage.ag"(line 97, column 18)- _lhsOaterm =- AAppl (if _lhsIisLoc then "LocRule" else "Rule")- ([AString (sQ (getName attr_)), _patIaterm, _rhsIaterm] ++ if _lhsIisLoc then [AString (sQ (show owrt_))] else [])- ( _patIaterm) =- (pat_ )- ( _rhsIaterm) =- (rhs_ )- in ( _lhsOaterm))))--- VisageRules --------------------------------------------------{-- visit 0:- inherited attribute:- isLoc : Bool- synthesized attribute:- aterms : [ATerm]- alternatives:- alternative Cons:- child hd : VisageRule- child tl : VisageRules- alternative Nil:--}--- cata-sem_VisageRules :: VisageRules ->- T_VisageRules-sem_VisageRules list =- (Prelude.foldr sem_VisageRules_Cons sem_VisageRules_Nil (Prelude.map sem_VisageRule list))--- semantic domain-newtype T_VisageRules = T_VisageRules (Bool ->- ( ([ATerm])))-data Inh_VisageRules = Inh_VisageRules {isLoc_Inh_VisageRules :: Bool}-data Syn_VisageRules = Syn_VisageRules {aterms_Syn_VisageRules :: [ATerm]}-wrap_VisageRules (T_VisageRules sem) (Inh_VisageRules _lhsIisLoc) =- (let ( _lhsOaterms) =- (sem _lhsIisLoc)- in (Syn_VisageRules _lhsOaterms))-sem_VisageRules_Cons :: T_VisageRule ->- T_VisageRules ->- T_VisageRules-sem_VisageRules_Cons (T_VisageRule hd_) (T_VisageRules tl_) =- (T_VisageRules (\ _lhsIisLoc ->- (let _lhsOaterms :: ([ATerm])- _hdOisLoc :: Bool- _tlOisLoc :: Bool- _hdIaterm :: ATerm- _tlIaterms :: ([ATerm])- -- "Visage.ag"(line 92, column 17)- _lhsOaterms =- _hdIaterm : _tlIaterms- -- copy rule (down)- _hdOisLoc =- _lhsIisLoc- -- copy rule (down)- _tlOisLoc =- _lhsIisLoc- ( _hdIaterm) =- (hd_ _hdOisLoc)- ( _tlIaterms) =- (tl_ _tlOisLoc)- in ( _lhsOaterms))))-sem_VisageRules_Nil :: T_VisageRules-sem_VisageRules_Nil =- (T_VisageRules (\ _lhsIisLoc ->- (let _lhsOaterms :: ([ATerm])- -- "Visage.ag"(line 93, column 17)- _lhsOaterms =- []- in ( _lhsOaterms))))+ + +-- UUAGC 0.9.10 (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,38 +1,40 @@--- UUAGC 0.9.5 (VisagePatterns.ag)-module VisagePatterns where--import UU.Scanner.Position(Pos)-import CommonTypes--- VisagePattern ------------------------------------------------{-- alternatives:- alternative VAlias:- child field : {Identifier}- child attr : {Identifier}- child pat : VisagePattern- alternative VConstr:- child name : {ConstructorIdent}- child pats : VisagePatterns- alternative VProduct:- child pos : {Pos}- child pats : VisagePatterns- alternative VUnderscore:- child pos : {Pos}- alternative VVar:- child field : {Identifier}- child attr : {Identifier}--}-data VisagePattern = VAlias (Identifier) (Identifier) (VisagePattern)- | VConstr (ConstructorIdent) (VisagePatterns)- | VProduct (Pos) (VisagePatterns)- | VUnderscore (Pos)- | VVar (Identifier) (Identifier)--- VisagePatterns -----------------------------------------------{-- alternatives:- alternative Cons:- child hd : VisagePattern- child tl : VisagePatterns- alternative Nil:--}-type VisagePatterns = [VisagePattern]+ + +-- UUAGC 0.9.10 (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,93 +1,95 @@--- UUAGC 0.9.5 (VisageSyntax.ag)-module VisageSyntax where--import CommonTypes-import UU.Pretty-import AbstractSyntax-import VisagePatterns-import Expression--- VisageChild --------------------------------------------------{-- alternatives:- alternative VChild:- child name : {Identifier}- child tp : {Type}- child inh : {Attributes}- child syn : {Attributes}- child rules : VisageRules--}-data VisageChild = VChild (Identifier) (Type) (Attributes) (Attributes) (VisageRules)--- VisageChildren -----------------------------------------------{-- alternatives:- alternative Cons:- child hd : VisageChild- child tl : VisageChildren- alternative Nil:--}-type VisageChildren = [VisageChild]--- VisageGrammar ------------------------------------------------{-- alternatives:- alternative VGrammar:- child nonts : VisageNonterminals--}-data VisageGrammar = VGrammar (VisageNonterminals)--- VisageNonterminal --------------------------------------------{-- alternatives:- alternative VNonterminal:- child nt : {NontermIdent}- child inh : {Attributes}- child syn : {Attributes}- child alts : VisageProductions--}-data VisageNonterminal = VNonterminal (NontermIdent) (Attributes) (Attributes) (VisageProductions)--- VisageNonterminals -------------------------------------------{-- alternatives:- alternative Cons:- child hd : VisageNonterminal- child tl : VisageNonterminals- alternative Nil:--}-type VisageNonterminals = [VisageNonterminal]--- VisageProduction ---------------------------------------------{-- alternatives:- alternative VProduction:- child con : {ConstructorIdent}- child children : VisageChildren- child rules : VisageRules- child locrules : VisageRules--}-data VisageProduction = VProduction (ConstructorIdent) (VisageChildren) (VisageRules) (VisageRules)--- VisageProductions --------------------------------------------{-- alternatives:- alternative Cons:- child hd : VisageProduction- child tl : VisageProductions- alternative Nil:--}-type VisageProductions = [VisageProduction]--- VisageRule ---------------------------------------------------{-- alternatives:- alternative VRule:- child fieldattrs : {[(Identifier,Identifier)]}- child attr : {Identifier}- child pat : {VisagePattern}- child rhs : {Expression}- child owrt : {Bool}--}-data VisageRule = VRule ([(Identifier,Identifier)]) (Identifier) (VisagePattern) (Expression) (Bool)--- VisageRules --------------------------------------------------{-- alternatives:- alternative Cons:- child hd : VisageRule- child tl : VisageRules- alternative Nil:--}-type VisageRules = [VisageRule]+ + +-- UUAGC 0.9.10 (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/Ag.hs view
@@ -8,7 +8,8 @@ import qualified Data.Set as Set import qualified Data.Map as Map-import qualified UU.DData.Seq as Seq ((<>),toList)+import qualified Data.Sequence as Seq ((><))+import Data.Foldable(toList) import Pretty import UU.Parsing (Message(..), Action(..))@@ -82,12 +83,12 @@ parseErrorList = map message2error parseErrors errorList = parseErrorList- ++ Seq.toList ( Pass1.errors_Syn_AG output1- Seq.<> Pass1a.errors_Syn_Grammar output1a- Seq.<> Pass2.errors_Syn_Grammar output2- Seq.<> Pass3.errors_Syn_Grammar output3- Seq.<> Pass4.errors_Syn_CGrammar output4- )+ ++ toList ( Pass1.errors_Syn_AG output1+ Seq.>< Pass1a.errors_Syn_Grammar output1a+ Seq.>< Pass2.errors_Syn_Grammar output2+ Seq.>< Pass3.errors_Syn_Grammar output3+ Seq.>< Pass4.errors_Syn_CGrammar output4+ ) fatalErrorList = filter (PrErr.isError flags') errorList @@ -274,7 +275,8 @@ let ppErrs = PrErr.wrap_Errors (PrErr.sem_Errors errs) PrErr.Inh_Errors {PrErr.options_Inh_Errors = flags} if null errs then mapM_ putStrLn fs- else putStr . formatErrors $ PrErr.pp_Syn_Errors ppErrs+ else do putStr . formatErrors $ PrErr.pp_Syn_Errors ppErrs+ exitFailure where combine :: ([a],[b]) -> ([a], [b]) -> ([a], [b]) combine (fs, mesgs) (fsr, mesgsr)
src/Scanner.hs view
@@ -1,7 +1,7 @@-{-# OPTIONS -fglasgow-exts #-}-+{-# OPTIONS -fglasgow-exts #-} + module Scanner where -import GHC.Prim+import GHC.Prim import TokenDef import UU.Scanner.Position import UU.Scanner.Token @@ -9,7 +9,7 @@ import Maybe import List import Char -import UU.Scanner.GenToken+import UU.Scanner.GenToken import Options data Input = Input !Pos String (Maybe (Token, Input)) @@ -37,16 +37,16 @@ ) type Lexer s = Pos -> String -> Maybe (s,Pos,String) --scan :: Options -> Lexer Token-scan opts- = scan- where- keywords' = if lcKeywords opts- then map (map toLower) keywords- else keywords- mkKeyword s | s `elem` lowercaseKeywords = s- | otherwise = map toUpper s+ +scan :: Options -> Lexer Token +scan opts + = scan + where + keywords' = if lcKeywords opts + then map (map toLower) keywords + else keywords + mkKeyword s | s `elem` lowercaseKeywords = s + | otherwise = map toUpper s scan :: Lexer Token scan p [] = Nothing @@ -84,8 +84,8 @@ scan' ('=' :rs) = (reserved "=" p, advc 1 p, rs) scan' (':':'=':rs) = (reserved ":=" p, advc 2 p, rs) - scan' (':' :rs) | not (doubleColons opts) = (reserved ":" p, advc 1 p, rs) scan' (':':':':rs) | doubleColons opts = (reserved "::" p, advc 1 p, rs) + scan' (':' :rs) = (reserved ":" p, advc 1 p, rs) scan' ('|' :rs) = (reserved "|" p, advc 1 p, rs) scan' ('/':'\\':rs) = (reserved "/\\" p, advc 2 p, rs) @@ -126,9 +126,9 @@ ident = span isValid - where isValid x = isAlphaNum x || x =='_' || x == '\''+ where isValid x = isAlphaNum x || x =='_' || x == '\'' lowercaseKeywords = ["loc","lhs", "inst"] -keywords = lowercaseKeywords +++keywords = lowercaseKeywords ++ [ "DATA", "EXT", "ATTR", "SEM","TYPE", "USE", "INCLUDE" , "SET","DERIVING","FOR", "WRAPPER", "MAYBE", "EITHER", "MAP", "INTMAP" , "PRAGMA", "SEMPRAGMA", "MODULE", "ATTACH", "UNIQUEREF", "INH", "SYN"
src/Version.hs view
@@ -1,4 +1,4 @@-module Version where - -banner :: String -banner = "Attribute Grammar compiler / HUT project. Version 0.9.10" +module Version where++banner :: String+banner = "Attribute Grammar compiler / HUT project. Version 0.9.11"
uuagc.cabal view
@@ -1,7 +1,7 @@ cabal-version: >=1.2 build-type: Simple name: uuagc-version: 0.9.10+version: 0.9.11 license: GPL license-file: LICENSE maintainer: Arie Middelkoop <ariem@cs.uu.nl>@@ -19,12 +19,12 @@ description: compatibility flag. executable uuagc if flag(compatibility1)- build-depends: base >= 4, ghc-prim+ build-depends: base >= 4, base < 5, ghc-prim else build-depends: base < 4 if flag(compatibility2)- build-depends: base >= 3, containers, directory, array+ build-depends: base >= 3, base < 5, containers, directory, array else build-depends: base < 3
uuagc.cabal-for-ghc-6.6 view
@@ -1,5 +1,5 @@ name: uuagc-version: 0.9.10+version: 0.9.11 license: GPL license-file: LICENSE maintainer: Arie Middelkoop <ariem@cs.uu.nl>