uuagc-0.9.27: src-derived/Desugar.hs
{-# OPTIONS_GHC -XBangPatterns #-}
-- UUAGC 0.9.26 (Desugar.ag)
module Desugar where
{-# LINE 13 "Desugar.ag" #-}
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Map(Map)
import qualified Data.Sequence as Seq
import Data.Sequence(Seq,(><))
import UU.Scanner.Position(Pos(..))
import Maybe
import Data.List(intersperse)
import AbstractSyntax
import ErrorMessages
import Options
import HsToken
import HsTokenScanner
import TokenDef
import CommonTypes
{-# LINE 24 "../src-derived/Desugar.hs" #-}
{-# LINE 2 "./AbstractSyntax.ag" #-}
-- AbstractSyntax.ag imports
import Data.Set(Set)
import Data.Map(Map)
import Patterns (Pattern(..),Patterns)
import Expression (Expression(..))
import CommonTypes
{-# LINE 34 "../src-derived/Desugar.hs" #-}
{-# LINE 2 "./Patterns.ag" #-}
-- Patterns.ag imports
import UU.Scanner.Position(Pos)
import CommonTypes (ConstructorIdent,Identifier)
{-# LINE 41 "../src-derived/Desugar.hs" #-}
{-# LINE 2 "./Expression.ag" #-}
import UU.Scanner.Position(Pos)
import HsToken
{-# LINE 47 "../src-derived/Desugar.hs" #-}
{-# LINE 2 "./HsToken.ag" #-}
import CommonTypes
import UU.Scanner.Position(Pos)
{-# LINE 53 "../src-derived/Desugar.hs" #-}
{-# LINE 97 "Desugar.ag" #-}
addl :: Int -> Pos -> Pos
addl n (Pos l c f) = Pos (l+n) c f
{-# LINE 58 "../src-derived/Desugar.hs" #-}
{-# LINE 132 "Desugar.ag" #-}
maybeError :: a -> Error -> Maybe a -> (a, Seq Error)
maybeError def err mb
= maybe (def, Seq.singleton err) (\r -> (r, Seq.empty)) mb
findField :: Identifier -> Identifier -> [(Identifier,Identifier)] -> Maybe Identifier
findField fld attr list
| fld == _FIRST = f list
| fld == _LAST = f (reverse list)
| otherwise = Just fld
where
f = lookup attr
{-# LINE 73 "../src-derived/Desugar.hs" #-}
{-# LINE 203 "Desugar.ag" #-}
mergeAttributes :: AttrMap -> AttrMap -> AttrMap
mergeAttributes = Map.unionWith $ Map.unionWith $ Set.union
{-# LINE 79 "../src-derived/Desugar.hs" #-}
{-# LINE 250 "Desugar.ag" #-}
desugarExprs :: Options -> NontermIdent -> ConstructorIdent ->
[(Identifier, Identifier)] -> [(Identifier, Identifier)] ->
Seq Error -> [Expression] -> (Seq Error, [Expression])
desugarExprs options nt con childInhs childSyns
= mapAccum (desugarExpr options nt con childInhs childSyns)
where mapAccum f e = foldr (\x (e0,xs) -> let (e1,x') = f e0 x in (e1, x:xs)) (e, [])
desugarExpr :: Options -> NontermIdent -> ConstructorIdent ->
[(Identifier, Identifier)] -> [(Identifier, Identifier)] ->
Seq Error -> Expression -> (Seq Error, Expression)
desugarExpr options nt con childInhs childSyns errs expr
= (errs Seq.>< errors_Syn_Expression syn, output_Syn_Expression syn)
where
inh = Inh_Expression { childInhs_Inh_Expression = childInhs
, childSyns_Inh_Expression = childSyns
, con_Inh_Expression = con
, nt_Inh_Expression = nt
, options_Inh_Expression = options
, ruleDescr_Inh_Expression = "augment-rule"
}
sem = sem_Expression expr
syn = wrap_Expression sem inh
{-# LINE 105 "../src-derived/Desugar.hs" #-}
-- 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 virtual : {Maybe (Maybe Type)}
visit 0:
local output : _
-}
-- cata
sem_Child :: Child ->
T_Child
sem_Child !(Child _name _tp _inh _syn _virtual ) =
(sem_Child_Child _name _tp _inh _syn _virtual )
-- semantic domain
newtype T_Child = T_Child (( ([(Identifier, Identifier)]),([(Identifier, Identifier)]),Child ))
data Inh_Child = Inh_Child {}
data Syn_Child = Syn_Child {childInhs_Syn_Child :: !(([(Identifier, Identifier)])),childSyns_Syn_Child :: !(([(Identifier, Identifier)])),output_Syn_Child :: !(Child )}
wrap_Child :: T_Child ->
Inh_Child ->
Syn_Child
wrap_Child !(T_Child sem ) !(Inh_Child ) =
(let ( !_lhsOchildInhs,!_lhsOchildSyns,!_lhsOoutput) =
(sem )
in (Syn_Child _lhsOchildInhs _lhsOchildSyns _lhsOoutput ))
sem_Child_Child :: Identifier ->
Type ->
Attributes ->
Attributes ->
(Maybe (Maybe Type)) ->
T_Child
sem_Child_Child !name_ !tp_ !inh_ !syn_ !virtual_ =
(T_Child (case (({-# LINE 129 "Desugar.ag" #-}
[(i, name_) | i <- Map.keys inh_ ]
{-# LINE 148 "Desugar.hs" #-})) of
{ !_lhsOchildInhs ->
(case (({-# LINE 130 "Desugar.ag" #-}
[(s, name_) | s <- Map.keys syn_ ]
{-# LINE 152 "Desugar.hs" #-})) of
{ !_lhsOchildSyns ->
(case (({-# LINE 39 "Desugar.ag" #-}
Child name_ tp_ inh_ syn_ virtual_
{-# LINE 156 "Desugar.hs" #-})) of
{ !_output ->
(case (({-# LINE 39 "Desugar.ag" #-}
_output
{-# LINE 160 "Desugar.hs" #-})) of
{ !_lhsOoutput ->
( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput) }) }) }) }) )
-- Children ----------------------------------------------------
{-
visit 0:
synthesized attributes:
childInhs : [(Identifier, Identifier)]
childSyns : [(Identifier, Identifier)]
output : SELF
alternatives:
alternative Cons:
child hd : Child
child tl : Children
visit 0:
local output : _
alternative Nil:
visit 0:
local output : _
-}
-- cata
sem_Children :: Children ->
T_Children
sem_Children !list =
(Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list) )
-- semantic domain
newtype T_Children = T_Children (( ([(Identifier, Identifier)]),([(Identifier, Identifier)]),Children ))
data Inh_Children = Inh_Children {}
data Syn_Children = Syn_Children {childInhs_Syn_Children :: !(([(Identifier, Identifier)])),childSyns_Syn_Children :: !(([(Identifier, Identifier)])),output_Syn_Children :: !(Children )}
wrap_Children :: T_Children ->
Inh_Children ->
Syn_Children
wrap_Children !(T_Children sem ) !(Inh_Children ) =
(let ( !_lhsOchildInhs,!_lhsOchildSyns,!_lhsOoutput) =
(sem )
in (Syn_Children _lhsOchildInhs _lhsOchildSyns _lhsOoutput ))
sem_Children_Cons :: T_Child ->
T_Children ->
T_Children
sem_Children_Cons !(T_Child hd_ ) !(T_Children tl_ ) =
(T_Children (case ((tl_ )) of
{ ( !_tlIchildInhs,!_tlIchildSyns,!_tlIoutput) ->
(case ((hd_ )) of
{ ( !_hdIchildInhs,!_hdIchildSyns,!_hdIoutput) ->
(case (({-# LINE 124 "Desugar.ag" #-}
_hdIchildInhs ++ _tlIchildInhs
{-# LINE 206 "Desugar.hs" #-})) of
{ !_lhsOchildInhs ->
(case (({-# LINE 124 "Desugar.ag" #-}
_hdIchildSyns ++ _tlIchildSyns
{-# LINE 210 "Desugar.hs" #-})) of
{ !_lhsOchildSyns ->
(case (({-# LINE 39 "Desugar.ag" #-}
(:) _hdIoutput _tlIoutput
{-# LINE 214 "Desugar.hs" #-})) of
{ !_output ->
(case (({-# LINE 39 "Desugar.ag" #-}
_output
{-# LINE 218 "Desugar.hs" #-})) of
{ !_lhsOoutput ->
( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput) }) }) }) }) }) }) )
sem_Children_Nil :: T_Children
sem_Children_Nil =
(T_Children (case (({-# LINE 124 "Desugar.ag" #-}
[]
{-# LINE 225 "Desugar.hs" #-})) of
{ !_lhsOchildInhs ->
(case (({-# LINE 124 "Desugar.ag" #-}
[]
{-# LINE 229 "Desugar.hs" #-})) of
{ !_lhsOchildSyns ->
(case (({-# LINE 39 "Desugar.ag" #-}
[]
{-# LINE 233 "Desugar.hs" #-})) of
{ !_output ->
(case (({-# LINE 39 "Desugar.ag" #-}
_output
{-# LINE 237 "Desugar.hs" #-})) of
{ !_lhsOoutput ->
( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput) }) }) }) }) )
-- Expression --------------------------------------------------
{-
visit 0:
inherited attributes:
childInhs : [(Identifier, Identifier)]
childSyns : [(Identifier, Identifier)]
con : ConstructorIdent
nt : NontermIdent
options : Options
ruleDescr : String
synthesized attributes:
errors : Seq Error
output : SELF
alternatives:
alternative Expression:
child pos : {Pos}
child tks : {[HsToken]}
visit 0:
local _tup1 : _
local tks' : _
-}
-- cata
sem_Expression :: Expression ->
T_Expression
sem_Expression !(Expression _pos _tks ) =
(sem_Expression_Expression _pos _tks )
-- semantic domain
newtype T_Expression = T_Expression (([(Identifier, Identifier)]) ->
([(Identifier, Identifier)]) ->
ConstructorIdent ->
NontermIdent ->
Options ->
String ->
( (Seq Error),Expression ))
data Inh_Expression = Inh_Expression {childInhs_Inh_Expression :: !(([(Identifier, Identifier)])),childSyns_Inh_Expression :: !(([(Identifier, Identifier)])),con_Inh_Expression :: !(ConstructorIdent),nt_Inh_Expression :: !(NontermIdent),options_Inh_Expression :: !(Options),ruleDescr_Inh_Expression :: !(String)}
data Syn_Expression = Syn_Expression {errors_Syn_Expression :: !((Seq Error)),output_Syn_Expression :: !(Expression )}
wrap_Expression :: T_Expression ->
Inh_Expression ->
Syn_Expression
wrap_Expression !(T_Expression sem ) !(Inh_Expression _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIoptions _lhsIruleDescr ) =
(let ( !_lhsOerrors,!_lhsOoutput) =
(sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIoptions _lhsIruleDescr )
in (Syn_Expression _lhsOerrors _lhsOoutput ))
sem_Expression_Expression :: Pos ->
([HsToken]) ->
T_Expression
sem_Expression_Expression !pos_ !tks_ =
(T_Expression (\ (!_lhsIchildInhs)
(!_lhsIchildSyns)
(!_lhsIcon)
(!_lhsInt)
(!_lhsIoptions)
(!_lhsIruleDescr) ->
(case (({-# LINE 48 "Desugar.ag" #-}
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)
{-# LINE 304 "Desugar.hs" #-})) of
{ !__tup1 ->
(case (({-# LINE 48 "Desugar.ag" #-}
__tup1
{-# LINE 308 "Desugar.hs" #-})) of
{ !(_,!_lhsOerrors) ->
(case (({-# LINE 48 "Desugar.ag" #-}
__tup1
{-# LINE 312 "Desugar.hs" #-})) of
{ !(!_tks',_) ->
(case (({-# LINE 58 "Desugar.ag" #-}
Expression pos_ _tks'
{-# LINE 316 "Desugar.hs" #-})) of
{ !_lhsOoutput ->
( _lhsOerrors,_lhsOoutput) }) }) }) })) )
-- Grammar -----------------------------------------------------
{-
visit 0:
inherited attributes:
forcedIrrefutables : AttrMap
options : Options
synthesized attributes:
allAttributes : AttrMap
errors : Seq Error
output : SELF
alternatives:
alternative Grammar:
child typeSyns : {TypeSyns}
child useMap : {UseMap}
child derivings : {Derivings}
child wrappers : {Set NontermIdent}
child nonts : Nonterminals
child pragmas : {PragmaMap}
child manualAttrOrderMap : {AttrOrderMap}
child paramMap : {ParamMap}
child contextMap : {ContextMap}
child uniqueMap : {UniqueMap}
child augmentsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))}
child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))}
-}
-- cata
sem_Grammar :: Grammar ->
T_Grammar
sem_Grammar !(Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap _augmentsMap _aroundsMap ) =
(sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts ) _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap _augmentsMap _aroundsMap )
-- semantic domain
newtype T_Grammar = T_Grammar (AttrMap ->
Options ->
( AttrMap,(Seq Error),Grammar ))
data Inh_Grammar = Inh_Grammar {forcedIrrefutables_Inh_Grammar :: !(AttrMap),options_Inh_Grammar :: !(Options)}
data Syn_Grammar = Syn_Grammar {allAttributes_Syn_Grammar :: !(AttrMap),errors_Syn_Grammar :: !((Seq Error)),output_Syn_Grammar :: !(Grammar )}
wrap_Grammar :: T_Grammar ->
Inh_Grammar ->
Syn_Grammar
wrap_Grammar !(T_Grammar sem ) !(Inh_Grammar _lhsIforcedIrrefutables _lhsIoptions ) =
(let ( !_lhsOallAttributes,!_lhsOerrors,!_lhsOoutput) =
(sem _lhsIforcedIrrefutables _lhsIoptions )
in (Syn_Grammar _lhsOallAttributes _lhsOerrors _lhsOoutput ))
sem_Grammar_Grammar :: TypeSyns ->
UseMap ->
Derivings ->
(Set NontermIdent) ->
T_Nonterminals ->
PragmaMap ->
AttrOrderMap ->
ParamMap ->
ContextMap ->
UniqueMap ->
(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) ->
(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) ->
T_Grammar
sem_Grammar_Grammar !typeSyns_ !useMap_ !derivings_ !wrappers_ !(T_Nonterminals nonts_ ) !pragmas_ !manualAttrOrderMap_ !paramMap_ !contextMap_ !uniqueMap_ !augmentsMap_ !aroundsMap_ =
(T_Grammar (\ (!_lhsIforcedIrrefutables)
(!_lhsIoptions) ->
(case (({-# LINE 35 "Desugar.ag" #-}
_lhsIoptions
{-# LINE 380 "Desugar.hs" #-})) of
{ !_nontsOoptions ->
(case (({-# LINE 214 "Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 384 "Desugar.hs" #-})) of
{ !_nontsOforcedIrrefutables ->
(case (({-# LINE 234 "Desugar.ag" #-}
augmentsMap_
{-# LINE 388 "Desugar.hs" #-})) of
{ !_nontsOaugmentsIn ->
(case ((nonts_ _nontsOaugmentsIn _nontsOforcedIrrefutables _nontsOoptions )) of
{ ( !_nontsIallAttributes,!_nontsIaugmentsOut,!_nontsIerrors,!_nontsIoutput) ->
(case (({-# LINE 195 "Desugar.ag" #-}
_nontsIallAttributes
{-# LINE 394 "Desugar.hs" #-})) of
{ !_lhsOallAttributes ->
(case (({-# LINE 37 "Desugar.ag" #-}
_nontsIerrors
{-# LINE 398 "Desugar.hs" #-})) of
{ !_lhsOerrors ->
(case (({-# LINE 290 "Desugar.ag" #-}
Grammar typeSyns_
useMap_
derivings_
wrappers_
_nontsIoutput
pragmas_
manualAttrOrderMap_
paramMap_
contextMap_
uniqueMap_
_nontsIaugmentsOut
aroundsMap_
{-# LINE 413 "Desugar.hs" #-})) of
{ !_lhsOoutput ->
( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) })) )
-- HsToken -----------------------------------------------------
{-
visit 0:
inherited attributes:
childInhs : [(Identifier, Identifier)]
childSyns : [(Identifier, Identifier)]
con : ConstructorIdent
nt : NontermIdent
ruleDescr : String
useFieldIdent : Bool
chained attribute:
addLines : Int
synthesized attributes:
errors : Seq Error
tks : SELF
alternatives:
alternative AGField:
child field : {Identifier}
child attr : {Identifier}
child pos : {Pos}
child rdesc : {Maybe String}
visit 0:
local mField : _
local field' : _
local tks : _
alternative AGLocal:
child var : {Identifier}
child pos : {Pos}
child rdesc : {Maybe String}
visit 0:
local tks : _
alternative CharToken:
child value : {String}
child pos : {Pos}
visit 0:
local tks : _
alternative Err:
child mesg : {String}
child pos : {Pos}
visit 0:
local tks : _
alternative HsToken:
child value : {String}
child pos : {Pos}
visit 0:
local tks : _
alternative StrToken:
child value : {String}
child pos : {Pos}
visit 0:
local tks : _
-}
-- cata
sem_HsToken :: HsToken ->
T_HsToken
sem_HsToken !(AGField _field _attr _pos _rdesc ) =
(sem_HsToken_AGField _field _attr _pos _rdesc )
sem_HsToken !(AGLocal _var _pos _rdesc ) =
(sem_HsToken_AGLocal _var _pos _rdesc )
sem_HsToken !(CharToken _value _pos ) =
(sem_HsToken_CharToken _value _pos )
sem_HsToken !(Err _mesg _pos ) =
(sem_HsToken_Err _mesg _pos )
sem_HsToken !(HsToken _value _pos ) =
(sem_HsToken_HsToken _value _pos )
sem_HsToken !(StrToken _value _pos ) =
(sem_HsToken_StrToken _value _pos )
-- semantic domain
newtype T_HsToken = T_HsToken (Int ->
([(Identifier, Identifier)]) ->
([(Identifier, Identifier)]) ->
ConstructorIdent ->
NontermIdent ->
String ->
Bool ->
( Int,(Seq Error),HsToken ))
data Inh_HsToken = Inh_HsToken {addLines_Inh_HsToken :: !(Int),childInhs_Inh_HsToken :: !(([(Identifier, Identifier)])),childSyns_Inh_HsToken :: !(([(Identifier, Identifier)])),con_Inh_HsToken :: !(ConstructorIdent),nt_Inh_HsToken :: !(NontermIdent),ruleDescr_Inh_HsToken :: !(String),useFieldIdent_Inh_HsToken :: !(Bool)}
data Syn_HsToken = Syn_HsToken {addLines_Syn_HsToken :: !(Int),errors_Syn_HsToken :: !((Seq Error)),tks_Syn_HsToken :: !(HsToken )}
wrap_HsToken :: T_HsToken ->
Inh_HsToken ->
Syn_HsToken
wrap_HsToken !(T_HsToken sem ) !(Inh_HsToken _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent ) =
(let ( !_lhsOaddLines,!_lhsOerrors,!_lhsOtks) =
(sem _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent )
in (Syn_HsToken _lhsOaddLines _lhsOerrors _lhsOtks ))
sem_HsToken_AGField :: Identifier ->
Identifier ->
Pos ->
(Maybe String) ->
T_HsToken
sem_HsToken_AGField !field_ !attr_ !pos_ !rdesc_ =
(T_HsToken (\ (!_lhsIaddLines)
(!_lhsIchildInhs)
(!_lhsIchildSyns)
(!_lhsIcon)
(!_lhsInt)
(!_lhsIruleDescr)
(!_lhsIuseFieldIdent) ->
(case (({-# LINE 78 "Desugar.ag" #-}
findField field_ attr_ _lhsIchildSyns
{-# LINE 516 "Desugar.hs" #-})) of
{ !_mField ->
(case (({-# LINE 80 "Desugar.ag" #-}
maybe field_ id _mField
{-# LINE 520 "Desugar.hs" #-})) of
{ !_field' ->
(case (({-# LINE 83 "Desugar.ag" #-}
if _lhsIuseFieldIdent || length (getName field_) < length (getName _field' )
then _lhsIaddLines + 1
else _lhsIaddLines
{-# LINE 526 "Desugar.hs" #-})) of
{ !_lhsOaddLines ->
(case (({-# LINE 81 "Desugar.ag" #-}
maybe (Seq.singleton (UndefAttr _lhsInt _lhsIcon field_ (Ident "<ANY>" (getPos field_)) False)) (const Seq.empty) _mField
{-# LINE 530 "Desugar.hs" #-})) of
{ !_lhsOerrors ->
(case (({-# LINE 87 "Desugar.ag" #-}
AGField _field' attr_ (addl _lhsIaddLines pos_) (if _lhsIuseFieldIdent then Just _lhsIruleDescr else Nothing)
{-# LINE 534 "Desugar.hs" #-})) of
{ !_tks ->
(case (({-# LINE 69 "Desugar.ag" #-}
_tks
{-# LINE 538 "Desugar.hs" #-})) of
{ !_lhsOtks ->
( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) }) }) })) )
sem_HsToken_AGLocal :: Identifier ->
Pos ->
(Maybe String) ->
T_HsToken
sem_HsToken_AGLocal !var_ !pos_ !rdesc_ =
(T_HsToken (\ (!_lhsIaddLines)
(!_lhsIchildInhs)
(!_lhsIchildSyns)
(!_lhsIcon)
(!_lhsInt)
(!_lhsIruleDescr)
(!_lhsIuseFieldIdent) ->
(case (({-# LINE 73 "Desugar.ag" #-}
if _lhsIuseFieldIdent
then _lhsIaddLines + 1
else _lhsIaddLines
{-# LINE 557 "Desugar.hs" #-})) of
{ !_lhsOaddLines ->
(case (({-# LINE 37 "Desugar.ag" #-}
Seq.empty
{-# LINE 561 "Desugar.hs" #-})) of
{ !_lhsOerrors ->
(case (({-# LINE 76 "Desugar.ag" #-}
AGLocal var_ (addl _lhsIaddLines pos_) (if _lhsIuseFieldIdent then Just _lhsIruleDescr else Nothing)
{-# LINE 565 "Desugar.hs" #-})) of
{ !_tks ->
(case (({-# LINE 69 "Desugar.ag" #-}
_tks
{-# LINE 569 "Desugar.hs" #-})) of
{ !_lhsOtks ->
( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) })) )
sem_HsToken_CharToken :: String ->
Pos ->
T_HsToken
sem_HsToken_CharToken !value_ !pos_ =
(T_HsToken (\ (!_lhsIaddLines)
(!_lhsIchildInhs)
(!_lhsIchildSyns)
(!_lhsIcon)
(!_lhsInt)
(!_lhsIruleDescr)
(!_lhsIuseFieldIdent) ->
(case (({-# LINE 63 "Desugar.ag" #-}
_lhsIaddLines
{-# LINE 585 "Desugar.hs" #-})) of
{ !_lhsOaddLines ->
(case (({-# LINE 37 "Desugar.ag" #-}
Seq.empty
{-# LINE 589 "Desugar.hs" #-})) of
{ !_lhsOerrors ->
(case (({-# LINE 91 "Desugar.ag" #-}
CharToken value_ (addl _lhsIaddLines pos_)
{-# LINE 593 "Desugar.hs" #-})) of
{ !_tks ->
(case (({-# LINE 69 "Desugar.ag" #-}
_tks
{-# LINE 597 "Desugar.hs" #-})) of
{ !_lhsOtks ->
( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) })) )
sem_HsToken_Err :: String ->
Pos ->
T_HsToken
sem_HsToken_Err !mesg_ !pos_ =
(T_HsToken (\ (!_lhsIaddLines)
(!_lhsIchildInhs)
(!_lhsIchildSyns)
(!_lhsIcon)
(!_lhsInt)
(!_lhsIruleDescr)
(!_lhsIuseFieldIdent) ->
(case (({-# LINE 63 "Desugar.ag" #-}
_lhsIaddLines
{-# LINE 613 "Desugar.hs" #-})) of
{ !_lhsOaddLines ->
(case (({-# LINE 37 "Desugar.ag" #-}
Seq.empty
{-# LINE 617 "Desugar.hs" #-})) of
{ !_lhsOerrors ->
(case (({-# LINE 95 "Desugar.ag" #-}
Err mesg_ (addl _lhsIaddLines pos_)
{-# LINE 621 "Desugar.hs" #-})) of
{ !_tks ->
(case (({-# LINE 69 "Desugar.ag" #-}
_tks
{-# LINE 625 "Desugar.hs" #-})) of
{ !_lhsOtks ->
( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) })) )
sem_HsToken_HsToken :: String ->
Pos ->
T_HsToken
sem_HsToken_HsToken !value_ !pos_ =
(T_HsToken (\ (!_lhsIaddLines)
(!_lhsIchildInhs)
(!_lhsIchildSyns)
(!_lhsIcon)
(!_lhsInt)
(!_lhsIruleDescr)
(!_lhsIuseFieldIdent) ->
(case (({-# LINE 63 "Desugar.ag" #-}
_lhsIaddLines
{-# LINE 641 "Desugar.hs" #-})) of
{ !_lhsOaddLines ->
(case (({-# LINE 37 "Desugar.ag" #-}
Seq.empty
{-# LINE 645 "Desugar.hs" #-})) of
{ !_lhsOerrors ->
(case (({-# LINE 89 "Desugar.ag" #-}
HsToken value_ (addl _lhsIaddLines pos_)
{-# LINE 649 "Desugar.hs" #-})) of
{ !_tks ->
(case (({-# LINE 69 "Desugar.ag" #-}
_tks
{-# LINE 653 "Desugar.hs" #-})) of
{ !_lhsOtks ->
( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) })) )
sem_HsToken_StrToken :: String ->
Pos ->
T_HsToken
sem_HsToken_StrToken !value_ !pos_ =
(T_HsToken (\ (!_lhsIaddLines)
(!_lhsIchildInhs)
(!_lhsIchildSyns)
(!_lhsIcon)
(!_lhsInt)
(!_lhsIruleDescr)
(!_lhsIuseFieldIdent) ->
(case (({-# LINE 63 "Desugar.ag" #-}
_lhsIaddLines
{-# LINE 669 "Desugar.hs" #-})) of
{ !_lhsOaddLines ->
(case (({-# LINE 37 "Desugar.ag" #-}
Seq.empty
{-# LINE 673 "Desugar.hs" #-})) of
{ !_lhsOerrors ->
(case (({-# LINE 93 "Desugar.ag" #-}
StrToken value_ (addl _lhsIaddLines pos_)
{-# LINE 677 "Desugar.hs" #-})) of
{ !_tks ->
(case (({-# LINE 69 "Desugar.ag" #-}
_tks
{-# LINE 681 "Desugar.hs" #-})) of
{ !_lhsOtks ->
( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) })) )
-- HsTokens ----------------------------------------------------
{-
visit 0:
inherited attributes:
childInhs : [(Identifier, Identifier)]
childSyns : [(Identifier, Identifier)]
con : ConstructorIdent
nt : NontermIdent
ruleDescr : String
useFieldIdent : Bool
chained attribute:
addLines : Int
synthesized attributes:
errors : Seq Error
tks : SELF
alternatives:
alternative Cons:
child hd : HsToken
child tl : HsTokens
visit 0:
local tks : _
alternative Nil:
visit 0:
local tks : _
-}
-- cata
sem_HsTokens :: HsTokens ->
T_HsTokens
sem_HsTokens !list =
(Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list) )
-- semantic domain
newtype T_HsTokens = T_HsTokens (Int ->
([(Identifier, Identifier)]) ->
([(Identifier, Identifier)]) ->
ConstructorIdent ->
NontermIdent ->
String ->
Bool ->
( Int,(Seq Error),HsTokens ))
data Inh_HsTokens = Inh_HsTokens {addLines_Inh_HsTokens :: !(Int),childInhs_Inh_HsTokens :: !(([(Identifier, Identifier)])),childSyns_Inh_HsTokens :: !(([(Identifier, Identifier)])),con_Inh_HsTokens :: !(ConstructorIdent),nt_Inh_HsTokens :: !(NontermIdent),ruleDescr_Inh_HsTokens :: !(String),useFieldIdent_Inh_HsTokens :: !(Bool)}
data Syn_HsTokens = Syn_HsTokens {addLines_Syn_HsTokens :: !(Int),errors_Syn_HsTokens :: !((Seq Error)),tks_Syn_HsTokens :: !(HsTokens )}
wrap_HsTokens :: T_HsTokens ->
Inh_HsTokens ->
Syn_HsTokens
wrap_HsTokens !(T_HsTokens sem ) !(Inh_HsTokens _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent ) =
(let ( !_lhsOaddLines,!_lhsOerrors,!_lhsOtks) =
(sem _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent )
in (Syn_HsTokens _lhsOaddLines _lhsOerrors _lhsOtks ))
sem_HsTokens_Cons :: T_HsToken ->
T_HsTokens ->
T_HsTokens
sem_HsTokens_Cons !(T_HsToken hd_ ) !(T_HsTokens tl_ ) =
(T_HsTokens (\ (!_lhsIaddLines)
(!_lhsIchildInhs)
(!_lhsIchildSyns)
(!_lhsIcon)
(!_lhsInt)
(!_lhsIruleDescr)
(!_lhsIuseFieldIdent) ->
(case (({-# LINE 61 "Desugar.ag" #-}
_lhsIuseFieldIdent
{-# LINE 745 "Desugar.hs" #-})) of
{ !_tlOuseFieldIdent ->
(case (({-# LINE 125 "Desugar.ag" #-}
_lhsIchildSyns
{-# LINE 749 "Desugar.hs" #-})) of
{ !_tlOchildSyns ->
(case (({-# LINE 61 "Desugar.ag" #-}
_lhsIuseFieldIdent
{-# LINE 753 "Desugar.hs" #-})) of
{ !_hdOuseFieldIdent ->
(case (({-# LINE 125 "Desugar.ag" #-}
_lhsIchildSyns
{-# LINE 757 "Desugar.hs" #-})) of
{ !_hdOchildSyns ->
(case (({-# LINE 63 "Desugar.ag" #-}
_lhsIaddLines
{-# LINE 761 "Desugar.hs" #-})) of
{ !_hdOaddLines ->
(case (({-# LINE 167 "Desugar.ag" #-}
_lhsIruleDescr
{-# LINE 765 "Desugar.hs" #-})) of
{ !_hdOruleDescr ->
(case (({-# LINE 151 "Desugar.ag" #-}
_lhsInt
{-# LINE 769 "Desugar.hs" #-})) of
{ !_hdOnt ->
(case (({-# LINE 152 "Desugar.ag" #-}
_lhsIcon
{-# LINE 773 "Desugar.hs" #-})) of
{ !_hdOcon ->
(case (({-# LINE 125 "Desugar.ag" #-}
_lhsIchildInhs
{-# LINE 777 "Desugar.hs" #-})) of
{ !_hdOchildInhs ->
(case ((hd_ _hdOaddLines _hdOchildInhs _hdOchildSyns _hdOcon _hdOnt _hdOruleDescr _hdOuseFieldIdent )) of
{ ( !_hdIaddLines,!_hdIerrors,!_hdItks) ->
(case (({-# LINE 63 "Desugar.ag" #-}
_hdIaddLines
{-# LINE 783 "Desugar.hs" #-})) of
{ !_tlOaddLines ->
(case (({-# LINE 167 "Desugar.ag" #-}
_lhsIruleDescr
{-# LINE 787 "Desugar.hs" #-})) of
{ !_tlOruleDescr ->
(case (({-# LINE 151 "Desugar.ag" #-}
_lhsInt
{-# LINE 791 "Desugar.hs" #-})) of
{ !_tlOnt ->
(case (({-# LINE 152 "Desugar.ag" #-}
_lhsIcon
{-# LINE 795 "Desugar.hs" #-})) of
{ !_tlOcon ->
(case (({-# LINE 125 "Desugar.ag" #-}
_lhsIchildInhs
{-# LINE 799 "Desugar.hs" #-})) of
{ !_tlOchildInhs ->
(case ((tl_ _tlOaddLines _tlOchildInhs _tlOchildSyns _tlOcon _tlOnt _tlOruleDescr _tlOuseFieldIdent )) of
{ ( !_tlIaddLines,!_tlIerrors,!_tlItks) ->
(case (({-# LINE 63 "Desugar.ag" #-}
_tlIaddLines
{-# LINE 805 "Desugar.hs" #-})) of
{ !_lhsOaddLines ->
(case (({-# LINE 37 "Desugar.ag" #-}
_hdIerrors Seq.>< _tlIerrors
{-# LINE 809 "Desugar.hs" #-})) of
{ !_lhsOerrors ->
(case (({-# LINE 69 "Desugar.ag" #-}
(:) _hdItks _tlItks
{-# LINE 813 "Desugar.hs" #-})) of
{ !_tks ->
(case (({-# LINE 69 "Desugar.ag" #-}
_tks
{-# LINE 817 "Desugar.hs" #-})) of
{ !_lhsOtks ->
( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) )
sem_HsTokens_Nil :: T_HsTokens
sem_HsTokens_Nil =
(T_HsTokens (\ (!_lhsIaddLines)
(!_lhsIchildInhs)
(!_lhsIchildSyns)
(!_lhsIcon)
(!_lhsInt)
(!_lhsIruleDescr)
(!_lhsIuseFieldIdent) ->
(case (({-# LINE 63 "Desugar.ag" #-}
_lhsIaddLines
{-# LINE 831 "Desugar.hs" #-})) of
{ !_lhsOaddLines ->
(case (({-# LINE 37 "Desugar.ag" #-}
Seq.empty
{-# LINE 835 "Desugar.hs" #-})) of
{ !_lhsOerrors ->
(case (({-# LINE 69 "Desugar.ag" #-}
[]
{-# LINE 839 "Desugar.hs" #-})) of
{ !_tks ->
(case (({-# LINE 69 "Desugar.ag" #-}
_tks
{-# LINE 843 "Desugar.hs" #-})) of
{ !_lhsOtks ->
( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) })) )
-- HsTokensRoot ------------------------------------------------
{-
visit 0:
inherited attributes:
childInhs : [(Identifier, Identifier)]
childSyns : [(Identifier, Identifier)]
con : ConstructorIdent
nt : NontermIdent
ruleDescr : String
useFieldIdent : Bool
synthesized attributes:
errors : Seq Error
tks : [HsToken]
alternatives:
alternative HsTokensRoot:
child tokens : HsTokens
-}
-- cata
sem_HsTokensRoot :: HsTokensRoot ->
T_HsTokensRoot
sem_HsTokensRoot !(HsTokensRoot _tokens ) =
(sem_HsTokensRoot_HsTokensRoot (sem_HsTokens _tokens ) )
-- semantic domain
newtype T_HsTokensRoot = T_HsTokensRoot (([(Identifier, Identifier)]) ->
([(Identifier, Identifier)]) ->
ConstructorIdent ->
NontermIdent ->
String ->
Bool ->
( (Seq Error),([HsToken])))
data Inh_HsTokensRoot = Inh_HsTokensRoot {childInhs_Inh_HsTokensRoot :: !(([(Identifier, Identifier)])),childSyns_Inh_HsTokensRoot :: !(([(Identifier, Identifier)])),con_Inh_HsTokensRoot :: !(ConstructorIdent),nt_Inh_HsTokensRoot :: !(NontermIdent),ruleDescr_Inh_HsTokensRoot :: !(String),useFieldIdent_Inh_HsTokensRoot :: !(Bool)}
data Syn_HsTokensRoot = Syn_HsTokensRoot {errors_Syn_HsTokensRoot :: !((Seq Error)),tks_Syn_HsTokensRoot :: !(([HsToken]))}
wrap_HsTokensRoot :: T_HsTokensRoot ->
Inh_HsTokensRoot ->
Syn_HsTokensRoot
wrap_HsTokensRoot !(T_HsTokensRoot sem ) !(Inh_HsTokensRoot _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent ) =
(let ( !_lhsOerrors,!_lhsOtks) =
(sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent )
in (Syn_HsTokensRoot _lhsOerrors _lhsOtks ))
sem_HsTokensRoot_HsTokensRoot :: T_HsTokens ->
T_HsTokensRoot
sem_HsTokensRoot_HsTokensRoot !(T_HsTokens tokens_ ) =
(T_HsTokensRoot (\ (!_lhsIchildInhs)
(!_lhsIchildSyns)
(!_lhsIcon)
(!_lhsInt)
(!_lhsIruleDescr)
(!_lhsIuseFieldIdent) ->
(case (({-# LINE 151 "Desugar.ag" #-}
_lhsInt
{-# LINE 896 "Desugar.hs" #-})) of
{ !_tokensOnt ->
(case (({-# LINE 152 "Desugar.ag" #-}
_lhsIcon
{-# LINE 900 "Desugar.hs" #-})) of
{ !_tokensOcon ->
(case (({-# LINE 125 "Desugar.ag" #-}
_lhsIchildSyns
{-# LINE 904 "Desugar.hs" #-})) of
{ !_tokensOchildSyns ->
(case (({-# LINE 61 "Desugar.ag" #-}
_lhsIuseFieldIdent
{-# LINE 908 "Desugar.hs" #-})) of
{ !_tokensOuseFieldIdent ->
(case (({-# LINE 167 "Desugar.ag" #-}
_lhsIruleDescr
{-# LINE 912 "Desugar.hs" #-})) of
{ !_tokensOruleDescr ->
(case (({-# LINE 125 "Desugar.ag" #-}
_lhsIchildInhs
{-# LINE 916 "Desugar.hs" #-})) of
{ !_tokensOchildInhs ->
(case (({-# LINE 66 "Desugar.ag" #-}
0
{-# LINE 920 "Desugar.hs" #-})) of
{ !_tokensOaddLines ->
(case ((tokens_ _tokensOaddLines _tokensOchildInhs _tokensOchildSyns _tokensOcon _tokensOnt _tokensOruleDescr _tokensOuseFieldIdent )) of
{ ( !_tokensIaddLines,!_tokensIerrors,!_tokensItks) ->
(case (({-# LINE 37 "Desugar.ag" #-}
_tokensIerrors
{-# LINE 926 "Desugar.hs" #-})) of
{ !_lhsOerrors ->
(case (({-# LINE 68 "Desugar.ag" #-}
_tokensItks
{-# LINE 930 "Desugar.hs" #-})) of
{ !_lhsOtks ->
( _lhsOerrors,_lhsOtks) }) }) }) }) }) }) }) }) }) })) )
-- Nonterminal -------------------------------------------------
{-
visit 0:
inherited attributes:
augmentsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))
forcedIrrefutables : AttrMap
options : Options
synthesized attributes:
allAttributes : AttrMap
augmentsOut : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))
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 augmentsIn : _
local augmentsOut : _
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 ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) ->
AttrMap ->
Options ->
( AttrMap,(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))),(Seq Error),Nonterminal ))
data Inh_Nonterminal = Inh_Nonterminal {augmentsIn_Inh_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),forcedIrrefutables_Inh_Nonterminal :: !(AttrMap),options_Inh_Nonterminal :: !(Options)}
data Syn_Nonterminal = Syn_Nonterminal {allAttributes_Syn_Nonterminal :: !(AttrMap),augmentsOut_Syn_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),errors_Syn_Nonterminal :: !((Seq Error)),output_Syn_Nonterminal :: !(Nonterminal )}
wrap_Nonterminal :: T_Nonterminal ->
Inh_Nonterminal ->
Syn_Nonterminal
wrap_Nonterminal !(T_Nonterminal sem ) !(Inh_Nonterminal _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIoptions ) =
(let ( !_lhsOallAttributes,!_lhsOaugmentsOut,!_lhsOerrors,!_lhsOoutput) =
(sem _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIoptions )
in (Syn_Nonterminal _lhsOallAttributes _lhsOaugmentsOut _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 (\ (!_lhsIaugmentsIn)
(!_lhsIforcedIrrefutables)
(!_lhsIoptions) ->
(case (({-# LINE 156 "Desugar.ag" #-}
nt_
{-# LINE 988 "Desugar.hs" #-})) of
{ !_prodsOnt ->
(case (({-# LINE 35 "Desugar.ag" #-}
_lhsIoptions
{-# LINE 992 "Desugar.hs" #-})) of
{ !_prodsOoptions ->
(case (({-# LINE 214 "Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 996 "Desugar.hs" #-})) of
{ !_prodsOforcedIrrefutables ->
(case (({-# LINE 238 "Desugar.ag" #-}
Map.findWithDefault Map.empty nt_ _lhsIaugmentsIn
{-# LINE 1000 "Desugar.hs" #-})) of
{ !_augmentsIn ->
(case (({-# LINE 229 "Desugar.ag" #-}
_augmentsIn
{-# LINE 1004 "Desugar.hs" #-})) of
{ !_prodsOaugmentsIn ->
(case ((prods_ _prodsOaugmentsIn _prodsOforcedIrrefutables _prodsOnt _prodsOoptions )) of
{ ( !_prodsIallAttributes,!_prodsIaugmentsOut,!_prodsIerrors,!_prodsIoutput) ->
(case (({-# LINE 195 "Desugar.ag" #-}
_prodsIallAttributes
{-# LINE 1010 "Desugar.hs" #-})) of
{ !_lhsOallAttributes ->
(case (({-# LINE 239 "Desugar.ag" #-}
Map.singleton nt_ _prodsIaugmentsOut
{-# LINE 1014 "Desugar.hs" #-})) of
{ !_augmentsOut ->
(case (({-# LINE 228 "Desugar.ag" #-}
_augmentsOut
{-# LINE 1018 "Desugar.hs" #-})) of
{ !_lhsOaugmentsOut ->
(case (({-# LINE 37 "Desugar.ag" #-}
_prodsIerrors
{-# LINE 1022 "Desugar.hs" #-})) of
{ !_lhsOerrors ->
(case (({-# LINE 39 "Desugar.ag" #-}
Nonterminal nt_ params_ inh_ syn_ _prodsIoutput
{-# LINE 1026 "Desugar.hs" #-})) of
{ !_output ->
(case (({-# LINE 39 "Desugar.ag" #-}
_output
{-# LINE 1030 "Desugar.hs" #-})) of
{ !_lhsOoutput ->
( _lhsOallAttributes,_lhsOaugmentsOut,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) })) )
-- Nonterminals ------------------------------------------------
{-
visit 0:
inherited attributes:
augmentsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))
forcedIrrefutables : AttrMap
options : Options
synthesized attributes:
allAttributes : AttrMap
augmentsOut : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))
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 ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) ->
AttrMap ->
Options ->
( AttrMap,(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))),(Seq Error),Nonterminals ))
data Inh_Nonterminals = Inh_Nonterminals {augmentsIn_Inh_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),forcedIrrefutables_Inh_Nonterminals :: !(AttrMap),options_Inh_Nonterminals :: !(Options)}
data Syn_Nonterminals = Syn_Nonterminals {allAttributes_Syn_Nonterminals :: !(AttrMap),augmentsOut_Syn_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),errors_Syn_Nonterminals :: !((Seq Error)),output_Syn_Nonterminals :: !(Nonterminals )}
wrap_Nonterminals :: T_Nonterminals ->
Inh_Nonterminals ->
Syn_Nonterminals
wrap_Nonterminals !(T_Nonterminals sem ) !(Inh_Nonterminals _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIoptions ) =
(let ( !_lhsOallAttributes,!_lhsOaugmentsOut,!_lhsOerrors,!_lhsOoutput) =
(sem _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIoptions )
in (Syn_Nonterminals _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput ))
sem_Nonterminals_Cons :: T_Nonterminal ->
T_Nonterminals ->
T_Nonterminals
sem_Nonterminals_Cons !(T_Nonterminal hd_ ) !(T_Nonterminals tl_ ) =
(T_Nonterminals (\ (!_lhsIaugmentsIn)
(!_lhsIforcedIrrefutables)
(!_lhsIoptions) ->
(case (({-# LINE 35 "Desugar.ag" #-}
_lhsIoptions
{-# LINE 1083 "Desugar.hs" #-})) of
{ !_tlOoptions ->
(case (({-# LINE 214 "Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 1087 "Desugar.hs" #-})) of
{ !_tlOforcedIrrefutables ->
(case (({-# LINE 227 "Desugar.ag" #-}
_lhsIaugmentsIn
{-# LINE 1091 "Desugar.hs" #-})) of
{ !_tlOaugmentsIn ->
(case ((tl_ _tlOaugmentsIn _tlOforcedIrrefutables _tlOoptions )) of
{ ( !_tlIallAttributes,!_tlIaugmentsOut,!_tlIerrors,!_tlIoutput) ->
(case (({-# LINE 35 "Desugar.ag" #-}
_lhsIoptions
{-# LINE 1097 "Desugar.hs" #-})) of
{ !_hdOoptions ->
(case (({-# LINE 214 "Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 1101 "Desugar.hs" #-})) of
{ !_hdOforcedIrrefutables ->
(case (({-# LINE 227 "Desugar.ag" #-}
_lhsIaugmentsIn
{-# LINE 1105 "Desugar.hs" #-})) of
{ !_hdOaugmentsIn ->
(case ((hd_ _hdOaugmentsIn _hdOforcedIrrefutables _hdOoptions )) of
{ ( !_hdIallAttributes,!_hdIaugmentsOut,!_hdIerrors,!_hdIoutput) ->
(case (({-# LINE 195 "Desugar.ag" #-}
_hdIallAttributes `mergeAttributes` _tlIallAttributes
{-# LINE 1111 "Desugar.hs" #-})) of
{ !_lhsOallAttributes ->
(case (({-# LINE 228 "Desugar.ag" #-}
_hdIaugmentsOut `Map.union` _tlIaugmentsOut
{-# LINE 1115 "Desugar.hs" #-})) of
{ !_lhsOaugmentsOut ->
(case (({-# LINE 37 "Desugar.ag" #-}
_hdIerrors Seq.>< _tlIerrors
{-# LINE 1119 "Desugar.hs" #-})) of
{ !_lhsOerrors ->
(case (({-# LINE 39 "Desugar.ag" #-}
(:) _hdIoutput _tlIoutput
{-# LINE 1123 "Desugar.hs" #-})) of
{ !_output ->
(case (({-# LINE 39 "Desugar.ag" #-}
_output
{-# LINE 1127 "Desugar.hs" #-})) of
{ !_lhsOoutput ->
( _lhsOallAttributes,_lhsOaugmentsOut,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) })) )
sem_Nonterminals_Nil :: T_Nonterminals
sem_Nonterminals_Nil =
(T_Nonterminals (\ (!_lhsIaugmentsIn)
(!_lhsIforcedIrrefutables)
(!_lhsIoptions) ->
(case (({-# LINE 195 "Desugar.ag" #-}
Map.empty
{-# LINE 1137 "Desugar.hs" #-})) of
{ !_lhsOallAttributes ->
(case (({-# LINE 228 "Desugar.ag" #-}
Map.empty
{-# LINE 1141 "Desugar.hs" #-})) of
{ !_lhsOaugmentsOut ->
(case (({-# LINE 37 "Desugar.ag" #-}
Seq.empty
{-# LINE 1145 "Desugar.hs" #-})) of
{ !_lhsOerrors ->
(case (({-# LINE 39 "Desugar.ag" #-}
[]
{-# LINE 1149 "Desugar.hs" #-})) of
{ !_output ->
(case (({-# LINE 39 "Desugar.ag" #-}
_output
{-# LINE 1153 "Desugar.hs" #-})) of
{ !_lhsOoutput ->
( _lhsOallAttributes,_lhsOaugmentsOut,_lhsOerrors,_lhsOoutput) }) }) }) }) })) )
-- Pattern -----------------------------------------------------
{-
visit 0:
synthesized attribute:
defsCollect : Set (Identifier, Identifier)
visit 1:
inherited attributes:
childInhs : [(Identifier, Identifier)]
childSyns : [(Identifier, Identifier)]
con : ConstructorIdent
defs : Set (Identifier, Identifier)
forcedIrrefutables : AttrMap
nt : NontermIdent
synthesized attributes:
allAttributes : AttrMap
copy : SELF
errors : Seq Error
output : SELF
alternatives:
alternative Alias:
child field : {Identifier}
child attr : {Identifier}
child pat : Pattern
child parts : Patterns
visit 0:
local def : _
visit 1:
local copy : _
local _tup2 : _
local field' : _
local err2 : _
local err1 : _
local output : _
alternative Constr:
child name : {ConstructorIdent}
child pats : Patterns
visit 1:
local copy : _
local output : _
alternative Irrefutable:
child pat : Pattern
visit 1:
local copy : _
local output : _
alternative Product:
child pos : {Pos}
child pats : Patterns
visit 1:
local copy : _
local output : _
alternative Underscore:
child pos : {Pos}
visit 1:
local copy : _
local output : _
-}
-- cata
sem_Pattern :: Pattern ->
T_Pattern
sem_Pattern !(Alias _field _attr _pat _parts ) =
(sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) )
sem_Pattern !(Constr _name _pats ) =
(sem_Pattern_Constr _name (sem_Patterns _pats ) )
sem_Pattern !(Irrefutable _pat ) =
(sem_Pattern_Irrefutable (sem_Pattern _pat ) )
sem_Pattern !(Product _pos _pats ) =
(sem_Pattern_Product _pos (sem_Patterns _pats ) )
sem_Pattern !(Underscore _pos ) =
(sem_Pattern_Underscore _pos )
-- semantic domain
newtype T_Pattern = T_Pattern (( (Set (Identifier, Identifier)),T_Pattern_1 ))
newtype T_Pattern_1 = T_Pattern_1 (([(Identifier, Identifier)]) ->
([(Identifier, Identifier)]) ->
ConstructorIdent ->
(Set (Identifier, Identifier)) ->
AttrMap ->
NontermIdent ->
( AttrMap,Pattern ,(Seq Error),Pattern ))
data Inh_Pattern = Inh_Pattern {childInhs_Inh_Pattern :: !(([(Identifier, Identifier)])),childSyns_Inh_Pattern :: !(([(Identifier, Identifier)])),con_Inh_Pattern :: !(ConstructorIdent),defs_Inh_Pattern :: !((Set (Identifier, Identifier))),forcedIrrefutables_Inh_Pattern :: !(AttrMap),nt_Inh_Pattern :: !(NontermIdent)}
data Syn_Pattern = Syn_Pattern {allAttributes_Syn_Pattern :: !(AttrMap),copy_Syn_Pattern :: !(Pattern ),defsCollect_Syn_Pattern :: !((Set (Identifier, Identifier))),errors_Syn_Pattern :: !((Seq Error)),output_Syn_Pattern :: !(Pattern )}
wrap_Pattern :: T_Pattern ->
Inh_Pattern ->
Syn_Pattern
wrap_Pattern !(T_Pattern sem ) !(Inh_Pattern _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt ) =
(let ( !_lhsOdefsCollect,!T_Pattern_1 sem_1) =
(sem )
( !_lhsOallAttributes,!_lhsOcopy,!_lhsOerrors,!_lhsOoutput) =
(sem_1 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt )
in (Syn_Pattern _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput ))
sem_Pattern_Alias :: Identifier ->
Identifier ->
T_Pattern ->
T_Patterns ->
T_Pattern
sem_Pattern_Alias !field_ !attr_ !(T_Pattern pat_ ) !(T_Patterns parts_ ) =
(T_Pattern (case (({-# LINE 181 "Desugar.ag" #-}
Set.singleton (field_, attr_)
{-# LINE 1253 "Desugar.hs" #-})) of
{ !_def ->
(case ((parts_ )) of
{ ( !_partsIdefsCollect,!T_Patterns_1 parts_1) ->
(case ((pat_ )) of
{ ( !_patIdefsCollect,!T_Pattern_1 pat_1) ->
(case (({-# LINE 182 "Desugar.ag" #-}
_def `Set.union` _patIdefsCollect `Set.union` _partsIdefsCollect
{-# LINE 1261 "Desugar.hs" #-})) of
{ !_lhsOdefsCollect ->
(case ((let sem_Pattern_Alias_1 :: T_Pattern_1
sem_Pattern_Alias_1 =
(T_Pattern_1 (\ (!_lhsIchildInhs)
(!_lhsIchildSyns)
(!_lhsIcon)
(!_lhsIdefs)
(!_lhsIforcedIrrefutables)
(!_lhsInt) ->
(case (({-# LINE 151 "Desugar.ag" #-}
_lhsInt
{-# LINE 1273 "Desugar.hs" #-})) of
{ !_patOnt ->
(case (({-# LINE 152 "Desugar.ag" #-}
_lhsIcon
{-# LINE 1277 "Desugar.hs" #-})) of
{ !_patOcon ->
(case (({-# LINE 214 "Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 1281 "Desugar.hs" #-})) of
{ !_patOforcedIrrefutables ->
(case (({-# LINE 184 "Desugar.ag" #-}
_lhsIdefs
{-# LINE 1285 "Desugar.hs" #-})) of
{ !_patOdefs ->
(case (({-# LINE 125 "Desugar.ag" #-}
_lhsIchildSyns
{-# LINE 1289 "Desugar.hs" #-})) of
{ !_patOchildSyns ->
(case (({-# LINE 125 "Desugar.ag" #-}
_lhsIchildInhs
{-# LINE 1293 "Desugar.hs" #-})) of
{ !_patOchildInhs ->
(case ((pat_1 _patOchildInhs _patOchildSyns _patOcon _patOdefs _patOforcedIrrefutables _patOnt )) of
{ ( !_patIallAttributes,!_patIcopy,!_patIerrors,!_patIoutput) ->
(case (({-# LINE 199 "Desugar.ag" #-}
(Map.singleton _lhsInt $ Map.singleton _lhsIcon $ Set.singleton (field_, attr_)) `mergeAttributes` _patIallAttributes
{-# LINE 1299 "Desugar.hs" #-})) of
{ !_lhsOallAttributes ->
(case (({-# LINE 151 "Desugar.ag" #-}
_lhsInt
{-# LINE 1303 "Desugar.hs" #-})) of
{ !_partsOnt ->
(case (({-# LINE 214 "Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 1307 "Desugar.hs" #-})) of
{ !_partsOforcedIrrefutables ->
(case (({-# LINE 184 "Desugar.ag" #-}
_lhsIdefs
{-# LINE 1311 "Desugar.hs" #-})) of
{ !_partsOdefs ->
(case (({-# LINE 152 "Desugar.ag" #-}
_lhsIcon
{-# LINE 1315 "Desugar.hs" #-})) of
{ !_partsOcon ->
(case (({-# LINE 125 "Desugar.ag" #-}
_lhsIchildSyns
{-# LINE 1319 "Desugar.hs" #-})) of
{ !_partsOchildSyns ->
(case (({-# LINE 125 "Desugar.ag" #-}
_lhsIchildInhs
{-# LINE 1323 "Desugar.hs" #-})) of
{ !_partsOchildInhs ->
(case ((parts_1 _partsOchildInhs _partsOchildSyns _partsOcon _partsOdefs _partsOforcedIrrefutables _partsOnt )) of
{ ( !_partsIallAttributes,!_partsIcopy,!_partsIerrors,!_partsIoutput) ->
(case (({-# LINE 23 "./Patterns.ag" #-}
Alias field_ attr_ _patIcopy _partsIcopy
{-# LINE 1329 "Desugar.hs" #-})) of
{ !_copy ->
(case (({-# LINE 23 "./Patterns.ag" #-}
_copy
{-# LINE 1333 "Desugar.hs" #-})) of
{ !_lhsOcopy ->
(case (({-# LINE 109 "Desugar.ag" #-}
maybeError field_ (UndefAttr _lhsInt _lhsIcon (Ident "<ANY>" (getPos field_)) attr_ True) $
findField field_ attr_ _lhsIchildInhs
{-# LINE 1338 "Desugar.hs" #-})) of
{ !__tup2 ->
(case (({-# LINE 109 "Desugar.ag" #-}
__tup2
{-# LINE 1342 "Desugar.hs" #-})) of
{ !(!_field',_) ->
(case (({-# LINE 111 "Desugar.ag" #-}
if _field' == field_
then Seq.empty
else if (_field' , attr_) `Set.member` _lhsIdefs
then Seq.singleton $ DupRule _lhsInt _lhsIcon field_ attr_ _field'
else Seq.empty
{-# LINE 1350 "Desugar.hs" #-})) of
{ !_err2 ->
(case (({-# LINE 109 "Desugar.ag" #-}
__tup2
{-# LINE 1354 "Desugar.hs" #-})) of
{ !(_,!_err1) ->
(case (({-# LINE 116 "Desugar.ag" #-}
_err1 Seq.>< _err2 Seq.>< _patIerrors Seq.>< _partsIerrors
{-# LINE 1358 "Desugar.hs" #-})) of
{ !_lhsOerrors ->
(case (({-# LINE 117 "Desugar.ag" #-}
Alias _field' attr_ _patIoutput _partsIoutput
{-# LINE 1362 "Desugar.hs" #-})) of
{ !_output ->
(case (({-# LINE 218 "Desugar.ag" #-}
if Set.member (field_, attr_) $ Map.findWithDefault Set.empty _lhsIcon $ Map.findWithDefault Map.empty _lhsInt $ _lhsIforcedIrrefutables
then Irrefutable _output
else _output
{-# LINE 1368 "Desugar.hs" #-})) of
{ !_lhsOoutput ->
( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) )
in sem_Pattern_Alias_1)) of
{ ( !sem_Pattern_1) ->
( _lhsOdefsCollect,sem_Pattern_1) }) }) }) }) }) )
sem_Pattern_Constr :: ConstructorIdent ->
T_Patterns ->
T_Pattern
sem_Pattern_Constr !name_ !(T_Patterns pats_ ) =
(T_Pattern (case ((pats_ )) of
{ ( !_patsIdefsCollect,!T_Patterns_1 pats_1) ->
(case (({-# LINE 178 "Desugar.ag" #-}
_patsIdefsCollect
{-# LINE 1382 "Desugar.hs" #-})) of
{ !_lhsOdefsCollect ->
(case ((let sem_Pattern_Constr_1 :: T_Pattern_1
sem_Pattern_Constr_1 =
(T_Pattern_1 (\ (!_lhsIchildInhs)
(!_lhsIchildSyns)
(!_lhsIcon)
(!_lhsIdefs)
(!_lhsIforcedIrrefutables)
(!_lhsInt) ->
(case (({-# LINE 151 "Desugar.ag" #-}
_lhsInt
{-# LINE 1394 "Desugar.hs" #-})) of
{ !_patsOnt ->
(case (({-# LINE 152 "Desugar.ag" #-}
_lhsIcon
{-# LINE 1398 "Desugar.hs" #-})) of
{ !_patsOcon ->
(case (({-# LINE 214 "Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 1402 "Desugar.hs" #-})) of
{ !_patsOforcedIrrefutables ->
(case (({-# LINE 184 "Desugar.ag" #-}
_lhsIdefs
{-# LINE 1406 "Desugar.hs" #-})) of
{ !_patsOdefs ->
(case (({-# LINE 125 "Desugar.ag" #-}
_lhsIchildSyns
{-# LINE 1410 "Desugar.hs" #-})) of
{ !_patsOchildSyns ->
(case (({-# LINE 125 "Desugar.ag" #-}
_lhsIchildInhs
{-# LINE 1414 "Desugar.hs" #-})) of
{ !_patsOchildInhs ->
(case ((pats_1 _patsOchildInhs _patsOchildSyns _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt )) of
{ ( !_patsIallAttributes,!_patsIcopy,!_patsIerrors,!_patsIoutput) ->
(case (({-# LINE 195 "Desugar.ag" #-}
_patsIallAttributes
{-# LINE 1420 "Desugar.hs" #-})) of
{ !_lhsOallAttributes ->
(case (({-# LINE 23 "./Patterns.ag" #-}
Constr name_ _patsIcopy
{-# LINE 1424 "Desugar.hs" #-})) of
{ !_copy ->
(case (({-# LINE 23 "./Patterns.ag" #-}
_copy
{-# LINE 1428 "Desugar.hs" #-})) of
{ !_lhsOcopy ->
(case (({-# LINE 37 "Desugar.ag" #-}
_patsIerrors
{-# LINE 1432 "Desugar.hs" #-})) of
{ !_lhsOerrors ->
(case (({-# LINE 39 "Desugar.ag" #-}
Constr name_ _patsIoutput
{-# LINE 1436 "Desugar.hs" #-})) of
{ !_output ->
(case (({-# LINE 39 "Desugar.ag" #-}
_output
{-# LINE 1440 "Desugar.hs" #-})) of
{ !_lhsOoutput ->
( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) })) )
in sem_Pattern_Constr_1)) of
{ ( !sem_Pattern_1) ->
( _lhsOdefsCollect,sem_Pattern_1) }) }) }) )
sem_Pattern_Irrefutable :: T_Pattern ->
T_Pattern
sem_Pattern_Irrefutable !(T_Pattern pat_ ) =
(T_Pattern (case ((pat_ )) of
{ ( !_patIdefsCollect,!T_Pattern_1 pat_1) ->
(case (({-# LINE 178 "Desugar.ag" #-}
_patIdefsCollect
{-# LINE 1453 "Desugar.hs" #-})) of
{ !_lhsOdefsCollect ->
(case ((let sem_Pattern_Irrefutable_1 :: T_Pattern_1
sem_Pattern_Irrefutable_1 =
(T_Pattern_1 (\ (!_lhsIchildInhs)
(!_lhsIchildSyns)
(!_lhsIcon)
(!_lhsIdefs)
(!_lhsIforcedIrrefutables)
(!_lhsInt) ->
(case (({-# LINE 201 "Desugar.ag" #-}
Map.empty
{-# LINE 1465 "Desugar.hs" #-})) of
{ !_lhsOallAttributes ->
(case (({-# LINE 151 "Desugar.ag" #-}
_lhsInt
{-# LINE 1469 "Desugar.hs" #-})) of
{ !_patOnt ->
(case (({-# LINE 214 "Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 1473 "Desugar.hs" #-})) of
{ !_patOforcedIrrefutables ->
(case (({-# LINE 184 "Desugar.ag" #-}
_lhsIdefs
{-# LINE 1477 "Desugar.hs" #-})) of
{ !_patOdefs ->
(case (({-# LINE 152 "Desugar.ag" #-}
_lhsIcon
{-# LINE 1481 "Desugar.hs" #-})) of
{ !_patOcon ->
(case (({-# LINE 125 "Desugar.ag" #-}
_lhsIchildSyns
{-# LINE 1485 "Desugar.hs" #-})) of
{ !_patOchildSyns ->
(case (({-# LINE 125 "Desugar.ag" #-}
_lhsIchildInhs
{-# LINE 1489 "Desugar.hs" #-})) of
{ !_patOchildInhs ->
(case ((pat_1 _patOchildInhs _patOchildSyns _patOcon _patOdefs _patOforcedIrrefutables _patOnt )) of
{ ( !_patIallAttributes,!_patIcopy,!_patIerrors,!_patIoutput) ->
(case (({-# LINE 23 "./Patterns.ag" #-}
Irrefutable _patIcopy
{-# LINE 1495 "Desugar.hs" #-})) of
{ !_copy ->
(case (({-# LINE 23 "./Patterns.ag" #-}
_copy
{-# LINE 1499 "Desugar.hs" #-})) of
{ !_lhsOcopy ->
(case (({-# LINE 37 "Desugar.ag" #-}
_patIerrors
{-# LINE 1503 "Desugar.hs" #-})) of
{ !_lhsOerrors ->
(case (({-# LINE 39 "Desugar.ag" #-}
Irrefutable _patIoutput
{-# LINE 1507 "Desugar.hs" #-})) of
{ !_output ->
(case (({-# LINE 39 "Desugar.ag" #-}
_output
{-# LINE 1511 "Desugar.hs" #-})) of
{ !_lhsOoutput ->
( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) })) )
in sem_Pattern_Irrefutable_1)) of
{ ( !sem_Pattern_1) ->
( _lhsOdefsCollect,sem_Pattern_1) }) }) }) )
sem_Pattern_Product :: Pos ->
T_Patterns ->
T_Pattern
sem_Pattern_Product !pos_ !(T_Patterns pats_ ) =
(T_Pattern (case ((pats_ )) of
{ ( !_patsIdefsCollect,!T_Patterns_1 pats_1) ->
(case (({-# LINE 178 "Desugar.ag" #-}
_patsIdefsCollect
{-# LINE 1525 "Desugar.hs" #-})) of
{ !_lhsOdefsCollect ->
(case ((let sem_Pattern_Product_1 :: T_Pattern_1
sem_Pattern_Product_1 =
(T_Pattern_1 (\ (!_lhsIchildInhs)
(!_lhsIchildSyns)
(!_lhsIcon)
(!_lhsIdefs)
(!_lhsIforcedIrrefutables)
(!_lhsInt) ->
(case (({-# LINE 151 "Desugar.ag" #-}
_lhsInt
{-# LINE 1537 "Desugar.hs" #-})) of
{ !_patsOnt ->
(case (({-# LINE 152 "Desugar.ag" #-}
_lhsIcon
{-# LINE 1541 "Desugar.hs" #-})) of
{ !_patsOcon ->
(case (({-# LINE 214 "Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 1545 "Desugar.hs" #-})) of
{ !_patsOforcedIrrefutables ->
(case (({-# LINE 184 "Desugar.ag" #-}
_lhsIdefs
{-# LINE 1549 "Desugar.hs" #-})) of
{ !_patsOdefs ->
(case (({-# LINE 125 "Desugar.ag" #-}
_lhsIchildSyns
{-# LINE 1553 "Desugar.hs" #-})) of
{ !_patsOchildSyns ->
(case (({-# LINE 125 "Desugar.ag" #-}
_lhsIchildInhs
{-# LINE 1557 "Desugar.hs" #-})) of
{ !_patsOchildInhs ->
(case ((pats_1 _patsOchildInhs _patsOchildSyns _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt )) of
{ ( !_patsIallAttributes,!_patsIcopy,!_patsIerrors,!_patsIoutput) ->
(case (({-# LINE 195 "Desugar.ag" #-}
_patsIallAttributes
{-# LINE 1563 "Desugar.hs" #-})) of
{ !_lhsOallAttributes ->
(case (({-# LINE 23 "./Patterns.ag" #-}
Product pos_ _patsIcopy
{-# LINE 1567 "Desugar.hs" #-})) of
{ !_copy ->
(case (({-# LINE 23 "./Patterns.ag" #-}
_copy
{-# LINE 1571 "Desugar.hs" #-})) of
{ !_lhsOcopy ->
(case (({-# LINE 37 "Desugar.ag" #-}
_patsIerrors
{-# LINE 1575 "Desugar.hs" #-})) of
{ !_lhsOerrors ->
(case (({-# LINE 39 "Desugar.ag" #-}
Product pos_ _patsIoutput
{-# LINE 1579 "Desugar.hs" #-})) of
{ !_output ->
(case (({-# LINE 39 "Desugar.ag" #-}
_output
{-# LINE 1583 "Desugar.hs" #-})) of
{ !_lhsOoutput ->
( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) })) )
in sem_Pattern_Product_1)) of
{ ( !sem_Pattern_1) ->
( _lhsOdefsCollect,sem_Pattern_1) }) }) }) )
sem_Pattern_Underscore :: Pos ->
T_Pattern
sem_Pattern_Underscore !pos_ =
(T_Pattern (case (({-# LINE 178 "Desugar.ag" #-}
Set.empty
{-# LINE 1594 "Desugar.hs" #-})) of
{ !_lhsOdefsCollect ->
(case ((let sem_Pattern_Underscore_1 :: T_Pattern_1
sem_Pattern_Underscore_1 =
(T_Pattern_1 (\ (!_lhsIchildInhs)
(!_lhsIchildSyns)
(!_lhsIcon)
(!_lhsIdefs)
(!_lhsIforcedIrrefutables)
(!_lhsInt) ->
(case (({-# LINE 195 "Desugar.ag" #-}
Map.empty
{-# LINE 1606 "Desugar.hs" #-})) of
{ !_lhsOallAttributes ->
(case (({-# LINE 23 "./Patterns.ag" #-}
Underscore pos_
{-# LINE 1610 "Desugar.hs" #-})) of
{ !_copy ->
(case (({-# LINE 23 "./Patterns.ag" #-}
_copy
{-# LINE 1614 "Desugar.hs" #-})) of
{ !_lhsOcopy ->
(case (({-# LINE 37 "Desugar.ag" #-}
Seq.empty
{-# LINE 1618 "Desugar.hs" #-})) of
{ !_lhsOerrors ->
(case (({-# LINE 39 "Desugar.ag" #-}
Underscore pos_
{-# LINE 1622 "Desugar.hs" #-})) of
{ !_output ->
(case (({-# LINE 39 "Desugar.ag" #-}
_output
{-# LINE 1626 "Desugar.hs" #-})) of
{ !_lhsOoutput ->
( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) })) )
in sem_Pattern_Underscore_1)) of
{ ( !sem_Pattern_1) ->
( _lhsOdefsCollect,sem_Pattern_1) }) }) )
-- Patterns ----------------------------------------------------
{-
visit 0:
synthesized attribute:
defsCollect : Set (Identifier, Identifier)
visit 1:
inherited attributes:
childInhs : [(Identifier, Identifier)]
childSyns : [(Identifier, Identifier)]
con : ConstructorIdent
defs : Set (Identifier, Identifier)
forcedIrrefutables : AttrMap
nt : NontermIdent
synthesized attributes:
allAttributes : AttrMap
copy : SELF
errors : Seq Error
output : SELF
alternatives:
alternative Cons:
child hd : Pattern
child tl : Patterns
visit 1:
local copy : _
local output : _
alternative Nil:
visit 1:
local copy : _
local output : _
-}
-- cata
sem_Patterns :: Patterns ->
T_Patterns
sem_Patterns !list =
(Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) )
-- semantic domain
newtype T_Patterns = T_Patterns (( (Set (Identifier, Identifier)),T_Patterns_1 ))
newtype T_Patterns_1 = T_Patterns_1 (([(Identifier, Identifier)]) ->
([(Identifier, Identifier)]) ->
ConstructorIdent ->
(Set (Identifier, Identifier)) ->
AttrMap ->
NontermIdent ->
( AttrMap,Patterns ,(Seq Error),Patterns ))
data Inh_Patterns = Inh_Patterns {childInhs_Inh_Patterns :: !(([(Identifier, Identifier)])),childSyns_Inh_Patterns :: !(([(Identifier, Identifier)])),con_Inh_Patterns :: !(ConstructorIdent),defs_Inh_Patterns :: !((Set (Identifier, Identifier))),forcedIrrefutables_Inh_Patterns :: !(AttrMap),nt_Inh_Patterns :: !(NontermIdent)}
data Syn_Patterns = Syn_Patterns {allAttributes_Syn_Patterns :: !(AttrMap),copy_Syn_Patterns :: !(Patterns ),defsCollect_Syn_Patterns :: !((Set (Identifier, Identifier))),errors_Syn_Patterns :: !((Seq Error)),output_Syn_Patterns :: !(Patterns )}
wrap_Patterns :: T_Patterns ->
Inh_Patterns ->
Syn_Patterns
wrap_Patterns !(T_Patterns sem ) !(Inh_Patterns _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt ) =
(let ( !_lhsOdefsCollect,!T_Patterns_1 sem_1) =
(sem )
( !_lhsOallAttributes,!_lhsOcopy,!_lhsOerrors,!_lhsOoutput) =
(sem_1 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt )
in (Syn_Patterns _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput ))
sem_Patterns_Cons :: T_Pattern ->
T_Patterns ->
T_Patterns
sem_Patterns_Cons !(T_Pattern hd_ ) !(T_Patterns tl_ ) =
(T_Patterns (case ((tl_ )) of
{ ( !_tlIdefsCollect,!T_Patterns_1 tl_1) ->
(case ((hd_ )) of
{ ( !_hdIdefsCollect,!T_Pattern_1 hd_1) ->
(case (({-# LINE 178 "Desugar.ag" #-}
_hdIdefsCollect `Set.union` _tlIdefsCollect
{-# LINE 1697 "Desugar.hs" #-})) of
{ !_lhsOdefsCollect ->
(case ((let sem_Patterns_Cons_1 :: T_Patterns_1
sem_Patterns_Cons_1 =
(T_Patterns_1 (\ (!_lhsIchildInhs)
(!_lhsIchildSyns)
(!_lhsIcon)
(!_lhsIdefs)
(!_lhsIforcedIrrefutables)
(!_lhsInt) ->
(case (({-# LINE 151 "Desugar.ag" #-}
_lhsInt
{-# LINE 1709 "Desugar.hs" #-})) of
{ !_tlOnt ->
(case (({-# LINE 152 "Desugar.ag" #-}
_lhsIcon
{-# LINE 1713 "Desugar.hs" #-})) of
{ !_tlOcon ->
(case (({-# LINE 151 "Desugar.ag" #-}
_lhsInt
{-# LINE 1717 "Desugar.hs" #-})) of
{ !_hdOnt ->
(case (({-# LINE 152 "Desugar.ag" #-}
_lhsIcon
{-# LINE 1721 "Desugar.hs" #-})) of
{ !_hdOcon ->
(case (({-# LINE 214 "Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 1725 "Desugar.hs" #-})) of
{ !_tlOforcedIrrefutables ->
(case (({-# LINE 184 "Desugar.ag" #-}
_lhsIdefs
{-# LINE 1729 "Desugar.hs" #-})) of
{ !_tlOdefs ->
(case (({-# LINE 125 "Desugar.ag" #-}
_lhsIchildSyns
{-# LINE 1733 "Desugar.hs" #-})) of
{ !_tlOchildSyns ->
(case (({-# LINE 125 "Desugar.ag" #-}
_lhsIchildInhs
{-# LINE 1737 "Desugar.hs" #-})) of
{ !_tlOchildInhs ->
(case ((tl_1 _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt )) of
{ ( !_tlIallAttributes,!_tlIcopy,!_tlIerrors,!_tlIoutput) ->
(case (({-# LINE 214 "Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 1743 "Desugar.hs" #-})) of
{ !_hdOforcedIrrefutables ->
(case (({-# LINE 184 "Desugar.ag" #-}
_lhsIdefs
{-# LINE 1747 "Desugar.hs" #-})) of
{ !_hdOdefs ->
(case (({-# LINE 125 "Desugar.ag" #-}
_lhsIchildSyns
{-# LINE 1751 "Desugar.hs" #-})) of
{ !_hdOchildSyns ->
(case (({-# LINE 125 "Desugar.ag" #-}
_lhsIchildInhs
{-# LINE 1755 "Desugar.hs" #-})) of
{ !_hdOchildInhs ->
(case ((hd_1 _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt )) of
{ ( !_hdIallAttributes,!_hdIcopy,!_hdIerrors,!_hdIoutput) ->
(case (({-# LINE 195 "Desugar.ag" #-}
_hdIallAttributes `mergeAttributes` _tlIallAttributes
{-# LINE 1761 "Desugar.hs" #-})) of
{ !_lhsOallAttributes ->
(case (({-# LINE 23 "./Patterns.ag" #-}
(:) _hdIcopy _tlIcopy
{-# LINE 1765 "Desugar.hs" #-})) of
{ !_copy ->
(case (({-# LINE 23 "./Patterns.ag" #-}
_copy
{-# LINE 1769 "Desugar.hs" #-})) of
{ !_lhsOcopy ->
(case (({-# LINE 37 "Desugar.ag" #-}
_hdIerrors Seq.>< _tlIerrors
{-# LINE 1773 "Desugar.hs" #-})) of
{ !_lhsOerrors ->
(case (({-# LINE 39 "Desugar.ag" #-}
(:) _hdIoutput _tlIoutput
{-# LINE 1777 "Desugar.hs" #-})) of
{ !_output ->
(case (({-# LINE 39 "Desugar.ag" #-}
_output
{-# LINE 1781 "Desugar.hs" #-})) of
{ !_lhsOoutput ->
( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) )
in sem_Patterns_Cons_1)) of
{ ( !sem_Patterns_1) ->
( _lhsOdefsCollect,sem_Patterns_1) }) }) }) }) )
sem_Patterns_Nil :: T_Patterns
sem_Patterns_Nil =
(T_Patterns (case (({-# LINE 178 "Desugar.ag" #-}
Set.empty
{-# LINE 1791 "Desugar.hs" #-})) of
{ !_lhsOdefsCollect ->
(case ((let sem_Patterns_Nil_1 :: T_Patterns_1
sem_Patterns_Nil_1 =
(T_Patterns_1 (\ (!_lhsIchildInhs)
(!_lhsIchildSyns)
(!_lhsIcon)
(!_lhsIdefs)
(!_lhsIforcedIrrefutables)
(!_lhsInt) ->
(case (({-# LINE 195 "Desugar.ag" #-}
Map.empty
{-# LINE 1803 "Desugar.hs" #-})) of
{ !_lhsOallAttributes ->
(case (({-# LINE 23 "./Patterns.ag" #-}
[]
{-# LINE 1807 "Desugar.hs" #-})) of
{ !_copy ->
(case (({-# LINE 23 "./Patterns.ag" #-}
_copy
{-# LINE 1811 "Desugar.hs" #-})) of
{ !_lhsOcopy ->
(case (({-# LINE 37 "Desugar.ag" #-}
Seq.empty
{-# LINE 1815 "Desugar.hs" #-})) of
{ !_lhsOerrors ->
(case (({-# LINE 39 "Desugar.ag" #-}
[]
{-# LINE 1819 "Desugar.hs" #-})) of
{ !_output ->
(case (({-# LINE 39 "Desugar.ag" #-}
_output
{-# LINE 1823 "Desugar.hs" #-})) of
{ !_lhsOoutput ->
( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) })) )
in sem_Patterns_Nil_1)) of
{ ( !sem_Patterns_1) ->
( _lhsOdefsCollect,sem_Patterns_1) }) }) )
-- Production --------------------------------------------------
{-
visit 0:
inherited attributes:
augmentsIn : Map ConstructorIdent (Map Identifier [Expression])
forcedIrrefutables : AttrMap
nt : NontermIdent
options : Options
synthesized attributes:
allAttributes : AttrMap
augmentsOut : Map ConstructorIdent (Map Identifier [Expression])
errors : Seq Error
output : SELF
alternatives:
alternative Production:
child con : {ConstructorIdent}
child children : Children
child rules : Rules
child typeSigs : TypeSigs
visit 0:
local augmentsIn : _
local _tup3 : _
local augmentsOut1 : _
local augmentsOut : _
local augmentErrs : _
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 ((Map ConstructorIdent (Map Identifier [Expression])) ->
AttrMap ->
NontermIdent ->
Options ->
( AttrMap,(Map ConstructorIdent (Map Identifier [Expression])),(Seq Error),Production ))
data Inh_Production = Inh_Production {augmentsIn_Inh_Production :: !((Map ConstructorIdent (Map Identifier [Expression]))),forcedIrrefutables_Inh_Production :: !(AttrMap),nt_Inh_Production :: !(NontermIdent),options_Inh_Production :: !(Options)}
data Syn_Production = Syn_Production {allAttributes_Syn_Production :: !(AttrMap),augmentsOut_Syn_Production :: !((Map ConstructorIdent (Map Identifier [Expression]))),errors_Syn_Production :: !((Seq Error)),output_Syn_Production :: !(Production )}
wrap_Production :: T_Production ->
Inh_Production ->
Syn_Production
wrap_Production !(T_Production sem ) !(Inh_Production _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsInt _lhsIoptions ) =
(let ( !_lhsOallAttributes,!_lhsOaugmentsOut,!_lhsOerrors,!_lhsOoutput) =
(sem _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsInt _lhsIoptions )
in (Syn_Production _lhsOallAttributes _lhsOaugmentsOut _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 (\ (!_lhsIaugmentsIn)
(!_lhsIforcedIrrefutables)
(!_lhsInt)
(!_lhsIoptions) ->
(case (({-# LINE 151 "Desugar.ag" #-}
_lhsInt
{-# LINE 1888 "Desugar.hs" #-})) of
{ !_rulesOnt ->
(case (({-# LINE 160 "Desugar.ag" #-}
con_
{-# LINE 1892 "Desugar.hs" #-})) of
{ !_rulesOcon ->
(case ((rules_ )) of
{ ( !_rulesIdefsCollect,!T_Rules_1 rules_1) ->
(case (({-# LINE 35 "Desugar.ag" #-}
_lhsIoptions
{-# LINE 1898 "Desugar.hs" #-})) of
{ !_rulesOoptions ->
(case (({-# LINE 214 "Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 1902 "Desugar.hs" #-})) of
{ !_rulesOforcedIrrefutables ->
(case ((children_ )) of
{ ( !_childrenIchildInhs,!_childrenIchildSyns,!_childrenIoutput) ->
(case (({-# LINE 125 "Desugar.ag" #-}
_childrenIchildSyns
{-# LINE 1908 "Desugar.hs" #-})) of
{ !_rulesOchildSyns ->
(case (({-# LINE 125 "Desugar.ag" #-}
_childrenIchildInhs
{-# LINE 1912 "Desugar.hs" #-})) of
{ !_rulesOchildInhs ->
(case (({-# LINE 187 "Desugar.ag" #-}
_rulesIdefsCollect
{-# LINE 1916 "Desugar.hs" #-})) of
{ !_rulesOdefs ->
(case ((rules_1 _rulesOchildInhs _rulesOchildSyns _rulesOcon _rulesOdefs _rulesOforcedIrrefutables _rulesOnt _rulesOoptions )) of
{ ( !_rulesIallAttributes,!_rulesIerrors,!_rulesIoutput) ->
(case (({-# LINE 195 "Desugar.ag" #-}
_rulesIallAttributes
{-# LINE 1922 "Desugar.hs" #-})) of
{ !_lhsOallAttributes ->
(case (({-# LINE 243 "Desugar.ag" #-}
Map.findWithDefault Map.empty con_ _lhsIaugmentsIn
{-# LINE 1926 "Desugar.hs" #-})) of
{ !_augmentsIn ->
(case (({-# LINE 246 "Desugar.ag" #-}
Map.mapAccum (desugarExprs _lhsIoptions _lhsInt con_ _childrenIchildInhs _childrenIchildSyns) Seq.empty _augmentsIn
{-# LINE 1930 "Desugar.hs" #-})) of
{ !__tup3 ->
(case (({-# LINE 246 "Desugar.ag" #-}
__tup3
{-# LINE 1934 "Desugar.hs" #-})) of
{ !(_,!_augmentsOut1) ->
(case (({-# LINE 244 "Desugar.ag" #-}
Map.singleton con_ _augmentsOut1
{-# LINE 1938 "Desugar.hs" #-})) of
{ !_augmentsOut ->
(case (({-# LINE 230 "Desugar.ag" #-}
_augmentsOut
{-# LINE 1942 "Desugar.hs" #-})) of
{ !_lhsOaugmentsOut ->
(case (({-# LINE 246 "Desugar.ag" #-}
__tup3
{-# LINE 1946 "Desugar.hs" #-})) of
{ !(!_augmentErrs,_) ->
(case (({-# LINE 282 "Desugar.ag" #-}
_rulesIerrors Seq.>< _augmentErrs
{-# LINE 1950 "Desugar.hs" #-})) of
{ !_lhsOerrors ->
(case ((typeSigs_ )) of
{ ( !_typeSigsIoutput) ->
(case (({-# LINE 39 "Desugar.ag" #-}
Production con_ _childrenIoutput _rulesIoutput _typeSigsIoutput
{-# LINE 1956 "Desugar.hs" #-})) of
{ !_output ->
(case (({-# LINE 39 "Desugar.ag" #-}
_output
{-# LINE 1960 "Desugar.hs" #-})) of
{ !_lhsOoutput ->
( _lhsOallAttributes,_lhsOaugmentsOut,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) )
-- Productions -------------------------------------------------
{-
visit 0:
inherited attributes:
augmentsIn : Map ConstructorIdent (Map Identifier [Expression])
forcedIrrefutables : AttrMap
nt : NontermIdent
options : Options
synthesized attributes:
allAttributes : AttrMap
augmentsOut : Map ConstructorIdent (Map Identifier [Expression])
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 ((Map ConstructorIdent (Map Identifier [Expression])) ->
AttrMap ->
NontermIdent ->
Options ->
( AttrMap,(Map ConstructorIdent (Map Identifier [Expression])),(Seq Error),Productions ))
data Inh_Productions = Inh_Productions {augmentsIn_Inh_Productions :: !((Map ConstructorIdent (Map Identifier [Expression]))),forcedIrrefutables_Inh_Productions :: !(AttrMap),nt_Inh_Productions :: !(NontermIdent),options_Inh_Productions :: !(Options)}
data Syn_Productions = Syn_Productions {allAttributes_Syn_Productions :: !(AttrMap),augmentsOut_Syn_Productions :: !((Map ConstructorIdent (Map Identifier [Expression]))),errors_Syn_Productions :: !((Seq Error)),output_Syn_Productions :: !(Productions )}
wrap_Productions :: T_Productions ->
Inh_Productions ->
Syn_Productions
wrap_Productions !(T_Productions sem ) !(Inh_Productions _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsInt _lhsIoptions ) =
(let ( !_lhsOallAttributes,!_lhsOaugmentsOut,!_lhsOerrors,!_lhsOoutput) =
(sem _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsInt _lhsIoptions )
in (Syn_Productions _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput ))
sem_Productions_Cons :: T_Production ->
T_Productions ->
T_Productions
sem_Productions_Cons !(T_Production hd_ ) !(T_Productions tl_ ) =
(T_Productions (\ (!_lhsIaugmentsIn)
(!_lhsIforcedIrrefutables)
(!_lhsInt)
(!_lhsIoptions) ->
(case (({-# LINE 151 "Desugar.ag" #-}
_lhsInt
{-# LINE 2016 "Desugar.hs" #-})) of
{ !_tlOnt ->
(case (({-# LINE 151 "Desugar.ag" #-}
_lhsInt
{-# LINE 2020 "Desugar.hs" #-})) of
{ !_hdOnt ->
(case (({-# LINE 35 "Desugar.ag" #-}
_lhsIoptions
{-# LINE 2024 "Desugar.hs" #-})) of
{ !_tlOoptions ->
(case (({-# LINE 214 "Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 2028 "Desugar.hs" #-})) of
{ !_tlOforcedIrrefutables ->
(case (({-# LINE 229 "Desugar.ag" #-}
_lhsIaugmentsIn
{-# LINE 2032 "Desugar.hs" #-})) of
{ !_tlOaugmentsIn ->
(case ((tl_ _tlOaugmentsIn _tlOforcedIrrefutables _tlOnt _tlOoptions )) of
{ ( !_tlIallAttributes,!_tlIaugmentsOut,!_tlIerrors,!_tlIoutput) ->
(case (({-# LINE 35 "Desugar.ag" #-}
_lhsIoptions
{-# LINE 2038 "Desugar.hs" #-})) of
{ !_hdOoptions ->
(case (({-# LINE 214 "Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 2042 "Desugar.hs" #-})) of
{ !_hdOforcedIrrefutables ->
(case (({-# LINE 229 "Desugar.ag" #-}
_lhsIaugmentsIn
{-# LINE 2046 "Desugar.hs" #-})) of
{ !_hdOaugmentsIn ->
(case ((hd_ _hdOaugmentsIn _hdOforcedIrrefutables _hdOnt _hdOoptions )) of
{ ( !_hdIallAttributes,!_hdIaugmentsOut,!_hdIerrors,!_hdIoutput) ->
(case (({-# LINE 195 "Desugar.ag" #-}
_hdIallAttributes `mergeAttributes` _tlIallAttributes
{-# LINE 2052 "Desugar.hs" #-})) of
{ !_lhsOallAttributes ->
(case (({-# LINE 230 "Desugar.ag" #-}
_hdIaugmentsOut `Map.union` _tlIaugmentsOut
{-# LINE 2056 "Desugar.hs" #-})) of
{ !_lhsOaugmentsOut ->
(case (({-# LINE 37 "Desugar.ag" #-}
_hdIerrors Seq.>< _tlIerrors
{-# LINE 2060 "Desugar.hs" #-})) of
{ !_lhsOerrors ->
(case (({-# LINE 39 "Desugar.ag" #-}
(:) _hdIoutput _tlIoutput
{-# LINE 2064 "Desugar.hs" #-})) of
{ !_output ->
(case (({-# LINE 39 "Desugar.ag" #-}
_output
{-# LINE 2068 "Desugar.hs" #-})) of
{ !_lhsOoutput ->
( _lhsOallAttributes,_lhsOaugmentsOut,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) )
sem_Productions_Nil :: T_Productions
sem_Productions_Nil =
(T_Productions (\ (!_lhsIaugmentsIn)
(!_lhsIforcedIrrefutables)
(!_lhsInt)
(!_lhsIoptions) ->
(case (({-# LINE 195 "Desugar.ag" #-}
Map.empty
{-# LINE 2079 "Desugar.hs" #-})) of
{ !_lhsOallAttributes ->
(case (({-# LINE 230 "Desugar.ag" #-}
Map.empty
{-# LINE 2083 "Desugar.hs" #-})) of
{ !_lhsOaugmentsOut ->
(case (({-# LINE 37 "Desugar.ag" #-}
Seq.empty
{-# LINE 2087 "Desugar.hs" #-})) of
{ !_lhsOerrors ->
(case (({-# LINE 39 "Desugar.ag" #-}
[]
{-# LINE 2091 "Desugar.hs" #-})) of
{ !_output ->
(case (({-# LINE 39 "Desugar.ag" #-}
_output
{-# LINE 2095 "Desugar.hs" #-})) of
{ !_lhsOoutput ->
( _lhsOallAttributes,_lhsOaugmentsOut,_lhsOerrors,_lhsOoutput) }) }) }) }) })) )
-- Rule --------------------------------------------------------
{-
visit 0:
synthesized attribute:
defsCollect : Set (Identifier, Identifier)
visit 1:
inherited attributes:
childInhs : [(Identifier, Identifier)]
childSyns : [(Identifier, Identifier)]
con : ConstructorIdent
defs : Set (Identifier, Identifier)
forcedIrrefutables : AttrMap
nt : NontermIdent
options : Options
synthesized attributes:
allAttributes : AttrMap
errors : Seq Error
output : SELF
alternatives:
alternative Rule:
child mbName : {Maybe Identifier}
child pattern : Pattern
child rhs : Expression
child owrt : {Bool}
child origin : {String}
child explicit : {Bool}
visit 1:
local ruleDescr : _
local output : _
-}
-- cata
sem_Rule :: Rule ->
T_Rule
sem_Rule !(Rule _mbName _pattern _rhs _owrt _origin _explicit ) =
(sem_Rule_Rule _mbName (sem_Pattern _pattern ) (sem_Expression _rhs ) _owrt _origin _explicit )
-- semantic domain
newtype T_Rule = T_Rule (( (Set (Identifier, Identifier)),T_Rule_1 ))
newtype T_Rule_1 = T_Rule_1 (([(Identifier, Identifier)]) ->
([(Identifier, Identifier)]) ->
ConstructorIdent ->
(Set (Identifier, Identifier)) ->
AttrMap ->
NontermIdent ->
Options ->
( AttrMap,(Seq Error),Rule ))
data Inh_Rule = Inh_Rule {childInhs_Inh_Rule :: !(([(Identifier, Identifier)])),childSyns_Inh_Rule :: !(([(Identifier, Identifier)])),con_Inh_Rule :: !(ConstructorIdent),defs_Inh_Rule :: !((Set (Identifier, Identifier))),forcedIrrefutables_Inh_Rule :: !(AttrMap),nt_Inh_Rule :: !(NontermIdent),options_Inh_Rule :: !(Options)}
data Syn_Rule = Syn_Rule {allAttributes_Syn_Rule :: !(AttrMap),defsCollect_Syn_Rule :: !((Set (Identifier, Identifier))),errors_Syn_Rule :: !((Seq Error)),output_Syn_Rule :: !(Rule )}
wrap_Rule :: T_Rule ->
Inh_Rule ->
Syn_Rule
wrap_Rule !(T_Rule sem ) !(Inh_Rule _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions ) =
(let ( !_lhsOdefsCollect,!T_Rule_1 sem_1) =
(sem )
( !_lhsOallAttributes,!_lhsOerrors,!_lhsOoutput) =
(sem_1 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions )
in (Syn_Rule _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput ))
sem_Rule_Rule :: (Maybe Identifier) ->
T_Pattern ->
T_Expression ->
Bool ->
String ->
Bool ->
T_Rule
sem_Rule_Rule !mbName_ !(T_Pattern pattern_ ) !(T_Expression rhs_ ) !owrt_ !origin_ !explicit_ =
(T_Rule (case ((pattern_ )) of
{ ( !_patternIdefsCollect,!T_Pattern_1 pattern_1) ->
(case (({-# LINE 178 "Desugar.ag" #-}
_patternIdefsCollect
{-# LINE 2166 "Desugar.hs" #-})) of
{ !_lhsOdefsCollect ->
(case ((let sem_Rule_Rule_1 :: T_Rule_1
sem_Rule_Rule_1 =
(T_Rule_1 (\ (!_lhsIchildInhs)
(!_lhsIchildSyns)
(!_lhsIcon)
(!_lhsIdefs)
(!_lhsIforcedIrrefutables)
(!_lhsInt)
(!_lhsIoptions) ->
(case (({-# LINE 151 "Desugar.ag" #-}
_lhsInt
{-# LINE 2179 "Desugar.hs" #-})) of
{ !_patternOnt ->
(case (({-# LINE 152 "Desugar.ag" #-}
_lhsIcon
{-# LINE 2183 "Desugar.hs" #-})) of
{ !_patternOcon ->
(case (({-# LINE 214 "Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 2187 "Desugar.hs" #-})) of
{ !_patternOforcedIrrefutables ->
(case (({-# LINE 184 "Desugar.ag" #-}
_lhsIdefs
{-# LINE 2191 "Desugar.hs" #-})) of
{ !_patternOdefs ->
(case (({-# LINE 125 "Desugar.ag" #-}
_lhsIchildSyns
{-# LINE 2195 "Desugar.hs" #-})) of
{ !_patternOchildSyns ->
(case (({-# LINE 125 "Desugar.ag" #-}
_lhsIchildInhs
{-# LINE 2199 "Desugar.hs" #-})) of
{ !_patternOchildInhs ->
(case ((pattern_1 _patternOchildInhs _patternOchildSyns _patternOcon _patternOdefs _patternOforcedIrrefutables _patternOnt )) of
{ ( !_patternIallAttributes,!_patternIcopy,!_patternIerrors,!_patternIoutput) ->
(case (({-# LINE 195 "Desugar.ag" #-}
_patternIallAttributes
{-# LINE 2205 "Desugar.hs" #-})) of
{ !_lhsOallAttributes ->
(case (({-# LINE 171 "Desugar.ag" #-}
show _lhsInt ++ " :: " ++ show _lhsIcon ++ " :: " ++ (concat $ intersperse "," $ map (\(f,a) -> show f ++ "." ++ show a) $ Set.toList _patternIdefsCollect)
{-# LINE 2209 "Desugar.hs" #-})) of
{ !_ruleDescr ->
(case (({-# LINE 167 "Desugar.ag" #-}
_ruleDescr
{-# LINE 2213 "Desugar.hs" #-})) of
{ !_rhsOruleDescr ->
(case (({-# LINE 35 "Desugar.ag" #-}
_lhsIoptions
{-# LINE 2217 "Desugar.hs" #-})) of
{ !_rhsOoptions ->
(case (({-# LINE 151 "Desugar.ag" #-}
_lhsInt
{-# LINE 2221 "Desugar.hs" #-})) of
{ !_rhsOnt ->
(case (({-# LINE 152 "Desugar.ag" #-}
_lhsIcon
{-# LINE 2225 "Desugar.hs" #-})) of
{ !_rhsOcon ->
(case (({-# LINE 125 "Desugar.ag" #-}
_lhsIchildSyns
{-# LINE 2229 "Desugar.hs" #-})) of
{ !_rhsOchildSyns ->
(case (({-# LINE 125 "Desugar.ag" #-}
_lhsIchildInhs
{-# LINE 2233 "Desugar.hs" #-})) of
{ !_rhsOchildInhs ->
(case ((rhs_ _rhsOchildInhs _rhsOchildSyns _rhsOcon _rhsOnt _rhsOoptions _rhsOruleDescr )) of
{ ( !_rhsIerrors,!_rhsIoutput) ->
(case (({-# LINE 37 "Desugar.ag" #-}
_patternIerrors Seq.>< _rhsIerrors
{-# LINE 2239 "Desugar.hs" #-})) of
{ !_lhsOerrors ->
(case (({-# LINE 39 "Desugar.ag" #-}
Rule mbName_ _patternIoutput _rhsIoutput owrt_ origin_ explicit_
{-# LINE 2243 "Desugar.hs" #-})) of
{ !_output ->
(case (({-# LINE 39 "Desugar.ag" #-}
_output
{-# LINE 2247 "Desugar.hs" #-})) of
{ !_lhsOoutput ->
( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) )
in sem_Rule_Rule_1)) of
{ ( !sem_Rule_1) ->
( _lhsOdefsCollect,sem_Rule_1) }) }) }) )
-- Rules -------------------------------------------------------
{-
visit 0:
synthesized attribute:
defsCollect : Set (Identifier, Identifier)
visit 1:
inherited attributes:
childInhs : [(Identifier, Identifier)]
childSyns : [(Identifier, Identifier)]
con : ConstructorIdent
defs : Set (Identifier, Identifier)
forcedIrrefutables : AttrMap
nt : NontermIdent
options : Options
synthesized attributes:
allAttributes : AttrMap
errors : Seq Error
output : SELF
alternatives:
alternative Cons:
child hd : Rule
child tl : Rules
visit 1:
local output : _
alternative Nil:
visit 1:
local output : _
-}
-- cata
sem_Rules :: Rules ->
T_Rules
sem_Rules !list =
(Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list) )
-- semantic domain
newtype T_Rules = T_Rules (( (Set (Identifier, Identifier)),T_Rules_1 ))
newtype T_Rules_1 = T_Rules_1 (([(Identifier, Identifier)]) ->
([(Identifier, Identifier)]) ->
ConstructorIdent ->
(Set (Identifier, Identifier)) ->
AttrMap ->
NontermIdent ->
Options ->
( AttrMap,(Seq Error),Rules ))
data Inh_Rules = Inh_Rules {childInhs_Inh_Rules :: !(([(Identifier, Identifier)])),childSyns_Inh_Rules :: !(([(Identifier, Identifier)])),con_Inh_Rules :: !(ConstructorIdent),defs_Inh_Rules :: !((Set (Identifier, Identifier))),forcedIrrefutables_Inh_Rules :: !(AttrMap),nt_Inh_Rules :: !(NontermIdent),options_Inh_Rules :: !(Options)}
data Syn_Rules = Syn_Rules {allAttributes_Syn_Rules :: !(AttrMap),defsCollect_Syn_Rules :: !((Set (Identifier, Identifier))),errors_Syn_Rules :: !((Seq Error)),output_Syn_Rules :: !(Rules )}
wrap_Rules :: T_Rules ->
Inh_Rules ->
Syn_Rules
wrap_Rules !(T_Rules sem ) !(Inh_Rules _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions ) =
(let ( !_lhsOdefsCollect,!T_Rules_1 sem_1) =
(sem )
( !_lhsOallAttributes,!_lhsOerrors,!_lhsOoutput) =
(sem_1 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions )
in (Syn_Rules _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput ))
sem_Rules_Cons :: T_Rule ->
T_Rules ->
T_Rules
sem_Rules_Cons !(T_Rule hd_ ) !(T_Rules tl_ ) =
(T_Rules (case ((tl_ )) of
{ ( !_tlIdefsCollect,!T_Rules_1 tl_1) ->
(case ((hd_ )) of
{ ( !_hdIdefsCollect,!T_Rule_1 hd_1) ->
(case (({-# LINE 178 "Desugar.ag" #-}
_hdIdefsCollect `Set.union` _tlIdefsCollect
{-# LINE 2317 "Desugar.hs" #-})) of
{ !_lhsOdefsCollect ->
(case ((let sem_Rules_Cons_1 :: T_Rules_1
sem_Rules_Cons_1 =
(T_Rules_1 (\ (!_lhsIchildInhs)
(!_lhsIchildSyns)
(!_lhsIcon)
(!_lhsIdefs)
(!_lhsIforcedIrrefutables)
(!_lhsInt)
(!_lhsIoptions) ->
(case (({-# LINE 151 "Desugar.ag" #-}
_lhsInt
{-# LINE 2330 "Desugar.hs" #-})) of
{ !_tlOnt ->
(case (({-# LINE 152 "Desugar.ag" #-}
_lhsIcon
{-# LINE 2334 "Desugar.hs" #-})) of
{ !_tlOcon ->
(case (({-# LINE 151 "Desugar.ag" #-}
_lhsInt
{-# LINE 2338 "Desugar.hs" #-})) of
{ !_hdOnt ->
(case (({-# LINE 152 "Desugar.ag" #-}
_lhsIcon
{-# LINE 2342 "Desugar.hs" #-})) of
{ !_hdOcon ->
(case (({-# LINE 35 "Desugar.ag" #-}
_lhsIoptions
{-# LINE 2346 "Desugar.hs" #-})) of
{ !_tlOoptions ->
(case (({-# LINE 214 "Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 2350 "Desugar.hs" #-})) of
{ !_tlOforcedIrrefutables ->
(case (({-# LINE 184 "Desugar.ag" #-}
_lhsIdefs
{-# LINE 2354 "Desugar.hs" #-})) of
{ !_tlOdefs ->
(case (({-# LINE 125 "Desugar.ag" #-}
_lhsIchildSyns
{-# LINE 2358 "Desugar.hs" #-})) of
{ !_tlOchildSyns ->
(case (({-# LINE 125 "Desugar.ag" #-}
_lhsIchildInhs
{-# LINE 2362 "Desugar.hs" #-})) of
{ !_tlOchildInhs ->
(case ((tl_1 _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt _tlOoptions )) of
{ ( !_tlIallAttributes,!_tlIerrors,!_tlIoutput) ->
(case (({-# LINE 35 "Desugar.ag" #-}
_lhsIoptions
{-# LINE 2368 "Desugar.hs" #-})) of
{ !_hdOoptions ->
(case (({-# LINE 214 "Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 2372 "Desugar.hs" #-})) of
{ !_hdOforcedIrrefutables ->
(case (({-# LINE 184 "Desugar.ag" #-}
_lhsIdefs
{-# LINE 2376 "Desugar.hs" #-})) of
{ !_hdOdefs ->
(case (({-# LINE 125 "Desugar.ag" #-}
_lhsIchildSyns
{-# LINE 2380 "Desugar.hs" #-})) of
{ !_hdOchildSyns ->
(case (({-# LINE 125 "Desugar.ag" #-}
_lhsIchildInhs
{-# LINE 2384 "Desugar.hs" #-})) of
{ !_hdOchildInhs ->
(case ((hd_1 _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt _hdOoptions )) of
{ ( !_hdIallAttributes,!_hdIerrors,!_hdIoutput) ->
(case (({-# LINE 195 "Desugar.ag" #-}
_hdIallAttributes `mergeAttributes` _tlIallAttributes
{-# LINE 2390 "Desugar.hs" #-})) of
{ !_lhsOallAttributes ->
(case (({-# LINE 37 "Desugar.ag" #-}
_hdIerrors Seq.>< _tlIerrors
{-# LINE 2394 "Desugar.hs" #-})) of
{ !_lhsOerrors ->
(case (({-# LINE 39 "Desugar.ag" #-}
(:) _hdIoutput _tlIoutput
{-# LINE 2398 "Desugar.hs" #-})) of
{ !_output ->
(case (({-# LINE 39 "Desugar.ag" #-}
_output
{-# LINE 2402 "Desugar.hs" #-})) of
{ !_lhsOoutput ->
( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) )
in sem_Rules_Cons_1)) of
{ ( !sem_Rules_1) ->
( _lhsOdefsCollect,sem_Rules_1) }) }) }) }) )
sem_Rules_Nil :: T_Rules
sem_Rules_Nil =
(T_Rules (case (({-# LINE 178 "Desugar.ag" #-}
Set.empty
{-# LINE 2412 "Desugar.hs" #-})) of
{ !_lhsOdefsCollect ->
(case ((let sem_Rules_Nil_1 :: T_Rules_1
sem_Rules_Nil_1 =
(T_Rules_1 (\ (!_lhsIchildInhs)
(!_lhsIchildSyns)
(!_lhsIcon)
(!_lhsIdefs)
(!_lhsIforcedIrrefutables)
(!_lhsInt)
(!_lhsIoptions) ->
(case (({-# LINE 195 "Desugar.ag" #-}
Map.empty
{-# LINE 2425 "Desugar.hs" #-})) of
{ !_lhsOallAttributes ->
(case (({-# LINE 37 "Desugar.ag" #-}
Seq.empty
{-# LINE 2429 "Desugar.hs" #-})) of
{ !_lhsOerrors ->
(case (({-# LINE 39 "Desugar.ag" #-}
[]
{-# LINE 2433 "Desugar.hs" #-})) of
{ !_output ->
(case (({-# LINE 39 "Desugar.ag" #-}
_output
{-# LINE 2437 "Desugar.hs" #-})) of
{ !_lhsOoutput ->
( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) })) )
in sem_Rules_Nil_1)) of
{ ( !sem_Rules_1) ->
( _lhsOdefsCollect,sem_Rules_1) }) }) )
-- TypeSig -----------------------------------------------------
{-
visit 0:
synthesized attribute:
output : SELF
alternatives:
alternative TypeSig:
child name : {Identifier}
child tp : {Type}
visit 0:
local output : _
-}
-- cata
sem_TypeSig :: TypeSig ->
T_TypeSig
sem_TypeSig !(TypeSig _name _tp ) =
(sem_TypeSig_TypeSig _name _tp )
-- semantic domain
newtype T_TypeSig = T_TypeSig (( TypeSig ))
data Inh_TypeSig = Inh_TypeSig {}
data Syn_TypeSig = Syn_TypeSig {output_Syn_TypeSig :: !(TypeSig )}
wrap_TypeSig :: T_TypeSig ->
Inh_TypeSig ->
Syn_TypeSig
wrap_TypeSig !(T_TypeSig sem ) !(Inh_TypeSig ) =
(let ( !_lhsOoutput) =
(sem )
in (Syn_TypeSig _lhsOoutput ))
sem_TypeSig_TypeSig :: Identifier ->
Type ->
T_TypeSig
sem_TypeSig_TypeSig !name_ !tp_ =
(T_TypeSig (case (({-# LINE 39 "Desugar.ag" #-}
TypeSig name_ tp_
{-# LINE 2477 "Desugar.hs" #-})) of
{ !_output ->
(case (({-# LINE 39 "Desugar.ag" #-}
_output
{-# LINE 2481 "Desugar.hs" #-})) of
{ !_lhsOoutput ->
( _lhsOoutput) }) }) )
-- TypeSigs ----------------------------------------------------
{-
visit 0:
synthesized attribute:
output : SELF
alternatives:
alternative Cons:
child hd : TypeSig
child tl : TypeSigs
visit 0:
local output : _
alternative Nil:
visit 0:
local output : _
-}
-- cata
sem_TypeSigs :: TypeSigs ->
T_TypeSigs
sem_TypeSigs !list =
(Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) )
-- semantic domain
newtype T_TypeSigs = T_TypeSigs (( TypeSigs ))
data Inh_TypeSigs = Inh_TypeSigs {}
data Syn_TypeSigs = Syn_TypeSigs {output_Syn_TypeSigs :: !(TypeSigs )}
wrap_TypeSigs :: T_TypeSigs ->
Inh_TypeSigs ->
Syn_TypeSigs
wrap_TypeSigs !(T_TypeSigs sem ) !(Inh_TypeSigs ) =
(let ( !_lhsOoutput) =
(sem )
in (Syn_TypeSigs _lhsOoutput ))
sem_TypeSigs_Cons :: T_TypeSig ->
T_TypeSigs ->
T_TypeSigs
sem_TypeSigs_Cons !(T_TypeSig hd_ ) !(T_TypeSigs tl_ ) =
(T_TypeSigs (case ((tl_ )) of
{ ( !_tlIoutput) ->
(case ((hd_ )) of
{ ( !_hdIoutput) ->
(case (({-# LINE 39 "Desugar.ag" #-}
(:) _hdIoutput _tlIoutput
{-# LINE 2525 "Desugar.hs" #-})) of
{ !_output ->
(case (({-# LINE 39 "Desugar.ag" #-}
_output
{-# LINE 2529 "Desugar.hs" #-})) of
{ !_lhsOoutput ->
( _lhsOoutput) }) }) }) }) )
sem_TypeSigs_Nil :: T_TypeSigs
sem_TypeSigs_Nil =
(T_TypeSigs (case (({-# LINE 39 "Desugar.ag" #-}
[]
{-# LINE 2536 "Desugar.hs" #-})) of
{ !_output ->
(case (({-# LINE 39 "Desugar.ag" #-}
_output
{-# LINE 2540 "Desugar.hs" #-})) of
{ !_lhsOoutput ->
( _lhsOoutput) }) }) )