-- UUAGC 0.9.40.1 (src-ag/TfmToVisage.ag)
module TfmToVisage where
{-# LINE 9 "src-ag/TfmToVisage.ag" #-}

import AbstractSyntax
import VisagePatterns
import VisageSyntax
import qualified Data.Map as Map
import Data.Map (Map)
{-# LINE 13 "dist/build/TfmToVisage.hs" #-}

{-# LINE 2 "src-ag/AbstractSyntax.ag" #-}

-- AbstractSyntax.ag imports
import Data.Set(Set)
import Data.Map(Map)
import Patterns    (Pattern(..),Patterns)
import Expression  (Expression(..))
import Macro --marcos
import CommonTypes
import ErrorMessages
{-# LINE 25 "dist/build/TfmToVisage.hs" #-}

{-# LINE 2 "src-ag/Patterns.ag" #-}

-- Patterns.ag imports
import UU.Scanner.Position(Pos)
import CommonTypes (ConstructorIdent,Identifier)
{-# LINE 32 "dist/build/TfmToVisage.hs" #-}

{-# LINE 2 "src-ag/Expression.ag" #-}

import UU.Scanner.Position(Pos)
import HsToken
{-# LINE 38 "dist/build/TfmToVisage.hs" #-}
{-# LINE 17 "src-ag/TfmToVisage.ag" #-}

-- 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

-}
{-# LINE 94 "dist/build/TfmToVisage.hs" #-}
-- Child -------------------------------------------------------
{-
   visit 0:
      inherited attributes:
         inhMap               : Map Identifier Attributes
         rulemap              : VisageRuleMap
         synMap               : Map Identifier Attributes
      synthesized attribute:
         vchild               : VisageChild
   alternatives:
      alternative Child:
         child name           : {Identifier}
         child tp             : {Type}
         child kind           : {ChildKind}
         visit 0:
            local chnt        : _
            local inh         : _
            local syn         : _
-}
-- cata
sem_Child :: Child ->
             T_Child
sem_Child (Child _name _tp _kind) =
    (sem_Child_Child _name _tp _kind)
-- semantic domain
newtype T_Child = T_Child ((Map Identifier Attributes) ->
                           VisageRuleMap ->
                           (Map Identifier Attributes) ->
                           ( VisageChild))
data Inh_Child = Inh_Child {inhMap_Inh_Child :: (Map Identifier Attributes),rulemap_Inh_Child :: VisageRuleMap,synMap_Inh_Child :: (Map Identifier Attributes)}
data Syn_Child = Syn_Child {vchild_Syn_Child :: VisageChild}
wrap_Child :: T_Child ->
              Inh_Child ->
              Syn_Child
wrap_Child (T_Child sem) (Inh_Child _lhsIinhMap _lhsIrulemap _lhsIsynMap) =
    (let ( _lhsOvchild) = sem _lhsIinhMap _lhsIrulemap _lhsIsynMap
     in  (Syn_Child _lhsOvchild))
sem_Child_Child :: Identifier ->
                   Type ->
                   ChildKind ->
                   T_Child
sem_Child_Child name_ tp_ kind_ =
    (T_Child (\ _lhsIinhMap
                _lhsIrulemap
                _lhsIsynMap ->
                  (let _lhsOvchild :: VisageChild
                       -- "src-ag/TfmToVisage.ag"(line 121, column 11)
                       _lhsOvchild =
                           ({-# LINE 121 "src-ag/TfmToVisage.ag" #-}
                            VChild name_ tp_ _inh     _syn     (getForField (getName name_) _lhsIrulemap)
                            {-# LINE 145 "dist/build/TfmToVisage" #-}
                            )
                       -- "src-ag/DistChildAttr.ag"(line 19, column 11)
                       _chnt =
                           ({-# LINE 19 "src-ag/DistChildAttr.ag" #-}
                            case tp_ of
                              NT nt _ _ -> nt
                              Self      -> error ("The type of child " ++ show name_ ++ " should not be a Self type.")
                              Haskell t -> identifier ""
                            {-# LINE 154 "dist/build/TfmToVisage" #-}
                            )
                       -- "src-ag/DistChildAttr.ag"(line 23, column 11)
                       _inh =
                           ({-# LINE 23 "src-ag/DistChildAttr.ag" #-}
                            Map.findWithDefault Map.empty _chnt     _lhsIinhMap
                            {-# LINE 160 "dist/build/TfmToVisage" #-}
                            )
                       -- "src-ag/DistChildAttr.ag"(line 24, column 11)
                       _syn =
                           ({-# LINE 24 "src-ag/DistChildAttr.ag" #-}
                            Map.findWithDefault Map.empty _chnt     _lhsIsynMap
                            {-# LINE 166 "dist/build/TfmToVisage" #-}
                            )
                       ___node =
                           (Syn_Child _lhsOvchild)
                   in  ( _lhsOvchild))))
-- Children ----------------------------------------------------
{-
   visit 0:
      inherited attributes:
         inhMap               : Map Identifier Attributes
         rulemap              : VisageRuleMap
         synMap               : Map Identifier Attributes
      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 ((Map Identifier Attributes) ->
                                 VisageRuleMap ->
                                 (Map Identifier Attributes) ->
                                 ( ([VisageChild])))
data Inh_Children = Inh_Children {inhMap_Inh_Children :: (Map Identifier Attributes),rulemap_Inh_Children :: VisageRuleMap,synMap_Inh_Children :: (Map Identifier Attributes)}
data Syn_Children = Syn_Children {vchildren_Syn_Children :: ([VisageChild])}
wrap_Children :: T_Children ->
                 Inh_Children ->
                 Syn_Children
wrap_Children (T_Children sem) (Inh_Children _lhsIinhMap _lhsIrulemap _lhsIsynMap) =
    (let ( _lhsOvchildren) = sem _lhsIinhMap _lhsIrulemap _lhsIsynMap
     in  (Syn_Children _lhsOvchildren))
sem_Children_Cons :: T_Child ->
                     T_Children ->
                     T_Children
sem_Children_Cons (T_Child hd_) (T_Children tl_) =
    (T_Children (\ _lhsIinhMap
                   _lhsIrulemap
                   _lhsIsynMap ->
                     (let _lhsOvchildren :: ([VisageChild])
                          _hdOinhMap :: (Map Identifier Attributes)
                          _hdOrulemap :: VisageRuleMap
                          _hdOsynMap :: (Map Identifier Attributes)
                          _tlOinhMap :: (Map Identifier Attributes)
                          _tlOrulemap :: VisageRuleMap
                          _tlOsynMap :: (Map Identifier Attributes)
                          _hdIvchild :: VisageChild
                          _tlIvchildren :: ([VisageChild])
                          -- "src-ag/TfmToVisage.ag"(line 117, column 17)
                          _lhsOvchildren =
                              ({-# LINE 117 "src-ag/TfmToVisage.ag" #-}
                               _hdIvchild : _tlIvchildren
                               {-# LINE 224 "dist/build/TfmToVisage" #-}
                               )
                          -- copy rule (down)
                          _hdOinhMap =
                              ({-# LINE 12 "src-ag/DistChildAttr.ag" #-}
                               _lhsIinhMap
                               {-# LINE 230 "dist/build/TfmToVisage" #-}
                               )
                          -- copy rule (down)
                          _hdOrulemap =
                              ({-# LINE 83 "src-ag/TfmToVisage.ag" #-}
                               _lhsIrulemap
                               {-# LINE 236 "dist/build/TfmToVisage" #-}
                               )
                          -- copy rule (down)
                          _hdOsynMap =
                              ({-# LINE 12 "src-ag/DistChildAttr.ag" #-}
                               _lhsIsynMap
                               {-# LINE 242 "dist/build/TfmToVisage" #-}
                               )
                          -- copy rule (down)
                          _tlOinhMap =
                              ({-# LINE 12 "src-ag/DistChildAttr.ag" #-}
                               _lhsIinhMap
                               {-# LINE 248 "dist/build/TfmToVisage" #-}
                               )
                          -- copy rule (down)
                          _tlOrulemap =
                              ({-# LINE 84 "src-ag/TfmToVisage.ag" #-}
                               _lhsIrulemap
                               {-# LINE 254 "dist/build/TfmToVisage" #-}
                               )
                          -- copy rule (down)
                          _tlOsynMap =
                              ({-# LINE 12 "src-ag/DistChildAttr.ag" #-}
                               _lhsIsynMap
                               {-# LINE 260 "dist/build/TfmToVisage" #-}
                               )
                          ( _hdIvchild) =
                              hd_ _hdOinhMap _hdOrulemap _hdOsynMap
                          ( _tlIvchildren) =
                              tl_ _tlOinhMap _tlOrulemap _tlOsynMap
                          ___node =
                              (Syn_Children _lhsOvchildren)
                      in  ( _lhsOvchildren))))
sem_Children_Nil :: T_Children
sem_Children_Nil =
    (T_Children (\ _lhsIinhMap
                   _lhsIrulemap
                   _lhsIsynMap ->
                     (let _lhsOvchildren :: ([VisageChild])
                          -- "src-ag/TfmToVisage.ag"(line 118, column 17)
                          _lhsOvchildren =
                              ({-# LINE 118 "src-ag/TfmToVisage.ag" #-}
                               []
                               {-# LINE 279 "dist/build/TfmToVisage" #-}
                               )
                          ___node =
                              (Syn_Children _lhsOvchildren)
                      in  ( _lhsOvchildren))))
-- Expression --------------------------------------------------
{-
   visit 0:
      synthesized attribute:
         self                 : Expression 
   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 =
                           ({-# LINE 74 "src-ag/TfmToVisage.ag" #-}
                            Expression pos_ tks_
                            {-# LINE 320 "dist/build/TfmToVisage" #-}
                            )
                       -- self rule
                       _lhsOself =
                           ({-# LINE 74 "src-ag/TfmToVisage.ag" #-}
                            _self
                            {-# LINE 326 "dist/build/TfmToVisage" #-}
                            )
                       ___node =
                           (Syn_Expression _lhsOself)
                   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 quantMap       : {QuantMap}
         child uniqueMap      : {UniqueMap}
         child augmentsMap    : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))}
         child aroundsMap     : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))}
         child mergeMap       : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))}
-}
-- cata
sem_Grammar :: Grammar ->
               T_Grammar
sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap) =
    (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts) _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap)
-- 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 ->
                       QuantMap ->
                       UniqueMap ->
                       (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) ->
                       (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) ->
                       (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) ->
                       T_Grammar
sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ =
    (T_Grammar (let _lhsOvisage :: VisageGrammar
                    _nontsOinhMap :: (Map Identifier Attributes)
                    _nontsOsynMap :: (Map Identifier Attributes)
                    _nontsIinhMap' :: (Map Identifier Attributes)
                    _nontsIsynMap' :: (Map Identifier Attributes)
                    _nontsIvnonts :: ([VisageNonterminal])
                    -- "src-ag/TfmToVisage.ag"(line 90, column 7)
                    _lhsOvisage =
                        ({-# LINE 90 "src-ag/TfmToVisage.ag" #-}
                         VGrammar _nontsIvnonts
                         {-# LINE 394 "dist/build/TfmToVisage" #-}
                         )
                    -- "src-ag/DistChildAttr.ag"(line 15, column 13)
                    _nontsOinhMap =
                        ({-# LINE 15 "src-ag/DistChildAttr.ag" #-}
                         _nontsIinhMap'
                         {-# LINE 400 "dist/build/TfmToVisage" #-}
                         )
                    -- "src-ag/DistChildAttr.ag"(line 16, column 13)
                    _nontsOsynMap =
                        ({-# LINE 16 "src-ag/DistChildAttr.ag" #-}
                         _nontsIsynMap'
                         {-# LINE 406 "dist/build/TfmToVisage" #-}
                         )
                    ( _nontsIinhMap',_nontsIsynMap',_nontsIvnonts) =
                        nonts_ _nontsOinhMap _nontsOsynMap
                    ___node =
                        (Syn_Grammar _lhsOvisage)
                in  ( _lhsOvisage)))
-- Nonterminal -------------------------------------------------
{-
   visit 0:
      inherited attributes:
         inhMap               : Map Identifier Attributes
         synMap               : Map Identifier Attributes
      synthesized attributes:
         inhMap'              : Map Identifier Attributes
         synMap'              : Map Identifier Attributes
         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 ((Map Identifier Attributes) ->
                                       (Map Identifier Attributes) ->
                                       ( (Map Identifier Attributes),(Map Identifier Attributes),VisageNonterminal))
data Inh_Nonterminal = Inh_Nonterminal {inhMap_Inh_Nonterminal :: (Map Identifier Attributes),synMap_Inh_Nonterminal :: (Map Identifier Attributes)}
data Syn_Nonterminal = Syn_Nonterminal {inhMap'_Syn_Nonterminal :: (Map Identifier Attributes),synMap'_Syn_Nonterminal :: (Map Identifier Attributes),vnont_Syn_Nonterminal :: VisageNonterminal}
wrap_Nonterminal :: T_Nonterminal ->
                    Inh_Nonterminal ->
                    Syn_Nonterminal
wrap_Nonterminal (T_Nonterminal sem) (Inh_Nonterminal _lhsIinhMap _lhsIsynMap) =
    (let ( _lhsOinhMap',_lhsOsynMap',_lhsOvnont) = sem _lhsIinhMap _lhsIsynMap
     in  (Syn_Nonterminal _lhsOinhMap' _lhsOsynMap' _lhsOvnont))
sem_Nonterminal_Nonterminal :: NontermIdent ->
                               ([Identifier]) ->
                               Attributes ->
                               Attributes ->
                               T_Productions ->
                               T_Nonterminal
sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ (T_Productions prods_) =
    (T_Nonterminal (\ _lhsIinhMap
                      _lhsIsynMap ->
                        (let _lhsOvnont :: VisageNonterminal
                             _lhsOinhMap' :: (Map Identifier Attributes)
                             _lhsOsynMap' :: (Map Identifier Attributes)
                             _prodsOinhMap :: (Map Identifier Attributes)
                             _prodsOsynMap :: (Map Identifier Attributes)
                             _prodsIvprods :: ([VisageProduction])
                             -- "src-ag/TfmToVisage.ag"(line 100, column 7)
                             _lhsOvnont =
                                 ({-# LINE 100 "src-ag/TfmToVisage.ag" #-}
                                  VNonterminal nt_ inh_ syn_ _prodsIvprods
                                  {-# LINE 467 "dist/build/TfmToVisage" #-}
                                  )
                             -- "src-ag/DistChildAttr.ag"(line 7, column 18)
                             _lhsOinhMap' =
                                 ({-# LINE 7 "src-ag/DistChildAttr.ag" #-}
                                  Map.singleton nt_ inh_
                                  {-# LINE 473 "dist/build/TfmToVisage" #-}
                                  )
                             -- "src-ag/DistChildAttr.ag"(line 8, column 18)
                             _lhsOsynMap' =
                                 ({-# LINE 8 "src-ag/DistChildAttr.ag" #-}
                                  Map.singleton nt_ syn_
                                  {-# LINE 479 "dist/build/TfmToVisage" #-}
                                  )
                             -- copy rule (down)
                             _prodsOinhMap =
                                 ({-# LINE 12 "src-ag/DistChildAttr.ag" #-}
                                  _lhsIinhMap
                                  {-# LINE 485 "dist/build/TfmToVisage" #-}
                                  )
                             -- copy rule (down)
                             _prodsOsynMap =
                                 ({-# LINE 12 "src-ag/DistChildAttr.ag" #-}
                                  _lhsIsynMap
                                  {-# LINE 491 "dist/build/TfmToVisage" #-}
                                  )
                             ( _prodsIvprods) =
                                 prods_ _prodsOinhMap _prodsOsynMap
                             ___node =
                                 (Syn_Nonterminal _lhsOinhMap' _lhsOsynMap' _lhsOvnont)
                         in  ( _lhsOinhMap',_lhsOsynMap',_lhsOvnont))))
-- Nonterminals ------------------------------------------------
{-
   visit 0:
      inherited attributes:
         inhMap               : Map Identifier Attributes
         synMap               : Map Identifier Attributes
      synthesized attributes:
         inhMap'              : Map Identifier Attributes
         synMap'              : Map Identifier Attributes
         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 ((Map Identifier Attributes) ->
                                         (Map Identifier Attributes) ->
                                         ( (Map Identifier Attributes),(Map Identifier Attributes),([VisageNonterminal])))
data Inh_Nonterminals = Inh_Nonterminals {inhMap_Inh_Nonterminals :: (Map Identifier Attributes),synMap_Inh_Nonterminals :: (Map Identifier Attributes)}
data Syn_Nonterminals = Syn_Nonterminals {inhMap'_Syn_Nonterminals :: (Map Identifier Attributes),synMap'_Syn_Nonterminals :: (Map Identifier Attributes),vnonts_Syn_Nonterminals :: ([VisageNonterminal])}
wrap_Nonterminals :: T_Nonterminals ->
                     Inh_Nonterminals ->
                     Syn_Nonterminals
wrap_Nonterminals (T_Nonterminals sem) (Inh_Nonterminals _lhsIinhMap _lhsIsynMap) =
    (let ( _lhsOinhMap',_lhsOsynMap',_lhsOvnonts) = sem _lhsIinhMap _lhsIsynMap
     in  (Syn_Nonterminals _lhsOinhMap' _lhsOsynMap' _lhsOvnonts))
sem_Nonterminals_Cons :: T_Nonterminal ->
                         T_Nonterminals ->
                         T_Nonterminals
sem_Nonterminals_Cons (T_Nonterminal hd_) (T_Nonterminals tl_) =
    (T_Nonterminals (\ _lhsIinhMap
                       _lhsIsynMap ->
                         (let _lhsOvnonts :: ([VisageNonterminal])
                              _lhsOinhMap' :: (Map Identifier Attributes)
                              _lhsOsynMap' :: (Map Identifier Attributes)
                              _hdOinhMap :: (Map Identifier Attributes)
                              _hdOsynMap :: (Map Identifier Attributes)
                              _tlOinhMap :: (Map Identifier Attributes)
                              _tlOsynMap :: (Map Identifier Attributes)
                              _hdIinhMap' :: (Map Identifier Attributes)
                              _hdIsynMap' :: (Map Identifier Attributes)
                              _hdIvnont :: VisageNonterminal
                              _tlIinhMap' :: (Map Identifier Attributes)
                              _tlIsynMap' :: (Map Identifier Attributes)
                              _tlIvnonts :: ([VisageNonterminal])
                              -- "src-ag/TfmToVisage.ag"(line 94, column 7)
                              _lhsOvnonts =
                                  ({-# LINE 94 "src-ag/TfmToVisage.ag" #-}
                                   _hdIvnont : _tlIvnonts
                                   {-# LINE 554 "dist/build/TfmToVisage" #-}
                                   )
                              -- use rule "src-ag/DistChildAttr.ag"(line 4, column 53)
                              _lhsOinhMap' =
                                  ({-# LINE 4 "src-ag/DistChildAttr.ag" #-}
                                   _hdIinhMap' `Map.union` _tlIinhMap'
                                   {-# LINE 560 "dist/build/TfmToVisage" #-}
                                   )
                              -- use rule "src-ag/DistChildAttr.ag"(line 4, column 53)
                              _lhsOsynMap' =
                                  ({-# LINE 4 "src-ag/DistChildAttr.ag" #-}
                                   _hdIsynMap' `Map.union` _tlIsynMap'
                                   {-# LINE 566 "dist/build/TfmToVisage" #-}
                                   )
                              -- copy rule (down)
                              _hdOinhMap =
                                  ({-# LINE 12 "src-ag/DistChildAttr.ag" #-}
                                   _lhsIinhMap
                                   {-# LINE 572 "dist/build/TfmToVisage" #-}
                                   )
                              -- copy rule (down)
                              _hdOsynMap =
                                  ({-# LINE 12 "src-ag/DistChildAttr.ag" #-}
                                   _lhsIsynMap
                                   {-# LINE 578 "dist/build/TfmToVisage" #-}
                                   )
                              -- copy rule (down)
                              _tlOinhMap =
                                  ({-# LINE 12 "src-ag/DistChildAttr.ag" #-}
                                   _lhsIinhMap
                                   {-# LINE 584 "dist/build/TfmToVisage" #-}
                                   )
                              -- copy rule (down)
                              _tlOsynMap =
                                  ({-# LINE 12 "src-ag/DistChildAttr.ag" #-}
                                   _lhsIsynMap
                                   {-# LINE 590 "dist/build/TfmToVisage" #-}
                                   )
                              ( _hdIinhMap',_hdIsynMap',_hdIvnont) =
                                  hd_ _hdOinhMap _hdOsynMap
                              ( _tlIinhMap',_tlIsynMap',_tlIvnonts) =
                                  tl_ _tlOinhMap _tlOsynMap
                              ___node =
                                  (Syn_Nonterminals _lhsOinhMap' _lhsOsynMap' _lhsOvnonts)
                          in  ( _lhsOinhMap',_lhsOsynMap',_lhsOvnonts))))
sem_Nonterminals_Nil :: T_Nonterminals
sem_Nonterminals_Nil =
    (T_Nonterminals (\ _lhsIinhMap
                       _lhsIsynMap ->
                         (let _lhsOvnonts :: ([VisageNonterminal])
                              _lhsOinhMap' :: (Map Identifier Attributes)
                              _lhsOsynMap' :: (Map Identifier Attributes)
                              -- "src-ag/TfmToVisage.ag"(line 96, column 7)
                              _lhsOvnonts =
                                  ({-# LINE 96 "src-ag/TfmToVisage.ag" #-}
                                   []
                                   {-# LINE 610 "dist/build/TfmToVisage" #-}
                                   )
                              -- use rule "src-ag/DistChildAttr.ag"(line 4, column 53)
                              _lhsOinhMap' =
                                  ({-# LINE 4 "src-ag/DistChildAttr.ag" #-}
                                   Map.empty
                                   {-# LINE 616 "dist/build/TfmToVisage" #-}
                                   )
                              -- use rule "src-ag/DistChildAttr.ag"(line 4, column 53)
                              _lhsOsynMap' =
                                  ({-# LINE 4 "src-ag/DistChildAttr.ag" #-}
                                   Map.empty
                                   {-# LINE 622 "dist/build/TfmToVisage" #-}
                                   )
                              ___node =
                                  (Syn_Nonterminals _lhsOinhMap' _lhsOsynMap' _lhsOvnonts)
                          in  ( _lhsOinhMap',_lhsOsynMap',_lhsOvnonts))))
-- Pattern -----------------------------------------------------
{-
   visit 0:
      synthesized attributes:
         copy                 : Pattern 
         fieldattrs           :  [(Identifier,Identifier)] 
         self                 : Pattern 
         vpat                 : VisagePattern
   alternatives:
      alternative Alias:
         child field          : {Identifier}
         child attr           : {Identifier}
         child pat            : Pattern 
         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) =
    (sem_Pattern_Alias _field _attr (sem_Pattern _pat))
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_Pattern
sem_Pattern_Alias field_ attr_ (T_Pattern pat_) =
    (T_Pattern (let _lhsOvpat :: VisagePattern
                    _lhsOfieldattrs :: ( [(Identifier,Identifier)] )
                    _lhsOcopy :: Pattern
                    _lhsOself :: Pattern
                    _patIcopy :: Pattern
                    _patIfieldattrs :: ( [(Identifier,Identifier)] )
                    _patIself :: Pattern
                    _patIvpat :: VisagePattern
                    -- "src-ag/TfmToVisage.ag"(line 138, column 17)
                    _lhsOvpat =
                        ({-# LINE 138 "src-ag/TfmToVisage.ag" #-}
                         if (isVar _self)
                         then VVar field_ attr_
                         else VAlias field_ attr_ _patIvpat
                         {-# LINE 708 "dist/build/TfmToVisage" #-}
                         )
                    -- "src-ag/TfmToVisage.ag"(line 147, column 17)
                    _lhsOfieldattrs =
                        ({-# LINE 147 "src-ag/TfmToVisage.ag" #-}
                         [(field_, attr_)]
                         {-# LINE 714 "dist/build/TfmToVisage" #-}
                         )
                    -- self rule
                    _copy =
                        ({-# LINE 22 "src-ag/Patterns.ag" #-}
                         Alias field_ attr_ _patIcopy
                         {-# LINE 720 "dist/build/TfmToVisage" #-}
                         )
                    -- self rule
                    _self =
                        ({-# LINE 74 "src-ag/TfmToVisage.ag" #-}
                         Alias field_ attr_ _patIself
                         {-# LINE 726 "dist/build/TfmToVisage" #-}
                         )
                    -- self rule
                    _lhsOcopy =
                        ({-# LINE 22 "src-ag/Patterns.ag" #-}
                         _copy
                         {-# LINE 732 "dist/build/TfmToVisage" #-}
                         )
                    -- self rule
                    _lhsOself =
                        ({-# LINE 74 "src-ag/TfmToVisage.ag" #-}
                         _self
                         {-# LINE 738 "dist/build/TfmToVisage" #-}
                         )
                    ( _patIcopy,_patIfieldattrs,_patIself,_patIvpat) =
                        pat_
                    ___node =
                        (Syn_Pattern _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpat)
                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])
                    -- "src-ag/TfmToVisage.ag"(line 136, column 17)
                    _lhsOvpat =
                        ({-# LINE 136 "src-ag/TfmToVisage.ag" #-}
                         VConstr name_ _patsIvpats
                         {-# LINE 761 "dist/build/TfmToVisage" #-}
                         )
                    -- use rule "src-ag/TfmToVisage.ag"(line 144, column 43)
                    _lhsOfieldattrs =
                        ({-# LINE 144 "src-ag/TfmToVisage.ag" #-}
                         _patsIfieldattrs
                         {-# LINE 767 "dist/build/TfmToVisage" #-}
                         )
                    -- self rule
                    _copy =
                        ({-# LINE 22 "src-ag/Patterns.ag" #-}
                         Constr name_ _patsIcopy
                         {-# LINE 773 "dist/build/TfmToVisage" #-}
                         )
                    -- self rule
                    _self =
                        ({-# LINE 74 "src-ag/TfmToVisage.ag" #-}
                         Constr name_ _patsIself
                         {-# LINE 779 "dist/build/TfmToVisage" #-}
                         )
                    -- self rule
                    _lhsOcopy =
                        ({-# LINE 22 "src-ag/Patterns.ag" #-}
                         _copy
                         {-# LINE 785 "dist/build/TfmToVisage" #-}
                         )
                    -- self rule
                    _lhsOself =
                        ({-# LINE 74 "src-ag/TfmToVisage.ag" #-}
                         _self
                         {-# LINE 791 "dist/build/TfmToVisage" #-}
                         )
                    ( _patsIcopy,_patsIfieldattrs,_patsIself,_patsIvpats) =
                        pats_
                    ___node =
                        (Syn_Pattern _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpat)
                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 "src-ag/TfmToVisage.ag"(line 144, column 43)
                    _lhsOfieldattrs =
                        ({-# LINE 144 "src-ag/TfmToVisage.ag" #-}
                         _patIfieldattrs
                         {-# LINE 813 "dist/build/TfmToVisage" #-}
                         )
                    -- self rule
                    _copy =
                        ({-# LINE 22 "src-ag/Patterns.ag" #-}
                         Irrefutable _patIcopy
                         {-# LINE 819 "dist/build/TfmToVisage" #-}
                         )
                    -- self rule
                    _self =
                        ({-# LINE 74 "src-ag/TfmToVisage.ag" #-}
                         Irrefutable _patIself
                         {-# LINE 825 "dist/build/TfmToVisage" #-}
                         )
                    -- self rule
                    _lhsOcopy =
                        ({-# LINE 22 "src-ag/Patterns.ag" #-}
                         _copy
                         {-# LINE 831 "dist/build/TfmToVisage" #-}
                         )
                    -- self rule
                    _lhsOself =
                        ({-# LINE 74 "src-ag/TfmToVisage.ag" #-}
                         _self
                         {-# LINE 837 "dist/build/TfmToVisage" #-}
                         )
                    -- copy rule (up)
                    _lhsOvpat =
                        ({-# LINE 85 "src-ag/TfmToVisage.ag" #-}
                         _patIvpat
                         {-# LINE 843 "dist/build/TfmToVisage" #-}
                         )
                    ( _patIcopy,_patIfieldattrs,_patIself,_patIvpat) =
                        pat_
                    ___node =
                        (Syn_Pattern _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpat)
                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])
                    -- "src-ag/TfmToVisage.ag"(line 137, column 17)
                    _lhsOvpat =
                        ({-# LINE 137 "src-ag/TfmToVisage.ag" #-}
                         VProduct pos_ _patsIvpats
                         {-# LINE 866 "dist/build/TfmToVisage" #-}
                         )
                    -- use rule "src-ag/TfmToVisage.ag"(line 144, column 43)
                    _lhsOfieldattrs =
                        ({-# LINE 144 "src-ag/TfmToVisage.ag" #-}
                         _patsIfieldattrs
                         {-# LINE 872 "dist/build/TfmToVisage" #-}
                         )
                    -- self rule
                    _copy =
                        ({-# LINE 22 "src-ag/Patterns.ag" #-}
                         Product pos_ _patsIcopy
                         {-# LINE 878 "dist/build/TfmToVisage" #-}
                         )
                    -- self rule
                    _self =
                        ({-# LINE 74 "src-ag/TfmToVisage.ag" #-}
                         Product pos_ _patsIself
                         {-# LINE 884 "dist/build/TfmToVisage" #-}
                         )
                    -- self rule
                    _lhsOcopy =
                        ({-# LINE 22 "src-ag/Patterns.ag" #-}
                         _copy
                         {-# LINE 890 "dist/build/TfmToVisage" #-}
                         )
                    -- self rule
                    _lhsOself =
                        ({-# LINE 74 "src-ag/TfmToVisage.ag" #-}
                         _self
                         {-# LINE 896 "dist/build/TfmToVisage" #-}
                         )
                    ( _patsIcopy,_patsIfieldattrs,_patsIself,_patsIvpats) =
                        pats_
                    ___node =
                        (Syn_Pattern _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpat)
                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
                    -- "src-ag/TfmToVisage.ag"(line 141, column 17)
                    _lhsOvpat =
                        ({-# LINE 141 "src-ag/TfmToVisage.ag" #-}
                         VUnderscore pos_
                         {-# LINE 914 "dist/build/TfmToVisage" #-}
                         )
                    -- use rule "src-ag/TfmToVisage.ag"(line 144, column 43)
                    _lhsOfieldattrs =
                        ({-# LINE 144 "src-ag/TfmToVisage.ag" #-}
                         []
                         {-# LINE 920 "dist/build/TfmToVisage" #-}
                         )
                    -- self rule
                    _copy =
                        ({-# LINE 22 "src-ag/Patterns.ag" #-}
                         Underscore pos_
                         {-# LINE 926 "dist/build/TfmToVisage" #-}
                         )
                    -- self rule
                    _self =
                        ({-# LINE 74 "src-ag/TfmToVisage.ag" #-}
                         Underscore pos_
                         {-# LINE 932 "dist/build/TfmToVisage" #-}
                         )
                    -- self rule
                    _lhsOcopy =
                        ({-# LINE 22 "src-ag/Patterns.ag" #-}
                         _copy
                         {-# LINE 938 "dist/build/TfmToVisage" #-}
                         )
                    -- self rule
                    _lhsOself =
                        ({-# LINE 74 "src-ag/TfmToVisage.ag" #-}
                         _self
                         {-# LINE 944 "dist/build/TfmToVisage" #-}
                         )
                    ___node =
                        (Syn_Pattern _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpat)
                in  ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpat)))
-- Patterns ----------------------------------------------------
{-
   visit 0:
      synthesized attributes:
         copy                 : Patterns 
         fieldattrs           :  [(Identifier,Identifier)] 
         self                 : Patterns 
         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])
                     -- "src-ag/TfmToVisage.ag"(line 132, column 17)
                     _lhsOvpats =
                         ({-# LINE 132 "src-ag/TfmToVisage.ag" #-}
                          _hdIvpat : _tlIvpats
                          {-# LINE 1004 "dist/build/TfmToVisage" #-}
                          )
                     -- use rule "src-ag/TfmToVisage.ag"(line 144, column 43)
                     _lhsOfieldattrs =
                         ({-# LINE 144 "src-ag/TfmToVisage.ag" #-}
                          _hdIfieldattrs  ++  _tlIfieldattrs
                          {-# LINE 1010 "dist/build/TfmToVisage" #-}
                          )
                     -- self rule
                     _copy =
                         ({-# LINE 22 "src-ag/Patterns.ag" #-}
                          (:) _hdIcopy _tlIcopy
                          {-# LINE 1016 "dist/build/TfmToVisage" #-}
                          )
                     -- self rule
                     _self =
                         ({-# LINE 74 "src-ag/TfmToVisage.ag" #-}
                          (:) _hdIself _tlIself
                          {-# LINE 1022 "dist/build/TfmToVisage" #-}
                          )
                     -- self rule
                     _lhsOcopy =
                         ({-# LINE 22 "src-ag/Patterns.ag" #-}
                          _copy
                          {-# LINE 1028 "dist/build/TfmToVisage" #-}
                          )
                     -- self rule
                     _lhsOself =
                         ({-# LINE 74 "src-ag/TfmToVisage.ag" #-}
                          _self
                          {-# LINE 1034 "dist/build/TfmToVisage" #-}
                          )
                     ( _hdIcopy,_hdIfieldattrs,_hdIself,_hdIvpat) =
                         hd_
                     ( _tlIcopy,_tlIfieldattrs,_tlIself,_tlIvpats) =
                         tl_
                     ___node =
                         (Syn_Patterns _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpats)
                 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
                     -- "src-ag/TfmToVisage.ag"(line 133, column 17)
                     _lhsOvpats =
                         ({-# LINE 133 "src-ag/TfmToVisage.ag" #-}
                          []
                          {-# LINE 1053 "dist/build/TfmToVisage" #-}
                          )
                     -- use rule "src-ag/TfmToVisage.ag"(line 144, column 43)
                     _lhsOfieldattrs =
                         ({-# LINE 144 "src-ag/TfmToVisage.ag" #-}
                          []
                          {-# LINE 1059 "dist/build/TfmToVisage" #-}
                          )
                     -- self rule
                     _copy =
                         ({-# LINE 22 "src-ag/Patterns.ag" #-}
                          []
                          {-# LINE 1065 "dist/build/TfmToVisage" #-}
                          )
                     -- self rule
                     _self =
                         ({-# LINE 74 "src-ag/TfmToVisage.ag" #-}
                          []
                          {-# LINE 1071 "dist/build/TfmToVisage" #-}
                          )
                     -- self rule
                     _lhsOcopy =
                         ({-# LINE 22 "src-ag/Patterns.ag" #-}
                          _copy
                          {-# LINE 1077 "dist/build/TfmToVisage" #-}
                          )
                     -- self rule
                     _lhsOself =
                         ({-# LINE 74 "src-ag/TfmToVisage.ag" #-}
                          _self
                          {-# LINE 1083 "dist/build/TfmToVisage" #-}
                          )
                     ___node =
                         (Syn_Patterns _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpats)
                 in  ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpats)))
-- Production --------------------------------------------------
{-
   visit 0:
      inherited attributes:
         inhMap               : Map Identifier Attributes
         synMap               : Map Identifier Attributes
      synthesized attribute:
         vprod                : VisageProduction
   alternatives:
      alternative Production:
         child con            : {ConstructorIdent}
         child params         : {[Identifier]}
         child constraints    : {[Type]}
         child children       : Children 
         child rules          : Rules 
         child typeSigs       : TypeSigs 
         child macro          : {MaybeMacro}
         visit 0:
            local splitVRules : _
            local locrules    : _
            local lhsrules    : _
-}
-- cata
sem_Production :: Production ->
                  T_Production
sem_Production (Production _con _params _constraints _children _rules _typeSigs _macro) =
    (sem_Production_Production _con _params _constraints (sem_Children _children) (sem_Rules _rules) (sem_TypeSigs _typeSigs) _macro)
-- semantic domain
newtype T_Production = T_Production ((Map Identifier Attributes) ->
                                     (Map Identifier Attributes) ->
                                     ( VisageProduction))
data Inh_Production = Inh_Production {inhMap_Inh_Production :: (Map Identifier Attributes),synMap_Inh_Production :: (Map Identifier Attributes)}
data Syn_Production = Syn_Production {vprod_Syn_Production :: VisageProduction}
wrap_Production :: T_Production ->
                   Inh_Production ->
                   Syn_Production
wrap_Production (T_Production sem) (Inh_Production _lhsIinhMap _lhsIsynMap) =
    (let ( _lhsOvprod) = sem _lhsIinhMap _lhsIsynMap
     in  (Syn_Production _lhsOvprod))
sem_Production_Production :: ConstructorIdent ->
                             ([Identifier]) ->
                             ([Type]) ->
                             T_Children ->
                             T_Rules ->
                             T_TypeSigs ->
                             MaybeMacro ->
                             T_Production
sem_Production_Production con_ params_ constraints_ (T_Children children_) (T_Rules rules_) (T_TypeSigs typeSigs_) macro_ =
    (T_Production (\ _lhsIinhMap
                     _lhsIsynMap ->
                       (let _lhsOvprod :: VisageProduction
                            _childrenOrulemap :: VisageRuleMap
                            _childrenOinhMap :: (Map Identifier Attributes)
                            _childrenOsynMap :: (Map Identifier Attributes)
                            _childrenIvchildren :: ([VisageChild])
                            _rulesIvrules :: ([VisageRule])
                            -- "src-ag/TfmToVisage.ag"(line 110, column 7)
                            _lhsOvprod =
                                ({-# LINE 110 "src-ag/TfmToVisage.ag" #-}
                                 VProduction con_ _childrenIvchildren _lhsrules _locrules
                                 {-# LINE 1148 "dist/build/TfmToVisage" #-}
                                 )
                            -- "src-ag/TfmToVisage.ag"(line 111, column 7)
                            _splitVRules =
                                ({-# LINE 111 "src-ag/TfmToVisage.ag" #-}
                                 splitVRules _rulesIvrules
                                 {-# LINE 1154 "dist/build/TfmToVisage" #-}
                                 )
                            -- "src-ag/TfmToVisage.ag"(line 112, column 7)
                            _locrules =
                                ({-# LINE 112 "src-ag/TfmToVisage.ag" #-}
                                 getForField "loc" _splitVRules
                                 {-# LINE 1160 "dist/build/TfmToVisage" #-}
                                 )
                            -- "src-ag/TfmToVisage.ag"(line 113, column 7)
                            _lhsrules =
                                ({-# LINE 113 "src-ag/TfmToVisage.ag" #-}
                                 getForField "lhs" _splitVRules
                                 {-# LINE 1166 "dist/build/TfmToVisage" #-}
                                 )
                            -- "src-ag/TfmToVisage.ag"(line 114, column 7)
                            _childrenOrulemap =
                                ({-# LINE 114 "src-ag/TfmToVisage.ag" #-}
                                 _splitVRules
                                 {-# LINE 1172 "dist/build/TfmToVisage" #-}
                                 )
                            -- copy rule (down)
                            _childrenOinhMap =
                                ({-# LINE 12 "src-ag/DistChildAttr.ag" #-}
                                 _lhsIinhMap
                                 {-# LINE 1178 "dist/build/TfmToVisage" #-}
                                 )
                            -- copy rule (down)
                            _childrenOsynMap =
                                ({-# LINE 12 "src-ag/DistChildAttr.ag" #-}
                                 _lhsIsynMap
                                 {-# LINE 1184 "dist/build/TfmToVisage" #-}
                                 )
                            ( _childrenIvchildren) =
                                children_ _childrenOinhMap _childrenOrulemap _childrenOsynMap
                            ( _rulesIvrules) =
                                rules_
                            ___node =
                                (Syn_Production _lhsOvprod)
                        in  ( _lhsOvprod))))
-- Productions -------------------------------------------------
{-
   visit 0:
      inherited attributes:
         inhMap               : Map Identifier Attributes
         synMap               : Map Identifier Attributes
      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 ((Map Identifier Attributes) ->
                                       (Map Identifier Attributes) ->
                                       ( ([VisageProduction])))
data Inh_Productions = Inh_Productions {inhMap_Inh_Productions :: (Map Identifier Attributes),synMap_Inh_Productions :: (Map Identifier Attributes)}
data Syn_Productions = Syn_Productions {vprods_Syn_Productions :: ([VisageProduction])}
wrap_Productions :: T_Productions ->
                    Inh_Productions ->
                    Syn_Productions
wrap_Productions (T_Productions sem) (Inh_Productions _lhsIinhMap _lhsIsynMap) =
    (let ( _lhsOvprods) = sem _lhsIinhMap _lhsIsynMap
     in  (Syn_Productions _lhsOvprods))
sem_Productions_Cons :: T_Production ->
                        T_Productions ->
                        T_Productions
sem_Productions_Cons (T_Production hd_) (T_Productions tl_) =
    (T_Productions (\ _lhsIinhMap
                      _lhsIsynMap ->
                        (let _lhsOvprods :: ([VisageProduction])
                             _hdOinhMap :: (Map Identifier Attributes)
                             _hdOsynMap :: (Map Identifier Attributes)
                             _tlOinhMap :: (Map Identifier Attributes)
                             _tlOsynMap :: (Map Identifier Attributes)
                             _hdIvprod :: VisageProduction
                             _tlIvprods :: ([VisageProduction])
                             -- "src-ag/TfmToVisage.ag"(line 104, column 7)
                             _lhsOvprods =
                                 ({-# LINE 104 "src-ag/TfmToVisage.ag" #-}
                                  _hdIvprod : _tlIvprods
                                  {-# LINE 1241 "dist/build/TfmToVisage" #-}
                                  )
                             -- copy rule (down)
                             _hdOinhMap =
                                 ({-# LINE 12 "src-ag/DistChildAttr.ag" #-}
                                  _lhsIinhMap
                                  {-# LINE 1247 "dist/build/TfmToVisage" #-}
                                  )
                             -- copy rule (down)
                             _hdOsynMap =
                                 ({-# LINE 12 "src-ag/DistChildAttr.ag" #-}
                                  _lhsIsynMap
                                  {-# LINE 1253 "dist/build/TfmToVisage" #-}
                                  )
                             -- copy rule (down)
                             _tlOinhMap =
                                 ({-# LINE 12 "src-ag/DistChildAttr.ag" #-}
                                  _lhsIinhMap
                                  {-# LINE 1259 "dist/build/TfmToVisage" #-}
                                  )
                             -- copy rule (down)
                             _tlOsynMap =
                                 ({-# LINE 12 "src-ag/DistChildAttr.ag" #-}
                                  _lhsIsynMap
                                  {-# LINE 1265 "dist/build/TfmToVisage" #-}
                                  )
                             ( _hdIvprod) =
                                 hd_ _hdOinhMap _hdOsynMap
                             ( _tlIvprods) =
                                 tl_ _tlOinhMap _tlOsynMap
                             ___node =
                                 (Syn_Productions _lhsOvprods)
                         in  ( _lhsOvprods))))
sem_Productions_Nil :: T_Productions
sem_Productions_Nil =
    (T_Productions (\ _lhsIinhMap
                      _lhsIsynMap ->
                        (let _lhsOvprods :: ([VisageProduction])
                             -- "src-ag/TfmToVisage.ag"(line 106, column 7)
                             _lhsOvprods =
                                 ({-# LINE 106 "src-ag/TfmToVisage.ag" #-}
                                  []
                                  {-# LINE 1283 "dist/build/TfmToVisage" #-}
                                  )
                             ___node =
                                 (Syn_Productions _lhsOvprods)
                         in  ( _lhsOvprods))))
-- Rule --------------------------------------------------------
{-
   visit 0:
      synthesized attribute:
         vrule                : VisageRule
   alternatives:
      alternative Rule:
         child mbName         : {Maybe Identifier}
         child pattern        : Pattern 
         child rhs            : Expression 
         child owrt           : {Bool}
         child origin         : {String}
         child explicit       : {Bool}
         child pure           : {Bool}
         child identity       : {Bool}
         child mbError        : {Maybe Error}
         child eager          : {Bool}
-}
-- cata
sem_Rule :: Rule ->
            T_Rule
sem_Rule (Rule _mbName _pattern _rhs _owrt _origin _explicit _pure _identity _mbError _eager) =
    (sem_Rule_Rule _mbName (sem_Pattern _pattern) (sem_Expression _rhs) _owrt _origin _explicit _pure _identity _mbError _eager)
-- 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 :: (Maybe Identifier) ->
                 T_Pattern ->
                 T_Expression ->
                 Bool ->
                 String ->
                 Bool ->
                 Bool ->
                 Bool ->
                 (Maybe Error) ->
                 Bool ->
                 T_Rule
sem_Rule_Rule mbName_ (T_Pattern pattern_) (T_Expression rhs_) owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ =
    (T_Rule (let _lhsOvrule :: VisageRule
                 _patternIcopy :: Pattern
                 _patternIfieldattrs :: ( [(Identifier,Identifier)] )
                 _patternIself :: Pattern
                 _patternIvpat :: VisagePattern
                 _rhsIself :: Expression
                 -- "src-ag/TfmToVisage.ag"(line 129, column 11)
                 _lhsOvrule =
                     ({-# LINE 129 "src-ag/TfmToVisage.ag" #-}
                      VRule _patternIfieldattrs undefined _patternIvpat _rhsIself owrt_
                      {-# LINE 1343 "dist/build/TfmToVisage" #-}
                      )
                 ( _patternIcopy,_patternIfieldattrs,_patternIself,_patternIvpat) =
                     pattern_
                 ( _rhsIself) =
                     rhs_
                 ___node =
                     (Syn_Rule _lhsOvrule)
             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])
                  -- "src-ag/TfmToVisage.ag"(line 124, column 17)
                  _lhsOvrules =
                      ({-# LINE 124 "src-ag/TfmToVisage.ag" #-}
                       _hdIvrule : _tlIvrules
                       {-# LINE 1389 "dist/build/TfmToVisage" #-}
                       )
                  ( _hdIvrule) =
                      hd_
                  ( _tlIvrules) =
                      tl_
                  ___node =
                      (Syn_Rules _lhsOvrules)
              in  ( _lhsOvrules)))
sem_Rules_Nil :: T_Rules
sem_Rules_Nil =
    (T_Rules (let _lhsOvrules :: ([VisageRule])
                  -- "src-ag/TfmToVisage.ag"(line 125, column 17)
                  _lhsOvrules =
                      ({-# LINE 125 "src-ag/TfmToVisage.ag" #-}
                       []
                       {-# LINE 1405 "dist/build/TfmToVisage" #-}
                       )
                  ___node =
                      (Syn_Rules _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 ___node =
                        (Syn_TypeSig)
                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 ___node =
                         (Syn_TypeSigs)
                 in  ( )))
sem_TypeSigs_Nil :: T_TypeSigs
sem_TypeSigs_Nil =
    (T_TypeSigs (let ___node =
                         (Syn_TypeSigs)
                 in  ( )))