uuagc-0.9.42.1: src-generated/Desugar.hs
{-# OPTIONS_GHC -XBangPatterns #-}
-- UUAGC 0.9.42.0 (src-ag/Desugar.ag)
module Desugar where
{-# LINE 14 "./src-ag/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 Data.Maybe
import Data.List(intersperse)
import AbstractSyntax
import ErrorMessages
import Options
import HsToken
import HsTokenScanner
import TokenDef
import CommonTypes
{-# LINE 24 "dist/build/Desugar.hs" #-}
{-# LINE 2 "./src-ag/AbstractSyntax.ag" #-}
-- AbstractSyntax.ag imports
import Data.Set(Set)
import Data.Map(Map)
import Patterns (Pattern(..),Patterns)
import Expression (Expression(..))
import Macro --marcos
import CommonTypes
import ErrorMessages
{-# LINE 36 "dist/build/Desugar.hs" #-}
{-# LINE 2 "./src-ag/Patterns.ag" #-}
-- Patterns.ag imports
import UU.Scanner.Position(Pos)
import CommonTypes (ConstructorIdent,Identifier)
{-# LINE 43 "dist/build/Desugar.hs" #-}
{-# LINE 2 "./src-ag/Expression.ag" #-}
import UU.Scanner.Position(Pos)
import HsToken
{-# LINE 49 "dist/build/Desugar.hs" #-}
{-# LINE 2 "./src-ag/HsToken.ag" #-}
import CommonTypes
import UU.Scanner.Position(Pos)
{-# LINE 55 "dist/build/Desugar.hs" #-}
{-# LINE 98 "./src-ag/Desugar.ag" #-}
addl :: Int -> Pos -> Pos
addl n (Pos l c f) = Pos (l+n) c f
{-# LINE 60 "dist/build/Desugar.hs" #-}
{-# LINE 133 "./src-ag/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 75 "dist/build/Desugar.hs" #-}
{-# LINE 204 "./src-ag/Desugar.ag" #-}
mergeAttributes :: AttrMap -> AttrMap -> AttrMap
mergeAttributes = Map.unionWith $ Map.unionWith $ Set.union
{-# LINE 81 "dist/build/Desugar.hs" #-}
{-# LINE 251 "./src-ag/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 107 "dist/build/Desugar.hs" #-}
{-# LINE 294 "./src-ag/Desugar.ag" #-}
addLateAttr :: Options -> String -> Attributes
addLateAttr options mainName
| kennedyWarren options && lateHigherOrderBinding options =
let tp = lateBindingType mainName
in Map.singleton idLateBindingAttr tp
| otherwise = Map.empty
{-# LINE 117 "dist/build/Desugar.hs" #-}
-- Child -------------------------------------------------------
{-
visit 0:
inherited attributes:
inhMap : Map Identifier Attributes
mainName : String
options : Options
synMap : Map Identifier Attributes
synthesized attributes:
childInhs : [(Identifier, Identifier)]
childSyns : [(Identifier, Identifier)]
output : Child
alternatives:
alternative Child:
child name : {Identifier}
child tp : {Type}
child kind : {ChildKind}
visit 0:
local chnt : _
local inh : _
local syn : _
-}
-- cata
sem_Child :: Child ->
T_Child
sem_Child !(Child _name _tp _kind) =
(sem_Child_Child _name _tp _kind)
-- semantic domain
newtype T_Child = T_Child ((Map Identifier Attributes) ->
String ->
Options ->
(Map Identifier Attributes) ->
( ([(Identifier, Identifier)]),([(Identifier, Identifier)]),Child))
data Inh_Child = Inh_Child {inhMap_Inh_Child :: !((Map Identifier Attributes)),mainName_Inh_Child :: !(String),options_Inh_Child :: !(Options),synMap_Inh_Child :: !((Map Identifier Attributes))}
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 _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) =
(let ( !_lhsOchildInhs,!_lhsOchildSyns,!_lhsOoutput) = sem _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap
in (Syn_Child _lhsOchildInhs _lhsOchildSyns _lhsOoutput))
sem_Child_Child :: Identifier ->
Type ->
ChildKind ->
T_Child
sem_Child_Child !name_ !tp_ !kind_ =
(T_Child (\ (!_lhsIinhMap)
(!_lhsImainName)
(!_lhsIoptions)
(!_lhsIsynMap) ->
(case (({-# LINE 19 "./src-ag/DistChildAttr.ag" #-}
case tp_ of
NT nt _ _ -> nt
Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.")
Haskell t -> identifier ""
{-# LINE 173 "dist/build/Desugar.hs" #-}
)) of
{ !_chnt ->
(case (({-# LINE 23 "./src-ag/DistChildAttr.ag" #-}
Map.findWithDefault Map.empty _chnt _lhsIinhMap
{-# LINE 178 "dist/build/Desugar.hs" #-}
)) of
{ !_inh ->
(case (({-# LINE 130 "./src-ag/Desugar.ag" #-}
[(i, name_) | i <- Map.keys _inh ]
{-# LINE 183 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOchildInhs ->
(case (({-# LINE 24 "./src-ag/DistChildAttr.ag" #-}
Map.findWithDefault Map.empty _chnt _lhsIsynMap
{-# LINE 188 "dist/build/Desugar.hs" #-}
)) of
{ !_syn ->
(case (({-# LINE 131 "./src-ag/Desugar.ag" #-}
[(s, name_) | s <- Map.keys _syn ]
{-# LINE 193 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOchildSyns ->
(case (({-# LINE 315 "./src-ag/Desugar.ag" #-}
Child name_ tp_ kind_
{-# LINE 198 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOoutput ->
( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput) }) }) }) }) }) })))
-- Children ----------------------------------------------------
{-
visit 0:
inherited attributes:
inhMap : Map Identifier Attributes
mainName : String
options : Options
synMap : Map Identifier Attributes
synthesized attributes:
childInhs : [(Identifier, Identifier)]
childSyns : [(Identifier, Identifier)]
output : Children
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 ((Map Identifier Attributes) ->
String ->
Options ->
(Map Identifier Attributes) ->
( ([(Identifier, Identifier)]),([(Identifier, Identifier)]),Children))
data Inh_Children = Inh_Children {inhMap_Inh_Children :: !((Map Identifier Attributes)),mainName_Inh_Children :: !(String),options_Inh_Children :: !(Options),synMap_Inh_Children :: !((Map Identifier Attributes))}
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 _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) =
(let ( !_lhsOchildInhs,!_lhsOchildSyns,!_lhsOoutput) = sem _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap
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 (\ (!_lhsIinhMap)
(!_lhsImainName)
(!_lhsIoptions)
(!_lhsIsynMap) ->
(case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-}
_lhsIinhMap
{-# LINE 253 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOinhMap ->
(case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-}
_lhsIinhMap
{-# LINE 258 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOinhMap ->
(case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-}
_lhsIsynMap
{-# LINE 263 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOsynMap ->
(case (({-# LINE 36 "./src-ag/Desugar.ag" #-}
_lhsIoptions
{-# LINE 268 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOoptions ->
(case (({-# LINE 289 "./src-ag/Desugar.ag" #-}
_lhsImainName
{-# LINE 273 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOmainName ->
(case (tl_ _tlOinhMap _tlOmainName _tlOoptions _tlOsynMap) of
{ ( !_tlIchildInhs,!_tlIchildSyns,!_tlIoutput) ->
(case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-}
_lhsIsynMap
{-# LINE 280 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOsynMap ->
(case (({-# LINE 36 "./src-ag/Desugar.ag" #-}
_lhsIoptions
{-# LINE 285 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOoptions ->
(case (({-# LINE 289 "./src-ag/Desugar.ag" #-}
_lhsImainName
{-# LINE 290 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOmainName ->
(case (hd_ _hdOinhMap _hdOmainName _hdOoptions _hdOsynMap) of
{ ( !_hdIchildInhs,!_hdIchildSyns,!_hdIoutput) ->
(case (({-# LINE 125 "./src-ag/Desugar.ag" #-}
_hdIchildInhs ++ _tlIchildInhs
{-# LINE 297 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOchildInhs ->
(case (({-# LINE 125 "./src-ag/Desugar.ag" #-}
_hdIchildSyns ++ _tlIchildSyns
{-# LINE 302 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOchildSyns ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
(:) _hdIoutput _tlIoutput
{-# LINE 307 "dist/build/Desugar.hs" #-}
)) of
{ !_output ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
_output
{-# LINE 312 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOoutput ->
( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) })))
sem_Children_Nil :: T_Children
sem_Children_Nil =
(T_Children (\ (!_lhsIinhMap)
(!_lhsImainName)
(!_lhsIoptions)
(!_lhsIsynMap) ->
(case (({-# LINE 125 "./src-ag/Desugar.ag" #-}
[]
{-# LINE 324 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOchildInhs ->
(case (({-# LINE 125 "./src-ag/Desugar.ag" #-}
[]
{-# LINE 329 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOchildSyns ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
[]
{-# LINE 334 "dist/build/Desugar.hs" #-}
)) of
{ !_output ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
_output
{-# LINE 339 "dist/build/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 : Expression
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 49 "./src-ag/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 406 "dist/build/Desugar.hs" #-}
)) of
{ !__tup1 ->
(case (({-# LINE 49 "./src-ag/Desugar.ag" #-}
__tup1
{-# LINE 411 "dist/build/Desugar.hs" #-}
)) of
{ !(_,!_lhsOerrors) ->
(case (({-# LINE 49 "./src-ag/Desugar.ag" #-}
__tup1
{-# LINE 416 "dist/build/Desugar.hs" #-}
)) of
{ !(!_tks',_) ->
(case (({-# LINE 59 "./src-ag/Desugar.ag" #-}
Expression pos_ _tks'
{-# LINE 421 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOoutput ->
( _lhsOerrors,_lhsOoutput) }) }) }) })))
-- Grammar -----------------------------------------------------
{-
visit 0:
inherited attributes:
forcedIrrefutables : AttrMap
mainName : String
options : Options
synthesized attributes:
allAttributes : AttrMap
errors : Seq Error
output : Grammar
alternatives:
alternative Grammar:
child typeSyns : {TypeSyns}
child useMap : {UseMap}
child derivings : {Derivings}
child wrappers : {Set NontermIdent}
child nonts : Nonterminals
child pragmas : {PragmaMap}
child manualAttrOrderMap : {AttrOrderMap}
child paramMap : {ParamMap}
child contextMap : {ContextMap}
child quantMap : {QuantMap}
child uniqueMap : {UniqueMap}
child augmentsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))}
child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))}
child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))}
-}
-- cata
sem_Grammar :: Grammar ->
T_Grammar
sem_Grammar !(Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap) =
(sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts) _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap)
-- semantic domain
newtype T_Grammar = T_Grammar (AttrMap ->
String ->
Options ->
( AttrMap,(Seq Error),Grammar))
data Inh_Grammar = Inh_Grammar {forcedIrrefutables_Inh_Grammar :: !(AttrMap),mainName_Inh_Grammar :: !(String),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 _lhsImainName _lhsIoptions) =
(let ( !_lhsOallAttributes,!_lhsOerrors,!_lhsOoutput) = sem _lhsIforcedIrrefutables _lhsImainName _lhsIoptions
in (Syn_Grammar _lhsOallAttributes _lhsOerrors _lhsOoutput))
sem_Grammar_Grammar :: TypeSyns ->
UseMap ->
Derivings ->
(Set NontermIdent) ->
T_Nonterminals ->
PragmaMap ->
AttrOrderMap ->
ParamMap ->
ContextMap ->
QuantMap ->
UniqueMap ->
(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) ->
(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) ->
(Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) ->
T_Grammar
sem_Grammar_Grammar !typeSyns_ !useMap_ !derivings_ !wrappers_ !(T_Nonterminals nonts_) !pragmas_ !manualAttrOrderMap_ !paramMap_ !contextMap_ !quantMap_ !uniqueMap_ !augmentsMap_ !aroundsMap_ !mergeMap_ =
(T_Grammar (\ (!_lhsIforcedIrrefutables)
(!_lhsImainName)
(!_lhsIoptions) ->
(case (nonts_) of
{ ( !_nontsIinhMap',!_nontsIsynMap',!T_Nonterminals_1 nonts_1) ->
(case (({-# LINE 36 "./src-ag/Desugar.ag" #-}
_lhsIoptions
{-# LINE 494 "dist/build/Desugar.hs" #-}
)) of
{ !_nontsOoptions ->
(case (({-# LINE 289 "./src-ag/Desugar.ag" #-}
_lhsImainName
{-# LINE 499 "dist/build/Desugar.hs" #-}
)) of
{ !_nontsOmainName ->
(case (({-# LINE 215 "./src-ag/Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 504 "dist/build/Desugar.hs" #-}
)) of
{ !_nontsOforcedIrrefutables ->
(case (({-# LINE 16 "./src-ag/DistChildAttr.ag" #-}
_nontsIsynMap'
{-# LINE 509 "dist/build/Desugar.hs" #-}
)) of
{ !_nontsOsynMap ->
(case (({-# LINE 15 "./src-ag/DistChildAttr.ag" #-}
_nontsIinhMap'
{-# LINE 514 "dist/build/Desugar.hs" #-}
)) of
{ !_nontsOinhMap ->
(case (({-# LINE 235 "./src-ag/Desugar.ag" #-}
augmentsMap_
{-# LINE 519 "dist/build/Desugar.hs" #-}
)) of
{ !_nontsOaugmentsIn ->
(case (nonts_1 _nontsOaugmentsIn _nontsOforcedIrrefutables _nontsOinhMap _nontsOmainName _nontsOoptions _nontsOsynMap) of
{ ( !_nontsIallAttributes,!_nontsIaugmentsOut,!_nontsIerrors,!_nontsIoutput) ->
(case (({-# LINE 196 "./src-ag/Desugar.ag" #-}
_nontsIallAttributes
{-# LINE 526 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOallAttributes ->
(case (({-# LINE 38 "./src-ag/Desugar.ag" #-}
_nontsIerrors
{-# LINE 531 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOerrors ->
(case (({-# LINE 319 "./src-ag/Desugar.ag" #-}
Grammar typeSyns_
useMap_
derivings_
wrappers_
_nontsIoutput
pragmas_
manualAttrOrderMap_
paramMap_
contextMap_
quantMap_
uniqueMap_
_nontsIaugmentsOut
aroundsMap_
mergeMap_
{-# LINE 549 "dist/build/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 : HsToken
alternatives:
alternative AGLocal:
child var : {Identifier}
child pos : {Pos}
child rdesc : {Maybe String}
visit 0:
local tks : _
alternative AGField:
child field : {Identifier}
child attr : {Identifier}
child pos : {Pos}
child rdesc : {Maybe String}
visit 0:
local mField : _
local field' : _
local tks : _
alternative HsToken:
child value : {String}
child pos : {Pos}
visit 0:
local tks : _
alternative CharToken:
child value : {String}
child pos : {Pos}
visit 0:
local tks : _
alternative StrToken:
child value : {String}
child pos : {Pos}
visit 0:
local tks : _
alternative Err:
child mesg : {String}
child pos : {Pos}
visit 0:
local tks : _
-}
-- cata
sem_HsToken :: HsToken ->
T_HsToken
sem_HsToken !(AGLocal _var _pos _rdesc) =
(sem_HsToken_AGLocal _var _pos _rdesc)
sem_HsToken !(AGField _field _attr _pos _rdesc) =
(sem_HsToken_AGField _field _attr _pos _rdesc)
sem_HsToken !(HsToken _value _pos) =
(sem_HsToken_HsToken _value _pos)
sem_HsToken !(CharToken _value _pos) =
(sem_HsToken_CharToken _value _pos)
sem_HsToken !(StrToken _value _pos) =
(sem_HsToken_StrToken _value _pos)
sem_HsToken !(Err _mesg _pos) =
(sem_HsToken_Err _mesg _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_AGLocal :: Identifier ->
Pos ->
(Maybe String) ->
T_HsToken
sem_HsToken_AGLocal !var_ !pos_ !rdesc_ =
(T_HsToken (\ (!_lhsIaddLines)
(!_lhsIchildInhs)
(!_lhsIchildSyns)
(!_lhsIcon)
(!_lhsInt)
(!_lhsIruleDescr)
(!_lhsIuseFieldIdent) ->
(case (({-# LINE 74 "./src-ag/Desugar.ag" #-}
if _lhsIuseFieldIdent
then _lhsIaddLines + 1
else _lhsIaddLines
{-# LINE 653 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOaddLines ->
(case (({-# LINE 38 "./src-ag/Desugar.ag" #-}
Seq.empty
{-# LINE 658 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOerrors ->
(case (({-# LINE 77 "./src-ag/Desugar.ag" #-}
AGLocal var_ (addl _lhsIaddLines pos_) (if _lhsIuseFieldIdent then Just _lhsIruleDescr else Nothing)
{-# LINE 663 "dist/build/Desugar.hs" #-}
)) of
{ !_tks ->
(case (({-# LINE 70 "./src-ag/Desugar.ag" #-}
_tks
{-# LINE 668 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOtks ->
( _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 79 "./src-ag/Desugar.ag" #-}
findField field_ attr_ _lhsIchildSyns
{-# LINE 687 "dist/build/Desugar.hs" #-}
)) of
{ !_mField ->
(case (({-# LINE 81 "./src-ag/Desugar.ag" #-}
maybe field_ id _mField
{-# LINE 692 "dist/build/Desugar.hs" #-}
)) of
{ !_field' ->
(case (({-# LINE 84 "./src-ag/Desugar.ag" #-}
if _lhsIuseFieldIdent || length (getName field_) < length (getName _field' )
then _lhsIaddLines + 1
else _lhsIaddLines
{-# LINE 699 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOaddLines ->
(case (({-# LINE 82 "./src-ag/Desugar.ag" #-}
maybe (Seq.singleton (UndefAttr _lhsInt _lhsIcon field_ (Ident "<ANY>" (getPos field_)) False)) (const Seq.empty) _mField
{-# LINE 704 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOerrors ->
(case (({-# LINE 88 "./src-ag/Desugar.ag" #-}
AGField _field' attr_ (addl _lhsIaddLines pos_) (if _lhsIuseFieldIdent then Just _lhsIruleDescr else Nothing)
{-# LINE 709 "dist/build/Desugar.hs" #-}
)) of
{ !_tks ->
(case (({-# LINE 70 "./src-ag/Desugar.ag" #-}
_tks
{-# LINE 714 "dist/build/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 64 "./src-ag/Desugar.ag" #-}
_lhsIaddLines
{-# LINE 731 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOaddLines ->
(case (({-# LINE 38 "./src-ag/Desugar.ag" #-}
Seq.empty
{-# LINE 736 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOerrors ->
(case (({-# LINE 90 "./src-ag/Desugar.ag" #-}
HsToken value_ (addl _lhsIaddLines pos_)
{-# LINE 741 "dist/build/Desugar.hs" #-}
)) of
{ !_tks ->
(case (({-# LINE 70 "./src-ag/Desugar.ag" #-}
_tks
{-# LINE 746 "dist/build/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 64 "./src-ag/Desugar.ag" #-}
_lhsIaddLines
{-# LINE 763 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOaddLines ->
(case (({-# LINE 38 "./src-ag/Desugar.ag" #-}
Seq.empty
{-# LINE 768 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOerrors ->
(case (({-# LINE 92 "./src-ag/Desugar.ag" #-}
CharToken value_ (addl _lhsIaddLines pos_)
{-# LINE 773 "dist/build/Desugar.hs" #-}
)) of
{ !_tks ->
(case (({-# LINE 70 "./src-ag/Desugar.ag" #-}
_tks
{-# LINE 778 "dist/build/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 64 "./src-ag/Desugar.ag" #-}
_lhsIaddLines
{-# LINE 795 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOaddLines ->
(case (({-# LINE 38 "./src-ag/Desugar.ag" #-}
Seq.empty
{-# LINE 800 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOerrors ->
(case (({-# LINE 94 "./src-ag/Desugar.ag" #-}
StrToken value_ (addl _lhsIaddLines pos_)
{-# LINE 805 "dist/build/Desugar.hs" #-}
)) of
{ !_tks ->
(case (({-# LINE 70 "./src-ag/Desugar.ag" #-}
_tks
{-# LINE 810 "dist/build/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 64 "./src-ag/Desugar.ag" #-}
_lhsIaddLines
{-# LINE 827 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOaddLines ->
(case (({-# LINE 38 "./src-ag/Desugar.ag" #-}
Seq.empty
{-# LINE 832 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOerrors ->
(case (({-# LINE 96 "./src-ag/Desugar.ag" #-}
Err mesg_ (addl _lhsIaddLines pos_)
{-# LINE 837 "dist/build/Desugar.hs" #-}
)) of
{ !_tks ->
(case (({-# LINE 70 "./src-ag/Desugar.ag" #-}
_tks
{-# LINE 842 "dist/build/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 : HsTokens
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 62 "./src-ag/Desugar.ag" #-}
_lhsIuseFieldIdent
{-# LINE 906 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOuseFieldIdent ->
(case (({-# LINE 126 "./src-ag/Desugar.ag" #-}
_lhsIchildSyns
{-# LINE 911 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOchildSyns ->
(case (({-# LINE 62 "./src-ag/Desugar.ag" #-}
_lhsIuseFieldIdent
{-# LINE 916 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOuseFieldIdent ->
(case (({-# LINE 126 "./src-ag/Desugar.ag" #-}
_lhsIchildSyns
{-# LINE 921 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOchildSyns ->
(case (({-# LINE 64 "./src-ag/Desugar.ag" #-}
_lhsIaddLines
{-# LINE 926 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOaddLines ->
(case (({-# LINE 168 "./src-ag/Desugar.ag" #-}
_lhsIruleDescr
{-# LINE 931 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOruleDescr ->
(case (({-# LINE 152 "./src-ag/Desugar.ag" #-}
_lhsInt
{-# LINE 936 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOnt ->
(case (({-# LINE 153 "./src-ag/Desugar.ag" #-}
_lhsIcon
{-# LINE 941 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOcon ->
(case (({-# LINE 126 "./src-ag/Desugar.ag" #-}
_lhsIchildInhs
{-# LINE 946 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOchildInhs ->
(case (hd_ _hdOaddLines _hdOchildInhs _hdOchildSyns _hdOcon _hdOnt _hdOruleDescr _hdOuseFieldIdent) of
{ ( !_hdIaddLines,!_hdIerrors,!_hdItks) ->
(case (({-# LINE 64 "./src-ag/Desugar.ag" #-}
_hdIaddLines
{-# LINE 953 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOaddLines ->
(case (({-# LINE 168 "./src-ag/Desugar.ag" #-}
_lhsIruleDescr
{-# LINE 958 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOruleDescr ->
(case (({-# LINE 152 "./src-ag/Desugar.ag" #-}
_lhsInt
{-# LINE 963 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOnt ->
(case (({-# LINE 153 "./src-ag/Desugar.ag" #-}
_lhsIcon
{-# LINE 968 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOcon ->
(case (({-# LINE 126 "./src-ag/Desugar.ag" #-}
_lhsIchildInhs
{-# LINE 973 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOchildInhs ->
(case (tl_ _tlOaddLines _tlOchildInhs _tlOchildSyns _tlOcon _tlOnt _tlOruleDescr _tlOuseFieldIdent) of
{ ( !_tlIaddLines,!_tlIerrors,!_tlItks) ->
(case (({-# LINE 64 "./src-ag/Desugar.ag" #-}
_tlIaddLines
{-# LINE 980 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOaddLines ->
(case (({-# LINE 38 "./src-ag/Desugar.ag" #-}
_hdIerrors Seq.>< _tlIerrors
{-# LINE 985 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOerrors ->
(case (({-# LINE 70 "./src-ag/Desugar.ag" #-}
(:) _hdItks _tlItks
{-# LINE 990 "dist/build/Desugar.hs" #-}
)) of
{ !_tks ->
(case (({-# LINE 70 "./src-ag/Desugar.ag" #-}
_tks
{-# LINE 995 "dist/build/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 64 "./src-ag/Desugar.ag" #-}
_lhsIaddLines
{-# LINE 1010 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOaddLines ->
(case (({-# LINE 38 "./src-ag/Desugar.ag" #-}
Seq.empty
{-# LINE 1015 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOerrors ->
(case (({-# LINE 70 "./src-ag/Desugar.ag" #-}
[]
{-# LINE 1020 "dist/build/Desugar.hs" #-}
)) of
{ !_tks ->
(case (({-# LINE 70 "./src-ag/Desugar.ag" #-}
_tks
{-# LINE 1025 "dist/build/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 152 "./src-ag/Desugar.ag" #-}
_lhsInt
{-# LINE 1078 "dist/build/Desugar.hs" #-}
)) of
{ !_tokensOnt ->
(case (({-# LINE 153 "./src-ag/Desugar.ag" #-}
_lhsIcon
{-# LINE 1083 "dist/build/Desugar.hs" #-}
)) of
{ !_tokensOcon ->
(case (({-# LINE 126 "./src-ag/Desugar.ag" #-}
_lhsIchildSyns
{-# LINE 1088 "dist/build/Desugar.hs" #-}
)) of
{ !_tokensOchildSyns ->
(case (({-# LINE 62 "./src-ag/Desugar.ag" #-}
_lhsIuseFieldIdent
{-# LINE 1093 "dist/build/Desugar.hs" #-}
)) of
{ !_tokensOuseFieldIdent ->
(case (({-# LINE 168 "./src-ag/Desugar.ag" #-}
_lhsIruleDescr
{-# LINE 1098 "dist/build/Desugar.hs" #-}
)) of
{ !_tokensOruleDescr ->
(case (({-# LINE 126 "./src-ag/Desugar.ag" #-}
_lhsIchildInhs
{-# LINE 1103 "dist/build/Desugar.hs" #-}
)) of
{ !_tokensOchildInhs ->
(case (({-# LINE 67 "./src-ag/Desugar.ag" #-}
0
{-# LINE 1108 "dist/build/Desugar.hs" #-}
)) of
{ !_tokensOaddLines ->
(case (tokens_ _tokensOaddLines _tokensOchildInhs _tokensOchildSyns _tokensOcon _tokensOnt _tokensOruleDescr _tokensOuseFieldIdent) of
{ ( !_tokensIaddLines,!_tokensIerrors,!_tokensItks) ->
(case (({-# LINE 38 "./src-ag/Desugar.ag" #-}
_tokensIerrors
{-# LINE 1115 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOerrors ->
(case (({-# LINE 69 "./src-ag/Desugar.ag" #-}
_tokensItks
{-# LINE 1120 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOtks ->
( _lhsOerrors,_lhsOtks) }) }) }) }) }) }) }) }) }) })))
-- Nonterminal -------------------------------------------------
{-
visit 0:
synthesized attributes:
inhMap' : Map Identifier Attributes
synMap' : Map Identifier Attributes
visit 1:
inherited attributes:
augmentsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))
forcedIrrefutables : AttrMap
inhMap : Map Identifier Attributes
mainName : String
options : Options
synMap : Map Identifier Attributes
synthesized attributes:
allAttributes : AttrMap
augmentsOut : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))
errors : Seq Error
output : Nonterminal
alternatives:
alternative Nonterminal:
child nt : {NontermIdent}
child params : {[Identifier]}
child inh : {Attributes}
child syn : {Attributes}
child prods : Productions
visit 1:
local augmentsIn : _
local augmentsOut : _
local extraInh : _
-}
-- cata
sem_Nonterminal :: Nonterminal ->
T_Nonterminal
sem_Nonterminal !(Nonterminal _nt _params _inh _syn _prods) =
(sem_Nonterminal_Nonterminal _nt _params _inh _syn (sem_Productions _prods))
-- semantic domain
newtype T_Nonterminal = T_Nonterminal (( (Map Identifier Attributes),(Map Identifier Attributes),T_Nonterminal_1))
newtype T_Nonterminal_1 = T_Nonterminal_1 ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) ->
AttrMap ->
(Map Identifier Attributes) ->
String ->
Options ->
(Map Identifier Attributes) ->
( 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),inhMap_Inh_Nonterminal :: !((Map Identifier Attributes)),mainName_Inh_Nonterminal :: !(String),options_Inh_Nonterminal :: !(Options),synMap_Inh_Nonterminal :: !((Map Identifier Attributes))}
data Syn_Nonterminal = Syn_Nonterminal {allAttributes_Syn_Nonterminal :: !(AttrMap),augmentsOut_Syn_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),errors_Syn_Nonterminal :: !((Seq Error)),inhMap'_Syn_Nonterminal :: !((Map Identifier Attributes)),output_Syn_Nonterminal :: !(Nonterminal),synMap'_Syn_Nonterminal :: !((Map Identifier Attributes))}
wrap_Nonterminal :: T_Nonterminal ->
Inh_Nonterminal ->
Syn_Nonterminal
wrap_Nonterminal !(T_Nonterminal sem) !(Inh_Nonterminal _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) =
(let ( !_lhsOinhMap',!_lhsOsynMap',!T_Nonterminal_1 sem_1) = sem
( !_lhsOallAttributes,!_lhsOaugmentsOut,!_lhsOerrors,!_lhsOoutput) = sem_1 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap
in (Syn_Nonterminal _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap'))
sem_Nonterminal_Nonterminal :: NontermIdent ->
([Identifier]) ->
Attributes ->
Attributes ->
T_Productions ->
T_Nonterminal
sem_Nonterminal_Nonterminal !nt_ !params_ !inh_ !syn_ !(T_Productions prods_) =
(T_Nonterminal (case (({-# LINE 7 "./src-ag/DistChildAttr.ag" #-}
Map.singleton nt_ inh_
{-# LINE 1187 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOinhMap' ->
(case (({-# LINE 8 "./src-ag/DistChildAttr.ag" #-}
Map.singleton nt_ syn_
{-# LINE 1192 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOsynMap' ->
(case ((let sem_Nonterminal_Nonterminal_1 :: T_Nonterminal_1
sem_Nonterminal_Nonterminal_1 =
(T_Nonterminal_1 (\ (!_lhsIaugmentsIn)
(!_lhsIforcedIrrefutables)
(!_lhsIinhMap)
(!_lhsImainName)
(!_lhsIoptions)
(!_lhsIsynMap) ->
(case (({-# LINE 157 "./src-ag/Desugar.ag" #-}
nt_
{-# LINE 1205 "dist/build/Desugar.hs" #-}
)) of
{ !_prodsOnt ->
(case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-}
_lhsIsynMap
{-# LINE 1210 "dist/build/Desugar.hs" #-}
)) of
{ !_prodsOsynMap ->
(case (({-# LINE 36 "./src-ag/Desugar.ag" #-}
_lhsIoptions
{-# LINE 1215 "dist/build/Desugar.hs" #-}
)) of
{ !_prodsOoptions ->
(case (({-# LINE 289 "./src-ag/Desugar.ag" #-}
_lhsImainName
{-# LINE 1220 "dist/build/Desugar.hs" #-}
)) of
{ !_prodsOmainName ->
(case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-}
_lhsIinhMap
{-# LINE 1225 "dist/build/Desugar.hs" #-}
)) of
{ !_prodsOinhMap ->
(case (({-# LINE 215 "./src-ag/Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 1230 "dist/build/Desugar.hs" #-}
)) of
{ !_prodsOforcedIrrefutables ->
(case (({-# LINE 239 "./src-ag/Desugar.ag" #-}
Map.findWithDefault Map.empty nt_ _lhsIaugmentsIn
{-# LINE 1235 "dist/build/Desugar.hs" #-}
)) of
{ !_augmentsIn ->
(case (({-# LINE 230 "./src-ag/Desugar.ag" #-}
_augmentsIn
{-# LINE 1240 "dist/build/Desugar.hs" #-}
)) of
{ !_prodsOaugmentsIn ->
(case (prods_ _prodsOaugmentsIn _prodsOforcedIrrefutables _prodsOinhMap _prodsOmainName _prodsOnt _prodsOoptions _prodsOsynMap) of
{ ( !_prodsIallAttributes,!_prodsIaugmentsOut,!_prodsIerrors,!_prodsIoutput) ->
(case (({-# LINE 196 "./src-ag/Desugar.ag" #-}
_prodsIallAttributes
{-# LINE 1247 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOallAttributes ->
(case (({-# LINE 240 "./src-ag/Desugar.ag" #-}
Map.singleton nt_ _prodsIaugmentsOut
{-# LINE 1252 "dist/build/Desugar.hs" #-}
)) of
{ !_augmentsOut ->
(case (({-# LINE 229 "./src-ag/Desugar.ag" #-}
_augmentsOut
{-# LINE 1257 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOaugmentsOut ->
(case (({-# LINE 38 "./src-ag/Desugar.ag" #-}
_prodsIerrors
{-# LINE 1262 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOerrors ->
(case (({-# LINE 292 "./src-ag/Desugar.ag" #-}
addLateAttr _lhsIoptions _lhsImainName
{-# LINE 1267 "dist/build/Desugar.hs" #-}
)) of
{ !_extraInh ->
(case (({-# LINE 308 "./src-ag/Desugar.ag" #-}
Nonterminal
nt_ params_
(_extraInh `Map.union` inh_)
syn_
_prodsIoutput
{-# LINE 1276 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOoutput ->
( _lhsOallAttributes,_lhsOaugmentsOut,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))
in sem_Nonterminal_Nonterminal_1)) of
{ ( !sem_Nonterminal_1) ->
( _lhsOinhMap',_lhsOsynMap',sem_Nonterminal_1) }) }) }))
-- Nonterminals ------------------------------------------------
{-
visit 0:
synthesized attributes:
inhMap' : Map Identifier Attributes
synMap' : Map Identifier Attributes
visit 1:
inherited attributes:
augmentsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))
forcedIrrefutables : AttrMap
inhMap : Map Identifier Attributes
mainName : String
options : Options
synMap : Map Identifier Attributes
synthesized attributes:
allAttributes : AttrMap
augmentsOut : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))
errors : Seq Error
output : Nonterminals
alternatives:
alternative Cons:
child hd : Nonterminal
child tl : Nonterminals
visit 1:
local output : _
alternative Nil:
visit 1:
local output : _
-}
-- cata
sem_Nonterminals :: Nonterminals ->
T_Nonterminals
sem_Nonterminals !list =
(Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list))
-- semantic domain
newtype T_Nonterminals = T_Nonterminals (( (Map Identifier Attributes),(Map Identifier Attributes),T_Nonterminals_1))
newtype T_Nonterminals_1 = T_Nonterminals_1 ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) ->
AttrMap ->
(Map Identifier Attributes) ->
String ->
Options ->
(Map Identifier Attributes) ->
( 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),inhMap_Inh_Nonterminals :: !((Map Identifier Attributes)),mainName_Inh_Nonterminals :: !(String),options_Inh_Nonterminals :: !(Options),synMap_Inh_Nonterminals :: !((Map Identifier Attributes))}
data Syn_Nonterminals = Syn_Nonterminals {allAttributes_Syn_Nonterminals :: !(AttrMap),augmentsOut_Syn_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),errors_Syn_Nonterminals :: !((Seq Error)),inhMap'_Syn_Nonterminals :: !((Map Identifier Attributes)),output_Syn_Nonterminals :: !(Nonterminals),synMap'_Syn_Nonterminals :: !((Map Identifier Attributes))}
wrap_Nonterminals :: T_Nonterminals ->
Inh_Nonterminals ->
Syn_Nonterminals
wrap_Nonterminals !(T_Nonterminals sem) !(Inh_Nonterminals _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) =
(let ( !_lhsOinhMap',!_lhsOsynMap',!T_Nonterminals_1 sem_1) = sem
( !_lhsOallAttributes,!_lhsOaugmentsOut,!_lhsOerrors,!_lhsOoutput) = sem_1 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap
in (Syn_Nonterminals _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap'))
sem_Nonterminals_Cons :: T_Nonterminal ->
T_Nonterminals ->
T_Nonterminals
sem_Nonterminals_Cons !(T_Nonterminal hd_) !(T_Nonterminals tl_) =
(T_Nonterminals (case (tl_) of
{ ( !_tlIinhMap',!_tlIsynMap',!T_Nonterminals_1 tl_1) ->
(case (hd_) of
{ ( !_hdIinhMap',!_hdIsynMap',!T_Nonterminal_1 hd_1) ->
(case (({-# LINE 4 "./src-ag/DistChildAttr.ag" #-}
_hdIinhMap' `Map.union` _tlIinhMap'
{-# LINE 1345 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOinhMap' ->
(case (({-# LINE 4 "./src-ag/DistChildAttr.ag" #-}
_hdIsynMap' `Map.union` _tlIsynMap'
{-# LINE 1350 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOsynMap' ->
(case ((let sem_Nonterminals_Cons_1 :: T_Nonterminals_1
sem_Nonterminals_Cons_1 =
(T_Nonterminals_1 (\ (!_lhsIaugmentsIn)
(!_lhsIforcedIrrefutables)
(!_lhsIinhMap)
(!_lhsImainName)
(!_lhsIoptions)
(!_lhsIsynMap) ->
(case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-}
_lhsIsynMap
{-# LINE 1363 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOsynMap ->
(case (({-# LINE 36 "./src-ag/Desugar.ag" #-}
_lhsIoptions
{-# LINE 1368 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOoptions ->
(case (({-# LINE 289 "./src-ag/Desugar.ag" #-}
_lhsImainName
{-# LINE 1373 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOmainName ->
(case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-}
_lhsIinhMap
{-# LINE 1378 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOinhMap ->
(case (({-# LINE 215 "./src-ag/Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 1383 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOforcedIrrefutables ->
(case (({-# LINE 228 "./src-ag/Desugar.ag" #-}
_lhsIaugmentsIn
{-# LINE 1388 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOaugmentsIn ->
(case (tl_1 _tlOaugmentsIn _tlOforcedIrrefutables _tlOinhMap _tlOmainName _tlOoptions _tlOsynMap) of
{ ( !_tlIallAttributes,!_tlIaugmentsOut,!_tlIerrors,!_tlIoutput) ->
(case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-}
_lhsIsynMap
{-# LINE 1395 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOsynMap ->
(case (({-# LINE 36 "./src-ag/Desugar.ag" #-}
_lhsIoptions
{-# LINE 1400 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOoptions ->
(case (({-# LINE 289 "./src-ag/Desugar.ag" #-}
_lhsImainName
{-# LINE 1405 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOmainName ->
(case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-}
_lhsIinhMap
{-# LINE 1410 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOinhMap ->
(case (({-# LINE 215 "./src-ag/Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 1415 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOforcedIrrefutables ->
(case (({-# LINE 228 "./src-ag/Desugar.ag" #-}
_lhsIaugmentsIn
{-# LINE 1420 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOaugmentsIn ->
(case (hd_1 _hdOaugmentsIn _hdOforcedIrrefutables _hdOinhMap _hdOmainName _hdOoptions _hdOsynMap) of
{ ( !_hdIallAttributes,!_hdIaugmentsOut,!_hdIerrors,!_hdIoutput) ->
(case (({-# LINE 196 "./src-ag/Desugar.ag" #-}
_hdIallAttributes `mergeAttributes` _tlIallAttributes
{-# LINE 1427 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOallAttributes ->
(case (({-# LINE 229 "./src-ag/Desugar.ag" #-}
_hdIaugmentsOut `Map.union` _tlIaugmentsOut
{-# LINE 1432 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOaugmentsOut ->
(case (({-# LINE 38 "./src-ag/Desugar.ag" #-}
_hdIerrors Seq.>< _tlIerrors
{-# LINE 1437 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOerrors ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
(:) _hdIoutput _tlIoutput
{-# LINE 1442 "dist/build/Desugar.hs" #-}
)) of
{ !_output ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
_output
{-# LINE 1447 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOoutput ->
( _lhsOallAttributes,_lhsOaugmentsOut,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))
in sem_Nonterminals_Cons_1)) of
{ ( !sem_Nonterminals_1) ->
( _lhsOinhMap',_lhsOsynMap',sem_Nonterminals_1) }) }) }) }) }))
sem_Nonterminals_Nil :: T_Nonterminals
sem_Nonterminals_Nil =
(T_Nonterminals (case (({-# LINE 4 "./src-ag/DistChildAttr.ag" #-}
Map.empty
{-# LINE 1458 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOinhMap' ->
(case (({-# LINE 4 "./src-ag/DistChildAttr.ag" #-}
Map.empty
{-# LINE 1463 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOsynMap' ->
(case ((let sem_Nonterminals_Nil_1 :: T_Nonterminals_1
sem_Nonterminals_Nil_1 =
(T_Nonterminals_1 (\ (!_lhsIaugmentsIn)
(!_lhsIforcedIrrefutables)
(!_lhsIinhMap)
(!_lhsImainName)
(!_lhsIoptions)
(!_lhsIsynMap) ->
(case (({-# LINE 196 "./src-ag/Desugar.ag" #-}
Map.empty
{-# LINE 1476 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOallAttributes ->
(case (({-# LINE 229 "./src-ag/Desugar.ag" #-}
Map.empty
{-# LINE 1481 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOaugmentsOut ->
(case (({-# LINE 38 "./src-ag/Desugar.ag" #-}
Seq.empty
{-# LINE 1486 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOerrors ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
[]
{-# LINE 1491 "dist/build/Desugar.hs" #-}
)) of
{ !_output ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
_output
{-# LINE 1496 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOoutput ->
( _lhsOallAttributes,_lhsOaugmentsOut,_lhsOerrors,_lhsOoutput) }) }) }) }) })))
in sem_Nonterminals_Nil_1)) of
{ ( !sem_Nonterminals_1) ->
( _lhsOinhMap',_lhsOsynMap',sem_Nonterminals_1) }) }) }))
-- 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 : Pattern
errors : Seq Error
output : Pattern
alternatives:
alternative Constr:
child name : {ConstructorIdent}
child pats : Patterns
visit 1:
local copy : _
local output : _
alternative Product:
child pos : {Pos}
child pats : Patterns
visit 1:
local copy : _
local output : _
alternative Alias:
child field : {Identifier}
child attr : {Identifier}
child pat : Pattern
visit 0:
local def : _
visit 1:
local copy : _
local _tup2 : _
local field' : _
local err2 : _
local err1 : _
local output : _
alternative Irrefutable:
child pat : Pattern
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 !(Constr _name _pats) =
(sem_Pattern_Constr _name (sem_Patterns _pats))
sem_Pattern !(Product _pos _pats) =
(sem_Pattern_Product _pos (sem_Patterns _pats))
sem_Pattern !(Alias _field _attr _pat) =
(sem_Pattern_Alias _field _attr (sem_Pattern _pat))
sem_Pattern !(Irrefutable _pat) =
(sem_Pattern_Irrefutable (sem_Pattern _pat))
sem_Pattern !(Underscore _pos) =
(sem_Pattern_Underscore _pos)
-- 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_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 179 "./src-ag/Desugar.ag" #-}
_patsIdefsCollect
{-# LINE 1597 "dist/build/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 152 "./src-ag/Desugar.ag" #-}
_lhsInt
{-# LINE 1610 "dist/build/Desugar.hs" #-}
)) of
{ !_patsOnt ->
(case (({-# LINE 153 "./src-ag/Desugar.ag" #-}
_lhsIcon
{-# LINE 1615 "dist/build/Desugar.hs" #-}
)) of
{ !_patsOcon ->
(case (({-# LINE 215 "./src-ag/Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 1620 "dist/build/Desugar.hs" #-}
)) of
{ !_patsOforcedIrrefutables ->
(case (({-# LINE 185 "./src-ag/Desugar.ag" #-}
_lhsIdefs
{-# LINE 1625 "dist/build/Desugar.hs" #-}
)) of
{ !_patsOdefs ->
(case (({-# LINE 126 "./src-ag/Desugar.ag" #-}
_lhsIchildSyns
{-# LINE 1630 "dist/build/Desugar.hs" #-}
)) of
{ !_patsOchildSyns ->
(case (({-# LINE 126 "./src-ag/Desugar.ag" #-}
_lhsIchildInhs
{-# LINE 1635 "dist/build/Desugar.hs" #-}
)) of
{ !_patsOchildInhs ->
(case (pats_1 _patsOchildInhs _patsOchildSyns _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt) of
{ ( !_patsIallAttributes,!_patsIcopy,!_patsIerrors,!_patsIoutput) ->
(case (({-# LINE 196 "./src-ag/Desugar.ag" #-}
_patsIallAttributes
{-# LINE 1642 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOallAttributes ->
(case (({-# LINE 22 "./src-ag/Patterns.ag" #-}
Constr name_ _patsIcopy
{-# LINE 1647 "dist/build/Desugar.hs" #-}
)) of
{ !_copy ->
(case (({-# LINE 22 "./src-ag/Patterns.ag" #-}
_copy
{-# LINE 1652 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOcopy ->
(case (({-# LINE 38 "./src-ag/Desugar.ag" #-}
_patsIerrors
{-# LINE 1657 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOerrors ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
Constr name_ _patsIoutput
{-# LINE 1662 "dist/build/Desugar.hs" #-}
)) of
{ !_output ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
_output
{-# LINE 1667 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOoutput ->
( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) })))
in sem_Pattern_Constr_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 179 "./src-ag/Desugar.ag" #-}
_patsIdefsCollect
{-# LINE 1682 "dist/build/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 152 "./src-ag/Desugar.ag" #-}
_lhsInt
{-# LINE 1695 "dist/build/Desugar.hs" #-}
)) of
{ !_patsOnt ->
(case (({-# LINE 153 "./src-ag/Desugar.ag" #-}
_lhsIcon
{-# LINE 1700 "dist/build/Desugar.hs" #-}
)) of
{ !_patsOcon ->
(case (({-# LINE 215 "./src-ag/Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 1705 "dist/build/Desugar.hs" #-}
)) of
{ !_patsOforcedIrrefutables ->
(case (({-# LINE 185 "./src-ag/Desugar.ag" #-}
_lhsIdefs
{-# LINE 1710 "dist/build/Desugar.hs" #-}
)) of
{ !_patsOdefs ->
(case (({-# LINE 126 "./src-ag/Desugar.ag" #-}
_lhsIchildSyns
{-# LINE 1715 "dist/build/Desugar.hs" #-}
)) of
{ !_patsOchildSyns ->
(case (({-# LINE 126 "./src-ag/Desugar.ag" #-}
_lhsIchildInhs
{-# LINE 1720 "dist/build/Desugar.hs" #-}
)) of
{ !_patsOchildInhs ->
(case (pats_1 _patsOchildInhs _patsOchildSyns _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt) of
{ ( !_patsIallAttributes,!_patsIcopy,!_patsIerrors,!_patsIoutput) ->
(case (({-# LINE 196 "./src-ag/Desugar.ag" #-}
_patsIallAttributes
{-# LINE 1727 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOallAttributes ->
(case (({-# LINE 22 "./src-ag/Patterns.ag" #-}
Product pos_ _patsIcopy
{-# LINE 1732 "dist/build/Desugar.hs" #-}
)) of
{ !_copy ->
(case (({-# LINE 22 "./src-ag/Patterns.ag" #-}
_copy
{-# LINE 1737 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOcopy ->
(case (({-# LINE 38 "./src-ag/Desugar.ag" #-}
_patsIerrors
{-# LINE 1742 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOerrors ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
Product pos_ _patsIoutput
{-# LINE 1747 "dist/build/Desugar.hs" #-}
)) of
{ !_output ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
_output
{-# LINE 1752 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOoutput ->
( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) })))
in sem_Pattern_Product_1)) of
{ ( !sem_Pattern_1) ->
( _lhsOdefsCollect,sem_Pattern_1) }) }) }))
sem_Pattern_Alias :: Identifier ->
Identifier ->
T_Pattern ->
T_Pattern
sem_Pattern_Alias !field_ !attr_ !(T_Pattern pat_) =
(T_Pattern (case (({-# LINE 182 "./src-ag/Desugar.ag" #-}
Set.singleton (field_, attr_)
{-# LINE 1766 "dist/build/Desugar.hs" #-}
)) of
{ !_def ->
(case (pat_) of
{ ( !_patIdefsCollect,!T_Pattern_1 pat_1) ->
(case (({-# LINE 183 "./src-ag/Desugar.ag" #-}
_def `Set.union` _patIdefsCollect
{-# LINE 1773 "dist/build/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 152 "./src-ag/Desugar.ag" #-}
_lhsInt
{-# LINE 1786 "dist/build/Desugar.hs" #-}
)) of
{ !_patOnt ->
(case (({-# LINE 153 "./src-ag/Desugar.ag" #-}
_lhsIcon
{-# LINE 1791 "dist/build/Desugar.hs" #-}
)) of
{ !_patOcon ->
(case (({-# LINE 215 "./src-ag/Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 1796 "dist/build/Desugar.hs" #-}
)) of
{ !_patOforcedIrrefutables ->
(case (({-# LINE 185 "./src-ag/Desugar.ag" #-}
_lhsIdefs
{-# LINE 1801 "dist/build/Desugar.hs" #-}
)) of
{ !_patOdefs ->
(case (({-# LINE 126 "./src-ag/Desugar.ag" #-}
_lhsIchildSyns
{-# LINE 1806 "dist/build/Desugar.hs" #-}
)) of
{ !_patOchildSyns ->
(case (({-# LINE 126 "./src-ag/Desugar.ag" #-}
_lhsIchildInhs
{-# LINE 1811 "dist/build/Desugar.hs" #-}
)) of
{ !_patOchildInhs ->
(case (pat_1 _patOchildInhs _patOchildSyns _patOcon _patOdefs _patOforcedIrrefutables _patOnt) of
{ ( !_patIallAttributes,!_patIcopy,!_patIerrors,!_patIoutput) ->
(case (({-# LINE 200 "./src-ag/Desugar.ag" #-}
(Map.singleton _lhsInt $ Map.singleton _lhsIcon $ Set.singleton (field_, attr_)) `mergeAttributes` _patIallAttributes
{-# LINE 1818 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOallAttributes ->
(case (({-# LINE 22 "./src-ag/Patterns.ag" #-}
Alias field_ attr_ _patIcopy
{-# LINE 1823 "dist/build/Desugar.hs" #-}
)) of
{ !_copy ->
(case (({-# LINE 22 "./src-ag/Patterns.ag" #-}
_copy
{-# LINE 1828 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOcopy ->
(case (({-# LINE 110 "./src-ag/Desugar.ag" #-}
maybeError field_ (UndefAttr _lhsInt _lhsIcon (Ident "<ANY>" (getPos field_)) attr_ True) $
findField field_ attr_ _lhsIchildInhs
{-# LINE 1834 "dist/build/Desugar.hs" #-}
)) of
{ !__tup2 ->
(case (({-# LINE 110 "./src-ag/Desugar.ag" #-}
__tup2
{-# LINE 1839 "dist/build/Desugar.hs" #-}
)) of
{ !(!_field',_) ->
(case (({-# LINE 112 "./src-ag/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 1848 "dist/build/Desugar.hs" #-}
)) of
{ !_err2 ->
(case (({-# LINE 110 "./src-ag/Desugar.ag" #-}
__tup2
{-# LINE 1853 "dist/build/Desugar.hs" #-}
)) of
{ !(_,!_err1) ->
(case (({-# LINE 117 "./src-ag/Desugar.ag" #-}
_err1 Seq.>< _err2 Seq.>< _patIerrors
{-# LINE 1858 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOerrors ->
(case (({-# LINE 118 "./src-ag/Desugar.ag" #-}
Alias _field' attr_ _patIoutput
{-# LINE 1863 "dist/build/Desugar.hs" #-}
)) of
{ !_output ->
(case (({-# LINE 219 "./src-ag/Desugar.ag" #-}
if Set.member (field_, attr_) $ Map.findWithDefault Set.empty _lhsIcon $ Map.findWithDefault Map.empty _lhsInt $ _lhsIforcedIrrefutables
then Irrefutable _output
else _output
{-# LINE 1870 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOoutput ->
( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))
in sem_Pattern_Alias_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 179 "./src-ag/Desugar.ag" #-}
_patIdefsCollect
{-# LINE 1884 "dist/build/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 202 "./src-ag/Desugar.ag" #-}
Map.empty
{-# LINE 1897 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOallAttributes ->
(case (({-# LINE 152 "./src-ag/Desugar.ag" #-}
_lhsInt
{-# LINE 1902 "dist/build/Desugar.hs" #-}
)) of
{ !_patOnt ->
(case (({-# LINE 215 "./src-ag/Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 1907 "dist/build/Desugar.hs" #-}
)) of
{ !_patOforcedIrrefutables ->
(case (({-# LINE 185 "./src-ag/Desugar.ag" #-}
_lhsIdefs
{-# LINE 1912 "dist/build/Desugar.hs" #-}
)) of
{ !_patOdefs ->
(case (({-# LINE 153 "./src-ag/Desugar.ag" #-}
_lhsIcon
{-# LINE 1917 "dist/build/Desugar.hs" #-}
)) of
{ !_patOcon ->
(case (({-# LINE 126 "./src-ag/Desugar.ag" #-}
_lhsIchildSyns
{-# LINE 1922 "dist/build/Desugar.hs" #-}
)) of
{ !_patOchildSyns ->
(case (({-# LINE 126 "./src-ag/Desugar.ag" #-}
_lhsIchildInhs
{-# LINE 1927 "dist/build/Desugar.hs" #-}
)) of
{ !_patOchildInhs ->
(case (pat_1 _patOchildInhs _patOchildSyns _patOcon _patOdefs _patOforcedIrrefutables _patOnt) of
{ ( !_patIallAttributes,!_patIcopy,!_patIerrors,!_patIoutput) ->
(case (({-# LINE 22 "./src-ag/Patterns.ag" #-}
Irrefutable _patIcopy
{-# LINE 1934 "dist/build/Desugar.hs" #-}
)) of
{ !_copy ->
(case (({-# LINE 22 "./src-ag/Patterns.ag" #-}
_copy
{-# LINE 1939 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOcopy ->
(case (({-# LINE 38 "./src-ag/Desugar.ag" #-}
_patIerrors
{-# LINE 1944 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOerrors ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
Irrefutable _patIoutput
{-# LINE 1949 "dist/build/Desugar.hs" #-}
)) of
{ !_output ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
_output
{-# LINE 1954 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOoutput ->
( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) })))
in sem_Pattern_Irrefutable_1)) of
{ ( !sem_Pattern_1) ->
( _lhsOdefsCollect,sem_Pattern_1) }) }) }))
sem_Pattern_Underscore :: Pos ->
T_Pattern
sem_Pattern_Underscore !pos_ =
(T_Pattern (case (({-# LINE 179 "./src-ag/Desugar.ag" #-}
Set.empty
{-# LINE 1966 "dist/build/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 196 "./src-ag/Desugar.ag" #-}
Map.empty
{-# LINE 1979 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOallAttributes ->
(case (({-# LINE 22 "./src-ag/Patterns.ag" #-}
Underscore pos_
{-# LINE 1984 "dist/build/Desugar.hs" #-}
)) of
{ !_copy ->
(case (({-# LINE 22 "./src-ag/Patterns.ag" #-}
_copy
{-# LINE 1989 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOcopy ->
(case (({-# LINE 38 "./src-ag/Desugar.ag" #-}
Seq.empty
{-# LINE 1994 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOerrors ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
Underscore pos_
{-# LINE 1999 "dist/build/Desugar.hs" #-}
)) of
{ !_output ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
_output
{-# LINE 2004 "dist/build/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 : Patterns
errors : Seq Error
output : Patterns
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 179 "./src-ag/Desugar.ag" #-}
_hdIdefsCollect `Set.union` _tlIdefsCollect
{-# LINE 2074 "dist/build/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 152 "./src-ag/Desugar.ag" #-}
_lhsInt
{-# LINE 2087 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOnt ->
(case (({-# LINE 153 "./src-ag/Desugar.ag" #-}
_lhsIcon
{-# LINE 2092 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOcon ->
(case (({-# LINE 152 "./src-ag/Desugar.ag" #-}
_lhsInt
{-# LINE 2097 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOnt ->
(case (({-# LINE 153 "./src-ag/Desugar.ag" #-}
_lhsIcon
{-# LINE 2102 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOcon ->
(case (({-# LINE 215 "./src-ag/Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 2107 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOforcedIrrefutables ->
(case (({-# LINE 185 "./src-ag/Desugar.ag" #-}
_lhsIdefs
{-# LINE 2112 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOdefs ->
(case (({-# LINE 126 "./src-ag/Desugar.ag" #-}
_lhsIchildSyns
{-# LINE 2117 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOchildSyns ->
(case (({-# LINE 126 "./src-ag/Desugar.ag" #-}
_lhsIchildInhs
{-# LINE 2122 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOchildInhs ->
(case (tl_1 _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt) of
{ ( !_tlIallAttributes,!_tlIcopy,!_tlIerrors,!_tlIoutput) ->
(case (({-# LINE 215 "./src-ag/Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 2129 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOforcedIrrefutables ->
(case (({-# LINE 185 "./src-ag/Desugar.ag" #-}
_lhsIdefs
{-# LINE 2134 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOdefs ->
(case (({-# LINE 126 "./src-ag/Desugar.ag" #-}
_lhsIchildSyns
{-# LINE 2139 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOchildSyns ->
(case (({-# LINE 126 "./src-ag/Desugar.ag" #-}
_lhsIchildInhs
{-# LINE 2144 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOchildInhs ->
(case (hd_1 _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt) of
{ ( !_hdIallAttributes,!_hdIcopy,!_hdIerrors,!_hdIoutput) ->
(case (({-# LINE 196 "./src-ag/Desugar.ag" #-}
_hdIallAttributes `mergeAttributes` _tlIallAttributes
{-# LINE 2151 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOallAttributes ->
(case (({-# LINE 22 "./src-ag/Patterns.ag" #-}
(:) _hdIcopy _tlIcopy
{-# LINE 2156 "dist/build/Desugar.hs" #-}
)) of
{ !_copy ->
(case (({-# LINE 22 "./src-ag/Patterns.ag" #-}
_copy
{-# LINE 2161 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOcopy ->
(case (({-# LINE 38 "./src-ag/Desugar.ag" #-}
_hdIerrors Seq.>< _tlIerrors
{-# LINE 2166 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOerrors ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
(:) _hdIoutput _tlIoutput
{-# LINE 2171 "dist/build/Desugar.hs" #-}
)) of
{ !_output ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
_output
{-# LINE 2176 "dist/build/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 179 "./src-ag/Desugar.ag" #-}
Set.empty
{-# LINE 2187 "dist/build/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 196 "./src-ag/Desugar.ag" #-}
Map.empty
{-# LINE 2200 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOallAttributes ->
(case (({-# LINE 22 "./src-ag/Patterns.ag" #-}
[]
{-# LINE 2205 "dist/build/Desugar.hs" #-}
)) of
{ !_copy ->
(case (({-# LINE 22 "./src-ag/Patterns.ag" #-}
_copy
{-# LINE 2210 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOcopy ->
(case (({-# LINE 38 "./src-ag/Desugar.ag" #-}
Seq.empty
{-# LINE 2215 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOerrors ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
[]
{-# LINE 2220 "dist/build/Desugar.hs" #-}
)) of
{ !_output ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
_output
{-# LINE 2225 "dist/build/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
inhMap : Map Identifier Attributes
mainName : String
nt : NontermIdent
options : Options
synMap : Map Identifier Attributes
synthesized attributes:
allAttributes : AttrMap
augmentsOut : Map ConstructorIdent (Map Identifier [Expression])
errors : Seq Error
output : Production
alternatives:
alternative Production:
child con : {ConstructorIdent}
child params : {[Identifier]}
child constraints : {[Type]}
child children : Children
child rules : Rules
child typeSigs : TypeSigs
child macro : {MaybeMacro}
visit 0:
local augmentsIn : _
local _tup3 : _
local augmentsOut1 : _
local augmentsOut : _
local augmentErrs : _
local output : _
-}
-- cata
sem_Production :: Production ->
T_Production
sem_Production !(Production _con _params _constraints _children _rules _typeSigs _macro) =
(sem_Production_Production _con _params _constraints (sem_Children _children) (sem_Rules _rules) (sem_TypeSigs _typeSigs) _macro)
-- semantic domain
newtype T_Production = T_Production ((Map ConstructorIdent (Map Identifier [Expression])) ->
AttrMap ->
(Map Identifier Attributes) ->
String ->
NontermIdent ->
Options ->
(Map Identifier Attributes) ->
( 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),inhMap_Inh_Production :: !((Map Identifier Attributes)),mainName_Inh_Production :: !(String),nt_Inh_Production :: !(NontermIdent),options_Inh_Production :: !(Options),synMap_Inh_Production :: !((Map Identifier Attributes))}
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 _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap) =
(let ( !_lhsOallAttributes,!_lhsOaugmentsOut,!_lhsOerrors,!_lhsOoutput) = sem _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap
in (Syn_Production _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput))
sem_Production_Production :: ConstructorIdent ->
([Identifier]) ->
([Type]) ->
T_Children ->
T_Rules ->
T_TypeSigs ->
MaybeMacro ->
T_Production
sem_Production_Production !con_ !params_ !constraints_ !(T_Children children_) !(T_Rules rules_) !(T_TypeSigs typeSigs_) !macro_ =
(T_Production (\ (!_lhsIaugmentsIn)
(!_lhsIforcedIrrefutables)
(!_lhsIinhMap)
(!_lhsImainName)
(!_lhsInt)
(!_lhsIoptions)
(!_lhsIsynMap) ->
(case (({-# LINE 152 "./src-ag/Desugar.ag" #-}
_lhsInt
{-# LINE 2305 "dist/build/Desugar.hs" #-}
)) of
{ !_rulesOnt ->
(case (({-# LINE 161 "./src-ag/Desugar.ag" #-}
con_
{-# LINE 2310 "dist/build/Desugar.hs" #-}
)) of
{ !_rulesOcon ->
(case (rules_) of
{ ( !_rulesIdefsCollect,!T_Rules_1 rules_1) ->
(case (({-# LINE 36 "./src-ag/Desugar.ag" #-}
_lhsIoptions
{-# LINE 2317 "dist/build/Desugar.hs" #-}
)) of
{ !_rulesOoptions ->
(case (({-# LINE 215 "./src-ag/Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 2322 "dist/build/Desugar.hs" #-}
)) of
{ !_rulesOforcedIrrefutables ->
(case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-}
_lhsIsynMap
{-# LINE 2327 "dist/build/Desugar.hs" #-}
)) of
{ !_childrenOsynMap ->
(case (({-# LINE 36 "./src-ag/Desugar.ag" #-}
_lhsIoptions
{-# LINE 2332 "dist/build/Desugar.hs" #-}
)) of
{ !_childrenOoptions ->
(case (({-# LINE 289 "./src-ag/Desugar.ag" #-}
_lhsImainName
{-# LINE 2337 "dist/build/Desugar.hs" #-}
)) of
{ !_childrenOmainName ->
(case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-}
_lhsIinhMap
{-# LINE 2342 "dist/build/Desugar.hs" #-}
)) of
{ !_childrenOinhMap ->
(case (children_ _childrenOinhMap _childrenOmainName _childrenOoptions _childrenOsynMap) of
{ ( !_childrenIchildInhs,!_childrenIchildSyns,!_childrenIoutput) ->
(case (({-# LINE 126 "./src-ag/Desugar.ag" #-}
_childrenIchildSyns
{-# LINE 2349 "dist/build/Desugar.hs" #-}
)) of
{ !_rulesOchildSyns ->
(case (({-# LINE 126 "./src-ag/Desugar.ag" #-}
_childrenIchildInhs
{-# LINE 2354 "dist/build/Desugar.hs" #-}
)) of
{ !_rulesOchildInhs ->
(case (({-# LINE 188 "./src-ag/Desugar.ag" #-}
_rulesIdefsCollect
{-# LINE 2359 "dist/build/Desugar.hs" #-}
)) of
{ !_rulesOdefs ->
(case (rules_1 _rulesOchildInhs _rulesOchildSyns _rulesOcon _rulesOdefs _rulesOforcedIrrefutables _rulesOnt _rulesOoptions) of
{ ( !_rulesIallAttributes,!_rulesIerrors,!_rulesIoutput) ->
(case (({-# LINE 196 "./src-ag/Desugar.ag" #-}
_rulesIallAttributes
{-# LINE 2366 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOallAttributes ->
(case (({-# LINE 244 "./src-ag/Desugar.ag" #-}
Map.findWithDefault Map.empty con_ _lhsIaugmentsIn
{-# LINE 2371 "dist/build/Desugar.hs" #-}
)) of
{ !_augmentsIn ->
(case (({-# LINE 247 "./src-ag/Desugar.ag" #-}
Map.mapAccum (desugarExprs _lhsIoptions _lhsInt con_ _childrenIchildInhs _childrenIchildSyns) Seq.empty _augmentsIn
{-# LINE 2376 "dist/build/Desugar.hs" #-}
)) of
{ !__tup3 ->
(case (({-# LINE 247 "./src-ag/Desugar.ag" #-}
__tup3
{-# LINE 2381 "dist/build/Desugar.hs" #-}
)) of
{ !(_,!_augmentsOut1) ->
(case (({-# LINE 245 "./src-ag/Desugar.ag" #-}
Map.singleton con_ _augmentsOut1
{-# LINE 2386 "dist/build/Desugar.hs" #-}
)) of
{ !_augmentsOut ->
(case (({-# LINE 231 "./src-ag/Desugar.ag" #-}
_augmentsOut
{-# LINE 2391 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOaugmentsOut ->
(case (({-# LINE 247 "./src-ag/Desugar.ag" #-}
__tup3
{-# LINE 2396 "dist/build/Desugar.hs" #-}
)) of
{ !(!_augmentErrs,_) ->
(case (({-# LINE 283 "./src-ag/Desugar.ag" #-}
_rulesIerrors Seq.>< _augmentErrs
{-# LINE 2401 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOerrors ->
(case (typeSigs_) of
{ ( !_typeSigsIoutput) ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
Production con_ params_ constraints_ _childrenIoutput _rulesIoutput _typeSigsIoutput macro_
{-# LINE 2408 "dist/build/Desugar.hs" #-}
)) of
{ !_output ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
_output
{-# LINE 2413 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOoutput ->
( _lhsOallAttributes,_lhsOaugmentsOut,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))
-- Productions -------------------------------------------------
{-
visit 0:
inherited attributes:
augmentsIn : Map ConstructorIdent (Map Identifier [Expression])
forcedIrrefutables : AttrMap
inhMap : Map Identifier Attributes
mainName : String
nt : NontermIdent
options : Options
synMap : Map Identifier Attributes
synthesized attributes:
allAttributes : AttrMap
augmentsOut : Map ConstructorIdent (Map Identifier [Expression])
errors : Seq Error
output : Productions
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 ->
(Map Identifier Attributes) ->
String ->
NontermIdent ->
Options ->
(Map Identifier Attributes) ->
( 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),inhMap_Inh_Productions :: !((Map Identifier Attributes)),mainName_Inh_Productions :: !(String),nt_Inh_Productions :: !(NontermIdent),options_Inh_Productions :: !(Options),synMap_Inh_Productions :: !((Map Identifier Attributes))}
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 _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap) =
(let ( !_lhsOallAttributes,!_lhsOaugmentsOut,!_lhsOerrors,!_lhsOoutput) = sem _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap
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)
(!_lhsIinhMap)
(!_lhsImainName)
(!_lhsInt)
(!_lhsIoptions)
(!_lhsIsynMap) ->
(case (({-# LINE 152 "./src-ag/Desugar.ag" #-}
_lhsInt
{-# LINE 2478 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOnt ->
(case (({-# LINE 152 "./src-ag/Desugar.ag" #-}
_lhsInt
{-# LINE 2483 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOnt ->
(case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-}
_lhsIsynMap
{-# LINE 2488 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOsynMap ->
(case (({-# LINE 36 "./src-ag/Desugar.ag" #-}
_lhsIoptions
{-# LINE 2493 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOoptions ->
(case (({-# LINE 289 "./src-ag/Desugar.ag" #-}
_lhsImainName
{-# LINE 2498 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOmainName ->
(case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-}
_lhsIinhMap
{-# LINE 2503 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOinhMap ->
(case (({-# LINE 215 "./src-ag/Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 2508 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOforcedIrrefutables ->
(case (({-# LINE 230 "./src-ag/Desugar.ag" #-}
_lhsIaugmentsIn
{-# LINE 2513 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOaugmentsIn ->
(case (tl_ _tlOaugmentsIn _tlOforcedIrrefutables _tlOinhMap _tlOmainName _tlOnt _tlOoptions _tlOsynMap) of
{ ( !_tlIallAttributes,!_tlIaugmentsOut,!_tlIerrors,!_tlIoutput) ->
(case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-}
_lhsIsynMap
{-# LINE 2520 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOsynMap ->
(case (({-# LINE 36 "./src-ag/Desugar.ag" #-}
_lhsIoptions
{-# LINE 2525 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOoptions ->
(case (({-# LINE 289 "./src-ag/Desugar.ag" #-}
_lhsImainName
{-# LINE 2530 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOmainName ->
(case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-}
_lhsIinhMap
{-# LINE 2535 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOinhMap ->
(case (({-# LINE 215 "./src-ag/Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 2540 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOforcedIrrefutables ->
(case (({-# LINE 230 "./src-ag/Desugar.ag" #-}
_lhsIaugmentsIn
{-# LINE 2545 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOaugmentsIn ->
(case (hd_ _hdOaugmentsIn _hdOforcedIrrefutables _hdOinhMap _hdOmainName _hdOnt _hdOoptions _hdOsynMap) of
{ ( !_hdIallAttributes,!_hdIaugmentsOut,!_hdIerrors,!_hdIoutput) ->
(case (({-# LINE 196 "./src-ag/Desugar.ag" #-}
_hdIallAttributes `mergeAttributes` _tlIallAttributes
{-# LINE 2552 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOallAttributes ->
(case (({-# LINE 231 "./src-ag/Desugar.ag" #-}
_hdIaugmentsOut `Map.union` _tlIaugmentsOut
{-# LINE 2557 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOaugmentsOut ->
(case (({-# LINE 38 "./src-ag/Desugar.ag" #-}
_hdIerrors Seq.>< _tlIerrors
{-# LINE 2562 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOerrors ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
(:) _hdIoutput _tlIoutput
{-# LINE 2567 "dist/build/Desugar.hs" #-}
)) of
{ !_output ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
_output
{-# LINE 2572 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOoutput ->
( _lhsOallAttributes,_lhsOaugmentsOut,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))
sem_Productions_Nil :: T_Productions
sem_Productions_Nil =
(T_Productions (\ (!_lhsIaugmentsIn)
(!_lhsIforcedIrrefutables)
(!_lhsIinhMap)
(!_lhsImainName)
(!_lhsInt)
(!_lhsIoptions)
(!_lhsIsynMap) ->
(case (({-# LINE 196 "./src-ag/Desugar.ag" #-}
Map.empty
{-# LINE 2587 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOallAttributes ->
(case (({-# LINE 231 "./src-ag/Desugar.ag" #-}
Map.empty
{-# LINE 2592 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOaugmentsOut ->
(case (({-# LINE 38 "./src-ag/Desugar.ag" #-}
Seq.empty
{-# LINE 2597 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOerrors ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
[]
{-# LINE 2602 "dist/build/Desugar.hs" #-}
)) of
{ !_output ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
_output
{-# LINE 2607 "dist/build/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 : Rule
alternatives:
alternative Rule:
child mbName : {Maybe Identifier}
child pattern : Pattern
child rhs : Expression
child owrt : {Bool}
child origin : {String}
child explicit : {Bool}
child pure : {Bool}
child identity : {Bool}
child mbError : {Maybe Error}
child eager : {Bool}
visit 1:
local ruleDescr : _
local output : _
-}
-- cata
sem_Rule :: Rule ->
T_Rule
sem_Rule !(Rule _mbName _pattern _rhs _owrt _origin _explicit _pure _identity _mbError _eager) =
(sem_Rule_Rule _mbName (sem_Pattern _pattern) (sem_Expression _rhs) _owrt _origin _explicit _pure _identity _mbError _eager)
-- semantic domain
newtype T_Rule = T_Rule (( (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 ->
Bool ->
Bool ->
(Maybe Error) ->
Bool ->
T_Rule
sem_Rule_Rule !mbName_ !(T_Pattern pattern_) !(T_Expression rhs_) !owrt_ !origin_ !explicit_ !pure_ !identity_ !mbError_ !eager_ =
(T_Rule (case (pattern_) of
{ ( !_patternIdefsCollect,!T_Pattern_1 pattern_1) ->
(case (({-# LINE 179 "./src-ag/Desugar.ag" #-}
_patternIdefsCollect
{-# LINE 2685 "dist/build/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 152 "./src-ag/Desugar.ag" #-}
_lhsInt
{-# LINE 2699 "dist/build/Desugar.hs" #-}
)) of
{ !_patternOnt ->
(case (({-# LINE 153 "./src-ag/Desugar.ag" #-}
_lhsIcon
{-# LINE 2704 "dist/build/Desugar.hs" #-}
)) of
{ !_patternOcon ->
(case (({-# LINE 215 "./src-ag/Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 2709 "dist/build/Desugar.hs" #-}
)) of
{ !_patternOforcedIrrefutables ->
(case (({-# LINE 185 "./src-ag/Desugar.ag" #-}
_lhsIdefs
{-# LINE 2714 "dist/build/Desugar.hs" #-}
)) of
{ !_patternOdefs ->
(case (({-# LINE 126 "./src-ag/Desugar.ag" #-}
_lhsIchildSyns
{-# LINE 2719 "dist/build/Desugar.hs" #-}
)) of
{ !_patternOchildSyns ->
(case (({-# LINE 126 "./src-ag/Desugar.ag" #-}
_lhsIchildInhs
{-# LINE 2724 "dist/build/Desugar.hs" #-}
)) of
{ !_patternOchildInhs ->
(case (pattern_1 _patternOchildInhs _patternOchildSyns _patternOcon _patternOdefs _patternOforcedIrrefutables _patternOnt) of
{ ( !_patternIallAttributes,!_patternIcopy,!_patternIerrors,!_patternIoutput) ->
(case (({-# LINE 196 "./src-ag/Desugar.ag" #-}
_patternIallAttributes
{-# LINE 2731 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOallAttributes ->
(case (({-# LINE 172 "./src-ag/Desugar.ag" #-}
show _lhsInt ++ " :: " ++ show _lhsIcon ++ " :: " ++ (concat $ intersperse "," $ map (\(f,a) -> show f ++ "." ++ show a) $ Set.toList _patternIdefsCollect)
{-# LINE 2736 "dist/build/Desugar.hs" #-}
)) of
{ !_ruleDescr ->
(case (({-# LINE 168 "./src-ag/Desugar.ag" #-}
_ruleDescr
{-# LINE 2741 "dist/build/Desugar.hs" #-}
)) of
{ !_rhsOruleDescr ->
(case (({-# LINE 36 "./src-ag/Desugar.ag" #-}
_lhsIoptions
{-# LINE 2746 "dist/build/Desugar.hs" #-}
)) of
{ !_rhsOoptions ->
(case (({-# LINE 152 "./src-ag/Desugar.ag" #-}
_lhsInt
{-# LINE 2751 "dist/build/Desugar.hs" #-}
)) of
{ !_rhsOnt ->
(case (({-# LINE 153 "./src-ag/Desugar.ag" #-}
_lhsIcon
{-# LINE 2756 "dist/build/Desugar.hs" #-}
)) of
{ !_rhsOcon ->
(case (({-# LINE 126 "./src-ag/Desugar.ag" #-}
_lhsIchildSyns
{-# LINE 2761 "dist/build/Desugar.hs" #-}
)) of
{ !_rhsOchildSyns ->
(case (({-# LINE 126 "./src-ag/Desugar.ag" #-}
_lhsIchildInhs
{-# LINE 2766 "dist/build/Desugar.hs" #-}
)) of
{ !_rhsOchildInhs ->
(case (rhs_ _rhsOchildInhs _rhsOchildSyns _rhsOcon _rhsOnt _rhsOoptions _rhsOruleDescr) of
{ ( !_rhsIerrors,!_rhsIoutput) ->
(case (({-# LINE 38 "./src-ag/Desugar.ag" #-}
_patternIerrors Seq.>< _rhsIerrors
{-# LINE 2773 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOerrors ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
Rule mbName_ _patternIoutput _rhsIoutput owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_
{-# LINE 2778 "dist/build/Desugar.hs" #-}
)) of
{ !_output ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
_output
{-# LINE 2783 "dist/build/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 : Rules
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 179 "./src-ag/Desugar.ag" #-}
_hdIdefsCollect `Set.union` _tlIdefsCollect
{-# LINE 2852 "dist/build/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 152 "./src-ag/Desugar.ag" #-}
_lhsInt
{-# LINE 2866 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOnt ->
(case (({-# LINE 153 "./src-ag/Desugar.ag" #-}
_lhsIcon
{-# LINE 2871 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOcon ->
(case (({-# LINE 152 "./src-ag/Desugar.ag" #-}
_lhsInt
{-# LINE 2876 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOnt ->
(case (({-# LINE 153 "./src-ag/Desugar.ag" #-}
_lhsIcon
{-# LINE 2881 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOcon ->
(case (({-# LINE 36 "./src-ag/Desugar.ag" #-}
_lhsIoptions
{-# LINE 2886 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOoptions ->
(case (({-# LINE 215 "./src-ag/Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 2891 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOforcedIrrefutables ->
(case (({-# LINE 185 "./src-ag/Desugar.ag" #-}
_lhsIdefs
{-# LINE 2896 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOdefs ->
(case (({-# LINE 126 "./src-ag/Desugar.ag" #-}
_lhsIchildSyns
{-# LINE 2901 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOchildSyns ->
(case (({-# LINE 126 "./src-ag/Desugar.ag" #-}
_lhsIchildInhs
{-# LINE 2906 "dist/build/Desugar.hs" #-}
)) of
{ !_tlOchildInhs ->
(case (tl_1 _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt _tlOoptions) of
{ ( !_tlIallAttributes,!_tlIerrors,!_tlIoutput) ->
(case (({-# LINE 36 "./src-ag/Desugar.ag" #-}
_lhsIoptions
{-# LINE 2913 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOoptions ->
(case (({-# LINE 215 "./src-ag/Desugar.ag" #-}
_lhsIforcedIrrefutables
{-# LINE 2918 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOforcedIrrefutables ->
(case (({-# LINE 185 "./src-ag/Desugar.ag" #-}
_lhsIdefs
{-# LINE 2923 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOdefs ->
(case (({-# LINE 126 "./src-ag/Desugar.ag" #-}
_lhsIchildSyns
{-# LINE 2928 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOchildSyns ->
(case (({-# LINE 126 "./src-ag/Desugar.ag" #-}
_lhsIchildInhs
{-# LINE 2933 "dist/build/Desugar.hs" #-}
)) of
{ !_hdOchildInhs ->
(case (hd_1 _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt _hdOoptions) of
{ ( !_hdIallAttributes,!_hdIerrors,!_hdIoutput) ->
(case (({-# LINE 196 "./src-ag/Desugar.ag" #-}
_hdIallAttributes `mergeAttributes` _tlIallAttributes
{-# LINE 2940 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOallAttributes ->
(case (({-# LINE 38 "./src-ag/Desugar.ag" #-}
_hdIerrors Seq.>< _tlIerrors
{-# LINE 2945 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOerrors ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
(:) _hdIoutput _tlIoutput
{-# LINE 2950 "dist/build/Desugar.hs" #-}
)) of
{ !_output ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
_output
{-# LINE 2955 "dist/build/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 179 "./src-ag/Desugar.ag" #-}
Set.empty
{-# LINE 2966 "dist/build/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 196 "./src-ag/Desugar.ag" #-}
Map.empty
{-# LINE 2980 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOallAttributes ->
(case (({-# LINE 38 "./src-ag/Desugar.ag" #-}
Seq.empty
{-# LINE 2985 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOerrors ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
[]
{-# LINE 2990 "dist/build/Desugar.hs" #-}
)) of
{ !_output ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
_output
{-# LINE 2995 "dist/build/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 : TypeSig
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 40 "./src-ag/Desugar.ag" #-}
TypeSig name_ tp_
{-# LINE 3035 "dist/build/Desugar.hs" #-}
)) of
{ !_output ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
_output
{-# LINE 3040 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOoutput ->
( _lhsOoutput) }) }))
-- TypeSigs ----------------------------------------------------
{-
visit 0:
synthesized attribute:
output : TypeSigs
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 40 "./src-ag/Desugar.ag" #-}
(:) _hdIoutput _tlIoutput
{-# LINE 3084 "dist/build/Desugar.hs" #-}
)) of
{ !_output ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
_output
{-# LINE 3089 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOoutput ->
( _lhsOoutput) }) }) }) }))
sem_TypeSigs_Nil :: T_TypeSigs
sem_TypeSigs_Nil =
(T_TypeSigs (case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
[]
{-# LINE 3097 "dist/build/Desugar.hs" #-}
)) of
{ !_output ->
(case (({-# LINE 40 "./src-ag/Desugar.ag" #-}
_output
{-# LINE 3102 "dist/build/Desugar.hs" #-}
)) of
{ !_lhsOoutput ->
( _lhsOoutput) }) }))