-- 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 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 (Constructor,Name) import UU.Scanner.Position(Pos) 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 :: Name -> Name -> [(Name,Name)] -> Maybe Name findField fld attr list | fld == _FIRST = f list | fld == _LAST = f (reverse list) | otherwise = Just fld where f = lookup attr -- Alternative ------------------------------------------------- {- visit 0: inherited attribute: nt : Nonterminal synthesized attributes: errors : Seq Error output : SELF alternatives: alternative Alternative: child con : {Constructor} child children : Children child rules : Rules child typeSigs : TypeSigs visit 0: local output : _ -} -- cata sem_Alternative :: Alternative -> T_Alternative sem_Alternative (Alternative _con _children _rules _typeSigs ) = (sem_Alternative_Alternative _con (sem_Children _children ) (sem_Rules _rules ) (sem_TypeSigs _typeSigs ) ) -- semantic domain newtype T_Alternative = T_Alternative (Nonterminal -> ( (Seq Error),Alternative)) data Inh_Alternative = Inh_Alternative {nt_Inh_Alternative :: Nonterminal} data Syn_Alternative = Syn_Alternative {errors_Syn_Alternative :: Seq Error,output_Syn_Alternative :: Alternative} wrap_Alternative (T_Alternative sem ) (Inh_Alternative _lhsInt ) = (let ( _lhsOerrors,_lhsOoutput) = (sem _lhsInt ) in (Syn_Alternative _lhsOerrors _lhsOoutput )) sem_Alternative_Alternative :: Constructor -> T_Children -> T_Rules -> T_TypeSigs -> T_Alternative sem_Alternative_Alternative con_ (T_Children children_ ) (T_Rules rules_ ) (T_TypeSigs typeSigs_ ) = (T_Alternative (\ _lhsInt -> (let _rulesOcon :: Constructor _rulesOdefs :: (Set (Name, Name)) _lhsOerrors :: (Seq Error) _lhsOoutput :: Alternative _rulesOchildInhs :: ([(Name, Name)]) _rulesOchildSyns :: ([(Name, Name)]) _rulesOnt :: Nonterminal _childrenIchildInhs :: ([(Name, Name)]) _childrenIchildSyns :: ([(Name, Name)]) _childrenIoutput :: Children _rulesIdefsCollect :: (Set (Name, Name)) _rulesIerrors :: (Seq Error) _rulesIoutput :: Rules _typeSigsIoutput :: TypeSigs -- "Desugar.ag"(line 149, column 7) _rulesOcon = con_ -- "Desugar.ag"(line 165, column 7) _rulesOdefs = _rulesIdefsCollect -- use rule "Desugar.ag"(line 30, column 144) _lhsOerrors = _rulesIerrors -- self rule _output = Alternative con_ _childrenIoutput _rulesIoutput _typeSigsIoutput -- self rule _lhsOoutput = _output -- copy rule (chain) _rulesOchildInhs = _childrenIchildInhs -- copy rule (chain) _rulesOchildSyns = _childrenIchildSyns -- copy rule (down) _rulesOnt = _lhsInt ( _childrenIchildInhs,_childrenIchildSyns,_childrenIoutput) = (children_ ) ( _rulesIdefsCollect,_rulesIerrors,_rulesIoutput) = (rules_ _rulesOchildInhs _rulesOchildSyns _rulesOcon _rulesOdefs _rulesOnt ) ( _typeSigsIoutput) = (typeSigs_ ) in ( _lhsOerrors,_lhsOoutput))) ) -- Alternatives ------------------------------------------------ {- visit 0: inherited attribute: nt : Nonterminal synthesized attributes: errors : Seq Error output : SELF alternatives: alternative Cons: child hd : Alternative child tl : Alternatives visit 0: local output : _ alternative Nil: visit 0: local output : _ -} -- cata sem_Alternatives :: Alternatives -> T_Alternatives sem_Alternatives list = (Prelude.foldr sem_Alternatives_Cons sem_Alternatives_Nil (Prelude.map sem_Alternative list) ) -- semantic domain newtype T_Alternatives = T_Alternatives (Nonterminal -> ( (Seq Error),Alternatives)) data Inh_Alternatives = Inh_Alternatives {nt_Inh_Alternatives :: Nonterminal} data Syn_Alternatives = Syn_Alternatives {errors_Syn_Alternatives :: Seq Error,output_Syn_Alternatives :: Alternatives} wrap_Alternatives (T_Alternatives sem ) (Inh_Alternatives _lhsInt ) = (let ( _lhsOerrors,_lhsOoutput) = (sem _lhsInt ) in (Syn_Alternatives _lhsOerrors _lhsOoutput )) sem_Alternatives_Cons :: T_Alternative -> T_Alternatives -> T_Alternatives sem_Alternatives_Cons (T_Alternative hd_ ) (T_Alternatives tl_ ) = (T_Alternatives (\ _lhsInt -> (let _lhsOerrors :: (Seq Error) _lhsOoutput :: Alternatives _hdOnt :: Nonterminal _tlOnt :: Nonterminal _hdIerrors :: (Seq Error) _hdIoutput :: Alternative _tlIerrors :: (Seq Error) _tlIoutput :: Alternatives -- use rule "Desugar.ag"(line 30, column 144) _lhsOerrors = _hdIerrors Seq.<> _tlIerrors -- self rule _output = (:) _hdIoutput _tlIoutput -- self rule _lhsOoutput = _output -- copy rule (down) _hdOnt = _lhsInt -- copy rule (down) _tlOnt = _lhsInt ( _hdIerrors,_hdIoutput) = (hd_ _hdOnt ) ( _tlIerrors,_tlIoutput) = (tl_ _tlOnt ) in ( _lhsOerrors,_lhsOoutput))) ) sem_Alternatives_Nil :: T_Alternatives sem_Alternatives_Nil = (T_Alternatives (\ _lhsInt -> (let _lhsOerrors :: (Seq Error) _lhsOoutput :: Alternatives -- use rule "Desugar.ag"(line 30, column 144) _lhsOerrors = Seq.empty -- self rule _output = [] -- self rule _lhsOoutput = _output in ( _lhsOerrors,_lhsOoutput))) ) -- Child ------------------------------------------------------- {- visit 0: synthesized attributes: childInhs : [(Name, Name)] childSyns : [(Name, Name)] output : SELF alternatives: alternative Child: child name : {Name} 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 (( ([(Name, Name)]),([(Name, Name)]),Child)) data Inh_Child = Inh_Child {} data Syn_Child = Syn_Child {childInhs_Syn_Child :: [(Name, Name)],childSyns_Syn_Child :: [(Name, Name)],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 :: Name -> Type -> Attributes -> Attributes -> Bool -> T_Child sem_Child_Child name_ tp_ inh_ syn_ higherOrder_ = (T_Child (let _lhsOchildInhs :: ([(Name, Name)]) _lhsOchildSyns :: ([(Name, Name)]) _lhsOoutput :: Child -- "Desugar.ag"(line 118, column 7) _lhsOchildInhs = [(i, name_) | i <- Map.keys inh_ ] -- "Desugar.ag"(line 119, 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 : [(Name, Name)] childSyns : [(Name, Name)] 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 (( ([(Name, Name)]),([(Name, Name)]),Children)) data Inh_Children = Inh_Children {} data Syn_Children = Syn_Children {childInhs_Syn_Children :: [(Name, Name)],childSyns_Syn_Children :: [(Name, Name)],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 :: ([(Name, Name)]) _lhsOchildSyns :: ([(Name, Name)]) _lhsOoutput :: Children _hdIchildInhs :: ([(Name, Name)]) _hdIchildSyns :: ([(Name, Name)]) _hdIoutput :: Child _tlIchildInhs :: ([(Name, Name)]) _tlIchildSyns :: ([(Name, Name)]) _tlIoutput :: Children -- use rule "Desugar.ag"(line 113, column 48) _lhsOchildInhs = _hdIchildInhs ++ _tlIchildInhs -- use rule "Desugar.ag"(line 113, 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 :: ([(Name, Name)]) _lhsOchildSyns :: ([(Name, Name)]) _lhsOoutput :: Children -- use rule "Desugar.ag"(line 113, column 48) _lhsOchildInhs = [] -- use rule "Desugar.ag"(line 113, column 48) _lhsOchildSyns = [] -- self rule _output = [] -- self rule _lhsOoutput = _output in ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput)) ) -- Expression -------------------------------------------------- {- visit 0: inherited attributes: childInhs : [(Name, Name)] childSyns : [(Name, Name)] con : Constructor nt : Nonterminal synthesized attributes: errors : Seq Error output : SELF alternatives: alternative Expression: child pos : {Pos} child txt : {String} visit 0: local tokens : _ local _tup1 : _ local txt' : _ local output : _ -} -- cata sem_Expression :: Expression -> T_Expression sem_Expression (Expression _pos _txt ) = (sem_Expression_Expression _pos _txt ) -- semantic domain newtype T_Expression = T_Expression (([(Name, Name)]) -> ([(Name, Name)]) -> Constructor -> Nonterminal -> ( (Seq Error),Expression)) data Inh_Expression = Inh_Expression {childInhs_Inh_Expression :: [(Name, Name)],childSyns_Inh_Expression :: [(Name, Name)],con_Inh_Expression :: Constructor,nt_Inh_Expression :: Nonterminal} 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 ) = (let ( _lhsOerrors,_lhsOoutput) = (sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt ) in (Syn_Expression _lhsOerrors _lhsOoutput )) sem_Expression_Expression :: Pos -> String -> T_Expression sem_Expression_Expression pos_ txt_ = (T_Expression (\ _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt -> (let _lhsOerrors :: (Seq Error) _lhsOoutput :: Expression -- "Desugar.ag"(line 41, column 7) _tokens = lexTokens pos_ txt_ -- "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 } sem = sem_HsTokensRoot (HsTokensRoot _tokens ) syn = wrap_HsTokensRoot sem inh in (txt_Syn_HsTokensRoot syn, errors_Syn_HsTokensRoot syn) -- "Desugar.ag"(line 42, column 7) (_txt',_) = __tup1 -- "Desugar.ag"(line 42, column 7) (_,_lhsOerrors) = __tup1 -- "Desugar.ag"(line 50, column 7) _lhsOoutput = Expression pos_ _txt' -- self rule _output = Expression pos_ txt_ in ( _lhsOerrors,_lhsOoutput))) ) -- Grammar ----------------------------------------------------- {- visit 0: inherited attribute: options : Options synthesized attributes: errors : Seq Error output : SELF alternatives: alternative Grammar: child typeSyns : {TypeSyns} child useMap : {UseMap} child derivings : {Derivings} child wrappers : {Set Nonterminal} child prods : Productions child pragmas : {PragmaMap} child manualAttrOrderMap : {AttrOrderMap} visit 0: local output : _ -} -- cata sem_Grammar :: Grammar -> T_Grammar sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _prods _pragmas _manualAttrOrderMap ) = (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Productions _prods ) _pragmas _manualAttrOrderMap ) -- semantic domain newtype T_Grammar = T_Grammar (Options -> ( (Seq Error),Grammar)) data Inh_Grammar = Inh_Grammar {options_Inh_Grammar :: Options} data Syn_Grammar = Syn_Grammar {errors_Syn_Grammar :: Seq Error,output_Syn_Grammar :: Grammar} wrap_Grammar (T_Grammar sem ) (Inh_Grammar _lhsIoptions ) = (let ( _lhsOerrors,_lhsOoutput) = (sem _lhsIoptions ) in (Syn_Grammar _lhsOerrors _lhsOoutput )) sem_Grammar_Grammar :: TypeSyns -> UseMap -> Derivings -> (Set Nonterminal) -> T_Productions -> PragmaMap -> AttrOrderMap -> T_Grammar sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Productions prods_ ) pragmas_ manualAttrOrderMap_ = (T_Grammar (\ _lhsIoptions -> (let _lhsOerrors :: (Seq Error) _lhsOoutput :: Grammar _prodsIerrors :: (Seq Error) _prodsIoutput :: Productions -- use rule "Desugar.ag"(line 30, column 144) _lhsOerrors = _prodsIerrors -- self rule _output = Grammar typeSyns_ useMap_ derivings_ wrappers_ _prodsIoutput pragmas_ manualAttrOrderMap_ -- self rule _lhsOoutput = _output ( _prodsIerrors,_prodsIoutput) = (prods_ ) in ( _lhsOerrors,_lhsOoutput))) ) -- HsToken ----------------------------------------------------- {- visit 0: inherited attributes: childInhs : [(Name, Name)] childSyns : [(Name, Name)] con : Constructor nt : Nonterminal chained attribute: addLines : Int synthesized attributes: errors : Seq Error tks : [(Pos,String)] alternatives: alternative AGField: child field : {Name} child attr : {Name} child pos : {Pos} visit 0: local mField : _ local field' : _ alternative AGLocal: child var : {Name} child pos : {Pos} alternative CharToken: child value : {String} child pos : {Pos} alternative Err: child mesg : {String} child pos : {Pos} alternative HsToken: child value : {String} child pos : {Pos} alternative StrToken: child value : {String} child pos : {Pos} -} -- cata sem_HsToken :: HsToken -> T_HsToken sem_HsToken (AGField _field _attr _pos ) = (sem_HsToken_AGField _field _attr _pos ) sem_HsToken (AGLocal _var _pos ) = (sem_HsToken_AGLocal _var _pos ) 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 -> ([(Name, Name)]) -> ([(Name, Name)]) -> Constructor -> Nonterminal -> ( Int,(Seq Error),([(Pos,String)]))) data Inh_HsToken = Inh_HsToken {addLines_Inh_HsToken :: Int,childInhs_Inh_HsToken :: [(Name, Name)],childSyns_Inh_HsToken :: [(Name, Name)],con_Inh_HsToken :: Constructor,nt_Inh_HsToken :: Nonterminal} data Syn_HsToken = Syn_HsToken {addLines_Syn_HsToken :: Int,errors_Syn_HsToken :: Seq Error,tks_Syn_HsToken :: [(Pos,String)]} wrap_HsToken (T_HsToken sem ) (Inh_HsToken _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt ) = (let ( _lhsOaddLines,_lhsOerrors,_lhsOtks) = (sem _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt ) in (Syn_HsToken _lhsOaddLines _lhsOerrors _lhsOtks )) sem_HsToken_AGField :: Name -> Name -> Pos -> T_HsToken sem_HsToken_AGField field_ attr_ pos_ = (T_HsToken (\ _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt -> (let _lhsOerrors :: (Seq Error) _lhsOaddLines :: Int _lhsOtks :: ([(Pos,String)]) -- "Desugar.ag"(line 67, column 7) _mField = findField field_ attr_ _lhsIchildSyns -- "Desugar.ag"(line 69, column 7) _field' = maybe field_ id _mField -- "Desugar.ag"(line 70, column 7) _lhsOerrors = maybe (Seq.single (UndefAttr _lhsInt _lhsIcon field_ (Ident "" (getPos field_)))) (const Seq.empty) _mField -- "Desugar.ag"(line 72, column 7) _lhsOaddLines = if length (getName field_) < length (getName _field' ) then _lhsIaddLines + 1 else _lhsIaddLines -- "Desugar.ag"(line 76, column 7) _lhsOtks = [(addl _lhsIaddLines pos_, "@" ++ show _field' ++ "." ++ show attr_)] in ( _lhsOaddLines,_lhsOerrors,_lhsOtks))) ) sem_HsToken_AGLocal :: Name -> Pos -> T_HsToken sem_HsToken_AGLocal var_ pos_ = (T_HsToken (\ _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt -> (let _lhsOtks :: ([(Pos,String)]) _lhsOerrors :: (Seq Error) _lhsOaddLines :: Int -- "Desugar.ag"(line 65, column 7) _lhsOtks = [(addl _lhsIaddLines pos_, "@" ++ show var_)] -- use rule "Desugar.ag"(line 30, column 144) _lhsOerrors = Seq.empty -- copy rule (chain) _lhsOaddLines = _lhsIaddLines in ( _lhsOaddLines,_lhsOerrors,_lhsOtks))) ) sem_HsToken_CharToken :: String -> Pos -> T_HsToken sem_HsToken_CharToken value_ pos_ = (T_HsToken (\ _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt -> (let _lhsOtks :: ([(Pos,String)]) _lhsOerrors :: (Seq Error) _lhsOaddLines :: Int -- "Desugar.ag"(line 80, column 7) _lhsOtks = [(addl _lhsIaddLines pos_, if null value_ then "" else showCharShort (head value_))] -- use rule "Desugar.ag"(line 30, column 144) _lhsOerrors = Seq.empty -- 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 -> (let _lhsOtks :: ([(Pos,String)]) _lhsOerrors :: (Seq Error) _lhsOaddLines :: Int -- "Desugar.ag"(line 84, column 7) _lhsOtks = [(addl _lhsIaddLines pos_, "***" ++ mesg_ ++ "***")] -- use rule "Desugar.ag"(line 30, column 144) _lhsOerrors = Seq.empty -- 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 -> (let _lhsOtks :: ([(Pos,String)]) _lhsOerrors :: (Seq Error) _lhsOaddLines :: Int -- "Desugar.ag"(line 78, column 7) _lhsOtks = [(addl _lhsIaddLines pos_, value_)] -- use rule "Desugar.ag"(line 30, column 144) _lhsOerrors = Seq.empty -- 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 -> (let _lhsOtks :: ([(Pos,String)]) _lhsOerrors :: (Seq Error) _lhsOaddLines :: Int -- "Desugar.ag"(line 82, column 7) _lhsOtks = [(addl _lhsIaddLines pos_, showStrShort value_)] -- use rule "Desugar.ag"(line 30, column 144) _lhsOerrors = Seq.empty -- copy rule (chain) _lhsOaddLines = _lhsIaddLines in ( _lhsOaddLines,_lhsOerrors,_lhsOtks))) ) -- HsTokens ---------------------------------------------------- {- visit 0: inherited attributes: childInhs : [(Name, Name)] childSyns : [(Name, Name)] con : Constructor nt : Nonterminal chained attribute: addLines : Int synthesized attributes: errors : Seq Error tks : [(Pos,String)] alternatives: alternative Cons: child hd : HsToken child tl : HsTokens alternative Nil: -} -- 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 -> ([(Name, Name)]) -> ([(Name, Name)]) -> Constructor -> Nonterminal -> ( Int,(Seq Error),([(Pos,String)]))) data Inh_HsTokens = Inh_HsTokens {addLines_Inh_HsTokens :: Int,childInhs_Inh_HsTokens :: [(Name, Name)],childSyns_Inh_HsTokens :: [(Name, Name)],con_Inh_HsTokens :: Constructor,nt_Inh_HsTokens :: Nonterminal} data Syn_HsTokens = Syn_HsTokens {addLines_Syn_HsTokens :: Int,errors_Syn_HsTokens :: Seq Error,tks_Syn_HsTokens :: [(Pos,String)]} wrap_HsTokens (T_HsTokens sem ) (Inh_HsTokens _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt ) = (let ( _lhsOaddLines,_lhsOerrors,_lhsOtks) = (sem _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt ) 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 -> (let _lhsOerrors :: (Seq Error) _lhsOtks :: ([(Pos,String)]) _lhsOaddLines :: Int _hdOaddLines :: Int _hdOchildInhs :: ([(Name, Name)]) _hdOchildSyns :: ([(Name, Name)]) _hdOcon :: Constructor _hdOnt :: Nonterminal _tlOaddLines :: Int _tlOchildInhs :: ([(Name, Name)]) _tlOchildSyns :: ([(Name, Name)]) _tlOcon :: Constructor _tlOnt :: Nonterminal _hdIaddLines :: Int _hdIerrors :: (Seq Error) _hdItks :: ([(Pos,String)]) _tlIaddLines :: Int _tlIerrors :: (Seq Error) _tlItks :: ([(Pos,String)]) -- use rule "Desugar.ag"(line 30, column 144) _lhsOerrors = _hdIerrors Seq.<> _tlIerrors -- use rule "Desugar.ag"(line 62, column 46) _lhsOtks = _hdItks ++ _tlItks -- 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 (chain) _tlOaddLines = _hdIaddLines -- copy rule (down) _tlOchildInhs = _lhsIchildInhs -- copy rule (down) _tlOchildSyns = _lhsIchildSyns -- copy rule (down) _tlOcon = _lhsIcon -- copy rule (down) _tlOnt = _lhsInt ( _hdIaddLines,_hdIerrors,_hdItks) = (hd_ _hdOaddLines _hdOchildInhs _hdOchildSyns _hdOcon _hdOnt ) ( _tlIaddLines,_tlIerrors,_tlItks) = (tl_ _tlOaddLines _tlOchildInhs _tlOchildSyns _tlOcon _tlOnt ) in ( _lhsOaddLines,_lhsOerrors,_lhsOtks))) ) sem_HsTokens_Nil :: T_HsTokens sem_HsTokens_Nil = (T_HsTokens (\ _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt -> (let _lhsOerrors :: (Seq Error) _lhsOtks :: ([(Pos,String)]) _lhsOaddLines :: Int -- use rule "Desugar.ag"(line 30, column 144) _lhsOerrors = Seq.empty -- use rule "Desugar.ag"(line 62, column 46) _lhsOtks = [] -- copy rule (chain) _lhsOaddLines = _lhsIaddLines in ( _lhsOaddLines,_lhsOerrors,_lhsOtks))) ) -- HsTokensRoot ------------------------------------------------ {- visit 0: inherited attributes: childInhs : [(Name, Name)] childSyns : [(Name, Name)] con : Constructor nt : Nonterminal synthesized attributes: errors : Seq Error tks : [(Pos,String)] txt : String 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 (([(Name, Name)]) -> ([(Name, Name)]) -> Constructor -> Nonterminal -> ( (Seq Error),([(Pos,String)]),String)) data Inh_HsTokensRoot = Inh_HsTokensRoot {childInhs_Inh_HsTokensRoot :: [(Name, Name)],childSyns_Inh_HsTokensRoot :: [(Name, Name)],con_Inh_HsTokensRoot :: Constructor,nt_Inh_HsTokensRoot :: Nonterminal} data Syn_HsTokensRoot = Syn_HsTokensRoot {errors_Syn_HsTokensRoot :: Seq Error,tks_Syn_HsTokensRoot :: [(Pos,String)],txt_Syn_HsTokensRoot :: String} wrap_HsTokensRoot (T_HsTokensRoot sem ) (Inh_HsTokensRoot _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt ) = (let ( _lhsOerrors,_lhsOtks,_lhsOtxt) = (sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt ) in (Syn_HsTokensRoot _lhsOerrors _lhsOtks _lhsOtxt )) sem_HsTokensRoot_HsTokensRoot :: T_HsTokens -> T_HsTokensRoot sem_HsTokensRoot_HsTokensRoot (T_HsTokens tokens_ ) = (T_HsTokensRoot (\ _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt -> (let _lhsOtxt :: String _tokensOaddLines :: Int _lhsOerrors :: (Seq Error) _lhsOtks :: ([(Pos,String)]) _tokensOchildInhs :: ([(Name, Name)]) _tokensOchildSyns :: ([(Name, Name)]) _tokensOcon :: Constructor _tokensOnt :: Nonterminal _tokensIaddLines :: Int _tokensIerrors :: (Seq Error) _tokensItks :: ([(Pos,String)]) -- "Desugar.ag"(line 55, column 7) _lhsOtxt = unlines $ showTokens _tokensItks -- "Desugar.ag"(line 60, column 7) _tokensOaddLines = 0 -- use rule "Desugar.ag"(line 30, column 144) _lhsOerrors = _tokensIerrors -- use rule "Desugar.ag"(line 62, column 46) _lhsOtks = _tokensItks -- copy rule (down) _tokensOchildInhs = _lhsIchildInhs -- copy rule (down) _tokensOchildSyns = _lhsIchildSyns -- copy rule (down) _tokensOcon = _lhsIcon -- copy rule (down) _tokensOnt = _lhsInt ( _tokensIaddLines,_tokensIerrors,_tokensItks) = (tokens_ _tokensOaddLines _tokensOchildInhs _tokensOchildSyns _tokensOcon _tokensOnt ) in ( _lhsOerrors,_lhsOtks,_lhsOtxt))) ) -- Pattern ----------------------------------------------------- {- visit 0: inherited attributes: childInhs : [(Name, Name)] childSyns : [(Name, Name)] con : Constructor defs : Set (Name, Name) nt : Nonterminal synthesized attributes: copy : SELF defsCollect : Set (Name, Name) errors : Seq Error output : SELF alternatives: alternative Alias: child field : {Name} child attr : {Name} child pat : Pattern child parts : Patterns visit 0: local _tup2 : _ local field' : _ local err1 : _ local err2 : _ local def : _ local copy : _ local output : _ alternative Constr: child name : {Constructor} child pats : Patterns 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 (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 (([(Name, Name)]) -> ([(Name, Name)]) -> Constructor -> (Set (Name, Name)) -> Nonterminal -> ( Pattern,(Set (Name, Name)),(Seq Error),Pattern)) data Inh_Pattern = Inh_Pattern {childInhs_Inh_Pattern :: [(Name, Name)],childSyns_Inh_Pattern :: [(Name, Name)],con_Inh_Pattern :: Constructor,defs_Inh_Pattern :: Set (Name, Name),nt_Inh_Pattern :: Nonterminal} data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern,defsCollect_Syn_Pattern :: Set (Name, Name),errors_Syn_Pattern :: Seq Error,output_Syn_Pattern :: Pattern} wrap_Pattern (T_Pattern sem ) (Inh_Pattern _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsInt ) = (let ( _lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput) = (sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsInt ) in (Syn_Pattern _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput )) sem_Pattern_Alias :: Name -> Name -> T_Pattern -> T_Patterns -> T_Pattern sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) = (T_Pattern (\ _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsInt -> (let _lhsOerrors :: (Seq Error) _lhsOoutput :: Pattern _lhsOdefsCollect :: (Set (Name, Name)) _lhsOcopy :: Pattern _patOchildInhs :: ([(Name, Name)]) _patOchildSyns :: ([(Name, Name)]) _patOcon :: Constructor _patOdefs :: (Set (Name, Name)) _patOnt :: Nonterminal _partsOchildInhs :: ([(Name, Name)]) _partsOchildSyns :: ([(Name, Name)]) _partsOcon :: Constructor _partsOdefs :: (Set (Name, Name)) _partsOnt :: Nonterminal _patIcopy :: Pattern _patIdefsCollect :: (Set (Name, Name)) _patIerrors :: (Seq Error) _patIoutput :: Pattern _partsIcopy :: Patterns _partsIdefsCollect :: (Set (Name, Name)) _partsIerrors :: (Seq Error) _partsIoutput :: Patterns -- "Desugar.ag"(line 98, column 7) __tup2 = maybeError field_ (UndefAttr _lhsInt _lhsIcon (Ident "" (getPos field_)) attr_) $ findField field_ attr_ _lhsIchildInhs -- "Desugar.ag"(line 98, column 7) (_field',_) = __tup2 -- "Desugar.ag"(line 98, column 7) (_,_err1) = __tup2 -- "Desugar.ag"(line 100, 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 105, column 7) _lhsOerrors = _err1 Seq.<> _err2 Seq.<> _patIerrors <> _partsIerrors -- "Desugar.ag"(line 106, column 7) _lhsOoutput = Alias _field' attr_ _patIoutput _partsIoutput -- "Desugar.ag"(line 159, column 7) _def = Set.singleton (field_, attr_) -- "Desugar.ag"(line 160, column 7) _lhsOdefsCollect = _def `Set.union` _patIdefsCollect `Set.union` _partsIdefsCollect -- self rule _copy = Alias field_ attr_ _patIcopy _partsIcopy -- self rule _output = Alias field_ attr_ _patIoutput _partsIoutput -- 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) _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) _partsOnt = _lhsInt ( _patIcopy,_patIdefsCollect,_patIerrors,_patIoutput) = (pat_ _patOchildInhs _patOchildSyns _patOcon _patOdefs _patOnt ) ( _partsIcopy,_partsIdefsCollect,_partsIerrors,_partsIoutput) = (parts_ _partsOchildInhs _partsOchildSyns _partsOcon _partsOdefs _partsOnt ) in ( _lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))) ) sem_Pattern_Constr :: Constructor -> T_Patterns -> T_Pattern sem_Pattern_Constr name_ (T_Patterns pats_ ) = (T_Pattern (\ _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsInt -> (let _lhsOdefsCollect :: (Set (Name, Name)) _lhsOerrors :: (Seq Error) _lhsOcopy :: Pattern _lhsOoutput :: Pattern _patsOchildInhs :: ([(Name, Name)]) _patsOchildSyns :: ([(Name, Name)]) _patsOcon :: Constructor _patsOdefs :: (Set (Name, Name)) _patsOnt :: Nonterminal _patsIcopy :: Patterns _patsIdefsCollect :: (Set (Name, Name)) _patsIerrors :: (Seq Error) _patsIoutput :: Patterns -- use rule "Desugar.ag"(line 156, column 52) _lhsOdefsCollect = _patsIdefsCollect -- use rule "Desugar.ag"(line 30, 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) _patsOnt = _lhsInt ( _patsIcopy,_patsIdefsCollect,_patsIerrors,_patsIoutput) = (pats_ _patsOchildInhs _patsOchildSyns _patsOcon _patsOdefs _patsOnt ) in ( _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 _lhsInt -> (let _lhsOdefsCollect :: (Set (Name, Name)) _lhsOerrors :: (Seq Error) _lhsOcopy :: Pattern _lhsOoutput :: Pattern _patsOchildInhs :: ([(Name, Name)]) _patsOchildSyns :: ([(Name, Name)]) _patsOcon :: Constructor _patsOdefs :: (Set (Name, Name)) _patsOnt :: Nonterminal _patsIcopy :: Patterns _patsIdefsCollect :: (Set (Name, Name)) _patsIerrors :: (Seq Error) _patsIoutput :: Patterns -- use rule "Desugar.ag"(line 156, column 52) _lhsOdefsCollect = _patsIdefsCollect -- use rule "Desugar.ag"(line 30, 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) _patsOnt = _lhsInt ( _patsIcopy,_patsIdefsCollect,_patsIerrors,_patsIoutput) = (pats_ _patsOchildInhs _patsOchildSyns _patsOcon _patsOdefs _patsOnt ) in ( _lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))) ) sem_Pattern_Underscore :: Pos -> T_Pattern sem_Pattern_Underscore pos_ = (T_Pattern (\ _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsInt -> (let _lhsOdefsCollect :: (Set (Name, Name)) _lhsOerrors :: (Seq Error) _lhsOcopy :: Pattern _lhsOoutput :: Pattern -- use rule "Desugar.ag"(line 156, column 52) _lhsOdefsCollect = Set.empty -- use rule "Desugar.ag"(line 30, column 144) _lhsOerrors = Seq.empty -- self rule _copy = Underscore pos_ -- self rule _output = Underscore pos_ -- self rule _lhsOcopy = _copy -- self rule _lhsOoutput = _output in ( _lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))) ) -- Patterns ---------------------------------------------------- {- visit 0: inherited attributes: childInhs : [(Name, Name)] childSyns : [(Name, Name)] con : Constructor defs : Set (Name, Name) nt : Nonterminal synthesized attributes: copy : SELF defsCollect : Set (Name, Name) 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 (([(Name, Name)]) -> ([(Name, Name)]) -> Constructor -> (Set (Name, Name)) -> Nonterminal -> ( Patterns,(Set (Name, Name)),(Seq Error),Patterns)) data Inh_Patterns = Inh_Patterns {childInhs_Inh_Patterns :: [(Name, Name)],childSyns_Inh_Patterns :: [(Name, Name)],con_Inh_Patterns :: Constructor,defs_Inh_Patterns :: Set (Name, Name),nt_Inh_Patterns :: Nonterminal} data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns,defsCollect_Syn_Patterns :: Set (Name, Name),errors_Syn_Patterns :: Seq Error,output_Syn_Patterns :: Patterns} wrap_Patterns (T_Patterns sem ) (Inh_Patterns _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsInt ) = (let ( _lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput) = (sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsInt ) in (Syn_Patterns _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 _lhsInt -> (let _lhsOdefsCollect :: (Set (Name, Name)) _lhsOerrors :: (Seq Error) _lhsOcopy :: Patterns _lhsOoutput :: Patterns _hdOchildInhs :: ([(Name, Name)]) _hdOchildSyns :: ([(Name, Name)]) _hdOcon :: Constructor _hdOdefs :: (Set (Name, Name)) _hdOnt :: Nonterminal _tlOchildInhs :: ([(Name, Name)]) _tlOchildSyns :: ([(Name, Name)]) _tlOcon :: Constructor _tlOdefs :: (Set (Name, Name)) _tlOnt :: Nonterminal _hdIcopy :: Pattern _hdIdefsCollect :: (Set (Name, Name)) _hdIerrors :: (Seq Error) _hdIoutput :: Pattern _tlIcopy :: Patterns _tlIdefsCollect :: (Set (Name, Name)) _tlIerrors :: (Seq Error) _tlIoutput :: Patterns -- use rule "Desugar.ag"(line 156, column 52) _lhsOdefsCollect = _hdIdefsCollect `Set.union` _tlIdefsCollect -- use rule "Desugar.ag"(line 30, 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) _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) _tlOnt = _lhsInt ( _hdIcopy,_hdIdefsCollect,_hdIerrors,_hdIoutput) = (hd_ _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOnt ) ( _tlIcopy,_tlIdefsCollect,_tlIerrors,_tlIoutput) = (tl_ _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOnt ) in ( _lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))) ) sem_Patterns_Nil :: T_Patterns sem_Patterns_Nil = (T_Patterns (\ _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsInt -> (let _lhsOdefsCollect :: (Set (Name, Name)) _lhsOerrors :: (Seq Error) _lhsOcopy :: Patterns _lhsOoutput :: Patterns -- use rule "Desugar.ag"(line 156, column 52) _lhsOdefsCollect = Set.empty -- use rule "Desugar.ag"(line 30, column 144) _lhsOerrors = Seq.empty -- self rule _copy = [] -- self rule _output = [] -- self rule _lhsOcopy = _copy -- self rule _lhsOoutput = _output in ( _lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput))) ) -- Production -------------------------------------------------- {- visit 0: synthesized attributes: errors : Seq Error output : SELF alternatives: alternative Production: child nt : {Nonterminal} child inh : {Attributes} child syn : {Attributes} child alts : Alternatives visit 0: local output : _ -} -- cata sem_Production :: Production -> T_Production sem_Production (Production _nt _inh _syn _alts ) = (sem_Production_Production _nt _inh _syn (sem_Alternatives _alts ) ) -- semantic domain newtype T_Production = T_Production (( (Seq Error),Production)) data Inh_Production = Inh_Production {} data Syn_Production = Syn_Production {errors_Syn_Production :: Seq Error,output_Syn_Production :: Production} wrap_Production (T_Production sem ) (Inh_Production ) = (let ( _lhsOerrors,_lhsOoutput) = (sem ) in (Syn_Production _lhsOerrors _lhsOoutput )) sem_Production_Production :: Nonterminal -> Attributes -> Attributes -> T_Alternatives -> T_Production sem_Production_Production nt_ inh_ syn_ (T_Alternatives alts_ ) = (T_Production (let _altsOnt :: Nonterminal _lhsOerrors :: (Seq Error) _lhsOoutput :: Production _altsIerrors :: (Seq Error) _altsIoutput :: Alternatives -- "Desugar.ag"(line 145, column 7) _altsOnt = nt_ -- use rule "Desugar.ag"(line 30, column 144) _lhsOerrors = _altsIerrors -- self rule _output = Production nt_ inh_ syn_ _altsIoutput -- self rule _lhsOoutput = _output ( _altsIerrors,_altsIoutput) = (alts_ _altsOnt ) in ( _lhsOerrors,_lhsOoutput)) ) -- Productions ------------------------------------------------- {- visit 0: synthesized attributes: 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 (( (Seq Error),Productions)) data Inh_Productions = Inh_Productions {} data Syn_Productions = Syn_Productions {errors_Syn_Productions :: Seq Error,output_Syn_Productions :: Productions} wrap_Productions (T_Productions sem ) (Inh_Productions ) = (let ( _lhsOerrors,_lhsOoutput) = (sem ) in (Syn_Productions _lhsOerrors _lhsOoutput )) sem_Productions_Cons :: T_Production -> T_Productions -> T_Productions sem_Productions_Cons (T_Production hd_ ) (T_Productions tl_ ) = (T_Productions (let _lhsOerrors :: (Seq Error) _lhsOoutput :: Productions _hdIerrors :: (Seq Error) _hdIoutput :: Production _tlIerrors :: (Seq Error) _tlIoutput :: Productions -- use rule "Desugar.ag"(line 30, column 144) _lhsOerrors = _hdIerrors Seq.<> _tlIerrors -- self rule _output = (:) _hdIoutput _tlIoutput -- self rule _lhsOoutput = _output ( _hdIerrors,_hdIoutput) = (hd_ ) ( _tlIerrors,_tlIoutput) = (tl_ ) in ( _lhsOerrors,_lhsOoutput)) ) sem_Productions_Nil :: T_Productions sem_Productions_Nil = (T_Productions (let _lhsOerrors :: (Seq Error) _lhsOoutput :: Productions -- use rule "Desugar.ag"(line 30, column 144) _lhsOerrors = Seq.empty -- self rule _output = [] -- self rule _lhsOoutput = _output in ( _lhsOerrors,_lhsOoutput)) ) -- Rule -------------------------------------------------------- {- visit 0: inherited attributes: childInhs : [(Name, Name)] childSyns : [(Name, Name)] con : Constructor defs : Set (Name, Name) nt : Nonterminal synthesized attributes: defsCollect : Set (Name, Name) errors : Seq Error output : SELF alternatives: alternative Rule: child pattern : Pattern child rhs : Expression child owrt : {Bool} child origin : {String} visit 0: 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 (([(Name, Name)]) -> ([(Name, Name)]) -> Constructor -> (Set (Name, Name)) -> Nonterminal -> ( (Set (Name, Name)),(Seq Error),Rule)) data Inh_Rule = Inh_Rule {childInhs_Inh_Rule :: [(Name, Name)],childSyns_Inh_Rule :: [(Name, Name)],con_Inh_Rule :: Constructor,defs_Inh_Rule :: Set (Name, Name),nt_Inh_Rule :: Nonterminal} data Syn_Rule = Syn_Rule {defsCollect_Syn_Rule :: Set (Name, Name),errors_Syn_Rule :: Seq Error,output_Syn_Rule :: Rule} wrap_Rule (T_Rule sem ) (Inh_Rule _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsInt ) = (let ( _lhsOdefsCollect,_lhsOerrors,_lhsOoutput) = (sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsInt ) in (Syn_Rule _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 _lhsInt -> (let _lhsOdefsCollect :: (Set (Name, Name)) _lhsOerrors :: (Seq Error) _lhsOoutput :: Rule _patternOchildInhs :: ([(Name, Name)]) _patternOchildSyns :: ([(Name, Name)]) _patternOcon :: Constructor _patternOdefs :: (Set (Name, Name)) _patternOnt :: Nonterminal _rhsOchildInhs :: ([(Name, Name)]) _rhsOchildSyns :: ([(Name, Name)]) _rhsOcon :: Constructor _rhsOnt :: Nonterminal _patternIcopy :: Pattern _patternIdefsCollect :: (Set (Name, Name)) _patternIerrors :: (Seq Error) _patternIoutput :: Pattern _rhsIerrors :: (Seq Error) _rhsIoutput :: Expression -- use rule "Desugar.ag"(line 156, column 52) _lhsOdefsCollect = _patternIdefsCollect -- use rule "Desugar.ag"(line 30, 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) _patternOnt = _lhsInt -- copy rule (down) _rhsOchildInhs = _lhsIchildInhs -- copy rule (down) _rhsOchildSyns = _lhsIchildSyns -- copy rule (down) _rhsOcon = _lhsIcon -- copy rule (down) _rhsOnt = _lhsInt ( _patternIcopy,_patternIdefsCollect,_patternIerrors,_patternIoutput) = (pattern_ _patternOchildInhs _patternOchildSyns _patternOcon _patternOdefs _patternOnt ) ( _rhsIerrors,_rhsIoutput) = (rhs_ _rhsOchildInhs _rhsOchildSyns _rhsOcon _rhsOnt ) in ( _lhsOdefsCollect,_lhsOerrors,_lhsOoutput))) ) -- Rules ------------------------------------------------------- {- visit 0: inherited attributes: childInhs : [(Name, Name)] childSyns : [(Name, Name)] con : Constructor defs : Set (Name, Name) nt : Nonterminal synthesized attributes: defsCollect : Set (Name, Name) 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 (([(Name, Name)]) -> ([(Name, Name)]) -> Constructor -> (Set (Name, Name)) -> Nonterminal -> ( (Set (Name, Name)),(Seq Error),Rules)) data Inh_Rules = Inh_Rules {childInhs_Inh_Rules :: [(Name, Name)],childSyns_Inh_Rules :: [(Name, Name)],con_Inh_Rules :: Constructor,defs_Inh_Rules :: Set (Name, Name),nt_Inh_Rules :: Nonterminal} data Syn_Rules = Syn_Rules {defsCollect_Syn_Rules :: Set (Name, Name),errors_Syn_Rules :: Seq Error,output_Syn_Rules :: Rules} wrap_Rules (T_Rules sem ) (Inh_Rules _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsInt ) = (let ( _lhsOdefsCollect,_lhsOerrors,_lhsOoutput) = (sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsInt ) in (Syn_Rules _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 _lhsInt -> (let _lhsOdefsCollect :: (Set (Name, Name)) _lhsOerrors :: (Seq Error) _lhsOoutput :: Rules _hdOchildInhs :: ([(Name, Name)]) _hdOchildSyns :: ([(Name, Name)]) _hdOcon :: Constructor _hdOdefs :: (Set (Name, Name)) _hdOnt :: Nonterminal _tlOchildInhs :: ([(Name, Name)]) _tlOchildSyns :: ([(Name, Name)]) _tlOcon :: Constructor _tlOdefs :: (Set (Name, Name)) _tlOnt :: Nonterminal _hdIdefsCollect :: (Set (Name, Name)) _hdIerrors :: (Seq Error) _hdIoutput :: Rule _tlIdefsCollect :: (Set (Name, Name)) _tlIerrors :: (Seq Error) _tlIoutput :: Rules -- use rule "Desugar.ag"(line 156, column 52) _lhsOdefsCollect = _hdIdefsCollect `Set.union` _tlIdefsCollect -- use rule "Desugar.ag"(line 30, 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) _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) _tlOnt = _lhsInt ( _hdIdefsCollect,_hdIerrors,_hdIoutput) = (hd_ _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOnt ) ( _tlIdefsCollect,_tlIerrors,_tlIoutput) = (tl_ _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOnt ) in ( _lhsOdefsCollect,_lhsOerrors,_lhsOoutput))) ) sem_Rules_Nil :: T_Rules sem_Rules_Nil = (T_Rules (\ _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsInt -> (let _lhsOdefsCollect :: (Set (Name, Name)) _lhsOerrors :: (Seq Error) _lhsOoutput :: Rules -- use rule "Desugar.ag"(line 156, column 52) _lhsOdefsCollect = Set.empty -- use rule "Desugar.ag"(line 30, column 144) _lhsOerrors = Seq.empty -- self rule _output = [] -- self rule _lhsOoutput = _output in ( _lhsOdefsCollect,_lhsOerrors,_lhsOoutput))) ) -- TypeSig ----------------------------------------------------- {- visit 0: synthesized attribute: output : SELF alternatives: alternative TypeSig: child name : {Name} 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 :: Name -> 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)) )