module TfmToVisage where
import UU.Scanner.Position(Pos)
import HsToken
import UU.Scanner.Position(Pos)
import CommonTypes (ConstructorIdent,Identifier)
import Data.Set(Set)
import Data.Map(Map)
import Patterns (Pattern(..),Patterns)
import Expression (Expression(..))
import Macro --marcos
import CommonTypes
import ErrorMessages
import AbstractSyntax
import VisagePatterns
import VisageSyntax
import qualified Data.Map as Map
import Data.Map (Map)
import Control.Monad.Identity (Identity)
import qualified Control.Monad.Identity
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)
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 act) (Inh_Child _lhsIinhMap _lhsIrulemap _lhsIsynMap) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg = T_Child_vIn1 _lhsIinhMap _lhsIrulemap _lhsIsynMap
(T_Child_vOut1 _lhsOvchild) <- return (inv_Child_s2 sem arg)
return (Syn_Child _lhsOvchild)
)
sem_Child :: Child -> T_Child
sem_Child ( Child name_ tp_ kind_ ) = sem_Child_Child name_ tp_ kind_
newtype T_Child = T_Child {
attach_T_Child :: Identity (T_Child_s2 )
}
newtype T_Child_s2 = C_Child_s2 {
inv_Child_s2 :: (T_Child_v1 )
}
data T_Child_s3 = C_Child_s3
type T_Child_v1 = (T_Child_vIn1 ) -> (T_Child_vOut1 )
data T_Child_vIn1 = T_Child_vIn1 (Map Identifier Attributes) (VisageRuleMap) (Map Identifier Attributes)
data T_Child_vOut1 = T_Child_vOut1 (VisageChild)
sem_Child_Child :: (Identifier) -> (Type) -> (ChildKind) -> T_Child
sem_Child_Child arg_name_ arg_tp_ _ = T_Child (return st2) where
st2 = let
v1 :: T_Child_v1
v1 = \ (T_Child_vIn1 _lhsIinhMap _lhsIrulemap _lhsIsynMap) -> ( let
_chnt = rule0 arg_name_ arg_tp_
_inh = rule1 _chnt _lhsIinhMap
_syn = rule2 _chnt _lhsIsynMap
_lhsOvchild :: VisageChild
_lhsOvchild = rule3 _inh _lhsIrulemap _syn arg_name_ arg_tp_
__result_ = T_Child_vOut1 _lhsOvchild
in __result_ )
in C_Child_s2 v1
rule0 = \ name_ tp_ ->
case tp_ of
NT nt _ _ -> nt
Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.")
Haskell t -> identifier ""
rule1 = \ _chnt ((_lhsIinhMap) :: Map Identifier Attributes) ->
Map.findWithDefault Map.empty _chnt _lhsIinhMap
rule2 = \ _chnt ((_lhsIsynMap) :: Map Identifier Attributes) ->
Map.findWithDefault Map.empty _chnt _lhsIsynMap
rule3 = \ _inh ((_lhsIrulemap) :: VisageRuleMap) _syn name_ tp_ ->
VChild name_ tp_ _inh _syn (getForField (getName name_) _lhsIrulemap)
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 act) (Inh_Children _lhsIinhMap _lhsIrulemap _lhsIsynMap) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg = T_Children_vIn4 _lhsIinhMap _lhsIrulemap _lhsIsynMap
(T_Children_vOut4 _lhsOvchildren) <- return (inv_Children_s5 sem arg)
return (Syn_Children _lhsOvchildren)
)
sem_Children :: Children -> T_Children
sem_Children list = Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list)
newtype T_Children = T_Children {
attach_T_Children :: Identity (T_Children_s5 )
}
newtype T_Children_s5 = C_Children_s5 {
inv_Children_s5 :: (T_Children_v4 )
}
data T_Children_s6 = C_Children_s6
type T_Children_v4 = (T_Children_vIn4 ) -> (T_Children_vOut4 )
data T_Children_vIn4 = T_Children_vIn4 (Map Identifier Attributes) (VisageRuleMap) (Map Identifier Attributes)
data T_Children_vOut4 = T_Children_vOut4 ([VisageChild])
sem_Children_Cons :: T_Child -> T_Children -> T_Children
sem_Children_Cons arg_hd_ arg_tl_ = T_Children (return st5) where
st5 = let
v4 :: T_Children_v4
v4 = \ (T_Children_vIn4 _lhsIinhMap _lhsIrulemap _lhsIsynMap) -> ( let
_hdX2 = Control.Monad.Identity.runIdentity (attach_T_Child (arg_hd_))
_tlX5 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_tl_))
(T_Child_vOut1 _hdIvchild) = inv_Child_s2 _hdX2 (T_Child_vIn1 _hdOinhMap _hdOrulemap _hdOsynMap)
(T_Children_vOut4 _tlIvchildren) = inv_Children_s5 _tlX5 (T_Children_vIn4 _tlOinhMap _tlOrulemap _tlOsynMap)
_lhsOvchildren :: [VisageChild]
_lhsOvchildren = rule4 _hdIvchild _tlIvchildren
_hdOinhMap = rule5 _lhsIinhMap
_hdOrulemap = rule6 _lhsIrulemap
_hdOsynMap = rule7 _lhsIsynMap
_tlOinhMap = rule8 _lhsIinhMap
_tlOrulemap = rule9 _lhsIrulemap
_tlOsynMap = rule10 _lhsIsynMap
__result_ = T_Children_vOut4 _lhsOvchildren
in __result_ )
in C_Children_s5 v4
rule4 = \ ((_hdIvchild) :: VisageChild) ((_tlIvchildren) :: [VisageChild]) ->
_hdIvchild : _tlIvchildren
rule5 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
_lhsIinhMap
rule6 = \ ((_lhsIrulemap) :: VisageRuleMap) ->
_lhsIrulemap
rule7 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
_lhsIsynMap
rule8 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
_lhsIinhMap
rule9 = \ ((_lhsIrulemap) :: VisageRuleMap) ->
_lhsIrulemap
rule10 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
_lhsIsynMap
sem_Children_Nil :: T_Children
sem_Children_Nil = T_Children (return st5) where
st5 = let
v4 :: T_Children_v4
v4 = \ (T_Children_vIn4 _lhsIinhMap _lhsIrulemap _lhsIsynMap) -> ( let
_lhsOvchildren :: [VisageChild]
_lhsOvchildren = rule11 ()
__result_ = T_Children_vOut4 _lhsOvchildren
in __result_ )
in C_Children_s5 v4
rule11 = \ (_ :: ()) ->
[]
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 act) (Inh_Expression ) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg = T_Expression_vIn7
(T_Expression_vOut7 _lhsOself) <- return (inv_Expression_s8 sem arg)
return (Syn_Expression _lhsOself)
)
sem_Expression :: Expression -> T_Expression
sem_Expression ( Expression pos_ tks_ ) = sem_Expression_Expression pos_ tks_
newtype T_Expression = T_Expression {
attach_T_Expression :: Identity (T_Expression_s8 )
}
newtype T_Expression_s8 = C_Expression_s8 {
inv_Expression_s8 :: (T_Expression_v7 )
}
data T_Expression_s9 = C_Expression_s9
type T_Expression_v7 = (T_Expression_vIn7 ) -> (T_Expression_vOut7 )
data T_Expression_vIn7 = T_Expression_vIn7
data T_Expression_vOut7 = T_Expression_vOut7 (Expression)
sem_Expression_Expression :: (Pos) -> ([HsToken]) -> T_Expression
sem_Expression_Expression arg_pos_ arg_tks_ = T_Expression (return st8) where
st8 = let
v7 :: T_Expression_v7
v7 = \ (T_Expression_vIn7 ) -> ( let
_self = rule12 arg_pos_ arg_tks_
_lhsOself :: Expression
_lhsOself = rule13 _self
__result_ = T_Expression_vOut7 _lhsOself
in __result_ )
in C_Expression_s8 v7
rule12 = \ pos_ tks_ ->
Expression pos_ tks_
rule13 = \ _self ->
_self
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 act) (Inh_Grammar ) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg = T_Grammar_vIn10
(T_Grammar_vOut10 _lhsOvisage) <- return (inv_Grammar_s11 sem arg)
return (Syn_Grammar _lhsOvisage)
)
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_
newtype T_Grammar = T_Grammar {
attach_T_Grammar :: Identity (T_Grammar_s11 )
}
newtype T_Grammar_s11 = C_Grammar_s11 {
inv_Grammar_s11 :: (T_Grammar_v10 )
}
data T_Grammar_s12 = C_Grammar_s12
type T_Grammar_v10 = (T_Grammar_vIn10 ) -> (T_Grammar_vOut10 )
data T_Grammar_vIn10 = T_Grammar_vIn10
data T_Grammar_vOut10 = T_Grammar_vOut10 (VisageGrammar)
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 _ _ _ _ arg_nonts_ _ _ _ _ _ _ _ _ _ = T_Grammar (return st11) where
st11 = let
v10 :: T_Grammar_v10
v10 = \ (T_Grammar_vIn10 ) -> ( let
_nontsX17 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_nonts_))
(T_Nonterminals_vOut16 _nontsIinhMap' _nontsIsynMap' _nontsIvnonts) = inv_Nonterminals_s17 _nontsX17 (T_Nonterminals_vIn16 _nontsOinhMap _nontsOsynMap)
_nontsOinhMap = rule14 _nontsIinhMap'
_nontsOsynMap = rule15 _nontsIsynMap'
_lhsOvisage :: VisageGrammar
_lhsOvisage = rule16 _nontsIvnonts
__result_ = T_Grammar_vOut10 _lhsOvisage
in __result_ )
in C_Grammar_s11 v10
rule14 = \ ((_nontsIinhMap') :: Map Identifier Attributes) ->
_nontsIinhMap'
rule15 = \ ((_nontsIsynMap') :: Map Identifier Attributes) ->
_nontsIsynMap'
rule16 = \ ((_nontsIvnonts) :: [VisageNonterminal]) ->
VGrammar _nontsIvnonts
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 act) (Inh_Nonterminal _lhsIinhMap _lhsIsynMap) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg = T_Nonterminal_vIn13 _lhsIinhMap _lhsIsynMap
(T_Nonterminal_vOut13 _lhsOinhMap' _lhsOsynMap' _lhsOvnont) <- return (inv_Nonterminal_s14 sem arg)
return (Syn_Nonterminal _lhsOinhMap' _lhsOsynMap' _lhsOvnont)
)
sem_Nonterminal :: Nonterminal -> T_Nonterminal
sem_Nonterminal ( Nonterminal nt_ params_ inh_ syn_ prods_ ) = sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ ( sem_Productions prods_ )
newtype T_Nonterminal = T_Nonterminal {
attach_T_Nonterminal :: Identity (T_Nonterminal_s14 )
}
newtype T_Nonterminal_s14 = C_Nonterminal_s14 {
inv_Nonterminal_s14 :: (T_Nonterminal_v13 )
}
data T_Nonterminal_s15 = C_Nonterminal_s15
type T_Nonterminal_v13 = (T_Nonterminal_vIn13 ) -> (T_Nonterminal_vOut13 )
data T_Nonterminal_vIn13 = T_Nonterminal_vIn13 (Map Identifier Attributes) (Map Identifier Attributes)
data T_Nonterminal_vOut13 = T_Nonterminal_vOut13 (Map Identifier Attributes) (Map Identifier Attributes) (VisageNonterminal)
sem_Nonterminal_Nonterminal :: (NontermIdent) -> ([Identifier]) -> (Attributes) -> (Attributes) -> T_Productions -> T_Nonterminal
sem_Nonterminal_Nonterminal arg_nt_ _ arg_inh_ arg_syn_ arg_prods_ = T_Nonterminal (return st14) where
st14 = let
v13 :: T_Nonterminal_v13
v13 = \ (T_Nonterminal_vIn13 _lhsIinhMap _lhsIsynMap) -> ( let
_prodsX29 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_))
(T_Productions_vOut28 _prodsIvprods) = inv_Productions_s29 _prodsX29 (T_Productions_vIn28 _prodsOinhMap _prodsOsynMap)
_lhsOinhMap' :: Map Identifier Attributes
_lhsOinhMap' = rule17 arg_inh_ arg_nt_
_lhsOsynMap' :: Map Identifier Attributes
_lhsOsynMap' = rule18 arg_nt_ arg_syn_
_lhsOvnont :: VisageNonterminal
_lhsOvnont = rule19 _prodsIvprods arg_inh_ arg_nt_ arg_syn_
_prodsOinhMap = rule20 _lhsIinhMap
_prodsOsynMap = rule21 _lhsIsynMap
__result_ = T_Nonterminal_vOut13 _lhsOinhMap' _lhsOsynMap' _lhsOvnont
in __result_ )
in C_Nonterminal_s14 v13
rule17 = \ inh_ nt_ ->
Map.singleton nt_ inh_
rule18 = \ nt_ syn_ ->
Map.singleton nt_ syn_
rule19 = \ ((_prodsIvprods) :: [VisageProduction]) inh_ nt_ syn_ ->
VNonterminal nt_ inh_ syn_ _prodsIvprods
rule20 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
_lhsIinhMap
rule21 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
_lhsIsynMap
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 act) (Inh_Nonterminals _lhsIinhMap _lhsIsynMap) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg = T_Nonterminals_vIn16 _lhsIinhMap _lhsIsynMap
(T_Nonterminals_vOut16 _lhsOinhMap' _lhsOsynMap' _lhsOvnonts) <- return (inv_Nonterminals_s17 sem arg)
return (Syn_Nonterminals _lhsOinhMap' _lhsOsynMap' _lhsOvnonts)
)
sem_Nonterminals :: Nonterminals -> T_Nonterminals
sem_Nonterminals list = Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list)
newtype T_Nonterminals = T_Nonterminals {
attach_T_Nonterminals :: Identity (T_Nonterminals_s17 )
}
newtype T_Nonterminals_s17 = C_Nonterminals_s17 {
inv_Nonterminals_s17 :: (T_Nonterminals_v16 )
}
data T_Nonterminals_s18 = C_Nonterminals_s18
type T_Nonterminals_v16 = (T_Nonterminals_vIn16 ) -> (T_Nonterminals_vOut16 )
data T_Nonterminals_vIn16 = T_Nonterminals_vIn16 (Map Identifier Attributes) (Map Identifier Attributes)
data T_Nonterminals_vOut16 = T_Nonterminals_vOut16 (Map Identifier Attributes) (Map Identifier Attributes) ([VisageNonterminal])
sem_Nonterminals_Cons :: T_Nonterminal -> T_Nonterminals -> T_Nonterminals
sem_Nonterminals_Cons arg_hd_ arg_tl_ = T_Nonterminals (return st17) where
st17 = let
v16 :: T_Nonterminals_v16
v16 = \ (T_Nonterminals_vIn16 _lhsIinhMap _lhsIsynMap) -> ( let
_hdX14 = Control.Monad.Identity.runIdentity (attach_T_Nonterminal (arg_hd_))
_tlX17 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_tl_))
(T_Nonterminal_vOut13 _hdIinhMap' _hdIsynMap' _hdIvnont) = inv_Nonterminal_s14 _hdX14 (T_Nonterminal_vIn13 _hdOinhMap _hdOsynMap)
(T_Nonterminals_vOut16 _tlIinhMap' _tlIsynMap' _tlIvnonts) = inv_Nonterminals_s17 _tlX17 (T_Nonterminals_vIn16 _tlOinhMap _tlOsynMap)
_lhsOvnonts :: [VisageNonterminal]
_lhsOvnonts = rule22 _hdIvnont _tlIvnonts
_lhsOinhMap' :: Map Identifier Attributes
_lhsOinhMap' = rule23 _hdIinhMap' _tlIinhMap'
_lhsOsynMap' :: Map Identifier Attributes
_lhsOsynMap' = rule24 _hdIsynMap' _tlIsynMap'
_hdOinhMap = rule25 _lhsIinhMap
_hdOsynMap = rule26 _lhsIsynMap
_tlOinhMap = rule27 _lhsIinhMap
_tlOsynMap = rule28 _lhsIsynMap
__result_ = T_Nonterminals_vOut16 _lhsOinhMap' _lhsOsynMap' _lhsOvnonts
in __result_ )
in C_Nonterminals_s17 v16
rule22 = \ ((_hdIvnont) :: VisageNonterminal) ((_tlIvnonts) :: [VisageNonterminal]) ->
_hdIvnont : _tlIvnonts
rule23 = \ ((_hdIinhMap') :: Map Identifier Attributes) ((_tlIinhMap') :: Map Identifier Attributes) ->
_hdIinhMap' `Map.union` _tlIinhMap'
rule24 = \ ((_hdIsynMap') :: Map Identifier Attributes) ((_tlIsynMap') :: Map Identifier Attributes) ->
_hdIsynMap' `Map.union` _tlIsynMap'
rule25 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
_lhsIinhMap
rule26 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
_lhsIsynMap
rule27 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
_lhsIinhMap
rule28 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
_lhsIsynMap
sem_Nonterminals_Nil :: T_Nonterminals
sem_Nonterminals_Nil = T_Nonterminals (return st17) where
st17 = let
v16 :: T_Nonterminals_v16
v16 = \ (T_Nonterminals_vIn16 _lhsIinhMap _lhsIsynMap) -> ( let
_lhsOvnonts :: [VisageNonterminal]
_lhsOvnonts = rule29 ()
_lhsOinhMap' :: Map Identifier Attributes
_lhsOinhMap' = rule30 ()
_lhsOsynMap' :: Map Identifier Attributes
_lhsOsynMap' = rule31 ()
__result_ = T_Nonterminals_vOut16 _lhsOinhMap' _lhsOsynMap' _lhsOvnonts
in __result_ )
in C_Nonterminals_s17 v16
rule29 = \ (_ :: ()) ->
[]
rule30 = \ (_ :: ()) ->
Map.empty
rule31 = \ (_ :: ()) ->
Map.empty
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 act) (Inh_Pattern ) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg = T_Pattern_vIn19
(T_Pattern_vOut19 _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpat) <- return (inv_Pattern_s20 sem arg)
return (Syn_Pattern _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpat)
)
sem_Pattern :: Pattern -> T_Pattern
sem_Pattern ( Constr name_ pats_ ) = sem_Pattern_Constr name_ ( sem_Patterns pats_ )
sem_Pattern ( Product pos_ pats_ ) = sem_Pattern_Product pos_ ( sem_Patterns pats_ )
sem_Pattern ( Alias field_ attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ )
sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ )
sem_Pattern ( Underscore pos_ ) = sem_Pattern_Underscore pos_
newtype T_Pattern = T_Pattern {
attach_T_Pattern :: Identity (T_Pattern_s20 )
}
newtype T_Pattern_s20 = C_Pattern_s20 {
inv_Pattern_s20 :: (T_Pattern_v19 )
}
data T_Pattern_s21 = C_Pattern_s21
type T_Pattern_v19 = (T_Pattern_vIn19 ) -> (T_Pattern_vOut19 )
data T_Pattern_vIn19 = T_Pattern_vIn19
data T_Pattern_vOut19 = T_Pattern_vOut19 (Pattern) ( [(Identifier,Identifier)] ) (Pattern) (VisagePattern)
sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern
sem_Pattern_Constr arg_name_ arg_pats_ = T_Pattern (return st20) where
st20 = let
v19 :: T_Pattern_v19
v19 = \ (T_Pattern_vIn19 ) -> ( let
_patsX23 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_))
(T_Patterns_vOut22 _patsIcopy _patsIfieldattrs _patsIself _patsIvpats) = inv_Patterns_s23 _patsX23 (T_Patterns_vIn22 )
_lhsOvpat :: VisagePattern
_lhsOvpat = rule32 _patsIvpats arg_name_
_lhsOfieldattrs :: [(Identifier,Identifier)]
_lhsOfieldattrs = rule33 _patsIfieldattrs
_copy = rule34 _patsIcopy arg_name_
_self = rule35 _patsIself arg_name_
_lhsOcopy :: Pattern
_lhsOcopy = rule36 _copy
_lhsOself :: Pattern
_lhsOself = rule37 _self
__result_ = T_Pattern_vOut19 _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpat
in __result_ )
in C_Pattern_s20 v19
rule32 = \ ((_patsIvpats) :: [VisagePattern]) name_ ->
VConstr name_ _patsIvpats
rule33 = \ ((_patsIfieldattrs) :: [(Identifier,Identifier)] ) ->
_patsIfieldattrs
rule34 = \ ((_patsIcopy) :: Patterns) name_ ->
Constr name_ _patsIcopy
rule35 = \ ((_patsIself) :: Patterns) name_ ->
Constr name_ _patsIself
rule36 = \ _copy ->
_copy
rule37 = \ _self ->
_self
sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern
sem_Pattern_Product arg_pos_ arg_pats_ = T_Pattern (return st20) where
st20 = let
v19 :: T_Pattern_v19
v19 = \ (T_Pattern_vIn19 ) -> ( let
_patsX23 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_))
(T_Patterns_vOut22 _patsIcopy _patsIfieldattrs _patsIself _patsIvpats) = inv_Patterns_s23 _patsX23 (T_Patterns_vIn22 )
_lhsOvpat :: VisagePattern
_lhsOvpat = rule38 _patsIvpats arg_pos_
_lhsOfieldattrs :: [(Identifier,Identifier)]
_lhsOfieldattrs = rule39 _patsIfieldattrs
_copy = rule40 _patsIcopy arg_pos_
_self = rule41 _patsIself arg_pos_
_lhsOcopy :: Pattern
_lhsOcopy = rule42 _copy
_lhsOself :: Pattern
_lhsOself = rule43 _self
__result_ = T_Pattern_vOut19 _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpat
in __result_ )
in C_Pattern_s20 v19
rule38 = \ ((_patsIvpats) :: [VisagePattern]) pos_ ->
VProduct pos_ _patsIvpats
rule39 = \ ((_patsIfieldattrs) :: [(Identifier,Identifier)] ) ->
_patsIfieldattrs
rule40 = \ ((_patsIcopy) :: Patterns) pos_ ->
Product pos_ _patsIcopy
rule41 = \ ((_patsIself) :: Patterns) pos_ ->
Product pos_ _patsIself
rule42 = \ _copy ->
_copy
rule43 = \ _self ->
_self
sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern
sem_Pattern_Alias arg_field_ arg_attr_ arg_pat_ = T_Pattern (return st20) where
st20 = let
v19 :: T_Pattern_v19
v19 = \ (T_Pattern_vIn19 ) -> ( let
_patX20 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_))
(T_Pattern_vOut19 _patIcopy _patIfieldattrs _patIself _patIvpat) = inv_Pattern_s20 _patX20 (T_Pattern_vIn19 )
_lhsOvpat :: VisagePattern
_lhsOvpat = rule44 _patIvpat _self arg_attr_ arg_field_
_lhsOfieldattrs :: [(Identifier,Identifier)]
_lhsOfieldattrs = rule45 arg_attr_ arg_field_
_copy = rule46 _patIcopy arg_attr_ arg_field_
_self = rule47 _patIself arg_attr_ arg_field_
_lhsOcopy :: Pattern
_lhsOcopy = rule48 _copy
_lhsOself :: Pattern
_lhsOself = rule49 _self
__result_ = T_Pattern_vOut19 _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpat
in __result_ )
in C_Pattern_s20 v19
rule44 = \ ((_patIvpat) :: VisagePattern) _self attr_ field_ ->
if (isVar _self)
then VVar field_ attr_
else VAlias field_ attr_ _patIvpat
rule45 = \ attr_ field_ ->
[(field_, attr_)]
rule46 = \ ((_patIcopy) :: Pattern) attr_ field_ ->
Alias field_ attr_ _patIcopy
rule47 = \ ((_patIself) :: Pattern) attr_ field_ ->
Alias field_ attr_ _patIself
rule48 = \ _copy ->
_copy
rule49 = \ _self ->
_self
sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern
sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st20) where
st20 = let
v19 :: T_Pattern_v19
v19 = \ (T_Pattern_vIn19 ) -> ( let
_patX20 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_))
(T_Pattern_vOut19 _patIcopy _patIfieldattrs _patIself _patIvpat) = inv_Pattern_s20 _patX20 (T_Pattern_vIn19 )
_lhsOfieldattrs :: [(Identifier,Identifier)]
_lhsOfieldattrs = rule50 _patIfieldattrs
_copy = rule51 _patIcopy
_self = rule52 _patIself
_lhsOcopy :: Pattern
_lhsOcopy = rule53 _copy
_lhsOself :: Pattern
_lhsOself = rule54 _self
_lhsOvpat :: VisagePattern
_lhsOvpat = rule55 _patIvpat
__result_ = T_Pattern_vOut19 _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpat
in __result_ )
in C_Pattern_s20 v19
rule50 = \ ((_patIfieldattrs) :: [(Identifier,Identifier)] ) ->
_patIfieldattrs
rule51 = \ ((_patIcopy) :: Pattern) ->
Irrefutable _patIcopy
rule52 = \ ((_patIself) :: Pattern) ->
Irrefutable _patIself
rule53 = \ _copy ->
_copy
rule54 = \ _self ->
_self
rule55 = \ ((_patIvpat) :: VisagePattern) ->
_patIvpat
sem_Pattern_Underscore :: (Pos) -> T_Pattern
sem_Pattern_Underscore arg_pos_ = T_Pattern (return st20) where
st20 = let
v19 :: T_Pattern_v19
v19 = \ (T_Pattern_vIn19 ) -> ( let
_lhsOvpat :: VisagePattern
_lhsOvpat = rule56 arg_pos_
_lhsOfieldattrs :: [(Identifier,Identifier)]
_lhsOfieldattrs = rule57 ()
_copy = rule58 arg_pos_
_self = rule59 arg_pos_
_lhsOcopy :: Pattern
_lhsOcopy = rule60 _copy
_lhsOself :: Pattern
_lhsOself = rule61 _self
__result_ = T_Pattern_vOut19 _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpat
in __result_ )
in C_Pattern_s20 v19
rule56 = \ pos_ ->
VUnderscore pos_
rule57 = \ (_ :: ()) ->
[]
rule58 = \ pos_ ->
Underscore pos_
rule59 = \ pos_ ->
Underscore pos_
rule60 = \ _copy ->
_copy
rule61 = \ _self ->
_self
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 act) (Inh_Patterns ) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg = T_Patterns_vIn22
(T_Patterns_vOut22 _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpats) <- return (inv_Patterns_s23 sem arg)
return (Syn_Patterns _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpats)
)
sem_Patterns :: Patterns -> T_Patterns
sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list)
newtype T_Patterns = T_Patterns {
attach_T_Patterns :: Identity (T_Patterns_s23 )
}
newtype T_Patterns_s23 = C_Patterns_s23 {
inv_Patterns_s23 :: (T_Patterns_v22 )
}
data T_Patterns_s24 = C_Patterns_s24
type T_Patterns_v22 = (T_Patterns_vIn22 ) -> (T_Patterns_vOut22 )
data T_Patterns_vIn22 = T_Patterns_vIn22
data T_Patterns_vOut22 = T_Patterns_vOut22 (Patterns) ( [(Identifier,Identifier)] ) (Patterns) ([VisagePattern])
sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns
sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st23) where
st23 = let
v22 :: T_Patterns_v22
v22 = \ (T_Patterns_vIn22 ) -> ( let
_hdX20 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_))
_tlX23 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_))
(T_Pattern_vOut19 _hdIcopy _hdIfieldattrs _hdIself _hdIvpat) = inv_Pattern_s20 _hdX20 (T_Pattern_vIn19 )
(T_Patterns_vOut22 _tlIcopy _tlIfieldattrs _tlIself _tlIvpats) = inv_Patterns_s23 _tlX23 (T_Patterns_vIn22 )
_lhsOvpats :: [VisagePattern]
_lhsOvpats = rule62 _hdIvpat _tlIvpats
_lhsOfieldattrs :: [(Identifier,Identifier)]
_lhsOfieldattrs = rule63 _hdIfieldattrs _tlIfieldattrs
_copy = rule64 _hdIcopy _tlIcopy
_self = rule65 _hdIself _tlIself
_lhsOcopy :: Patterns
_lhsOcopy = rule66 _copy
_lhsOself :: Patterns
_lhsOself = rule67 _self
__result_ = T_Patterns_vOut22 _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpats
in __result_ )
in C_Patterns_s23 v22
rule62 = \ ((_hdIvpat) :: VisagePattern) ((_tlIvpats) :: [VisagePattern]) ->
_hdIvpat : _tlIvpats
rule63 = \ ((_hdIfieldattrs) :: [(Identifier,Identifier)] ) ((_tlIfieldattrs) :: [(Identifier,Identifier)] ) ->
_hdIfieldattrs ++ _tlIfieldattrs
rule64 = \ ((_hdIcopy) :: Pattern) ((_tlIcopy) :: Patterns) ->
(:) _hdIcopy _tlIcopy
rule65 = \ ((_hdIself) :: Pattern) ((_tlIself) :: Patterns) ->
(:) _hdIself _tlIself
rule66 = \ _copy ->
_copy
rule67 = \ _self ->
_self
sem_Patterns_Nil :: T_Patterns
sem_Patterns_Nil = T_Patterns (return st23) where
st23 = let
v22 :: T_Patterns_v22
v22 = \ (T_Patterns_vIn22 ) -> ( let
_lhsOvpats :: [VisagePattern]
_lhsOvpats = rule68 ()
_lhsOfieldattrs :: [(Identifier,Identifier)]
_lhsOfieldattrs = rule69 ()
_copy = rule70 ()
_self = rule71 ()
_lhsOcopy :: Patterns
_lhsOcopy = rule72 _copy
_lhsOself :: Patterns
_lhsOself = rule73 _self
__result_ = T_Patterns_vOut22 _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpats
in __result_ )
in C_Patterns_s23 v22
rule68 = \ (_ :: ()) ->
[]
rule69 = \ (_ :: ()) ->
[]
rule70 = \ (_ :: ()) ->
[]
rule71 = \ (_ :: ()) ->
[]
rule72 = \ _copy ->
_copy
rule73 = \ _self ->
_self
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 act) (Inh_Production _lhsIinhMap _lhsIsynMap) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg = T_Production_vIn25 _lhsIinhMap _lhsIsynMap
(T_Production_vOut25 _lhsOvprod) <- return (inv_Production_s26 sem arg)
return (Syn_Production _lhsOvprod)
)
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_
newtype T_Production = T_Production {
attach_T_Production :: Identity (T_Production_s26 )
}
newtype T_Production_s26 = C_Production_s26 {
inv_Production_s26 :: (T_Production_v25 )
}
data T_Production_s27 = C_Production_s27
type T_Production_v25 = (T_Production_vIn25 ) -> (T_Production_vOut25 )
data T_Production_vIn25 = T_Production_vIn25 (Map Identifier Attributes) (Map Identifier Attributes)
data T_Production_vOut25 = T_Production_vOut25 (VisageProduction)
sem_Production_Production :: (ConstructorIdent) -> ([Identifier]) -> ([Type]) -> T_Children -> T_Rules -> T_TypeSigs -> (MaybeMacro) -> T_Production
sem_Production_Production arg_con_ _ _ arg_children_ arg_rules_ arg_typeSigs_ _ = T_Production (return st26) where
st26 = let
v25 :: T_Production_v25
v25 = \ (T_Production_vIn25 _lhsIinhMap _lhsIsynMap) -> ( let
_childrenX5 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_children_))
_rulesX35 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_rules_))
_typeSigsX41 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_typeSigs_))
(T_Children_vOut4 _childrenIvchildren) = inv_Children_s5 _childrenX5 (T_Children_vIn4 _childrenOinhMap _childrenOrulemap _childrenOsynMap)
(T_Rules_vOut34 _rulesIvrules) = inv_Rules_s35 _rulesX35 (T_Rules_vIn34 )
(T_TypeSigs_vOut40 ) = inv_TypeSigs_s41 _typeSigsX41 (T_TypeSigs_vIn40 )
_lhsOvprod :: VisageProduction
_lhsOvprod = rule74 _childrenIvchildren _lhsrules _locrules arg_con_
_splitVRules = rule75 _rulesIvrules
_locrules = rule76 _splitVRules
_lhsrules = rule77 _splitVRules
_childrenOrulemap = rule78 _splitVRules
_childrenOinhMap = rule79 _lhsIinhMap
_childrenOsynMap = rule80 _lhsIsynMap
__result_ = T_Production_vOut25 _lhsOvprod
in __result_ )
in C_Production_s26 v25
rule74 = \ ((_childrenIvchildren) :: [VisageChild]) _lhsrules _locrules con_ ->
VProduction con_ _childrenIvchildren _lhsrules _locrules
rule75 = \ ((_rulesIvrules) :: [VisageRule]) ->
splitVRules _rulesIvrules
rule76 = \ _splitVRules ->
getForField "loc" _splitVRules
rule77 = \ _splitVRules ->
getForField "lhs" _splitVRules
rule78 = \ _splitVRules ->
_splitVRules
rule79 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
_lhsIinhMap
rule80 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
_lhsIsynMap
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 act) (Inh_Productions _lhsIinhMap _lhsIsynMap) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg = T_Productions_vIn28 _lhsIinhMap _lhsIsynMap
(T_Productions_vOut28 _lhsOvprods) <- return (inv_Productions_s29 sem arg)
return (Syn_Productions _lhsOvprods)
)
sem_Productions :: Productions -> T_Productions
sem_Productions list = Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list)
newtype T_Productions = T_Productions {
attach_T_Productions :: Identity (T_Productions_s29 )
}
newtype T_Productions_s29 = C_Productions_s29 {
inv_Productions_s29 :: (T_Productions_v28 )
}
data T_Productions_s30 = C_Productions_s30
type T_Productions_v28 = (T_Productions_vIn28 ) -> (T_Productions_vOut28 )
data T_Productions_vIn28 = T_Productions_vIn28 (Map Identifier Attributes) (Map Identifier Attributes)
data T_Productions_vOut28 = T_Productions_vOut28 ([VisageProduction])
sem_Productions_Cons :: T_Production -> T_Productions -> T_Productions
sem_Productions_Cons arg_hd_ arg_tl_ = T_Productions (return st29) where
st29 = let
v28 :: T_Productions_v28
v28 = \ (T_Productions_vIn28 _lhsIinhMap _lhsIsynMap) -> ( let
_hdX26 = Control.Monad.Identity.runIdentity (attach_T_Production (arg_hd_))
_tlX29 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_tl_))
(T_Production_vOut25 _hdIvprod) = inv_Production_s26 _hdX26 (T_Production_vIn25 _hdOinhMap _hdOsynMap)
(T_Productions_vOut28 _tlIvprods) = inv_Productions_s29 _tlX29 (T_Productions_vIn28 _tlOinhMap _tlOsynMap)
_lhsOvprods :: [VisageProduction]
_lhsOvprods = rule81 _hdIvprod _tlIvprods
_hdOinhMap = rule82 _lhsIinhMap
_hdOsynMap = rule83 _lhsIsynMap
_tlOinhMap = rule84 _lhsIinhMap
_tlOsynMap = rule85 _lhsIsynMap
__result_ = T_Productions_vOut28 _lhsOvprods
in __result_ )
in C_Productions_s29 v28
rule81 = \ ((_hdIvprod) :: VisageProduction) ((_tlIvprods) :: [VisageProduction]) ->
_hdIvprod : _tlIvprods
rule82 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
_lhsIinhMap
rule83 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
_lhsIsynMap
rule84 = \ ((_lhsIinhMap) :: Map Identifier Attributes) ->
_lhsIinhMap
rule85 = \ ((_lhsIsynMap) :: Map Identifier Attributes) ->
_lhsIsynMap
sem_Productions_Nil :: T_Productions
sem_Productions_Nil = T_Productions (return st29) where
st29 = let
v28 :: T_Productions_v28
v28 = \ (T_Productions_vIn28 _lhsIinhMap _lhsIsynMap) -> ( let
_lhsOvprods :: [VisageProduction]
_lhsOvprods = rule86 ()
__result_ = T_Productions_vOut28 _lhsOvprods
in __result_ )
in C_Productions_s29 v28
rule86 = \ (_ :: ()) ->
[]
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 act) (Inh_Rule ) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg = T_Rule_vIn31
(T_Rule_vOut31 _lhsOvrule) <- return (inv_Rule_s32 sem arg)
return (Syn_Rule _lhsOvrule)
)
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_
newtype T_Rule = T_Rule {
attach_T_Rule :: Identity (T_Rule_s32 )
}
newtype T_Rule_s32 = C_Rule_s32 {
inv_Rule_s32 :: (T_Rule_v31 )
}
data T_Rule_s33 = C_Rule_s33
type T_Rule_v31 = (T_Rule_vIn31 ) -> (T_Rule_vOut31 )
data T_Rule_vIn31 = T_Rule_vIn31
data T_Rule_vOut31 = T_Rule_vOut31 (VisageRule)
sem_Rule_Rule :: (Maybe Identifier) -> T_Pattern -> T_Expression -> (Bool) -> (String) -> (Bool) -> (Bool) -> (Bool) -> (Maybe Error) -> (Bool) -> T_Rule
sem_Rule_Rule _ arg_pattern_ arg_rhs_ arg_owrt_ _ _ _ _ _ _ = T_Rule (return st32) where
st32 = let
v31 :: T_Rule_v31
v31 = \ (T_Rule_vIn31 ) -> ( let
_patternX20 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_))
_rhsX8 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_rhs_))
(T_Pattern_vOut19 _patternIcopy _patternIfieldattrs _patternIself _patternIvpat) = inv_Pattern_s20 _patternX20 (T_Pattern_vIn19 )
(T_Expression_vOut7 _rhsIself) = inv_Expression_s8 _rhsX8 (T_Expression_vIn7 )
_lhsOvrule :: VisageRule
_lhsOvrule = rule87 _patternIfieldattrs _patternIvpat _rhsIself arg_owrt_
__result_ = T_Rule_vOut31 _lhsOvrule
in __result_ )
in C_Rule_s32 v31
rule87 = \ ((_patternIfieldattrs) :: [(Identifier,Identifier)] ) ((_patternIvpat) :: VisagePattern) ((_rhsIself) :: Expression) owrt_ ->
VRule _patternIfieldattrs undefined _patternIvpat _rhsIself owrt_
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 act) (Inh_Rules ) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg = T_Rules_vIn34
(T_Rules_vOut34 _lhsOvrules) <- return (inv_Rules_s35 sem arg)
return (Syn_Rules _lhsOvrules)
)
sem_Rules :: Rules -> T_Rules
sem_Rules list = Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list)
newtype T_Rules = T_Rules {
attach_T_Rules :: Identity (T_Rules_s35 )
}
newtype T_Rules_s35 = C_Rules_s35 {
inv_Rules_s35 :: (T_Rules_v34 )
}
data T_Rules_s36 = C_Rules_s36
type T_Rules_v34 = (T_Rules_vIn34 ) -> (T_Rules_vOut34 )
data T_Rules_vIn34 = T_Rules_vIn34
data T_Rules_vOut34 = T_Rules_vOut34 ([VisageRule])
sem_Rules_Cons :: T_Rule -> T_Rules -> T_Rules
sem_Rules_Cons arg_hd_ arg_tl_ = T_Rules (return st35) where
st35 = let
v34 :: T_Rules_v34
v34 = \ (T_Rules_vIn34 ) -> ( let
_hdX32 = Control.Monad.Identity.runIdentity (attach_T_Rule (arg_hd_))
_tlX35 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_tl_))
(T_Rule_vOut31 _hdIvrule) = inv_Rule_s32 _hdX32 (T_Rule_vIn31 )
(T_Rules_vOut34 _tlIvrules) = inv_Rules_s35 _tlX35 (T_Rules_vIn34 )
_lhsOvrules :: [VisageRule]
_lhsOvrules = rule88 _hdIvrule _tlIvrules
__result_ = T_Rules_vOut34 _lhsOvrules
in __result_ )
in C_Rules_s35 v34
rule88 = \ ((_hdIvrule) :: VisageRule) ((_tlIvrules) :: [VisageRule]) ->
_hdIvrule : _tlIvrules
sem_Rules_Nil :: T_Rules
sem_Rules_Nil = T_Rules (return st35) where
st35 = let
v34 :: T_Rules_v34
v34 = \ (T_Rules_vIn34 ) -> ( let
_lhsOvrules :: [VisageRule]
_lhsOvrules = rule89 ()
__result_ = T_Rules_vOut34 _lhsOvrules
in __result_ )
in C_Rules_s35 v34
rule89 = \ (_ :: ()) ->
[]
data Inh_TypeSig = Inh_TypeSig { }
data Syn_TypeSig = Syn_TypeSig { }
wrap_TypeSig :: T_TypeSig -> Inh_TypeSig -> (Syn_TypeSig )
wrap_TypeSig (T_TypeSig act) (Inh_TypeSig ) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg = T_TypeSig_vIn37
(T_TypeSig_vOut37 ) <- return (inv_TypeSig_s38 sem arg)
return (Syn_TypeSig )
)
sem_TypeSig :: TypeSig -> T_TypeSig
sem_TypeSig ( TypeSig name_ tp_ ) = sem_TypeSig_TypeSig name_ tp_
newtype T_TypeSig = T_TypeSig {
attach_T_TypeSig :: Identity (T_TypeSig_s38 )
}
newtype T_TypeSig_s38 = C_TypeSig_s38 {
inv_TypeSig_s38 :: (T_TypeSig_v37 )
}
data T_TypeSig_s39 = C_TypeSig_s39
type T_TypeSig_v37 = (T_TypeSig_vIn37 ) -> (T_TypeSig_vOut37 )
data T_TypeSig_vIn37 = T_TypeSig_vIn37
data T_TypeSig_vOut37 = T_TypeSig_vOut37
sem_TypeSig_TypeSig :: (Identifier) -> (Type) -> T_TypeSig
sem_TypeSig_TypeSig _ _ = T_TypeSig (return st38) where
st38 = let
v37 :: T_TypeSig_v37
v37 = \ (T_TypeSig_vIn37 ) -> ( let
__result_ = T_TypeSig_vOut37
in __result_ )
in C_TypeSig_s38 v37
data Inh_TypeSigs = Inh_TypeSigs { }
data Syn_TypeSigs = Syn_TypeSigs { }
wrap_TypeSigs :: T_TypeSigs -> Inh_TypeSigs -> (Syn_TypeSigs )
wrap_TypeSigs (T_TypeSigs act) (Inh_TypeSigs ) =
Control.Monad.Identity.runIdentity (
do sem <- act
let arg = T_TypeSigs_vIn40
(T_TypeSigs_vOut40 ) <- return (inv_TypeSigs_s41 sem arg)
return (Syn_TypeSigs )
)
sem_TypeSigs :: TypeSigs -> T_TypeSigs
sem_TypeSigs list = Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list)
newtype T_TypeSigs = T_TypeSigs {
attach_T_TypeSigs :: Identity (T_TypeSigs_s41 )
}
newtype T_TypeSigs_s41 = C_TypeSigs_s41 {
inv_TypeSigs_s41 :: (T_TypeSigs_v40 )
}
data T_TypeSigs_s42 = C_TypeSigs_s42
type T_TypeSigs_v40 = (T_TypeSigs_vIn40 ) -> (T_TypeSigs_vOut40 )
data T_TypeSigs_vIn40 = T_TypeSigs_vIn40
data T_TypeSigs_vOut40 = T_TypeSigs_vOut40
sem_TypeSigs_Cons :: T_TypeSig -> T_TypeSigs -> T_TypeSigs
sem_TypeSigs_Cons arg_hd_ arg_tl_ = T_TypeSigs (return st41) where
st41 = let
v40 :: T_TypeSigs_v40
v40 = \ (T_TypeSigs_vIn40 ) -> ( let
_hdX38 = Control.Monad.Identity.runIdentity (attach_T_TypeSig (arg_hd_))
_tlX41 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_tl_))
(T_TypeSig_vOut37 ) = inv_TypeSig_s38 _hdX38 (T_TypeSig_vIn37 )
(T_TypeSigs_vOut40 ) = inv_TypeSigs_s41 _tlX41 (T_TypeSigs_vIn40 )
__result_ = T_TypeSigs_vOut40
in __result_ )
in C_TypeSigs_s41 v40
sem_TypeSigs_Nil :: T_TypeSigs
sem_TypeSigs_Nil = T_TypeSigs (return st41) where
st41 = let
v40 :: T_TypeSigs_v40
v40 = \ (T_TypeSigs_vIn40 ) -> ( let
__result_ = T_TypeSigs_vOut40
in __result_ )
in C_TypeSigs_s41 v40