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