diff --git a/src-derived/DefaultRules.hs b/src-derived/DefaultRules.hs --- a/src-derived/DefaultRules.hs +++ b/src-derived/DefaultRules.hs @@ -1,2654 +1,2658 @@ {-# OPTIONS_GHC -XBangPatterns #-} --- UUAGC 0.9.38.1 (DefaultRules.ag) -module DefaultRules where -{-# LINE 10 "DefaultRules.ag" #-} - -import qualified List (delete,intersperse) - -import qualified Data.Set as Set -import qualified Data.Map as Map -import Data.Map(Map) -import qualified Data.Sequence as Seq -import Data.Sequence(Seq,(><)) -import UU.Scanner.Position(noPos) -import Pretty -import Maybe -import HsToken -import HsTokenScanner -import Data.List(intersperse) - -import AbstractSyntax -import ErrorMessages - -import Options(Options,modcopy,rename) -{-# LINE 26 "../src-derived/DefaultRules.hs" #-} - -{-# LINE 2 "./AbstractSyntax.ag" #-} - --- AbstractSyntax.ag imports -import Data.Set(Set) -import Data.Map(Map) -import Patterns (Pattern(..),Patterns) -import Expression (Expression(..)) -import CommonTypes -{-# LINE 36 "../src-derived/DefaultRules.hs" #-} - -{-# LINE 2 "./Patterns.ag" #-} - --- Patterns.ag imports -import UU.Scanner.Position(Pos) -import CommonTypes (ConstructorIdent,Identifier) -{-# LINE 43 "../src-derived/DefaultRules.hs" #-} -{-# LINE 61 "DefaultRules.ag" #-} - -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.><) 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) - ] - ) - -{-# LINE 91 "../src-derived/DefaultRules.hs" #-} - -{-# LINE 172 "DefaultRules.ag" #-} - - - - -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 Nothing - (Alias f1 a1 (Underscore noPos) []) - expr - False - origin - False - - -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.singleton (MissingRule nt con fld a) - ) - Just f - | f == _ACHILD -> ( fieldName a - , Seq.singleton (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.singleton (MissingRule nt con fld a) - ) - Just f - | f == _ACHILD -> ( [AGLocal a noPos Nothing] - , Seq.singleton (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 -{-# LINE 244 "../src-derived/DefaultRules.hs" #-} - -{-# LINE 403 "DefaultRules.ag" #-} - -addAugments :: (Identifier, [Expression]) -> [Rule] -> [Rule] -addAugments (_, exprs) rules - | null exprs = rules -addAugments (syn, exprs) rules - = [rule] ++ funRules ++ map modify rules - where - rule = Rule Nothing (Alias _LHS syn (Underscore noPos) []) rhs False "augmented rule" False - rhs = Expression noPos tks - tks = [ HsToken "foldr ($) " noPos, AGLocal substSyn noPos Nothing, HsToken " [" noPos] ++ funs ++ [HsToken "]" noPos] - funs = intersperse (HsToken ", " noPos) (map (\n -> AGLocal n noPos Nothing) funNames) - - substSyn = Ident (show syn ++ "_augmented_syn") (getPos syn) - funNames = zipWith (\i _ -> Ident (show syn ++ "_augmented_f" ++ show i) (getPos syn)) [1..] exprs - funRules = zipWith (\name expr -> Rule Nothing (Alias _LOC name (Underscore noPos) []) expr False "augment function" False) funNames exprs - - modify (Rule mbNm pat rhs owrt origin expl) - | containsSyn pat = Rule mbNm (modifyPat pat) rhs owrt origin expl - modify r = r - - containsSyn (Constr _ pats) = any containsSyn pats - containsSyn (Product _ pats) = any containsSyn pats - containsSyn (Irrefutable pat) = containsSyn pat - containsSyn (Alias field attr pat parts) = (field == _LHS && attr == syn) || containsSyn pat || any containsSyn parts - containsSyn _ = False - - modifyPat (Constr name pats) = Constr name (map modifyPat pats) - modifyPat (Product pos pats) = Product pos (map modifyPat pats) - modifyPat (Irrefutable pat) = Irrefutable (modifyPat pat) - modifyPat (Alias field attr pat parts) - | field == _LHS && attr == syn = Alias _LOC substSyn (modifyPat pat) (map modifyPat parts) - | otherwise = Alias field attr (modifyPat pat) (map modifyPat parts) - modifyPat p = p - -addArounds :: (Identifier, [Expression]) -> [Rule] -> [Rule] -addArounds (_, exprs) rules | null exprs = rules -addArounds (child, exprs) rules - = [rule] ++ funRules ++ rules - where - rule = Rule Nothing (Alias _LOC childLoc (Underscore noPos) []) rhs False "around rule" False - rhs = Expression noPos tks - tks = [ HsToken "\\s -> foldr ($) s " noPos, HsToken " [" noPos] ++ funs ++ [HsToken "]" noPos] - funs = intersperse (HsToken ", " noPos) (map (\n -> AGLocal n noPos Nothing) funNames) - - childLoc = Ident (show child ++ "_around") (getPos child) - funNames = zipWith (\i _ -> Ident (show child ++ "_around_f" ++ show i) (getPos child)) [1..] exprs - funRules = zipWith (\name expr -> Rule Nothing (Alias _LOC name (Underscore noPos) []) expr False "around function" False) funNames exprs - -addMerges :: (Identifier, (Identifier,[Identifier],Expression)) -> [Rule] -> [Rule] -addMerges (target,(_,_,expr)) rules - = rule : rules - where - rule = Rule Nothing (Alias _LOC childLoc (Underscore noPos) []) expr False "merge rule" False - childLoc = Ident (show target ++ "_merge") (getPos target) -{-# LINE 301 "../src-derived/DefaultRules.hs" #-} - -{-# LINE 518 "DefaultRules.ag" #-} - -{- -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 (Just nm) pat expr owrt origin expl) uniq - = let pos = getPos nm - r = Rule Nothing (Alias _LOC (Ident ("_rule_" ++ show nm) pos) (Underscore pos) []) expr owrt origin expl - expr' = Expression pos tks - tks = [AGLocal (Ident ("_rule_" ++ show nm) pos) pos (Just ("Indirection to rule " ++ show nm))] - (rs,uniq') = multiRule (Rule Nothing pat expr' owrt origin False) uniq - in (r:rs, uniq') - -multiRule (Rule Nothing pat expr owrt origin expl) uniq - = let f :: Bool -> (Pattern->Pattern) -> Expression -> Pattern -> Int -> (Pattern, ([Rule], Int)) - f expl' 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 False (us (length xs1)) freshExpr p n1 - in (x2:xs1, rs2++rs1, n2) - (xs9,rs9,n9) = foldr g ([], [], n+1) pats - in ( freshPat - , ( Rule Nothing (w freshPat) e owrt origin expl' : rs9 - , n9 - ) - ) - f expl' w e p n - = ( p - , ( [Rule Nothing (w p) e owrt origin expl'] - , n - ) - ) - in snd (f expl id expr pat uniq) - -{-# LINE 359 "../src-derived/DefaultRules.hs" #-} --- Child ------------------------------------------------------- -{- - visit 0: - inherited attributes: - con : ConstructorIdent - cr : Bool - merged : Set Identifier - nt : NontermIdent - synthesized attributes: - errors : Seq Error - field : (Identifier,Type,Maybe (Maybe Type)) - inherited : Attributes - name : Identifier - output : SELF - synthesized : Attributes - alternatives: - alternative Child: - child name : {Identifier} - child tp : {Type} - child inh : {Attributes} - child syn : {Attributes} - child virtual : {Maybe (Maybe Type)} - visit 0: - local output : _ --} --- cata -sem_Child :: Child -> - T_Child -sem_Child !(Child _name _tp _inh _syn _virtual ) = - (sem_Child_Child _name _tp _inh _syn _virtual ) --- semantic domain -newtype T_Child = T_Child (ConstructorIdent -> - Bool -> - (Set Identifier) -> - NontermIdent -> - ( (Seq Error),( (Identifier,Type,Maybe (Maybe Type)) ),Attributes,Identifier,Child ,Attributes)) -data Inh_Child = Inh_Child {con_Inh_Child :: !(ConstructorIdent),cr_Inh_Child :: !(Bool),merged_Inh_Child :: !((Set Identifier)),nt_Inh_Child :: !(NontermIdent)} -data Syn_Child = Syn_Child {errors_Syn_Child :: !((Seq Error)),field_Syn_Child :: !(( (Identifier,Type,Maybe (Maybe Type)) )),inherited_Syn_Child :: !(Attributes),name_Syn_Child :: !(Identifier),output_Syn_Child :: !(Child ),synthesized_Syn_Child :: !(Attributes)} -wrap_Child :: T_Child -> - Inh_Child -> - Syn_Child -wrap_Child !(T_Child sem ) !(Inh_Child _lhsIcon _lhsIcr _lhsImerged _lhsInt ) = - (let ( !_lhsOerrors,!_lhsOfield,!_lhsOinherited,!_lhsOname,!_lhsOoutput,!_lhsOsynthesized) = sem _lhsIcon _lhsIcr _lhsImerged _lhsInt - in (Syn_Child _lhsOerrors _lhsOfield _lhsOinherited _lhsOname _lhsOoutput _lhsOsynthesized )) -sem_Child_Child :: Identifier -> - Type -> - Attributes -> - Attributes -> - (Maybe (Maybe Type)) -> - T_Child -sem_Child_Child !name_ !tp_ !inh_ !syn_ !virtual_ = - (T_Child (\ (!_lhsIcon) - (!_lhsIcr) - (!_lhsImerged) - (!_lhsInt) -> - (case (({-# LINE 115 "DefaultRules.ag" #-} - Seq.empty - {-# LINE 417 "DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 477 "DefaultRules.ag" #-} - (name_,tp_,virtual_) - {-# LINE 422 "DefaultRules.hs" #-} - )) of - { !_lhsOfield -> - (case (({-# LINE 155 "DefaultRules.ag" #-} - inh_ - {-# LINE 427 "DefaultRules.hs" #-} - )) of - { !_lhsOinherited -> - (case (({-# LINE 146 "DefaultRules.ag" #-} - name_ - {-# LINE 432 "DefaultRules.hs" #-} - )) of - { !_lhsOname -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - Child name_ tp_ inh_ syn_ virtual_ - {-# LINE 437 "DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - _output - {-# LINE 442 "DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - (case (({-# LINE 156 "DefaultRules.ag" #-} - if name_ `Set.member` _lhsImerged - then Map.empty - else syn_ - {-# LINE 449 "DefaultRules.hs" #-} - )) of - { !_lhsOsynthesized -> - ( _lhsOerrors,_lhsOfield,_lhsOinherited,_lhsOname,_lhsOoutput,_lhsOsynthesized) }) }) }) }) }) }) })) ) --- Children ---------------------------------------------------- -{- - visit 0: - inherited attributes: - con : ConstructorIdent - cr : Bool - merged : Set Identifier - nt : NontermIdent - synthesized attributes: - errors : Seq Error - fields : [(Identifier,Type,Maybe (Maybe Type))] - 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 -> - (Set Identifier) -> - NontermIdent -> - ( (Seq Error),([(Identifier,Type,Maybe (Maybe Type))]),([(Identifier, Attributes)]),Children ,([(Identifier, Attributes)]))) -data Inh_Children = Inh_Children {con_Inh_Children :: !(ConstructorIdent),cr_Inh_Children :: !(Bool),merged_Inh_Children :: !((Set Identifier)),nt_Inh_Children :: !(NontermIdent)} -data Syn_Children = Syn_Children {errors_Syn_Children :: !((Seq Error)),fields_Syn_Children :: !(([(Identifier,Type,Maybe (Maybe Type))])),inputs_Syn_Children :: !(([(Identifier, Attributes)])),output_Syn_Children :: !(Children ),outputs_Syn_Children :: !(([(Identifier, Attributes)]))} -wrap_Children :: T_Children -> - Inh_Children -> - Syn_Children -wrap_Children !(T_Children sem ) !(Inh_Children _lhsIcon _lhsIcr _lhsImerged _lhsInt ) = - (let ( !_lhsOerrors,!_lhsOfields,!_lhsOinputs,!_lhsOoutput,!_lhsOoutputs) = sem _lhsIcon _lhsIcr _lhsImerged _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) - (!_lhsImerged) - (!_lhsInt) -> - (case (({-# LINE 34 "DefaultRules.ag" #-} - _lhsInt - {-# LINE 506 "DefaultRules.hs" #-} - )) of - { !_tlOnt -> - (case (({-# LINE 662 "DefaultRules.ag" #-} - _lhsImerged - {-# LINE 511 "DefaultRules.hs" #-} - )) of - { !_tlOmerged -> - (case (({-# LINE 47 "DefaultRules.ag" #-} - _lhsIcr - {-# LINE 516 "DefaultRules.hs" #-} - )) of - { !_tlOcr -> - (case (({-# LINE 35 "DefaultRules.ag" #-} - _lhsIcon - {-# LINE 521 "DefaultRules.hs" #-} - )) of - { !_tlOcon -> - (case (tl_ _tlOcon _tlOcr _tlOmerged _tlOnt ) of - { ( !_tlIerrors,!_tlIfields,!_tlIinputs,!_tlIoutput,!_tlIoutputs) -> - (case (({-# LINE 34 "DefaultRules.ag" #-} - _lhsInt - {-# LINE 528 "DefaultRules.hs" #-} - )) of - { !_hdOnt -> - (case (({-# LINE 662 "DefaultRules.ag" #-} - _lhsImerged - {-# LINE 533 "DefaultRules.hs" #-} - )) of - { !_hdOmerged -> - (case (({-# LINE 47 "DefaultRules.ag" #-} - _lhsIcr - {-# LINE 538 "DefaultRules.hs" #-} - )) of - { !_hdOcr -> - (case (({-# LINE 35 "DefaultRules.ag" #-} - _lhsIcon - {-# LINE 543 "DefaultRules.hs" #-} - )) of - { !_hdOcon -> - (case (hd_ _hdOcon _hdOcr _hdOmerged _hdOnt ) of - { ( !_hdIerrors,!_hdIfield,!_hdIinherited,!_hdIname,!_hdIoutput,!_hdIsynthesized) -> - (case (({-# LINE 115 "DefaultRules.ag" #-} - _hdIerrors Seq.>< _tlIerrors - {-# LINE 550 "DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 473 "DefaultRules.ag" #-} - _hdIfield : _tlIfields - {-# LINE 555 "DefaultRules.hs" #-} - )) of - { !_lhsOfields -> - (case (({-# LINE 161 "DefaultRules.ag" #-} - (_hdIname, _hdIinherited) : _tlIinputs - {-# LINE 560 "DefaultRules.hs" #-} - )) of - { !_lhsOinputs -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - (:) _hdIoutput _tlIoutput - {-# LINE 565 "DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - _output - {-# LINE 570 "DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - (case (({-# LINE 162 "DefaultRules.ag" #-} - (_hdIname, _hdIsynthesized) : _tlIoutputs - {-# LINE 575 "DefaultRules.hs" #-} - )) of - { !_lhsOoutputs -> - ( _lhsOerrors,_lhsOfields,_lhsOinputs,_lhsOoutput,_lhsOoutputs) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Children_Nil :: T_Children -sem_Children_Nil = - (T_Children (\ (!_lhsIcon) - (!_lhsIcr) - (!_lhsImerged) - (!_lhsInt) -> - (case (({-# LINE 115 "DefaultRules.ag" #-} - Seq.empty - {-# LINE 587 "DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 474 "DefaultRules.ag" #-} - [] - {-# LINE 592 "DefaultRules.hs" #-} - )) of - { !_lhsOfields -> - (case (({-# LINE 163 "DefaultRules.ag" #-} - [] - {-# LINE 597 "DefaultRules.hs" #-} - )) of - { !_lhsOinputs -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - [] - {-# LINE 602 "DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - _output - {-# LINE 607 "DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - (case (({-# LINE 164 "DefaultRules.ag" #-} - [] - {-# LINE 612 "DefaultRules.hs" #-} - )) of - { !_lhsOoutputs -> - ( _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} - child quantMap : {QuantMap} - child uniqueMap : {UniqueMap} - child augmentsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} - child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} - child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))} - visit 0: - local output : _ --} --- cata -sem_Grammar :: Grammar -> - T_Grammar -sem_Grammar !(Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap ) = - (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts ) _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap ) --- semantic domain -newtype T_Grammar = T_Grammar (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 -> - Inh_Grammar -> - Syn_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 -> - QuantMap -> - UniqueMap -> - (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> - (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> - (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> - T_Grammar -sem_Grammar_Grammar !typeSyns_ !useMap_ !derivings_ !wrappers_ !(T_Nonterminals nonts_ ) !pragmas_ !manualAttrOrderMap_ !paramMap_ !contextMap_ !quantMap_ !uniqueMap_ !augmentsMap_ !aroundsMap_ !mergeMap_ = - (T_Grammar (\ (!_lhsIoptions) -> - (case (({-# LINE 664 "DefaultRules.ag" #-} - mergeMap_ - {-# LINE 678 "DefaultRules.hs" #-} - )) of - { !_nontsOmergesIn -> - (case (({-# LINE 583 "DefaultRules.ag" #-} - manualAttrOrderMap_ - {-# LINE 683 "DefaultRules.hs" #-} - )) of - { !_nontsOmanualAttrOrderMap -> - (case (({-# LINE 150 "DefaultRules.ag" #-} - typeSyns_ - {-# LINE 688 "DefaultRules.hs" #-} - )) of - { !_nontsOtypeSyns -> - (case (({-# LINE 148 "DefaultRules.ag" #-} - useMap_ - {-# LINE 693 "DefaultRules.hs" #-} - )) of - { !_nontsOuseMap -> - (case (({-# LINE 50 "DefaultRules.ag" #-} - modcopy _lhsIoptions - {-# LINE 698 "DefaultRules.hs" #-} - )) of - { !_nontsOcr -> - (case (({-# LINE 49 "DefaultRules.ag" #-} - rename _lhsIoptions - {-# LINE 703 "DefaultRules.hs" #-} - )) of - { !_nontsOo_rename -> - (case (nonts_ ) of - { ( !_nontsIcollect_nts,!T_Nonterminals_1 nonts_1) -> - (case (({-# LINE 656 "DefaultRules.ag" #-} - aroundsMap_ - {-# LINE 710 "DefaultRules.hs" #-} - )) of - { !_nontsOaroundsIn -> - (case (({-# LINE 649 "DefaultRules.ag" #-} - augmentsMap_ - {-# LINE 715 "DefaultRules.hs" #-} - )) of - { !_nontsOaugmentsIn -> - (case (({-# LINE 494 "DefaultRules.ag" #-} - 1 - {-# LINE 720 "DefaultRules.hs" #-} - )) of - { !_nontsOuniq -> - (case (({-# LINE 127 "DefaultRules.ag" #-} - _nontsIcollect_nts - {-# LINE 725 "DefaultRules.hs" #-} - )) of - { !_nontsOnonterminals -> - (case (nonts_1 _nontsOaroundsIn _nontsOaugmentsIn _nontsOcr _nontsOmanualAttrOrderMap _nontsOmergesIn _nontsOnonterminals _nontsOo_rename _nontsOtypeSyns _nontsOuniq _nontsOuseMap ) of - { ( !_nontsIerrors,!_nontsIoutput,!_nontsIuniq) -> - (case (({-# LINE 115 "DefaultRules.ag" #-} - _nontsIerrors - {-# LINE 732 "DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - Grammar typeSyns_ useMap_ derivings_ wrappers_ _nontsIoutput pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ - {-# LINE 737 "DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - _output - {-# LINE 742 "DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) --- Nonterminal ------------------------------------------------- -{- - visit 0: - synthesized attribute: - collect_nts : Set NontermIdent - visit 1: - inherited attributes: - aroundsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) - augmentsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) - cr : Bool - manualAttrOrderMap : AttrOrderMap - mergesIn : Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) - nonterminals : Set NontermIdent - o_rename : Bool - typeSyns : TypeSyns - useMap : UseMap - chained attribute: - uniq : Int - synthesized attributes: - errors : Seq Error - output : SELF - alternatives: - alternative Nonterminal: - child nt : {NontermIdent} - child params : {[Identifier]} - child inh : {Attributes} - child syn : {Attributes} - child prods : Productions - visit 1: - local mergesIn : _ - local augmentsIn : _ - local aroundsIn : _ - 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 (( (Set NontermIdent),T_Nonterminal_1 )) -newtype T_Nonterminal_1 = T_Nonterminal_1 ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> - (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> - Bool -> - AttrOrderMap -> - (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) -> - (Set NontermIdent) -> - Bool -> - TypeSyns -> - Int -> - UseMap -> - ( (Seq Error),Nonterminal ,Int)) -data Inh_Nonterminal = Inh_Nonterminal {aroundsIn_Inh_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),augmentsIn_Inh_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),cr_Inh_Nonterminal :: !(Bool),manualAttrOrderMap_Inh_Nonterminal :: !(AttrOrderMap),mergesIn_Inh_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))))),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 -> - Inh_Nonterminal -> - Syn_Nonterminal -wrap_Nonterminal !(T_Nonterminal sem ) !(Inh_Nonterminal _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap ) = - (let ( !_lhsOcollect_nts,!T_Nonterminal_1 sem_1) = sem - ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = sem_1 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsImanualAttrOrderMap _lhsImergesIn _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 (case (({-# LINE 123 "DefaultRules.ag" #-} - Set.singleton nt_ - {-# LINE 816 "DefaultRules.hs" #-} - )) of - { !_lhsOcollect_nts -> - (case ((let sem_Nonterminal_Nonterminal_1 :: T_Nonterminal_1 - sem_Nonterminal_Nonterminal_1 = - (T_Nonterminal_1 (\ (!_lhsIaroundsIn) - (!_lhsIaugmentsIn) - (!_lhsIcr) - (!_lhsImanualAttrOrderMap) - (!_lhsImergesIn) - (!_lhsInonterminals) - (!_lhsIo_rename) - (!_lhsItypeSyns) - (!_lhsIuniq) - (!_lhsIuseMap) -> - (case (({-# LINE 55 "DefaultRules.ag" #-} - _lhsItypeSyns - {-# LINE 833 "DefaultRules.hs" #-} - )) of - { !_prodsOtypeSyns -> - (case (({-# LINE 43 "DefaultRules.ag" #-} - _lhsIo_rename - {-# LINE 838 "DefaultRules.hs" #-} - )) of - { !_prodsOo_rename -> - (case (({-# LINE 665 "DefaultRules.ag" #-} - Map.findWithDefault Map.empty nt_ _lhsImergesIn - {-# LINE 843 "DefaultRules.hs" #-} - )) of - { !_mergesIn -> - (case (({-# LINE 661 "DefaultRules.ag" #-} - _mergesIn - {-# LINE 848 "DefaultRules.hs" #-} - )) of - { !_prodsOmergesIn -> - (case (({-# LINE 579 "DefaultRules.ag" #-} - _lhsImanualAttrOrderMap - {-# LINE 853 "DefaultRules.hs" #-} - )) of - { !_prodsOmanualAttrOrderMap -> - (case (({-# LINE 44 "DefaultRules.ag" #-} - _lhsIcr - {-# LINE 858 "DefaultRules.hs" #-} - )) of - { !_prodsOcr -> - (case (({-# LINE 152 "DefaultRules.ag" #-} - nt_ - {-# LINE 863 "DefaultRules.hs" #-} - )) of - { !_prodsOnt -> - (case (({-# LINE 140 "DefaultRules.ag" #-} - Map.findWithDefault Map.empty nt_ _lhsIuseMap - {-# LINE 868 "DefaultRules.hs" #-} - )) of - { !_prodsOuseMap -> - (case (({-# LINE 139 "DefaultRules.ag" #-} - syn_ - {-# LINE 873 "DefaultRules.hs" #-} - )) of - { !_prodsOsyn -> - (case (({-# LINE 138 "DefaultRules.ag" #-} - inh_ - {-# LINE 878 "DefaultRules.hs" #-} - )) of - { !_prodsOinh -> - (case (({-# LINE 491 "DefaultRules.ag" #-} - _lhsIuniq - {-# LINE 883 "DefaultRules.hs" #-} - )) of - { !_prodsOuniq -> - (case (({-# LINE 125 "DefaultRules.ag" #-} - _lhsInonterminals - {-# LINE 888 "DefaultRules.hs" #-} - )) of - { !_prodsOnonterminals -> - (case (({-# LINE 650 "DefaultRules.ag" #-} - Map.findWithDefault Map.empty nt_ _lhsIaugmentsIn - {-# LINE 893 "DefaultRules.hs" #-} - )) of - { !_augmentsIn -> - (case (({-# LINE 647 "DefaultRules.ag" #-} - _augmentsIn - {-# LINE 898 "DefaultRules.hs" #-} - )) of - { !_prodsOaugmentsIn -> - (case (({-# LINE 657 "DefaultRules.ag" #-} - Map.findWithDefault Map.empty nt_ _lhsIaroundsIn - {-# LINE 903 "DefaultRules.hs" #-} - )) of - { !_aroundsIn -> - (case (({-# LINE 654 "DefaultRules.ag" #-} - _aroundsIn - {-# LINE 908 "DefaultRules.hs" #-} - )) of - { !_prodsOaroundsIn -> - (case (prods_ _prodsOaroundsIn _prodsOaugmentsIn _prodsOcr _prodsOinh _prodsOmanualAttrOrderMap _prodsOmergesIn _prodsOnonterminals _prodsOnt _prodsOo_rename _prodsOsyn _prodsOtypeSyns _prodsOuniq _prodsOuseMap ) of - { ( !_prodsIerrors,!_prodsIoutput,!_prodsIuniq) -> - (case (({-# LINE 115 "DefaultRules.ag" #-} - _prodsIerrors - {-# LINE 915 "DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - Nonterminal nt_ params_ inh_ syn_ _prodsIoutput - {-# LINE 920 "DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - _output - {-# LINE 925 "DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - (case (({-# LINE 491 "DefaultRules.ag" #-} - _prodsIuniq - {-# LINE 930 "DefaultRules.hs" #-} - )) of - { !_lhsOuniq -> - ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) - in sem_Nonterminal_Nonterminal_1)) of - { ( !sem_Nonterminal_1) -> - ( _lhsOcollect_nts,sem_Nonterminal_1) }) }) ) --- Nonterminals ------------------------------------------------ -{- - visit 0: - synthesized attribute: - collect_nts : Set NontermIdent - visit 1: - inherited attributes: - aroundsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) - augmentsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) - cr : Bool - manualAttrOrderMap : AttrOrderMap - mergesIn : Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) - nonterminals : Set NontermIdent - o_rename : Bool - typeSyns : TypeSyns - useMap : UseMap - chained attribute: - uniq : Int - synthesized attributes: - errors : Seq Error - output : SELF - alternatives: - alternative Cons: - child hd : Nonterminal - child tl : Nonterminals - visit 1: - local output : _ - alternative Nil: - visit 1: - local output : _ --} --- cata -sem_Nonterminals :: Nonterminals -> - T_Nonterminals -sem_Nonterminals !list = - (Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list) ) --- semantic domain -newtype T_Nonterminals = T_Nonterminals (( (Set NontermIdent),T_Nonterminals_1 )) -newtype T_Nonterminals_1 = T_Nonterminals_1 ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> - (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> - Bool -> - AttrOrderMap -> - (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) -> - (Set NontermIdent) -> - Bool -> - TypeSyns -> - Int -> - UseMap -> - ( (Seq Error),Nonterminals ,Int)) -data Inh_Nonterminals = Inh_Nonterminals {aroundsIn_Inh_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),augmentsIn_Inh_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),cr_Inh_Nonterminals :: !(Bool),manualAttrOrderMap_Inh_Nonterminals :: !(AttrOrderMap),mergesIn_Inh_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))))),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 -> - Inh_Nonterminals -> - Syn_Nonterminals -wrap_Nonterminals !(T_Nonterminals sem ) !(Inh_Nonterminals _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap ) = - (let ( !_lhsOcollect_nts,!T_Nonterminals_1 sem_1) = sem - ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = sem_1 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsImanualAttrOrderMap _lhsImergesIn _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 (case (tl_ ) of - { ( !_tlIcollect_nts,!T_Nonterminals_1 tl_1) -> - (case (hd_ ) of - { ( !_hdIcollect_nts,!T_Nonterminal_1 hd_1) -> - (case (({-# LINE 121 "DefaultRules.ag" #-} - _hdIcollect_nts `Set.union` _tlIcollect_nts - {-# LINE 1005 "DefaultRules.hs" #-} - )) of - { !_lhsOcollect_nts -> - (case ((let sem_Nonterminals_Cons_1 :: T_Nonterminals_1 - sem_Nonterminals_Cons_1 = - (T_Nonterminals_1 (\ (!_lhsIaroundsIn) - (!_lhsIaugmentsIn) - (!_lhsIcr) - (!_lhsImanualAttrOrderMap) - (!_lhsImergesIn) - (!_lhsInonterminals) - (!_lhsIo_rename) - (!_lhsItypeSyns) - (!_lhsIuniq) - (!_lhsIuseMap) -> - (case (({-# LINE 134 "DefaultRules.ag" #-} - _lhsIuseMap - {-# LINE 1022 "DefaultRules.hs" #-} - )) of - { !_tlOuseMap -> - (case (({-# LINE 55 "DefaultRules.ag" #-} - _lhsItypeSyns - {-# LINE 1027 "DefaultRules.hs" #-} - )) of - { !_tlOtypeSyns -> - (case (({-# LINE 43 "DefaultRules.ag" #-} - _lhsIo_rename - {-# LINE 1032 "DefaultRules.hs" #-} - )) of - { !_tlOo_rename -> - (case (({-# LINE 660 "DefaultRules.ag" #-} - _lhsImergesIn - {-# LINE 1037 "DefaultRules.hs" #-} - )) of - { !_tlOmergesIn -> - (case (({-# LINE 579 "DefaultRules.ag" #-} - _lhsImanualAttrOrderMap - {-# LINE 1042 "DefaultRules.hs" #-} - )) of - { !_tlOmanualAttrOrderMap -> - (case (({-# LINE 44 "DefaultRules.ag" #-} - _lhsIcr - {-# LINE 1047 "DefaultRules.hs" #-} - )) of - { !_tlOcr -> - (case (({-# LINE 134 "DefaultRules.ag" #-} - _lhsIuseMap - {-# LINE 1052 "DefaultRules.hs" #-} - )) of - { !_hdOuseMap -> - (case (({-# LINE 55 "DefaultRules.ag" #-} - _lhsItypeSyns - {-# LINE 1057 "DefaultRules.hs" #-} - )) of - { !_hdOtypeSyns -> - (case (({-# LINE 43 "DefaultRules.ag" #-} - _lhsIo_rename - {-# LINE 1062 "DefaultRules.hs" #-} - )) of - { !_hdOo_rename -> - (case (({-# LINE 660 "DefaultRules.ag" #-} - _lhsImergesIn - {-# LINE 1067 "DefaultRules.hs" #-} - )) of - { !_hdOmergesIn -> - (case (({-# LINE 579 "DefaultRules.ag" #-} - _lhsImanualAttrOrderMap - {-# LINE 1072 "DefaultRules.hs" #-} - )) of - { !_hdOmanualAttrOrderMap -> - (case (({-# LINE 44 "DefaultRules.ag" #-} - _lhsIcr - {-# LINE 1077 "DefaultRules.hs" #-} - )) of - { !_hdOcr -> - (case (({-# LINE 491 "DefaultRules.ag" #-} - _lhsIuniq - {-# LINE 1082 "DefaultRules.hs" #-} - )) of - { !_hdOuniq -> - (case (({-# LINE 125 "DefaultRules.ag" #-} - _lhsInonterminals - {-# LINE 1087 "DefaultRules.hs" #-} - )) of - { !_hdOnonterminals -> - (case (({-# LINE 646 "DefaultRules.ag" #-} - _lhsIaugmentsIn - {-# LINE 1092 "DefaultRules.hs" #-} - )) of - { !_hdOaugmentsIn -> - (case (({-# LINE 653 "DefaultRules.ag" #-} - _lhsIaroundsIn - {-# LINE 1097 "DefaultRules.hs" #-} - )) of - { !_hdOaroundsIn -> - (case (hd_1 _hdOaroundsIn _hdOaugmentsIn _hdOcr _hdOmanualAttrOrderMap _hdOmergesIn _hdOnonterminals _hdOo_rename _hdOtypeSyns _hdOuniq _hdOuseMap ) of - { ( !_hdIerrors,!_hdIoutput,!_hdIuniq) -> - (case (({-# LINE 491 "DefaultRules.ag" #-} - _hdIuniq - {-# LINE 1104 "DefaultRules.hs" #-} - )) of - { !_tlOuniq -> - (case (({-# LINE 125 "DefaultRules.ag" #-} - _lhsInonterminals - {-# LINE 1109 "DefaultRules.hs" #-} - )) of - { !_tlOnonterminals -> - (case (({-# LINE 646 "DefaultRules.ag" #-} - _lhsIaugmentsIn - {-# LINE 1114 "DefaultRules.hs" #-} - )) of - { !_tlOaugmentsIn -> - (case (({-# LINE 653 "DefaultRules.ag" #-} - _lhsIaroundsIn - {-# LINE 1119 "DefaultRules.hs" #-} - )) of - { !_tlOaroundsIn -> - (case (tl_1 _tlOaroundsIn _tlOaugmentsIn _tlOcr _tlOmanualAttrOrderMap _tlOmergesIn _tlOnonterminals _tlOo_rename _tlOtypeSyns _tlOuniq _tlOuseMap ) of - { ( !_tlIerrors,!_tlIoutput,!_tlIuniq) -> - (case (({-# LINE 115 "DefaultRules.ag" #-} - _hdIerrors Seq.>< _tlIerrors - {-# LINE 1126 "DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - (:) _hdIoutput _tlIoutput - {-# LINE 1131 "DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - _output - {-# LINE 1136 "DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - (case (({-# LINE 491 "DefaultRules.ag" #-} - _tlIuniq - {-# LINE 1141 "DefaultRules.hs" #-} - )) of - { !_lhsOuniq -> - ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) - in sem_Nonterminals_Cons_1)) of - { ( !sem_Nonterminals_1) -> - ( _lhsOcollect_nts,sem_Nonterminals_1) }) }) }) }) ) -sem_Nonterminals_Nil :: T_Nonterminals -sem_Nonterminals_Nil = - (T_Nonterminals (case (({-# LINE 121 "DefaultRules.ag" #-} - Set.empty - {-# LINE 1152 "DefaultRules.hs" #-} - )) of - { !_lhsOcollect_nts -> - (case ((let sem_Nonterminals_Nil_1 :: T_Nonterminals_1 - sem_Nonterminals_Nil_1 = - (T_Nonterminals_1 (\ (!_lhsIaroundsIn) - (!_lhsIaugmentsIn) - (!_lhsIcr) - (!_lhsImanualAttrOrderMap) - (!_lhsImergesIn) - (!_lhsInonterminals) - (!_lhsIo_rename) - (!_lhsItypeSyns) - (!_lhsIuniq) - (!_lhsIuseMap) -> - (case (({-# LINE 115 "DefaultRules.ag" #-} - Seq.empty - {-# LINE 1169 "DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - [] - {-# LINE 1174 "DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - _output - {-# LINE 1179 "DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - (case (({-# LINE 491 "DefaultRules.ag" #-} - _lhsIuniq - {-# LINE 1184 "DefaultRules.hs" #-} - )) of - { !_lhsOuniq -> - ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) })) ) - in sem_Nonterminals_Nil_1)) of - { ( !sem_Nonterminals_1) -> - ( _lhsOcollect_nts,sem_Nonterminals_1) }) }) ) --- 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 -> - Inh_Pattern -> - Syn_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) -> - (case (({-# LINE 485 "DefaultRules.ag" #-} - True - {-# LINE 1271 "DefaultRules.hs" #-} - )) of - { !_lhsOcontainsVars -> - (case (({-# LINE 34 "DefaultRules.ag" #-} - _lhsInt - {-# LINE 1276 "DefaultRules.hs" #-} - )) of - { !_partsOnt -> - (case (({-# LINE 35 "DefaultRules.ag" #-} - _lhsIcon - {-# LINE 1281 "DefaultRules.hs" #-} - )) of - { !_partsOcon -> - (case (parts_ _partsOcon _partsOnt ) of - { ( !_partsIcontainsVars,!_partsIcopy,!_partsIdefinedAttrs,!_partsIerrors,!_partsIlocals,!_partsIoutput) -> - (case (({-# LINE 34 "DefaultRules.ag" #-} - _lhsInt - {-# LINE 1288 "DefaultRules.hs" #-} - )) of - { !_patOnt -> - (case (({-# LINE 35 "DefaultRules.ag" #-} - _lhsIcon - {-# LINE 1293 "DefaultRules.hs" #-} - )) of - { !_patOcon -> - (case (pat_ _patOcon _patOnt ) of - { ( !_patIcontainsVars,!_patIcopy,!_patIdefinedAttrs,!_patIerrors,!_patIlocals,!_patIoutput) -> - (case (({-# LINE 23 "./Patterns.ag" #-} - Alias field_ attr_ _patIcopy _partsIcopy - {-# LINE 1300 "DefaultRules.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "./Patterns.ag" #-} - _copy - {-# LINE 1305 "DefaultRules.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 467 "DefaultRules.ag" #-} - Set.insert (field_,attr_) _patIdefinedAttrs - {-# LINE 1310 "DefaultRules.hs" #-} - )) of - { !_lhsOdefinedAttrs -> - (case (({-# LINE 115 "DefaultRules.ag" #-} - _patIerrors Seq.>< _partsIerrors - {-# LINE 1315 "DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 468 "DefaultRules.ag" #-} - if field_ == _LOC - then Set.insert attr_ _patIlocals - else _patIlocals - {-# LINE 1322 "DefaultRules.hs" #-} - )) of - { !_lhsOlocals -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - Alias field_ attr_ _patIoutput _partsIoutput - {-# LINE 1327 "DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - _output - {-# LINE 1332 "DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - ( _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) -> - (case (({-# LINE 34 "DefaultRules.ag" #-} - _lhsInt - {-# LINE 1344 "DefaultRules.hs" #-} - )) of - { !_patsOnt -> - (case (({-# LINE 35 "DefaultRules.ag" #-} - _lhsIcon - {-# LINE 1349 "DefaultRules.hs" #-} - )) of - { !_patsOcon -> - (case (pats_ _patsOcon _patsOnt ) of - { ( !_patsIcontainsVars,!_patsIcopy,!_patsIdefinedAttrs,!_patsIerrors,!_patsIlocals,!_patsIoutput) -> - (case (({-# LINE 482 "DefaultRules.ag" #-} - _patsIcontainsVars - {-# LINE 1356 "DefaultRules.hs" #-} - )) of - { !_lhsOcontainsVars -> - (case (({-# LINE 23 "./Patterns.ag" #-} - Constr name_ _patsIcopy - {-# LINE 1361 "DefaultRules.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "./Patterns.ag" #-} - _copy - {-# LINE 1366 "DefaultRules.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 462 "DefaultRules.ag" #-} - _patsIdefinedAttrs - {-# LINE 1371 "DefaultRules.hs" #-} - )) of - { !_lhsOdefinedAttrs -> - (case (({-# LINE 115 "DefaultRules.ag" #-} - _patsIerrors - {-# LINE 1376 "DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 461 "DefaultRules.ag" #-} - _patsIlocals - {-# LINE 1381 "DefaultRules.hs" #-} - )) of - { !_lhsOlocals -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - Constr name_ _patsIoutput - {-# LINE 1386 "DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - _output - {-# LINE 1391 "DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Pattern_Irrefutable :: T_Pattern -> - T_Pattern -sem_Pattern_Irrefutable !(T_Pattern pat_ ) = - (T_Pattern (\ (!_lhsIcon) - (!_lhsInt) -> - (case (({-# LINE 34 "DefaultRules.ag" #-} - _lhsInt - {-# LINE 1402 "DefaultRules.hs" #-} - )) of - { !_patOnt -> - (case (({-# LINE 35 "DefaultRules.ag" #-} - _lhsIcon - {-# LINE 1407 "DefaultRules.hs" #-} - )) of - { !_patOcon -> - (case (pat_ _patOcon _patOnt ) of - { ( !_patIcontainsVars,!_patIcopy,!_patIdefinedAttrs,!_patIerrors,!_patIlocals,!_patIoutput) -> - (case (({-# LINE 482 "DefaultRules.ag" #-} - _patIcontainsVars - {-# LINE 1414 "DefaultRules.hs" #-} - )) of - { !_lhsOcontainsVars -> - (case (({-# LINE 23 "./Patterns.ag" #-} - Irrefutable _patIcopy - {-# LINE 1419 "DefaultRules.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "./Patterns.ag" #-} - _copy - {-# LINE 1424 "DefaultRules.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 462 "DefaultRules.ag" #-} - _patIdefinedAttrs - {-# LINE 1429 "DefaultRules.hs" #-} - )) of - { !_lhsOdefinedAttrs -> - (case (({-# LINE 115 "DefaultRules.ag" #-} - _patIerrors - {-# LINE 1434 "DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 461 "DefaultRules.ag" #-} - _patIlocals - {-# LINE 1439 "DefaultRules.hs" #-} - )) of - { !_lhsOlocals -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - Irrefutable _patIoutput - {-# LINE 1444 "DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - _output - {-# LINE 1449 "DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - ( _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) -> - (case (({-# LINE 34 "DefaultRules.ag" #-} - _lhsInt - {-# LINE 1461 "DefaultRules.hs" #-} - )) of - { !_patsOnt -> - (case (({-# LINE 35 "DefaultRules.ag" #-} - _lhsIcon - {-# LINE 1466 "DefaultRules.hs" #-} - )) of - { !_patsOcon -> - (case (pats_ _patsOcon _patsOnt ) of - { ( !_patsIcontainsVars,!_patsIcopy,!_patsIdefinedAttrs,!_patsIerrors,!_patsIlocals,!_patsIoutput) -> - (case (({-# LINE 482 "DefaultRules.ag" #-} - _patsIcontainsVars - {-# LINE 1473 "DefaultRules.hs" #-} - )) of - { !_lhsOcontainsVars -> - (case (({-# LINE 23 "./Patterns.ag" #-} - Product pos_ _patsIcopy - {-# LINE 1478 "DefaultRules.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "./Patterns.ag" #-} - _copy - {-# LINE 1483 "DefaultRules.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 462 "DefaultRules.ag" #-} - _patsIdefinedAttrs - {-# LINE 1488 "DefaultRules.hs" #-} - )) of - { !_lhsOdefinedAttrs -> - (case (({-# LINE 115 "DefaultRules.ag" #-} - _patsIerrors - {-# LINE 1493 "DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 461 "DefaultRules.ag" #-} - _patsIlocals - {-# LINE 1498 "DefaultRules.hs" #-} - )) of - { !_lhsOlocals -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - Product pos_ _patsIoutput - {-# LINE 1503 "DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - _output - {-# LINE 1508 "DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Pattern_Underscore :: Pos -> - T_Pattern -sem_Pattern_Underscore !pos_ = - (T_Pattern (\ (!_lhsIcon) - (!_lhsInt) -> - (case (({-# LINE 482 "DefaultRules.ag" #-} - False - {-# LINE 1519 "DefaultRules.hs" #-} - )) of - { !_lhsOcontainsVars -> - (case (({-# LINE 23 "./Patterns.ag" #-} - Underscore pos_ - {-# LINE 1524 "DefaultRules.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "./Patterns.ag" #-} - _copy - {-# LINE 1529 "DefaultRules.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 462 "DefaultRules.ag" #-} - Set.empty - {-# LINE 1534 "DefaultRules.hs" #-} - )) of - { !_lhsOdefinedAttrs -> - (case (({-# LINE 115 "DefaultRules.ag" #-} - Seq.empty - {-# LINE 1539 "DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 461 "DefaultRules.ag" #-} - Set.empty - {-# LINE 1544 "DefaultRules.hs" #-} - )) of - { !_lhsOlocals -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - Underscore pos_ - {-# LINE 1549 "DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - _output - {-# LINE 1554 "DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - ( _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 -> - Inh_Patterns -> - Syn_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) -> - (case (({-# LINE 34 "DefaultRules.ag" #-} - _lhsInt - {-# LINE 1608 "DefaultRules.hs" #-} - )) of - { !_tlOnt -> - (case (({-# LINE 35 "DefaultRules.ag" #-} - _lhsIcon - {-# LINE 1613 "DefaultRules.hs" #-} - )) of - { !_tlOcon -> - (case (tl_ _tlOcon _tlOnt ) of - { ( !_tlIcontainsVars,!_tlIcopy,!_tlIdefinedAttrs,!_tlIerrors,!_tlIlocals,!_tlIoutput) -> - (case (({-# LINE 34 "DefaultRules.ag" #-} - _lhsInt - {-# LINE 1620 "DefaultRules.hs" #-} - )) of - { !_hdOnt -> - (case (({-# LINE 35 "DefaultRules.ag" #-} - _lhsIcon - {-# LINE 1625 "DefaultRules.hs" #-} - )) of - { !_hdOcon -> - (case (hd_ _hdOcon _hdOnt ) of - { ( !_hdIcontainsVars,!_hdIcopy,!_hdIdefinedAttrs,!_hdIerrors,!_hdIlocals,!_hdIoutput) -> - (case (({-# LINE 482 "DefaultRules.ag" #-} - _hdIcontainsVars || _tlIcontainsVars - {-# LINE 1632 "DefaultRules.hs" #-} - )) of - { !_lhsOcontainsVars -> - (case (({-# LINE 23 "./Patterns.ag" #-} - (:) _hdIcopy _tlIcopy - {-# LINE 1637 "DefaultRules.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "./Patterns.ag" #-} - _copy - {-# LINE 1642 "DefaultRules.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 462 "DefaultRules.ag" #-} - _hdIdefinedAttrs `Set.union` _tlIdefinedAttrs - {-# LINE 1647 "DefaultRules.hs" #-} - )) of - { !_lhsOdefinedAttrs -> - (case (({-# LINE 115 "DefaultRules.ag" #-} - _hdIerrors Seq.>< _tlIerrors - {-# LINE 1652 "DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 461 "DefaultRules.ag" #-} - _hdIlocals `Set.union` _tlIlocals - {-# LINE 1657 "DefaultRules.hs" #-} - )) of - { !_lhsOlocals -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - (:) _hdIoutput _tlIoutput - {-# LINE 1662 "DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - _output - {-# LINE 1667 "DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Patterns_Nil :: T_Patterns -sem_Patterns_Nil = - (T_Patterns (\ (!_lhsIcon) - (!_lhsInt) -> - (case (({-# LINE 482 "DefaultRules.ag" #-} - False - {-# LINE 1677 "DefaultRules.hs" #-} - )) of - { !_lhsOcontainsVars -> - (case (({-# LINE 23 "./Patterns.ag" #-} - [] - {-# LINE 1682 "DefaultRules.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "./Patterns.ag" #-} - _copy - {-# LINE 1687 "DefaultRules.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 462 "DefaultRules.ag" #-} - Set.empty - {-# LINE 1692 "DefaultRules.hs" #-} - )) of - { !_lhsOdefinedAttrs -> - (case (({-# LINE 115 "DefaultRules.ag" #-} - Seq.empty - {-# LINE 1697 "DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 461 "DefaultRules.ag" #-} - Set.empty - {-# LINE 1702 "DefaultRules.hs" #-} - )) of - { !_lhsOlocals -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - [] - {-# LINE 1707 "DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - _output - {-# LINE 1712 "DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) })) ) --- Production -------------------------------------------------- -{- - visit 0: - inherited attributes: - aroundsIn : Map ConstructorIdent (Map Identifier [Expression]) - augmentsIn : Map ConstructorIdent (Map Identifier [Expression]) - cr : Bool - inh : Attributes - manualAttrOrderMap : AttrOrderMap - mergesIn : Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)) - 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 mergesIn : _ - local merged : _ - local orderDeps : _ - local orderErrs : _ - local _tup1 : _ - local errs : _ - local aroundsIn : _ - local augmentsIn : _ - local newRls : _ - local extra1 : _ - local extra2 : _ - local extra3 : _ --} --- cata -sem_Production :: Production -> - T_Production -sem_Production !(Production _con _children _rules _typeSigs ) = - (sem_Production_Production _con (sem_Children _children ) (sem_Rules _rules ) (sem_TypeSigs _typeSigs ) ) --- semantic domain -newtype T_Production = T_Production ((Map ConstructorIdent (Map Identifier [Expression])) -> - (Map ConstructorIdent (Map Identifier [Expression])) -> - Bool -> - Attributes -> - AttrOrderMap -> - (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) -> - (Set NontermIdent) -> - NontermIdent -> - Bool -> - Attributes -> - TypeSyns -> - Int -> - (Map Identifier (String,String,String)) -> - ( (Seq Error),Production ,Int)) -data Inh_Production = Inh_Production {aroundsIn_Inh_Production :: !((Map ConstructorIdent (Map Identifier [Expression]))),augmentsIn_Inh_Production :: !((Map ConstructorIdent (Map Identifier [Expression]))),cr_Inh_Production :: !(Bool),inh_Inh_Production :: !(Attributes),manualAttrOrderMap_Inh_Production :: !(AttrOrderMap),mergesIn_Inh_Production :: !((Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))),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 -> - Inh_Production -> - Syn_Production -wrap_Production !(T_Production sem ) !(Inh_Production _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap ) = - (let ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = sem _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsImergesIn _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 (\ (!_lhsIaroundsIn) - (!_lhsIaugmentsIn) - (!_lhsIcr) - (!_lhsIinh) - (!_lhsImanualAttrOrderMap) - (!_lhsImergesIn) - (!_lhsInonterminals) - (!_lhsInt) - (!_lhsIo_rename) - (!_lhsIsyn) - (!_lhsItypeSyns) - (!_lhsIuniq) - (!_lhsIuseMap) -> - (case (({-# LINE 666 "DefaultRules.ag" #-} - Map.findWithDefault Map.empty con_ _lhsImergesIn - {-# LINE 1806 "DefaultRules.hs" #-} - )) of - { !_mergesIn -> - (case (({-# LINE 667 "DefaultRules.ag" #-} - Set.fromList [ c | (_,cs,_) <- Map.elems _mergesIn , c <- cs ] - {-# LINE 1811 "DefaultRules.hs" #-} - )) of - { !_merged -> - (case (({-# LINE 662 "DefaultRules.ag" #-} - _merged - {-# LINE 1816 "DefaultRules.hs" #-} - )) of - { !_childrenOmerged -> - (case (({-# LINE 593 "DefaultRules.ag" #-} - Set.toList $ Map.findWithDefault Set.empty con_ $ Map.findWithDefault Map.empty _lhsInt _lhsImanualAttrOrderMap - {-# LINE 1821 "DefaultRules.hs" #-} - )) of - { !_orderDeps -> - (case (({-# LINE 491 "DefaultRules.ag" #-} - _lhsIuniq - {-# LINE 1826 "DefaultRules.hs" #-} - )) of - { !_rulesOuniq -> - (case (({-# LINE 34 "DefaultRules.ag" #-} - _lhsInt - {-# LINE 1831 "DefaultRules.hs" #-} - )) of - { !_rulesOnt -> - (case (({-# LINE 143 "DefaultRules.ag" #-} - con_ - {-# LINE 1836 "DefaultRules.hs" #-} - )) of - { !_rulesOcon -> - (case (rules_ _rulesOcon _rulesOnt _rulesOuniq ) of - { ( !_rulesIdefinedAttrs,!_rulesIerrors,!_rulesIlocals,!_rulesIoutput,!_rulesIruleNames,!_rulesIuniq) -> - (case (({-# LINE 34 "DefaultRules.ag" #-} - _lhsInt - {-# LINE 1843 "DefaultRules.hs" #-} - )) of - { !_childrenOnt -> - (case (({-# LINE 47 "DefaultRules.ag" #-} - _lhsIcr - {-# LINE 1848 "DefaultRules.hs" #-} - )) of - { !_childrenOcr -> - (case (({-# LINE 144 "DefaultRules.ag" #-} - con_ - {-# LINE 1853 "DefaultRules.hs" #-} - )) of - { !_childrenOcon -> - (case (children_ _childrenOcon _childrenOcr _childrenOmerged _childrenOnt ) of - { ( !_childrenIerrors,!_childrenIfields,!_childrenIinputs,!_childrenIoutput,!_childrenIoutputs) -> - (case (({-# LINE 595 "DefaultRules.ag" #-} - 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] - existsRule nm = if nm `Set.member` _rulesIruleNames - then [] - else [MissingNamedRule _lhsInt con_ nm] - checkIn (OccAttr fld nm) = isInAttribute fld nm - checkIn (OccRule nm) = existsRule nm - checkOut (OccAttr fld nm) = isOutAttribute fld nm - checkOut (OccRule nm) = existsRule nm - in Seq.fromList . concat $ - [ checkIn occA ++ checkOut occB - | (Dependency occA occB) <- _orderDeps - ] - {-# LINE 1894 "DefaultRules.hs" #-} - )) of - { !_orderErrs -> - (case (({-# LINE 332 "DefaultRules.ag" #-} - 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,virt) <- _childrenIfields, childExists virt]) - | 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 - childExists Nothing = True - childExists (Just (Just _)) = True - childExists (Just Nothing) = False - 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> - (case (({-# LINE 332 "DefaultRules.ag" #-} - __tup1 - {-# LINE 1959 "DefaultRules.hs" #-} - )) of - { !(_,!_errs) -> - (case (({-# LINE 330 "DefaultRules.ag" #-} - _childrenIerrors >< _errs >< _rulesIerrors >< _orderErrs - {-# LINE 1964 "DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 658 "DefaultRules.ag" #-} - Map.findWithDefault Map.empty con_ _lhsIaroundsIn - {-# LINE 1969 "DefaultRules.hs" #-} - )) of - { !_aroundsIn -> - (case (({-# LINE 651 "DefaultRules.ag" #-} - Map.findWithDefault Map.empty con_ _lhsIaugmentsIn - {-# LINE 1974 "DefaultRules.hs" #-} - )) of - { !_augmentsIn -> - (case (({-# LINE 332 "DefaultRules.ag" #-} - __tup1 - {-# LINE 1979 "DefaultRules.hs" #-} - )) of - { !(!_newRls,_) -> - (case (({-# LINE 505 "DefaultRules.ag" #-} - foldr addAugments (_rulesIoutput ++ _newRls) (Map.assocs _augmentsIn ) - {-# LINE 1984 "DefaultRules.hs" #-} - )) of - { !_extra1 -> - (case (({-# LINE 506 "DefaultRules.ag" #-} - foldr addArounds _extra1 (Map.assocs _aroundsIn ) - {-# LINE 1989 "DefaultRules.hs" #-} - )) of - { !_extra2 -> - (case (({-# LINE 507 "DefaultRules.ag" #-} - foldr addMerges _extra2 (Map.assocs _mergesIn ) - {-# LINE 1994 "DefaultRules.hs" #-} - )) of - { !_extra3 -> - (case (typeSigs_ ) of - { ( !_typeSigsIoutput) -> - (case (({-# LINE 508 "DefaultRules.ag" #-} - Production con_ _childrenIoutput _extra3 _typeSigsIoutput - {-# LINE 2001 "DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - (case (({-# LINE 491 "DefaultRules.ag" #-} - _rulesIuniq - {-# LINE 2006 "DefaultRules.hs" #-} - )) of - { !_lhsOuniq -> - ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) --- Productions ------------------------------------------------- -{- - visit 0: - inherited attributes: - aroundsIn : Map ConstructorIdent (Map Identifier [Expression]) - augmentsIn : Map ConstructorIdent (Map Identifier [Expression]) - cr : Bool - inh : Attributes - manualAttrOrderMap : AttrOrderMap - mergesIn : Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)) - 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 ((Map ConstructorIdent (Map Identifier [Expression])) -> - (Map ConstructorIdent (Map Identifier [Expression])) -> - Bool -> - Attributes -> - AttrOrderMap -> - (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) -> - (Set NontermIdent) -> - NontermIdent -> - Bool -> - Attributes -> - TypeSyns -> - Int -> - (Map Identifier (String,String,String)) -> - ( (Seq Error),Productions ,Int)) -data Inh_Productions = Inh_Productions {aroundsIn_Inh_Productions :: !((Map ConstructorIdent (Map Identifier [Expression]))),augmentsIn_Inh_Productions :: !((Map ConstructorIdent (Map Identifier [Expression]))),cr_Inh_Productions :: !(Bool),inh_Inh_Productions :: !(Attributes),manualAttrOrderMap_Inh_Productions :: !(AttrOrderMap),mergesIn_Inh_Productions :: !((Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))),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 -> - Inh_Productions -> - Syn_Productions -wrap_Productions !(T_Productions sem ) !(Inh_Productions _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap ) = - (let ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = sem _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsImergesIn _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 (\ (!_lhsIaroundsIn) - (!_lhsIaugmentsIn) - (!_lhsIcr) - (!_lhsIinh) - (!_lhsImanualAttrOrderMap) - (!_lhsImergesIn) - (!_lhsInonterminals) - (!_lhsInt) - (!_lhsIo_rename) - (!_lhsIsyn) - (!_lhsItypeSyns) - (!_lhsIuniq) - (!_lhsIuseMap) -> - (case (({-# LINE 135 "DefaultRules.ag" #-} - _lhsIuseMap - {-# LINE 2088 "DefaultRules.hs" #-} - )) of - { !_tlOuseMap -> - (case (({-# LINE 55 "DefaultRules.ag" #-} - _lhsItypeSyns - {-# LINE 2093 "DefaultRules.hs" #-} - )) of - { !_tlOtypeSyns -> - (case (({-# LINE 135 "DefaultRules.ag" #-} - _lhsIsyn - {-# LINE 2098 "DefaultRules.hs" #-} - )) of - { !_tlOsyn -> - (case (({-# LINE 43 "DefaultRules.ag" #-} - _lhsIo_rename - {-# LINE 2103 "DefaultRules.hs" #-} - )) of - { !_tlOo_rename -> - (case (({-# LINE 34 "DefaultRules.ag" #-} - _lhsInt - {-# LINE 2108 "DefaultRules.hs" #-} - )) of - { !_tlOnt -> - (case (({-# LINE 661 "DefaultRules.ag" #-} - _lhsImergesIn - {-# LINE 2113 "DefaultRules.hs" #-} - )) of - { !_tlOmergesIn -> - (case (({-# LINE 579 "DefaultRules.ag" #-} - _lhsImanualAttrOrderMap - {-# LINE 2118 "DefaultRules.hs" #-} - )) of - { !_tlOmanualAttrOrderMap -> - (case (({-# LINE 135 "DefaultRules.ag" #-} - _lhsIinh - {-# LINE 2123 "DefaultRules.hs" #-} - )) of - { !_tlOinh -> - (case (({-# LINE 44 "DefaultRules.ag" #-} - _lhsIcr - {-# LINE 2128 "DefaultRules.hs" #-} - )) of - { !_tlOcr -> - (case (({-# LINE 135 "DefaultRules.ag" #-} - _lhsIuseMap - {-# LINE 2133 "DefaultRules.hs" #-} - )) of - { !_hdOuseMap -> - (case (({-# LINE 55 "DefaultRules.ag" #-} - _lhsItypeSyns - {-# LINE 2138 "DefaultRules.hs" #-} - )) of - { !_hdOtypeSyns -> - (case (({-# LINE 135 "DefaultRules.ag" #-} - _lhsIsyn - {-# LINE 2143 "DefaultRules.hs" #-} - )) of - { !_hdOsyn -> - (case (({-# LINE 43 "DefaultRules.ag" #-} - _lhsIo_rename - {-# LINE 2148 "DefaultRules.hs" #-} - )) of - { !_hdOo_rename -> - (case (({-# LINE 34 "DefaultRules.ag" #-} - _lhsInt - {-# LINE 2153 "DefaultRules.hs" #-} - )) of - { !_hdOnt -> - (case (({-# LINE 661 "DefaultRules.ag" #-} - _lhsImergesIn - {-# LINE 2158 "DefaultRules.hs" #-} - )) of - { !_hdOmergesIn -> - (case (({-# LINE 579 "DefaultRules.ag" #-} - _lhsImanualAttrOrderMap - {-# LINE 2163 "DefaultRules.hs" #-} - )) of - { !_hdOmanualAttrOrderMap -> - (case (({-# LINE 135 "DefaultRules.ag" #-} - _lhsIinh - {-# LINE 2168 "DefaultRules.hs" #-} - )) of - { !_hdOinh -> - (case (({-# LINE 44 "DefaultRules.ag" #-} - _lhsIcr - {-# LINE 2173 "DefaultRules.hs" #-} - )) of - { !_hdOcr -> - (case (({-# LINE 491 "DefaultRules.ag" #-} - _lhsIuniq - {-# LINE 2178 "DefaultRules.hs" #-} - )) of - { !_hdOuniq -> - (case (({-# LINE 125 "DefaultRules.ag" #-} - _lhsInonterminals - {-# LINE 2183 "DefaultRules.hs" #-} - )) of - { !_hdOnonterminals -> - (case (({-# LINE 647 "DefaultRules.ag" #-} - _lhsIaugmentsIn - {-# LINE 2188 "DefaultRules.hs" #-} - )) of - { !_hdOaugmentsIn -> - (case (({-# LINE 654 "DefaultRules.ag" #-} - _lhsIaroundsIn - {-# LINE 2193 "DefaultRules.hs" #-} - )) of - { !_hdOaroundsIn -> - (case (hd_ _hdOaroundsIn _hdOaugmentsIn _hdOcr _hdOinh _hdOmanualAttrOrderMap _hdOmergesIn _hdOnonterminals _hdOnt _hdOo_rename _hdOsyn _hdOtypeSyns _hdOuniq _hdOuseMap ) of - { ( !_hdIerrors,!_hdIoutput,!_hdIuniq) -> - (case (({-# LINE 491 "DefaultRules.ag" #-} - _hdIuniq - {-# LINE 2200 "DefaultRules.hs" #-} - )) of - { !_tlOuniq -> - (case (({-# LINE 125 "DefaultRules.ag" #-} - _lhsInonterminals - {-# LINE 2205 "DefaultRules.hs" #-} - )) of - { !_tlOnonterminals -> - (case (({-# LINE 647 "DefaultRules.ag" #-} - _lhsIaugmentsIn - {-# LINE 2210 "DefaultRules.hs" #-} - )) of - { !_tlOaugmentsIn -> - (case (({-# LINE 654 "DefaultRules.ag" #-} - _lhsIaroundsIn - {-# LINE 2215 "DefaultRules.hs" #-} - )) of - { !_tlOaroundsIn -> - (case (tl_ _tlOaroundsIn _tlOaugmentsIn _tlOcr _tlOinh _tlOmanualAttrOrderMap _tlOmergesIn _tlOnonterminals _tlOnt _tlOo_rename _tlOsyn _tlOtypeSyns _tlOuniq _tlOuseMap ) of - { ( !_tlIerrors,!_tlIoutput,!_tlIuniq) -> - (case (({-# LINE 115 "DefaultRules.ag" #-} - _hdIerrors Seq.>< _tlIerrors - {-# LINE 2222 "DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - (:) _hdIoutput _tlIoutput - {-# LINE 2227 "DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - _output - {-# LINE 2232 "DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - (case (({-# LINE 491 "DefaultRules.ag" #-} - _tlIuniq - {-# LINE 2237 "DefaultRules.hs" #-} - )) of - { !_lhsOuniq -> - ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Productions_Nil :: T_Productions -sem_Productions_Nil = - (T_Productions (\ (!_lhsIaroundsIn) - (!_lhsIaugmentsIn) - (!_lhsIcr) - (!_lhsIinh) - (!_lhsImanualAttrOrderMap) - (!_lhsImergesIn) - (!_lhsInonterminals) - (!_lhsInt) - (!_lhsIo_rename) - (!_lhsIsyn) - (!_lhsItypeSyns) - (!_lhsIuniq) - (!_lhsIuseMap) -> - (case (({-# LINE 115 "DefaultRules.ag" #-} - Seq.empty - {-# LINE 2258 "DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - [] - {-# LINE 2263 "DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - _output - {-# LINE 2268 "DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - (case (({-# LINE 491 "DefaultRules.ag" #-} - _lhsIuniq - {-# LINE 2273 "DefaultRules.hs" #-} - )) of - { !_lhsOuniq -> - ( _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 - ruleNames : Set Identifier - alternatives: - alternative Rule: - child mbName : {Maybe Identifier} - child pattern : Pattern - child rhs : {Expression} - child owrt : {Bool} - child origin : {String} - child explicit : {Bool} - visit 0: - local output : _ - local _tup2 : {(Rules,Int)} --} --- cata -sem_Rule :: Rule -> - T_Rule -sem_Rule !(Rule _mbName _pattern _rhs _owrt _origin _explicit ) = - (sem_Rule_Rule _mbName (sem_Pattern _pattern ) _rhs _owrt _origin _explicit ) --- semantic domain -newtype T_Rule = T_Rule (ConstructorIdent -> - NontermIdent -> - Int -> - ( Bool,(Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Rule ,Rules ,(Set Identifier),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 ),ruleNames_Syn_Rule :: !((Set Identifier)),uniq_Syn_Rule :: !(Int)} -wrap_Rule :: T_Rule -> - Inh_Rule -> - Syn_Rule -wrap_Rule !(T_Rule sem ) !(Inh_Rule _lhsIcon _lhsInt _lhsIuniq ) = - (let ( !_lhsOcontainsVars,!_lhsOdefinedAttrs,!_lhsOerrors,!_lhsOlocals,!_lhsOoutput,!_lhsOoutputs,!_lhsOruleNames,!_lhsOuniq) = sem _lhsIcon _lhsInt _lhsIuniq - in (Syn_Rule _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOoutputs _lhsOruleNames _lhsOuniq )) -sem_Rule_Rule :: (Maybe Identifier) -> - T_Pattern -> - Expression -> - Bool -> - String -> - Bool -> - T_Rule -sem_Rule_Rule !mbName_ !(T_Pattern pattern_ ) !rhs_ !owrt_ !origin_ !explicit_ = - (T_Rule (\ (!_lhsIcon) - (!_lhsInt) - (!_lhsIuniq) -> - (case (({-# LINE 34 "DefaultRules.ag" #-} - _lhsInt - {-# LINE 2336 "DefaultRules.hs" #-} - )) of - { !_patternOnt -> - (case (({-# LINE 35 "DefaultRules.ag" #-} - _lhsIcon - {-# LINE 2341 "DefaultRules.hs" #-} - )) of - { !_patternOcon -> - (case (pattern_ _patternOcon _patternOnt ) of - { ( !_patternIcontainsVars,!_patternIcopy,!_patternIdefinedAttrs,!_patternIerrors,!_patternIlocals,!_patternIoutput) -> - (case (({-# LINE 482 "DefaultRules.ag" #-} - _patternIcontainsVars - {-# LINE 2348 "DefaultRules.hs" #-} - )) of - { !_lhsOcontainsVars -> - (case (({-# LINE 462 "DefaultRules.ag" #-} - _patternIdefinedAttrs - {-# LINE 2353 "DefaultRules.hs" #-} - )) of - { !_lhsOdefinedAttrs -> - (case (({-# LINE 115 "DefaultRules.ag" #-} - _patternIerrors - {-# LINE 2358 "DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 461 "DefaultRules.ag" #-} - _patternIlocals - {-# LINE 2363 "DefaultRules.hs" #-} - )) of - { !_lhsOlocals -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - Rule mbName_ _patternIoutput rhs_ owrt_ origin_ explicit_ - {-# LINE 2368 "DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - _output - {-# LINE 2373 "DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - (case (({-# LINE 515 "DefaultRules.ag" #-} - multiRule _output _lhsIuniq - {-# LINE 2378 "DefaultRules.hs" #-} - )) of - { !__tup2 -> - (case (({-# LINE 515 "DefaultRules.ag" #-} - __tup2 - {-# LINE 2383 "DefaultRules.hs" #-} - )) of - { !(!_lhsOoutputs,_) -> - (case (({-# LINE 587 "DefaultRules.ag" #-} - case mbName_ of - Nothing -> Set.empty - Just nm -> Set.singleton nm - {-# LINE 2390 "DefaultRules.hs" #-} - )) of - { !_lhsOruleNames -> - (case (({-# LINE 515 "DefaultRules.ag" #-} - __tup2 - {-# LINE 2395 "DefaultRules.hs" #-} - )) of - { !(_,!_lhsOuniq) -> - ( _lhsOcontainsVars,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOoutputs,_lhsOruleNames,_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 - ruleNames : Set Identifier - alternatives: - alternative Cons: - child hd : Rule - child tl : Rules - 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 ,(Set Identifier),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 ),ruleNames_Syn_Rules :: !((Set Identifier)),uniq_Syn_Rules :: !(Int)} -wrap_Rules :: T_Rules -> - Inh_Rules -> - Syn_Rules -wrap_Rules !(T_Rules sem ) !(Inh_Rules _lhsIcon _lhsInt _lhsIuniq ) = - (let ( !_lhsOdefinedAttrs,!_lhsOerrors,!_lhsOlocals,!_lhsOoutput,!_lhsOruleNames,!_lhsOuniq) = sem _lhsIcon _lhsInt _lhsIuniq - in (Syn_Rules _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOruleNames _lhsOuniq )) -sem_Rules_Cons :: T_Rule -> - T_Rules -> - T_Rules -sem_Rules_Cons !(T_Rule hd_ ) !(T_Rules tl_ ) = - (T_Rules (\ (!_lhsIcon) - (!_lhsInt) - (!_lhsIuniq) -> - (case (({-# LINE 491 "DefaultRules.ag" #-} - _lhsIuniq - {-# LINE 2448 "DefaultRules.hs" #-} - )) of - { !_hdOuniq -> - (case (({-# LINE 34 "DefaultRules.ag" #-} - _lhsInt - {-# LINE 2453 "DefaultRules.hs" #-} - )) of - { !_hdOnt -> - (case (({-# LINE 35 "DefaultRules.ag" #-} - _lhsIcon - {-# LINE 2458 "DefaultRules.hs" #-} - )) of - { !_hdOcon -> - (case (hd_ _hdOcon _hdOnt _hdOuniq ) of - { ( !_hdIcontainsVars,!_hdIdefinedAttrs,!_hdIerrors,!_hdIlocals,!_hdIoutput,!_hdIoutputs,!_hdIruleNames,!_hdIuniq) -> - (case (({-# LINE 491 "DefaultRules.ag" #-} - _hdIuniq - {-# LINE 2465 "DefaultRules.hs" #-} - )) of - { !_tlOuniq -> - (case (({-# LINE 34 "DefaultRules.ag" #-} - _lhsInt - {-# LINE 2470 "DefaultRules.hs" #-} - )) of - { !_tlOnt -> - (case (({-# LINE 35 "DefaultRules.ag" #-} - _lhsIcon - {-# LINE 2475 "DefaultRules.hs" #-} - )) of - { !_tlOcon -> - (case (tl_ _tlOcon _tlOnt _tlOuniq ) of - { ( !_tlIdefinedAttrs,!_tlIerrors,!_tlIlocals,!_tlIoutput,!_tlIruleNames,!_tlIuniq) -> - (case (({-# LINE 462 "DefaultRules.ag" #-} - _hdIdefinedAttrs `Set.union` _tlIdefinedAttrs - {-# LINE 2482 "DefaultRules.hs" #-} - )) of - { !_lhsOdefinedAttrs -> - (case (({-# LINE 115 "DefaultRules.ag" #-} - _hdIerrors Seq.>< _tlIerrors - {-# LINE 2487 "DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 461 "DefaultRules.ag" #-} - _hdIlocals `Set.union` _tlIlocals - {-# LINE 2492 "DefaultRules.hs" #-} - )) of - { !_lhsOlocals -> - (case (({-# LINE 511 "DefaultRules.ag" #-} - if _hdIcontainsVars then _hdIoutputs ++ _tlIoutput else _tlIoutput - {-# LINE 2497 "DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - (case (({-# LINE 585 "DefaultRules.ag" #-} - _hdIruleNames `Set.union` _tlIruleNames - {-# LINE 2502 "DefaultRules.hs" #-} - )) of - { !_lhsOruleNames -> - (case (({-# LINE 491 "DefaultRules.ag" #-} - _tlIuniq - {-# LINE 2507 "DefaultRules.hs" #-} - )) of - { !_lhsOuniq -> - ( _lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOruleNames,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Rules_Nil :: T_Rules -sem_Rules_Nil = - (T_Rules (\ (!_lhsIcon) - (!_lhsInt) - (!_lhsIuniq) -> - (case (({-# LINE 462 "DefaultRules.ag" #-} - Set.empty - {-# LINE 2518 "DefaultRules.hs" #-} - )) of - { !_lhsOdefinedAttrs -> - (case (({-# LINE 115 "DefaultRules.ag" #-} - Seq.empty - {-# LINE 2523 "DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 461 "DefaultRules.ag" #-} - Set.empty - {-# LINE 2528 "DefaultRules.hs" #-} - )) of - { !_lhsOlocals -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - [] - {-# LINE 2533 "DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - _output - {-# LINE 2538 "DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - (case (({-# LINE 585 "DefaultRules.ag" #-} - Set.empty - {-# LINE 2543 "DefaultRules.hs" #-} - )) of - { !_lhsOruleNames -> - (case (({-# LINE 491 "DefaultRules.ag" #-} - _lhsIuniq - {-# LINE 2548 "DefaultRules.hs" #-} - )) of - { !_lhsOuniq -> - ( _lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOruleNames,_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 -> - Inh_TypeSig -> - Syn_TypeSig -wrap_TypeSig !(T_TypeSig sem ) !(Inh_TypeSig ) = - (let ( !_lhsOoutput) = sem - in (Syn_TypeSig _lhsOoutput )) -sem_TypeSig_TypeSig :: Identifier -> - Type -> - T_TypeSig -sem_TypeSig_TypeSig !name_ !tp_ = - (T_TypeSig (case (({-# LINE 498 "DefaultRules.ag" #-} - TypeSig name_ tp_ - {-# LINE 2585 "DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - _output - {-# LINE 2590 "DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOoutput) }) }) ) --- TypeSigs ---------------------------------------------------- -{- - visit 0: - synthesized attribute: - output : SELF - alternatives: - alternative Cons: - child hd : TypeSig - child tl : TypeSigs - visit 0: - local output : _ - alternative Nil: - visit 0: - local output : _ --} --- cata -sem_TypeSigs :: TypeSigs -> - T_TypeSigs -sem_TypeSigs !list = - (Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) ) --- semantic domain -newtype T_TypeSigs = T_TypeSigs (( TypeSigs )) -data Inh_TypeSigs = Inh_TypeSigs {} -data Syn_TypeSigs = Syn_TypeSigs {output_Syn_TypeSigs :: !(TypeSigs )} -wrap_TypeSigs :: T_TypeSigs -> - Inh_TypeSigs -> - Syn_TypeSigs -wrap_TypeSigs !(T_TypeSigs sem ) !(Inh_TypeSigs ) = - (let ( !_lhsOoutput) = sem - in (Syn_TypeSigs _lhsOoutput )) -sem_TypeSigs_Cons :: T_TypeSig -> - T_TypeSigs -> - T_TypeSigs -sem_TypeSigs_Cons !(T_TypeSig hd_ ) !(T_TypeSigs tl_ ) = - (T_TypeSigs (case (tl_ ) of - { ( !_tlIoutput) -> - (case (hd_ ) of - { ( !_hdIoutput) -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - (:) _hdIoutput _tlIoutput - {-# LINE 2634 "DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - _output - {-# LINE 2639 "DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOoutput) }) }) }) }) ) -sem_TypeSigs_Nil :: T_TypeSigs -sem_TypeSigs_Nil = - (T_TypeSigs (case (({-# LINE 498 "DefaultRules.ag" #-} - [] - {-# LINE 2647 "DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 498 "DefaultRules.ag" #-} - _output - {-# LINE 2652 "DefaultRules.hs" #-} +-- UUAGC 0.9.38.2 (DefaultRules.ag) +module DefaultRules where +{-# LINE 10 "DefaultRules.ag" #-} + +import qualified List (delete,intersperse) + +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Map(Map) +import qualified Data.Sequence as Seq +import Data.Sequence(Seq,(><)) +import UU.Scanner.Position(noPos) +import Pretty +import Maybe +import HsToken +import HsTokenScanner +import Data.List(intersperse) + +import AbstractSyntax +import ErrorMessages + +import Options(Options,modcopy,rename) +{-# LINE 26 "../src-derived/DefaultRules.hs" #-} + +{-# LINE 2 "./AbstractSyntax.ag" #-} + +-- AbstractSyntax.ag imports +import Data.Set(Set) +import Data.Map(Map) +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import CommonTypes +{-# LINE 36 "../src-derived/DefaultRules.hs" #-} + +{-# LINE 2 "./Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 43 "../src-derived/DefaultRules.hs" #-} +{-# LINE 61 "DefaultRules.ag" #-} + +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" = case lookup nt typeSyns of + Just (Map _ _) -> "Map.empty" + Just (IntMap _) -> "IntMap.empty" + _ -> "[]" + | con == "Just" = "Just" + | con == "Nothing" = "Nothing" + | con == "Entry" = case lookup nt typeSyns of + Just (Map _ _) -> "Map.insert" + Just (IntMap _) -> "IntMap.insert" + | otherwise = normalName + +concatSeq = foldr (Seq.><) 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) + ] + ) + +{-# LINE 95 "../src-derived/DefaultRules.hs" #-} + +{-# LINE 176 "DefaultRules.ag" #-} + + + + +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 Nothing + (Alias f1 a1 (Underscore noPos) []) + expr + False + origin + False + + +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.singleton (MissingRule nt con fld a) + ) + Just f + | f == _ACHILD -> ( fieldName a + , Seq.singleton (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.singleton (MissingRule nt con fld a) + ) + Just f + | f == _ACHILD -> ( [AGLocal a noPos Nothing] + , Seq.singleton (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 +{-# LINE 248 "../src-derived/DefaultRules.hs" #-} + +{-# LINE 407 "DefaultRules.ag" #-} + +addAugments :: (Identifier, [Expression]) -> [Rule] -> [Rule] +addAugments (_, exprs) rules + | null exprs = rules +addAugments (syn, exprs) rules + = [rule] ++ funRules ++ map modify rules + where + rule = Rule Nothing (Alias _LHS syn (Underscore noPos) []) rhs False "augmented rule" False + rhs = Expression noPos tks + tks = [ HsToken "foldr ($) " noPos, AGLocal substSyn noPos Nothing, HsToken " [" noPos] ++ funs ++ [HsToken "]" noPos] + funs = intersperse (HsToken ", " noPos) (map (\n -> AGLocal n noPos Nothing) funNames) + + substSyn = Ident (show syn ++ "_augmented_syn") (getPos syn) + funNames = zipWith (\i _ -> Ident (show syn ++ "_augmented_f" ++ show i) (getPos syn)) [1..] exprs + funRules = zipWith (\name expr -> Rule Nothing (Alias _LOC name (Underscore noPos) []) expr False "augment function" False) funNames exprs + + modify (Rule mbNm pat rhs owrt origin expl) + | containsSyn pat = Rule mbNm (modifyPat pat) rhs owrt origin expl + modify r = r + + containsSyn (Constr _ pats) = any containsSyn pats + containsSyn (Product _ pats) = any containsSyn pats + containsSyn (Irrefutable pat) = containsSyn pat + containsSyn (Alias field attr pat parts) = (field == _LHS && attr == syn) || containsSyn pat || any containsSyn parts + containsSyn _ = False + + modifyPat (Constr name pats) = Constr name (map modifyPat pats) + modifyPat (Product pos pats) = Product pos (map modifyPat pats) + modifyPat (Irrefutable pat) = Irrefutable (modifyPat pat) + modifyPat (Alias field attr pat parts) + | field == _LHS && attr == syn = Alias _LOC substSyn (modifyPat pat) (map modifyPat parts) + | otherwise = Alias field attr (modifyPat pat) (map modifyPat parts) + modifyPat p = p + +addArounds :: (Identifier, [Expression]) -> [Rule] -> [Rule] +addArounds (_, exprs) rules | null exprs = rules +addArounds (child, exprs) rules + = [rule] ++ funRules ++ rules + where + rule = Rule Nothing (Alias _LOC childLoc (Underscore noPos) []) rhs False "around rule" False + rhs = Expression noPos tks + tks = [ HsToken "\\s -> foldr ($) s " noPos, HsToken " [" noPos] ++ funs ++ [HsToken "]" noPos] + funs = intersperse (HsToken ", " noPos) (map (\n -> AGLocal n noPos Nothing) funNames) + + childLoc = Ident (show child ++ "_around") (getPos child) + funNames = zipWith (\i _ -> Ident (show child ++ "_around_f" ++ show i) (getPos child)) [1..] exprs + funRules = zipWith (\name expr -> Rule Nothing (Alias _LOC name (Underscore noPos) []) expr False "around function" False) funNames exprs + +addMerges :: (Identifier, (Identifier,[Identifier],Expression)) -> [Rule] -> [Rule] +addMerges (target,(_,_,expr)) rules + = rule : rules + where + rule = Rule Nothing (Alias _LOC childLoc (Underscore noPos) []) expr False "merge rule" False + childLoc = Ident (show target ++ "_merge") (getPos target) +{-# LINE 305 "../src-derived/DefaultRules.hs" #-} + +{-# LINE 522 "DefaultRules.ag" #-} + +{- +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 (Just nm) pat expr owrt origin expl) uniq + = let pos = getPos nm + r = Rule Nothing (Alias _LOC (Ident ("_rule_" ++ show nm) pos) (Underscore pos) []) expr owrt origin expl + expr' = Expression pos tks + tks = [AGLocal (Ident ("_rule_" ++ show nm) pos) pos (Just ("Indirection to rule " ++ show nm))] + (rs,uniq') = multiRule (Rule Nothing pat expr' owrt origin False) uniq + in (r:rs, uniq') + +multiRule (Rule Nothing pat expr owrt origin expl) uniq + = let f :: Bool -> (Pattern->Pattern) -> Expression -> Pattern -> Int -> (Pattern, ([Rule], Int)) + f expl' 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 False (us (length xs1)) freshExpr p n1 + in (x2:xs1, rs2++rs1, n2) + (xs9,rs9,n9) = foldr g ([], [], n+1) pats + in ( freshPat + , ( Rule Nothing (w freshPat) e owrt origin expl' : rs9 + , n9 + ) + ) + f expl' w e p n + = ( p + , ( [Rule Nothing (w p) e owrt origin expl'] + , n + ) + ) + in snd (f expl id expr pat uniq) + +{-# LINE 363 "../src-derived/DefaultRules.hs" #-} +-- Child ------------------------------------------------------- +{- + visit 0: + inherited attributes: + con : ConstructorIdent + cr : Bool + merged : Set Identifier + nt : NontermIdent + synthesized attributes: + errors : Seq Error + field : (Identifier,Type,Maybe (Maybe Type)) + inherited : Attributes + name : Identifier + output : SELF + synthesized : Attributes + alternatives: + alternative Child: + child name : {Identifier} + child tp : {Type} + child inh : {Attributes} + child syn : {Attributes} + child virtual : {Maybe (Maybe Type)} + visit 0: + local output : _ +-} +-- cata +sem_Child :: Child -> + T_Child +sem_Child !(Child _name _tp _inh _syn _virtual ) = + (sem_Child_Child _name _tp _inh _syn _virtual ) +-- semantic domain +newtype T_Child = T_Child (ConstructorIdent -> + Bool -> + (Set Identifier) -> + NontermIdent -> + ( (Seq Error),( (Identifier,Type,Maybe (Maybe Type)) ),Attributes,Identifier,Child ,Attributes)) +data Inh_Child = Inh_Child {con_Inh_Child :: !(ConstructorIdent),cr_Inh_Child :: !(Bool),merged_Inh_Child :: !((Set Identifier)),nt_Inh_Child :: !(NontermIdent)} +data Syn_Child = Syn_Child {errors_Syn_Child :: !((Seq Error)),field_Syn_Child :: !(( (Identifier,Type,Maybe (Maybe Type)) )),inherited_Syn_Child :: !(Attributes),name_Syn_Child :: !(Identifier),output_Syn_Child :: !(Child ),synthesized_Syn_Child :: !(Attributes)} +wrap_Child :: T_Child -> + Inh_Child -> + Syn_Child +wrap_Child !(T_Child sem ) !(Inh_Child _lhsIcon _lhsIcr _lhsImerged _lhsInt ) = + (let ( !_lhsOerrors,!_lhsOfield,!_lhsOinherited,!_lhsOname,!_lhsOoutput,!_lhsOsynthesized) = sem _lhsIcon _lhsIcr _lhsImerged _lhsInt + in (Syn_Child _lhsOerrors _lhsOfield _lhsOinherited _lhsOname _lhsOoutput _lhsOsynthesized )) +sem_Child_Child :: Identifier -> + Type -> + Attributes -> + Attributes -> + (Maybe (Maybe Type)) -> + T_Child +sem_Child_Child !name_ !tp_ !inh_ !syn_ !virtual_ = + (T_Child (\ (!_lhsIcon) + (!_lhsIcr) + (!_lhsImerged) + (!_lhsInt) -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + Seq.empty + {-# LINE 421 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 481 "DefaultRules.ag" #-} + (name_,tp_,virtual_) + {-# LINE 426 "DefaultRules.hs" #-} + )) of + { !_lhsOfield -> + (case (({-# LINE 159 "DefaultRules.ag" #-} + inh_ + {-# LINE 431 "DefaultRules.hs" #-} + )) of + { !_lhsOinherited -> + (case (({-# LINE 150 "DefaultRules.ag" #-} + name_ + {-# LINE 436 "DefaultRules.hs" #-} + )) of + { !_lhsOname -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + Child name_ tp_ inh_ syn_ virtual_ + {-# LINE 441 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 446 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 160 "DefaultRules.ag" #-} + if name_ `Set.member` _lhsImerged + then Map.empty + else syn_ + {-# LINE 453 "DefaultRules.hs" #-} + )) of + { !_lhsOsynthesized -> + ( _lhsOerrors,_lhsOfield,_lhsOinherited,_lhsOname,_lhsOoutput,_lhsOsynthesized) }) }) }) }) }) }) })) ) +-- Children ---------------------------------------------------- +{- + visit 0: + inherited attributes: + con : ConstructorIdent + cr : Bool + merged : Set Identifier + nt : NontermIdent + synthesized attributes: + errors : Seq Error + fields : [(Identifier,Type,Maybe (Maybe Type))] + 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 -> + (Set Identifier) -> + NontermIdent -> + ( (Seq Error),([(Identifier,Type,Maybe (Maybe Type))]),([(Identifier, Attributes)]),Children ,([(Identifier, Attributes)]))) +data Inh_Children = Inh_Children {con_Inh_Children :: !(ConstructorIdent),cr_Inh_Children :: !(Bool),merged_Inh_Children :: !((Set Identifier)),nt_Inh_Children :: !(NontermIdent)} +data Syn_Children = Syn_Children {errors_Syn_Children :: !((Seq Error)),fields_Syn_Children :: !(([(Identifier,Type,Maybe (Maybe Type))])),inputs_Syn_Children :: !(([(Identifier, Attributes)])),output_Syn_Children :: !(Children ),outputs_Syn_Children :: !(([(Identifier, Attributes)]))} +wrap_Children :: T_Children -> + Inh_Children -> + Syn_Children +wrap_Children !(T_Children sem ) !(Inh_Children _lhsIcon _lhsIcr _lhsImerged _lhsInt ) = + (let ( !_lhsOerrors,!_lhsOfields,!_lhsOinputs,!_lhsOoutput,!_lhsOoutputs) = sem _lhsIcon _lhsIcr _lhsImerged _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) + (!_lhsImerged) + (!_lhsInt) -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 510 "DefaultRules.hs" #-} + )) of + { !_tlOnt -> + (case (({-# LINE 666 "DefaultRules.ag" #-} + _lhsImerged + {-# LINE 515 "DefaultRules.hs" #-} + )) of + { !_tlOmerged -> + (case (({-# LINE 47 "DefaultRules.ag" #-} + _lhsIcr + {-# LINE 520 "DefaultRules.hs" #-} + )) of + { !_tlOcr -> + (case (({-# LINE 35 "DefaultRules.ag" #-} + _lhsIcon + {-# LINE 525 "DefaultRules.hs" #-} + )) of + { !_tlOcon -> + (case (tl_ _tlOcon _tlOcr _tlOmerged _tlOnt ) of + { ( !_tlIerrors,!_tlIfields,!_tlIinputs,!_tlIoutput,!_tlIoutputs) -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 532 "DefaultRules.hs" #-} + )) of + { !_hdOnt -> + (case (({-# LINE 666 "DefaultRules.ag" #-} + _lhsImerged + {-# LINE 537 "DefaultRules.hs" #-} + )) of + { !_hdOmerged -> + (case (({-# LINE 47 "DefaultRules.ag" #-} + _lhsIcr + {-# LINE 542 "DefaultRules.hs" #-} + )) of + { !_hdOcr -> + (case (({-# LINE 35 "DefaultRules.ag" #-} + _lhsIcon + {-# LINE 547 "DefaultRules.hs" #-} + )) of + { !_hdOcon -> + (case (hd_ _hdOcon _hdOcr _hdOmerged _hdOnt ) of + { ( !_hdIerrors,!_hdIfield,!_hdIinherited,!_hdIname,!_hdIoutput,!_hdIsynthesized) -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 554 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 477 "DefaultRules.ag" #-} + _hdIfield : _tlIfields + {-# LINE 559 "DefaultRules.hs" #-} + )) of + { !_lhsOfields -> + (case (({-# LINE 165 "DefaultRules.ag" #-} + (_hdIname, _hdIinherited) : _tlIinputs + {-# LINE 564 "DefaultRules.hs" #-} + )) of + { !_lhsOinputs -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 569 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 574 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 166 "DefaultRules.ag" #-} + (_hdIname, _hdIsynthesized) : _tlIoutputs + {-# LINE 579 "DefaultRules.hs" #-} + )) of + { !_lhsOoutputs -> + ( _lhsOerrors,_lhsOfields,_lhsOinputs,_lhsOoutput,_lhsOoutputs) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) +sem_Children_Nil :: T_Children +sem_Children_Nil = + (T_Children (\ (!_lhsIcon) + (!_lhsIcr) + (!_lhsImerged) + (!_lhsInt) -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + Seq.empty + {-# LINE 591 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 478 "DefaultRules.ag" #-} + [] + {-# LINE 596 "DefaultRules.hs" #-} + )) of + { !_lhsOfields -> + (case (({-# LINE 167 "DefaultRules.ag" #-} + [] + {-# LINE 601 "DefaultRules.hs" #-} + )) of + { !_lhsOinputs -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + [] + {-# LINE 606 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 611 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 168 "DefaultRules.ag" #-} + [] + {-# LINE 616 "DefaultRules.hs" #-} + )) of + { !_lhsOoutputs -> + ( _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} + child quantMap : {QuantMap} + child uniqueMap : {UniqueMap} + child augmentsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))} + visit 0: + local output : _ +-} +-- cata +sem_Grammar :: Grammar -> + T_Grammar +sem_Grammar !(Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap ) = + (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts ) _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap ) +-- semantic domain +newtype T_Grammar = T_Grammar (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 -> + Inh_Grammar -> + Syn_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 -> + QuantMap -> + UniqueMap -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> + T_Grammar +sem_Grammar_Grammar !typeSyns_ !useMap_ !derivings_ !wrappers_ !(T_Nonterminals nonts_ ) !pragmas_ !manualAttrOrderMap_ !paramMap_ !contextMap_ !quantMap_ !uniqueMap_ !augmentsMap_ !aroundsMap_ !mergeMap_ = + (T_Grammar (\ (!_lhsIoptions) -> + (case (({-# LINE 668 "DefaultRules.ag" #-} + mergeMap_ + {-# LINE 682 "DefaultRules.hs" #-} + )) of + { !_nontsOmergesIn -> + (case (({-# LINE 587 "DefaultRules.ag" #-} + manualAttrOrderMap_ + {-# LINE 687 "DefaultRules.hs" #-} + )) of + { !_nontsOmanualAttrOrderMap -> + (case (({-# LINE 154 "DefaultRules.ag" #-} + typeSyns_ + {-# LINE 692 "DefaultRules.hs" #-} + )) of + { !_nontsOtypeSyns -> + (case (({-# LINE 152 "DefaultRules.ag" #-} + useMap_ + {-# LINE 697 "DefaultRules.hs" #-} + )) of + { !_nontsOuseMap -> + (case (({-# LINE 50 "DefaultRules.ag" #-} + modcopy _lhsIoptions + {-# LINE 702 "DefaultRules.hs" #-} + )) of + { !_nontsOcr -> + (case (({-# LINE 49 "DefaultRules.ag" #-} + rename _lhsIoptions + {-# LINE 707 "DefaultRules.hs" #-} + )) of + { !_nontsOo_rename -> + (case (nonts_ ) of + { ( !_nontsIcollect_nts,!T_Nonterminals_1 nonts_1) -> + (case (({-# LINE 660 "DefaultRules.ag" #-} + aroundsMap_ + {-# LINE 714 "DefaultRules.hs" #-} + )) of + { !_nontsOaroundsIn -> + (case (({-# LINE 653 "DefaultRules.ag" #-} + augmentsMap_ + {-# LINE 719 "DefaultRules.hs" #-} + )) of + { !_nontsOaugmentsIn -> + (case (({-# LINE 498 "DefaultRules.ag" #-} + 1 + {-# LINE 724 "DefaultRules.hs" #-} + )) of + { !_nontsOuniq -> + (case (({-# LINE 131 "DefaultRules.ag" #-} + _nontsIcollect_nts + {-# LINE 729 "DefaultRules.hs" #-} + )) of + { !_nontsOnonterminals -> + (case (nonts_1 _nontsOaroundsIn _nontsOaugmentsIn _nontsOcr _nontsOmanualAttrOrderMap _nontsOmergesIn _nontsOnonterminals _nontsOo_rename _nontsOtypeSyns _nontsOuniq _nontsOuseMap ) of + { ( !_nontsIerrors,!_nontsIoutput,!_nontsIuniq) -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + _nontsIerrors + {-# LINE 736 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + Grammar typeSyns_ useMap_ derivings_ wrappers_ _nontsIoutput pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ + {-# LINE 741 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 746 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) +-- Nonterminal ------------------------------------------------- +{- + visit 0: + synthesized attribute: + collect_nts : Set NontermIdent + visit 1: + inherited attributes: + aroundsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + augmentsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + cr : Bool + manualAttrOrderMap : AttrOrderMap + mergesIn : Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) + nonterminals : Set NontermIdent + o_rename : Bool + typeSyns : TypeSyns + useMap : UseMap + chained attribute: + uniq : Int + synthesized attributes: + errors : Seq Error + output : SELF + alternatives: + alternative Nonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child inh : {Attributes} + child syn : {Attributes} + child prods : Productions + visit 1: + local mergesIn : _ + local augmentsIn : _ + local aroundsIn : _ + 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 (( (Set NontermIdent),T_Nonterminal_1 )) +newtype T_Nonterminal_1 = T_Nonterminal_1 ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + Bool -> + AttrOrderMap -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) -> + (Set NontermIdent) -> + Bool -> + TypeSyns -> + Int -> + UseMap -> + ( (Seq Error),Nonterminal ,Int)) +data Inh_Nonterminal = Inh_Nonterminal {aroundsIn_Inh_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),augmentsIn_Inh_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),cr_Inh_Nonterminal :: !(Bool),manualAttrOrderMap_Inh_Nonterminal :: !(AttrOrderMap),mergesIn_Inh_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))))),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 -> + Inh_Nonterminal -> + Syn_Nonterminal +wrap_Nonterminal !(T_Nonterminal sem ) !(Inh_Nonterminal _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap ) = + (let ( !_lhsOcollect_nts,!T_Nonterminal_1 sem_1) = sem + ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = sem_1 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsImanualAttrOrderMap _lhsImergesIn _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 (case (({-# LINE 127 "DefaultRules.ag" #-} + Set.singleton nt_ + {-# LINE 820 "DefaultRules.hs" #-} + )) of + { !_lhsOcollect_nts -> + (case ((let sem_Nonterminal_Nonterminal_1 :: T_Nonterminal_1 + sem_Nonterminal_Nonterminal_1 = + (T_Nonterminal_1 (\ (!_lhsIaroundsIn) + (!_lhsIaugmentsIn) + (!_lhsIcr) + (!_lhsImanualAttrOrderMap) + (!_lhsImergesIn) + (!_lhsInonterminals) + (!_lhsIo_rename) + (!_lhsItypeSyns) + (!_lhsIuniq) + (!_lhsIuseMap) -> + (case (({-# LINE 55 "DefaultRules.ag" #-} + _lhsItypeSyns + {-# LINE 837 "DefaultRules.hs" #-} + )) of + { !_prodsOtypeSyns -> + (case (({-# LINE 43 "DefaultRules.ag" #-} + _lhsIo_rename + {-# LINE 842 "DefaultRules.hs" #-} + )) of + { !_prodsOo_rename -> + (case (({-# LINE 669 "DefaultRules.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsImergesIn + {-# LINE 847 "DefaultRules.hs" #-} + )) of + { !_mergesIn -> + (case (({-# LINE 665 "DefaultRules.ag" #-} + _mergesIn + {-# LINE 852 "DefaultRules.hs" #-} + )) of + { !_prodsOmergesIn -> + (case (({-# LINE 583 "DefaultRules.ag" #-} + _lhsImanualAttrOrderMap + {-# LINE 857 "DefaultRules.hs" #-} + )) of + { !_prodsOmanualAttrOrderMap -> + (case (({-# LINE 44 "DefaultRules.ag" #-} + _lhsIcr + {-# LINE 862 "DefaultRules.hs" #-} + )) of + { !_prodsOcr -> + (case (({-# LINE 156 "DefaultRules.ag" #-} + nt_ + {-# LINE 867 "DefaultRules.hs" #-} + )) of + { !_prodsOnt -> + (case (({-# LINE 144 "DefaultRules.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsIuseMap + {-# LINE 872 "DefaultRules.hs" #-} + )) of + { !_prodsOuseMap -> + (case (({-# LINE 143 "DefaultRules.ag" #-} + syn_ + {-# LINE 877 "DefaultRules.hs" #-} + )) of + { !_prodsOsyn -> + (case (({-# LINE 142 "DefaultRules.ag" #-} + inh_ + {-# LINE 882 "DefaultRules.hs" #-} + )) of + { !_prodsOinh -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _lhsIuniq + {-# LINE 887 "DefaultRules.hs" #-} + )) of + { !_prodsOuniq -> + (case (({-# LINE 129 "DefaultRules.ag" #-} + _lhsInonterminals + {-# LINE 892 "DefaultRules.hs" #-} + )) of + { !_prodsOnonterminals -> + (case (({-# LINE 654 "DefaultRules.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsIaugmentsIn + {-# LINE 897 "DefaultRules.hs" #-} + )) of + { !_augmentsIn -> + (case (({-# LINE 651 "DefaultRules.ag" #-} + _augmentsIn + {-# LINE 902 "DefaultRules.hs" #-} + )) of + { !_prodsOaugmentsIn -> + (case (({-# LINE 661 "DefaultRules.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsIaroundsIn + {-# LINE 907 "DefaultRules.hs" #-} + )) of + { !_aroundsIn -> + (case (({-# LINE 658 "DefaultRules.ag" #-} + _aroundsIn + {-# LINE 912 "DefaultRules.hs" #-} + )) of + { !_prodsOaroundsIn -> + (case (prods_ _prodsOaroundsIn _prodsOaugmentsIn _prodsOcr _prodsOinh _prodsOmanualAttrOrderMap _prodsOmergesIn _prodsOnonterminals _prodsOnt _prodsOo_rename _prodsOsyn _prodsOtypeSyns _prodsOuniq _prodsOuseMap ) of + { ( !_prodsIerrors,!_prodsIoutput,!_prodsIuniq) -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + _prodsIerrors + {-# LINE 919 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + Nonterminal nt_ params_ inh_ syn_ _prodsIoutput + {-# LINE 924 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 929 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _prodsIuniq + {-# LINE 934 "DefaultRules.hs" #-} + )) of + { !_lhsOuniq -> + ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) + in sem_Nonterminal_Nonterminal_1)) of + { ( !sem_Nonterminal_1) -> + ( _lhsOcollect_nts,sem_Nonterminal_1) }) }) ) +-- Nonterminals ------------------------------------------------ +{- + visit 0: + synthesized attribute: + collect_nts : Set NontermIdent + visit 1: + inherited attributes: + aroundsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + augmentsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + cr : Bool + manualAttrOrderMap : AttrOrderMap + mergesIn : Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) + nonterminals : Set NontermIdent + o_rename : Bool + typeSyns : TypeSyns + useMap : UseMap + chained attribute: + uniq : Int + synthesized attributes: + errors : Seq Error + output : SELF + alternatives: + alternative Cons: + child hd : Nonterminal + child tl : Nonterminals + visit 1: + local output : _ + alternative Nil: + visit 1: + local output : _ +-} +-- cata +sem_Nonterminals :: Nonterminals -> + T_Nonterminals +sem_Nonterminals !list = + (Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list) ) +-- semantic domain +newtype T_Nonterminals = T_Nonterminals (( (Set NontermIdent),T_Nonterminals_1 )) +newtype T_Nonterminals_1 = T_Nonterminals_1 ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + Bool -> + AttrOrderMap -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) -> + (Set NontermIdent) -> + Bool -> + TypeSyns -> + Int -> + UseMap -> + ( (Seq Error),Nonterminals ,Int)) +data Inh_Nonterminals = Inh_Nonterminals {aroundsIn_Inh_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),augmentsIn_Inh_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),cr_Inh_Nonterminals :: !(Bool),manualAttrOrderMap_Inh_Nonterminals :: !(AttrOrderMap),mergesIn_Inh_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))))),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 -> + Inh_Nonterminals -> + Syn_Nonterminals +wrap_Nonterminals !(T_Nonterminals sem ) !(Inh_Nonterminals _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap ) = + (let ( !_lhsOcollect_nts,!T_Nonterminals_1 sem_1) = sem + ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = sem_1 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsImanualAttrOrderMap _lhsImergesIn _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 (case (tl_ ) of + { ( !_tlIcollect_nts,!T_Nonterminals_1 tl_1) -> + (case (hd_ ) of + { ( !_hdIcollect_nts,!T_Nonterminal_1 hd_1) -> + (case (({-# LINE 125 "DefaultRules.ag" #-} + _hdIcollect_nts `Set.union` _tlIcollect_nts + {-# LINE 1009 "DefaultRules.hs" #-} + )) of + { !_lhsOcollect_nts -> + (case ((let sem_Nonterminals_Cons_1 :: T_Nonterminals_1 + sem_Nonterminals_Cons_1 = + (T_Nonterminals_1 (\ (!_lhsIaroundsIn) + (!_lhsIaugmentsIn) + (!_lhsIcr) + (!_lhsImanualAttrOrderMap) + (!_lhsImergesIn) + (!_lhsInonterminals) + (!_lhsIo_rename) + (!_lhsItypeSyns) + (!_lhsIuniq) + (!_lhsIuseMap) -> + (case (({-# LINE 138 "DefaultRules.ag" #-} + _lhsIuseMap + {-# LINE 1026 "DefaultRules.hs" #-} + )) of + { !_tlOuseMap -> + (case (({-# LINE 55 "DefaultRules.ag" #-} + _lhsItypeSyns + {-# LINE 1031 "DefaultRules.hs" #-} + )) of + { !_tlOtypeSyns -> + (case (({-# LINE 43 "DefaultRules.ag" #-} + _lhsIo_rename + {-# LINE 1036 "DefaultRules.hs" #-} + )) of + { !_tlOo_rename -> + (case (({-# LINE 664 "DefaultRules.ag" #-} + _lhsImergesIn + {-# LINE 1041 "DefaultRules.hs" #-} + )) of + { !_tlOmergesIn -> + (case (({-# LINE 583 "DefaultRules.ag" #-} + _lhsImanualAttrOrderMap + {-# LINE 1046 "DefaultRules.hs" #-} + )) of + { !_tlOmanualAttrOrderMap -> + (case (({-# LINE 44 "DefaultRules.ag" #-} + _lhsIcr + {-# LINE 1051 "DefaultRules.hs" #-} + )) of + { !_tlOcr -> + (case (({-# LINE 138 "DefaultRules.ag" #-} + _lhsIuseMap + {-# LINE 1056 "DefaultRules.hs" #-} + )) of + { !_hdOuseMap -> + (case (({-# LINE 55 "DefaultRules.ag" #-} + _lhsItypeSyns + {-# LINE 1061 "DefaultRules.hs" #-} + )) of + { !_hdOtypeSyns -> + (case (({-# LINE 43 "DefaultRules.ag" #-} + _lhsIo_rename + {-# LINE 1066 "DefaultRules.hs" #-} + )) of + { !_hdOo_rename -> + (case (({-# LINE 664 "DefaultRules.ag" #-} + _lhsImergesIn + {-# LINE 1071 "DefaultRules.hs" #-} + )) of + { !_hdOmergesIn -> + (case (({-# LINE 583 "DefaultRules.ag" #-} + _lhsImanualAttrOrderMap + {-# LINE 1076 "DefaultRules.hs" #-} + )) of + { !_hdOmanualAttrOrderMap -> + (case (({-# LINE 44 "DefaultRules.ag" #-} + _lhsIcr + {-# LINE 1081 "DefaultRules.hs" #-} + )) of + { !_hdOcr -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _lhsIuniq + {-# LINE 1086 "DefaultRules.hs" #-} + )) of + { !_hdOuniq -> + (case (({-# LINE 129 "DefaultRules.ag" #-} + _lhsInonterminals + {-# LINE 1091 "DefaultRules.hs" #-} + )) of + { !_hdOnonterminals -> + (case (({-# LINE 650 "DefaultRules.ag" #-} + _lhsIaugmentsIn + {-# LINE 1096 "DefaultRules.hs" #-} + )) of + { !_hdOaugmentsIn -> + (case (({-# LINE 657 "DefaultRules.ag" #-} + _lhsIaroundsIn + {-# LINE 1101 "DefaultRules.hs" #-} + )) of + { !_hdOaroundsIn -> + (case (hd_1 _hdOaroundsIn _hdOaugmentsIn _hdOcr _hdOmanualAttrOrderMap _hdOmergesIn _hdOnonterminals _hdOo_rename _hdOtypeSyns _hdOuniq _hdOuseMap ) of + { ( !_hdIerrors,!_hdIoutput,!_hdIuniq) -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _hdIuniq + {-# LINE 1108 "DefaultRules.hs" #-} + )) of + { !_tlOuniq -> + (case (({-# LINE 129 "DefaultRules.ag" #-} + _lhsInonterminals + {-# LINE 1113 "DefaultRules.hs" #-} + )) of + { !_tlOnonterminals -> + (case (({-# LINE 650 "DefaultRules.ag" #-} + _lhsIaugmentsIn + {-# LINE 1118 "DefaultRules.hs" #-} + )) of + { !_tlOaugmentsIn -> + (case (({-# LINE 657 "DefaultRules.ag" #-} + _lhsIaroundsIn + {-# LINE 1123 "DefaultRules.hs" #-} + )) of + { !_tlOaroundsIn -> + (case (tl_1 _tlOaroundsIn _tlOaugmentsIn _tlOcr _tlOmanualAttrOrderMap _tlOmergesIn _tlOnonterminals _tlOo_rename _tlOtypeSyns _tlOuniq _tlOuseMap ) of + { ( !_tlIerrors,!_tlIoutput,!_tlIuniq) -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 1130 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 1135 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 1140 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _tlIuniq + {-# LINE 1145 "DefaultRules.hs" #-} + )) of + { !_lhsOuniq -> + ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) + in sem_Nonterminals_Cons_1)) of + { ( !sem_Nonterminals_1) -> + ( _lhsOcollect_nts,sem_Nonterminals_1) }) }) }) }) ) +sem_Nonterminals_Nil :: T_Nonterminals +sem_Nonterminals_Nil = + (T_Nonterminals (case (({-# LINE 125 "DefaultRules.ag" #-} + Set.empty + {-# LINE 1156 "DefaultRules.hs" #-} + )) of + { !_lhsOcollect_nts -> + (case ((let sem_Nonterminals_Nil_1 :: T_Nonterminals_1 + sem_Nonterminals_Nil_1 = + (T_Nonterminals_1 (\ (!_lhsIaroundsIn) + (!_lhsIaugmentsIn) + (!_lhsIcr) + (!_lhsImanualAttrOrderMap) + (!_lhsImergesIn) + (!_lhsInonterminals) + (!_lhsIo_rename) + (!_lhsItypeSyns) + (!_lhsIuniq) + (!_lhsIuseMap) -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + Seq.empty + {-# LINE 1173 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + [] + {-# LINE 1178 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 1183 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _lhsIuniq + {-# LINE 1188 "DefaultRules.hs" #-} + )) of + { !_lhsOuniq -> + ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) })) ) + in sem_Nonterminals_Nil_1)) of + { ( !sem_Nonterminals_1) -> + ( _lhsOcollect_nts,sem_Nonterminals_1) }) }) ) +-- 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 -> + Inh_Pattern -> + Syn_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) -> + (case (({-# LINE 489 "DefaultRules.ag" #-} + True + {-# LINE 1275 "DefaultRules.hs" #-} + )) of + { !_lhsOcontainsVars -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 1280 "DefaultRules.hs" #-} + )) of + { !_partsOnt -> + (case (({-# LINE 35 "DefaultRules.ag" #-} + _lhsIcon + {-# LINE 1285 "DefaultRules.hs" #-} + )) of + { !_partsOcon -> + (case (parts_ _partsOcon _partsOnt ) of + { ( !_partsIcontainsVars,!_partsIcopy,!_partsIdefinedAttrs,!_partsIerrors,!_partsIlocals,!_partsIoutput) -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 1292 "DefaultRules.hs" #-} + )) of + { !_patOnt -> + (case (({-# LINE 35 "DefaultRules.ag" #-} + _lhsIcon + {-# LINE 1297 "DefaultRules.hs" #-} + )) of + { !_patOcon -> + (case (pat_ _patOcon _patOnt ) of + { ( !_patIcontainsVars,!_patIcopy,!_patIdefinedAttrs,!_patIerrors,!_patIlocals,!_patIoutput) -> + (case (({-# LINE 23 "./Patterns.ag" #-} + Alias field_ attr_ _patIcopy _partsIcopy + {-# LINE 1304 "DefaultRules.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1309 "DefaultRules.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 471 "DefaultRules.ag" #-} + Set.insert (field_,attr_) _patIdefinedAttrs + {-# LINE 1314 "DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + _patIerrors Seq.>< _partsIerrors + {-# LINE 1319 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 472 "DefaultRules.ag" #-} + if field_ == _LOC + then Set.insert attr_ _patIlocals + else _patIlocals + {-# LINE 1326 "DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + Alias field_ attr_ _patIoutput _partsIoutput + {-# LINE 1331 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 1336 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _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) -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 1348 "DefaultRules.hs" #-} + )) of + { !_patsOnt -> + (case (({-# LINE 35 "DefaultRules.ag" #-} + _lhsIcon + {-# LINE 1353 "DefaultRules.hs" #-} + )) of + { !_patsOcon -> + (case (pats_ _patsOcon _patsOnt ) of + { ( !_patsIcontainsVars,!_patsIcopy,!_patsIdefinedAttrs,!_patsIerrors,!_patsIlocals,!_patsIoutput) -> + (case (({-# LINE 486 "DefaultRules.ag" #-} + _patsIcontainsVars + {-# LINE 1360 "DefaultRules.hs" #-} + )) of + { !_lhsOcontainsVars -> + (case (({-# LINE 23 "./Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 1365 "DefaultRules.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1370 "DefaultRules.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 466 "DefaultRules.ag" #-} + _patsIdefinedAttrs + {-# LINE 1375 "DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + _patsIerrors + {-# LINE 1380 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 465 "DefaultRules.ag" #-} + _patsIlocals + {-# LINE 1385 "DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + Constr name_ _patsIoutput + {-# LINE 1390 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 1395 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) })) ) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable !(T_Pattern pat_ ) = + (T_Pattern (\ (!_lhsIcon) + (!_lhsInt) -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 1406 "DefaultRules.hs" #-} + )) of + { !_patOnt -> + (case (({-# LINE 35 "DefaultRules.ag" #-} + _lhsIcon + {-# LINE 1411 "DefaultRules.hs" #-} + )) of + { !_patOcon -> + (case (pat_ _patOcon _patOnt ) of + { ( !_patIcontainsVars,!_patIcopy,!_patIdefinedAttrs,!_patIerrors,!_patIlocals,!_patIoutput) -> + (case (({-# LINE 486 "DefaultRules.ag" #-} + _patIcontainsVars + {-# LINE 1418 "DefaultRules.hs" #-} + )) of + { !_lhsOcontainsVars -> + (case (({-# LINE 23 "./Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 1423 "DefaultRules.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1428 "DefaultRules.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 466 "DefaultRules.ag" #-} + _patIdefinedAttrs + {-# LINE 1433 "DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + _patIerrors + {-# LINE 1438 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 465 "DefaultRules.ag" #-} + _patIlocals + {-# LINE 1443 "DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + Irrefutable _patIoutput + {-# LINE 1448 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 1453 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _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) -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 1465 "DefaultRules.hs" #-} + )) of + { !_patsOnt -> + (case (({-# LINE 35 "DefaultRules.ag" #-} + _lhsIcon + {-# LINE 1470 "DefaultRules.hs" #-} + )) of + { !_patsOcon -> + (case (pats_ _patsOcon _patsOnt ) of + { ( !_patsIcontainsVars,!_patsIcopy,!_patsIdefinedAttrs,!_patsIerrors,!_patsIlocals,!_patsIoutput) -> + (case (({-# LINE 486 "DefaultRules.ag" #-} + _patsIcontainsVars + {-# LINE 1477 "DefaultRules.hs" #-} + )) of + { !_lhsOcontainsVars -> + (case (({-# LINE 23 "./Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 1482 "DefaultRules.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1487 "DefaultRules.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 466 "DefaultRules.ag" #-} + _patsIdefinedAttrs + {-# LINE 1492 "DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + _patsIerrors + {-# LINE 1497 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 465 "DefaultRules.ag" #-} + _patsIlocals + {-# LINE 1502 "DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + Product pos_ _patsIoutput + {-# LINE 1507 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 1512 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) })) ) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore !pos_ = + (T_Pattern (\ (!_lhsIcon) + (!_lhsInt) -> + (case (({-# LINE 486 "DefaultRules.ag" #-} + False + {-# LINE 1523 "DefaultRules.hs" #-} + )) of + { !_lhsOcontainsVars -> + (case (({-# LINE 23 "./Patterns.ag" #-} + Underscore pos_ + {-# LINE 1528 "DefaultRules.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1533 "DefaultRules.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 466 "DefaultRules.ag" #-} + Set.empty + {-# LINE 1538 "DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + Seq.empty + {-# LINE 1543 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 465 "DefaultRules.ag" #-} + Set.empty + {-# LINE 1548 "DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + Underscore pos_ + {-# LINE 1553 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 1558 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _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 -> + Inh_Patterns -> + Syn_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) -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 1612 "DefaultRules.hs" #-} + )) of + { !_tlOnt -> + (case (({-# LINE 35 "DefaultRules.ag" #-} + _lhsIcon + {-# LINE 1617 "DefaultRules.hs" #-} + )) of + { !_tlOcon -> + (case (tl_ _tlOcon _tlOnt ) of + { ( !_tlIcontainsVars,!_tlIcopy,!_tlIdefinedAttrs,!_tlIerrors,!_tlIlocals,!_tlIoutput) -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 1624 "DefaultRules.hs" #-} + )) of + { !_hdOnt -> + (case (({-# LINE 35 "DefaultRules.ag" #-} + _lhsIcon + {-# LINE 1629 "DefaultRules.hs" #-} + )) of + { !_hdOcon -> + (case (hd_ _hdOcon _hdOnt ) of + { ( !_hdIcontainsVars,!_hdIcopy,!_hdIdefinedAttrs,!_hdIerrors,!_hdIlocals,!_hdIoutput) -> + (case (({-# LINE 486 "DefaultRules.ag" #-} + _hdIcontainsVars || _tlIcontainsVars + {-# LINE 1636 "DefaultRules.hs" #-} + )) of + { !_lhsOcontainsVars -> + (case (({-# LINE 23 "./Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 1641 "DefaultRules.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1646 "DefaultRules.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 466 "DefaultRules.ag" #-} + _hdIdefinedAttrs `Set.union` _tlIdefinedAttrs + {-# LINE 1651 "DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 1656 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 465 "DefaultRules.ag" #-} + _hdIlocals `Set.union` _tlIlocals + {-# LINE 1661 "DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 1666 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 1671 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (\ (!_lhsIcon) + (!_lhsInt) -> + (case (({-# LINE 486 "DefaultRules.ag" #-} + False + {-# LINE 1681 "DefaultRules.hs" #-} + )) of + { !_lhsOcontainsVars -> + (case (({-# LINE 23 "./Patterns.ag" #-} + [] + {-# LINE 1686 "DefaultRules.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 1691 "DefaultRules.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 466 "DefaultRules.ag" #-} + Set.empty + {-# LINE 1696 "DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + Seq.empty + {-# LINE 1701 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 465 "DefaultRules.ag" #-} + Set.empty + {-# LINE 1706 "DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + [] + {-# LINE 1711 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 1716 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) })) ) +-- Production -------------------------------------------------- +{- + visit 0: + inherited attributes: + aroundsIn : Map ConstructorIdent (Map Identifier [Expression]) + augmentsIn : Map ConstructorIdent (Map Identifier [Expression]) + cr : Bool + inh : Attributes + manualAttrOrderMap : AttrOrderMap + mergesIn : Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)) + 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 mergesIn : _ + local merged : _ + local orderDeps : _ + local orderErrs : _ + local _tup1 : _ + local errs : _ + local aroundsIn : _ + local augmentsIn : _ + local newRls : _ + local extra1 : _ + local extra2 : _ + local extra3 : _ +-} +-- cata +sem_Production :: Production -> + T_Production +sem_Production !(Production _con _children _rules _typeSigs ) = + (sem_Production_Production _con (sem_Children _children ) (sem_Rules _rules ) (sem_TypeSigs _typeSigs ) ) +-- semantic domain +newtype T_Production = T_Production ((Map ConstructorIdent (Map Identifier [Expression])) -> + (Map ConstructorIdent (Map Identifier [Expression])) -> + Bool -> + Attributes -> + AttrOrderMap -> + (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) -> + (Set NontermIdent) -> + NontermIdent -> + Bool -> + Attributes -> + TypeSyns -> + Int -> + (Map Identifier (String,String,String)) -> + ( (Seq Error),Production ,Int)) +data Inh_Production = Inh_Production {aroundsIn_Inh_Production :: !((Map ConstructorIdent (Map Identifier [Expression]))),augmentsIn_Inh_Production :: !((Map ConstructorIdent (Map Identifier [Expression]))),cr_Inh_Production :: !(Bool),inh_Inh_Production :: !(Attributes),manualAttrOrderMap_Inh_Production :: !(AttrOrderMap),mergesIn_Inh_Production :: !((Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))),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 -> + Inh_Production -> + Syn_Production +wrap_Production !(T_Production sem ) !(Inh_Production _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap ) = + (let ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = sem _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsImergesIn _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 (\ (!_lhsIaroundsIn) + (!_lhsIaugmentsIn) + (!_lhsIcr) + (!_lhsIinh) + (!_lhsImanualAttrOrderMap) + (!_lhsImergesIn) + (!_lhsInonterminals) + (!_lhsInt) + (!_lhsIo_rename) + (!_lhsIsyn) + (!_lhsItypeSyns) + (!_lhsIuniq) + (!_lhsIuseMap) -> + (case (({-# LINE 670 "DefaultRules.ag" #-} + Map.findWithDefault Map.empty con_ _lhsImergesIn + {-# LINE 1810 "DefaultRules.hs" #-} + )) of + { !_mergesIn -> + (case (({-# LINE 671 "DefaultRules.ag" #-} + Set.fromList [ c | (_,cs,_) <- Map.elems _mergesIn , c <- cs ] + {-# LINE 1815 "DefaultRules.hs" #-} + )) of + { !_merged -> + (case (({-# LINE 666 "DefaultRules.ag" #-} + _merged + {-# LINE 1820 "DefaultRules.hs" #-} + )) of + { !_childrenOmerged -> + (case (({-# LINE 597 "DefaultRules.ag" #-} + Set.toList $ Map.findWithDefault Set.empty con_ $ Map.findWithDefault Map.empty _lhsInt _lhsImanualAttrOrderMap + {-# LINE 1825 "DefaultRules.hs" #-} + )) of + { !_orderDeps -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _lhsIuniq + {-# LINE 1830 "DefaultRules.hs" #-} + )) of + { !_rulesOuniq -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 1835 "DefaultRules.hs" #-} + )) of + { !_rulesOnt -> + (case (({-# LINE 147 "DefaultRules.ag" #-} + con_ + {-# LINE 1840 "DefaultRules.hs" #-} + )) of + { !_rulesOcon -> + (case (rules_ _rulesOcon _rulesOnt _rulesOuniq ) of + { ( !_rulesIdefinedAttrs,!_rulesIerrors,!_rulesIlocals,!_rulesIoutput,!_rulesIruleNames,!_rulesIuniq) -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 1847 "DefaultRules.hs" #-} + )) of + { !_childrenOnt -> + (case (({-# LINE 47 "DefaultRules.ag" #-} + _lhsIcr + {-# LINE 1852 "DefaultRules.hs" #-} + )) of + { !_childrenOcr -> + (case (({-# LINE 148 "DefaultRules.ag" #-} + con_ + {-# LINE 1857 "DefaultRules.hs" #-} + )) of + { !_childrenOcon -> + (case (children_ _childrenOcon _childrenOcr _childrenOmerged _childrenOnt ) of + { ( !_childrenIerrors,!_childrenIfields,!_childrenIinputs,!_childrenIoutput,!_childrenIoutputs) -> + (case (({-# LINE 599 "DefaultRules.ag" #-} + 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] + existsRule nm = if nm `Set.member` _rulesIruleNames + then [] + else [MissingNamedRule _lhsInt con_ nm] + checkIn (OccAttr fld nm) = isInAttribute fld nm + checkIn (OccRule nm) = existsRule nm + checkOut (OccAttr fld nm) = isOutAttribute fld nm + checkOut (OccRule nm) = existsRule nm + in Seq.fromList . concat $ + [ checkIn occA ++ checkOut occB + | (Dependency occA occB) <- _orderDeps + ] + {-# LINE 1898 "DefaultRules.hs" #-} + )) of + { !_orderErrs -> + (case (({-# LINE 336 "DefaultRules.ag" #-} + 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,virt) <- _childrenIfields, childExists virt]) + | 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 + childExists Nothing = True + childExists (Just (Just _)) = True + childExists (Just Nothing) = False + 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> + (case (({-# LINE 336 "DefaultRules.ag" #-} + __tup1 + {-# LINE 1963 "DefaultRules.hs" #-} + )) of + { !(_,!_errs) -> + (case (({-# LINE 334 "DefaultRules.ag" #-} + _childrenIerrors >< _errs >< _rulesIerrors >< _orderErrs + {-# LINE 1968 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 662 "DefaultRules.ag" #-} + Map.findWithDefault Map.empty con_ _lhsIaroundsIn + {-# LINE 1973 "DefaultRules.hs" #-} + )) of + { !_aroundsIn -> + (case (({-# LINE 655 "DefaultRules.ag" #-} + Map.findWithDefault Map.empty con_ _lhsIaugmentsIn + {-# LINE 1978 "DefaultRules.hs" #-} + )) of + { !_augmentsIn -> + (case (({-# LINE 336 "DefaultRules.ag" #-} + __tup1 + {-# LINE 1983 "DefaultRules.hs" #-} + )) of + { !(!_newRls,_) -> + (case (({-# LINE 509 "DefaultRules.ag" #-} + foldr addAugments (_rulesIoutput ++ _newRls) (Map.assocs _augmentsIn ) + {-# LINE 1988 "DefaultRules.hs" #-} + )) of + { !_extra1 -> + (case (({-# LINE 510 "DefaultRules.ag" #-} + foldr addArounds _extra1 (Map.assocs _aroundsIn ) + {-# LINE 1993 "DefaultRules.hs" #-} + )) of + { !_extra2 -> + (case (({-# LINE 511 "DefaultRules.ag" #-} + foldr addMerges _extra2 (Map.assocs _mergesIn ) + {-# LINE 1998 "DefaultRules.hs" #-} + )) of + { !_extra3 -> + (case (typeSigs_ ) of + { ( !_typeSigsIoutput) -> + (case (({-# LINE 512 "DefaultRules.ag" #-} + Production con_ _childrenIoutput _extra3 _typeSigsIoutput + {-# LINE 2005 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _rulesIuniq + {-# LINE 2010 "DefaultRules.hs" #-} + )) of + { !_lhsOuniq -> + ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) +-- Productions ------------------------------------------------- +{- + visit 0: + inherited attributes: + aroundsIn : Map ConstructorIdent (Map Identifier [Expression]) + augmentsIn : Map ConstructorIdent (Map Identifier [Expression]) + cr : Bool + inh : Attributes + manualAttrOrderMap : AttrOrderMap + mergesIn : Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)) + 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 ((Map ConstructorIdent (Map Identifier [Expression])) -> + (Map ConstructorIdent (Map Identifier [Expression])) -> + Bool -> + Attributes -> + AttrOrderMap -> + (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) -> + (Set NontermIdent) -> + NontermIdent -> + Bool -> + Attributes -> + TypeSyns -> + Int -> + (Map Identifier (String,String,String)) -> + ( (Seq Error),Productions ,Int)) +data Inh_Productions = Inh_Productions {aroundsIn_Inh_Productions :: !((Map ConstructorIdent (Map Identifier [Expression]))),augmentsIn_Inh_Productions :: !((Map ConstructorIdent (Map Identifier [Expression]))),cr_Inh_Productions :: !(Bool),inh_Inh_Productions :: !(Attributes),manualAttrOrderMap_Inh_Productions :: !(AttrOrderMap),mergesIn_Inh_Productions :: !((Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))),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 -> + Inh_Productions -> + Syn_Productions +wrap_Productions !(T_Productions sem ) !(Inh_Productions _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap ) = + (let ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = sem _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsImergesIn _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 (\ (!_lhsIaroundsIn) + (!_lhsIaugmentsIn) + (!_lhsIcr) + (!_lhsIinh) + (!_lhsImanualAttrOrderMap) + (!_lhsImergesIn) + (!_lhsInonterminals) + (!_lhsInt) + (!_lhsIo_rename) + (!_lhsIsyn) + (!_lhsItypeSyns) + (!_lhsIuniq) + (!_lhsIuseMap) -> + (case (({-# LINE 139 "DefaultRules.ag" #-} + _lhsIuseMap + {-# LINE 2092 "DefaultRules.hs" #-} + )) of + { !_tlOuseMap -> + (case (({-# LINE 55 "DefaultRules.ag" #-} + _lhsItypeSyns + {-# LINE 2097 "DefaultRules.hs" #-} + )) of + { !_tlOtypeSyns -> + (case (({-# LINE 139 "DefaultRules.ag" #-} + _lhsIsyn + {-# LINE 2102 "DefaultRules.hs" #-} + )) of + { !_tlOsyn -> + (case (({-# LINE 43 "DefaultRules.ag" #-} + _lhsIo_rename + {-# LINE 2107 "DefaultRules.hs" #-} + )) of + { !_tlOo_rename -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 2112 "DefaultRules.hs" #-} + )) of + { !_tlOnt -> + (case (({-# LINE 665 "DefaultRules.ag" #-} + _lhsImergesIn + {-# LINE 2117 "DefaultRules.hs" #-} + )) of + { !_tlOmergesIn -> + (case (({-# LINE 583 "DefaultRules.ag" #-} + _lhsImanualAttrOrderMap + {-# LINE 2122 "DefaultRules.hs" #-} + )) of + { !_tlOmanualAttrOrderMap -> + (case (({-# LINE 139 "DefaultRules.ag" #-} + _lhsIinh + {-# LINE 2127 "DefaultRules.hs" #-} + )) of + { !_tlOinh -> + (case (({-# LINE 44 "DefaultRules.ag" #-} + _lhsIcr + {-# LINE 2132 "DefaultRules.hs" #-} + )) of + { !_tlOcr -> + (case (({-# LINE 139 "DefaultRules.ag" #-} + _lhsIuseMap + {-# LINE 2137 "DefaultRules.hs" #-} + )) of + { !_hdOuseMap -> + (case (({-# LINE 55 "DefaultRules.ag" #-} + _lhsItypeSyns + {-# LINE 2142 "DefaultRules.hs" #-} + )) of + { !_hdOtypeSyns -> + (case (({-# LINE 139 "DefaultRules.ag" #-} + _lhsIsyn + {-# LINE 2147 "DefaultRules.hs" #-} + )) of + { !_hdOsyn -> + (case (({-# LINE 43 "DefaultRules.ag" #-} + _lhsIo_rename + {-# LINE 2152 "DefaultRules.hs" #-} + )) of + { !_hdOo_rename -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 2157 "DefaultRules.hs" #-} + )) of + { !_hdOnt -> + (case (({-# LINE 665 "DefaultRules.ag" #-} + _lhsImergesIn + {-# LINE 2162 "DefaultRules.hs" #-} + )) of + { !_hdOmergesIn -> + (case (({-# LINE 583 "DefaultRules.ag" #-} + _lhsImanualAttrOrderMap + {-# LINE 2167 "DefaultRules.hs" #-} + )) of + { !_hdOmanualAttrOrderMap -> + (case (({-# LINE 139 "DefaultRules.ag" #-} + _lhsIinh + {-# LINE 2172 "DefaultRules.hs" #-} + )) of + { !_hdOinh -> + (case (({-# LINE 44 "DefaultRules.ag" #-} + _lhsIcr + {-# LINE 2177 "DefaultRules.hs" #-} + )) of + { !_hdOcr -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _lhsIuniq + {-# LINE 2182 "DefaultRules.hs" #-} + )) of + { !_hdOuniq -> + (case (({-# LINE 129 "DefaultRules.ag" #-} + _lhsInonterminals + {-# LINE 2187 "DefaultRules.hs" #-} + )) of + { !_hdOnonterminals -> + (case (({-# LINE 651 "DefaultRules.ag" #-} + _lhsIaugmentsIn + {-# LINE 2192 "DefaultRules.hs" #-} + )) of + { !_hdOaugmentsIn -> + (case (({-# LINE 658 "DefaultRules.ag" #-} + _lhsIaroundsIn + {-# LINE 2197 "DefaultRules.hs" #-} + )) of + { !_hdOaroundsIn -> + (case (hd_ _hdOaroundsIn _hdOaugmentsIn _hdOcr _hdOinh _hdOmanualAttrOrderMap _hdOmergesIn _hdOnonterminals _hdOnt _hdOo_rename _hdOsyn _hdOtypeSyns _hdOuniq _hdOuseMap ) of + { ( !_hdIerrors,!_hdIoutput,!_hdIuniq) -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _hdIuniq + {-# LINE 2204 "DefaultRules.hs" #-} + )) of + { !_tlOuniq -> + (case (({-# LINE 129 "DefaultRules.ag" #-} + _lhsInonterminals + {-# LINE 2209 "DefaultRules.hs" #-} + )) of + { !_tlOnonterminals -> + (case (({-# LINE 651 "DefaultRules.ag" #-} + _lhsIaugmentsIn + {-# LINE 2214 "DefaultRules.hs" #-} + )) of + { !_tlOaugmentsIn -> + (case (({-# LINE 658 "DefaultRules.ag" #-} + _lhsIaroundsIn + {-# LINE 2219 "DefaultRules.hs" #-} + )) of + { !_tlOaroundsIn -> + (case (tl_ _tlOaroundsIn _tlOaugmentsIn _tlOcr _tlOinh _tlOmanualAttrOrderMap _tlOmergesIn _tlOnonterminals _tlOnt _tlOo_rename _tlOsyn _tlOtypeSyns _tlOuniq _tlOuseMap ) of + { ( !_tlIerrors,!_tlIoutput,!_tlIuniq) -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 2226 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 2231 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 2236 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _tlIuniq + {-# LINE 2241 "DefaultRules.hs" #-} + )) of + { !_lhsOuniq -> + ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) +sem_Productions_Nil :: T_Productions +sem_Productions_Nil = + (T_Productions (\ (!_lhsIaroundsIn) + (!_lhsIaugmentsIn) + (!_lhsIcr) + (!_lhsIinh) + (!_lhsImanualAttrOrderMap) + (!_lhsImergesIn) + (!_lhsInonterminals) + (!_lhsInt) + (!_lhsIo_rename) + (!_lhsIsyn) + (!_lhsItypeSyns) + (!_lhsIuniq) + (!_lhsIuseMap) -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + Seq.empty + {-# LINE 2262 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + [] + {-# LINE 2267 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 2272 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _lhsIuniq + {-# LINE 2277 "DefaultRules.hs" #-} + )) of + { !_lhsOuniq -> + ( _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 + ruleNames : Set Identifier + alternatives: + alternative Rule: + child mbName : {Maybe Identifier} + child pattern : Pattern + child rhs : {Expression} + child owrt : {Bool} + child origin : {String} + child explicit : {Bool} + visit 0: + local output : _ + local _tup2 : {(Rules,Int)} +-} +-- cata +sem_Rule :: Rule -> + T_Rule +sem_Rule !(Rule _mbName _pattern _rhs _owrt _origin _explicit ) = + (sem_Rule_Rule _mbName (sem_Pattern _pattern ) _rhs _owrt _origin _explicit ) +-- semantic domain +newtype T_Rule = T_Rule (ConstructorIdent -> + NontermIdent -> + Int -> + ( Bool,(Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Rule ,Rules ,(Set Identifier),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 ),ruleNames_Syn_Rule :: !((Set Identifier)),uniq_Syn_Rule :: !(Int)} +wrap_Rule :: T_Rule -> + Inh_Rule -> + Syn_Rule +wrap_Rule !(T_Rule sem ) !(Inh_Rule _lhsIcon _lhsInt _lhsIuniq ) = + (let ( !_lhsOcontainsVars,!_lhsOdefinedAttrs,!_lhsOerrors,!_lhsOlocals,!_lhsOoutput,!_lhsOoutputs,!_lhsOruleNames,!_lhsOuniq) = sem _lhsIcon _lhsInt _lhsIuniq + in (Syn_Rule _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOoutputs _lhsOruleNames _lhsOuniq )) +sem_Rule_Rule :: (Maybe Identifier) -> + T_Pattern -> + Expression -> + Bool -> + String -> + Bool -> + T_Rule +sem_Rule_Rule !mbName_ !(T_Pattern pattern_ ) !rhs_ !owrt_ !origin_ !explicit_ = + (T_Rule (\ (!_lhsIcon) + (!_lhsInt) + (!_lhsIuniq) -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 2340 "DefaultRules.hs" #-} + )) of + { !_patternOnt -> + (case (({-# LINE 35 "DefaultRules.ag" #-} + _lhsIcon + {-# LINE 2345 "DefaultRules.hs" #-} + )) of + { !_patternOcon -> + (case (pattern_ _patternOcon _patternOnt ) of + { ( !_patternIcontainsVars,!_patternIcopy,!_patternIdefinedAttrs,!_patternIerrors,!_patternIlocals,!_patternIoutput) -> + (case (({-# LINE 486 "DefaultRules.ag" #-} + _patternIcontainsVars + {-# LINE 2352 "DefaultRules.hs" #-} + )) of + { !_lhsOcontainsVars -> + (case (({-# LINE 466 "DefaultRules.ag" #-} + _patternIdefinedAttrs + {-# LINE 2357 "DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + _patternIerrors + {-# LINE 2362 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 465 "DefaultRules.ag" #-} + _patternIlocals + {-# LINE 2367 "DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + Rule mbName_ _patternIoutput rhs_ owrt_ origin_ explicit_ + {-# LINE 2372 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 2377 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 519 "DefaultRules.ag" #-} + multiRule _output _lhsIuniq + {-# LINE 2382 "DefaultRules.hs" #-} + )) of + { !__tup2 -> + (case (({-# LINE 519 "DefaultRules.ag" #-} + __tup2 + {-# LINE 2387 "DefaultRules.hs" #-} + )) of + { !(!_lhsOoutputs,_) -> + (case (({-# LINE 591 "DefaultRules.ag" #-} + case mbName_ of + Nothing -> Set.empty + Just nm -> Set.singleton nm + {-# LINE 2394 "DefaultRules.hs" #-} + )) of + { !_lhsOruleNames -> + (case (({-# LINE 519 "DefaultRules.ag" #-} + __tup2 + {-# LINE 2399 "DefaultRules.hs" #-} + )) of + { !(_,!_lhsOuniq) -> + ( _lhsOcontainsVars,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOoutputs,_lhsOruleNames,_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 + ruleNames : Set Identifier + alternatives: + alternative Cons: + child hd : Rule + child tl : Rules + 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 ,(Set Identifier),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 ),ruleNames_Syn_Rules :: !((Set Identifier)),uniq_Syn_Rules :: !(Int)} +wrap_Rules :: T_Rules -> + Inh_Rules -> + Syn_Rules +wrap_Rules !(T_Rules sem ) !(Inh_Rules _lhsIcon _lhsInt _lhsIuniq ) = + (let ( !_lhsOdefinedAttrs,!_lhsOerrors,!_lhsOlocals,!_lhsOoutput,!_lhsOruleNames,!_lhsOuniq) = sem _lhsIcon _lhsInt _lhsIuniq + in (Syn_Rules _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOruleNames _lhsOuniq )) +sem_Rules_Cons :: T_Rule -> + T_Rules -> + T_Rules +sem_Rules_Cons !(T_Rule hd_ ) !(T_Rules tl_ ) = + (T_Rules (\ (!_lhsIcon) + (!_lhsInt) + (!_lhsIuniq) -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _lhsIuniq + {-# LINE 2452 "DefaultRules.hs" #-} + )) of + { !_hdOuniq -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 2457 "DefaultRules.hs" #-} + )) of + { !_hdOnt -> + (case (({-# LINE 35 "DefaultRules.ag" #-} + _lhsIcon + {-# LINE 2462 "DefaultRules.hs" #-} + )) of + { !_hdOcon -> + (case (hd_ _hdOcon _hdOnt _hdOuniq ) of + { ( !_hdIcontainsVars,!_hdIdefinedAttrs,!_hdIerrors,!_hdIlocals,!_hdIoutput,!_hdIoutputs,!_hdIruleNames,!_hdIuniq) -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _hdIuniq + {-# LINE 2469 "DefaultRules.hs" #-} + )) of + { !_tlOuniq -> + (case (({-# LINE 34 "DefaultRules.ag" #-} + _lhsInt + {-# LINE 2474 "DefaultRules.hs" #-} + )) of + { !_tlOnt -> + (case (({-# LINE 35 "DefaultRules.ag" #-} + _lhsIcon + {-# LINE 2479 "DefaultRules.hs" #-} + )) of + { !_tlOcon -> + (case (tl_ _tlOcon _tlOnt _tlOuniq ) of + { ( !_tlIdefinedAttrs,!_tlIerrors,!_tlIlocals,!_tlIoutput,!_tlIruleNames,!_tlIuniq) -> + (case (({-# LINE 466 "DefaultRules.ag" #-} + _hdIdefinedAttrs `Set.union` _tlIdefinedAttrs + {-# LINE 2486 "DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 2491 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 465 "DefaultRules.ag" #-} + _hdIlocals `Set.union` _tlIlocals + {-# LINE 2496 "DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 515 "DefaultRules.ag" #-} + if _hdIcontainsVars then _hdIoutputs ++ _tlIoutput else _tlIoutput + {-# LINE 2501 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 589 "DefaultRules.ag" #-} + _hdIruleNames `Set.union` _tlIruleNames + {-# LINE 2506 "DefaultRules.hs" #-} + )) of + { !_lhsOruleNames -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _tlIuniq + {-# LINE 2511 "DefaultRules.hs" #-} + )) of + { !_lhsOuniq -> + ( _lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOruleNames,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) +sem_Rules_Nil :: T_Rules +sem_Rules_Nil = + (T_Rules (\ (!_lhsIcon) + (!_lhsInt) + (!_lhsIuniq) -> + (case (({-# LINE 466 "DefaultRules.ag" #-} + Set.empty + {-# LINE 2522 "DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 119 "DefaultRules.ag" #-} + Seq.empty + {-# LINE 2527 "DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 465 "DefaultRules.ag" #-} + Set.empty + {-# LINE 2532 "DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + [] + {-# LINE 2537 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 2542 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 589 "DefaultRules.ag" #-} + Set.empty + {-# LINE 2547 "DefaultRules.hs" #-} + )) of + { !_lhsOruleNames -> + (case (({-# LINE 495 "DefaultRules.ag" #-} + _lhsIuniq + {-# LINE 2552 "DefaultRules.hs" #-} + )) of + { !_lhsOuniq -> + ( _lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOruleNames,_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 -> + Inh_TypeSig -> + Syn_TypeSig +wrap_TypeSig !(T_TypeSig sem ) !(Inh_TypeSig ) = + (let ( !_lhsOoutput) = sem + in (Syn_TypeSig _lhsOoutput )) +sem_TypeSig_TypeSig :: Identifier -> + Type -> + T_TypeSig +sem_TypeSig_TypeSig !name_ !tp_ = + (T_TypeSig (case (({-# LINE 502 "DefaultRules.ag" #-} + TypeSig name_ tp_ + {-# LINE 2589 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 2594 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOoutput) }) }) ) +-- TypeSigs ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + output : SELF + alternatives: + alternative Cons: + child hd : TypeSig + child tl : TypeSigs + visit 0: + local output : _ + alternative Nil: + visit 0: + local output : _ +-} +-- cata +sem_TypeSigs :: TypeSigs -> + T_TypeSigs +sem_TypeSigs !list = + (Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) ) +-- semantic domain +newtype T_TypeSigs = T_TypeSigs (( TypeSigs )) +data Inh_TypeSigs = Inh_TypeSigs {} +data Syn_TypeSigs = Syn_TypeSigs {output_Syn_TypeSigs :: !(TypeSigs )} +wrap_TypeSigs :: T_TypeSigs -> + Inh_TypeSigs -> + Syn_TypeSigs +wrap_TypeSigs !(T_TypeSigs sem ) !(Inh_TypeSigs ) = + (let ( !_lhsOoutput) = sem + in (Syn_TypeSigs _lhsOoutput )) +sem_TypeSigs_Cons :: T_TypeSig -> + T_TypeSigs -> + T_TypeSigs +sem_TypeSigs_Cons !(T_TypeSig hd_ ) !(T_TypeSigs tl_ ) = + (T_TypeSigs (case (tl_ ) of + { ( !_tlIoutput) -> + (case (hd_ ) of + { ( !_hdIoutput) -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 2638 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 2643 "DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOoutput) }) }) }) }) ) +sem_TypeSigs_Nil :: T_TypeSigs +sem_TypeSigs_Nil = + (T_TypeSigs (case (({-# LINE 502 "DefaultRules.ag" #-} + [] + {-# LINE 2651 "DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 502 "DefaultRules.ag" #-} + _output + {-# LINE 2656 "DefaultRules.hs" #-} )) of { !_lhsOoutput -> ( _lhsOoutput) }) }) ) diff --git a/src/Version.hs b/src/Version.hs --- a/src/Version.hs +++ b/src/Version.hs @@ -1,4 +1,4 @@ module Version where banner :: String -banner = "Attribute Grammar compiler / HUT project. Version 0.9.38.4" +banner = "Attribute Grammar compiler / HUT project. Version 0.9.38.5" diff --git a/uuagc.cabal b/uuagc.cabal --- a/uuagc.cabal +++ b/uuagc.cabal @@ -1,7 +1,7 @@ cabal-version: >=1.2 build-type: Simple name: uuagc -version: 0.9.38.4 +version: 0.9.38.5 license: GPL license-file: LICENSE maintainer: Arie Middelkoop diff --git a/uuagc.cabal-for-ghc-6.6 b/uuagc.cabal-for-ghc-6.6 --- a/uuagc.cabal-for-ghc-6.6 +++ b/uuagc.cabal-for-ghc-6.6 @@ -1,5 +1,5 @@ name: uuagc -version: 0.9.38.4 +version: 0.9.38.5 license: GPL license-file: LICENSE maintainer: Arie Middelkoop