uuagc-0.9.6: src-derived/Desugar.hs
-- UUAGC 0.9.5 (Desugar.ag)
module Desugar where
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Map(Map)
import qualified UU.DData.Seq as Seq
import UU.DData.Seq(Seq,(<>))
import UU.Scanner.Position(Pos(..))
import Maybe
import Data.List(intersperse)
import AbstractSyntax
import ErrorMessages
import Options
import HsToken
import HsTokenScanner
import TokenDef
-- AbstractSyntax.ag imports
import Data.Set(Set)
import Data.Map(Map)
import Patterns (Pattern(..),Patterns)
import Expression (Expression(..))
import CommonTypes
-- Patterns.ag imports
import UU.Scanner.Position(Pos)
import CommonTypes (ConstructorIdent,Identifier)
import UU.Scanner.Position(Pos)
import HsToken
import CommonTypes
import UU.Scanner.Position(Pos)
addl :: Int -> Pos -> Pos
addl n (Pos l c f) = Pos (l+n) c f
maybeError :: a -> Error -> Maybe a -> (a, Seq Error)
maybeError def err mb
= maybe (def, Seq.single err) (\r -> (r, Seq.empty)) mb
findField :: Identifier -> Identifier -> [(Identifier,Identifier)] -> Maybe Identifier
findField fld attr list
| fld == _FIRST = f list
| fld == _LAST = f (reverse list)
| otherwise = Just fld
where
f = lookup attr
mergeAttributes :: AttrMap -> AttrMap -> AttrMap
mergeAttributes = Map.unionWith $ Map.unionWith $ Set.union
-- Child -------------------------------------------------------
{-
visit 0:
synthesized attributes:
childInhs : [(Identifier, Identifier)]
childSyns : [(Identifier, Identifier)]
output : SELF
alternatives:
alternative Child:
child name : {Identifier}
child tp : {Type}
child inh : {Attributes}
child syn : {Attributes}
child higherOrder : {Bool}
visit 0:
local output : _
-}
-- cata
sem_Child :: Child ->
T_Child
sem_Child (Child _name _tp _inh _syn _higherOrder) =
(sem_Child_Child _name _tp _inh _syn _higherOrder)
-- semantic domain
newtype T_Child = T_Child (( ([(Identifier, Identifier)]),([(Identifier, Identifier)]),Child))
data Inh_Child = Inh_Child {}
data Syn_Child = Syn_Child {childInhs_Syn_Child :: [(Identifier, Identifier)],childSyns_Syn_Child :: [(Identifier, Identifier)],output_Syn_Child :: Child}
wrap_Child (T_Child sem) (Inh_Child ) =
(let ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput) =
(sem )
in (Syn_Child _lhsOchildInhs _lhsOchildSyns _lhsOoutput))
sem_Child_Child :: Identifier ->
Type ->
Attributes ->
Attributes ->
Bool ->
T_Child
sem_Child_Child name_ tp_ inh_ syn_ higherOrder_ =
(T_Child (let _lhsOchildInhs :: ([(Identifier, Identifier)])
_lhsOchildSyns :: ([(Identifier, Identifier)])
_lhsOoutput :: Child
-- "Desugar.ag"(line 123, column 7)
_lhsOchildInhs =
[(i, name_) | i <- Map.keys inh_ ]
-- "Desugar.ag"(line 124, column 7)
_lhsOchildSyns =
[(s, name_) | s <- Map.keys syn_ ]
-- self rule
_output =
Child name_ tp_ inh_ syn_ higherOrder_
-- self rule
_lhsOoutput =
_output
in ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput)))
-- Children ----------------------------------------------------
{-
visit 0:
synthesized attributes:
childInhs : [(Identifier, Identifier)]
childSyns : [(Identifier, Identifier)]
output : SELF
alternatives:
alternative Cons:
child hd : Child
child tl : Children
visit 0:
local output : _
alternative Nil:
visit 0:
local output : _
-}
-- cata
sem_Children :: Children ->
T_Children
sem_Children list =
(Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list))
-- semantic domain
newtype T_Children = T_Children (( ([(Identifier, Identifier)]),([(Identifier, Identifier)]),Children))
data Inh_Children = Inh_Children {}
data Syn_Children = Syn_Children {childInhs_Syn_Children :: [(Identifier, Identifier)],childSyns_Syn_Children :: [(Identifier, Identifier)],output_Syn_Children :: Children}
wrap_Children (T_Children sem) (Inh_Children ) =
(let ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput) =
(sem )
in (Syn_Children _lhsOchildInhs _lhsOchildSyns _lhsOoutput))
sem_Children_Cons :: T_Child ->
T_Children ->
T_Children
sem_Children_Cons (T_Child hd_) (T_Children tl_) =
(T_Children (let _lhsOchildInhs :: ([(Identifier, Identifier)])
_lhsOchildSyns :: ([(Identifier, Identifier)])
_lhsOoutput :: Children
_hdIchildInhs :: ([(Identifier, Identifier)])
_hdIchildSyns :: ([(Identifier, Identifier)])
_hdIoutput :: Child
_tlIchildInhs :: ([(Identifier, Identifier)])
_tlIchildSyns :: ([(Identifier, Identifier)])
_tlIoutput :: Children
-- use rule "Desugar.ag"(line 118, column 48)
_lhsOchildInhs =
_hdIchildInhs ++ _tlIchildInhs
-- use rule "Desugar.ag"(line 118, column 48)
_lhsOchildSyns =
_hdIchildSyns ++ _tlIchildSyns
-- self rule
_output =
(:) _hdIoutput _tlIoutput
-- self rule
_lhsOoutput =
_output
( _hdIchildInhs,_hdIchildSyns,_hdIoutput) =
(hd_ )
( _tlIchildInhs,_tlIchildSyns,_tlIoutput) =
(tl_ )
in ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput)))
sem_Children_Nil :: T_Children
sem_Children_Nil =
(T_Children (let _lhsOchildInhs :: ([(Identifier, Identifier)])
_lhsOchildSyns :: ([(Identifier, Identifier)])
_lhsOoutput :: Children
-- use rule "Desugar.ag"(line 118, column 48)
_lhsOchildInhs =
[]
-- use rule "Desugar.ag"(line 118, column 48)
_lhsOchildSyns =
[]
-- self rule
_output =
[]
-- self rule
_lhsOoutput =
_output
in ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput)))
-- Expression --------------------------------------------------
{-
visit 0:
inherited attributes:
childInhs : [(Identifier, Identifier)]
childSyns : [(Identifier, Identifier)]
con : ConstructorIdent
nt : NontermIdent
options : Options
ruleDescr : String
synthesized attributes:
errors : Seq Error
output : SELF
alternatives:
alternative Expression:
child pos : {Pos}
child tks : {[HsToken]}
visit 0:
local _tup1 : _
local tks' : _
local output : _
-}
-- cata
sem_Expression :: Expression ->
T_Expression
sem_Expression (Expression _pos _tks) =
(sem_Expression_Expression _pos _tks)
-- semantic domain
newtype T_Expression = T_Expression (([(Identifier, Identifier)]) ->
([(Identifier, Identifier)]) ->
ConstructorIdent ->
NontermIdent ->
Options ->
String ->
( (Seq Error),Expression))
data Inh_Expression = Inh_Expression {childInhs_Inh_Expression :: [(Identifier, Identifier)],childSyns_Inh_Expression :: [(Identifier, Identifier)],con_Inh_Expression :: ConstructorIdent,nt_Inh_Expression :: NontermIdent,options_Inh_Expression :: Options,ruleDescr_Inh_Expression :: String}
data Syn_Expression = Syn_Expression {errors_Syn_Expression :: Seq Error,output_Syn_Expression :: Expression}
wrap_Expression (T_Expression sem) (Inh_Expression _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIoptions _lhsIruleDescr) =
(let ( _lhsOerrors,_lhsOoutput) =
(sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIoptions _lhsIruleDescr)
in (Syn_Expression _lhsOerrors _lhsOoutput))
sem_Expression_Expression :: Pos ->
([HsToken]) ->
T_Expression
sem_Expression_Expression pos_ tks_ =
(T_Expression (\ _lhsIchildInhs
_lhsIchildSyns
_lhsIcon
_lhsInt
_lhsIoptions
_lhsIruleDescr ->
(let _lhsOerrors :: (Seq Error)
_lhsOoutput :: Expression
-- "Desugar.ag"(line 42, column 7)
__tup1 =
let inh = Inh_HsTokensRoot { childInhs_Inh_HsTokensRoot = _lhsIchildInhs
, childSyns_Inh_HsTokensRoot = _lhsIchildSyns
, nt_Inh_HsTokensRoot = _lhsInt
, con_Inh_HsTokensRoot = _lhsIcon
, ruleDescr_Inh_HsTokensRoot = _lhsIruleDescr
, useFieldIdent_Inh_HsTokensRoot = genUseTraces _lhsIoptions
}
sem = sem_HsTokensRoot (HsTokensRoot tks_)
syn = wrap_HsTokensRoot sem inh
in (tks_Syn_HsTokensRoot syn, errors_Syn_HsTokensRoot syn)
-- "Desugar.ag"(line 42, column 7)
(_tks',_) =
__tup1
-- "Desugar.ag"(line 42, column 7)
(_,_lhsOerrors) =
__tup1
-- "Desugar.ag"(line 52, column 7)
_lhsOoutput =
Expression pos_ _tks'
-- self rule
_output =
Expression pos_ tks_
in ( _lhsOerrors,_lhsOoutput))))
-- Grammar -----------------------------------------------------
{-
visit 0:
inherited attributes:
forcedIrrefutables : AttrMap
options : Options
synthesized attributes:
allAttributes : AttrMap
errors : Seq Error
output : SELF
alternatives:
alternative Grammar:
child typeSyns : {TypeSyns}
child useMap : {UseMap}
child derivings : {Derivings}
child wrappers : {Set NontermIdent}
child nonts : Nonterminals
child pragmas : {PragmaMap}
child manualAttrOrderMap : {AttrOrderMap}
child paramMap : {ParamMap}
child contextMap : {ContextMap}
visit 0:
local output : _
-}
-- cata
sem_Grammar :: Grammar ->
T_Grammar
sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap) =
(sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts) _pragmas _manualAttrOrderMap _paramMap _contextMap)
-- semantic domain
newtype T_Grammar = T_Grammar (AttrMap ->
Options ->
( AttrMap,(Seq Error),Grammar))
data Inh_Grammar = Inh_Grammar {forcedIrrefutables_Inh_Grammar :: AttrMap,options_Inh_Grammar :: Options}
data Syn_Grammar = Syn_Grammar {allAttributes_Syn_Grammar :: AttrMap,errors_Syn_Grammar :: Seq Error,output_Syn_Grammar :: Grammar}
wrap_Grammar (T_Grammar sem) (Inh_Grammar _lhsIforcedIrrefutables _lhsIoptions) =
(let ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) =
(sem _lhsIforcedIrrefutables _lhsIoptions)
in (Syn_Grammar _lhsOallAttributes _lhsOerrors _lhsOoutput))
sem_Grammar_Grammar :: TypeSyns ->
UseMap ->
Derivings ->
(Set NontermIdent) ->
T_Nonterminals ->
PragmaMap ->
AttrOrderMap ->
ParamMap ->
ContextMap ->
T_Grammar
sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ =
(T_Grammar (\ _lhsIforcedIrrefutables
_lhsIoptions ->
(let _lhsOallAttributes :: AttrMap
_lhsOerrors :: (Seq Error)
_lhsOoutput :: Grammar
_nontsOforcedIrrefutables :: AttrMap
_nontsOoptions :: Options
_nontsIallAttributes :: AttrMap
_nontsIerrors :: (Seq Error)
_nontsIoutput :: Nonterminals
-- use rule "Desugar.ag"(line 189, column 23)
_lhsOallAttributes =
_nontsIallAttributes
-- use rule "Desugar.ag"(line 31, column 144)
_lhsOerrors =
_nontsIerrors
-- self rule
_output =
Grammar typeSyns_ useMap_ derivings_ wrappers_ _nontsIoutput pragmas_ manualAttrOrderMap_ paramMap_ contextMap_
-- self rule
_lhsOoutput =
_output
-- copy rule (down)
_nontsOforcedIrrefutables =
_lhsIforcedIrrefutables
-- copy rule (down)
_nontsOoptions =
_lhsIoptions
( _nontsIallAttributes,_nontsIerrors,_nontsIoutput) =
(nonts_ _nontsOforcedIrrefutables _nontsOoptions)
in ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput))))
-- HsToken -----------------------------------------------------
{-
visit 0:
inherited attributes:
childInhs : [(Identifier, Identifier)]
childSyns : [(Identifier, Identifier)]
con : ConstructorIdent
nt : NontermIdent
ruleDescr : String
useFieldIdent : Bool
chained attribute:
addLines : Int
synthesized attributes:
errors : Seq Error
tks : SELF
alternatives:
alternative AGField:
child field : {Identifier}
child attr : {Identifier}
child pos : {Pos}
child rdesc : {Maybe String}
visit 0:
local mField : _
local field' : _
local tks : _
alternative AGLocal:
child var : {Identifier}
child pos : {Pos}
child rdesc : {Maybe String}
visit 0:
local tks : _
alternative CharToken:
child value : {String}
child pos : {Pos}
visit 0:
local tks : _
alternative Err:
child mesg : {String}
child pos : {Pos}
visit 0:
local tks : _
alternative HsToken:
child value : {String}
child pos : {Pos}
visit 0:
local tks : _
alternative StrToken:
child value : {String}
child pos : {Pos}
visit 0:
local tks : _
-}
-- cata
sem_HsToken :: HsToken ->
T_HsToken
sem_HsToken (AGField _field _attr _pos _rdesc) =
(sem_HsToken_AGField _field _attr _pos _rdesc)
sem_HsToken (AGLocal _var _pos _rdesc) =
(sem_HsToken_AGLocal _var _pos _rdesc)
sem_HsToken (CharToken _value _pos) =
(sem_HsToken_CharToken _value _pos)
sem_HsToken (Err _mesg _pos) =
(sem_HsToken_Err _mesg _pos)
sem_HsToken (HsToken _value _pos) =
(sem_HsToken_HsToken _value _pos)
sem_HsToken (StrToken _value _pos) =
(sem_HsToken_StrToken _value _pos)
-- semantic domain
newtype T_HsToken = T_HsToken (Int ->
([(Identifier, Identifier)]) ->
([(Identifier, Identifier)]) ->
ConstructorIdent ->
NontermIdent ->
String ->
Bool ->
( Int,(Seq Error),HsToken))
data Inh_HsToken = Inh_HsToken {addLines_Inh_HsToken :: Int,childInhs_Inh_HsToken :: [(Identifier, Identifier)],childSyns_Inh_HsToken :: [(Identifier, Identifier)],con_Inh_HsToken :: ConstructorIdent,nt_Inh_HsToken :: NontermIdent,ruleDescr_Inh_HsToken :: String,useFieldIdent_Inh_HsToken :: Bool}
data Syn_HsToken = Syn_HsToken {addLines_Syn_HsToken :: Int,errors_Syn_HsToken :: Seq Error,tks_Syn_HsToken :: HsToken}
wrap_HsToken (T_HsToken sem) (Inh_HsToken _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) =
(let ( _lhsOaddLines,_lhsOerrors,_lhsOtks) =
(sem _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent)
in (Syn_HsToken _lhsOaddLines _lhsOerrors _lhsOtks))
sem_HsToken_AGField :: Identifier ->
Identifier ->
Pos ->
(Maybe String) ->
T_HsToken
sem_HsToken_AGField field_ attr_ pos_ rdesc_ =
(T_HsToken (\ _lhsIaddLines
_lhsIchildInhs
_lhsIchildSyns
_lhsIcon
_lhsInt
_lhsIruleDescr
_lhsIuseFieldIdent ->
(let _lhsOerrors :: (Seq Error)
_lhsOaddLines :: Int
_lhsOtks :: HsToken
-- "Desugar.ag"(line 72, column 7)
_mField =
findField field_ attr_ _lhsIchildSyns
-- "Desugar.ag"(line 74, column 7)
_field' =
maybe field_ id _mField
-- "Desugar.ag"(line 75, column 7)
_lhsOerrors =
maybe (Seq.single (UndefAttr _lhsInt _lhsIcon field_ (Ident "<ANY>" (getPos field_)) False)) (const Seq.empty) _mField
-- "Desugar.ag"(line 77, column 7)
_lhsOaddLines =
if _lhsIuseFieldIdent || length (getName field_) < length (getName _field' )
then _lhsIaddLines + 1
else _lhsIaddLines
-- "Desugar.ag"(line 81, column 7)
_tks =
AGField field_ attr_ (addl _lhsIaddLines pos_) (if _lhsIuseFieldIdent then Just _lhsIruleDescr else Nothing)
-- self rule
_lhsOtks =
_tks
in ( _lhsOaddLines,_lhsOerrors,_lhsOtks))))
sem_HsToken_AGLocal :: Identifier ->
Pos ->
(Maybe String) ->
T_HsToken
sem_HsToken_AGLocal var_ pos_ rdesc_ =
(T_HsToken (\ _lhsIaddLines
_lhsIchildInhs
_lhsIchildSyns
_lhsIcon
_lhsInt
_lhsIruleDescr
_lhsIuseFieldIdent ->
(let _lhsOaddLines :: Int
_lhsOerrors :: (Seq Error)
_lhsOtks :: HsToken
-- "Desugar.ag"(line 67, column 7)
_lhsOaddLines =
if _lhsIuseFieldIdent
then _lhsIaddLines + 1
else _lhsIaddLines
-- "Desugar.ag"(line 70, column 7)
_tks =
AGLocal var_ (addl _lhsIaddLines pos_) (if _lhsIuseFieldIdent then Just _lhsIruleDescr else Nothing)
-- use rule "Desugar.ag"(line 31, column 144)
_lhsOerrors =
Seq.empty
-- self rule
_lhsOtks =
_tks
in ( _lhsOaddLines,_lhsOerrors,_lhsOtks))))
sem_HsToken_CharToken :: String ->
Pos ->
T_HsToken
sem_HsToken_CharToken value_ pos_ =
(T_HsToken (\ _lhsIaddLines
_lhsIchildInhs
_lhsIchildSyns
_lhsIcon
_lhsInt
_lhsIruleDescr
_lhsIuseFieldIdent ->
(let _lhsOerrors :: (Seq Error)
_lhsOtks :: HsToken
_lhsOaddLines :: Int
-- "Desugar.ag"(line 85, column 7)
_tks =
CharToken value_ (addl _lhsIaddLines pos_)
-- use rule "Desugar.ag"(line 31, column 144)
_lhsOerrors =
Seq.empty
-- self rule
_lhsOtks =
_tks
-- copy rule (chain)
_lhsOaddLines =
_lhsIaddLines
in ( _lhsOaddLines,_lhsOerrors,_lhsOtks))))
sem_HsToken_Err :: String ->
Pos ->
T_HsToken
sem_HsToken_Err mesg_ pos_ =
(T_HsToken (\ _lhsIaddLines
_lhsIchildInhs
_lhsIchildSyns
_lhsIcon
_lhsInt
_lhsIruleDescr
_lhsIuseFieldIdent ->
(let _lhsOerrors :: (Seq Error)
_lhsOtks :: HsToken
_lhsOaddLines :: Int
-- "Desugar.ag"(line 89, column 7)
_tks =
Err mesg_ (addl _lhsIaddLines pos_)
-- use rule "Desugar.ag"(line 31, column 144)
_lhsOerrors =
Seq.empty
-- self rule
_lhsOtks =
_tks
-- copy rule (chain)
_lhsOaddLines =
_lhsIaddLines
in ( _lhsOaddLines,_lhsOerrors,_lhsOtks))))
sem_HsToken_HsToken :: String ->
Pos ->
T_HsToken
sem_HsToken_HsToken value_ pos_ =
(T_HsToken (\ _lhsIaddLines
_lhsIchildInhs
_lhsIchildSyns
_lhsIcon
_lhsInt
_lhsIruleDescr
_lhsIuseFieldIdent ->
(let _lhsOerrors :: (Seq Error)
_lhsOtks :: HsToken
_lhsOaddLines :: Int
-- "Desugar.ag"(line 83, column 7)
_tks =
HsToken value_ (addl _lhsIaddLines pos_)
-- use rule "Desugar.ag"(line 31, column 144)
_lhsOerrors =
Seq.empty
-- self rule
_lhsOtks =
_tks
-- copy rule (chain)
_lhsOaddLines =
_lhsIaddLines
in ( _lhsOaddLines,_lhsOerrors,_lhsOtks))))
sem_HsToken_StrToken :: String ->
Pos ->
T_HsToken
sem_HsToken_StrToken value_ pos_ =
(T_HsToken (\ _lhsIaddLines
_lhsIchildInhs
_lhsIchildSyns
_lhsIcon
_lhsInt
_lhsIruleDescr
_lhsIuseFieldIdent ->
(let _lhsOerrors :: (Seq Error)
_lhsOtks :: HsToken
_lhsOaddLines :: Int
-- "Desugar.ag"(line 87, column 7)
_tks =
StrToken value_ (addl _lhsIaddLines pos_)
-- use rule "Desugar.ag"(line 31, column 144)
_lhsOerrors =
Seq.empty
-- self rule
_lhsOtks =
_tks
-- copy rule (chain)
_lhsOaddLines =
_lhsIaddLines
in ( _lhsOaddLines,_lhsOerrors,_lhsOtks))))
-- HsTokens ----------------------------------------------------
{-
visit 0:
inherited attributes:
childInhs : [(Identifier, Identifier)]
childSyns : [(Identifier, Identifier)]
con : ConstructorIdent
nt : NontermIdent
ruleDescr : String
useFieldIdent : Bool
chained attribute:
addLines : Int
synthesized attributes:
errors : Seq Error
tks : SELF
alternatives:
alternative Cons:
child hd : HsToken
child tl : HsTokens
visit 0:
local tks : _
alternative Nil:
visit 0:
local tks : _
-}
-- cata
sem_HsTokens :: HsTokens ->
T_HsTokens
sem_HsTokens list =
(Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list))
-- semantic domain
newtype T_HsTokens = T_HsTokens (Int ->
([(Identifier, Identifier)]) ->
([(Identifier, Identifier)]) ->
ConstructorIdent ->
NontermIdent ->
String ->
Bool ->
( Int,(Seq Error),HsTokens))
data Inh_HsTokens = Inh_HsTokens {addLines_Inh_HsTokens :: Int,childInhs_Inh_HsTokens :: [(Identifier, Identifier)],childSyns_Inh_HsTokens :: [(Identifier, Identifier)],con_Inh_HsTokens :: ConstructorIdent,nt_Inh_HsTokens :: NontermIdent,ruleDescr_Inh_HsTokens :: String,useFieldIdent_Inh_HsTokens :: Bool}
data Syn_HsTokens = Syn_HsTokens {addLines_Syn_HsTokens :: Int,errors_Syn_HsTokens :: Seq Error,tks_Syn_HsTokens :: HsTokens}
wrap_HsTokens (T_HsTokens sem) (Inh_HsTokens _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) =
(let ( _lhsOaddLines,_lhsOerrors,_lhsOtks) =
(sem _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent)
in (Syn_HsTokens _lhsOaddLines _lhsOerrors _lhsOtks))
sem_HsTokens_Cons :: T_HsToken ->
T_HsTokens ->
T_HsTokens
sem_HsTokens_Cons (T_HsToken hd_) (T_HsTokens tl_) =
(T_HsTokens (\ _lhsIaddLines
_lhsIchildInhs
_lhsIchildSyns
_lhsIcon
_lhsInt
_lhsIruleDescr
_lhsIuseFieldIdent ->
(let _lhsOerrors :: (Seq Error)
_lhsOtks :: HsTokens
_lhsOaddLines :: Int
_hdOaddLines :: Int
_hdOchildInhs :: ([(Identifier, Identifier)])
_hdOchildSyns :: ([(Identifier, Identifier)])
_hdOcon :: ConstructorIdent
_hdOnt :: NontermIdent
_hdOruleDescr :: String
_hdOuseFieldIdent :: Bool
_tlOaddLines :: Int
_tlOchildInhs :: ([(Identifier, Identifier)])
_tlOchildSyns :: ([(Identifier, Identifier)])
_tlOcon :: ConstructorIdent
_tlOnt :: NontermIdent
_tlOruleDescr :: String
_tlOuseFieldIdent :: Bool
_hdIaddLines :: Int
_hdIerrors :: (Seq Error)
_hdItks :: HsToken
_tlIaddLines :: Int
_tlIerrors :: (Seq Error)
_tlItks :: HsTokens
-- use rule "Desugar.ag"(line 31, column 144)
_lhsOerrors =
_hdIerrors Seq.<> _tlIerrors
-- self rule
_tks =
(:) _hdItks _tlItks
-- self rule
_lhsOtks =
_tks
-- copy rule (up)
_lhsOaddLines =
_tlIaddLines
-- copy rule (down)
_hdOaddLines =
_lhsIaddLines
-- copy rule (down)
_hdOchildInhs =
_lhsIchildInhs
-- copy rule (down)
_hdOchildSyns =
_lhsIchildSyns
-- copy rule (down)
_hdOcon =
_lhsIcon
-- copy rule (down)
_hdOnt =
_lhsInt
-- copy rule (down)
_hdOruleDescr =
_lhsIruleDescr
-- copy rule (down)
_hdOuseFieldIdent =
_lhsIuseFieldIdent
-- copy rule (chain)
_tlOaddLines =
_hdIaddLines
-- copy rule (down)
_tlOchildInhs =
_lhsIchildInhs
-- copy rule (down)
_tlOchildSyns =
_lhsIchildSyns
-- copy rule (down)
_tlOcon =
_lhsIcon
-- copy rule (down)
_tlOnt =
_lhsInt
-- copy rule (down)
_tlOruleDescr =
_lhsIruleDescr
-- copy rule (down)
_tlOuseFieldIdent =
_lhsIuseFieldIdent
( _hdIaddLines,_hdIerrors,_hdItks) =
(hd_ _hdOaddLines _hdOchildInhs _hdOchildSyns _hdOcon _hdOnt _hdOruleDescr _hdOuseFieldIdent)
( _tlIaddLines,_tlIerrors,_tlItks) =
(tl_ _tlOaddLines _tlOchildInhs _tlOchildSyns _tlOcon _tlOnt _tlOruleDescr _tlOuseFieldIdent)
in ( _lhsOaddLines,_lhsOerrors,_lhsOtks))))
sem_HsTokens_Nil :: T_HsTokens
sem_HsTokens_Nil =
(T_HsTokens (\ _lhsIaddLines
_lhsIchildInhs
_lhsIchildSyns
_lhsIcon
_lhsInt
_lhsIruleDescr
_lhsIuseFieldIdent ->
(let _lhsOerrors :: (Seq Error)
_lhsOtks :: HsTokens
_lhsOaddLines :: Int
-- use rule "Desugar.ag"(line 31, column 144)
_lhsOerrors =
Seq.empty
-- self rule
_tks =
[]
-- self rule
_lhsOtks =
_tks
-- copy rule (chain)
_lhsOaddLines =
_lhsIaddLines
in ( _lhsOaddLines,_lhsOerrors,_lhsOtks))))
-- HsTokensRoot ------------------------------------------------
{-
visit 0:
inherited attributes:
childInhs : [(Identifier, Identifier)]
childSyns : [(Identifier, Identifier)]
con : ConstructorIdent
nt : NontermIdent
ruleDescr : String
useFieldIdent : Bool
synthesized attributes:
errors : Seq Error
tks : [HsToken]
alternatives:
alternative HsTokensRoot:
child tokens : HsTokens
-}
-- cata
sem_HsTokensRoot :: HsTokensRoot ->
T_HsTokensRoot
sem_HsTokensRoot (HsTokensRoot _tokens) =
(sem_HsTokensRoot_HsTokensRoot (sem_HsTokens _tokens))
-- semantic domain
newtype T_HsTokensRoot = T_HsTokensRoot (([(Identifier, Identifier)]) ->
([(Identifier, Identifier)]) ->
ConstructorIdent ->
NontermIdent ->
String ->
Bool ->
( (Seq Error),([HsToken])))
data Inh_HsTokensRoot = Inh_HsTokensRoot {childInhs_Inh_HsTokensRoot :: [(Identifier, Identifier)],childSyns_Inh_HsTokensRoot :: [(Identifier, Identifier)],con_Inh_HsTokensRoot :: ConstructorIdent,nt_Inh_HsTokensRoot :: NontermIdent,ruleDescr_Inh_HsTokensRoot :: String,useFieldIdent_Inh_HsTokensRoot :: Bool}
data Syn_HsTokensRoot = Syn_HsTokensRoot {errors_Syn_HsTokensRoot :: Seq Error,tks_Syn_HsTokensRoot :: [HsToken]}
wrap_HsTokensRoot (T_HsTokensRoot sem) (Inh_HsTokensRoot _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) =
(let ( _lhsOerrors,_lhsOtks) =
(sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent)
in (Syn_HsTokensRoot _lhsOerrors _lhsOtks))
sem_HsTokensRoot_HsTokensRoot :: T_HsTokens ->
T_HsTokensRoot
sem_HsTokensRoot_HsTokensRoot (T_HsTokens tokens_) =
(T_HsTokensRoot (\ _lhsIchildInhs
_lhsIchildSyns
_lhsIcon
_lhsInt
_lhsIruleDescr
_lhsIuseFieldIdent ->
(let _tokensOaddLines :: Int
_lhsOerrors :: (Seq Error)
_lhsOtks :: ([HsToken])
_tokensOchildInhs :: ([(Identifier, Identifier)])
_tokensOchildSyns :: ([(Identifier, Identifier)])
_tokensOcon :: ConstructorIdent
_tokensOnt :: NontermIdent
_tokensOruleDescr :: String
_tokensOuseFieldIdent :: Bool
_tokensIaddLines :: Int
_tokensIerrors :: (Seq Error)
_tokensItks :: HsTokens
-- "Desugar.ag"(line 60, column 7)
_tokensOaddLines =
0
-- use rule "Desugar.ag"(line 31, column 144)
_lhsOerrors =
_tokensIerrors
-- copy rule (up)
_lhsOtks =
_tokensItks
-- copy rule (down)
_tokensOchildInhs =
_lhsIchildInhs
-- copy rule (down)
_tokensOchildSyns =
_lhsIchildSyns
-- copy rule (down)
_tokensOcon =
_lhsIcon
-- copy rule (down)
_tokensOnt =
_lhsInt
-- copy rule (down)
_tokensOruleDescr =
_lhsIruleDescr
-- copy rule (down)
_tokensOuseFieldIdent =
_lhsIuseFieldIdent
( _tokensIaddLines,_tokensIerrors,_tokensItks) =
(tokens_ _tokensOaddLines _tokensOchildInhs _tokensOchildSyns _tokensOcon _tokensOnt _tokensOruleDescr _tokensOuseFieldIdent)
in ( _lhsOerrors,_lhsOtks))))
-- Nonterminal -------------------------------------------------
{-
visit 0:
inherited attributes:
forcedIrrefutables : AttrMap
options : Options
synthesized attributes:
allAttributes : AttrMap
errors : Seq Error
output : SELF
alternatives:
alternative Nonterminal:
child nt : {NontermIdent}
child params : {[Identifier]}
child inh : {Attributes}
child syn : {Attributes}
child prods : Productions
visit 0:
local output : _
-}
-- cata
sem_Nonterminal :: Nonterminal ->
T_Nonterminal
sem_Nonterminal (Nonterminal _nt _params _inh _syn _prods) =
(sem_Nonterminal_Nonterminal _nt _params _inh _syn (sem_Productions _prods))
-- semantic domain
newtype T_Nonterminal = T_Nonterminal (AttrMap ->
Options ->
( AttrMap,(Seq Error),Nonterminal))
data Inh_Nonterminal = Inh_Nonterminal {forcedIrrefutables_Inh_Nonterminal :: AttrMap,options_Inh_Nonterminal :: Options}
data Syn_Nonterminal = Syn_Nonterminal {allAttributes_Syn_Nonterminal :: AttrMap,errors_Syn_Nonterminal :: Seq Error,output_Syn_Nonterminal :: Nonterminal}
wrap_Nonterminal (T_Nonterminal sem) (Inh_Nonterminal _lhsIforcedIrrefutables _lhsIoptions) =
(let ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) =
(sem _lhsIforcedIrrefutables _lhsIoptions)
in (Syn_Nonterminal _lhsOallAttributes _lhsOerrors _lhsOoutput))
sem_Nonterminal_Nonterminal :: NontermIdent ->
([Identifier]) ->
Attributes ->
Attributes ->
T_Productions ->
T_Nonterminal
sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ (T_Productions prods_) =
(T_Nonterminal (\ _lhsIforcedIrrefutables
_lhsIoptions ->
(let _prodsOnt :: NontermIdent
_lhsOallAttributes :: AttrMap
_lhsOerrors :: (Seq Error)
_lhsOoutput :: Nonterminal
_prodsOforcedIrrefutables :: AttrMap
_prodsOoptions :: Options
_prodsIallAttributes :: AttrMap
_prodsIerrors :: (Seq Error)
_prodsIoutput :: Productions
-- "Desugar.ag"(line 150, column 7)
_prodsOnt =
nt_
-- use rule "Desugar.ag"(line 189, column 23)
_lhsOallAttributes =
_prodsIallAttributes
-- use rule "Desugar.ag"(line 31, column 144)
_lhsOerrors =
_prodsIerrors
-- self rule
_output =
Nonterminal nt_ params_ inh_ syn_ _prodsIoutput
-- self rule
_lhsOoutput =
_output
-- copy rule (down)
_prodsOforcedIrrefutables =
_lhsIforcedIrrefutables
-- copy rule (down)
_prodsOoptions =
_lhsIoptions
( _prodsIallAttributes,_prodsIerrors,_prodsIoutput) =
(prods_ _prodsOforcedIrrefutables _prodsOnt _prodsOoptions)
in ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput))))
-- Nonterminals ------------------------------------------------
{-
visit 0:
inherited attributes:
forcedIrrefutables : AttrMap
options : Options
synthesized attributes:
allAttributes : AttrMap
errors : Seq Error
output : SELF
alternatives:
alternative Cons:
child hd : Nonterminal
child tl : Nonterminals
visit 0:
local output : _
alternative Nil:
visit 0:
local output : _
-}
-- cata
sem_Nonterminals :: Nonterminals ->
T_Nonterminals
sem_Nonterminals list =
(Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list))
-- semantic domain
newtype T_Nonterminals = T_Nonterminals (AttrMap ->
Options ->
( AttrMap,(Seq Error),Nonterminals))
data Inh_Nonterminals = Inh_Nonterminals {forcedIrrefutables_Inh_Nonterminals :: AttrMap,options_Inh_Nonterminals :: Options}
data Syn_Nonterminals = Syn_Nonterminals {allAttributes_Syn_Nonterminals :: AttrMap,errors_Syn_Nonterminals :: Seq Error,output_Syn_Nonterminals :: Nonterminals}
wrap_Nonterminals (T_Nonterminals sem) (Inh_Nonterminals _lhsIforcedIrrefutables _lhsIoptions) =
(let ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) =
(sem _lhsIforcedIrrefutables _lhsIoptions)
in (Syn_Nonterminals _lhsOallAttributes _lhsOerrors _lhsOoutput))
sem_Nonterminals_Cons :: T_Nonterminal ->
T_Nonterminals ->
T_Nonterminals
sem_Nonterminals_Cons (T_Nonterminal hd_) (T_Nonterminals tl_) =
(T_Nonterminals (\ _lhsIforcedIrrefutables
_lhsIoptions ->
(let _lhsOallAttributes :: AttrMap
_lhsOerrors :: (Seq Error)
_lhsOoutput :: Nonterminals
_hdOforcedIrrefutables :: AttrMap
_hdOoptions :: Options
_tlOforcedIrrefutables :: AttrMap
_tlOoptions :: Options
_hdIallAttributes :: AttrMap
_hdIerrors :: (Seq Error)
_hdIoutput :: Nonterminal
_tlIallAttributes :: AttrMap
_tlIerrors :: (Seq Error)
_tlIoutput :: Nonterminals
-- use rule "Desugar.ag"(line 189, column 23)
_lhsOallAttributes =
_hdIallAttributes `mergeAttributes` _tlIallAttributes
-- use rule "Desugar.ag"(line 31, column 144)
_lhsOerrors =
_hdIerrors Seq.<> _tlIerrors
-- self rule
_output =
(:) _hdIoutput _tlIoutput
-- self rule
_lhsOoutput =
_output
-- copy rule (down)
_hdOforcedIrrefutables =
_lhsIforcedIrrefutables
-- copy rule (down)
_hdOoptions =
_lhsIoptions
-- copy rule (down)
_tlOforcedIrrefutables =
_lhsIforcedIrrefutables
-- copy rule (down)
_tlOoptions =
_lhsIoptions
( _hdIallAttributes,_hdIerrors,_hdIoutput) =
(hd_ _hdOforcedIrrefutables _hdOoptions)
( _tlIallAttributes,_tlIerrors,_tlIoutput) =
(tl_ _tlOforcedIrrefutables _tlOoptions)
in ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput))))
sem_Nonterminals_Nil :: T_Nonterminals
sem_Nonterminals_Nil =
(T_Nonterminals (\ _lhsIforcedIrrefutables
_lhsIoptions ->
(let _lhsOallAttributes :: AttrMap
_lhsOerrors :: (Seq Error)
_lhsOoutput :: Nonterminals
-- use rule "Desugar.ag"(line 189, column 23)
_lhsOallAttributes =
Map.empty
-- use rule "Desugar.ag"(line 31, column 144)
_lhsOerrors =
Seq.empty
-- self rule
_output =
[]
-- self rule
_lhsOoutput =
_output
in ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput))))
-- Pattern -----------------------------------------------------
{-
visit 0:
inherited attributes:
childInhs : [(Identifier, Identifier)]
childSyns : [(Identifier, Identifier)]
con : ConstructorIdent
defs : Set (Identifier, Identifier)
forcedIrrefutables : AttrMap
nt : NontermIdent
synthesized attributes:
allAttributes : AttrMap
copy : SELF
defsCollect : Set (Identifier, Identifier)
errors : Seq Error
output : SELF
alternatives:
alternative Alias:
child field : {Identifier}
child attr : {Identifier}
child pat : Pattern
child parts : Patterns
visit 0:
local _tup2 : _
local field' : _
local err1 : _
local err2 : _
local output : _
local def : _
local copy : _
alternative Constr:
child name : {ConstructorIdent}
child pats : Patterns
visit 0:
local copy : _
local output : _
alternative Irrefutable:
child pat : Pattern
visit 0:
local copy : _
local output : _
alternative Product:
child pos : {Pos}
child pats : Patterns
visit 0:
local copy : _
local output : _
alternative Underscore:
child pos : {Pos}
visit 0:
local copy : _
local output : _
-}
-- cata
sem_Pattern :: Pattern ->
T_Pattern
sem_Pattern (Alias _field _attr _pat _parts) =
(sem_Pattern_Alias _field _attr (sem_Pattern _pat) (sem_Patterns _parts))
sem_Pattern (Constr _name _pats) =
(sem_Pattern_Constr _name (sem_Patterns _pats))
sem_Pattern (Irrefutable _pat) =
(sem_Pattern_Irrefutable (sem_Pattern _pat))
sem_Pattern (Product _pos _pats) =
(sem_Pattern_Product _pos (sem_Patterns _pats))
sem_Pattern (Underscore _pos) =
(sem_Pattern_Underscore _pos)
-- semantic domain
newtype T_Pattern = T_Pattern (([(Identifier, Identifier)]) ->
([(Identifier, Identifier)]) ->
ConstructorIdent ->
(Set (Identifier, Identifier)) ->
AttrMap ->
NontermIdent ->
( AttrMap,Pattern,(Set (Identifier, Identifier)),(Seq Error),Pattern))
data Inh_Pattern = Inh_Pattern {childInhs_Inh_Pattern :: [(Identifier, Identifier)],childSyns_Inh_Pattern :: [(Identifier, Identifier)],con_Inh_Pattern :: ConstructorIdent,defs_Inh_Pattern :: Set (Identifier, Identifier),forcedIrrefutables_Inh_Pattern :: AttrMap,nt_Inh_Pattern :: NontermIdent}
data Syn_Pattern = Syn_Pattern {allAttributes_Syn_Pattern :: AttrMap,copy_Syn_Pattern :: Pattern,defsCollect_Syn_Pattern :: Set (Identifier, Identifier),errors_Syn_Pattern :: Seq Error,output_Syn_Pattern :: Pattern}
wrap_Pattern (T_Pattern sem) (Inh_Pattern _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) =
(let ( _lhsOallAttributes,_lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput) =
(sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt)
in (Syn_Pattern _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput))
sem_Pattern_Alias :: Identifier ->
Identifier ->
T_Pattern ->
T_Patterns ->
T_Pattern
sem_Pattern_Alias field_ attr_ (T_Pattern pat_) (T_Patterns parts_) =
(T_Pattern (\ _lhsIchildInhs
_lhsIchildSyns
_lhsIcon
_lhsIdefs
_lhsIforcedIrrefutables
_lhsInt ->
(let _lhsOerrors :: (Seq Error)
_lhsOdefsCollect :: (Set (Identifier, Identifier))
_lhsOallAttributes :: AttrMap
_lhsOoutput :: Pattern
_lhsOcopy :: Pattern
_patOchildInhs :: ([(Identifier, Identifier)])
_patOchildSyns :: ([(Identifier, Identifier)])
_patOcon :: ConstructorIdent
_patOdefs :: (Set (Identifier, Identifier))
_patOforcedIrrefutables :: AttrMap
_patOnt :: NontermIdent
_partsOchildInhs :: ([(Identifier, Identifier)])
_partsOchildSyns :: ([(Identifier, Identifier)])
_partsOcon :: ConstructorIdent
_partsOdefs :: (Set (Identifier, Identifier))
_partsOforcedIrrefutables :: AttrMap
_partsOnt :: NontermIdent
_patIallAttributes :: AttrMap
_patIcopy :: Pattern
_patIdefsCollect :: (Set (Identifier, Identifier))
_patIerrors :: (Seq Error)
_patIoutput :: Pattern
_partsIallAttributes :: AttrMap
_partsIcopy :: Patterns
_partsIdefsCollect :: (Set (Identifier, Identifier))
_partsIerrors :: (Seq Error)
_partsIoutput :: Patterns
-- "Desugar.ag"(line 103, column 7)
__tup2 =
maybeError field_ (UndefAttr _lhsInt _lhsIcon (Ident "<ANY>" (getPos field_)) attr_ True) $
findField field_ attr_ _lhsIchildInhs
-- "Desugar.ag"(line 103, column 7)
(_field',_) =
__tup2
-- "Desugar.ag"(line 103, column 7)
(_,_err1) =
__tup2
-- "Desugar.ag"(line 105, column 7)
_err2 =
if _field' == field_
then Seq.empty
else if (_field' , attr_) `Set.member` _lhsIdefs
then Seq.single $ DupRule _lhsInt _lhsIcon field_ attr_ _field'
else Seq.empty
-- "Desugar.ag"(line 110, column 7)
_lhsOerrors =
_err1 Seq.<> _err2 Seq.<> _patIerrors <> _partsIerrors
-- "Desugar.ag"(line 111, column 7)
_output =
Alias _field' attr_ _patIoutput _partsIoutput
-- "Desugar.ag"(line 175, column 7)
_def =
Set.singleton (field_, attr_)
-- "Desugar.ag"(line 176, column 7)
_lhsOdefsCollect =
_def `Set.union` _patIdefsCollect `Set.union` _partsIdefsCollect
-- "Desugar.ag"(line 193, column 7)
_lhsOallAttributes =
(Map.singleton _lhsInt $ Map.singleton _lhsIcon $ Set.singleton (field_, attr_)) `mergeAttributes` _patIallAttributes
-- "Desugar.ag"(line 212, column 7)
_lhsOoutput =
if Set.member (field_, attr_) $ Map.findWithDefault Set.empty _lhsIcon $ Map.findWithDefault Map.empty _lhsInt $ _lhsIforcedIrrefutables
then Irrefutable _output
else _output
-- self rule
_copy =
Alias field_ attr_ _patIcopy _partsIcopy
-- self rule
_lhsOcopy =
_copy
-- copy rule (down)
_patOchildInhs =
_lhsIchildInhs
-- copy rule (down)
_patOchildSyns =
_lhsIchildSyns
-- copy rule (down)
_patOcon =
_lhsIcon
-- copy rule (down)
_patOdefs =
_lhsIdefs
-- copy rule (down)
_patOforcedIrrefutables =
_lhsIforcedIrrefutables
-- copy rule (down)
_patOnt =
_lhsInt
-- copy rule (down)
_partsOchildInhs =
_lhsIchildInhs
-- copy rule (down)
_partsOchildSyns =
_lhsIchildSyns
-- copy rule (down)
_partsOcon =
_lhsIcon
-- copy rule (down)
_partsOdefs =
_lhsIdefs
-- copy rule (down)
_partsOforcedIrrefutables =
_lhsIforcedIrrefutables
-- copy rule (down)
_partsOnt =
_lhsInt
( _patIallAttributes,_patIcopy,_patIdefsCollect,_patIerrors,_patIoutput) =
(pat_ _patOchildInhs _patOchildSyns _patOcon _patOdefs _patOforcedIrrefutables _patOnt)
( _partsIallAttributes,_partsIcopy,_partsIdefsCollect,_partsIerrors,_partsIoutput) =
(parts_ _partsOchildInhs _partsOchildSyns _partsOcon _partsOdefs _partsOforcedIrrefutables _partsOnt)
in ( _lhsOallAttributes,_lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))))
sem_Pattern_Constr :: ConstructorIdent ->
T_Patterns ->
T_Pattern
sem_Pattern_Constr name_ (T_Patterns pats_) =
(T_Pattern (\ _lhsIchildInhs
_lhsIchildSyns
_lhsIcon
_lhsIdefs
_lhsIforcedIrrefutables
_lhsInt ->
(let _lhsOallAttributes :: AttrMap
_lhsOdefsCollect :: (Set (Identifier, Identifier))
_lhsOerrors :: (Seq Error)
_lhsOcopy :: Pattern
_lhsOoutput :: Pattern
_patsOchildInhs :: ([(Identifier, Identifier)])
_patsOchildSyns :: ([(Identifier, Identifier)])
_patsOcon :: ConstructorIdent
_patsOdefs :: (Set (Identifier, Identifier))
_patsOforcedIrrefutables :: AttrMap
_patsOnt :: NontermIdent
_patsIallAttributes :: AttrMap
_patsIcopy :: Patterns
_patsIdefsCollect :: (Set (Identifier, Identifier))
_patsIerrors :: (Seq Error)
_patsIoutput :: Patterns
-- use rule "Desugar.ag"(line 189, column 23)
_lhsOallAttributes =
_patsIallAttributes
-- use rule "Desugar.ag"(line 172, column 52)
_lhsOdefsCollect =
_patsIdefsCollect
-- use rule "Desugar.ag"(line 31, column 144)
_lhsOerrors =
_patsIerrors
-- self rule
_copy =
Constr name_ _patsIcopy
-- self rule
_output =
Constr name_ _patsIoutput
-- self rule
_lhsOcopy =
_copy
-- self rule
_lhsOoutput =
_output
-- copy rule (down)
_patsOchildInhs =
_lhsIchildInhs
-- copy rule (down)
_patsOchildSyns =
_lhsIchildSyns
-- copy rule (down)
_patsOcon =
_lhsIcon
-- copy rule (down)
_patsOdefs =
_lhsIdefs
-- copy rule (down)
_patsOforcedIrrefutables =
_lhsIforcedIrrefutables
-- copy rule (down)
_patsOnt =
_lhsInt
( _patsIallAttributes,_patsIcopy,_patsIdefsCollect,_patsIerrors,_patsIoutput) =
(pats_ _patsOchildInhs _patsOchildSyns _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt)
in ( _lhsOallAttributes,_lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))))
sem_Pattern_Irrefutable :: T_Pattern ->
T_Pattern
sem_Pattern_Irrefutable (T_Pattern pat_) =
(T_Pattern (\ _lhsIchildInhs
_lhsIchildSyns
_lhsIcon
_lhsIdefs
_lhsIforcedIrrefutables
_lhsInt ->
(let _lhsOallAttributes :: AttrMap
_lhsOdefsCollect :: (Set (Identifier, Identifier))
_lhsOerrors :: (Seq Error)
_lhsOcopy :: Pattern
_lhsOoutput :: Pattern
_patOchildInhs :: ([(Identifier, Identifier)])
_patOchildSyns :: ([(Identifier, Identifier)])
_patOcon :: ConstructorIdent
_patOdefs :: (Set (Identifier, Identifier))
_patOforcedIrrefutables :: AttrMap
_patOnt :: NontermIdent
_patIallAttributes :: AttrMap
_patIcopy :: Pattern
_patIdefsCollect :: (Set (Identifier, Identifier))
_patIerrors :: (Seq Error)
_patIoutput :: Pattern
-- "Desugar.ag"(line 195, column 7)
_lhsOallAttributes =
Map.empty
-- use rule "Desugar.ag"(line 172, column 52)
_lhsOdefsCollect =
_patIdefsCollect
-- use rule "Desugar.ag"(line 31, column 144)
_lhsOerrors =
_patIerrors
-- self rule
_copy =
Irrefutable _patIcopy
-- self rule
_output =
Irrefutable _patIoutput
-- self rule
_lhsOcopy =
_copy
-- self rule
_lhsOoutput =
_output
-- copy rule (down)
_patOchildInhs =
_lhsIchildInhs
-- copy rule (down)
_patOchildSyns =
_lhsIchildSyns
-- copy rule (down)
_patOcon =
_lhsIcon
-- copy rule (down)
_patOdefs =
_lhsIdefs
-- copy rule (down)
_patOforcedIrrefutables =
_lhsIforcedIrrefutables
-- copy rule (down)
_patOnt =
_lhsInt
( _patIallAttributes,_patIcopy,_patIdefsCollect,_patIerrors,_patIoutput) =
(pat_ _patOchildInhs _patOchildSyns _patOcon _patOdefs _patOforcedIrrefutables _patOnt)
in ( _lhsOallAttributes,_lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))))
sem_Pattern_Product :: Pos ->
T_Patterns ->
T_Pattern
sem_Pattern_Product pos_ (T_Patterns pats_) =
(T_Pattern (\ _lhsIchildInhs
_lhsIchildSyns
_lhsIcon
_lhsIdefs
_lhsIforcedIrrefutables
_lhsInt ->
(let _lhsOallAttributes :: AttrMap
_lhsOdefsCollect :: (Set (Identifier, Identifier))
_lhsOerrors :: (Seq Error)
_lhsOcopy :: Pattern
_lhsOoutput :: Pattern
_patsOchildInhs :: ([(Identifier, Identifier)])
_patsOchildSyns :: ([(Identifier, Identifier)])
_patsOcon :: ConstructorIdent
_patsOdefs :: (Set (Identifier, Identifier))
_patsOforcedIrrefutables :: AttrMap
_patsOnt :: NontermIdent
_patsIallAttributes :: AttrMap
_patsIcopy :: Patterns
_patsIdefsCollect :: (Set (Identifier, Identifier))
_patsIerrors :: (Seq Error)
_patsIoutput :: Patterns
-- use rule "Desugar.ag"(line 189, column 23)
_lhsOallAttributes =
_patsIallAttributes
-- use rule "Desugar.ag"(line 172, column 52)
_lhsOdefsCollect =
_patsIdefsCollect
-- use rule "Desugar.ag"(line 31, column 144)
_lhsOerrors =
_patsIerrors
-- self rule
_copy =
Product pos_ _patsIcopy
-- self rule
_output =
Product pos_ _patsIoutput
-- self rule
_lhsOcopy =
_copy
-- self rule
_lhsOoutput =
_output
-- copy rule (down)
_patsOchildInhs =
_lhsIchildInhs
-- copy rule (down)
_patsOchildSyns =
_lhsIchildSyns
-- copy rule (down)
_patsOcon =
_lhsIcon
-- copy rule (down)
_patsOdefs =
_lhsIdefs
-- copy rule (down)
_patsOforcedIrrefutables =
_lhsIforcedIrrefutables
-- copy rule (down)
_patsOnt =
_lhsInt
( _patsIallAttributes,_patsIcopy,_patsIdefsCollect,_patsIerrors,_patsIoutput) =
(pats_ _patsOchildInhs _patsOchildSyns _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt)
in ( _lhsOallAttributes,_lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))))
sem_Pattern_Underscore :: Pos ->
T_Pattern
sem_Pattern_Underscore pos_ =
(T_Pattern (\ _lhsIchildInhs
_lhsIchildSyns
_lhsIcon
_lhsIdefs
_lhsIforcedIrrefutables
_lhsInt ->
(let _lhsOallAttributes :: AttrMap
_lhsOdefsCollect :: (Set (Identifier, Identifier))
_lhsOerrors :: (Seq Error)
_lhsOcopy :: Pattern
_lhsOoutput :: Pattern
-- use rule "Desugar.ag"(line 189, column 23)
_lhsOallAttributes =
Map.empty
-- use rule "Desugar.ag"(line 172, column 52)
_lhsOdefsCollect =
Set.empty
-- use rule "Desugar.ag"(line 31, column 144)
_lhsOerrors =
Seq.empty
-- self rule
_copy =
Underscore pos_
-- self rule
_output =
Underscore pos_
-- self rule
_lhsOcopy =
_copy
-- self rule
_lhsOoutput =
_output
in ( _lhsOallAttributes,_lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))))
-- Patterns ----------------------------------------------------
{-
visit 0:
inherited attributes:
childInhs : [(Identifier, Identifier)]
childSyns : [(Identifier, Identifier)]
con : ConstructorIdent
defs : Set (Identifier, Identifier)
forcedIrrefutables : AttrMap
nt : NontermIdent
synthesized attributes:
allAttributes : AttrMap
copy : SELF
defsCollect : Set (Identifier, Identifier)
errors : Seq Error
output : SELF
alternatives:
alternative Cons:
child hd : Pattern
child tl : Patterns
visit 0:
local copy : _
local output : _
alternative Nil:
visit 0:
local copy : _
local output : _
-}
-- cata
sem_Patterns :: Patterns ->
T_Patterns
sem_Patterns list =
(Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list))
-- semantic domain
newtype T_Patterns = T_Patterns (([(Identifier, Identifier)]) ->
([(Identifier, Identifier)]) ->
ConstructorIdent ->
(Set (Identifier, Identifier)) ->
AttrMap ->
NontermIdent ->
( AttrMap,Patterns,(Set (Identifier, Identifier)),(Seq Error),Patterns))
data Inh_Patterns = Inh_Patterns {childInhs_Inh_Patterns :: [(Identifier, Identifier)],childSyns_Inh_Patterns :: [(Identifier, Identifier)],con_Inh_Patterns :: ConstructorIdent,defs_Inh_Patterns :: Set (Identifier, Identifier),forcedIrrefutables_Inh_Patterns :: AttrMap,nt_Inh_Patterns :: NontermIdent}
data Syn_Patterns = Syn_Patterns {allAttributes_Syn_Patterns :: AttrMap,copy_Syn_Patterns :: Patterns,defsCollect_Syn_Patterns :: Set (Identifier, Identifier),errors_Syn_Patterns :: Seq Error,output_Syn_Patterns :: Patterns}
wrap_Patterns (T_Patterns sem) (Inh_Patterns _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) =
(let ( _lhsOallAttributes,_lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput) =
(sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt)
in (Syn_Patterns _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput))
sem_Patterns_Cons :: T_Pattern ->
T_Patterns ->
T_Patterns
sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) =
(T_Patterns (\ _lhsIchildInhs
_lhsIchildSyns
_lhsIcon
_lhsIdefs
_lhsIforcedIrrefutables
_lhsInt ->
(let _lhsOallAttributes :: AttrMap
_lhsOdefsCollect :: (Set (Identifier, Identifier))
_lhsOerrors :: (Seq Error)
_lhsOcopy :: Patterns
_lhsOoutput :: Patterns
_hdOchildInhs :: ([(Identifier, Identifier)])
_hdOchildSyns :: ([(Identifier, Identifier)])
_hdOcon :: ConstructorIdent
_hdOdefs :: (Set (Identifier, Identifier))
_hdOforcedIrrefutables :: AttrMap
_hdOnt :: NontermIdent
_tlOchildInhs :: ([(Identifier, Identifier)])
_tlOchildSyns :: ([(Identifier, Identifier)])
_tlOcon :: ConstructorIdent
_tlOdefs :: (Set (Identifier, Identifier))
_tlOforcedIrrefutables :: AttrMap
_tlOnt :: NontermIdent
_hdIallAttributes :: AttrMap
_hdIcopy :: Pattern
_hdIdefsCollect :: (Set (Identifier, Identifier))
_hdIerrors :: (Seq Error)
_hdIoutput :: Pattern
_tlIallAttributes :: AttrMap
_tlIcopy :: Patterns
_tlIdefsCollect :: (Set (Identifier, Identifier))
_tlIerrors :: (Seq Error)
_tlIoutput :: Patterns
-- use rule "Desugar.ag"(line 189, column 23)
_lhsOallAttributes =
_hdIallAttributes `mergeAttributes` _tlIallAttributes
-- use rule "Desugar.ag"(line 172, column 52)
_lhsOdefsCollect =
_hdIdefsCollect `Set.union` _tlIdefsCollect
-- use rule "Desugar.ag"(line 31, column 144)
_lhsOerrors =
_hdIerrors Seq.<> _tlIerrors
-- self rule
_copy =
(:) _hdIcopy _tlIcopy
-- self rule
_output =
(:) _hdIoutput _tlIoutput
-- self rule
_lhsOcopy =
_copy
-- self rule
_lhsOoutput =
_output
-- copy rule (down)
_hdOchildInhs =
_lhsIchildInhs
-- copy rule (down)
_hdOchildSyns =
_lhsIchildSyns
-- copy rule (down)
_hdOcon =
_lhsIcon
-- copy rule (down)
_hdOdefs =
_lhsIdefs
-- copy rule (down)
_hdOforcedIrrefutables =
_lhsIforcedIrrefutables
-- copy rule (down)
_hdOnt =
_lhsInt
-- copy rule (down)
_tlOchildInhs =
_lhsIchildInhs
-- copy rule (down)
_tlOchildSyns =
_lhsIchildSyns
-- copy rule (down)
_tlOcon =
_lhsIcon
-- copy rule (down)
_tlOdefs =
_lhsIdefs
-- copy rule (down)
_tlOforcedIrrefutables =
_lhsIforcedIrrefutables
-- copy rule (down)
_tlOnt =
_lhsInt
( _hdIallAttributes,_hdIcopy,_hdIdefsCollect,_hdIerrors,_hdIoutput) =
(hd_ _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt)
( _tlIallAttributes,_tlIcopy,_tlIdefsCollect,_tlIerrors,_tlIoutput) =
(tl_ _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt)
in ( _lhsOallAttributes,_lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))))
sem_Patterns_Nil :: T_Patterns
sem_Patterns_Nil =
(T_Patterns (\ _lhsIchildInhs
_lhsIchildSyns
_lhsIcon
_lhsIdefs
_lhsIforcedIrrefutables
_lhsInt ->
(let _lhsOallAttributes :: AttrMap
_lhsOdefsCollect :: (Set (Identifier, Identifier))
_lhsOerrors :: (Seq Error)
_lhsOcopy :: Patterns
_lhsOoutput :: Patterns
-- use rule "Desugar.ag"(line 189, column 23)
_lhsOallAttributes =
Map.empty
-- use rule "Desugar.ag"(line 172, column 52)
_lhsOdefsCollect =
Set.empty
-- use rule "Desugar.ag"(line 31, column 144)
_lhsOerrors =
Seq.empty
-- self rule
_copy =
[]
-- self rule
_output =
[]
-- self rule
_lhsOcopy =
_copy
-- self rule
_lhsOoutput =
_output
in ( _lhsOallAttributes,_lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))))
-- Production --------------------------------------------------
{-
visit 0:
inherited attributes:
forcedIrrefutables : AttrMap
nt : NontermIdent
options : Options
synthesized attributes:
allAttributes : AttrMap
errors : Seq Error
output : SELF
alternatives:
alternative Production:
child con : {ConstructorIdent}
child children : Children
child rules : Rules
child typeSigs : TypeSigs
visit 0:
local output : _
-}
-- cata
sem_Production :: Production ->
T_Production
sem_Production (Production _con _children _rules _typeSigs) =
(sem_Production_Production _con (sem_Children _children) (sem_Rules _rules) (sem_TypeSigs _typeSigs))
-- semantic domain
newtype T_Production = T_Production (AttrMap ->
NontermIdent ->
Options ->
( AttrMap,(Seq Error),Production))
data Inh_Production = Inh_Production {forcedIrrefutables_Inh_Production :: AttrMap,nt_Inh_Production :: NontermIdent,options_Inh_Production :: Options}
data Syn_Production = Syn_Production {allAttributes_Syn_Production :: AttrMap,errors_Syn_Production :: Seq Error,output_Syn_Production :: Production}
wrap_Production (T_Production sem) (Inh_Production _lhsIforcedIrrefutables _lhsInt _lhsIoptions) =
(let ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) =
(sem _lhsIforcedIrrefutables _lhsInt _lhsIoptions)
in (Syn_Production _lhsOallAttributes _lhsOerrors _lhsOoutput))
sem_Production_Production :: ConstructorIdent ->
T_Children ->
T_Rules ->
T_TypeSigs ->
T_Production
sem_Production_Production con_ (T_Children children_) (T_Rules rules_) (T_TypeSigs typeSigs_) =
(T_Production (\ _lhsIforcedIrrefutables
_lhsInt
_lhsIoptions ->
(let _rulesOcon :: ConstructorIdent
_rulesOdefs :: (Set (Identifier, Identifier))
_lhsOallAttributes :: AttrMap
_lhsOerrors :: (Seq Error)
_lhsOoutput :: Production
_rulesOchildInhs :: ([(Identifier, Identifier)])
_rulesOchildSyns :: ([(Identifier, Identifier)])
_rulesOforcedIrrefutables :: AttrMap
_rulesOnt :: NontermIdent
_rulesOoptions :: Options
_childrenIchildInhs :: ([(Identifier, Identifier)])
_childrenIchildSyns :: ([(Identifier, Identifier)])
_childrenIoutput :: Children
_rulesIallAttributes :: AttrMap
_rulesIdefsCollect :: (Set (Identifier, Identifier))
_rulesIerrors :: (Seq Error)
_rulesIoutput :: Rules
_typeSigsIoutput :: TypeSigs
-- "Desugar.ag"(line 154, column 7)
_rulesOcon =
con_
-- "Desugar.ag"(line 181, column 7)
_rulesOdefs =
_rulesIdefsCollect
-- use rule "Desugar.ag"(line 189, column 23)
_lhsOallAttributes =
_rulesIallAttributes
-- use rule "Desugar.ag"(line 31, column 144)
_lhsOerrors =
_rulesIerrors
-- self rule
_output =
Production con_ _childrenIoutput _rulesIoutput _typeSigsIoutput
-- self rule
_lhsOoutput =
_output
-- copy rule (chain)
_rulesOchildInhs =
_childrenIchildInhs
-- copy rule (chain)
_rulesOchildSyns =
_childrenIchildSyns
-- copy rule (down)
_rulesOforcedIrrefutables =
_lhsIforcedIrrefutables
-- copy rule (down)
_rulesOnt =
_lhsInt
-- copy rule (down)
_rulesOoptions =
_lhsIoptions
( _childrenIchildInhs,_childrenIchildSyns,_childrenIoutput) =
(children_ )
( _rulesIallAttributes,_rulesIdefsCollect,_rulesIerrors,_rulesIoutput) =
(rules_ _rulesOchildInhs _rulesOchildSyns _rulesOcon _rulesOdefs _rulesOforcedIrrefutables _rulesOnt _rulesOoptions)
( _typeSigsIoutput) =
(typeSigs_ )
in ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput))))
-- Productions -------------------------------------------------
{-
visit 0:
inherited attributes:
forcedIrrefutables : AttrMap
nt : NontermIdent
options : Options
synthesized attributes:
allAttributes : AttrMap
errors : Seq Error
output : SELF
alternatives:
alternative Cons:
child hd : Production
child tl : Productions
visit 0:
local output : _
alternative Nil:
visit 0:
local output : _
-}
-- cata
sem_Productions :: Productions ->
T_Productions
sem_Productions list =
(Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list))
-- semantic domain
newtype T_Productions = T_Productions (AttrMap ->
NontermIdent ->
Options ->
( AttrMap,(Seq Error),Productions))
data Inh_Productions = Inh_Productions {forcedIrrefutables_Inh_Productions :: AttrMap,nt_Inh_Productions :: NontermIdent,options_Inh_Productions :: Options}
data Syn_Productions = Syn_Productions {allAttributes_Syn_Productions :: AttrMap,errors_Syn_Productions :: Seq Error,output_Syn_Productions :: Productions}
wrap_Productions (T_Productions sem) (Inh_Productions _lhsIforcedIrrefutables _lhsInt _lhsIoptions) =
(let ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) =
(sem _lhsIforcedIrrefutables _lhsInt _lhsIoptions)
in (Syn_Productions _lhsOallAttributes _lhsOerrors _lhsOoutput))
sem_Productions_Cons :: T_Production ->
T_Productions ->
T_Productions
sem_Productions_Cons (T_Production hd_) (T_Productions tl_) =
(T_Productions (\ _lhsIforcedIrrefutables
_lhsInt
_lhsIoptions ->
(let _lhsOallAttributes :: AttrMap
_lhsOerrors :: (Seq Error)
_lhsOoutput :: Productions
_hdOforcedIrrefutables :: AttrMap
_hdOnt :: NontermIdent
_hdOoptions :: Options
_tlOforcedIrrefutables :: AttrMap
_tlOnt :: NontermIdent
_tlOoptions :: Options
_hdIallAttributes :: AttrMap
_hdIerrors :: (Seq Error)
_hdIoutput :: Production
_tlIallAttributes :: AttrMap
_tlIerrors :: (Seq Error)
_tlIoutput :: Productions
-- use rule "Desugar.ag"(line 189, column 23)
_lhsOallAttributes =
_hdIallAttributes `mergeAttributes` _tlIallAttributes
-- use rule "Desugar.ag"(line 31, column 144)
_lhsOerrors =
_hdIerrors Seq.<> _tlIerrors
-- self rule
_output =
(:) _hdIoutput _tlIoutput
-- self rule
_lhsOoutput =
_output
-- copy rule (down)
_hdOforcedIrrefutables =
_lhsIforcedIrrefutables
-- copy rule (down)
_hdOnt =
_lhsInt
-- copy rule (down)
_hdOoptions =
_lhsIoptions
-- copy rule (down)
_tlOforcedIrrefutables =
_lhsIforcedIrrefutables
-- copy rule (down)
_tlOnt =
_lhsInt
-- copy rule (down)
_tlOoptions =
_lhsIoptions
( _hdIallAttributes,_hdIerrors,_hdIoutput) =
(hd_ _hdOforcedIrrefutables _hdOnt _hdOoptions)
( _tlIallAttributes,_tlIerrors,_tlIoutput) =
(tl_ _tlOforcedIrrefutables _tlOnt _tlOoptions)
in ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput))))
sem_Productions_Nil :: T_Productions
sem_Productions_Nil =
(T_Productions (\ _lhsIforcedIrrefutables
_lhsInt
_lhsIoptions ->
(let _lhsOallAttributes :: AttrMap
_lhsOerrors :: (Seq Error)
_lhsOoutput :: Productions
-- use rule "Desugar.ag"(line 189, column 23)
_lhsOallAttributes =
Map.empty
-- use rule "Desugar.ag"(line 31, column 144)
_lhsOerrors =
Seq.empty
-- self rule
_output =
[]
-- self rule
_lhsOoutput =
_output
in ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput))))
-- Rule --------------------------------------------------------
{-
visit 0:
inherited attributes:
childInhs : [(Identifier, Identifier)]
childSyns : [(Identifier, Identifier)]
con : ConstructorIdent
defs : Set (Identifier, Identifier)
forcedIrrefutables : AttrMap
nt : NontermIdent
options : Options
synthesized attributes:
allAttributes : AttrMap
defsCollect : Set (Identifier, Identifier)
errors : Seq Error
output : SELF
alternatives:
alternative Rule:
child pattern : Pattern
child rhs : Expression
child owrt : {Bool}
child origin : {String}
visit 0:
local ruleDescr : _
local output : _
-}
-- cata
sem_Rule :: Rule ->
T_Rule
sem_Rule (Rule _pattern _rhs _owrt _origin) =
(sem_Rule_Rule (sem_Pattern _pattern) (sem_Expression _rhs) _owrt _origin)
-- semantic domain
newtype T_Rule = T_Rule (([(Identifier, Identifier)]) ->
([(Identifier, Identifier)]) ->
ConstructorIdent ->
(Set (Identifier, Identifier)) ->
AttrMap ->
NontermIdent ->
Options ->
( AttrMap,(Set (Identifier, Identifier)),(Seq Error),Rule))
data Inh_Rule = Inh_Rule {childInhs_Inh_Rule :: [(Identifier, Identifier)],childSyns_Inh_Rule :: [(Identifier, Identifier)],con_Inh_Rule :: ConstructorIdent,defs_Inh_Rule :: Set (Identifier, Identifier),forcedIrrefutables_Inh_Rule :: AttrMap,nt_Inh_Rule :: NontermIdent,options_Inh_Rule :: Options}
data Syn_Rule = Syn_Rule {allAttributes_Syn_Rule :: AttrMap,defsCollect_Syn_Rule :: Set (Identifier, Identifier),errors_Syn_Rule :: Seq Error,output_Syn_Rule :: Rule}
wrap_Rule (T_Rule sem) (Inh_Rule _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions) =
(let ( _lhsOallAttributes,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput) =
(sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions)
in (Syn_Rule _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput))
sem_Rule_Rule :: T_Pattern ->
T_Expression ->
Bool ->
String ->
T_Rule
sem_Rule_Rule (T_Pattern pattern_) (T_Expression rhs_) owrt_ origin_ =
(T_Rule (\ _lhsIchildInhs
_lhsIchildSyns
_lhsIcon
_lhsIdefs
_lhsIforcedIrrefutables
_lhsInt
_lhsIoptions ->
(let _lhsOallAttributes :: AttrMap
_lhsOdefsCollect :: (Set (Identifier, Identifier))
_lhsOerrors :: (Seq Error)
_lhsOoutput :: Rule
_patternOchildInhs :: ([(Identifier, Identifier)])
_patternOchildSyns :: ([(Identifier, Identifier)])
_patternOcon :: ConstructorIdent
_patternOdefs :: (Set (Identifier, Identifier))
_patternOforcedIrrefutables :: AttrMap
_patternOnt :: NontermIdent
_rhsOchildInhs :: ([(Identifier, Identifier)])
_rhsOchildSyns :: ([(Identifier, Identifier)])
_rhsOcon :: ConstructorIdent
_rhsOnt :: NontermIdent
_rhsOoptions :: Options
_rhsOruleDescr :: String
_patternIallAttributes :: AttrMap
_patternIcopy :: Pattern
_patternIdefsCollect :: (Set (Identifier, Identifier))
_patternIerrors :: (Seq Error)
_patternIoutput :: Pattern
_rhsIerrors :: (Seq Error)
_rhsIoutput :: Expression
-- "Desugar.ag"(line 165, column 7)
_ruleDescr =
show _lhsInt ++ " :: " ++ show _lhsIcon ++ " :: " ++ (concat $ intersperse "," $ map (\(f,a) -> show f ++ "." ++ show a) $ Set.toList _patternIdefsCollect)
-- use rule "Desugar.ag"(line 189, column 23)
_lhsOallAttributes =
_patternIallAttributes
-- use rule "Desugar.ag"(line 172, column 52)
_lhsOdefsCollect =
_patternIdefsCollect
-- use rule "Desugar.ag"(line 31, column 144)
_lhsOerrors =
_patternIerrors Seq.<> _rhsIerrors
-- self rule
_output =
Rule _patternIoutput _rhsIoutput owrt_ origin_
-- self rule
_lhsOoutput =
_output
-- copy rule (down)
_patternOchildInhs =
_lhsIchildInhs
-- copy rule (down)
_patternOchildSyns =
_lhsIchildSyns
-- copy rule (down)
_patternOcon =
_lhsIcon
-- copy rule (down)
_patternOdefs =
_lhsIdefs
-- copy rule (down)
_patternOforcedIrrefutables =
_lhsIforcedIrrefutables
-- copy rule (down)
_patternOnt =
_lhsInt
-- copy rule (down)
_rhsOchildInhs =
_lhsIchildInhs
-- copy rule (down)
_rhsOchildSyns =
_lhsIchildSyns
-- copy rule (down)
_rhsOcon =
_lhsIcon
-- copy rule (down)
_rhsOnt =
_lhsInt
-- copy rule (down)
_rhsOoptions =
_lhsIoptions
-- copy rule (from local)
_rhsOruleDescr =
_ruleDescr
( _patternIallAttributes,_patternIcopy,_patternIdefsCollect,_patternIerrors,_patternIoutput) =
(pattern_ _patternOchildInhs _patternOchildSyns _patternOcon _patternOdefs _patternOforcedIrrefutables _patternOnt)
( _rhsIerrors,_rhsIoutput) =
(rhs_ _rhsOchildInhs _rhsOchildSyns _rhsOcon _rhsOnt _rhsOoptions _rhsOruleDescr)
in ( _lhsOallAttributes,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))))
-- Rules -------------------------------------------------------
{-
visit 0:
inherited attributes:
childInhs : [(Identifier, Identifier)]
childSyns : [(Identifier, Identifier)]
con : ConstructorIdent
defs : Set (Identifier, Identifier)
forcedIrrefutables : AttrMap
nt : NontermIdent
options : Options
synthesized attributes:
allAttributes : AttrMap
defsCollect : Set (Identifier, Identifier)
errors : Seq Error
output : SELF
alternatives:
alternative Cons:
child hd : Rule
child tl : Rules
visit 0:
local output : _
alternative Nil:
visit 0:
local output : _
-}
-- cata
sem_Rules :: Rules ->
T_Rules
sem_Rules list =
(Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list))
-- semantic domain
newtype T_Rules = T_Rules (([(Identifier, Identifier)]) ->
([(Identifier, Identifier)]) ->
ConstructorIdent ->
(Set (Identifier, Identifier)) ->
AttrMap ->
NontermIdent ->
Options ->
( AttrMap,(Set (Identifier, Identifier)),(Seq Error),Rules))
data Inh_Rules = Inh_Rules {childInhs_Inh_Rules :: [(Identifier, Identifier)],childSyns_Inh_Rules :: [(Identifier, Identifier)],con_Inh_Rules :: ConstructorIdent,defs_Inh_Rules :: Set (Identifier, Identifier),forcedIrrefutables_Inh_Rules :: AttrMap,nt_Inh_Rules :: NontermIdent,options_Inh_Rules :: Options}
data Syn_Rules = Syn_Rules {allAttributes_Syn_Rules :: AttrMap,defsCollect_Syn_Rules :: Set (Identifier, Identifier),errors_Syn_Rules :: Seq Error,output_Syn_Rules :: Rules}
wrap_Rules (T_Rules sem) (Inh_Rules _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions) =
(let ( _lhsOallAttributes,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput) =
(sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions)
in (Syn_Rules _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput))
sem_Rules_Cons :: T_Rule ->
T_Rules ->
T_Rules
sem_Rules_Cons (T_Rule hd_) (T_Rules tl_) =
(T_Rules (\ _lhsIchildInhs
_lhsIchildSyns
_lhsIcon
_lhsIdefs
_lhsIforcedIrrefutables
_lhsInt
_lhsIoptions ->
(let _lhsOallAttributes :: AttrMap
_lhsOdefsCollect :: (Set (Identifier, Identifier))
_lhsOerrors :: (Seq Error)
_lhsOoutput :: Rules
_hdOchildInhs :: ([(Identifier, Identifier)])
_hdOchildSyns :: ([(Identifier, Identifier)])
_hdOcon :: ConstructorIdent
_hdOdefs :: (Set (Identifier, Identifier))
_hdOforcedIrrefutables :: AttrMap
_hdOnt :: NontermIdent
_hdOoptions :: Options
_tlOchildInhs :: ([(Identifier, Identifier)])
_tlOchildSyns :: ([(Identifier, Identifier)])
_tlOcon :: ConstructorIdent
_tlOdefs :: (Set (Identifier, Identifier))
_tlOforcedIrrefutables :: AttrMap
_tlOnt :: NontermIdent
_tlOoptions :: Options
_hdIallAttributes :: AttrMap
_hdIdefsCollect :: (Set (Identifier, Identifier))
_hdIerrors :: (Seq Error)
_hdIoutput :: Rule
_tlIallAttributes :: AttrMap
_tlIdefsCollect :: (Set (Identifier, Identifier))
_tlIerrors :: (Seq Error)
_tlIoutput :: Rules
-- use rule "Desugar.ag"(line 189, column 23)
_lhsOallAttributes =
_hdIallAttributes `mergeAttributes` _tlIallAttributes
-- use rule "Desugar.ag"(line 172, column 52)
_lhsOdefsCollect =
_hdIdefsCollect `Set.union` _tlIdefsCollect
-- use rule "Desugar.ag"(line 31, column 144)
_lhsOerrors =
_hdIerrors Seq.<> _tlIerrors
-- self rule
_output =
(:) _hdIoutput _tlIoutput
-- self rule
_lhsOoutput =
_output
-- copy rule (down)
_hdOchildInhs =
_lhsIchildInhs
-- copy rule (down)
_hdOchildSyns =
_lhsIchildSyns
-- copy rule (down)
_hdOcon =
_lhsIcon
-- copy rule (down)
_hdOdefs =
_lhsIdefs
-- copy rule (down)
_hdOforcedIrrefutables =
_lhsIforcedIrrefutables
-- copy rule (down)
_hdOnt =
_lhsInt
-- copy rule (down)
_hdOoptions =
_lhsIoptions
-- copy rule (down)
_tlOchildInhs =
_lhsIchildInhs
-- copy rule (down)
_tlOchildSyns =
_lhsIchildSyns
-- copy rule (down)
_tlOcon =
_lhsIcon
-- copy rule (down)
_tlOdefs =
_lhsIdefs
-- copy rule (down)
_tlOforcedIrrefutables =
_lhsIforcedIrrefutables
-- copy rule (down)
_tlOnt =
_lhsInt
-- copy rule (down)
_tlOoptions =
_lhsIoptions
( _hdIallAttributes,_hdIdefsCollect,_hdIerrors,_hdIoutput) =
(hd_ _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt _hdOoptions)
( _tlIallAttributes,_tlIdefsCollect,_tlIerrors,_tlIoutput) =
(tl_ _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt _tlOoptions)
in ( _lhsOallAttributes,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))))
sem_Rules_Nil :: T_Rules
sem_Rules_Nil =
(T_Rules (\ _lhsIchildInhs
_lhsIchildSyns
_lhsIcon
_lhsIdefs
_lhsIforcedIrrefutables
_lhsInt
_lhsIoptions ->
(let _lhsOallAttributes :: AttrMap
_lhsOdefsCollect :: (Set (Identifier, Identifier))
_lhsOerrors :: (Seq Error)
_lhsOoutput :: Rules
-- use rule "Desugar.ag"(line 189, column 23)
_lhsOallAttributes =
Map.empty
-- use rule "Desugar.ag"(line 172, column 52)
_lhsOdefsCollect =
Set.empty
-- use rule "Desugar.ag"(line 31, column 144)
_lhsOerrors =
Seq.empty
-- self rule
_output =
[]
-- self rule
_lhsOoutput =
_output
in ( _lhsOallAttributes,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))))
-- TypeSig -----------------------------------------------------
{-
visit 0:
synthesized attribute:
output : SELF
alternatives:
alternative TypeSig:
child name : {Identifier}
child tp : {Type}
visit 0:
local output : _
-}
-- cata
sem_TypeSig :: TypeSig ->
T_TypeSig
sem_TypeSig (TypeSig _name _tp) =
(sem_TypeSig_TypeSig _name _tp)
-- semantic domain
newtype T_TypeSig = T_TypeSig (( TypeSig))
data Inh_TypeSig = Inh_TypeSig {}
data Syn_TypeSig = Syn_TypeSig {output_Syn_TypeSig :: TypeSig}
wrap_TypeSig (T_TypeSig sem) (Inh_TypeSig ) =
(let ( _lhsOoutput) =
(sem )
in (Syn_TypeSig _lhsOoutput))
sem_TypeSig_TypeSig :: Identifier ->
Type ->
T_TypeSig
sem_TypeSig_TypeSig name_ tp_ =
(T_TypeSig (let _lhsOoutput :: TypeSig
-- self rule
_output =
TypeSig name_ tp_
-- self rule
_lhsOoutput =
_output
in ( _lhsOoutput)))
-- TypeSigs ----------------------------------------------------
{-
visit 0:
synthesized attribute:
output : SELF
alternatives:
alternative Cons:
child hd : TypeSig
child tl : TypeSigs
visit 0:
local output : _
alternative Nil:
visit 0:
local output : _
-}
-- cata
sem_TypeSigs :: TypeSigs ->
T_TypeSigs
sem_TypeSigs list =
(Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list))
-- semantic domain
newtype T_TypeSigs = T_TypeSigs (( TypeSigs))
data Inh_TypeSigs = Inh_TypeSigs {}
data Syn_TypeSigs = Syn_TypeSigs {output_Syn_TypeSigs :: TypeSigs}
wrap_TypeSigs (T_TypeSigs sem) (Inh_TypeSigs ) =
(let ( _lhsOoutput) =
(sem )
in (Syn_TypeSigs _lhsOoutput))
sem_TypeSigs_Cons :: T_TypeSig ->
T_TypeSigs ->
T_TypeSigs
sem_TypeSigs_Cons (T_TypeSig hd_) (T_TypeSigs tl_) =
(T_TypeSigs (let _lhsOoutput :: TypeSigs
_hdIoutput :: TypeSig
_tlIoutput :: TypeSigs
-- self rule
_output =
(:) _hdIoutput _tlIoutput
-- self rule
_lhsOoutput =
_output
( _hdIoutput) =
(hd_ )
( _tlIoutput) =
(tl_ )
in ( _lhsOoutput)))
sem_TypeSigs_Nil :: T_TypeSigs
sem_TypeSigs_Nil =
(T_TypeSigs (let _lhsOoutput :: TypeSigs
-- self rule
_output =
[]
-- self rule
_lhsOoutput =
_output
in ( _lhsOoutput)))