-- UUAGC 0.9.5 (DefaultRules.ag) module DefaultRules where import qualified List (delete,intersperse) 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(noPos) import Pretty import Maybe import HsToken import HsTokenScanner import AbstractSyntax import ErrorMessages import Options(Options,modcopy,rename) -- 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) fieldName n = '@' : getName n locName n = '@' : getName n attrName fld attr | fld == _LOC = '@' : getName attr | otherwise = '@' : getName fld ++ "." ++ getName attr _ACHILD = Ident "(" noPos -- hack getConName typeSyns rename nt con1 | nt `elem` map fst typeSyns = synonym | otherwise = normalName where con = getName con1 normalName | rename = getName nt++"_"++ con | otherwise = con synonym | con == "Cons" = "(:)" | con == "Nil" = "[]" | con == "Just" = "Just" | con == "Nothing" = "Nothing" | otherwise = normalName concatSeq = foldr Seq.append Seq.empty splitAttrs :: Map Identifier a -> [Identifier] -> ([(Identifier,a)],[Identifier]) -- a used as (String,String) splitAttrs _ [] = ([],[]) splitAttrs useMap (n:rest) = let (uses,normals) = splitAttrs useMap rest in case Map.lookup n useMap of Just x -> ((n,x):uses , normals ) Nothing -> ( uses , n:normals ) removeDefined :: Set (Identifier,Identifier) -> (Identifier,Attributes) -> (Identifier,[Identifier]) removeDefined defined (fld,as) = ( fld , [ a | a <- Map.keys as , not (Set.member (fld,a) defined) ] ) deprecatedCopyRuleError nt con fld a = let mesg = "In the definitions for alternative" >#< getName con >#< "of nonterminal" >#< getName nt >|< "," >-< "the value of field" >#< getName a >#< "is copied by a copy-rule." >-< "Copying the value of a field using a copy-rule is deprecated" >-< "Please add the following lines to your code:" >-< ( "SEM" >#< getName nt >-< indent 2 ( "|" >#< getName con >#< getName fld >#< "." >#< a >#< "=" >#< "@" >|< a ) ) in CustomError True (getPos a) mesg missingRuleErrorExpr nt con fld a = "error \"missing rule: " ++ show nt ++ "." ++ show con ++ "." ++ show fld ++ "." ++ show a ++ "\"" makeRule :: (Identifier,Identifier) -> Expression -> String -> Rule makeRule (f1,a1) expr origin = Rule (Alias f1 a1 (Underscore noPos) []) expr False origin useRule :: Set Identifier -> [(Identifier,Attributes)] -> (Identifier,(String,String,String)) -> Rule useRule locals ch_outs (n,(op,e,pos)) = let elems = [ fld | (fld,as) <- ch_outs , Map.member n as ] expr | Set.member n locals = attrName _LOC n | null elems = e | otherwise = foldr1 (\x y -> x ++ " " ++ op ++ " " ++ y) (map (flip attrName n) elems) tks | Set.member n locals = [AGLocal n noPos Nothing] | null elems = lexTokens noPos e | otherwise = lexTokens noPos str where str = foldr1 (\x y -> x ++ " " ++ op ++ " " ++ y) (map (flip attrName n) elems) in makeRule (_LHS,n) (Expression noPos tks) ("use rule " ++ pos) selfRule lhsNecLoc attr x = let expr | lhsNecLoc = locName attr | otherwise = x tks | lhsNecLoc = [AGLocal attr noPos Nothing] | otherwise = lexTokens noPos x in makeRule (if lhsNecLoc then _LHS else _LOC,attr) (Expression noPos tks) "self rule" concatRE rsess = let (rss,ess) = unzip rsess in (concat rss, concatSeq ess) copyRule :: Identifier -> Identifier -> Bool -> Set Identifier -> (Map Identifier Identifier, (Identifier,[Identifier])) -> ([Rule], Seq Error) copyRule nt con modcopy locals (env,(fld,as)) = concatRE (map copyRu as) where copyRu a = ( [ makeRule (fld,a) (Expression noPos tks) (cruletxt sel) ] , err ) where sel | not modcopy && Set.member a locals = Just _LOC | otherwise = Map.lookup a env (expr,err) = case sel of Nothing -> ( missingRuleErrorExpr nt con fld a , Seq.single (MissingRule nt con fld a) ) Just f | f == _ACHILD -> ( fieldName a , Seq.single (deprecatedCopyRuleError nt con fld a) ) | otherwise -> ( attrName f a , Seq.empty ) (tks,err') = case sel of Nothing -> ( [HsToken (missingRuleErrorExpr nt con fld a) noPos] , Seq.single (MissingRule nt con fld a) ) Just f | f == _ACHILD -> ( [AGLocal a noPos Nothing] , Seq.single (deprecatedCopyRuleError nt con fld a) ) | otherwise -> ( [AGField f a noPos Nothing] , Seq.empty ) cruletxt sel | local = "copy rule (from local)" | deprChild = "deprecated child copy" | Set.member a locals && nonlocal = "modified copy rule" | incoming && outgoing = "copy rule (chain)" | incoming = "copy rule (down)" | outgoing = "copy rule (up)" | otherwise = "copy rule (chain)" where outgoing = fld == _LHS incoming = maybe False (== _LHS) sel nonlocal = maybe False (/= _LOC) sel local = maybe False (== _LOC) sel deprChild = maybe False (== _ACHILD) sel {- multiRule replaces loc.(a,b) = e by loc.tup1 = e loc.(a,_) = @loc.tup1 loc.(_,b) = @loc.tup1 It needs to thread a unique number for inventing names for the tuples. It also works for nested tuples: loc.(a,(b,c)) = e becomes loc.tup1 = e loc.(a,_) = @loc.tup1 loc.(_,tup2) = @loc.tup1 loc.(b,_) = @loc.tup2 loc.(_,c) = @loc.tup2 -} multiRule :: Rule -> Int -> ([Rule], Int) multiRule (Rule pat expr owrt origin) uniq = let f :: (Pattern->Pattern) -> Expression -> Pattern -> Int -> (Pattern, ([Rule], Int)) f w e (Product pos pats) n = let freshName = Ident ("_tup" ++ show n) pos freshExpr = Expression pos freshTks freshTks = [AGField _LOC freshName pos Nothing] freshPat = Alias _LOC freshName (Underscore pos) pats a = length pats - 1 us b p = Product pos (replicate (a-b) (Underscore pos) ++ [p] ++ replicate b (Underscore pos)) g :: Pattern -> ([Pattern],[Rule],Int) -> ([Pattern],[Rule],Int) g p (xs1,rs1,n1) = let (x2,(rs2,n2)) = f (us (length xs1)) freshExpr p n1 in (x2:xs1, rs2++rs1, n2) (xs9,rs9,n9) = foldr g ([], [], n+1) pats in ( freshPat , ( Rule (w freshPat) e owrt origin : rs9 , n9 ) ) f w e p n = ( p , ( [Rule (w p) e owrt origin] , n ) ) in snd (f id expr pat uniq) -- Child ------------------------------------------------------- {- visit 0: inherited attributes: con : ConstructorIdent cr : Bool nt : NontermIdent synthesized attributes: errors : Seq Error field : (Identifier,Type,Bool) inherited : Attributes name : Identifier output : SELF synthesized : Attributes 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 (ConstructorIdent -> Bool -> NontermIdent -> ( (Seq Error),( (Identifier,Type,Bool) ),Attributes,Identifier,Child,Attributes)) data Inh_Child = Inh_Child {con_Inh_Child :: ConstructorIdent,cr_Inh_Child :: Bool,nt_Inh_Child :: NontermIdent} data Syn_Child = Syn_Child {errors_Syn_Child :: Seq Error,field_Syn_Child :: (Identifier,Type,Bool) ,inherited_Syn_Child :: Attributes,name_Syn_Child :: Identifier,output_Syn_Child :: Child,synthesized_Syn_Child :: Attributes} wrap_Child (T_Child sem) (Inh_Child _lhsIcon _lhsIcr _lhsInt) = (let ( _lhsOerrors,_lhsOfield,_lhsOinherited,_lhsOname,_lhsOoutput,_lhsOsynthesized) = (sem _lhsIcon _lhsIcr _lhsInt) in (Syn_Child _lhsOerrors _lhsOfield _lhsOinherited _lhsOname _lhsOoutput _lhsOsynthesized)) sem_Child_Child :: Identifier -> Type -> Attributes -> Attributes -> Bool -> T_Child sem_Child_Child name_ tp_ inh_ syn_ higherOrder_ = (T_Child (\ _lhsIcon _lhsIcr _lhsInt -> (let _lhsOname :: Identifier _lhsOinherited :: Attributes _lhsOsynthesized :: Attributes _lhsOfield :: ( (Identifier,Type,Bool) ) _lhsOerrors :: (Seq Error) _lhsOoutput :: Child -- "DefaultRules.ag"(line 140, column 11) _lhsOname = name_ -- "DefaultRules.ag"(line 149, column 11) _lhsOinherited = inh_ -- "DefaultRules.ag"(line 150, column 11) _lhsOsynthesized = syn_ -- "DefaultRules.ag"(line 411, column 11) _lhsOfield = (name_,tp_,higherOrder_) -- use rule "DefaultRules.ag"(line 109, column 19) _lhsOerrors = Seq.empty -- self rule _output = Child name_ tp_ inh_ syn_ higherOrder_ -- self rule _lhsOoutput = _output in ( _lhsOerrors,_lhsOfield,_lhsOinherited,_lhsOname,_lhsOoutput,_lhsOsynthesized)))) -- Children ---------------------------------------------------- {- visit 0: inherited attributes: con : ConstructorIdent cr : Bool nt : NontermIdent synthesized attributes: errors : Seq Error fields : [(Identifier,Type,Bool)] inputs : [(Identifier, Attributes)] output : SELF outputs : [(Identifier, Attributes)] 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 (ConstructorIdent -> Bool -> NontermIdent -> ( (Seq Error),([(Identifier,Type,Bool)]),([(Identifier, Attributes)]),Children,([(Identifier, Attributes)]))) data Inh_Children = Inh_Children {con_Inh_Children :: ConstructorIdent,cr_Inh_Children :: Bool,nt_Inh_Children :: NontermIdent} data Syn_Children = Syn_Children {errors_Syn_Children :: Seq Error,fields_Syn_Children :: [(Identifier,Type,Bool)],inputs_Syn_Children :: [(Identifier, Attributes)],output_Syn_Children :: Children,outputs_Syn_Children :: [(Identifier, Attributes)]} wrap_Children (T_Children sem) (Inh_Children _lhsIcon _lhsIcr _lhsInt) = (let ( _lhsOerrors,_lhsOfields,_lhsOinputs,_lhsOoutput,_lhsOoutputs) = (sem _lhsIcon _lhsIcr _lhsInt) in (Syn_Children _lhsOerrors _lhsOfields _lhsOinputs _lhsOoutput _lhsOoutputs)) sem_Children_Cons :: T_Child -> T_Children -> T_Children sem_Children_Cons (T_Child hd_) (T_Children tl_) = (T_Children (\ _lhsIcon _lhsIcr _lhsInt -> (let _lhsOinputs :: ([(Identifier, Attributes)]) _lhsOoutputs :: ([(Identifier, Attributes)]) _lhsOfields :: ([(Identifier,Type,Bool)]) _lhsOerrors :: (Seq Error) _lhsOoutput :: Children _hdOcon :: ConstructorIdent _hdOcr :: Bool _hdOnt :: NontermIdent _tlOcon :: ConstructorIdent _tlOcr :: Bool _tlOnt :: NontermIdent _hdIerrors :: (Seq Error) _hdIfield :: ( (Identifier,Type,Bool) ) _hdIinherited :: Attributes _hdIname :: Identifier _hdIoutput :: Child _hdIsynthesized :: Attributes _tlIerrors :: (Seq Error) _tlIfields :: ([(Identifier,Type,Bool)]) _tlIinputs :: ([(Identifier, Attributes)]) _tlIoutput :: Children _tlIoutputs :: ([(Identifier, Attributes)]) -- "DefaultRules.ag"(line 153, column 10) _lhsOinputs = (_hdIname, _hdIinherited) : _tlIinputs -- "DefaultRules.ag"(line 153, column 10) _lhsOoutputs = (_hdIname, _hdIsynthesized) : _tlIoutputs -- "DefaultRules.ag"(line 407, column 10) _lhsOfields = _hdIfield : _tlIfields -- use rule "DefaultRules.ag"(line 109, column 19) _lhsOerrors = _hdIerrors Seq.<> _tlIerrors -- self rule _output = (:) _hdIoutput _tlIoutput -- self rule _lhsOoutput = _output -- copy rule (down) _hdOcon = _lhsIcon -- copy rule (down) _hdOcr = _lhsIcr -- copy rule (down) _hdOnt = _lhsInt -- copy rule (down) _tlOcon = _lhsIcon -- copy rule (down) _tlOcr = _lhsIcr -- copy rule (down) _tlOnt = _lhsInt ( _hdIerrors,_hdIfield,_hdIinherited,_hdIname,_hdIoutput,_hdIsynthesized) = (hd_ _hdOcon _hdOcr _hdOnt) ( _tlIerrors,_tlIfields,_tlIinputs,_tlIoutput,_tlIoutputs) = (tl_ _tlOcon _tlOcr _tlOnt) in ( _lhsOerrors,_lhsOfields,_lhsOinputs,_lhsOoutput,_lhsOoutputs)))) sem_Children_Nil :: T_Children sem_Children_Nil = (T_Children (\ _lhsIcon _lhsIcr _lhsInt -> (let _lhsOinputs :: ([(Identifier, Attributes)]) _lhsOoutputs :: ([(Identifier, Attributes)]) _lhsOfields :: ([(Identifier,Type,Bool)]) _lhsOerrors :: (Seq Error) _lhsOoutput :: Children -- "DefaultRules.ag"(line 155, column 10) _lhsOinputs = [] -- "DefaultRules.ag"(line 155, column 10) _lhsOoutputs = [] -- "DefaultRules.ag"(line 408, column 10) _lhsOfields = [] -- use rule "DefaultRules.ag"(line 109, column 19) _lhsOerrors = Seq.empty -- self rule _output = [] -- self rule _lhsOoutput = _output in ( _lhsOerrors,_lhsOfields,_lhsOinputs,_lhsOoutput,_lhsOoutputs)))) -- 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 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 (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 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 (\ _lhsIoptions -> (let _nontsOo_rename :: Bool _nontsOcr :: Bool _nontsOnonterminals :: (Set NontermIdent) _nontsOuseMap :: UseMap _nontsOtypeSyns :: TypeSyns _nontsOuniq :: Int _nontsOmanualAttrOrderMap :: AttrOrderMap _lhsOerrors :: (Seq Error) _lhsOoutput :: Grammar _nontsIcollect_nts :: (Set NontermIdent) _nontsIerrors :: (Seq Error) _nontsIoutput :: Nonterminals _nontsIuniq :: Int -- "DefaultRules.ag"(line 43, column 17) _nontsOo_rename = rename _lhsIoptions -- "DefaultRules.ag"(line 44, column 17) _nontsOcr = modcopy _lhsIoptions -- "DefaultRules.ag"(line 121, column 13) _nontsOnonterminals = _nontsIcollect_nts -- "DefaultRules.ag"(line 142, column 13) _nontsOuseMap = useMap_ -- "DefaultRules.ag"(line 144, column 13) _nontsOtypeSyns = typeSyns_ -- "DefaultRules.ag"(line 428, column 13) _nontsOuniq = 1 -- "DefaultRules.ag"(line 505, column 7) _nontsOmanualAttrOrderMap = manualAttrOrderMap_ -- use rule "DefaultRules.ag"(line 109, column 19) _lhsOerrors = _nontsIerrors -- self rule _output = Grammar typeSyns_ useMap_ derivings_ wrappers_ _nontsIoutput pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ -- self rule _lhsOoutput = _output ( _nontsIcollect_nts,_nontsIerrors,_nontsIoutput,_nontsIuniq) = (nonts_ _nontsOcr _nontsOmanualAttrOrderMap _nontsOnonterminals _nontsOo_rename _nontsOtypeSyns _nontsOuniq _nontsOuseMap) in ( _lhsOerrors,_lhsOoutput)))) -- Nonterminal ------------------------------------------------- {- visit 0: inherited attributes: cr : Bool manualAttrOrderMap : AttrOrderMap nonterminals : Set NontermIdent o_rename : Bool typeSyns : TypeSyns useMap : UseMap chained attribute: uniq : Int synthesized attributes: collect_nts : Set NontermIdent 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 (Bool -> AttrOrderMap -> (Set NontermIdent) -> Bool -> TypeSyns -> Int -> UseMap -> ( (Set NontermIdent),(Seq Error),Nonterminal,Int)) data Inh_Nonterminal = Inh_Nonterminal {cr_Inh_Nonterminal :: Bool,manualAttrOrderMap_Inh_Nonterminal :: AttrOrderMap,nonterminals_Inh_Nonterminal :: Set NontermIdent,o_rename_Inh_Nonterminal :: Bool,typeSyns_Inh_Nonterminal :: TypeSyns,uniq_Inh_Nonterminal :: Int,useMap_Inh_Nonterminal :: UseMap} data Syn_Nonterminal = Syn_Nonterminal {collect_nts_Syn_Nonterminal :: Set NontermIdent,errors_Syn_Nonterminal :: Seq Error,output_Syn_Nonterminal :: Nonterminal,uniq_Syn_Nonterminal :: Int} wrap_Nonterminal (T_Nonterminal sem) (Inh_Nonterminal _lhsIcr _lhsImanualAttrOrderMap _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap) = (let ( _lhsOcollect_nts,_lhsOerrors,_lhsOoutput,_lhsOuniq) = (sem _lhsIcr _lhsImanualAttrOrderMap _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap) in (Syn_Nonterminal _lhsOcollect_nts _lhsOerrors _lhsOoutput _lhsOuniq)) sem_Nonterminal_Nonterminal :: NontermIdent -> ([Identifier]) -> Attributes -> Attributes -> T_Productions -> T_Nonterminal sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ (T_Productions prods_) = (T_Nonterminal (\ _lhsIcr _lhsImanualAttrOrderMap _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap -> (let _lhsOcollect_nts :: (Set NontermIdent) _prodsOinh :: Attributes _prodsOsyn :: Attributes _prodsOuseMap :: (Map Identifier (String,String,String)) _prodsOnt :: NontermIdent _lhsOerrors :: (Seq Error) _lhsOoutput :: Nonterminal _lhsOuniq :: Int _prodsOcr :: Bool _prodsOmanualAttrOrderMap :: AttrOrderMap _prodsOnonterminals :: (Set NontermIdent) _prodsOo_rename :: Bool _prodsOtypeSyns :: TypeSyns _prodsOuniq :: Int _prodsIerrors :: (Seq Error) _prodsIoutput :: Productions _prodsIuniq :: Int -- "DefaultRules.ag"(line 117, column 17) _lhsOcollect_nts = Set.singleton nt_ -- "DefaultRules.ag"(line 132, column 18) _prodsOinh = inh_ -- "DefaultRules.ag"(line 133, column 18) _prodsOsyn = syn_ -- "DefaultRules.ag"(line 134, column 18) _prodsOuseMap = Map.findWithDefault Map.empty nt_ _lhsIuseMap -- "DefaultRules.ag"(line 146, column 17) _prodsOnt = nt_ -- use rule "DefaultRules.ag"(line 109, column 19) _lhsOerrors = _prodsIerrors -- self rule _output = Nonterminal nt_ params_ inh_ syn_ _prodsIoutput -- self rule _lhsOoutput = _output -- copy rule (up) _lhsOuniq = _prodsIuniq -- copy rule (down) _prodsOcr = _lhsIcr -- copy rule (down) _prodsOmanualAttrOrderMap = _lhsImanualAttrOrderMap -- copy rule (down) _prodsOnonterminals = _lhsInonterminals -- copy rule (down) _prodsOo_rename = _lhsIo_rename -- copy rule (down) _prodsOtypeSyns = _lhsItypeSyns -- copy rule (down) _prodsOuniq = _lhsIuniq ( _prodsIerrors,_prodsIoutput,_prodsIuniq) = (prods_ _prodsOcr _prodsOinh _prodsOmanualAttrOrderMap _prodsOnonterminals _prodsOnt _prodsOo_rename _prodsOsyn _prodsOtypeSyns _prodsOuniq _prodsOuseMap) in ( _lhsOcollect_nts,_lhsOerrors,_lhsOoutput,_lhsOuniq)))) -- Nonterminals ------------------------------------------------ {- visit 0: inherited attributes: cr : Bool manualAttrOrderMap : AttrOrderMap nonterminals : Set NontermIdent o_rename : Bool typeSyns : TypeSyns useMap : UseMap chained attribute: uniq : Int synthesized attributes: collect_nts : Set NontermIdent 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 (Bool -> AttrOrderMap -> (Set NontermIdent) -> Bool -> TypeSyns -> Int -> UseMap -> ( (Set NontermIdent),(Seq Error),Nonterminals,Int)) data Inh_Nonterminals = Inh_Nonterminals {cr_Inh_Nonterminals :: Bool,manualAttrOrderMap_Inh_Nonterminals :: AttrOrderMap,nonterminals_Inh_Nonterminals :: Set NontermIdent,o_rename_Inh_Nonterminals :: Bool,typeSyns_Inh_Nonterminals :: TypeSyns,uniq_Inh_Nonterminals :: Int,useMap_Inh_Nonterminals :: UseMap} data Syn_Nonterminals = Syn_Nonterminals {collect_nts_Syn_Nonterminals :: Set NontermIdent,errors_Syn_Nonterminals :: Seq Error,output_Syn_Nonterminals :: Nonterminals,uniq_Syn_Nonterminals :: Int} wrap_Nonterminals (T_Nonterminals sem) (Inh_Nonterminals _lhsIcr _lhsImanualAttrOrderMap _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap) = (let ( _lhsOcollect_nts,_lhsOerrors,_lhsOoutput,_lhsOuniq) = (sem _lhsIcr _lhsImanualAttrOrderMap _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap) in (Syn_Nonterminals _lhsOcollect_nts _lhsOerrors _lhsOoutput _lhsOuniq)) sem_Nonterminals_Cons :: T_Nonterminal -> T_Nonterminals -> T_Nonterminals sem_Nonterminals_Cons (T_Nonterminal hd_) (T_Nonterminals tl_) = (T_Nonterminals (\ _lhsIcr _lhsImanualAttrOrderMap _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap -> (let _lhsOcollect_nts :: (Set NontermIdent) _lhsOerrors :: (Seq Error) _lhsOoutput :: Nonterminals _lhsOuniq :: Int _hdOcr :: Bool _hdOmanualAttrOrderMap :: AttrOrderMap _hdOnonterminals :: (Set NontermIdent) _hdOo_rename :: Bool _hdOtypeSyns :: TypeSyns _hdOuniq :: Int _hdOuseMap :: UseMap _tlOcr :: Bool _tlOmanualAttrOrderMap :: AttrOrderMap _tlOnonterminals :: (Set NontermIdent) _tlOo_rename :: Bool _tlOtypeSyns :: TypeSyns _tlOuniq :: Int _tlOuseMap :: UseMap _hdIcollect_nts :: (Set NontermIdent) _hdIerrors :: (Seq Error) _hdIoutput :: Nonterminal _hdIuniq :: Int _tlIcollect_nts :: (Set NontermIdent) _tlIerrors :: (Seq Error) _tlIoutput :: Nonterminals _tlIuniq :: Int -- use rule "DefaultRules.ag"(line 115, column 49) _lhsOcollect_nts = _hdIcollect_nts `Set.union` _tlIcollect_nts -- use rule "DefaultRules.ag"(line 109, column 19) _lhsOerrors = _hdIerrors Seq.<> _tlIerrors -- self rule _output = (:) _hdIoutput _tlIoutput -- self rule _lhsOoutput = _output -- copy rule (up) _lhsOuniq = _tlIuniq -- copy rule (down) _hdOcr = _lhsIcr -- copy rule (down) _hdOmanualAttrOrderMap = _lhsImanualAttrOrderMap -- copy rule (down) _hdOnonterminals = _lhsInonterminals -- copy rule (down) _hdOo_rename = _lhsIo_rename -- copy rule (down) _hdOtypeSyns = _lhsItypeSyns -- copy rule (down) _hdOuniq = _lhsIuniq -- copy rule (down) _hdOuseMap = _lhsIuseMap -- copy rule (down) _tlOcr = _lhsIcr -- copy rule (down) _tlOmanualAttrOrderMap = _lhsImanualAttrOrderMap -- copy rule (down) _tlOnonterminals = _lhsInonterminals -- copy rule (down) _tlOo_rename = _lhsIo_rename -- copy rule (down) _tlOtypeSyns = _lhsItypeSyns -- copy rule (chain) _tlOuniq = _hdIuniq -- copy rule (down) _tlOuseMap = _lhsIuseMap ( _hdIcollect_nts,_hdIerrors,_hdIoutput,_hdIuniq) = (hd_ _hdOcr _hdOmanualAttrOrderMap _hdOnonterminals _hdOo_rename _hdOtypeSyns _hdOuniq _hdOuseMap) ( _tlIcollect_nts,_tlIerrors,_tlIoutput,_tlIuniq) = (tl_ _tlOcr _tlOmanualAttrOrderMap _tlOnonterminals _tlOo_rename _tlOtypeSyns _tlOuniq _tlOuseMap) in ( _lhsOcollect_nts,_lhsOerrors,_lhsOoutput,_lhsOuniq)))) sem_Nonterminals_Nil :: T_Nonterminals sem_Nonterminals_Nil = (T_Nonterminals (\ _lhsIcr _lhsImanualAttrOrderMap _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap -> (let _lhsOcollect_nts :: (Set NontermIdent) _lhsOerrors :: (Seq Error) _lhsOoutput :: Nonterminals _lhsOuniq :: Int -- use rule "DefaultRules.ag"(line 115, column 49) _lhsOcollect_nts = Set.empty -- use rule "DefaultRules.ag"(line 109, column 19) _lhsOerrors = Seq.empty -- self rule _output = [] -- self rule _lhsOoutput = _output -- copy rule (chain) _lhsOuniq = _lhsIuniq in ( _lhsOcollect_nts,_lhsOerrors,_lhsOoutput,_lhsOuniq)))) -- Pattern ----------------------------------------------------- {- visit 0: inherited attributes: con : ConstructorIdent nt : NontermIdent synthesized attributes: containsVars : Bool copy : SELF definedAttrs : Set (Identifier,Identifier) errors : Seq Error locals : Set Identifier output : SELF alternatives: alternative Alias: child field : {Identifier} child attr : {Identifier} child pat : Pattern child parts : Patterns visit 0: local copy : _ local output : _ 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 (ConstructorIdent -> NontermIdent -> ( Bool,Pattern,(Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Pattern)) data Inh_Pattern = Inh_Pattern {con_Inh_Pattern :: ConstructorIdent,nt_Inh_Pattern :: NontermIdent} data Syn_Pattern = Syn_Pattern {containsVars_Syn_Pattern :: Bool,copy_Syn_Pattern :: Pattern,definedAttrs_Syn_Pattern :: Set (Identifier,Identifier),errors_Syn_Pattern :: Seq Error,locals_Syn_Pattern :: Set Identifier,output_Syn_Pattern :: Pattern} wrap_Pattern (T_Pattern sem) (Inh_Pattern _lhsIcon _lhsInt) = (let ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) = (sem _lhsIcon _lhsInt) in (Syn_Pattern _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _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 (\ _lhsIcon _lhsInt -> (let _lhsOdefinedAttrs :: (Set (Identifier,Identifier)) _lhsOlocals :: (Set Identifier) _lhsOcontainsVars :: Bool _lhsOerrors :: (Seq Error) _lhsOcopy :: Pattern _lhsOoutput :: Pattern _patOcon :: ConstructorIdent _patOnt :: NontermIdent _partsOcon :: ConstructorIdent _partsOnt :: NontermIdent _patIcontainsVars :: Bool _patIcopy :: Pattern _patIdefinedAttrs :: (Set (Identifier,Identifier)) _patIerrors :: (Seq Error) _patIlocals :: (Set Identifier) _patIoutput :: Pattern _partsIcontainsVars :: Bool _partsIcopy :: Patterns _partsIdefinedAttrs :: (Set (Identifier,Identifier)) _partsIerrors :: (Seq Error) _partsIlocals :: (Set Identifier) _partsIoutput :: Patterns -- "DefaultRules.ag"(line 401, column 11) _lhsOdefinedAttrs = Set.insert (field_,attr_) _patIdefinedAttrs -- "DefaultRules.ag"(line 401, column 11) _lhsOlocals = if field_ == _LOC then Set.insert attr_ _patIlocals else _patIlocals -- "DefaultRules.ag"(line 419, column 16) _lhsOcontainsVars = True -- use rule "DefaultRules.ag"(line 109, column 19) _lhsOerrors = _patIerrors Seq.<> _partsIerrors -- self rule _copy = Alias field_ attr_ _patIcopy _partsIcopy -- self rule _output = Alias field_ attr_ _patIoutput _partsIoutput -- self rule _lhsOcopy = _copy -- self rule _lhsOoutput = _output -- copy rule (down) _patOcon = _lhsIcon -- copy rule (down) _patOnt = _lhsInt -- copy rule (down) _partsOcon = _lhsIcon -- copy rule (down) _partsOnt = _lhsInt ( _patIcontainsVars,_patIcopy,_patIdefinedAttrs,_patIerrors,_patIlocals,_patIoutput) = (pat_ _patOcon _patOnt) ( _partsIcontainsVars,_partsIcopy,_partsIdefinedAttrs,_partsIerrors,_partsIlocals,_partsIoutput) = (parts_ _partsOcon _partsOnt) in ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput)))) sem_Pattern_Constr :: ConstructorIdent -> T_Patterns -> T_Pattern sem_Pattern_Constr name_ (T_Patterns pats_) = (T_Pattern (\ _lhsIcon _lhsInt -> (let _lhsOcontainsVars :: Bool _lhsOdefinedAttrs :: (Set (Identifier,Identifier)) _lhsOerrors :: (Seq Error) _lhsOlocals :: (Set Identifier) _lhsOcopy :: Pattern _lhsOoutput :: Pattern _patsOcon :: ConstructorIdent _patsOnt :: NontermIdent _patsIcontainsVars :: Bool _patsIcopy :: Patterns _patsIdefinedAttrs :: (Set (Identifier,Identifier)) _patsIerrors :: (Seq Error) _patsIlocals :: (Set Identifier) _patsIoutput :: Patterns -- use rule "DefaultRules.ag"(line 416, column 46) _lhsOcontainsVars = _patsIcontainsVars -- use rule "DefaultRules.ag"(line 396, column 23) _lhsOdefinedAttrs = _patsIdefinedAttrs -- use rule "DefaultRules.ag"(line 109, column 19) _lhsOerrors = _patsIerrors -- use rule "DefaultRules.ag"(line 395, column 23) _lhsOlocals = _patsIlocals -- self rule _copy = Constr name_ _patsIcopy -- self rule _output = Constr name_ _patsIoutput -- self rule _lhsOcopy = _copy -- self rule _lhsOoutput = _output -- copy rule (down) _patsOcon = _lhsIcon -- copy rule (down) _patsOnt = _lhsInt ( _patsIcontainsVars,_patsIcopy,_patsIdefinedAttrs,_patsIerrors,_patsIlocals,_patsIoutput) = (pats_ _patsOcon _patsOnt) in ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput)))) sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern sem_Pattern_Irrefutable (T_Pattern pat_) = (T_Pattern (\ _lhsIcon _lhsInt -> (let _lhsOcontainsVars :: Bool _lhsOdefinedAttrs :: (Set (Identifier,Identifier)) _lhsOerrors :: (Seq Error) _lhsOlocals :: (Set Identifier) _lhsOcopy :: Pattern _lhsOoutput :: Pattern _patOcon :: ConstructorIdent _patOnt :: NontermIdent _patIcontainsVars :: Bool _patIcopy :: Pattern _patIdefinedAttrs :: (Set (Identifier,Identifier)) _patIerrors :: (Seq Error) _patIlocals :: (Set Identifier) _patIoutput :: Pattern -- use rule "DefaultRules.ag"(line 416, column 46) _lhsOcontainsVars = _patIcontainsVars -- use rule "DefaultRules.ag"(line 396, column 23) _lhsOdefinedAttrs = _patIdefinedAttrs -- use rule "DefaultRules.ag"(line 109, column 19) _lhsOerrors = _patIerrors -- use rule "DefaultRules.ag"(line 395, column 23) _lhsOlocals = _patIlocals -- self rule _copy = Irrefutable _patIcopy -- self rule _output = Irrefutable _patIoutput -- self rule _lhsOcopy = _copy -- self rule _lhsOoutput = _output -- copy rule (down) _patOcon = _lhsIcon -- copy rule (down) _patOnt = _lhsInt ( _patIcontainsVars,_patIcopy,_patIdefinedAttrs,_patIerrors,_patIlocals,_patIoutput) = (pat_ _patOcon _patOnt) in ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput)))) sem_Pattern_Product :: Pos -> T_Patterns -> T_Pattern sem_Pattern_Product pos_ (T_Patterns pats_) = (T_Pattern (\ _lhsIcon _lhsInt -> (let _lhsOcontainsVars :: Bool _lhsOdefinedAttrs :: (Set (Identifier,Identifier)) _lhsOerrors :: (Seq Error) _lhsOlocals :: (Set Identifier) _lhsOcopy :: Pattern _lhsOoutput :: Pattern _patsOcon :: ConstructorIdent _patsOnt :: NontermIdent _patsIcontainsVars :: Bool _patsIcopy :: Patterns _patsIdefinedAttrs :: (Set (Identifier,Identifier)) _patsIerrors :: (Seq Error) _patsIlocals :: (Set Identifier) _patsIoutput :: Patterns -- use rule "DefaultRules.ag"(line 416, column 46) _lhsOcontainsVars = _patsIcontainsVars -- use rule "DefaultRules.ag"(line 396, column 23) _lhsOdefinedAttrs = _patsIdefinedAttrs -- use rule "DefaultRules.ag"(line 109, column 19) _lhsOerrors = _patsIerrors -- use rule "DefaultRules.ag"(line 395, column 23) _lhsOlocals = _patsIlocals -- self rule _copy = Product pos_ _patsIcopy -- self rule _output = Product pos_ _patsIoutput -- self rule _lhsOcopy = _copy -- self rule _lhsOoutput = _output -- copy rule (down) _patsOcon = _lhsIcon -- copy rule (down) _patsOnt = _lhsInt ( _patsIcontainsVars,_patsIcopy,_patsIdefinedAttrs,_patsIerrors,_patsIlocals,_patsIoutput) = (pats_ _patsOcon _patsOnt) in ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput)))) sem_Pattern_Underscore :: Pos -> T_Pattern sem_Pattern_Underscore pos_ = (T_Pattern (\ _lhsIcon _lhsInt -> (let _lhsOcontainsVars :: Bool _lhsOdefinedAttrs :: (Set (Identifier,Identifier)) _lhsOerrors :: (Seq Error) _lhsOlocals :: (Set Identifier) _lhsOcopy :: Pattern _lhsOoutput :: Pattern -- use rule "DefaultRules.ag"(line 416, column 46) _lhsOcontainsVars = False -- use rule "DefaultRules.ag"(line 396, column 23) _lhsOdefinedAttrs = Set.empty -- use rule "DefaultRules.ag"(line 109, column 19) _lhsOerrors = Seq.empty -- use rule "DefaultRules.ag"(line 395, column 23) _lhsOlocals = Set.empty -- self rule _copy = Underscore pos_ -- self rule _output = Underscore pos_ -- self rule _lhsOcopy = _copy -- self rule _lhsOoutput = _output in ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput)))) -- Patterns ---------------------------------------------------- {- visit 0: inherited attributes: con : ConstructorIdent nt : NontermIdent synthesized attributes: containsVars : Bool copy : SELF definedAttrs : Set (Identifier,Identifier) errors : Seq Error locals : Set Identifier 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 (ConstructorIdent -> NontermIdent -> ( Bool,Patterns,(Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Patterns)) data Inh_Patterns = Inh_Patterns {con_Inh_Patterns :: ConstructorIdent,nt_Inh_Patterns :: NontermIdent} data Syn_Patterns = Syn_Patterns {containsVars_Syn_Patterns :: Bool,copy_Syn_Patterns :: Patterns,definedAttrs_Syn_Patterns :: Set (Identifier,Identifier),errors_Syn_Patterns :: Seq Error,locals_Syn_Patterns :: Set Identifier,output_Syn_Patterns :: Patterns} wrap_Patterns (T_Patterns sem) (Inh_Patterns _lhsIcon _lhsInt) = (let ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) = (sem _lhsIcon _lhsInt) in (Syn_Patterns _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput)) sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) = (T_Patterns (\ _lhsIcon _lhsInt -> (let _lhsOcontainsVars :: Bool _lhsOdefinedAttrs :: (Set (Identifier,Identifier)) _lhsOerrors :: (Seq Error) _lhsOlocals :: (Set Identifier) _lhsOcopy :: Patterns _lhsOoutput :: Patterns _hdOcon :: ConstructorIdent _hdOnt :: NontermIdent _tlOcon :: ConstructorIdent _tlOnt :: NontermIdent _hdIcontainsVars :: Bool _hdIcopy :: Pattern _hdIdefinedAttrs :: (Set (Identifier,Identifier)) _hdIerrors :: (Seq Error) _hdIlocals :: (Set Identifier) _hdIoutput :: Pattern _tlIcontainsVars :: Bool _tlIcopy :: Patterns _tlIdefinedAttrs :: (Set (Identifier,Identifier)) _tlIerrors :: (Seq Error) _tlIlocals :: (Set Identifier) _tlIoutput :: Patterns -- use rule "DefaultRules.ag"(line 416, column 46) _lhsOcontainsVars = _hdIcontainsVars || _tlIcontainsVars -- use rule "DefaultRules.ag"(line 396, column 23) _lhsOdefinedAttrs = _hdIdefinedAttrs `Set.union` _tlIdefinedAttrs -- use rule "DefaultRules.ag"(line 109, column 19) _lhsOerrors = _hdIerrors Seq.<> _tlIerrors -- use rule "DefaultRules.ag"(line 395, column 23) _lhsOlocals = _hdIlocals `Set.union` _tlIlocals -- self rule _copy = (:) _hdIcopy _tlIcopy -- self rule _output = (:) _hdIoutput _tlIoutput -- self rule _lhsOcopy = _copy -- self rule _lhsOoutput = _output -- copy rule (down) _hdOcon = _lhsIcon -- copy rule (down) _hdOnt = _lhsInt -- copy rule (down) _tlOcon = _lhsIcon -- copy rule (down) _tlOnt = _lhsInt ( _hdIcontainsVars,_hdIcopy,_hdIdefinedAttrs,_hdIerrors,_hdIlocals,_hdIoutput) = (hd_ _hdOcon _hdOnt) ( _tlIcontainsVars,_tlIcopy,_tlIdefinedAttrs,_tlIerrors,_tlIlocals,_tlIoutput) = (tl_ _tlOcon _tlOnt) in ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput)))) sem_Patterns_Nil :: T_Patterns sem_Patterns_Nil = (T_Patterns (\ _lhsIcon _lhsInt -> (let _lhsOcontainsVars :: Bool _lhsOdefinedAttrs :: (Set (Identifier,Identifier)) _lhsOerrors :: (Seq Error) _lhsOlocals :: (Set Identifier) _lhsOcopy :: Patterns _lhsOoutput :: Patterns -- use rule "DefaultRules.ag"(line 416, column 46) _lhsOcontainsVars = False -- use rule "DefaultRules.ag"(line 396, column 23) _lhsOdefinedAttrs = Set.empty -- use rule "DefaultRules.ag"(line 109, column 19) _lhsOerrors = Seq.empty -- use rule "DefaultRules.ag"(line 395, column 23) _lhsOlocals = Set.empty -- self rule _copy = [] -- self rule _output = [] -- self rule _lhsOcopy = _copy -- self rule _lhsOoutput = _output in ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput)))) -- Production -------------------------------------------------- {- visit 0: inherited attributes: cr : Bool inh : Attributes manualAttrOrderMap : AttrOrderMap nonterminals : Set NontermIdent nt : NontermIdent o_rename : Bool syn : Attributes typeSyns : TypeSyns useMap : Map Identifier (String,String,String) chained attribute: uniq : Int synthesized attributes: errors : Seq Error output : SELF alternatives: alternative Production: child con : {ConstructorIdent} child children : Children child rules : Rules child typeSigs : TypeSigs visit 0: local _tup1 : _ local newRls : _ local errs : _ local orderDeps : _ local orderErrs : _ 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 (Bool -> Attributes -> AttrOrderMap -> (Set NontermIdent) -> NontermIdent -> Bool -> Attributes -> TypeSyns -> Int -> (Map Identifier (String,String,String)) -> ( (Seq Error),Production,Int)) data Inh_Production = Inh_Production {cr_Inh_Production :: Bool,inh_Inh_Production :: Attributes,manualAttrOrderMap_Inh_Production :: AttrOrderMap,nonterminals_Inh_Production :: Set NontermIdent,nt_Inh_Production :: NontermIdent,o_rename_Inh_Production :: Bool,syn_Inh_Production :: Attributes,typeSyns_Inh_Production :: TypeSyns,uniq_Inh_Production :: Int,useMap_Inh_Production :: Map Identifier (String,String,String)} data Syn_Production = Syn_Production {errors_Syn_Production :: Seq Error,output_Syn_Production :: Production,uniq_Syn_Production :: Int} wrap_Production (T_Production sem) (Inh_Production _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap) = (let ( _lhsOerrors,_lhsOoutput,_lhsOuniq) = (sem _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap) in (Syn_Production _lhsOerrors _lhsOoutput _lhsOuniq)) 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 (\ _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap -> (let _rulesOcon :: ConstructorIdent _childrenOcon :: ConstructorIdent _lhsOerrors :: (Seq Error) _lhsOoutput :: Production _lhsOuniq :: Int _childrenOcr :: Bool _childrenOnt :: NontermIdent _rulesOnt :: NontermIdent _rulesOuniq :: Int _childrenIerrors :: (Seq Error) _childrenIfields :: ([(Identifier,Type,Bool)]) _childrenIinputs :: ([(Identifier, Attributes)]) _childrenIoutput :: Children _childrenIoutputs :: ([(Identifier, Attributes)]) _rulesIdefinedAttrs :: (Set (Identifier,Identifier)) _rulesIerrors :: (Seq Error) _rulesIlocals :: (Set Identifier) _rulesIoutput :: Rules _rulesIuniq :: Int _typeSigsIoutput :: TypeSigs -- "DefaultRules.ag"(line 137, column 16) _rulesOcon = con_ -- "DefaultRules.ag"(line 138, column 17) _childrenOcon = con_ -- "DefaultRules.ag"(line 320, column 4) _lhsOerrors = _childrenIerrors <> _errs <> _rulesIerrors <> _orderErrs -- "DefaultRules.ag"(line 322, column 8) __tup1 = let locals = _rulesIlocals initenv = Map.fromList ( [ (a,_ACHILD) | (a,_,_) <- _childrenIfields ] ++ attrs(_LHS, _lhsIinh) ++ [ (a,_LOC) | a <- Set.toList locals ] ) attrs (n,as) = [ (a,n) | a <- Map.keys as ] envs = scanl (flip Map.union) initenv (map (Map.fromList . attrs ) _childrenIoutputs) child_envs = init envs lhs_env = last envs (selfAttrs, normalAttrs) = Map.partition isSELFNonterminal _lhsIsyn (_,undefAttrs) = removeDefined _rulesIdefinedAttrs (_LHS, normalAttrs) (useAttrs,others) = splitAttrs _lhsIuseMap undefAttrs (rules1, errors1) = concatRE $ map (copyRule _lhsInt con_ _lhsIcr locals) (zip envs (map (removeDefined _rulesIdefinedAttrs) _childrenIinputs)) uRules = map (useRule locals _childrenIoutputs) useAttrs selfLocRules = [ selfRule False attr (constructor [childSelf attr nm tp | (nm,tp,ho) <- _childrenIfields, not ho]) | attr <- Map.keys selfAttrs , not (Set.member attr locals) ] where childSelf self nm tp = case tp of NT nt _ -> attrName nm self _ | nm `Set.member` locals -> locname nm | otherwise -> fieldName nm constructor fs | getName con_ == "Tuple" && _lhsInt `elem` map fst _lhsItypeSyns = "(" ++ concat (List.intersperse "," fs) ++ ")" | otherwise = getConName _lhsItypeSyns _lhsIo_rename _lhsInt con_ ++ " " ++ unwords fs selfRules = [ selfRule True attr undefined | attr <- Map.keys selfAttrs , not (Set.member (_LHS,attr) _rulesIdefinedAttrs) ] (rules5, errs5) = copyRule _lhsInt con_ _lhsIcr locals (lhs_env, (_LHS, others)) in (uRules++selfLocRules++selfRules++rules5++rules1, errors1<>errs5) -- "DefaultRules.ag"(line 322, column 8) (_newRls,_) = __tup1 -- "DefaultRules.ag"(line 322, column 8) (_,_errs) = __tup1 -- "DefaultRules.ag"(line 438, column 16) _lhsOoutput = Production con_ _childrenIoutput (_rulesIoutput ++ _newRls) _typeSigsIoutput -- "DefaultRules.ag"(line 510, column 7) _orderDeps = Set.toList $ Map.findWithDefault Set.empty con_ $ Map.findWithDefault Map.empty _lhsInt _lhsImanualAttrOrderMap -- "DefaultRules.ag"(line 512, column 7) _orderErrs = let chldOutMap = Map.fromList [ (k, Map.keysSet s) | (k,s) <- _childrenIoutputs ] chldInMap = Map.fromList [ (k, Map.keysSet s) | (k,s) <- _childrenIinputs ] isInAttribute :: Identifier -> Identifier -> [Error] isInAttribute fld nm | fld == _LOC = if nm `Set.member` _rulesIlocals then [] else [UndefAttr _lhsInt con_ fld nm False] | fld == _LHS = if nm `Map.member` _lhsIinh then [] else [UndefAttr _lhsInt con_ fld nm False] | otherwise = if nm `Set.member` (Map.findWithDefault Set.empty fld chldOutMap) then [] else [UndefAttr _lhsInt con_ fld nm False] isOutAttribute :: Identifier -> Identifier -> [Error] isOutAttribute fld nm | fld == _LOC = if nm `Set.member` _rulesIlocals then [] else [UndefAttr _lhsInt con_ fld nm True] | fld == _LHS = if nm `Map.member` _lhsIsyn then [] else [UndefAttr _lhsInt con_ fld nm True] | otherwise = if nm `Set.member` (Map.findWithDefault Set.empty fld chldInMap) then [] else [UndefAttr _lhsInt con_ fld nm True] in Seq.fromList . concat $ [ isInAttribute fldA nmA ++ isOutAttribute fldB nmB | dep@(Dependency (fldA,nmA) (fldB,nmB)) <- _orderDeps ] -- self rule _output = Production con_ _childrenIoutput _rulesIoutput _typeSigsIoutput -- copy rule (up) _lhsOuniq = _rulesIuniq -- copy rule (down) _childrenOcr = _lhsIcr -- copy rule (down) _childrenOnt = _lhsInt -- copy rule (down) _rulesOnt = _lhsInt -- copy rule (down) _rulesOuniq = _lhsIuniq ( _childrenIerrors,_childrenIfields,_childrenIinputs,_childrenIoutput,_childrenIoutputs) = (children_ _childrenOcon _childrenOcr _childrenOnt) ( _rulesIdefinedAttrs,_rulesIerrors,_rulesIlocals,_rulesIoutput,_rulesIuniq) = (rules_ _rulesOcon _rulesOnt _rulesOuniq) ( _typeSigsIoutput) = (typeSigs_ ) in ( _lhsOerrors,_lhsOoutput,_lhsOuniq)))) -- Productions ------------------------------------------------- {- visit 0: inherited attributes: cr : Bool inh : Attributes manualAttrOrderMap : AttrOrderMap nonterminals : Set NontermIdent nt : NontermIdent o_rename : Bool syn : Attributes typeSyns : TypeSyns useMap : Map Identifier (String,String,String) chained attribute: uniq : Int 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 (Bool -> Attributes -> AttrOrderMap -> (Set NontermIdent) -> NontermIdent -> Bool -> Attributes -> TypeSyns -> Int -> (Map Identifier (String,String,String)) -> ( (Seq Error),Productions,Int)) data Inh_Productions = Inh_Productions {cr_Inh_Productions :: Bool,inh_Inh_Productions :: Attributes,manualAttrOrderMap_Inh_Productions :: AttrOrderMap,nonterminals_Inh_Productions :: Set NontermIdent,nt_Inh_Productions :: NontermIdent,o_rename_Inh_Productions :: Bool,syn_Inh_Productions :: Attributes,typeSyns_Inh_Productions :: TypeSyns,uniq_Inh_Productions :: Int,useMap_Inh_Productions :: Map Identifier (String,String,String)} data Syn_Productions = Syn_Productions {errors_Syn_Productions :: Seq Error,output_Syn_Productions :: Productions,uniq_Syn_Productions :: Int} wrap_Productions (T_Productions sem) (Inh_Productions _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap) = (let ( _lhsOerrors,_lhsOoutput,_lhsOuniq) = (sem _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap) in (Syn_Productions _lhsOerrors _lhsOoutput _lhsOuniq)) sem_Productions_Cons :: T_Production -> T_Productions -> T_Productions sem_Productions_Cons (T_Production hd_) (T_Productions tl_) = (T_Productions (\ _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap -> (let _lhsOerrors :: (Seq Error) _lhsOoutput :: Productions _lhsOuniq :: Int _hdOcr :: Bool _hdOinh :: Attributes _hdOmanualAttrOrderMap :: AttrOrderMap _hdOnonterminals :: (Set NontermIdent) _hdOnt :: NontermIdent _hdOo_rename :: Bool _hdOsyn :: Attributes _hdOtypeSyns :: TypeSyns _hdOuniq :: Int _hdOuseMap :: (Map Identifier (String,String,String)) _tlOcr :: Bool _tlOinh :: Attributes _tlOmanualAttrOrderMap :: AttrOrderMap _tlOnonterminals :: (Set NontermIdent) _tlOnt :: NontermIdent _tlOo_rename :: Bool _tlOsyn :: Attributes _tlOtypeSyns :: TypeSyns _tlOuniq :: Int _tlOuseMap :: (Map Identifier (String,String,String)) _hdIerrors :: (Seq Error) _hdIoutput :: Production _hdIuniq :: Int _tlIerrors :: (Seq Error) _tlIoutput :: Productions _tlIuniq :: Int -- use rule "DefaultRules.ag"(line 109, column 19) _lhsOerrors = _hdIerrors Seq.<> _tlIerrors -- self rule _output = (:) _hdIoutput _tlIoutput -- self rule _lhsOoutput = _output -- copy rule (up) _lhsOuniq = _tlIuniq -- copy rule (down) _hdOcr = _lhsIcr -- copy rule (down) _hdOinh = _lhsIinh -- copy rule (down) _hdOmanualAttrOrderMap = _lhsImanualAttrOrderMap -- copy rule (down) _hdOnonterminals = _lhsInonterminals -- copy rule (down) _hdOnt = _lhsInt -- copy rule (down) _hdOo_rename = _lhsIo_rename -- copy rule (down) _hdOsyn = _lhsIsyn -- copy rule (down) _hdOtypeSyns = _lhsItypeSyns -- copy rule (down) _hdOuniq = _lhsIuniq -- copy rule (down) _hdOuseMap = _lhsIuseMap -- copy rule (down) _tlOcr = _lhsIcr -- copy rule (down) _tlOinh = _lhsIinh -- copy rule (down) _tlOmanualAttrOrderMap = _lhsImanualAttrOrderMap -- copy rule (down) _tlOnonterminals = _lhsInonterminals -- copy rule (down) _tlOnt = _lhsInt -- copy rule (down) _tlOo_rename = _lhsIo_rename -- copy rule (down) _tlOsyn = _lhsIsyn -- copy rule (down) _tlOtypeSyns = _lhsItypeSyns -- copy rule (chain) _tlOuniq = _hdIuniq -- copy rule (down) _tlOuseMap = _lhsIuseMap ( _hdIerrors,_hdIoutput,_hdIuniq) = (hd_ _hdOcr _hdOinh _hdOmanualAttrOrderMap _hdOnonterminals _hdOnt _hdOo_rename _hdOsyn _hdOtypeSyns _hdOuniq _hdOuseMap) ( _tlIerrors,_tlIoutput,_tlIuniq) = (tl_ _tlOcr _tlOinh _tlOmanualAttrOrderMap _tlOnonterminals _tlOnt _tlOo_rename _tlOsyn _tlOtypeSyns _tlOuniq _tlOuseMap) in ( _lhsOerrors,_lhsOoutput,_lhsOuniq)))) sem_Productions_Nil :: T_Productions sem_Productions_Nil = (T_Productions (\ _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap -> (let _lhsOerrors :: (Seq Error) _lhsOoutput :: Productions _lhsOuniq :: Int -- use rule "DefaultRules.ag"(line 109, column 19) _lhsOerrors = Seq.empty -- self rule _output = [] -- self rule _lhsOoutput = _output -- copy rule (chain) _lhsOuniq = _lhsIuniq in ( _lhsOerrors,_lhsOoutput,_lhsOuniq)))) -- Rule -------------------------------------------------------- {- visit 0: inherited attributes: con : ConstructorIdent nt : NontermIdent chained attribute: uniq : Int synthesized attributes: containsVars : Bool definedAttrs : Set (Identifier,Identifier) errors : Seq Error locals : Set Identifier output : SELF outputs : Rules alternatives: alternative Rule: child pattern : Pattern child rhs : {Expression} child owrt : {Bool} child origin : {String} visit 0: local _tup2 : {(Rules,Int)} local output : _ -} -- cata sem_Rule :: Rule -> T_Rule sem_Rule (Rule _pattern _rhs _owrt _origin) = (sem_Rule_Rule (sem_Pattern _pattern) _rhs _owrt _origin) -- semantic domain newtype T_Rule = T_Rule (ConstructorIdent -> NontermIdent -> Int -> ( Bool,(Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Rule,Rules,Int)) data Inh_Rule = Inh_Rule {con_Inh_Rule :: ConstructorIdent,nt_Inh_Rule :: NontermIdent,uniq_Inh_Rule :: Int} data Syn_Rule = Syn_Rule {containsVars_Syn_Rule :: Bool,definedAttrs_Syn_Rule :: Set (Identifier,Identifier),errors_Syn_Rule :: Seq Error,locals_Syn_Rule :: Set Identifier,output_Syn_Rule :: Rule,outputs_Syn_Rule :: Rules,uniq_Syn_Rule :: Int} wrap_Rule (T_Rule sem) (Inh_Rule _lhsIcon _lhsInt _lhsIuniq) = (let ( _lhsOcontainsVars,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOoutputs,_lhsOuniq) = (sem _lhsIcon _lhsInt _lhsIuniq) in (Syn_Rule _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOoutputs _lhsOuniq)) sem_Rule_Rule :: T_Pattern -> Expression -> Bool -> String -> T_Rule sem_Rule_Rule (T_Pattern pattern_) rhs_ owrt_ origin_ = (T_Rule (\ _lhsIcon _lhsInt _lhsIuniq -> (let __tup2 :: ((Rules,Int)) _lhsOoutputs :: Rules _lhsOuniq :: Int _lhsOcontainsVars :: Bool _lhsOdefinedAttrs :: (Set (Identifier,Identifier)) _lhsOerrors :: (Seq Error) _lhsOlocals :: (Set Identifier) _lhsOoutput :: Rule _patternOcon :: ConstructorIdent _patternOnt :: NontermIdent _patternIcontainsVars :: Bool _patternIcopy :: Pattern _patternIdefinedAttrs :: (Set (Identifier,Identifier)) _patternIerrors :: (Seq Error) _patternIlocals :: (Set Identifier) _patternIoutput :: Pattern -- "DefaultRules.ag"(line 445, column 11) __tup2 = multiRule _output _lhsIuniq -- "DefaultRules.ag"(line 445, column 11) (_lhsOoutputs,_) = __tup2 -- "DefaultRules.ag"(line 445, column 11) (_,_lhsOuniq) = __tup2 -- use rule "DefaultRules.ag"(line 416, column 46) _lhsOcontainsVars = _patternIcontainsVars -- use rule "DefaultRules.ag"(line 396, column 23) _lhsOdefinedAttrs = _patternIdefinedAttrs -- use rule "DefaultRules.ag"(line 109, column 19) _lhsOerrors = _patternIerrors -- use rule "DefaultRules.ag"(line 395, column 23) _lhsOlocals = _patternIlocals -- self rule _output = Rule _patternIoutput rhs_ owrt_ origin_ -- self rule _lhsOoutput = _output -- copy rule (down) _patternOcon = _lhsIcon -- copy rule (down) _patternOnt = _lhsInt ( _patternIcontainsVars,_patternIcopy,_patternIdefinedAttrs,_patternIerrors,_patternIlocals,_patternIoutput) = (pattern_ _patternOcon _patternOnt) in ( _lhsOcontainsVars,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOoutputs,_lhsOuniq)))) -- Rules ------------------------------------------------------- {- visit 0: inherited attributes: con : ConstructorIdent nt : NontermIdent chained attribute: uniq : Int synthesized attributes: definedAttrs : Set (Identifier,Identifier) errors : Seq Error locals : Set Identifier 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 (ConstructorIdent -> NontermIdent -> Int -> ( (Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Rules,Int)) data Inh_Rules = Inh_Rules {con_Inh_Rules :: ConstructorIdent,nt_Inh_Rules :: NontermIdent,uniq_Inh_Rules :: Int} data Syn_Rules = Syn_Rules {definedAttrs_Syn_Rules :: Set (Identifier,Identifier),errors_Syn_Rules :: Seq Error,locals_Syn_Rules :: Set Identifier,output_Syn_Rules :: Rules,uniq_Syn_Rules :: Int} wrap_Rules (T_Rules sem) (Inh_Rules _lhsIcon _lhsInt _lhsIuniq) = (let ( _lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOuniq) = (sem _lhsIcon _lhsInt _lhsIuniq) in (Syn_Rules _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOuniq)) sem_Rules_Cons :: T_Rule -> T_Rules -> T_Rules sem_Rules_Cons (T_Rule hd_) (T_Rules tl_) = (T_Rules (\ _lhsIcon _lhsInt _lhsIuniq -> (let _lhsOoutput :: Rules _lhsOdefinedAttrs :: (Set (Identifier,Identifier)) _lhsOerrors :: (Seq Error) _lhsOlocals :: (Set Identifier) _lhsOuniq :: Int _hdOcon :: ConstructorIdent _hdOnt :: NontermIdent _hdOuniq :: Int _tlOcon :: ConstructorIdent _tlOnt :: NontermIdent _tlOuniq :: Int _hdIcontainsVars :: Bool _hdIdefinedAttrs :: (Set (Identifier,Identifier)) _hdIerrors :: (Seq Error) _hdIlocals :: (Set Identifier) _hdIoutput :: Rule _hdIoutputs :: Rules _hdIuniq :: Int _tlIdefinedAttrs :: (Set (Identifier,Identifier)) _tlIerrors :: (Seq Error) _tlIlocals :: (Set Identifier) _tlIoutput :: Rules _tlIuniq :: Int -- "DefaultRules.ag"(line 441, column 10) _lhsOoutput = if _hdIcontainsVars then _hdIoutputs ++ _tlIoutput else _tlIoutput -- use rule "DefaultRules.ag"(line 396, column 23) _lhsOdefinedAttrs = _hdIdefinedAttrs `Set.union` _tlIdefinedAttrs -- use rule "DefaultRules.ag"(line 109, column 19) _lhsOerrors = _hdIerrors Seq.<> _tlIerrors -- use rule "DefaultRules.ag"(line 395, column 23) _lhsOlocals = _hdIlocals `Set.union` _tlIlocals -- self rule _output = (:) _hdIoutput _tlIoutput -- copy rule (up) _lhsOuniq = _tlIuniq -- copy rule (down) _hdOcon = _lhsIcon -- copy rule (down) _hdOnt = _lhsInt -- copy rule (down) _hdOuniq = _lhsIuniq -- copy rule (down) _tlOcon = _lhsIcon -- copy rule (down) _tlOnt = _lhsInt -- copy rule (chain) _tlOuniq = _hdIuniq ( _hdIcontainsVars,_hdIdefinedAttrs,_hdIerrors,_hdIlocals,_hdIoutput,_hdIoutputs,_hdIuniq) = (hd_ _hdOcon _hdOnt _hdOuniq) ( _tlIdefinedAttrs,_tlIerrors,_tlIlocals,_tlIoutput,_tlIuniq) = (tl_ _tlOcon _tlOnt _tlOuniq) in ( _lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOuniq)))) sem_Rules_Nil :: T_Rules sem_Rules_Nil = (T_Rules (\ _lhsIcon _lhsInt _lhsIuniq -> (let _lhsOdefinedAttrs :: (Set (Identifier,Identifier)) _lhsOerrors :: (Seq Error) _lhsOlocals :: (Set Identifier) _lhsOoutput :: Rules _lhsOuniq :: Int -- use rule "DefaultRules.ag"(line 396, column 23) _lhsOdefinedAttrs = Set.empty -- use rule "DefaultRules.ag"(line 109, column 19) _lhsOerrors = Seq.empty -- use rule "DefaultRules.ag"(line 395, column 23) _lhsOlocals = Set.empty -- self rule _output = [] -- self rule _lhsOoutput = _output -- copy rule (chain) _lhsOuniq = _lhsIuniq in ( _lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOuniq)))) -- 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)))