diff --git a/src-derived/AbstractSyntax.hs b/src-derived/AbstractSyntax.hs --- a/src-derived/AbstractSyntax.hs +++ b/src-derived/AbstractSyntax.hs @@ -40,8 +40,9 @@ child manualAttrOrderMap : {AttrOrderMap} child paramMap : {ParamMap} child contextMap : {ContextMap} + child uniqueMap : {UniqueMap} -} -data Grammar = Grammar (TypeSyns) (UseMap) (Derivings) (Set NontermIdent) (Nonterminals) (PragmaMap) (AttrOrderMap) (ParamMap) (ContextMap) +data Grammar = Grammar (TypeSyns) (UseMap) (Derivings) (Set NontermIdent) (Nonterminals) (PragmaMap) (AttrOrderMap) (ParamMap) (ContextMap) (UniqueMap) -- Nonterminal ------------------------------------------------- {- alternatives: diff --git a/src-derived/AbstractSyntaxDump.hs b/src-derived/AbstractSyntaxDump.hs --- a/src-derived/AbstractSyntaxDump.hs +++ b/src-derived/AbstractSyntaxDump.hs @@ -165,12 +165,13 @@ child manualAttrOrderMap : {AttrOrderMap} child paramMap : {ParamMap} child contextMap : {ContextMap} + child uniqueMap : {UniqueMap} -} -- cata sem_Grammar :: Grammar -> T_Grammar -sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap) = - (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts) _pragmas _manualAttrOrderMap _paramMap _contextMap) +sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap) = + (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts) _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap) -- semantic domain newtype T_Grammar = T_Grammar (( PP_Doc)) data Inh_Grammar = Inh_Grammar {} @@ -188,8 +189,9 @@ AttrOrderMap -> ParamMap -> ContextMap -> + UniqueMap -> T_Grammar -sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ = +sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ uniqueMap_ = (T_Grammar (let _lhsOpp :: PP_Doc _nontsIpp :: PP_Doc _nontsIppL :: ([PP_Doc]) diff --git a/src-derived/Code.hs b/src-derived/Code.hs --- a/src-derived/Code.hs +++ b/src-derived/Code.hs @@ -246,6 +246,7 @@ | TupleType (Types) | TypeApp (Type) (Types) | UnboxedTupleType (Types) + deriving ( Show) -- Types ------------------------------------------------------- {- alternatives: diff --git a/src-derived/ConcreteSyntax.hs b/src-derived/ConcreteSyntax.hs --- a/src-derived/ConcreteSyntax.hs +++ b/src-derived/ConcreteSyntax.hs @@ -97,7 +97,8 @@ child set : NontSet alternative Txt: child pos : {Pos} - child name : {NontermIdent} + child name : {Identifier} + child mbNt : {Maybe NontermIdent} child lines : {[String]} alternative Type: child pos : {Pos} @@ -116,7 +117,7 @@ | Pragma (Pos) ([NontermIdent]) | Sem (Pos) (ClassContext) (NontSet) (Attrs) (SemAlts) | Set (Pos) (NontermIdent) (NontSet) - | Txt (Pos) (NontermIdent) ([String]) + | Txt (Pos) (Identifier) (Maybe NontermIdent) ([String]) | Type (Pos) (ClassContext) (NontermIdent) ([Identifier]) (ComplexType) | Wrapper (Pos) (NontSet) -- Elems ------------------------------------------------------- @@ -186,11 +187,15 @@ alternative TypeDef: child ident : {Identifier} child tp : {Type} + alternative UniqueDef: + child ident : {Identifier} + child ref : {Identifier} -} data SemDef = AttrOrderBefore ([(Identifier,Identifier)]) ([(Identifier,Identifier)]) | Def (Pattern) (Expression) (Bool) | SemPragma ([NontermIdent]) | TypeDef (Identifier) (Type) + | UniqueDef (Identifier) (Identifier) -- SemDefs ----------------------------------------------------- {- alternatives: diff --git a/src-derived/DeclBlocks.hs b/src-derived/DeclBlocks.hs --- a/src-derived/DeclBlocks.hs +++ b/src-derived/DeclBlocks.hs @@ -1,4 +1,3 @@ - -- UUAGC 0.9.5 (DeclBlocks.ag) module DeclBlocks where @@ -9,17 +8,17 @@ alternative DeclBlock: child defs : {[Decl]} child visit : {Decl} - child next : DeclBlocks + child next : DeclBlocks alternative DeclTerminator: child defs : {[Decl]} child result : {Expr} -} -data DeclBlocks = DeclBlock ([Decl]) (Decl) (DeclBlocks) - | DeclTerminator ([Decl]) (Expr) +data DeclBlocks = DeclBlock ([Decl]) (Decl) (DeclBlocks) + | DeclTerminator ([Decl]) (Expr) -- DeclBlocksRoot ---------------------------------------------- {- alternatives: alternative DeclBlocksRoot: - child blocks : DeclBlocks + child blocks : DeclBlocks -} -data DeclBlocksRoot = DeclBlocksRoot (DeclBlocks) +data DeclBlocksRoot = DeclBlocksRoot (DeclBlocks) diff --git a/src-derived/DefaultRules.hs b/src-derived/DefaultRules.hs --- a/src-derived/DefaultRules.hs +++ b/src-derived/DefaultRules.hs @@ -1,2115 +1,1635 @@ --- UUAGC 0.9.5 (DefaultRules.ag) -module DefaultRules where - -import qualified List (delete,intersperse) - -import qualified Data.Set as Set -import qualified Data.Map as Map -import Data.Map(Map) -import qualified UU.DData.Seq as Seq -import UU.DData.Seq(Seq,(<>)) -import UU.Scanner.Position(noPos) -import Pretty -import Maybe -import HsToken -import HsTokenScanner - -import AbstractSyntax -import ErrorMessages - -import Options(Options,modcopy,rename) - --- AbstractSyntax.ag imports -import Data.Set(Set) -import Data.Map(Map) -import Patterns (Pattern(..),Patterns) -import Expression (Expression(..)) -import CommonTypes - --- Patterns.ag imports -import UU.Scanner.Position(Pos) -import CommonTypes (ConstructorIdent,Identifier) - -fieldName n = '@' : getName n - -locName n = '@' : getName n - -attrName fld attr - | fld == _LOC = '@' : getName attr - | otherwise = '@' : getName fld ++ "." ++ getName attr - -_ACHILD = Ident "(" noPos -- hack - - -getConName typeSyns rename nt con1 - | nt `elem` map fst typeSyns = synonym - | otherwise = normalName - where con = getName con1 - normalName | rename = getName nt++"_"++ con - | otherwise = con - synonym | con == "Cons" = "(:)" - | con == "Nil" = "[]" - | con == "Just" = "Just" - | con == "Nothing" = "Nothing" - | otherwise = normalName - - - -concatSeq = foldr Seq.append Seq.empty - -splitAttrs :: Map Identifier a -> [Identifier] -> ([(Identifier,a)],[Identifier]) -- a used as (String,String) -splitAttrs _ [] - = ([],[]) -splitAttrs useMap (n:rest) - = let (uses,normals) = splitAttrs useMap rest - in case Map.lookup n useMap of - Just x -> ((n,x):uses , normals ) - Nothing -> ( uses , n:normals ) - -removeDefined :: Set (Identifier,Identifier) -> (Identifier,Attributes) -> (Identifier,[Identifier]) -removeDefined defined (fld,as) - = ( fld - , [ a - | a <- Map.keys as - , not (Set.member (fld,a) defined) - ] - ) - - - - - -deprecatedCopyRuleError nt con fld a - = let mesg = - "In the definitions for alternative" - >#< getName con - >#< "of nonterminal" - >#< getName nt - >|< "," - >-< "the value of field" - >#< getName a - >#< "is copied by a copy-rule." - >-< "Copying the value of a field using a copy-rule is deprecated" - >-< "Please add the following lines to your code:" - >-< ( "SEM" - >#< getName nt - >-< indent 2 ( "|" - >#< getName con - >#< getName fld - >#< "." - >#< a - >#< "=" - >#< "@" - >|< a - ) - ) - in CustomError True (getPos a) mesg - - -missingRuleErrorExpr nt con fld a - = "error \"missing rule: " - ++ show nt ++ "." ++ show con ++ "." - ++ show fld ++ "." ++ show a ++ "\"" - - - -makeRule :: (Identifier,Identifier) -> Expression -> String -> Rule -makeRule (f1,a1) expr origin - = Rule (Alias f1 a1 (Underscore noPos) []) - expr - False - origin - - -useRule :: Set Identifier -> [(Identifier,Attributes)] -> (Identifier,(String,String,String)) -> Rule -useRule locals ch_outs (n,(op,e,pos)) - = let elems = [ fld - | (fld,as) <- ch_outs - , Map.member n as - ] - - expr | Set.member n locals = attrName _LOC n - | null elems = e - | otherwise = foldr1 (\x y -> x ++ " " ++ op ++ " " ++ y) - (map (flip attrName n) elems) - - tks | Set.member n locals = [AGLocal n noPos Nothing] - | null elems = lexTokens noPos e - | otherwise = lexTokens noPos str - where - str = foldr1 (\x y -> x ++ " " ++ op ++ " " ++ y) - (map (flip attrName n) elems) - - in makeRule (_LHS,n) - (Expression noPos tks) - ("use rule " ++ pos) - - - - -selfRule lhsNecLoc attr x - = let expr | lhsNecLoc = locName attr - | otherwise = x - - tks | lhsNecLoc = [AGLocal attr noPos Nothing] - | otherwise = lexTokens noPos x - - in makeRule (if lhsNecLoc then _LHS else _LOC,attr) - (Expression noPos tks) - "self rule" - - - - -concatRE rsess = let (rss,ess) = unzip rsess - in (concat rss, concatSeq ess) - - -copyRule :: Identifier -> Identifier -> Bool -> Set Identifier -> (Map Identifier Identifier, (Identifier,[Identifier])) -> ([Rule], Seq Error) -copyRule nt con modcopy locals (env,(fld,as)) - = concatRE (map copyRu as) - - where - copyRu a - = ( [ makeRule (fld,a) - (Expression noPos tks) - (cruletxt sel) - ] - , err - ) - - where - sel - | not modcopy - && Set.member a locals = Just _LOC - | otherwise = Map.lookup a env - - (expr,err) - = case sel of - Nothing -> ( missingRuleErrorExpr nt con fld a - , Seq.single (MissingRule nt con fld a) - ) - Just f - | f == _ACHILD -> ( fieldName a - , Seq.single (deprecatedCopyRuleError nt con fld a) - ) - | otherwise -> ( attrName f a - , Seq.empty - ) - - (tks,err') - = case sel of - Nothing -> ( [HsToken (missingRuleErrorExpr nt con fld a) noPos] - , Seq.single (MissingRule nt con fld a) - ) - Just f - | f == _ACHILD -> ( [AGLocal a noPos Nothing] - , Seq.single (deprecatedCopyRuleError nt con fld a) - ) - | otherwise -> ( [AGField f a noPos Nothing] - , Seq.empty - ) - - cruletxt sel - | local = "copy rule (from local)" - | deprChild = "deprecated child copy" - | Set.member a locals && nonlocal = "modified copy rule" - | incoming && outgoing = "copy rule (chain)" - | incoming = "copy rule (down)" - | outgoing = "copy rule (up)" - | otherwise = "copy rule (chain)" - where outgoing = fld == _LHS - incoming = maybe False (== _LHS) sel - nonlocal = maybe False (/= _LOC) sel - local = maybe False (== _LOC) sel - deprChild = maybe False (== _ACHILD) sel - -{- -multiRule replaces - loc.(a,b) = e -by - loc.tup1 = e - loc.(a,_) = @loc.tup1 - loc.(_,b) = @loc.tup1 -It needs to thread a unique number for inventing names for the tuples. - -It also works for nested tuples: - loc.(a,(b,c)) = e -becomes - loc.tup1 = e - loc.(a,_) = @loc.tup1 - loc.(_,tup2) = @loc.tup1 - loc.(b,_) = @loc.tup2 - loc.(_,c) = @loc.tup2 --} - -multiRule :: Rule -> Int -> ([Rule], Int) -multiRule (Rule pat expr owrt origin) uniq - = let f :: (Pattern->Pattern) -> Expression -> Pattern -> Int -> (Pattern, ([Rule], Int)) - f w e (Product pos pats) n - = let freshName = Ident ("_tup" ++ show n) pos - freshExpr = Expression pos freshTks - freshTks = [AGField _LOC freshName pos Nothing] - freshPat = Alias _LOC freshName (Underscore pos) pats - a = length pats - 1 - us b p = Product pos (replicate (a-b) (Underscore pos) ++ [p] ++ replicate b (Underscore pos)) - g :: Pattern -> ([Pattern],[Rule],Int) -> ([Pattern],[Rule],Int) - g p (xs1,rs1,n1) = let (x2,(rs2,n2)) = f (us (length xs1)) freshExpr p n1 - in (x2:xs1, rs2++rs1, n2) - (xs9,rs9,n9) = foldr g ([], [], n+1) pats - in ( freshPat - , ( Rule (w freshPat) e owrt origin : rs9 - , n9 - ) - ) - f w e p n - = ( p - , ( [Rule (w p) e owrt origin] - , n - ) - ) - in snd (f id expr pat uniq) - --- Child ------------------------------------------------------- -{- - visit 0: - inherited attributes: - con : ConstructorIdent - cr : Bool - nt : NontermIdent - synthesized attributes: - errors : Seq Error - field : (Identifier,Type,Bool) - inherited : Attributes - name : Identifier - output : SELF - synthesized : Attributes - alternatives: - alternative Child: - child name : {Identifier} - child tp : {Type} - child inh : {Attributes} - child syn : {Attributes} - child higherOrder : {Bool} - visit 0: - local output : _ --} --- cata -sem_Child :: Child -> - T_Child -sem_Child (Child _name _tp _inh _syn _higherOrder) = - (sem_Child_Child _name _tp _inh _syn _higherOrder) --- semantic domain -newtype T_Child = T_Child (ConstructorIdent -> - Bool -> - NontermIdent -> - ( (Seq Error),( (Identifier,Type,Bool) ),Attributes,Identifier,Child,Attributes)) -data Inh_Child = Inh_Child {con_Inh_Child :: ConstructorIdent,cr_Inh_Child :: Bool,nt_Inh_Child :: NontermIdent} -data Syn_Child = Syn_Child {errors_Syn_Child :: Seq Error,field_Syn_Child :: (Identifier,Type,Bool) ,inherited_Syn_Child :: Attributes,name_Syn_Child :: Identifier,output_Syn_Child :: Child,synthesized_Syn_Child :: Attributes} -wrap_Child (T_Child sem) (Inh_Child _lhsIcon _lhsIcr _lhsInt) = - (let ( _lhsOerrors,_lhsOfield,_lhsOinherited,_lhsOname,_lhsOoutput,_lhsOsynthesized) = - (sem _lhsIcon _lhsIcr _lhsInt) - in (Syn_Child _lhsOerrors _lhsOfield _lhsOinherited _lhsOname _lhsOoutput _lhsOsynthesized)) -sem_Child_Child :: Identifier -> - Type -> - Attributes -> - Attributes -> - Bool -> - T_Child -sem_Child_Child name_ tp_ inh_ syn_ higherOrder_ = - (T_Child (\ _lhsIcon - _lhsIcr - _lhsInt -> - (let _lhsOname :: Identifier - _lhsOinherited :: Attributes - _lhsOsynthesized :: Attributes - _lhsOfield :: ( (Identifier,Type,Bool) ) - _lhsOerrors :: (Seq Error) - _lhsOoutput :: Child - -- "DefaultRules.ag"(line 140, column 11) - _lhsOname = - name_ - -- "DefaultRules.ag"(line 149, column 11) - _lhsOinherited = - inh_ - -- "DefaultRules.ag"(line 150, column 11) - _lhsOsynthesized = - syn_ - -- "DefaultRules.ag"(line 411, column 11) - _lhsOfield = - (name_,tp_,higherOrder_) - -- use rule "DefaultRules.ag"(line 109, column 19) - _lhsOerrors = - Seq.empty - -- self rule - _output = - Child name_ tp_ inh_ syn_ higherOrder_ - -- self rule - _lhsOoutput = - _output - in ( _lhsOerrors,_lhsOfield,_lhsOinherited,_lhsOname,_lhsOoutput,_lhsOsynthesized)))) --- Children ---------------------------------------------------- -{- - visit 0: - inherited attributes: - con : ConstructorIdent - cr : Bool - nt : NontermIdent - synthesized attributes: - errors : Seq Error - fields : [(Identifier,Type,Bool)] - inputs : [(Identifier, Attributes)] - output : SELF - outputs : [(Identifier, Attributes)] - alternatives: - alternative Cons: - child hd : Child - child tl : Children - visit 0: - local output : _ - alternative Nil: - visit 0: - local output : _ --} --- cata -sem_Children :: Children -> - T_Children -sem_Children list = - (Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list)) --- semantic domain -newtype T_Children = T_Children (ConstructorIdent -> - Bool -> - NontermIdent -> - ( (Seq Error),([(Identifier,Type,Bool)]),([(Identifier, Attributes)]),Children,([(Identifier, Attributes)]))) -data Inh_Children = Inh_Children {con_Inh_Children :: ConstructorIdent,cr_Inh_Children :: Bool,nt_Inh_Children :: NontermIdent} -data Syn_Children = Syn_Children {errors_Syn_Children :: Seq Error,fields_Syn_Children :: [(Identifier,Type,Bool)],inputs_Syn_Children :: [(Identifier, Attributes)],output_Syn_Children :: Children,outputs_Syn_Children :: [(Identifier, Attributes)]} -wrap_Children (T_Children sem) (Inh_Children _lhsIcon _lhsIcr _lhsInt) = - (let ( _lhsOerrors,_lhsOfields,_lhsOinputs,_lhsOoutput,_lhsOoutputs) = - (sem _lhsIcon _lhsIcr _lhsInt) - in (Syn_Children _lhsOerrors _lhsOfields _lhsOinputs _lhsOoutput _lhsOoutputs)) -sem_Children_Cons :: T_Child -> - T_Children -> - T_Children -sem_Children_Cons (T_Child hd_) (T_Children tl_) = - (T_Children (\ _lhsIcon - _lhsIcr - _lhsInt -> - (let _lhsOinputs :: ([(Identifier, Attributes)]) - _lhsOoutputs :: ([(Identifier, Attributes)]) - _lhsOfields :: ([(Identifier,Type,Bool)]) - _lhsOerrors :: (Seq Error) - _lhsOoutput :: Children - _hdOcon :: ConstructorIdent - _hdOcr :: Bool - _hdOnt :: NontermIdent - _tlOcon :: ConstructorIdent - _tlOcr :: Bool - _tlOnt :: NontermIdent - _hdIerrors :: (Seq Error) - _hdIfield :: ( (Identifier,Type,Bool) ) - _hdIinherited :: Attributes - _hdIname :: Identifier - _hdIoutput :: Child - _hdIsynthesized :: Attributes - _tlIerrors :: (Seq Error) - _tlIfields :: ([(Identifier,Type,Bool)]) - _tlIinputs :: ([(Identifier, Attributes)]) - _tlIoutput :: Children - _tlIoutputs :: ([(Identifier, Attributes)]) - -- "DefaultRules.ag"(line 153, column 10) - _lhsOinputs = - (_hdIname, _hdIinherited) : _tlIinputs - -- "DefaultRules.ag"(line 153, column 10) - _lhsOoutputs = - (_hdIname, _hdIsynthesized) : _tlIoutputs - -- "DefaultRules.ag"(line 407, column 10) - _lhsOfields = - _hdIfield : _tlIfields - -- use rule "DefaultRules.ag"(line 109, column 19) - _lhsOerrors = - _hdIerrors Seq.<> _tlIerrors - -- self rule - _output = - (:) _hdIoutput _tlIoutput - -- self rule - _lhsOoutput = - _output - -- copy rule (down) - _hdOcon = - _lhsIcon - -- copy rule (down) - _hdOcr = - _lhsIcr - -- copy rule (down) - _hdOnt = - _lhsInt - -- copy rule (down) - _tlOcon = - _lhsIcon - -- copy rule (down) - _tlOcr = - _lhsIcr - -- copy rule (down) - _tlOnt = - _lhsInt - ( _hdIerrors,_hdIfield,_hdIinherited,_hdIname,_hdIoutput,_hdIsynthesized) = - (hd_ _hdOcon _hdOcr _hdOnt) - ( _tlIerrors,_tlIfields,_tlIinputs,_tlIoutput,_tlIoutputs) = - (tl_ _tlOcon _tlOcr _tlOnt) - in ( _lhsOerrors,_lhsOfields,_lhsOinputs,_lhsOoutput,_lhsOoutputs)))) -sem_Children_Nil :: T_Children -sem_Children_Nil = - (T_Children (\ _lhsIcon - _lhsIcr - _lhsInt -> - (let _lhsOinputs :: ([(Identifier, Attributes)]) - _lhsOoutputs :: ([(Identifier, Attributes)]) - _lhsOfields :: ([(Identifier,Type,Bool)]) - _lhsOerrors :: (Seq Error) - _lhsOoutput :: Children - -- "DefaultRules.ag"(line 155, column 10) - _lhsOinputs = - [] - -- "DefaultRules.ag"(line 155, column 10) - _lhsOoutputs = - [] - -- "DefaultRules.ag"(line 408, column 10) - _lhsOfields = - [] - -- use rule "DefaultRules.ag"(line 109, column 19) - _lhsOerrors = - Seq.empty - -- self rule - _output = - [] - -- self rule - _lhsOoutput = - _output - in ( _lhsOerrors,_lhsOfields,_lhsOinputs,_lhsOoutput,_lhsOoutputs)))) --- Grammar ----------------------------------------------------- -{- - visit 0: - inherited attribute: - options : Options - synthesized attributes: - errors : Seq Error - output : SELF - alternatives: - alternative Grammar: - child typeSyns : {TypeSyns} - child useMap : {UseMap} - child derivings : {Derivings} - child wrappers : {Set NontermIdent} - child nonts : Nonterminals - child pragmas : {PragmaMap} - child manualAttrOrderMap : {AttrOrderMap} - child paramMap : {ParamMap} - child contextMap : {ContextMap} - visit 0: - local output : _ --} --- cata -sem_Grammar :: Grammar -> - T_Grammar -sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap) = - (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts) _pragmas _manualAttrOrderMap _paramMap _contextMap) --- semantic domain -newtype T_Grammar = T_Grammar (Options -> - ( (Seq Error),Grammar)) -data Inh_Grammar = Inh_Grammar {options_Inh_Grammar :: Options} -data Syn_Grammar = Syn_Grammar {errors_Syn_Grammar :: Seq Error,output_Syn_Grammar :: Grammar} -wrap_Grammar (T_Grammar sem) (Inh_Grammar _lhsIoptions) = - (let ( _lhsOerrors,_lhsOoutput) = - (sem _lhsIoptions) - in (Syn_Grammar _lhsOerrors _lhsOoutput)) -sem_Grammar_Grammar :: TypeSyns -> - UseMap -> - Derivings -> - (Set NontermIdent) -> - T_Nonterminals -> - PragmaMap -> - AttrOrderMap -> - ParamMap -> - ContextMap -> - T_Grammar -sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ = - (T_Grammar (\ _lhsIoptions -> - (let _nontsOo_rename :: Bool - _nontsOcr :: Bool - _nontsOnonterminals :: (Set NontermIdent) - _nontsOuseMap :: UseMap - _nontsOtypeSyns :: TypeSyns - _nontsOuniq :: Int - _nontsOmanualAttrOrderMap :: AttrOrderMap - _lhsOerrors :: (Seq Error) - _lhsOoutput :: Grammar - _nontsIcollect_nts :: (Set NontermIdent) - _nontsIerrors :: (Seq Error) - _nontsIoutput :: Nonterminals - _nontsIuniq :: Int - -- "DefaultRules.ag"(line 43, column 17) - _nontsOo_rename = - rename _lhsIoptions - -- "DefaultRules.ag"(line 44, column 17) - _nontsOcr = - modcopy _lhsIoptions - -- "DefaultRules.ag"(line 121, column 13) - _nontsOnonterminals = - _nontsIcollect_nts - -- "DefaultRules.ag"(line 142, column 13) - _nontsOuseMap = - useMap_ - -- "DefaultRules.ag"(line 144, column 13) - _nontsOtypeSyns = - typeSyns_ - -- "DefaultRules.ag"(line 428, column 13) - _nontsOuniq = - 1 - -- "DefaultRules.ag"(line 505, column 7) - _nontsOmanualAttrOrderMap = - manualAttrOrderMap_ - -- use rule "DefaultRules.ag"(line 109, column 19) - _lhsOerrors = - _nontsIerrors - -- self rule - _output = - Grammar typeSyns_ useMap_ derivings_ wrappers_ _nontsIoutput pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ - -- self rule - _lhsOoutput = - _output - ( _nontsIcollect_nts,_nontsIerrors,_nontsIoutput,_nontsIuniq) = - (nonts_ _nontsOcr _nontsOmanualAttrOrderMap _nontsOnonterminals _nontsOo_rename _nontsOtypeSyns _nontsOuniq _nontsOuseMap) - in ( _lhsOerrors,_lhsOoutput)))) --- Nonterminal ------------------------------------------------- -{- - visit 0: - inherited attributes: - cr : Bool - manualAttrOrderMap : AttrOrderMap - nonterminals : Set NontermIdent - o_rename : Bool - typeSyns : TypeSyns - useMap : UseMap - chained attribute: - uniq : Int - synthesized attributes: - collect_nts : Set NontermIdent - errors : Seq Error - output : SELF - alternatives: - alternative Nonterminal: - child nt : {NontermIdent} - child params : {[Identifier]} - child inh : {Attributes} - child syn : {Attributes} - child prods : Productions - visit 0: - local output : _ --} --- cata -sem_Nonterminal :: Nonterminal -> - T_Nonterminal -sem_Nonterminal (Nonterminal _nt _params _inh _syn _prods) = - (sem_Nonterminal_Nonterminal _nt _params _inh _syn (sem_Productions _prods)) --- semantic domain -newtype T_Nonterminal = T_Nonterminal (Bool -> - AttrOrderMap -> - (Set NontermIdent) -> - Bool -> - TypeSyns -> - Int -> - UseMap -> - ( (Set NontermIdent),(Seq Error),Nonterminal,Int)) -data Inh_Nonterminal = Inh_Nonterminal {cr_Inh_Nonterminal :: Bool,manualAttrOrderMap_Inh_Nonterminal :: AttrOrderMap,nonterminals_Inh_Nonterminal :: Set NontermIdent,o_rename_Inh_Nonterminal :: Bool,typeSyns_Inh_Nonterminal :: TypeSyns,uniq_Inh_Nonterminal :: Int,useMap_Inh_Nonterminal :: UseMap} -data Syn_Nonterminal = Syn_Nonterminal {collect_nts_Syn_Nonterminal :: Set NontermIdent,errors_Syn_Nonterminal :: Seq Error,output_Syn_Nonterminal :: Nonterminal,uniq_Syn_Nonterminal :: Int} -wrap_Nonterminal (T_Nonterminal sem) (Inh_Nonterminal _lhsIcr _lhsImanualAttrOrderMap _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap) = - (let ( _lhsOcollect_nts,_lhsOerrors,_lhsOoutput,_lhsOuniq) = - (sem _lhsIcr _lhsImanualAttrOrderMap _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap) - in (Syn_Nonterminal _lhsOcollect_nts _lhsOerrors _lhsOoutput _lhsOuniq)) -sem_Nonterminal_Nonterminal :: NontermIdent -> - ([Identifier]) -> - Attributes -> - Attributes -> - T_Productions -> - T_Nonterminal -sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ (T_Productions prods_) = - (T_Nonterminal (\ _lhsIcr - _lhsImanualAttrOrderMap - _lhsInonterminals - _lhsIo_rename - _lhsItypeSyns - _lhsIuniq - _lhsIuseMap -> - (let _lhsOcollect_nts :: (Set NontermIdent) - _prodsOinh :: Attributes - _prodsOsyn :: Attributes - _prodsOuseMap :: (Map Identifier (String,String,String)) - _prodsOnt :: NontermIdent - _lhsOerrors :: (Seq Error) - _lhsOoutput :: Nonterminal - _lhsOuniq :: Int - _prodsOcr :: Bool - _prodsOmanualAttrOrderMap :: AttrOrderMap - _prodsOnonterminals :: (Set NontermIdent) - _prodsOo_rename :: Bool - _prodsOtypeSyns :: TypeSyns - _prodsOuniq :: Int - _prodsIerrors :: (Seq Error) - _prodsIoutput :: Productions - _prodsIuniq :: Int - -- "DefaultRules.ag"(line 117, column 17) - _lhsOcollect_nts = - Set.singleton nt_ - -- "DefaultRules.ag"(line 132, column 18) - _prodsOinh = - inh_ - -- "DefaultRules.ag"(line 133, column 18) - _prodsOsyn = - syn_ - -- "DefaultRules.ag"(line 134, column 18) - _prodsOuseMap = - Map.findWithDefault Map.empty nt_ _lhsIuseMap - -- "DefaultRules.ag"(line 146, column 17) - _prodsOnt = - nt_ - -- use rule "DefaultRules.ag"(line 109, column 19) - _lhsOerrors = - _prodsIerrors - -- self rule - _output = - Nonterminal nt_ params_ inh_ syn_ _prodsIoutput - -- self rule - _lhsOoutput = - _output - -- copy rule (up) - _lhsOuniq = - _prodsIuniq - -- copy rule (down) - _prodsOcr = - _lhsIcr - -- copy rule (down) - _prodsOmanualAttrOrderMap = - _lhsImanualAttrOrderMap - -- copy rule (down) - _prodsOnonterminals = - _lhsInonterminals - -- copy rule (down) - _prodsOo_rename = - _lhsIo_rename - -- copy rule (down) - _prodsOtypeSyns = - _lhsItypeSyns - -- copy rule (down) - _prodsOuniq = - _lhsIuniq - ( _prodsIerrors,_prodsIoutput,_prodsIuniq) = - (prods_ _prodsOcr _prodsOinh _prodsOmanualAttrOrderMap _prodsOnonterminals _prodsOnt _prodsOo_rename _prodsOsyn _prodsOtypeSyns _prodsOuniq _prodsOuseMap) - in ( _lhsOcollect_nts,_lhsOerrors,_lhsOoutput,_lhsOuniq)))) --- Nonterminals ------------------------------------------------ -{- - visit 0: - inherited attributes: - cr : Bool - manualAttrOrderMap : AttrOrderMap - nonterminals : Set NontermIdent - o_rename : Bool - typeSyns : TypeSyns - useMap : UseMap - chained attribute: - uniq : Int - synthesized attributes: - collect_nts : Set NontermIdent - errors : Seq Error - output : SELF - alternatives: - alternative Cons: - child hd : Nonterminal - child tl : Nonterminals - visit 0: - local output : _ - alternative Nil: - visit 0: - local output : _ --} --- cata -sem_Nonterminals :: Nonterminals -> - T_Nonterminals -sem_Nonterminals list = - (Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list)) --- semantic domain -newtype T_Nonterminals = T_Nonterminals (Bool -> - AttrOrderMap -> - (Set NontermIdent) -> - Bool -> - TypeSyns -> - Int -> - UseMap -> - ( (Set NontermIdent),(Seq Error),Nonterminals,Int)) -data Inh_Nonterminals = Inh_Nonterminals {cr_Inh_Nonterminals :: Bool,manualAttrOrderMap_Inh_Nonterminals :: AttrOrderMap,nonterminals_Inh_Nonterminals :: Set NontermIdent,o_rename_Inh_Nonterminals :: Bool,typeSyns_Inh_Nonterminals :: TypeSyns,uniq_Inh_Nonterminals :: Int,useMap_Inh_Nonterminals :: UseMap} -data Syn_Nonterminals = Syn_Nonterminals {collect_nts_Syn_Nonterminals :: Set NontermIdent,errors_Syn_Nonterminals :: Seq Error,output_Syn_Nonterminals :: Nonterminals,uniq_Syn_Nonterminals :: Int} -wrap_Nonterminals (T_Nonterminals sem) (Inh_Nonterminals _lhsIcr _lhsImanualAttrOrderMap _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap) = - (let ( _lhsOcollect_nts,_lhsOerrors,_lhsOoutput,_lhsOuniq) = - (sem _lhsIcr _lhsImanualAttrOrderMap _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap) - in (Syn_Nonterminals _lhsOcollect_nts _lhsOerrors _lhsOoutput _lhsOuniq)) -sem_Nonterminals_Cons :: T_Nonterminal -> - T_Nonterminals -> - T_Nonterminals -sem_Nonterminals_Cons (T_Nonterminal hd_) (T_Nonterminals tl_) = - (T_Nonterminals (\ _lhsIcr - _lhsImanualAttrOrderMap - _lhsInonterminals - _lhsIo_rename - _lhsItypeSyns - _lhsIuniq - _lhsIuseMap -> - (let _lhsOcollect_nts :: (Set NontermIdent) - _lhsOerrors :: (Seq Error) - _lhsOoutput :: Nonterminals - _lhsOuniq :: Int - _hdOcr :: Bool - _hdOmanualAttrOrderMap :: AttrOrderMap - _hdOnonterminals :: (Set NontermIdent) - _hdOo_rename :: Bool - _hdOtypeSyns :: TypeSyns - _hdOuniq :: Int - _hdOuseMap :: UseMap - _tlOcr :: Bool - _tlOmanualAttrOrderMap :: AttrOrderMap - _tlOnonterminals :: (Set NontermIdent) - _tlOo_rename :: Bool - _tlOtypeSyns :: TypeSyns - _tlOuniq :: Int - _tlOuseMap :: UseMap - _hdIcollect_nts :: (Set NontermIdent) - _hdIerrors :: (Seq Error) - _hdIoutput :: Nonterminal - _hdIuniq :: Int - _tlIcollect_nts :: (Set NontermIdent) - _tlIerrors :: (Seq Error) - _tlIoutput :: Nonterminals - _tlIuniq :: Int - -- use rule "DefaultRules.ag"(line 115, column 49) - _lhsOcollect_nts = - _hdIcollect_nts `Set.union` _tlIcollect_nts - -- use rule "DefaultRules.ag"(line 109, column 19) - _lhsOerrors = - _hdIerrors Seq.<> _tlIerrors - -- self rule - _output = - (:) _hdIoutput _tlIoutput - -- self rule - _lhsOoutput = - _output - -- copy rule (up) - _lhsOuniq = - _tlIuniq - -- copy rule (down) - _hdOcr = - _lhsIcr - -- copy rule (down) - _hdOmanualAttrOrderMap = - _lhsImanualAttrOrderMap - -- copy rule (down) - _hdOnonterminals = - _lhsInonterminals - -- copy rule (down) - _hdOo_rename = - _lhsIo_rename - -- copy rule (down) - _hdOtypeSyns = - _lhsItypeSyns - -- copy rule (down) - _hdOuniq = - _lhsIuniq - -- copy rule (down) - _hdOuseMap = - _lhsIuseMap - -- copy rule (down) - _tlOcr = - _lhsIcr - -- copy rule (down) - _tlOmanualAttrOrderMap = - _lhsImanualAttrOrderMap - -- copy rule (down) - _tlOnonterminals = - _lhsInonterminals - -- copy rule (down) - _tlOo_rename = - _lhsIo_rename - -- copy rule (down) - _tlOtypeSyns = - _lhsItypeSyns - -- copy rule (chain) - _tlOuniq = - _hdIuniq - -- copy rule (down) - _tlOuseMap = - _lhsIuseMap - ( _hdIcollect_nts,_hdIerrors,_hdIoutput,_hdIuniq) = - (hd_ _hdOcr _hdOmanualAttrOrderMap _hdOnonterminals _hdOo_rename _hdOtypeSyns _hdOuniq _hdOuseMap) - ( _tlIcollect_nts,_tlIerrors,_tlIoutput,_tlIuniq) = - (tl_ _tlOcr _tlOmanualAttrOrderMap _tlOnonterminals _tlOo_rename _tlOtypeSyns _tlOuniq _tlOuseMap) - in ( _lhsOcollect_nts,_lhsOerrors,_lhsOoutput,_lhsOuniq)))) -sem_Nonterminals_Nil :: T_Nonterminals -sem_Nonterminals_Nil = - (T_Nonterminals (\ _lhsIcr - _lhsImanualAttrOrderMap - _lhsInonterminals - _lhsIo_rename - _lhsItypeSyns - _lhsIuniq - _lhsIuseMap -> - (let _lhsOcollect_nts :: (Set NontermIdent) - _lhsOerrors :: (Seq Error) - _lhsOoutput :: Nonterminals - _lhsOuniq :: Int - -- use rule "DefaultRules.ag"(line 115, column 49) - _lhsOcollect_nts = - Set.empty - -- use rule "DefaultRules.ag"(line 109, column 19) - _lhsOerrors = - Seq.empty - -- self rule - _output = - [] - -- self rule - _lhsOoutput = - _output - -- copy rule (chain) - _lhsOuniq = - _lhsIuniq - in ( _lhsOcollect_nts,_lhsOerrors,_lhsOoutput,_lhsOuniq)))) --- Pattern ----------------------------------------------------- -{- - visit 0: - inherited attributes: - con : ConstructorIdent - nt : NontermIdent - synthesized attributes: - containsVars : Bool - copy : SELF - definedAttrs : Set (Identifier,Identifier) - errors : Seq Error - locals : Set Identifier - output : SELF - alternatives: - alternative Alias: - child field : {Identifier} - child attr : {Identifier} - child pat : Pattern - child parts : Patterns - visit 0: - local copy : _ - local output : _ - alternative Constr: - child name : {ConstructorIdent} - child pats : Patterns - visit 0: - local copy : _ - local output : _ - alternative Irrefutable: - child pat : Pattern - visit 0: - local copy : _ - local output : _ - alternative Product: - child pos : {Pos} - child pats : Patterns - visit 0: - local copy : _ - local output : _ - alternative Underscore: - child pos : {Pos} - visit 0: - local copy : _ - local output : _ --} --- cata -sem_Pattern :: Pattern -> - T_Pattern -sem_Pattern (Alias _field _attr _pat _parts) = - (sem_Pattern_Alias _field _attr (sem_Pattern _pat) (sem_Patterns _parts)) -sem_Pattern (Constr _name _pats) = - (sem_Pattern_Constr _name (sem_Patterns _pats)) -sem_Pattern (Irrefutable _pat) = - (sem_Pattern_Irrefutable (sem_Pattern _pat)) -sem_Pattern (Product _pos _pats) = - (sem_Pattern_Product _pos (sem_Patterns _pats)) -sem_Pattern (Underscore _pos) = - (sem_Pattern_Underscore _pos) --- semantic domain -newtype T_Pattern = T_Pattern (ConstructorIdent -> - NontermIdent -> - ( Bool,Pattern,(Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Pattern)) -data Inh_Pattern = Inh_Pattern {con_Inh_Pattern :: ConstructorIdent,nt_Inh_Pattern :: NontermIdent} -data Syn_Pattern = Syn_Pattern {containsVars_Syn_Pattern :: Bool,copy_Syn_Pattern :: Pattern,definedAttrs_Syn_Pattern :: Set (Identifier,Identifier),errors_Syn_Pattern :: Seq Error,locals_Syn_Pattern :: Set Identifier,output_Syn_Pattern :: Pattern} -wrap_Pattern (T_Pattern sem) (Inh_Pattern _lhsIcon _lhsInt) = - (let ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) = - (sem _lhsIcon _lhsInt) - in (Syn_Pattern _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput)) -sem_Pattern_Alias :: Identifier -> - Identifier -> - T_Pattern -> - T_Patterns -> - T_Pattern -sem_Pattern_Alias field_ attr_ (T_Pattern pat_) (T_Patterns parts_) = - (T_Pattern (\ _lhsIcon - _lhsInt -> - (let _lhsOdefinedAttrs :: (Set (Identifier,Identifier)) - _lhsOlocals :: (Set Identifier) - _lhsOcontainsVars :: Bool - _lhsOerrors :: (Seq Error) - _lhsOcopy :: Pattern - _lhsOoutput :: Pattern - _patOcon :: ConstructorIdent - _patOnt :: NontermIdent - _partsOcon :: ConstructorIdent - _partsOnt :: NontermIdent - _patIcontainsVars :: Bool - _patIcopy :: Pattern - _patIdefinedAttrs :: (Set (Identifier,Identifier)) - _patIerrors :: (Seq Error) - _patIlocals :: (Set Identifier) - _patIoutput :: Pattern - _partsIcontainsVars :: Bool - _partsIcopy :: Patterns - _partsIdefinedAttrs :: (Set (Identifier,Identifier)) - _partsIerrors :: (Seq Error) - _partsIlocals :: (Set Identifier) - _partsIoutput :: Patterns - -- "DefaultRules.ag"(line 401, column 11) - _lhsOdefinedAttrs = - Set.insert (field_,attr_) _patIdefinedAttrs - -- "DefaultRules.ag"(line 401, column 11) - _lhsOlocals = - if field_ == _LOC - then Set.insert attr_ _patIlocals - else _patIlocals - -- "DefaultRules.ag"(line 419, column 16) - _lhsOcontainsVars = - True - -- use rule "DefaultRules.ag"(line 109, column 19) - _lhsOerrors = - _patIerrors Seq.<> _partsIerrors - -- self rule - _copy = - Alias field_ attr_ _patIcopy _partsIcopy - -- self rule - _output = - Alias field_ attr_ _patIoutput _partsIoutput - -- self rule - _lhsOcopy = - _copy - -- self rule - _lhsOoutput = - _output - -- copy rule (down) - _patOcon = - _lhsIcon - -- copy rule (down) - _patOnt = - _lhsInt - -- copy rule (down) - _partsOcon = - _lhsIcon - -- copy rule (down) - _partsOnt = - _lhsInt - ( _patIcontainsVars,_patIcopy,_patIdefinedAttrs,_patIerrors,_patIlocals,_patIoutput) = - (pat_ _patOcon _patOnt) - ( _partsIcontainsVars,_partsIcopy,_partsIdefinedAttrs,_partsIerrors,_partsIlocals,_partsIoutput) = - (parts_ _partsOcon _partsOnt) - in ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput)))) -sem_Pattern_Constr :: ConstructorIdent -> - T_Patterns -> - T_Pattern -sem_Pattern_Constr name_ (T_Patterns pats_) = - (T_Pattern (\ _lhsIcon - _lhsInt -> - (let _lhsOcontainsVars :: Bool - _lhsOdefinedAttrs :: (Set (Identifier,Identifier)) - _lhsOerrors :: (Seq Error) - _lhsOlocals :: (Set Identifier) - _lhsOcopy :: Pattern - _lhsOoutput :: Pattern - _patsOcon :: ConstructorIdent - _patsOnt :: NontermIdent - _patsIcontainsVars :: Bool - _patsIcopy :: Patterns - _patsIdefinedAttrs :: (Set (Identifier,Identifier)) - _patsIerrors :: (Seq Error) - _patsIlocals :: (Set Identifier) - _patsIoutput :: Patterns - -- use rule "DefaultRules.ag"(line 416, column 46) - _lhsOcontainsVars = - _patsIcontainsVars - -- use rule "DefaultRules.ag"(line 396, column 23) - _lhsOdefinedAttrs = - _patsIdefinedAttrs - -- use rule "DefaultRules.ag"(line 109, column 19) - _lhsOerrors = - _patsIerrors - -- use rule "DefaultRules.ag"(line 395, column 23) - _lhsOlocals = - _patsIlocals - -- self rule - _copy = - Constr name_ _patsIcopy - -- self rule - _output = - Constr name_ _patsIoutput - -- self rule - _lhsOcopy = - _copy - -- self rule - _lhsOoutput = - _output - -- copy rule (down) - _patsOcon = - _lhsIcon - -- copy rule (down) - _patsOnt = - _lhsInt - ( _patsIcontainsVars,_patsIcopy,_patsIdefinedAttrs,_patsIerrors,_patsIlocals,_patsIoutput) = - (pats_ _patsOcon _patsOnt) - in ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput)))) -sem_Pattern_Irrefutable :: T_Pattern -> - T_Pattern -sem_Pattern_Irrefutable (T_Pattern pat_) = - (T_Pattern (\ _lhsIcon - _lhsInt -> - (let _lhsOcontainsVars :: Bool - _lhsOdefinedAttrs :: (Set (Identifier,Identifier)) - _lhsOerrors :: (Seq Error) - _lhsOlocals :: (Set Identifier) - _lhsOcopy :: Pattern - _lhsOoutput :: Pattern - _patOcon :: ConstructorIdent - _patOnt :: NontermIdent - _patIcontainsVars :: Bool - _patIcopy :: Pattern - _patIdefinedAttrs :: (Set (Identifier,Identifier)) - _patIerrors :: (Seq Error) - _patIlocals :: (Set Identifier) - _patIoutput :: Pattern - -- use rule "DefaultRules.ag"(line 416, column 46) - _lhsOcontainsVars = - _patIcontainsVars - -- use rule "DefaultRules.ag"(line 396, column 23) - _lhsOdefinedAttrs = - _patIdefinedAttrs - -- use rule "DefaultRules.ag"(line 109, column 19) - _lhsOerrors = - _patIerrors - -- use rule "DefaultRules.ag"(line 395, column 23) - _lhsOlocals = - _patIlocals - -- self rule - _copy = - Irrefutable _patIcopy - -- self rule - _output = - Irrefutable _patIoutput - -- self rule - _lhsOcopy = - _copy - -- self rule - _lhsOoutput = - _output - -- copy rule (down) - _patOcon = - _lhsIcon - -- copy rule (down) - _patOnt = - _lhsInt - ( _patIcontainsVars,_patIcopy,_patIdefinedAttrs,_patIerrors,_patIlocals,_patIoutput) = - (pat_ _patOcon _patOnt) - in ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput)))) -sem_Pattern_Product :: Pos -> - T_Patterns -> - T_Pattern -sem_Pattern_Product pos_ (T_Patterns pats_) = - (T_Pattern (\ _lhsIcon - _lhsInt -> - (let _lhsOcontainsVars :: Bool - _lhsOdefinedAttrs :: (Set (Identifier,Identifier)) - _lhsOerrors :: (Seq Error) - _lhsOlocals :: (Set Identifier) - _lhsOcopy :: Pattern - _lhsOoutput :: Pattern - _patsOcon :: ConstructorIdent - _patsOnt :: NontermIdent - _patsIcontainsVars :: Bool - _patsIcopy :: Patterns - _patsIdefinedAttrs :: (Set (Identifier,Identifier)) - _patsIerrors :: (Seq Error) - _patsIlocals :: (Set Identifier) - _patsIoutput :: Patterns - -- use rule "DefaultRules.ag"(line 416, column 46) - _lhsOcontainsVars = - _patsIcontainsVars - -- use rule "DefaultRules.ag"(line 396, column 23) - _lhsOdefinedAttrs = - _patsIdefinedAttrs - -- use rule "DefaultRules.ag"(line 109, column 19) - _lhsOerrors = - _patsIerrors - -- use rule "DefaultRules.ag"(line 395, column 23) - _lhsOlocals = - _patsIlocals - -- self rule - _copy = - Product pos_ _patsIcopy - -- self rule - _output = - Product pos_ _patsIoutput - -- self rule - _lhsOcopy = - _copy - -- self rule - _lhsOoutput = - _output - -- copy rule (down) - _patsOcon = - _lhsIcon - -- copy rule (down) - _patsOnt = - _lhsInt - ( _patsIcontainsVars,_patsIcopy,_patsIdefinedAttrs,_patsIerrors,_patsIlocals,_patsIoutput) = - (pats_ _patsOcon _patsOnt) - in ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput)))) -sem_Pattern_Underscore :: Pos -> - T_Pattern -sem_Pattern_Underscore pos_ = - (T_Pattern (\ _lhsIcon - _lhsInt -> - (let _lhsOcontainsVars :: Bool - _lhsOdefinedAttrs :: (Set (Identifier,Identifier)) - _lhsOerrors :: (Seq Error) - _lhsOlocals :: (Set Identifier) - _lhsOcopy :: Pattern - _lhsOoutput :: Pattern - -- use rule "DefaultRules.ag"(line 416, column 46) - _lhsOcontainsVars = - False - -- use rule "DefaultRules.ag"(line 396, column 23) - _lhsOdefinedAttrs = - Set.empty - -- use rule "DefaultRules.ag"(line 109, column 19) - _lhsOerrors = - Seq.empty - -- use rule "DefaultRules.ag"(line 395, column 23) - _lhsOlocals = - Set.empty - -- self rule - _copy = - Underscore pos_ - -- self rule - _output = - Underscore pos_ - -- self rule - _lhsOcopy = - _copy - -- self rule - _lhsOoutput = - _output - in ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput)))) --- Patterns ---------------------------------------------------- -{- - visit 0: - inherited attributes: - con : ConstructorIdent - nt : NontermIdent - synthesized attributes: - containsVars : Bool - copy : SELF - definedAttrs : Set (Identifier,Identifier) - errors : Seq Error - locals : Set Identifier - output : SELF - alternatives: - alternative Cons: - child hd : Pattern - child tl : Patterns - visit 0: - local copy : _ - local output : _ - alternative Nil: - visit 0: - local copy : _ - local output : _ --} --- cata -sem_Patterns :: Patterns -> - T_Patterns -sem_Patterns list = - (Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list)) --- semantic domain -newtype T_Patterns = T_Patterns (ConstructorIdent -> - NontermIdent -> - ( Bool,Patterns,(Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Patterns)) -data Inh_Patterns = Inh_Patterns {con_Inh_Patterns :: ConstructorIdent,nt_Inh_Patterns :: NontermIdent} -data Syn_Patterns = Syn_Patterns {containsVars_Syn_Patterns :: Bool,copy_Syn_Patterns :: Patterns,definedAttrs_Syn_Patterns :: Set (Identifier,Identifier),errors_Syn_Patterns :: Seq Error,locals_Syn_Patterns :: Set Identifier,output_Syn_Patterns :: Patterns} -wrap_Patterns (T_Patterns sem) (Inh_Patterns _lhsIcon _lhsInt) = - (let ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) = - (sem _lhsIcon _lhsInt) - in (Syn_Patterns _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput)) -sem_Patterns_Cons :: T_Pattern -> - T_Patterns -> - T_Patterns -sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) = - (T_Patterns (\ _lhsIcon - _lhsInt -> - (let _lhsOcontainsVars :: Bool - _lhsOdefinedAttrs :: (Set (Identifier,Identifier)) - _lhsOerrors :: (Seq Error) - _lhsOlocals :: (Set Identifier) - _lhsOcopy :: Patterns - _lhsOoutput :: Patterns - _hdOcon :: ConstructorIdent - _hdOnt :: NontermIdent - _tlOcon :: ConstructorIdent - _tlOnt :: NontermIdent - _hdIcontainsVars :: Bool - _hdIcopy :: Pattern - _hdIdefinedAttrs :: (Set (Identifier,Identifier)) - _hdIerrors :: (Seq Error) - _hdIlocals :: (Set Identifier) - _hdIoutput :: Pattern - _tlIcontainsVars :: Bool - _tlIcopy :: Patterns - _tlIdefinedAttrs :: (Set (Identifier,Identifier)) - _tlIerrors :: (Seq Error) - _tlIlocals :: (Set Identifier) - _tlIoutput :: Patterns - -- use rule "DefaultRules.ag"(line 416, column 46) - _lhsOcontainsVars = - _hdIcontainsVars || _tlIcontainsVars - -- use rule "DefaultRules.ag"(line 396, column 23) - _lhsOdefinedAttrs = - _hdIdefinedAttrs `Set.union` _tlIdefinedAttrs - -- use rule "DefaultRules.ag"(line 109, column 19) - _lhsOerrors = - _hdIerrors Seq.<> _tlIerrors - -- use rule "DefaultRules.ag"(line 395, column 23) - _lhsOlocals = - _hdIlocals `Set.union` _tlIlocals - -- self rule - _copy = - (:) _hdIcopy _tlIcopy - -- self rule - _output = - (:) _hdIoutput _tlIoutput - -- self rule - _lhsOcopy = - _copy - -- self rule - _lhsOoutput = - _output - -- copy rule (down) - _hdOcon = - _lhsIcon - -- copy rule (down) - _hdOnt = - _lhsInt - -- copy rule (down) - _tlOcon = - _lhsIcon - -- copy rule (down) - _tlOnt = - _lhsInt - ( _hdIcontainsVars,_hdIcopy,_hdIdefinedAttrs,_hdIerrors,_hdIlocals,_hdIoutput) = - (hd_ _hdOcon _hdOnt) - ( _tlIcontainsVars,_tlIcopy,_tlIdefinedAttrs,_tlIerrors,_tlIlocals,_tlIoutput) = - (tl_ _tlOcon _tlOnt) - in ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput)))) -sem_Patterns_Nil :: T_Patterns -sem_Patterns_Nil = - (T_Patterns (\ _lhsIcon - _lhsInt -> - (let _lhsOcontainsVars :: Bool - _lhsOdefinedAttrs :: (Set (Identifier,Identifier)) - _lhsOerrors :: (Seq Error) - _lhsOlocals :: (Set Identifier) - _lhsOcopy :: Patterns - _lhsOoutput :: Patterns - -- use rule "DefaultRules.ag"(line 416, column 46) - _lhsOcontainsVars = - False - -- use rule "DefaultRules.ag"(line 396, column 23) - _lhsOdefinedAttrs = - Set.empty - -- use rule "DefaultRules.ag"(line 109, column 19) - _lhsOerrors = - Seq.empty - -- use rule "DefaultRules.ag"(line 395, column 23) - _lhsOlocals = - Set.empty - -- self rule - _copy = - [] - -- self rule - _output = - [] - -- self rule - _lhsOcopy = - _copy - -- self rule - _lhsOoutput = - _output - in ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput)))) --- Production -------------------------------------------------- -{- - visit 0: - inherited attributes: - cr : Bool - inh : Attributes - manualAttrOrderMap : AttrOrderMap - nonterminals : Set NontermIdent - nt : NontermIdent - o_rename : Bool - syn : Attributes - typeSyns : TypeSyns - useMap : Map Identifier (String,String,String) - chained attribute: - uniq : Int - synthesized attributes: - errors : Seq Error - output : SELF - alternatives: - alternative Production: - child con : {ConstructorIdent} - child children : Children - child rules : Rules - child typeSigs : TypeSigs - visit 0: - local _tup1 : _ - local newRls : _ - local errs : _ - local orderDeps : _ - local orderErrs : _ - local output : _ --} --- cata -sem_Production :: Production -> - T_Production -sem_Production (Production _con _children _rules _typeSigs) = - (sem_Production_Production _con (sem_Children _children) (sem_Rules _rules) (sem_TypeSigs _typeSigs)) --- semantic domain -newtype T_Production = T_Production (Bool -> - Attributes -> - AttrOrderMap -> - (Set NontermIdent) -> - NontermIdent -> - Bool -> - Attributes -> - TypeSyns -> - Int -> - (Map Identifier (String,String,String)) -> - ( (Seq Error),Production,Int)) -data Inh_Production = Inh_Production {cr_Inh_Production :: Bool,inh_Inh_Production :: Attributes,manualAttrOrderMap_Inh_Production :: AttrOrderMap,nonterminals_Inh_Production :: Set NontermIdent,nt_Inh_Production :: NontermIdent,o_rename_Inh_Production :: Bool,syn_Inh_Production :: Attributes,typeSyns_Inh_Production :: TypeSyns,uniq_Inh_Production :: Int,useMap_Inh_Production :: Map Identifier (String,String,String)} -data Syn_Production = Syn_Production {errors_Syn_Production :: Seq Error,output_Syn_Production :: Production,uniq_Syn_Production :: Int} -wrap_Production (T_Production sem) (Inh_Production _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap) = - (let ( _lhsOerrors,_lhsOoutput,_lhsOuniq) = - (sem _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap) - in (Syn_Production _lhsOerrors _lhsOoutput _lhsOuniq)) -sem_Production_Production :: ConstructorIdent -> - T_Children -> - T_Rules -> - T_TypeSigs -> - T_Production -sem_Production_Production con_ (T_Children children_) (T_Rules rules_) (T_TypeSigs typeSigs_) = - (T_Production (\ _lhsIcr - _lhsIinh - _lhsImanualAttrOrderMap - _lhsInonterminals - _lhsInt - _lhsIo_rename - _lhsIsyn - _lhsItypeSyns - _lhsIuniq - _lhsIuseMap -> - (let _rulesOcon :: ConstructorIdent - _childrenOcon :: ConstructorIdent - _lhsOerrors :: (Seq Error) - _lhsOoutput :: Production - _lhsOuniq :: Int - _childrenOcr :: Bool - _childrenOnt :: NontermIdent - _rulesOnt :: NontermIdent - _rulesOuniq :: Int - _childrenIerrors :: (Seq Error) - _childrenIfields :: ([(Identifier,Type,Bool)]) - _childrenIinputs :: ([(Identifier, Attributes)]) - _childrenIoutput :: Children - _childrenIoutputs :: ([(Identifier, Attributes)]) - _rulesIdefinedAttrs :: (Set (Identifier,Identifier)) - _rulesIerrors :: (Seq Error) - _rulesIlocals :: (Set Identifier) - _rulesIoutput :: Rules - _rulesIuniq :: Int - _typeSigsIoutput :: TypeSigs - -- "DefaultRules.ag"(line 137, column 16) - _rulesOcon = - con_ - -- "DefaultRules.ag"(line 138, column 17) - _childrenOcon = - con_ - -- "DefaultRules.ag"(line 320, column 4) - _lhsOerrors = - _childrenIerrors <> _errs <> _rulesIerrors <> _orderErrs - -- "DefaultRules.ag"(line 322, column 8) - __tup1 = - let locals = _rulesIlocals - initenv = Map.fromList ( [ (a,_ACHILD) - | (a,_,_) <- _childrenIfields - ] - ++ attrs(_LHS, _lhsIinh) - ++ [ (a,_LOC) - | a <- Set.toList locals - ] - ) - attrs (n,as) = [ (a,n) | a <- Map.keys as ] - envs = scanl (flip Map.union) - initenv - (map (Map.fromList . attrs ) _childrenIoutputs) - child_envs = init envs - lhs_env = last envs - (selfAttrs, normalAttrs) - = Map.partition isSELFNonterminal _lhsIsyn - (_,undefAttrs) - = removeDefined _rulesIdefinedAttrs (_LHS, normalAttrs) - (useAttrs,others) - = splitAttrs _lhsIuseMap undefAttrs - (rules1, errors1) - = concatRE $ map (copyRule _lhsInt con_ _lhsIcr locals) - (zip envs (map (removeDefined _rulesIdefinedAttrs) _childrenIinputs)) - uRules - = map (useRule locals _childrenIoutputs) useAttrs - selfLocRules - = [ selfRule False attr (constructor [childSelf attr nm tp | (nm,tp,ho) <- _childrenIfields, not ho]) - | attr <- Map.keys selfAttrs - , not (Set.member attr locals) - ] - where - childSelf self nm tp - = case tp of NT nt _ -> attrName nm self - _ | nm `Set.member` locals -> locname nm - | otherwise -> fieldName nm - constructor fs - | getName con_ == "Tuple" && _lhsInt `elem` map fst _lhsItypeSyns - = "(" ++ concat (List.intersperse "," fs) ++ ")" - | otherwise - = getConName _lhsItypeSyns _lhsIo_rename _lhsInt con_ ++ " " ++ unwords fs - selfRules - = [ selfRule True attr undefined - | attr <- Map.keys selfAttrs - , not (Set.member (_LHS,attr) _rulesIdefinedAttrs) - ] - (rules5, errs5) - = copyRule _lhsInt - con_ - _lhsIcr - locals - (lhs_env, (_LHS, others)) - in (uRules++selfLocRules++selfRules++rules5++rules1, errors1<>errs5) - -- "DefaultRules.ag"(line 322, column 8) - (_newRls,_) = - __tup1 - -- "DefaultRules.ag"(line 322, column 8) - (_,_errs) = - __tup1 - -- "DefaultRules.ag"(line 438, column 16) - _lhsOoutput = - Production con_ _childrenIoutput (_rulesIoutput ++ _newRls) _typeSigsIoutput - -- "DefaultRules.ag"(line 510, column 7) - _orderDeps = - Set.toList $ Map.findWithDefault Set.empty con_ $ Map.findWithDefault Map.empty _lhsInt _lhsImanualAttrOrderMap - -- "DefaultRules.ag"(line 512, column 7) - _orderErrs = - let chldOutMap = Map.fromList [ (k, Map.keysSet s) | (k,s) <- _childrenIoutputs ] - chldInMap = Map.fromList [ (k, Map.keysSet s) | (k,s) <- _childrenIinputs ] - isInAttribute :: Identifier -> Identifier -> [Error] - isInAttribute fld nm - | fld == _LOC = if nm `Set.member` _rulesIlocals - then [] - else [UndefAttr _lhsInt con_ fld nm False] - | fld == _LHS = if nm `Map.member` _lhsIinh - then [] - else [UndefAttr _lhsInt con_ fld nm False] - | otherwise = if nm `Set.member` (Map.findWithDefault Set.empty fld chldOutMap) - then [] - else [UndefAttr _lhsInt con_ fld nm False] - isOutAttribute :: Identifier -> Identifier -> [Error] - isOutAttribute fld nm - | fld == _LOC = if nm `Set.member` _rulesIlocals - then [] - else [UndefAttr _lhsInt con_ fld nm True] - | fld == _LHS = if nm `Map.member` _lhsIsyn - then [] - else [UndefAttr _lhsInt con_ fld nm True] - | otherwise = if nm `Set.member` (Map.findWithDefault Set.empty fld chldInMap) - then [] - else [UndefAttr _lhsInt con_ fld nm True] - in Seq.fromList . concat $ - [ isInAttribute fldA nmA ++ isOutAttribute fldB nmB - | dep@(Dependency (fldA,nmA) (fldB,nmB)) <- _orderDeps - ] - -- self rule - _output = - Production con_ _childrenIoutput _rulesIoutput _typeSigsIoutput - -- copy rule (up) - _lhsOuniq = - _rulesIuniq - -- copy rule (down) - _childrenOcr = - _lhsIcr - -- copy rule (down) - _childrenOnt = - _lhsInt - -- copy rule (down) - _rulesOnt = - _lhsInt - -- copy rule (down) - _rulesOuniq = - _lhsIuniq - ( _childrenIerrors,_childrenIfields,_childrenIinputs,_childrenIoutput,_childrenIoutputs) = - (children_ _childrenOcon _childrenOcr _childrenOnt) - ( _rulesIdefinedAttrs,_rulesIerrors,_rulesIlocals,_rulesIoutput,_rulesIuniq) = - (rules_ _rulesOcon _rulesOnt _rulesOuniq) - ( _typeSigsIoutput) = - (typeSigs_ ) - in ( _lhsOerrors,_lhsOoutput,_lhsOuniq)))) --- Productions ------------------------------------------------- -{- - visit 0: - inherited attributes: - cr : Bool - inh : Attributes - manualAttrOrderMap : AttrOrderMap - nonterminals : Set NontermIdent - nt : NontermIdent - o_rename : Bool - syn : Attributes - typeSyns : TypeSyns - useMap : Map Identifier (String,String,String) - chained attribute: - uniq : Int - synthesized attributes: - errors : Seq Error - output : SELF - alternatives: - alternative Cons: - child hd : Production - child tl : Productions - visit 0: - local output : _ - alternative Nil: - visit 0: - local output : _ --} --- cata -sem_Productions :: Productions -> - T_Productions -sem_Productions list = - (Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list)) --- semantic domain -newtype T_Productions = T_Productions (Bool -> - Attributes -> - AttrOrderMap -> - (Set NontermIdent) -> - NontermIdent -> - Bool -> - Attributes -> - TypeSyns -> - Int -> - (Map Identifier (String,String,String)) -> - ( (Seq Error),Productions,Int)) -data Inh_Productions = Inh_Productions {cr_Inh_Productions :: Bool,inh_Inh_Productions :: Attributes,manualAttrOrderMap_Inh_Productions :: AttrOrderMap,nonterminals_Inh_Productions :: Set NontermIdent,nt_Inh_Productions :: NontermIdent,o_rename_Inh_Productions :: Bool,syn_Inh_Productions :: Attributes,typeSyns_Inh_Productions :: TypeSyns,uniq_Inh_Productions :: Int,useMap_Inh_Productions :: Map Identifier (String,String,String)} -data Syn_Productions = Syn_Productions {errors_Syn_Productions :: Seq Error,output_Syn_Productions :: Productions,uniq_Syn_Productions :: Int} -wrap_Productions (T_Productions sem) (Inh_Productions _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap) = - (let ( _lhsOerrors,_lhsOoutput,_lhsOuniq) = - (sem _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap) - in (Syn_Productions _lhsOerrors _lhsOoutput _lhsOuniq)) -sem_Productions_Cons :: T_Production -> - T_Productions -> - T_Productions -sem_Productions_Cons (T_Production hd_) (T_Productions tl_) = - (T_Productions (\ _lhsIcr - _lhsIinh - _lhsImanualAttrOrderMap - _lhsInonterminals - _lhsInt - _lhsIo_rename - _lhsIsyn - _lhsItypeSyns - _lhsIuniq - _lhsIuseMap -> - (let _lhsOerrors :: (Seq Error) - _lhsOoutput :: Productions - _lhsOuniq :: Int - _hdOcr :: Bool - _hdOinh :: Attributes - _hdOmanualAttrOrderMap :: AttrOrderMap - _hdOnonterminals :: (Set NontermIdent) - _hdOnt :: NontermIdent - _hdOo_rename :: Bool - _hdOsyn :: Attributes - _hdOtypeSyns :: TypeSyns - _hdOuniq :: Int - _hdOuseMap :: (Map Identifier (String,String,String)) - _tlOcr :: Bool - _tlOinh :: Attributes - _tlOmanualAttrOrderMap :: AttrOrderMap - _tlOnonterminals :: (Set NontermIdent) - _tlOnt :: NontermIdent - _tlOo_rename :: Bool - _tlOsyn :: Attributes - _tlOtypeSyns :: TypeSyns - _tlOuniq :: Int - _tlOuseMap :: (Map Identifier (String,String,String)) - _hdIerrors :: (Seq Error) - _hdIoutput :: Production - _hdIuniq :: Int - _tlIerrors :: (Seq Error) - _tlIoutput :: Productions - _tlIuniq :: Int - -- use rule "DefaultRules.ag"(line 109, column 19) - _lhsOerrors = - _hdIerrors Seq.<> _tlIerrors - -- self rule - _output = - (:) _hdIoutput _tlIoutput - -- self rule - _lhsOoutput = - _output - -- copy rule (up) - _lhsOuniq = - _tlIuniq - -- copy rule (down) - _hdOcr = - _lhsIcr - -- copy rule (down) - _hdOinh = - _lhsIinh - -- copy rule (down) - _hdOmanualAttrOrderMap = - _lhsImanualAttrOrderMap - -- copy rule (down) - _hdOnonterminals = - _lhsInonterminals - -- copy rule (down) - _hdOnt = - _lhsInt - -- copy rule (down) - _hdOo_rename = - _lhsIo_rename - -- copy rule (down) - _hdOsyn = - _lhsIsyn - -- copy rule (down) - _hdOtypeSyns = - _lhsItypeSyns - -- copy rule (down) - _hdOuniq = - _lhsIuniq - -- copy rule (down) - _hdOuseMap = - _lhsIuseMap - -- copy rule (down) - _tlOcr = - _lhsIcr - -- copy rule (down) - _tlOinh = - _lhsIinh - -- copy rule (down) - _tlOmanualAttrOrderMap = - _lhsImanualAttrOrderMap - -- copy rule (down) - _tlOnonterminals = - _lhsInonterminals - -- copy rule (down) - _tlOnt = - _lhsInt - -- copy rule (down) - _tlOo_rename = - _lhsIo_rename - -- copy rule (down) - _tlOsyn = - _lhsIsyn - -- copy rule (down) - _tlOtypeSyns = - _lhsItypeSyns - -- copy rule (chain) - _tlOuniq = - _hdIuniq - -- copy rule (down) - _tlOuseMap = - _lhsIuseMap - ( _hdIerrors,_hdIoutput,_hdIuniq) = - (hd_ _hdOcr _hdOinh _hdOmanualAttrOrderMap _hdOnonterminals _hdOnt _hdOo_rename _hdOsyn _hdOtypeSyns _hdOuniq _hdOuseMap) - ( _tlIerrors,_tlIoutput,_tlIuniq) = - (tl_ _tlOcr _tlOinh _tlOmanualAttrOrderMap _tlOnonterminals _tlOnt _tlOo_rename _tlOsyn _tlOtypeSyns _tlOuniq _tlOuseMap) - in ( _lhsOerrors,_lhsOoutput,_lhsOuniq)))) -sem_Productions_Nil :: T_Productions -sem_Productions_Nil = - (T_Productions (\ _lhsIcr - _lhsIinh - _lhsImanualAttrOrderMap - _lhsInonterminals - _lhsInt - _lhsIo_rename - _lhsIsyn - _lhsItypeSyns - _lhsIuniq - _lhsIuseMap -> - (let _lhsOerrors :: (Seq Error) - _lhsOoutput :: Productions - _lhsOuniq :: Int - -- use rule "DefaultRules.ag"(line 109, column 19) - _lhsOerrors = - Seq.empty - -- self rule - _output = - [] - -- self rule - _lhsOoutput = - _output - -- copy rule (chain) - _lhsOuniq = - _lhsIuniq - in ( _lhsOerrors,_lhsOoutput,_lhsOuniq)))) --- Rule -------------------------------------------------------- -{- - visit 0: - inherited attributes: - con : ConstructorIdent - nt : NontermIdent - chained attribute: - uniq : Int - synthesized attributes: - containsVars : Bool - definedAttrs : Set (Identifier,Identifier) - errors : Seq Error - locals : Set Identifier - output : SELF - outputs : Rules - alternatives: - alternative Rule: - child pattern : Pattern - child rhs : {Expression} - child owrt : {Bool} - child origin : {String} - visit 0: - local _tup2 : {(Rules,Int)} - local output : _ --} --- cata -sem_Rule :: Rule -> - T_Rule -sem_Rule (Rule _pattern _rhs _owrt _origin) = - (sem_Rule_Rule (sem_Pattern _pattern) _rhs _owrt _origin) --- semantic domain -newtype T_Rule = T_Rule (ConstructorIdent -> - NontermIdent -> - Int -> - ( Bool,(Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Rule,Rules,Int)) -data Inh_Rule = Inh_Rule {con_Inh_Rule :: ConstructorIdent,nt_Inh_Rule :: NontermIdent,uniq_Inh_Rule :: Int} -data Syn_Rule = Syn_Rule {containsVars_Syn_Rule :: Bool,definedAttrs_Syn_Rule :: Set (Identifier,Identifier),errors_Syn_Rule :: Seq Error,locals_Syn_Rule :: Set Identifier,output_Syn_Rule :: Rule,outputs_Syn_Rule :: Rules,uniq_Syn_Rule :: Int} -wrap_Rule (T_Rule sem) (Inh_Rule _lhsIcon _lhsInt _lhsIuniq) = - (let ( _lhsOcontainsVars,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOoutputs,_lhsOuniq) = - (sem _lhsIcon _lhsInt _lhsIuniq) - in (Syn_Rule _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOoutputs _lhsOuniq)) -sem_Rule_Rule :: T_Pattern -> - Expression -> - Bool -> - String -> - T_Rule -sem_Rule_Rule (T_Pattern pattern_) rhs_ owrt_ origin_ = - (T_Rule (\ _lhsIcon - _lhsInt - _lhsIuniq -> - (let __tup2 :: ((Rules,Int)) - _lhsOoutputs :: Rules - _lhsOuniq :: Int - _lhsOcontainsVars :: Bool - _lhsOdefinedAttrs :: (Set (Identifier,Identifier)) - _lhsOerrors :: (Seq Error) - _lhsOlocals :: (Set Identifier) - _lhsOoutput :: Rule - _patternOcon :: ConstructorIdent - _patternOnt :: NontermIdent - _patternIcontainsVars :: Bool - _patternIcopy :: Pattern - _patternIdefinedAttrs :: (Set (Identifier,Identifier)) - _patternIerrors :: (Seq Error) - _patternIlocals :: (Set Identifier) - _patternIoutput :: Pattern - -- "DefaultRules.ag"(line 445, column 11) - __tup2 = - multiRule _output _lhsIuniq - -- "DefaultRules.ag"(line 445, column 11) - (_lhsOoutputs,_) = - __tup2 - -- "DefaultRules.ag"(line 445, column 11) - (_,_lhsOuniq) = - __tup2 - -- use rule "DefaultRules.ag"(line 416, column 46) - _lhsOcontainsVars = - _patternIcontainsVars - -- use rule "DefaultRules.ag"(line 396, column 23) - _lhsOdefinedAttrs = - _patternIdefinedAttrs - -- use rule "DefaultRules.ag"(line 109, column 19) - _lhsOerrors = - _patternIerrors - -- use rule "DefaultRules.ag"(line 395, column 23) - _lhsOlocals = - _patternIlocals - -- self rule - _output = - Rule _patternIoutput rhs_ owrt_ origin_ - -- self rule - _lhsOoutput = - _output - -- copy rule (down) - _patternOcon = - _lhsIcon - -- copy rule (down) - _patternOnt = - _lhsInt - ( _patternIcontainsVars,_patternIcopy,_patternIdefinedAttrs,_patternIerrors,_patternIlocals,_patternIoutput) = - (pattern_ _patternOcon _patternOnt) - in ( _lhsOcontainsVars,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOoutputs,_lhsOuniq)))) --- Rules ------------------------------------------------------- -{- - visit 0: - inherited attributes: - con : ConstructorIdent - nt : NontermIdent - chained attribute: - uniq : Int - synthesized attributes: - definedAttrs : Set (Identifier,Identifier) - errors : Seq Error - locals : Set Identifier - output : SELF - alternatives: - alternative Cons: - child hd : Rule - child tl : Rules - visit 0: - local output : _ - alternative Nil: - visit 0: - local output : _ --} --- cata -sem_Rules :: Rules -> - T_Rules -sem_Rules list = - (Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list)) --- semantic domain -newtype T_Rules = T_Rules (ConstructorIdent -> - NontermIdent -> - Int -> - ( (Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Rules,Int)) -data Inh_Rules = Inh_Rules {con_Inh_Rules :: ConstructorIdent,nt_Inh_Rules :: NontermIdent,uniq_Inh_Rules :: Int} -data Syn_Rules = Syn_Rules {definedAttrs_Syn_Rules :: Set (Identifier,Identifier),errors_Syn_Rules :: Seq Error,locals_Syn_Rules :: Set Identifier,output_Syn_Rules :: Rules,uniq_Syn_Rules :: Int} -wrap_Rules (T_Rules sem) (Inh_Rules _lhsIcon _lhsInt _lhsIuniq) = - (let ( _lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOuniq) = - (sem _lhsIcon _lhsInt _lhsIuniq) - in (Syn_Rules _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOuniq)) -sem_Rules_Cons :: T_Rule -> - T_Rules -> - T_Rules -sem_Rules_Cons (T_Rule hd_) (T_Rules tl_) = - (T_Rules (\ _lhsIcon - _lhsInt - _lhsIuniq -> - (let _lhsOoutput :: Rules - _lhsOdefinedAttrs :: (Set (Identifier,Identifier)) - _lhsOerrors :: (Seq Error) - _lhsOlocals :: (Set Identifier) - _lhsOuniq :: Int - _hdOcon :: ConstructorIdent - _hdOnt :: NontermIdent - _hdOuniq :: Int - _tlOcon :: ConstructorIdent - _tlOnt :: NontermIdent - _tlOuniq :: Int - _hdIcontainsVars :: Bool - _hdIdefinedAttrs :: (Set (Identifier,Identifier)) - _hdIerrors :: (Seq Error) - _hdIlocals :: (Set Identifier) - _hdIoutput :: Rule - _hdIoutputs :: Rules - _hdIuniq :: Int - _tlIdefinedAttrs :: (Set (Identifier,Identifier)) - _tlIerrors :: (Seq Error) - _tlIlocals :: (Set Identifier) - _tlIoutput :: Rules - _tlIuniq :: Int - -- "DefaultRules.ag"(line 441, column 10) - _lhsOoutput = - if _hdIcontainsVars then _hdIoutputs ++ _tlIoutput else _tlIoutput - -- use rule "DefaultRules.ag"(line 396, column 23) - _lhsOdefinedAttrs = - _hdIdefinedAttrs `Set.union` _tlIdefinedAttrs - -- use rule "DefaultRules.ag"(line 109, column 19) - _lhsOerrors = - _hdIerrors Seq.<> _tlIerrors - -- use rule "DefaultRules.ag"(line 395, column 23) - _lhsOlocals = - _hdIlocals `Set.union` _tlIlocals - -- self rule - _output = - (:) _hdIoutput _tlIoutput - -- copy rule (up) - _lhsOuniq = - _tlIuniq - -- copy rule (down) - _hdOcon = - _lhsIcon - -- copy rule (down) - _hdOnt = - _lhsInt - -- copy rule (down) - _hdOuniq = - _lhsIuniq - -- copy rule (down) - _tlOcon = - _lhsIcon - -- copy rule (down) - _tlOnt = - _lhsInt - -- copy rule (chain) - _tlOuniq = - _hdIuniq - ( _hdIcontainsVars,_hdIdefinedAttrs,_hdIerrors,_hdIlocals,_hdIoutput,_hdIoutputs,_hdIuniq) = - (hd_ _hdOcon _hdOnt _hdOuniq) - ( _tlIdefinedAttrs,_tlIerrors,_tlIlocals,_tlIoutput,_tlIuniq) = - (tl_ _tlOcon _tlOnt _tlOuniq) - in ( _lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOuniq)))) -sem_Rules_Nil :: T_Rules -sem_Rules_Nil = - (T_Rules (\ _lhsIcon - _lhsInt - _lhsIuniq -> - (let _lhsOdefinedAttrs :: (Set (Identifier,Identifier)) - _lhsOerrors :: (Seq Error) - _lhsOlocals :: (Set Identifier) - _lhsOoutput :: Rules - _lhsOuniq :: Int - -- use rule "DefaultRules.ag"(line 396, column 23) - _lhsOdefinedAttrs = - Set.empty - -- use rule "DefaultRules.ag"(line 109, column 19) - _lhsOerrors = - Seq.empty - -- use rule "DefaultRules.ag"(line 395, column 23) - _lhsOlocals = - Set.empty - -- self rule - _output = - [] - -- self rule - _lhsOoutput = - _output - -- copy rule (chain) - _lhsOuniq = - _lhsIuniq - in ( _lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOuniq)))) --- TypeSig ----------------------------------------------------- -{- - visit 0: - synthesized attribute: - output : SELF - alternatives: - alternative TypeSig: - child name : {Identifier} - child tp : {Type} - visit 0: - local output : _ --} --- cata -sem_TypeSig :: TypeSig -> - T_TypeSig -sem_TypeSig (TypeSig _name _tp) = - (sem_TypeSig_TypeSig _name _tp) --- semantic domain -newtype T_TypeSig = T_TypeSig (( TypeSig)) -data Inh_TypeSig = Inh_TypeSig {} -data Syn_TypeSig = Syn_TypeSig {output_Syn_TypeSig :: TypeSig} -wrap_TypeSig (T_TypeSig sem) (Inh_TypeSig ) = - (let ( _lhsOoutput) = - (sem ) - in (Syn_TypeSig _lhsOoutput)) -sem_TypeSig_TypeSig :: Identifier -> - Type -> - T_TypeSig -sem_TypeSig_TypeSig name_ tp_ = - (T_TypeSig (let _lhsOoutput :: TypeSig - -- self rule - _output = - TypeSig name_ tp_ - -- self rule - _lhsOoutput = - _output - in ( _lhsOoutput))) --- TypeSigs ---------------------------------------------------- -{- - visit 0: - synthesized attribute: - output : SELF - alternatives: - alternative Cons: - child hd : TypeSig - child tl : TypeSigs - visit 0: - local output : _ - alternative Nil: - visit 0: - local output : _ --} --- cata -sem_TypeSigs :: TypeSigs -> - T_TypeSigs -sem_TypeSigs list = - (Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list)) --- semantic domain -newtype T_TypeSigs = T_TypeSigs (( TypeSigs)) -data Inh_TypeSigs = Inh_TypeSigs {} -data Syn_TypeSigs = Syn_TypeSigs {output_Syn_TypeSigs :: TypeSigs} -wrap_TypeSigs (T_TypeSigs sem) (Inh_TypeSigs ) = - (let ( _lhsOoutput) = - (sem ) - in (Syn_TypeSigs _lhsOoutput)) -sem_TypeSigs_Cons :: T_TypeSig -> - T_TypeSigs -> - T_TypeSigs -sem_TypeSigs_Cons (T_TypeSig hd_) (T_TypeSigs tl_) = - (T_TypeSigs (let _lhsOoutput :: TypeSigs - _hdIoutput :: TypeSig - _tlIoutput :: TypeSigs - -- self rule - _output = - (:) _hdIoutput _tlIoutput - -- self rule - _lhsOoutput = - _output - ( _hdIoutput) = - (hd_ ) - ( _tlIoutput) = - (tl_ ) - in ( _lhsOoutput))) -sem_TypeSigs_Nil :: T_TypeSigs -sem_TypeSigs_Nil = - (T_TypeSigs (let _lhsOoutput :: TypeSigs - -- self rule - _output = - [] - -- self rule - _lhsOoutput = - _output - in ( _lhsOoutput))) +{-# OPTIONS_GHC -fbang-patterns #-} +-- UUAGC 0.9.5 (DefaultRules.ag) +module DefaultRules where + +import qualified List (delete,intersperse) + +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Map(Map) +import qualified UU.DData.Seq as Seq +import UU.DData.Seq(Seq,(<>)) +import UU.Scanner.Position(noPos) +import Pretty +import Maybe +import HsToken +import HsTokenScanner + +import AbstractSyntax +import ErrorMessages + +import Options(Options,modcopy,rename) + +-- AbstractSyntax.ag imports +import Data.Set(Set) +import Data.Map(Map) +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import CommonTypes + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) + +fieldName n = '@' : getName n + +locName n = '@' : getName n + +attrName fld attr + | fld == _LOC = '@' : getName attr + | otherwise = '@' : getName fld ++ "." ++ getName attr + +_ACHILD = Ident "(" noPos -- hack + + +getConName typeSyns rename nt con1 + | nt `elem` map fst typeSyns = synonym + | otherwise = normalName + where con = getName con1 + normalName | rename = getName nt++"_"++ con + | otherwise = con + synonym | con == "Cons" = "(:)" + | con == "Nil" = "[]" + | con == "Just" = "Just" + | con == "Nothing" = "Nothing" + | otherwise = normalName + + + +concatSeq = foldr Seq.append Seq.empty + +splitAttrs :: Map Identifier a -> [Identifier] -> ([(Identifier,a)],[Identifier]) -- a used as (String,String) +splitAttrs _ [] + = ([],[]) +splitAttrs useMap (n:rest) + = let (uses,normals) = splitAttrs useMap rest + in case Map.lookup n useMap of + Just x -> ((n,x):uses , normals ) + Nothing -> ( uses , n:normals ) + +removeDefined :: Set (Identifier,Identifier) -> (Identifier,Attributes) -> (Identifier,[Identifier]) +removeDefined defined (fld,as) + = ( fld + , [ a + | a <- Map.keys as + , not (Set.member (fld,a) defined) + ] + ) + + + + + +deprecatedCopyRuleError nt con fld a + = let mesg = + "In the definitions for alternative" + >#< getName con + >#< "of nonterminal" + >#< getName nt + >|< "," + >-< "the value of field" + >#< getName a + >#< "is copied by a copy-rule." + >-< "Copying the value of a field using a copy-rule is deprecated" + >-< "Please add the following lines to your code:" + >-< ( "SEM" + >#< getName nt + >-< indent 2 ( "|" + >#< getName con + >#< getName fld + >#< "." + >#< a + >#< "=" + >#< "@" + >|< a + ) + ) + in CustomError True (getPos a) mesg + + +missingRuleErrorExpr nt con fld a + = "error \"missing rule: " + ++ show nt ++ "." ++ show con ++ "." + ++ show fld ++ "." ++ show a ++ "\"" + + + +makeRule :: (Identifier,Identifier) -> Expression -> String -> Rule +makeRule (f1,a1) expr origin + = Rule (Alias f1 a1 (Underscore noPos) []) + expr + False + origin + + +useRule :: Set Identifier -> [(Identifier,Attributes)] -> (Identifier,(String,String,String)) -> Rule +useRule locals ch_outs (n,(op,e,pos)) + = let elems = [ fld + | (fld,as) <- ch_outs + , Map.member n as + ] + + expr | Set.member n locals = attrName _LOC n + | null elems = e + | otherwise = foldr1 (\x y -> x ++ " " ++ op ++ " " ++ y) + (map (flip attrName n) elems) + + tks | Set.member n locals = [AGLocal n noPos Nothing] + | null elems = lexTokens noPos e + | otherwise = lexTokens noPos str + where + str = foldr1 (\x y -> x ++ " " ++ op ++ " " ++ y) + (map (flip attrName n) elems) + + in makeRule (_LHS,n) + (Expression noPos tks) + ("use rule " ++ pos) + + + + +selfRule lhsNecLoc attr x + = let expr | lhsNecLoc = locName attr + | otherwise = x + + tks | lhsNecLoc = [AGLocal attr noPos Nothing] + | otherwise = lexTokens noPos x + + in makeRule (if lhsNecLoc then _LHS else _LOC,attr) + (Expression noPos tks) + "self rule" + + + + +concatRE rsess = let (rss,ess) = unzip rsess + in (concat rss, concatSeq ess) + + +copyRule :: Identifier -> Identifier -> Bool -> Set Identifier -> (Map Identifier Identifier, (Identifier,[Identifier])) -> ([Rule], Seq Error) +copyRule nt con modcopy locals (env,(fld,as)) + = concatRE (map copyRu as) + + where + copyRu a + = ( [ makeRule (fld,a) + (Expression noPos tks) + (cruletxt sel) + ] + , err + ) + + where + sel + | not modcopy + && Set.member a locals = Just _LOC + | otherwise = Map.lookup a env + + (expr,err) + = case sel of + Nothing -> ( missingRuleErrorExpr nt con fld a + , Seq.single (MissingRule nt con fld a) + ) + Just f + | f == _ACHILD -> ( fieldName a + , Seq.single (deprecatedCopyRuleError nt con fld a) + ) + | otherwise -> ( attrName f a + , Seq.empty + ) + + (tks,err') + = case sel of + Nothing -> ( [HsToken (missingRuleErrorExpr nt con fld a) noPos] + , Seq.single (MissingRule nt con fld a) + ) + Just f + | f == _ACHILD -> ( [AGLocal a noPos Nothing] + , Seq.single (deprecatedCopyRuleError nt con fld a) + ) + | otherwise -> ( [AGField f a noPos Nothing] + , Seq.empty + ) + + cruletxt sel + | local = "copy rule (from local)" + | deprChild = "deprecated child copy" + | Set.member a locals && nonlocal = "modified copy rule" + | incoming && outgoing = "copy rule (chain)" + | incoming = "copy rule (down)" + | outgoing = "copy rule (up)" + | otherwise = "copy rule (chain)" + where outgoing = fld == _LHS + incoming = maybe False (== _LHS) sel + nonlocal = maybe False (/= _LOC) sel + local = maybe False (== _LOC) sel + deprChild = maybe False (== _ACHILD) sel + +{- +multiRule replaces + loc.(a,b) = e +by + loc.tup1 = e + loc.(a,_) = @loc.tup1 + loc.(_,b) = @loc.tup1 +It needs to thread a unique number for inventing names for the tuples. + +It also works for nested tuples: + loc.(a,(b,c)) = e +becomes + loc.tup1 = e + loc.(a,_) = @loc.tup1 + loc.(_,tup2) = @loc.tup1 + loc.(b,_) = @loc.tup2 + loc.(_,c) = @loc.tup2 +-} + +multiRule :: Rule -> Int -> ([Rule], Int) +multiRule (Rule pat expr owrt origin) uniq + = let f :: (Pattern->Pattern) -> Expression -> Pattern -> Int -> (Pattern, ([Rule], Int)) + f w e (Product pos pats) n + = let freshName = Ident ("_tup" ++ show n) pos + freshExpr = Expression pos freshTks + freshTks = [AGField _LOC freshName pos Nothing] + freshPat = Alias _LOC freshName (Underscore pos) pats + a = length pats - 1 + us b p = Product pos (replicate (a-b) (Underscore pos) ++ [p] ++ replicate b (Underscore pos)) + g :: Pattern -> ([Pattern],[Rule],Int) -> ([Pattern],[Rule],Int) + g p (xs1,rs1,n1) = let (x2,(rs2,n2)) = f (us (length xs1)) freshExpr p n1 + in (x2:xs1, rs2++rs1, n2) + (xs9,rs9,n9) = foldr g ([], [], n+1) pats + in ( freshPat + , ( Rule (w freshPat) e owrt origin : rs9 + , n9 + ) + ) + f w e p n + = ( p + , ( [Rule (w p) e owrt origin] + , n + ) + ) + in snd (f id expr pat uniq) + +-- Child ------------------------------------------------------- +{- + visit 0: + inherited attributes: + con : ConstructorIdent + cr : Bool + nt : NontermIdent + synthesized attributes: + errors : Seq Error + field : (Identifier,Type,Bool) + inherited : Attributes + name : Identifier + output : SELF + synthesized : Attributes + alternatives: + alternative Child: + child name : {Identifier} + child tp : {Type} + child inh : {Attributes} + child syn : {Attributes} + child higherOrder : {Bool} + visit 0: + local output : _ +-} +-- cata +sem_Child :: Child -> + T_Child +sem_Child !(Child _name _tp _inh _syn _higherOrder) = + (sem_Child_Child _name _tp _inh _syn _higherOrder) +-- semantic domain +newtype T_Child = T_Child (ConstructorIdent -> + Bool -> + NontermIdent -> + ( (Seq Error),( (Identifier,Type,Bool) ),Attributes,Identifier,Child,Attributes)) +data Inh_Child = Inh_Child {con_Inh_Child :: !(ConstructorIdent),cr_Inh_Child :: !(Bool),nt_Inh_Child :: !(NontermIdent)} +data Syn_Child = Syn_Child {errors_Syn_Child :: !(Seq Error),field_Syn_Child :: !( (Identifier,Type,Bool) ),inherited_Syn_Child :: !(Attributes),name_Syn_Child :: !(Identifier),output_Syn_Child :: !(Child),synthesized_Syn_Child :: !(Attributes)} +wrap_Child !(T_Child sem) !(Inh_Child _lhsIcon _lhsIcr _lhsInt) = + (let ( !_lhsOerrors,!_lhsOfield,!_lhsOinherited,!_lhsOname,!_lhsOoutput,!_lhsOsynthesized) = + (sem _lhsIcon _lhsIcr _lhsInt) + in (Syn_Child _lhsOerrors _lhsOfield _lhsOinherited _lhsOname _lhsOoutput _lhsOsynthesized)) +sem_Child_Child :: Identifier -> + Type -> + Attributes -> + Attributes -> + Bool -> + T_Child +sem_Child_Child !name_ !tp_ !inh_ !syn_ !higherOrder_ = + (T_Child (\ (!_lhsIcon) + (!_lhsIcr) + (!_lhsInt) -> + (case (Seq.empty) of + { !_lhsOerrors -> + (case ((name_,tp_,higherOrder_)) of + { !_lhsOfield -> + (case (inh_) of + { !_lhsOinherited -> + (case (name_) of + { !_lhsOname -> + (case (Child name_ tp_ inh_ syn_ higherOrder_) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + (case (syn_) of + { !_lhsOsynthesized -> + ( _lhsOerrors,_lhsOfield,_lhsOinherited,_lhsOname,_lhsOoutput,_lhsOsynthesized) }) }) }) }) }) }) }))) +-- Children ---------------------------------------------------- +{- + visit 0: + inherited attributes: + con : ConstructorIdent + cr : Bool + nt : NontermIdent + synthesized attributes: + errors : Seq Error + fields : [(Identifier,Type,Bool)] + inputs : [(Identifier, Attributes)] + output : SELF + outputs : [(Identifier, Attributes)] + alternatives: + alternative Cons: + child hd : Child + child tl : Children + visit 0: + local output : _ + alternative Nil: + visit 0: + local output : _ +-} +-- cata +sem_Children :: Children -> + T_Children +sem_Children !list = + (Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list)) +-- semantic domain +newtype T_Children = T_Children (ConstructorIdent -> + Bool -> + NontermIdent -> + ( (Seq Error),([(Identifier,Type,Bool)]),([(Identifier, Attributes)]),Children,([(Identifier, Attributes)]))) +data Inh_Children = Inh_Children {con_Inh_Children :: !(ConstructorIdent),cr_Inh_Children :: !(Bool),nt_Inh_Children :: !(NontermIdent)} +data Syn_Children = Syn_Children {errors_Syn_Children :: !(Seq Error),fields_Syn_Children :: !([(Identifier,Type,Bool)]),inputs_Syn_Children :: !([(Identifier, Attributes)]),output_Syn_Children :: !(Children),outputs_Syn_Children :: !([(Identifier, Attributes)])} +wrap_Children !(T_Children sem) !(Inh_Children _lhsIcon _lhsIcr _lhsInt) = + (let ( !_lhsOerrors,!_lhsOfields,!_lhsOinputs,!_lhsOoutput,!_lhsOoutputs) = + (sem _lhsIcon _lhsIcr _lhsInt) + in (Syn_Children _lhsOerrors _lhsOfields _lhsOinputs _lhsOoutput _lhsOoutputs)) +sem_Children_Cons :: T_Child -> + T_Children -> + T_Children +sem_Children_Cons !(T_Child hd_) !(T_Children tl_) = + (T_Children (\ (!_lhsIcon) + (!_lhsIcr) + (!_lhsInt) -> + (case (_lhsInt) of + { !_tlOnt -> + (case (_lhsIcr) of + { !_tlOcr -> + (case (_lhsIcon) of + { !_tlOcon -> + (case ((tl_ _tlOcon _tlOcr _tlOnt)) of + { ( !_tlIerrors,!_tlIfields,!_tlIinputs,!_tlIoutput,!_tlIoutputs) -> + (case (_lhsInt) of + { !_hdOnt -> + (case (_lhsIcr) of + { !_hdOcr -> + (case (_lhsIcon) of + { !_hdOcon -> + (case ((hd_ _hdOcon _hdOcr _hdOnt)) of + { ( !_hdIerrors,!_hdIfield,!_hdIinherited,!_hdIname,!_hdIoutput,!_hdIsynthesized) -> + (case (_hdIerrors Seq.<> _tlIerrors) of + { !_lhsOerrors -> + (case (_hdIfield : _tlIfields) of + { !_lhsOfields -> + (case ((_hdIname, _hdIinherited) : _tlIinputs) of + { !_lhsOinputs -> + (case ((:) _hdIoutput _tlIoutput) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + (case ((_hdIname, _hdIsynthesized) : _tlIoutputs) of + { !_lhsOoutputs -> + ( _lhsOerrors,_lhsOfields,_lhsOinputs,_lhsOoutput,_lhsOoutputs) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_Children_Nil :: T_Children +sem_Children_Nil = + (T_Children (\ (!_lhsIcon) + (!_lhsIcr) + (!_lhsInt) -> + (case (Seq.empty) of + { !_lhsOerrors -> + (case ([]) of + { !_lhsOfields -> + (case ([]) of + { !_lhsOinputs -> + (case ([]) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + (case ([]) 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 uniqueMap : {UniqueMap} + visit 0: + local output : _ +-} +-- cata +sem_Grammar :: Grammar -> + T_Grammar +sem_Grammar !(Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap) = + (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts) _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap) +-- semantic domain +newtype T_Grammar = T_Grammar (Options -> + ( (Seq Error),Grammar)) +data Inh_Grammar = Inh_Grammar {options_Inh_Grammar :: !(Options)} +data Syn_Grammar = Syn_Grammar {errors_Syn_Grammar :: !(Seq Error),output_Syn_Grammar :: !(Grammar)} +wrap_Grammar !(T_Grammar sem) !(Inh_Grammar _lhsIoptions) = + (let ( !_lhsOerrors,!_lhsOoutput) = + (sem _lhsIoptions) + in (Syn_Grammar _lhsOerrors _lhsOoutput)) +sem_Grammar_Grammar :: TypeSyns -> + UseMap -> + Derivings -> + (Set NontermIdent) -> + T_Nonterminals -> + PragmaMap -> + AttrOrderMap -> + ParamMap -> + ContextMap -> + UniqueMap -> + T_Grammar +sem_Grammar_Grammar !typeSyns_ !useMap_ !derivings_ !wrappers_ !(T_Nonterminals nonts_) !pragmas_ !manualAttrOrderMap_ !paramMap_ !contextMap_ !uniqueMap_ = + (T_Grammar (\ (!_lhsIoptions) -> + (case (manualAttrOrderMap_) of + { !_nontsOmanualAttrOrderMap -> + (case (typeSyns_) of + { !_nontsOtypeSyns -> + (case (useMap_) of + { !_nontsOuseMap -> + (case (modcopy _lhsIoptions) of + { !_nontsOcr -> + (case (rename _lhsIoptions) of + { !_nontsOo_rename -> + (case ((nonts_ )) of + { ( !_nontsIcollect_nts,!T_Nonterminals_1 nonts_1) -> + (case (1) of + { !_nontsOuniq -> + (case (_nontsIcollect_nts) of + { !_nontsOnonterminals -> + (case ((nonts_1 _nontsOcr _nontsOmanualAttrOrderMap _nontsOnonterminals _nontsOo_rename _nontsOtypeSyns _nontsOuniq _nontsOuseMap)) of + { ( !_nontsIerrors,!_nontsIoutput,!_nontsIuniq) -> + (case (_nontsIerrors) of + { !_lhsOerrors -> + (case (Grammar typeSyns_ useMap_ derivings_ wrappers_ _nontsIoutput pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ uniqueMap_) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + ( _lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }))) +-- Nonterminal ------------------------------------------------- +{- + visit 0: + synthesized attribute: + collect_nts : Set NontermIdent + visit 1: + inherited attributes: + cr : Bool + manualAttrOrderMap : AttrOrderMap + 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 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 (Bool -> + AttrOrderMap -> + (Set NontermIdent) -> + Bool -> + TypeSyns -> + Int -> + UseMap -> + ( (Seq Error),Nonterminal,Int)) +data Inh_Nonterminal = Inh_Nonterminal {cr_Inh_Nonterminal :: !(Bool),manualAttrOrderMap_Inh_Nonterminal :: !(AttrOrderMap),nonterminals_Inh_Nonterminal :: !(Set NontermIdent),o_rename_Inh_Nonterminal :: !(Bool),typeSyns_Inh_Nonterminal :: !(TypeSyns),uniq_Inh_Nonterminal :: !(Int),useMap_Inh_Nonterminal :: !(UseMap)} +data Syn_Nonterminal = Syn_Nonterminal {collect_nts_Syn_Nonterminal :: !(Set NontermIdent),errors_Syn_Nonterminal :: !(Seq Error),output_Syn_Nonterminal :: !(Nonterminal),uniq_Syn_Nonterminal :: !(Int)} +wrap_Nonterminal !(T_Nonterminal sem) !(Inh_Nonterminal _lhsIcr _lhsImanualAttrOrderMap _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap) = + (let ( !_lhsOcollect_nts,!T_Nonterminal_1 sem_1) = + (sem ) + ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = + (sem_1 _lhsIcr _lhsImanualAttrOrderMap _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap) + in (Syn_Nonterminal _lhsOcollect_nts _lhsOerrors _lhsOoutput _lhsOuniq)) +sem_Nonterminal_Nonterminal :: NontermIdent -> + ([Identifier]) -> + Attributes -> + Attributes -> + T_Productions -> + T_Nonterminal +sem_Nonterminal_Nonterminal !nt_ !params_ !inh_ !syn_ !(T_Productions prods_) = + (T_Nonterminal (case (Set.singleton nt_) of + { !_lhsOcollect_nts -> + (case ((sem_Nonterminal_Nonterminal_1 nt_ syn_ inh_ (T_Productions prods_) params_)) of + { ( !sem_Nonterminal_1) -> + ( _lhsOcollect_nts,sem_Nonterminal_1) }) })) +sem_Nonterminal_Nonterminal_1 :: NontermIdent -> + Attributes -> + Attributes -> + T_Productions -> + ([Identifier]) -> + T_Nonterminal_1 +sem_Nonterminal_Nonterminal_1 !nt_ !syn_ !inh_ !(T_Productions prods_) !params_ = + (T_Nonterminal_1 (\ (!_lhsIcr) + (!_lhsImanualAttrOrderMap) + (!_lhsInonterminals) + (!_lhsIo_rename) + (!_lhsItypeSyns) + (!_lhsIuniq) + (!_lhsIuseMap) -> + (case (_lhsItypeSyns) of + { !_prodsOtypeSyns -> + (case (_lhsIo_rename) of + { !_prodsOo_rename -> + (case (_lhsImanualAttrOrderMap) of + { !_prodsOmanualAttrOrderMap -> + (case (_lhsIcr) of + { !_prodsOcr -> + (case (nt_) of + { !_prodsOnt -> + (case (Map.findWithDefault Map.empty nt_ _lhsIuseMap) of + { !_prodsOuseMap -> + (case (syn_) of + { !_prodsOsyn -> + (case (inh_) of + { !_prodsOinh -> + (case (_lhsIuniq) of + { !_prodsOuniq -> + (case (_lhsInonterminals) of + { !_prodsOnonterminals -> + (case ((prods_ _prodsOcr _prodsOinh _prodsOmanualAttrOrderMap _prodsOnonterminals _prodsOnt _prodsOo_rename _prodsOsyn _prodsOtypeSyns _prodsOuniq _prodsOuseMap)) of + { ( !_prodsIerrors,!_prodsIoutput,!_prodsIuniq) -> + (case (_prodsIerrors) of + { !_lhsOerrors -> + (case (Nonterminal nt_ params_ inh_ syn_ _prodsIoutput) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + (case (_prodsIuniq) of + { !_lhsOuniq -> + ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +-- Nonterminals ------------------------------------------------ +{- + visit 0: + synthesized attribute: + collect_nts : Set NontermIdent + visit 1: + inherited attributes: + cr : Bool + manualAttrOrderMap : AttrOrderMap + 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 (Bool -> + AttrOrderMap -> + (Set NontermIdent) -> + Bool -> + TypeSyns -> + Int -> + UseMap -> + ( (Seq Error),Nonterminals,Int)) +data Inh_Nonterminals = Inh_Nonterminals {cr_Inh_Nonterminals :: !(Bool),manualAttrOrderMap_Inh_Nonterminals :: !(AttrOrderMap),nonterminals_Inh_Nonterminals :: !(Set NontermIdent),o_rename_Inh_Nonterminals :: !(Bool),typeSyns_Inh_Nonterminals :: !(TypeSyns),uniq_Inh_Nonterminals :: !(Int),useMap_Inh_Nonterminals :: !(UseMap)} +data Syn_Nonterminals = Syn_Nonterminals {collect_nts_Syn_Nonterminals :: !(Set NontermIdent),errors_Syn_Nonterminals :: !(Seq Error),output_Syn_Nonterminals :: !(Nonterminals),uniq_Syn_Nonterminals :: !(Int)} +wrap_Nonterminals !(T_Nonterminals sem) !(Inh_Nonterminals _lhsIcr _lhsImanualAttrOrderMap _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap) = + (let ( !_lhsOcollect_nts,!T_Nonterminals_1 sem_1) = + (sem ) + ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = + (sem_1 _lhsIcr _lhsImanualAttrOrderMap _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap) + in (Syn_Nonterminals _lhsOcollect_nts _lhsOerrors _lhsOoutput _lhsOuniq)) +sem_Nonterminals_Cons :: T_Nonterminal -> + T_Nonterminals -> + T_Nonterminals +sem_Nonterminals_Cons !(T_Nonterminal hd_) !(T_Nonterminals tl_) = + (T_Nonterminals (case ((tl_ )) of + { ( !_tlIcollect_nts,!T_Nonterminals_1 tl_1) -> + (case ((hd_ )) of + { ( !_hdIcollect_nts,!T_Nonterminal_1 hd_1) -> + (case (_hdIcollect_nts `Set.union` _tlIcollect_nts) of + { !_lhsOcollect_nts -> + (case ((sem_Nonterminals_Cons_1 (T_Nonterminal_1 hd_1) (T_Nonterminals_1 tl_1))) of + { ( !sem_Nonterminals_1) -> + ( _lhsOcollect_nts,sem_Nonterminals_1) }) }) }) })) +sem_Nonterminals_Cons_1 :: T_Nonterminal_1 -> + T_Nonterminals_1 -> + T_Nonterminals_1 +sem_Nonterminals_Cons_1 !(T_Nonterminal_1 hd_1) !(T_Nonterminals_1 tl_1) = + (T_Nonterminals_1 (\ (!_lhsIcr) + (!_lhsImanualAttrOrderMap) + (!_lhsInonterminals) + (!_lhsIo_rename) + (!_lhsItypeSyns) + (!_lhsIuniq) + (!_lhsIuseMap) -> + (case (_lhsIuseMap) of + { !_tlOuseMap -> + (case (_lhsItypeSyns) of + { !_tlOtypeSyns -> + (case (_lhsIo_rename) of + { !_tlOo_rename -> + (case (_lhsImanualAttrOrderMap) of + { !_tlOmanualAttrOrderMap -> + (case (_lhsIcr) of + { !_tlOcr -> + (case (_lhsIuseMap) of + { !_hdOuseMap -> + (case (_lhsItypeSyns) of + { !_hdOtypeSyns -> + (case (_lhsIo_rename) of + { !_hdOo_rename -> + (case (_lhsImanualAttrOrderMap) of + { !_hdOmanualAttrOrderMap -> + (case (_lhsIcr) of + { !_hdOcr -> + (case (_lhsIuniq) of + { !_hdOuniq -> + (case (_lhsInonterminals) of + { !_hdOnonterminals -> + (case ((hd_1 _hdOcr _hdOmanualAttrOrderMap _hdOnonterminals _hdOo_rename _hdOtypeSyns _hdOuniq _hdOuseMap)) of + { ( !_hdIerrors,!_hdIoutput,!_hdIuniq) -> + (case (_hdIuniq) of + { !_tlOuniq -> + (case (_lhsInonterminals) of + { !_tlOnonterminals -> + (case ((tl_1 _tlOcr _tlOmanualAttrOrderMap _tlOnonterminals _tlOo_rename _tlOtypeSyns _tlOuniq _tlOuseMap)) of + { ( !_tlIerrors,!_tlIoutput,!_tlIuniq) -> + (case (_hdIerrors Seq.<> _tlIerrors) of + { !_lhsOerrors -> + (case ((:) _hdIoutput _tlIoutput) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + (case (_tlIuniq) of + { !_lhsOuniq -> + ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_Nonterminals_Nil :: T_Nonterminals +sem_Nonterminals_Nil = + (T_Nonterminals (case (Set.empty) of + { !_lhsOcollect_nts -> + (case ((sem_Nonterminals_Nil_1 )) of + { ( !sem_Nonterminals_1) -> + ( _lhsOcollect_nts,sem_Nonterminals_1) }) })) +sem_Nonterminals_Nil_1 :: T_Nonterminals_1 +sem_Nonterminals_Nil_1 = + (T_Nonterminals_1 (\ (!_lhsIcr) + (!_lhsImanualAttrOrderMap) + (!_lhsInonterminals) + (!_lhsIo_rename) + (!_lhsItypeSyns) + (!_lhsIuniq) + (!_lhsIuseMap) -> + (case (Seq.empty) of + { !_lhsOerrors -> + (case ([]) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + (case (_lhsIuniq) of + { !_lhsOuniq -> + ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }))) +-- Pattern ----------------------------------------------------- +{- + visit 0: + inherited attributes: + con : ConstructorIdent + nt : NontermIdent + synthesized attributes: + containsVars : Bool + copy : SELF + definedAttrs : Set (Identifier,Identifier) + errors : Seq Error + locals : Set Identifier + output : SELF + alternatives: + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + child parts : Patterns + visit 0: + local copy : _ + local output : _ + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + local output : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + local output : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + local output : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ + local output : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern !(Alias _field _attr _pat _parts) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat) (sem_Patterns _parts)) +sem_Pattern !(Constr _name _pats) = + (sem_Pattern_Constr _name (sem_Patterns _pats)) +sem_Pattern !(Irrefutable _pat) = + (sem_Pattern_Irrefutable (sem_Pattern _pat)) +sem_Pattern !(Product _pos _pats) = + (sem_Pattern_Product _pos (sem_Patterns _pats)) +sem_Pattern !(Underscore _pos) = + (sem_Pattern_Underscore _pos) +-- semantic domain +newtype T_Pattern = T_Pattern (ConstructorIdent -> + NontermIdent -> + ( Bool,Pattern,(Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Pattern)) +data Inh_Pattern = Inh_Pattern {con_Inh_Pattern :: !(ConstructorIdent),nt_Inh_Pattern :: !(NontermIdent)} +data Syn_Pattern = Syn_Pattern {containsVars_Syn_Pattern :: !(Bool),copy_Syn_Pattern :: !(Pattern),definedAttrs_Syn_Pattern :: !(Set (Identifier,Identifier)),errors_Syn_Pattern :: !(Seq Error),locals_Syn_Pattern :: !(Set Identifier),output_Syn_Pattern :: !(Pattern)} +wrap_Pattern !(T_Pattern sem) !(Inh_Pattern _lhsIcon _lhsInt) = + (let ( !_lhsOcontainsVars,!_lhsOcopy,!_lhsOdefinedAttrs,!_lhsOerrors,!_lhsOlocals,!_lhsOoutput) = + (sem _lhsIcon _lhsInt) + in (Syn_Pattern _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput)) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Patterns -> + T_Pattern +sem_Pattern_Alias !field_ !attr_ !(T_Pattern pat_) !(T_Patterns parts_) = + (T_Pattern (\ (!_lhsIcon) + (!_lhsInt) -> + (case (True) of + { !_lhsOcontainsVars -> + (case (_lhsInt) of + { !_partsOnt -> + (case (_lhsIcon) of + { !_partsOcon -> + (case ((parts_ _partsOcon _partsOnt)) of + { ( !_partsIcontainsVars,!_partsIcopy,!_partsIdefinedAttrs,!_partsIerrors,!_partsIlocals,!_partsIoutput) -> + (case (_lhsInt) of + { !_patOnt -> + (case (_lhsIcon) of + { !_patOcon -> + (case ((pat_ _patOcon _patOnt)) of + { ( !_patIcontainsVars,!_patIcopy,!_patIdefinedAttrs,!_patIerrors,!_patIlocals,!_patIoutput) -> + (case (Alias field_ attr_ _patIcopy _partsIcopy) of + { !_copy -> + (case (_copy) of + { !_lhsOcopy -> + (case (Set.insert (field_,attr_) _patIdefinedAttrs) of + { !_lhsOdefinedAttrs -> + (case (_patIerrors Seq.<> _partsIerrors) of + { !_lhsOerrors -> + (case (if field_ == _LOC + then Set.insert attr_ _patIlocals + else _patIlocals) of + { !_lhsOlocals -> + (case (Alias field_ attr_ _patIoutput _partsIoutput) of + { !_output -> + (case (_output) 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 (_lhsInt) of + { !_patsOnt -> + (case (_lhsIcon) of + { !_patsOcon -> + (case ((pats_ _patsOcon _patsOnt)) of + { ( !_patsIcontainsVars,!_patsIcopy,!_patsIdefinedAttrs,!_patsIerrors,!_patsIlocals,!_patsIoutput) -> + (case (_patsIcontainsVars) of + { !_lhsOcontainsVars -> + (case (Constr name_ _patsIcopy) of + { !_copy -> + (case (_copy) of + { !_lhsOcopy -> + (case (_patsIdefinedAttrs) of + { !_lhsOdefinedAttrs -> + (case (_patsIerrors) of + { !_lhsOerrors -> + (case (_patsIlocals) of + { !_lhsOlocals -> + (case (Constr name_ _patsIoutput) of + { !_output -> + (case (_output) 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 (_lhsInt) of + { !_patOnt -> + (case (_lhsIcon) of + { !_patOcon -> + (case ((pat_ _patOcon _patOnt)) of + { ( !_patIcontainsVars,!_patIcopy,!_patIdefinedAttrs,!_patIerrors,!_patIlocals,!_patIoutput) -> + (case (_patIcontainsVars) of + { !_lhsOcontainsVars -> + (case (Irrefutable _patIcopy) of + { !_copy -> + (case (_copy) of + { !_lhsOcopy -> + (case (_patIdefinedAttrs) of + { !_lhsOdefinedAttrs -> + (case (_patIerrors) of + { !_lhsOerrors -> + (case (_patIlocals) of + { !_lhsOlocals -> + (case (Irrefutable _patIoutput) of + { !_output -> + (case (_output) 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 (_lhsInt) of + { !_patsOnt -> + (case (_lhsIcon) of + { !_patsOcon -> + (case ((pats_ _patsOcon _patsOnt)) of + { ( !_patsIcontainsVars,!_patsIcopy,!_patsIdefinedAttrs,!_patsIerrors,!_patsIlocals,!_patsIoutput) -> + (case (_patsIcontainsVars) of + { !_lhsOcontainsVars -> + (case (Product pos_ _patsIcopy) of + { !_copy -> + (case (_copy) of + { !_lhsOcopy -> + (case (_patsIdefinedAttrs) of + { !_lhsOdefinedAttrs -> + (case (_patsIerrors) of + { !_lhsOerrors -> + (case (_patsIlocals) of + { !_lhsOlocals -> + (case (Product pos_ _patsIoutput) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }))) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore !pos_ = + (T_Pattern (\ (!_lhsIcon) + (!_lhsInt) -> + (case (False) of + { !_lhsOcontainsVars -> + (case (Underscore pos_) of + { !_copy -> + (case (_copy) of + { !_lhsOcopy -> + (case (Set.empty) of + { !_lhsOdefinedAttrs -> + (case (Seq.empty) of + { !_lhsOerrors -> + (case (Set.empty) of + { !_lhsOlocals -> + (case (Underscore pos_) of + { !_output -> + (case (_output) 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 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 (_lhsInt) of + { !_tlOnt -> + (case (_lhsIcon) of + { !_tlOcon -> + (case ((tl_ _tlOcon _tlOnt)) of + { ( !_tlIcontainsVars,!_tlIcopy,!_tlIdefinedAttrs,!_tlIerrors,!_tlIlocals,!_tlIoutput) -> + (case (_lhsInt) of + { !_hdOnt -> + (case (_lhsIcon) of + { !_hdOcon -> + (case ((hd_ _hdOcon _hdOnt)) of + { ( !_hdIcontainsVars,!_hdIcopy,!_hdIdefinedAttrs,!_hdIerrors,!_hdIlocals,!_hdIoutput) -> + (case (_hdIcontainsVars || _tlIcontainsVars) of + { !_lhsOcontainsVars -> + (case ((:) _hdIcopy _tlIcopy) of + { !_copy -> + (case (_copy) of + { !_lhsOcopy -> + (case (_hdIdefinedAttrs `Set.union` _tlIdefinedAttrs) of + { !_lhsOdefinedAttrs -> + (case (_hdIerrors Seq.<> _tlIerrors) of + { !_lhsOerrors -> + (case (_hdIlocals `Set.union` _tlIlocals) of + { !_lhsOlocals -> + (case ((:) _hdIoutput _tlIoutput) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (\ (!_lhsIcon) + (!_lhsInt) -> + (case (False) of + { !_lhsOcontainsVars -> + (case ([]) of + { !_copy -> + (case (_copy) of + { !_lhsOcopy -> + (case (Set.empty) of + { !_lhsOdefinedAttrs -> + (case (Seq.empty) of + { !_lhsOerrors -> + (case (Set.empty) of + { !_lhsOlocals -> + (case ([]) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }))) +-- Production -------------------------------------------------- +{- + visit 0: + inherited attributes: + cr : Bool + inh : Attributes + manualAttrOrderMap : AttrOrderMap + nonterminals : Set NontermIdent + nt : NontermIdent + o_rename : Bool + syn : Attributes + typeSyns : TypeSyns + useMap : Map Identifier (String,String,String) + chained attribute: + uniq : Int + synthesized attributes: + errors : Seq Error + output : SELF + alternatives: + alternative Production: + child con : {ConstructorIdent} + child children : Children + child rules : Rules + child typeSigs : TypeSigs + visit 0: + local orderDeps : _ + local orderErrs : _ + local _tup1 : _ + local errs : _ + local newRls : _ +-} +-- cata +sem_Production :: Production -> + T_Production +sem_Production !(Production _con _children _rules _typeSigs) = + (sem_Production_Production _con (sem_Children _children) (sem_Rules _rules) (sem_TypeSigs _typeSigs)) +-- semantic domain +newtype T_Production = T_Production (Bool -> + Attributes -> + AttrOrderMap -> + (Set NontermIdent) -> + NontermIdent -> + Bool -> + Attributes -> + TypeSyns -> + Int -> + (Map Identifier (String,String,String)) -> + ( (Seq Error),Production,Int)) +data Inh_Production = Inh_Production {cr_Inh_Production :: !(Bool),inh_Inh_Production :: !(Attributes),manualAttrOrderMap_Inh_Production :: !(AttrOrderMap),nonterminals_Inh_Production :: !(Set NontermIdent),nt_Inh_Production :: !(NontermIdent),o_rename_Inh_Production :: !(Bool),syn_Inh_Production :: !(Attributes),typeSyns_Inh_Production :: !(TypeSyns),uniq_Inh_Production :: !(Int),useMap_Inh_Production :: !(Map Identifier (String,String,String))} +data Syn_Production = Syn_Production {errors_Syn_Production :: !(Seq Error),output_Syn_Production :: !(Production),uniq_Syn_Production :: !(Int)} +wrap_Production !(T_Production sem) !(Inh_Production _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap) = + (let ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = + (sem _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap) + in (Syn_Production _lhsOerrors _lhsOoutput _lhsOuniq)) +sem_Production_Production :: ConstructorIdent -> + T_Children -> + T_Rules -> + T_TypeSigs -> + T_Production +sem_Production_Production !con_ !(T_Children children_) !(T_Rules rules_) !(T_TypeSigs typeSigs_) = + (T_Production (\ (!_lhsIcr) + (!_lhsIinh) + (!_lhsImanualAttrOrderMap) + (!_lhsInonterminals) + (!_lhsInt) + (!_lhsIo_rename) + (!_lhsIsyn) + (!_lhsItypeSyns) + (!_lhsIuniq) + (!_lhsIuseMap) -> + (case (Set.toList $ Map.findWithDefault Set.empty con_ $ Map.findWithDefault Map.empty _lhsInt _lhsImanualAttrOrderMap) of + { !_orderDeps -> + (case (_lhsIuniq) of + { !_rulesOuniq -> + (case (_lhsInt) of + { !_rulesOnt -> + (case (con_) of + { !_rulesOcon -> + (case ((rules_ _rulesOcon _rulesOnt _rulesOuniq)) of + { ( !_rulesIdefinedAttrs,!_rulesIerrors,!_rulesIlocals,!_rulesIoutput,!_rulesIuniq) -> + (case (_lhsInt) of + { !_childrenOnt -> + (case (_lhsIcr) of + { !_childrenOcr -> + (case (con_) of + { !_childrenOcon -> + (case ((children_ _childrenOcon _childrenOcr _childrenOnt)) of + { ( !_childrenIerrors,!_childrenIfields,!_childrenIinputs,!_childrenIoutput,!_childrenIoutputs) -> + (case (let chldOutMap = Map.fromList [ (k, Map.keysSet s) | (k,s) <- _childrenIoutputs ] + chldInMap = Map.fromList [ (k, Map.keysSet s) | (k,s) <- _childrenIinputs ] + isInAttribute :: Identifier -> Identifier -> [Error] + isInAttribute fld nm + | fld == _LOC = if nm `Set.member` _rulesIlocals + then [] + else [UndefAttr _lhsInt con_ fld nm False] + | fld == _LHS = if nm `Map.member` _lhsIinh + then [] + else [UndefAttr _lhsInt con_ fld nm False] + | otherwise = if nm `Set.member` (Map.findWithDefault Set.empty fld chldOutMap) + then [] + else [UndefAttr _lhsInt con_ fld nm False] + isOutAttribute :: Identifier -> Identifier -> [Error] + isOutAttribute fld nm + | fld == _LOC = if nm `Set.member` _rulesIlocals + then [] + else [UndefAttr _lhsInt con_ fld nm True] + | fld == _LHS = if nm `Map.member` _lhsIsyn + then [] + else [UndefAttr _lhsInt con_ fld nm True] + | otherwise = if nm `Set.member` (Map.findWithDefault Set.empty fld chldInMap) + then [] + else [UndefAttr _lhsInt con_ fld nm True] + in Seq.fromList . concat $ + [ isInAttribute fldA nmA ++ isOutAttribute fldB nmB + | dep@(Dependency (fldA,nmA) (fldB,nmB)) <- _orderDeps + ]) of + { !_orderErrs -> + (case (let locals = _rulesIlocals + initenv = Map.fromList ( [ (a,_ACHILD) + | (a,_,_) <- _childrenIfields + ] + ++ attrs(_LHS, _lhsIinh) + ++ [ (a,_LOC) + | a <- Set.toList locals + ] + ) + attrs (n,as) = [ (a,n) | a <- Map.keys as ] + envs = scanl (flip Map.union) + initenv + (map (Map.fromList . attrs ) _childrenIoutputs) + child_envs = init envs + lhs_env = last envs + (selfAttrs, normalAttrs) + = Map.partition isSELFNonterminal _lhsIsyn + (_,undefAttrs) + = removeDefined _rulesIdefinedAttrs (_LHS, normalAttrs) + (useAttrs,others) + = splitAttrs _lhsIuseMap undefAttrs + (rules1, errors1) + = concatRE $ map (copyRule _lhsInt con_ _lhsIcr locals) + (zip envs (map (removeDefined _rulesIdefinedAttrs) _childrenIinputs)) + uRules + = map (useRule locals _childrenIoutputs) useAttrs + selfLocRules + = [ selfRule False attr (constructor [childSelf attr nm tp | (nm,tp,ho) <- _childrenIfields, not ho]) + | attr <- Map.keys selfAttrs + , not (Set.member attr locals) + ] + where + childSelf self nm tp + = case tp of NT nt _ -> attrName nm self + _ | nm `Set.member` locals -> locname nm + | otherwise -> fieldName nm + constructor fs + | getName con_ == "Tuple" && _lhsInt `elem` map fst _lhsItypeSyns + = "(" ++ concat (List.intersperse "," fs) ++ ")" + | otherwise + = getConName _lhsItypeSyns _lhsIo_rename _lhsInt con_ ++ " " ++ unwords fs + selfRules + = [ selfRule True attr undefined + | attr <- Map.keys selfAttrs + , not (Set.member (_LHS,attr) _rulesIdefinedAttrs) + ] + (rules5, errs5) + = copyRule _lhsInt + con_ + _lhsIcr + locals + (lhs_env, (_LHS, others)) + in (uRules++selfLocRules++selfRules++rules5++rules1, errors1<>errs5)) of + { !__tup1 -> + (case (__tup1) of + { !(_,!_errs) -> + (case (_childrenIerrors <> _errs <> _rulesIerrors <> _orderErrs) of + { !_lhsOerrors -> + (case (__tup1) of + { !(!_newRls,_) -> + (case ((typeSigs_ )) of + { ( !_typeSigsIoutput) -> + (case (Production con_ _childrenIoutput (_rulesIoutput ++ _newRls) _typeSigsIoutput) of + { !_lhsOoutput -> + (case (_rulesIuniq) of + { !_lhsOuniq -> + ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +-- Productions ------------------------------------------------- +{- + visit 0: + inherited attributes: + cr : Bool + inh : Attributes + manualAttrOrderMap : AttrOrderMap + nonterminals : Set NontermIdent + nt : NontermIdent + o_rename : Bool + syn : Attributes + typeSyns : TypeSyns + useMap : Map Identifier (String,String,String) + chained attribute: + uniq : Int + synthesized attributes: + errors : Seq Error + output : SELF + alternatives: + alternative Cons: + child hd : Production + child tl : Productions + visit 0: + local output : _ + alternative Nil: + visit 0: + local output : _ +-} +-- cata +sem_Productions :: Productions -> + T_Productions +sem_Productions !list = + (Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list)) +-- semantic domain +newtype T_Productions = T_Productions (Bool -> + Attributes -> + AttrOrderMap -> + (Set NontermIdent) -> + NontermIdent -> + Bool -> + Attributes -> + TypeSyns -> + Int -> + (Map Identifier (String,String,String)) -> + ( (Seq Error),Productions,Int)) +data Inh_Productions = Inh_Productions {cr_Inh_Productions :: !(Bool),inh_Inh_Productions :: !(Attributes),manualAttrOrderMap_Inh_Productions :: !(AttrOrderMap),nonterminals_Inh_Productions :: !(Set NontermIdent),nt_Inh_Productions :: !(NontermIdent),o_rename_Inh_Productions :: !(Bool),syn_Inh_Productions :: !(Attributes),typeSyns_Inh_Productions :: !(TypeSyns),uniq_Inh_Productions :: !(Int),useMap_Inh_Productions :: !(Map Identifier (String,String,String))} +data Syn_Productions = Syn_Productions {errors_Syn_Productions :: !(Seq Error),output_Syn_Productions :: !(Productions),uniq_Syn_Productions :: !(Int)} +wrap_Productions !(T_Productions sem) !(Inh_Productions _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap) = + (let ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = + (sem _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap) + in (Syn_Productions _lhsOerrors _lhsOoutput _lhsOuniq)) +sem_Productions_Cons :: T_Production -> + T_Productions -> + T_Productions +sem_Productions_Cons !(T_Production hd_) !(T_Productions tl_) = + (T_Productions (\ (!_lhsIcr) + (!_lhsIinh) + (!_lhsImanualAttrOrderMap) + (!_lhsInonterminals) + (!_lhsInt) + (!_lhsIo_rename) + (!_lhsIsyn) + (!_lhsItypeSyns) + (!_lhsIuniq) + (!_lhsIuseMap) -> + (case (_lhsIuseMap) of + { !_tlOuseMap -> + (case (_lhsItypeSyns) of + { !_tlOtypeSyns -> + (case (_lhsIsyn) of + { !_tlOsyn -> + (case (_lhsIo_rename) of + { !_tlOo_rename -> + (case (_lhsInt) of + { !_tlOnt -> + (case (_lhsImanualAttrOrderMap) of + { !_tlOmanualAttrOrderMap -> + (case (_lhsIinh) of + { !_tlOinh -> + (case (_lhsIcr) of + { !_tlOcr -> + (case (_lhsIuseMap) of + { !_hdOuseMap -> + (case (_lhsItypeSyns) of + { !_hdOtypeSyns -> + (case (_lhsIsyn) of + { !_hdOsyn -> + (case (_lhsIo_rename) of + { !_hdOo_rename -> + (case (_lhsInt) of + { !_hdOnt -> + (case (_lhsImanualAttrOrderMap) of + { !_hdOmanualAttrOrderMap -> + (case (_lhsIinh) of + { !_hdOinh -> + (case (_lhsIcr) of + { !_hdOcr -> + (case (_lhsIuniq) of + { !_hdOuniq -> + (case (_lhsInonterminals) of + { !_hdOnonterminals -> + (case ((hd_ _hdOcr _hdOinh _hdOmanualAttrOrderMap _hdOnonterminals _hdOnt _hdOo_rename _hdOsyn _hdOtypeSyns _hdOuniq _hdOuseMap)) of + { ( !_hdIerrors,!_hdIoutput,!_hdIuniq) -> + (case (_hdIuniq) of + { !_tlOuniq -> + (case (_lhsInonterminals) of + { !_tlOnonterminals -> + (case ((tl_ _tlOcr _tlOinh _tlOmanualAttrOrderMap _tlOnonterminals _tlOnt _tlOo_rename _tlOsyn _tlOtypeSyns _tlOuniq _tlOuseMap)) of + { ( !_tlIerrors,!_tlIoutput,!_tlIuniq) -> + (case (_hdIerrors Seq.<> _tlIerrors) of + { !_lhsOerrors -> + (case ((:) _hdIoutput _tlIoutput) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + (case (_tlIuniq) of + { !_lhsOuniq -> + ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_Productions_Nil :: T_Productions +sem_Productions_Nil = + (T_Productions (\ (!_lhsIcr) + (!_lhsIinh) + (!_lhsImanualAttrOrderMap) + (!_lhsInonterminals) + (!_lhsInt) + (!_lhsIo_rename) + (!_lhsIsyn) + (!_lhsItypeSyns) + (!_lhsIuniq) + (!_lhsIuseMap) -> + (case (Seq.empty) of + { !_lhsOerrors -> + (case ([]) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + (case (_lhsIuniq) 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 + alternatives: + alternative Rule: + child pattern : Pattern + child rhs : {Expression} + child owrt : {Bool} + child origin : {String} + visit 0: + local output : _ + local _tup2 : {(Rules,Int)} +-} +-- cata +sem_Rule :: Rule -> + T_Rule +sem_Rule !(Rule _pattern _rhs _owrt _origin) = + (sem_Rule_Rule (sem_Pattern _pattern) _rhs _owrt _origin) +-- semantic domain +newtype T_Rule = T_Rule (ConstructorIdent -> + NontermIdent -> + Int -> + ( Bool,(Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Rule,Rules,Int)) +data Inh_Rule = Inh_Rule {con_Inh_Rule :: !(ConstructorIdent),nt_Inh_Rule :: !(NontermIdent),uniq_Inh_Rule :: !(Int)} +data Syn_Rule = Syn_Rule {containsVars_Syn_Rule :: !(Bool),definedAttrs_Syn_Rule :: !(Set (Identifier,Identifier)),errors_Syn_Rule :: !(Seq Error),locals_Syn_Rule :: !(Set Identifier),output_Syn_Rule :: !(Rule),outputs_Syn_Rule :: !(Rules),uniq_Syn_Rule :: !(Int)} +wrap_Rule !(T_Rule sem) !(Inh_Rule _lhsIcon _lhsInt _lhsIuniq) = + (let ( !_lhsOcontainsVars,!_lhsOdefinedAttrs,!_lhsOerrors,!_lhsOlocals,!_lhsOoutput,!_lhsOoutputs,!_lhsOuniq) = + (sem _lhsIcon _lhsInt _lhsIuniq) + in (Syn_Rule _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOoutputs _lhsOuniq)) +sem_Rule_Rule :: T_Pattern -> + Expression -> + Bool -> + String -> + T_Rule +sem_Rule_Rule !(T_Pattern pattern_) !rhs_ !owrt_ !origin_ = + (T_Rule (\ (!_lhsIcon) + (!_lhsInt) + (!_lhsIuniq) -> + (case (_lhsInt) of + { !_patternOnt -> + (case (_lhsIcon) of + { !_patternOcon -> + (case ((pattern_ _patternOcon _patternOnt)) of + { ( !_patternIcontainsVars,!_patternIcopy,!_patternIdefinedAttrs,!_patternIerrors,!_patternIlocals,!_patternIoutput) -> + (case (_patternIcontainsVars) of + { !_lhsOcontainsVars -> + (case (_patternIdefinedAttrs) of + { !_lhsOdefinedAttrs -> + (case (_patternIerrors) of + { !_lhsOerrors -> + (case (_patternIlocals) of + { !_lhsOlocals -> + (case (Rule _patternIoutput rhs_ owrt_ origin_) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + (case (multiRule _output _lhsIuniq) of + { !__tup2 -> + (case (__tup2) of + { !(!_lhsOoutputs,_) -> + (case (__tup2) of + { !(_,!_lhsOuniq) -> + ( _lhsOcontainsVars,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOoutputs,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }))) +-- Rules ------------------------------------------------------- +{- + visit 0: + inherited attributes: + con : ConstructorIdent + nt : NontermIdent + chained attribute: + uniq : Int + synthesized attributes: + definedAttrs : Set (Identifier,Identifier) + errors : Seq Error + locals : Set Identifier + output : SELF + alternatives: + alternative Cons: + child hd : Rule + child tl : Rules + alternative Nil: + visit 0: + local output : _ +-} +-- cata +sem_Rules :: Rules -> + T_Rules +sem_Rules !list = + (Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list)) +-- semantic domain +newtype T_Rules = T_Rules (ConstructorIdent -> + NontermIdent -> + Int -> + ( (Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Rules,Int)) +data Inh_Rules = Inh_Rules {con_Inh_Rules :: !(ConstructorIdent),nt_Inh_Rules :: !(NontermIdent),uniq_Inh_Rules :: !(Int)} +data Syn_Rules = Syn_Rules {definedAttrs_Syn_Rules :: !(Set (Identifier,Identifier)),errors_Syn_Rules :: !(Seq Error),locals_Syn_Rules :: !(Set Identifier),output_Syn_Rules :: !(Rules),uniq_Syn_Rules :: !(Int)} +wrap_Rules !(T_Rules sem) !(Inh_Rules _lhsIcon _lhsInt _lhsIuniq) = + (let ( !_lhsOdefinedAttrs,!_lhsOerrors,!_lhsOlocals,!_lhsOoutput,!_lhsOuniq) = + (sem _lhsIcon _lhsInt _lhsIuniq) + in (Syn_Rules _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOuniq)) +sem_Rules_Cons :: T_Rule -> + T_Rules -> + T_Rules +sem_Rules_Cons !(T_Rule hd_) !(T_Rules tl_) = + (T_Rules (\ (!_lhsIcon) + (!_lhsInt) + (!_lhsIuniq) -> + (case (_lhsIuniq) of + { !_hdOuniq -> + (case (_lhsInt) of + { !_hdOnt -> + (case (_lhsIcon) of + { !_hdOcon -> + (case ((hd_ _hdOcon _hdOnt _hdOuniq)) of + { ( !_hdIcontainsVars,!_hdIdefinedAttrs,!_hdIerrors,!_hdIlocals,!_hdIoutput,!_hdIoutputs,!_hdIuniq) -> + (case (_hdIuniq) of + { !_tlOuniq -> + (case (_lhsInt) of + { !_tlOnt -> + (case (_lhsIcon) of + { !_tlOcon -> + (case ((tl_ _tlOcon _tlOnt _tlOuniq)) of + { ( !_tlIdefinedAttrs,!_tlIerrors,!_tlIlocals,!_tlIoutput,!_tlIuniq) -> + (case (_hdIdefinedAttrs `Set.union` _tlIdefinedAttrs) of + { !_lhsOdefinedAttrs -> + (case (_hdIerrors Seq.<> _tlIerrors) of + { !_lhsOerrors -> + (case (_hdIlocals `Set.union` _tlIlocals) of + { !_lhsOlocals -> + (case (if _hdIcontainsVars then _hdIoutputs ++ _tlIoutput else _tlIoutput) of + { !_lhsOoutput -> + (case (_tlIuniq) of + { !_lhsOuniq -> + ( _lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_Rules_Nil :: T_Rules +sem_Rules_Nil = + (T_Rules (\ (!_lhsIcon) + (!_lhsInt) + (!_lhsIuniq) -> + (case (Set.empty) of + { !_lhsOdefinedAttrs -> + (case (Seq.empty) of + { !_lhsOerrors -> + (case (Set.empty) of + { !_lhsOlocals -> + (case ([]) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + (case (_lhsIuniq) of + { !_lhsOuniq -> + ( _lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }))) +-- TypeSig ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + output : SELF + alternatives: + alternative TypeSig: + child name : {Identifier} + child tp : {Type} + visit 0: + local output : _ +-} +-- cata +sem_TypeSig :: TypeSig -> + T_TypeSig +sem_TypeSig !(TypeSig _name _tp) = + (sem_TypeSig_TypeSig _name _tp) +-- semantic domain +newtype T_TypeSig = T_TypeSig (( TypeSig)) +data Inh_TypeSig = Inh_TypeSig {} +data Syn_TypeSig = Syn_TypeSig {output_Syn_TypeSig :: !(TypeSig)} +wrap_TypeSig !(T_TypeSig sem) !(Inh_TypeSig ) = + (let ( !_lhsOoutput) = + (sem ) + in (Syn_TypeSig _lhsOoutput)) +sem_TypeSig_TypeSig :: Identifier -> + Type -> + T_TypeSig +sem_TypeSig_TypeSig !name_ !tp_ = + (T_TypeSig (case (TypeSig name_ tp_) of + { !_output -> + (case (_output) 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 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 ((:) _hdIoutput _tlIoutput) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + ( _lhsOoutput) }) }) }) })) +sem_TypeSigs_Nil :: T_TypeSigs +sem_TypeSigs_Nil = + (T_TypeSigs (case ([]) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + ( _lhsOoutput) }) })) diff --git a/src-derived/Desugar.hs b/src-derived/Desugar.hs --- a/src-derived/Desugar.hs +++ b/src-derived/Desugar.hs @@ -1,2279 +1,1811 @@ --- UUAGC 0.9.5 (Desugar.ag) -module Desugar where - -import qualified Data.Set as Set -import qualified Data.Map as Map -import Data.Map(Map) -import qualified UU.DData.Seq as Seq -import UU.DData.Seq(Seq,(<>)) -import UU.Scanner.Position(Pos(..)) -import Maybe -import Data.List(intersperse) - -import AbstractSyntax -import ErrorMessages -import Options -import HsToken -import HsTokenScanner -import TokenDef - --- AbstractSyntax.ag imports -import Data.Set(Set) -import Data.Map(Map) -import Patterns (Pattern(..),Patterns) -import Expression (Expression(..)) -import CommonTypes - --- Patterns.ag imports -import UU.Scanner.Position(Pos) -import CommonTypes (ConstructorIdent,Identifier) - -import UU.Scanner.Position(Pos) -import HsToken - -import CommonTypes -import UU.Scanner.Position(Pos) - -addl :: Int -> Pos -> Pos -addl n (Pos l c f) = Pos (l+n) c f - -maybeError :: a -> Error -> Maybe a -> (a, Seq Error) -maybeError def err mb - = maybe (def, Seq.single err) (\r -> (r, Seq.empty)) mb - -findField :: Identifier -> Identifier -> [(Identifier,Identifier)] -> Maybe Identifier -findField fld attr list - | fld == _FIRST = f list - | fld == _LAST = f (reverse list) - | otherwise = Just fld - where - f = lookup attr - -mergeAttributes :: AttrMap -> AttrMap -> AttrMap -mergeAttributes = Map.unionWith $ Map.unionWith $ Set.union --- Child ------------------------------------------------------- -{- - visit 0: - synthesized attributes: - childInhs : [(Identifier, Identifier)] - childSyns : [(Identifier, Identifier)] - output : SELF - alternatives: - alternative Child: - child name : {Identifier} - child tp : {Type} - child inh : {Attributes} - child syn : {Attributes} - child higherOrder : {Bool} - visit 0: - local output : _ --} --- cata -sem_Child :: Child -> - T_Child -sem_Child (Child _name _tp _inh _syn _higherOrder) = - (sem_Child_Child _name _tp _inh _syn _higherOrder) --- semantic domain -newtype T_Child = T_Child (( ([(Identifier, Identifier)]),([(Identifier, Identifier)]),Child)) -data Inh_Child = Inh_Child {} -data Syn_Child = Syn_Child {childInhs_Syn_Child :: [(Identifier, Identifier)],childSyns_Syn_Child :: [(Identifier, Identifier)],output_Syn_Child :: Child} -wrap_Child (T_Child sem) (Inh_Child ) = - (let ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput) = - (sem ) - in (Syn_Child _lhsOchildInhs _lhsOchildSyns _lhsOoutput)) -sem_Child_Child :: Identifier -> - Type -> - Attributes -> - Attributes -> - Bool -> - T_Child -sem_Child_Child name_ tp_ inh_ syn_ higherOrder_ = - (T_Child (let _lhsOchildInhs :: ([(Identifier, Identifier)]) - _lhsOchildSyns :: ([(Identifier, Identifier)]) - _lhsOoutput :: Child - -- "Desugar.ag"(line 123, column 7) - _lhsOchildInhs = - [(i, name_) | i <- Map.keys inh_ ] - -- "Desugar.ag"(line 124, column 7) - _lhsOchildSyns = - [(s, name_) | s <- Map.keys syn_ ] - -- self rule - _output = - Child name_ tp_ inh_ syn_ higherOrder_ - -- self rule - _lhsOoutput = - _output - in ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput))) --- Children ---------------------------------------------------- -{- - visit 0: - synthesized attributes: - childInhs : [(Identifier, Identifier)] - childSyns : [(Identifier, Identifier)] - output : SELF - alternatives: - alternative Cons: - child hd : Child - child tl : Children - visit 0: - local output : _ - alternative Nil: - visit 0: - local output : _ --} --- cata -sem_Children :: Children -> - T_Children -sem_Children list = - (Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list)) --- semantic domain -newtype T_Children = T_Children (( ([(Identifier, Identifier)]),([(Identifier, Identifier)]),Children)) -data Inh_Children = Inh_Children {} -data Syn_Children = Syn_Children {childInhs_Syn_Children :: [(Identifier, Identifier)],childSyns_Syn_Children :: [(Identifier, Identifier)],output_Syn_Children :: Children} -wrap_Children (T_Children sem) (Inh_Children ) = - (let ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput) = - (sem ) - in (Syn_Children _lhsOchildInhs _lhsOchildSyns _lhsOoutput)) -sem_Children_Cons :: T_Child -> - T_Children -> - T_Children -sem_Children_Cons (T_Child hd_) (T_Children tl_) = - (T_Children (let _lhsOchildInhs :: ([(Identifier, Identifier)]) - _lhsOchildSyns :: ([(Identifier, Identifier)]) - _lhsOoutput :: Children - _hdIchildInhs :: ([(Identifier, Identifier)]) - _hdIchildSyns :: ([(Identifier, Identifier)]) - _hdIoutput :: Child - _tlIchildInhs :: ([(Identifier, Identifier)]) - _tlIchildSyns :: ([(Identifier, Identifier)]) - _tlIoutput :: Children - -- use rule "Desugar.ag"(line 118, column 48) - _lhsOchildInhs = - _hdIchildInhs ++ _tlIchildInhs - -- use rule "Desugar.ag"(line 118, column 48) - _lhsOchildSyns = - _hdIchildSyns ++ _tlIchildSyns - -- self rule - _output = - (:) _hdIoutput _tlIoutput - -- self rule - _lhsOoutput = - _output - ( _hdIchildInhs,_hdIchildSyns,_hdIoutput) = - (hd_ ) - ( _tlIchildInhs,_tlIchildSyns,_tlIoutput) = - (tl_ ) - in ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput))) -sem_Children_Nil :: T_Children -sem_Children_Nil = - (T_Children (let _lhsOchildInhs :: ([(Identifier, Identifier)]) - _lhsOchildSyns :: ([(Identifier, Identifier)]) - _lhsOoutput :: Children - -- use rule "Desugar.ag"(line 118, column 48) - _lhsOchildInhs = - [] - -- use rule "Desugar.ag"(line 118, column 48) - _lhsOchildSyns = - [] - -- self rule - _output = - [] - -- self rule - _lhsOoutput = - _output - in ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput))) --- Expression -------------------------------------------------- -{- - visit 0: - inherited attributes: - childInhs : [(Identifier, Identifier)] - childSyns : [(Identifier, Identifier)] - con : ConstructorIdent - nt : NontermIdent - options : Options - ruleDescr : String - synthesized attributes: - errors : Seq Error - output : SELF - alternatives: - alternative Expression: - child pos : {Pos} - child tks : {[HsToken]} - visit 0: - local _tup1 : _ - local tks' : _ - local output : _ --} --- cata -sem_Expression :: Expression -> - T_Expression -sem_Expression (Expression _pos _tks) = - (sem_Expression_Expression _pos _tks) --- semantic domain -newtype T_Expression = T_Expression (([(Identifier, Identifier)]) -> - ([(Identifier, Identifier)]) -> - ConstructorIdent -> - NontermIdent -> - Options -> - String -> - ( (Seq Error),Expression)) -data Inh_Expression = Inh_Expression {childInhs_Inh_Expression :: [(Identifier, Identifier)],childSyns_Inh_Expression :: [(Identifier, Identifier)],con_Inh_Expression :: ConstructorIdent,nt_Inh_Expression :: NontermIdent,options_Inh_Expression :: Options,ruleDescr_Inh_Expression :: String} -data Syn_Expression = Syn_Expression {errors_Syn_Expression :: Seq Error,output_Syn_Expression :: Expression} -wrap_Expression (T_Expression sem) (Inh_Expression _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIoptions _lhsIruleDescr) = - (let ( _lhsOerrors,_lhsOoutput) = - (sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIoptions _lhsIruleDescr) - in (Syn_Expression _lhsOerrors _lhsOoutput)) -sem_Expression_Expression :: Pos -> - ([HsToken]) -> - T_Expression -sem_Expression_Expression pos_ tks_ = - (T_Expression (\ _lhsIchildInhs - _lhsIchildSyns - _lhsIcon - _lhsInt - _lhsIoptions - _lhsIruleDescr -> - (let _lhsOerrors :: (Seq Error) - _lhsOoutput :: Expression - -- "Desugar.ag"(line 42, column 7) - __tup1 = - let inh = Inh_HsTokensRoot { childInhs_Inh_HsTokensRoot = _lhsIchildInhs - , childSyns_Inh_HsTokensRoot = _lhsIchildSyns - , nt_Inh_HsTokensRoot = _lhsInt - , con_Inh_HsTokensRoot = _lhsIcon - , ruleDescr_Inh_HsTokensRoot = _lhsIruleDescr - , useFieldIdent_Inh_HsTokensRoot = genUseTraces _lhsIoptions - } - sem = sem_HsTokensRoot (HsTokensRoot tks_) - syn = wrap_HsTokensRoot sem inh - in (tks_Syn_HsTokensRoot syn, errors_Syn_HsTokensRoot syn) - -- "Desugar.ag"(line 42, column 7) - (_tks',_) = - __tup1 - -- "Desugar.ag"(line 42, column 7) - (_,_lhsOerrors) = - __tup1 - -- "Desugar.ag"(line 52, column 7) - _lhsOoutput = - Expression pos_ _tks' - -- self rule - _output = - Expression pos_ tks_ - in ( _lhsOerrors,_lhsOoutput)))) --- Grammar ----------------------------------------------------- -{- - visit 0: - inherited attributes: - forcedIrrefutables : AttrMap - options : Options - synthesized attributes: - allAttributes : AttrMap - errors : Seq Error - output : SELF - alternatives: - alternative Grammar: - child typeSyns : {TypeSyns} - child useMap : {UseMap} - child derivings : {Derivings} - child wrappers : {Set NontermIdent} - child nonts : Nonterminals - child pragmas : {PragmaMap} - child manualAttrOrderMap : {AttrOrderMap} - child paramMap : {ParamMap} - child contextMap : {ContextMap} - visit 0: - local output : _ --} --- cata -sem_Grammar :: Grammar -> - T_Grammar -sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap) = - (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts) _pragmas _manualAttrOrderMap _paramMap _contextMap) --- semantic domain -newtype T_Grammar = T_Grammar (AttrMap -> - Options -> - ( AttrMap,(Seq Error),Grammar)) -data Inh_Grammar = Inh_Grammar {forcedIrrefutables_Inh_Grammar :: AttrMap,options_Inh_Grammar :: Options} -data Syn_Grammar = Syn_Grammar {allAttributes_Syn_Grammar :: AttrMap,errors_Syn_Grammar :: Seq Error,output_Syn_Grammar :: Grammar} -wrap_Grammar (T_Grammar sem) (Inh_Grammar _lhsIforcedIrrefutables _lhsIoptions) = - (let ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) = - (sem _lhsIforcedIrrefutables _lhsIoptions) - in (Syn_Grammar _lhsOallAttributes _lhsOerrors _lhsOoutput)) -sem_Grammar_Grammar :: TypeSyns -> - UseMap -> - Derivings -> - (Set NontermIdent) -> - T_Nonterminals -> - PragmaMap -> - AttrOrderMap -> - ParamMap -> - ContextMap -> - T_Grammar -sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ = - (T_Grammar (\ _lhsIforcedIrrefutables - _lhsIoptions -> - (let _lhsOallAttributes :: AttrMap - _lhsOerrors :: (Seq Error) - _lhsOoutput :: Grammar - _nontsOforcedIrrefutables :: AttrMap - _nontsOoptions :: Options - _nontsIallAttributes :: AttrMap - _nontsIerrors :: (Seq Error) - _nontsIoutput :: Nonterminals - -- use rule "Desugar.ag"(line 189, column 23) - _lhsOallAttributes = - _nontsIallAttributes - -- use rule "Desugar.ag"(line 31, column 144) - _lhsOerrors = - _nontsIerrors - -- self rule - _output = - Grammar typeSyns_ useMap_ derivings_ wrappers_ _nontsIoutput pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ - -- self rule - _lhsOoutput = - _output - -- copy rule (down) - _nontsOforcedIrrefutables = - _lhsIforcedIrrefutables - -- copy rule (down) - _nontsOoptions = - _lhsIoptions - ( _nontsIallAttributes,_nontsIerrors,_nontsIoutput) = - (nonts_ _nontsOforcedIrrefutables _nontsOoptions) - in ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput)))) --- HsToken ----------------------------------------------------- -{- - visit 0: - inherited attributes: - childInhs : [(Identifier, Identifier)] - childSyns : [(Identifier, Identifier)] - con : ConstructorIdent - nt : NontermIdent - ruleDescr : String - useFieldIdent : Bool - chained attribute: - addLines : Int - synthesized attributes: - errors : Seq Error - tks : SELF - alternatives: - alternative AGField: - child field : {Identifier} - child attr : {Identifier} - child pos : {Pos} - child rdesc : {Maybe String} - visit 0: - local mField : _ - local field' : _ - local tks : _ - alternative AGLocal: - child var : {Identifier} - child pos : {Pos} - child rdesc : {Maybe String} - visit 0: - local tks : _ - alternative CharToken: - child value : {String} - child pos : {Pos} - visit 0: - local tks : _ - alternative Err: - child mesg : {String} - child pos : {Pos} - visit 0: - local tks : _ - alternative HsToken: - child value : {String} - child pos : {Pos} - visit 0: - local tks : _ - alternative StrToken: - child value : {String} - child pos : {Pos} - visit 0: - local tks : _ --} --- cata -sem_HsToken :: HsToken -> - T_HsToken -sem_HsToken (AGField _field _attr _pos _rdesc) = - (sem_HsToken_AGField _field _attr _pos _rdesc) -sem_HsToken (AGLocal _var _pos _rdesc) = - (sem_HsToken_AGLocal _var _pos _rdesc) -sem_HsToken (CharToken _value _pos) = - (sem_HsToken_CharToken _value _pos) -sem_HsToken (Err _mesg _pos) = - (sem_HsToken_Err _mesg _pos) -sem_HsToken (HsToken _value _pos) = - (sem_HsToken_HsToken _value _pos) -sem_HsToken (StrToken _value _pos) = - (sem_HsToken_StrToken _value _pos) --- semantic domain -newtype T_HsToken = T_HsToken (Int -> - ([(Identifier, Identifier)]) -> - ([(Identifier, Identifier)]) -> - ConstructorIdent -> - NontermIdent -> - String -> - Bool -> - ( Int,(Seq Error),HsToken)) -data Inh_HsToken = Inh_HsToken {addLines_Inh_HsToken :: Int,childInhs_Inh_HsToken :: [(Identifier, Identifier)],childSyns_Inh_HsToken :: [(Identifier, Identifier)],con_Inh_HsToken :: ConstructorIdent,nt_Inh_HsToken :: NontermIdent,ruleDescr_Inh_HsToken :: String,useFieldIdent_Inh_HsToken :: Bool} -data Syn_HsToken = Syn_HsToken {addLines_Syn_HsToken :: Int,errors_Syn_HsToken :: Seq Error,tks_Syn_HsToken :: HsToken} -wrap_HsToken (T_HsToken sem) (Inh_HsToken _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) = - (let ( _lhsOaddLines,_lhsOerrors,_lhsOtks) = - (sem _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) - in (Syn_HsToken _lhsOaddLines _lhsOerrors _lhsOtks)) -sem_HsToken_AGField :: Identifier -> - Identifier -> - Pos -> - (Maybe String) -> - T_HsToken -sem_HsToken_AGField field_ attr_ pos_ rdesc_ = - (T_HsToken (\ _lhsIaddLines - _lhsIchildInhs - _lhsIchildSyns - _lhsIcon - _lhsInt - _lhsIruleDescr - _lhsIuseFieldIdent -> - (let _lhsOerrors :: (Seq Error) - _lhsOaddLines :: Int - _lhsOtks :: HsToken - -- "Desugar.ag"(line 72, column 7) - _mField = - findField field_ attr_ _lhsIchildSyns - -- "Desugar.ag"(line 74, column 7) - _field' = - maybe field_ id _mField - -- "Desugar.ag"(line 75, column 7) - _lhsOerrors = - maybe (Seq.single (UndefAttr _lhsInt _lhsIcon field_ (Ident "" (getPos field_)) False)) (const Seq.empty) _mField - -- "Desugar.ag"(line 77, column 7) - _lhsOaddLines = - if _lhsIuseFieldIdent || length (getName field_) < length (getName _field' ) - then _lhsIaddLines + 1 - else _lhsIaddLines - -- "Desugar.ag"(line 81, column 7) - _tks = - AGField field_ attr_ (addl _lhsIaddLines pos_) (if _lhsIuseFieldIdent then Just _lhsIruleDescr else Nothing) - -- self rule - _lhsOtks = - _tks - in ( _lhsOaddLines,_lhsOerrors,_lhsOtks)))) -sem_HsToken_AGLocal :: Identifier -> - Pos -> - (Maybe String) -> - T_HsToken -sem_HsToken_AGLocal var_ pos_ rdesc_ = - (T_HsToken (\ _lhsIaddLines - _lhsIchildInhs - _lhsIchildSyns - _lhsIcon - _lhsInt - _lhsIruleDescr - _lhsIuseFieldIdent -> - (let _lhsOaddLines :: Int - _lhsOerrors :: (Seq Error) - _lhsOtks :: HsToken - -- "Desugar.ag"(line 67, column 7) - _lhsOaddLines = - if _lhsIuseFieldIdent - then _lhsIaddLines + 1 - else _lhsIaddLines - -- "Desugar.ag"(line 70, column 7) - _tks = - AGLocal var_ (addl _lhsIaddLines pos_) (if _lhsIuseFieldIdent then Just _lhsIruleDescr else Nothing) - -- use rule "Desugar.ag"(line 31, column 144) - _lhsOerrors = - Seq.empty - -- self rule - _lhsOtks = - _tks - in ( _lhsOaddLines,_lhsOerrors,_lhsOtks)))) -sem_HsToken_CharToken :: String -> - Pos -> - T_HsToken -sem_HsToken_CharToken value_ pos_ = - (T_HsToken (\ _lhsIaddLines - _lhsIchildInhs - _lhsIchildSyns - _lhsIcon - _lhsInt - _lhsIruleDescr - _lhsIuseFieldIdent -> - (let _lhsOerrors :: (Seq Error) - _lhsOtks :: HsToken - _lhsOaddLines :: Int - -- "Desugar.ag"(line 85, column 7) - _tks = - CharToken value_ (addl _lhsIaddLines pos_) - -- use rule "Desugar.ag"(line 31, column 144) - _lhsOerrors = - Seq.empty - -- self rule - _lhsOtks = - _tks - -- copy rule (chain) - _lhsOaddLines = - _lhsIaddLines - in ( _lhsOaddLines,_lhsOerrors,_lhsOtks)))) -sem_HsToken_Err :: String -> - Pos -> - T_HsToken -sem_HsToken_Err mesg_ pos_ = - (T_HsToken (\ _lhsIaddLines - _lhsIchildInhs - _lhsIchildSyns - _lhsIcon - _lhsInt - _lhsIruleDescr - _lhsIuseFieldIdent -> - (let _lhsOerrors :: (Seq Error) - _lhsOtks :: HsToken - _lhsOaddLines :: Int - -- "Desugar.ag"(line 89, column 7) - _tks = - Err mesg_ (addl _lhsIaddLines pos_) - -- use rule "Desugar.ag"(line 31, column 144) - _lhsOerrors = - Seq.empty - -- self rule - _lhsOtks = - _tks - -- copy rule (chain) - _lhsOaddLines = - _lhsIaddLines - in ( _lhsOaddLines,_lhsOerrors,_lhsOtks)))) -sem_HsToken_HsToken :: String -> - Pos -> - T_HsToken -sem_HsToken_HsToken value_ pos_ = - (T_HsToken (\ _lhsIaddLines - _lhsIchildInhs - _lhsIchildSyns - _lhsIcon - _lhsInt - _lhsIruleDescr - _lhsIuseFieldIdent -> - (let _lhsOerrors :: (Seq Error) - _lhsOtks :: HsToken - _lhsOaddLines :: Int - -- "Desugar.ag"(line 83, column 7) - _tks = - HsToken value_ (addl _lhsIaddLines pos_) - -- use rule "Desugar.ag"(line 31, column 144) - _lhsOerrors = - Seq.empty - -- self rule - _lhsOtks = - _tks - -- copy rule (chain) - _lhsOaddLines = - _lhsIaddLines - in ( _lhsOaddLines,_lhsOerrors,_lhsOtks)))) -sem_HsToken_StrToken :: String -> - Pos -> - T_HsToken -sem_HsToken_StrToken value_ pos_ = - (T_HsToken (\ _lhsIaddLines - _lhsIchildInhs - _lhsIchildSyns - _lhsIcon - _lhsInt - _lhsIruleDescr - _lhsIuseFieldIdent -> - (let _lhsOerrors :: (Seq Error) - _lhsOtks :: HsToken - _lhsOaddLines :: Int - -- "Desugar.ag"(line 87, column 7) - _tks = - StrToken value_ (addl _lhsIaddLines pos_) - -- use rule "Desugar.ag"(line 31, column 144) - _lhsOerrors = - Seq.empty - -- self rule - _lhsOtks = - _tks - -- copy rule (chain) - _lhsOaddLines = - _lhsIaddLines - in ( _lhsOaddLines,_lhsOerrors,_lhsOtks)))) --- HsTokens ---------------------------------------------------- -{- - visit 0: - inherited attributes: - childInhs : [(Identifier, Identifier)] - childSyns : [(Identifier, Identifier)] - con : ConstructorIdent - nt : NontermIdent - ruleDescr : String - useFieldIdent : Bool - chained attribute: - addLines : Int - synthesized attributes: - errors : Seq Error - tks : SELF - alternatives: - alternative Cons: - child hd : HsToken - child tl : HsTokens - visit 0: - local tks : _ - alternative Nil: - visit 0: - local tks : _ --} --- cata -sem_HsTokens :: HsTokens -> - T_HsTokens -sem_HsTokens list = - (Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list)) --- semantic domain -newtype T_HsTokens = T_HsTokens (Int -> - ([(Identifier, Identifier)]) -> - ([(Identifier, Identifier)]) -> - ConstructorIdent -> - NontermIdent -> - String -> - Bool -> - ( Int,(Seq Error),HsTokens)) -data Inh_HsTokens = Inh_HsTokens {addLines_Inh_HsTokens :: Int,childInhs_Inh_HsTokens :: [(Identifier, Identifier)],childSyns_Inh_HsTokens :: [(Identifier, Identifier)],con_Inh_HsTokens :: ConstructorIdent,nt_Inh_HsTokens :: NontermIdent,ruleDescr_Inh_HsTokens :: String,useFieldIdent_Inh_HsTokens :: Bool} -data Syn_HsTokens = Syn_HsTokens {addLines_Syn_HsTokens :: Int,errors_Syn_HsTokens :: Seq Error,tks_Syn_HsTokens :: HsTokens} -wrap_HsTokens (T_HsTokens sem) (Inh_HsTokens _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) = - (let ( _lhsOaddLines,_lhsOerrors,_lhsOtks) = - (sem _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) - in (Syn_HsTokens _lhsOaddLines _lhsOerrors _lhsOtks)) -sem_HsTokens_Cons :: T_HsToken -> - T_HsTokens -> - T_HsTokens -sem_HsTokens_Cons (T_HsToken hd_) (T_HsTokens tl_) = - (T_HsTokens (\ _lhsIaddLines - _lhsIchildInhs - _lhsIchildSyns - _lhsIcon - _lhsInt - _lhsIruleDescr - _lhsIuseFieldIdent -> - (let _lhsOerrors :: (Seq Error) - _lhsOtks :: HsTokens - _lhsOaddLines :: Int - _hdOaddLines :: Int - _hdOchildInhs :: ([(Identifier, Identifier)]) - _hdOchildSyns :: ([(Identifier, Identifier)]) - _hdOcon :: ConstructorIdent - _hdOnt :: NontermIdent - _hdOruleDescr :: String - _hdOuseFieldIdent :: Bool - _tlOaddLines :: Int - _tlOchildInhs :: ([(Identifier, Identifier)]) - _tlOchildSyns :: ([(Identifier, Identifier)]) - _tlOcon :: ConstructorIdent - _tlOnt :: NontermIdent - _tlOruleDescr :: String - _tlOuseFieldIdent :: Bool - _hdIaddLines :: Int - _hdIerrors :: (Seq Error) - _hdItks :: HsToken - _tlIaddLines :: Int - _tlIerrors :: (Seq Error) - _tlItks :: HsTokens - -- use rule "Desugar.ag"(line 31, column 144) - _lhsOerrors = - _hdIerrors Seq.<> _tlIerrors - -- self rule - _tks = - (:) _hdItks _tlItks - -- self rule - _lhsOtks = - _tks - -- copy rule (up) - _lhsOaddLines = - _tlIaddLines - -- copy rule (down) - _hdOaddLines = - _lhsIaddLines - -- copy rule (down) - _hdOchildInhs = - _lhsIchildInhs - -- copy rule (down) - _hdOchildSyns = - _lhsIchildSyns - -- copy rule (down) - _hdOcon = - _lhsIcon - -- copy rule (down) - _hdOnt = - _lhsInt - -- copy rule (down) - _hdOruleDescr = - _lhsIruleDescr - -- copy rule (down) - _hdOuseFieldIdent = - _lhsIuseFieldIdent - -- copy rule (chain) - _tlOaddLines = - _hdIaddLines - -- copy rule (down) - _tlOchildInhs = - _lhsIchildInhs - -- copy rule (down) - _tlOchildSyns = - _lhsIchildSyns - -- copy rule (down) - _tlOcon = - _lhsIcon - -- copy rule (down) - _tlOnt = - _lhsInt - -- copy rule (down) - _tlOruleDescr = - _lhsIruleDescr - -- copy rule (down) - _tlOuseFieldIdent = - _lhsIuseFieldIdent - ( _hdIaddLines,_hdIerrors,_hdItks) = - (hd_ _hdOaddLines _hdOchildInhs _hdOchildSyns _hdOcon _hdOnt _hdOruleDescr _hdOuseFieldIdent) - ( _tlIaddLines,_tlIerrors,_tlItks) = - (tl_ _tlOaddLines _tlOchildInhs _tlOchildSyns _tlOcon _tlOnt _tlOruleDescr _tlOuseFieldIdent) - in ( _lhsOaddLines,_lhsOerrors,_lhsOtks)))) -sem_HsTokens_Nil :: T_HsTokens -sem_HsTokens_Nil = - (T_HsTokens (\ _lhsIaddLines - _lhsIchildInhs - _lhsIchildSyns - _lhsIcon - _lhsInt - _lhsIruleDescr - _lhsIuseFieldIdent -> - (let _lhsOerrors :: (Seq Error) - _lhsOtks :: HsTokens - _lhsOaddLines :: Int - -- use rule "Desugar.ag"(line 31, column 144) - _lhsOerrors = - Seq.empty - -- self rule - _tks = - [] - -- self rule - _lhsOtks = - _tks - -- copy rule (chain) - _lhsOaddLines = - _lhsIaddLines - in ( _lhsOaddLines,_lhsOerrors,_lhsOtks)))) --- HsTokensRoot ------------------------------------------------ -{- - visit 0: - inherited attributes: - childInhs : [(Identifier, Identifier)] - childSyns : [(Identifier, Identifier)] - con : ConstructorIdent - nt : NontermIdent - ruleDescr : String - useFieldIdent : Bool - synthesized attributes: - errors : Seq Error - tks : [HsToken] - alternatives: - alternative HsTokensRoot: - child tokens : HsTokens --} --- cata -sem_HsTokensRoot :: HsTokensRoot -> - T_HsTokensRoot -sem_HsTokensRoot (HsTokensRoot _tokens) = - (sem_HsTokensRoot_HsTokensRoot (sem_HsTokens _tokens)) --- semantic domain -newtype T_HsTokensRoot = T_HsTokensRoot (([(Identifier, Identifier)]) -> - ([(Identifier, Identifier)]) -> - ConstructorIdent -> - NontermIdent -> - String -> - Bool -> - ( (Seq Error),([HsToken]))) -data Inh_HsTokensRoot = Inh_HsTokensRoot {childInhs_Inh_HsTokensRoot :: [(Identifier, Identifier)],childSyns_Inh_HsTokensRoot :: [(Identifier, Identifier)],con_Inh_HsTokensRoot :: ConstructorIdent,nt_Inh_HsTokensRoot :: NontermIdent,ruleDescr_Inh_HsTokensRoot :: String,useFieldIdent_Inh_HsTokensRoot :: Bool} -data Syn_HsTokensRoot = Syn_HsTokensRoot {errors_Syn_HsTokensRoot :: Seq Error,tks_Syn_HsTokensRoot :: [HsToken]} -wrap_HsTokensRoot (T_HsTokensRoot sem) (Inh_HsTokensRoot _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) = - (let ( _lhsOerrors,_lhsOtks) = - (sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) - in (Syn_HsTokensRoot _lhsOerrors _lhsOtks)) -sem_HsTokensRoot_HsTokensRoot :: T_HsTokens -> - T_HsTokensRoot -sem_HsTokensRoot_HsTokensRoot (T_HsTokens tokens_) = - (T_HsTokensRoot (\ _lhsIchildInhs - _lhsIchildSyns - _lhsIcon - _lhsInt - _lhsIruleDescr - _lhsIuseFieldIdent -> - (let _tokensOaddLines :: Int - _lhsOerrors :: (Seq Error) - _lhsOtks :: ([HsToken]) - _tokensOchildInhs :: ([(Identifier, Identifier)]) - _tokensOchildSyns :: ([(Identifier, Identifier)]) - _tokensOcon :: ConstructorIdent - _tokensOnt :: NontermIdent - _tokensOruleDescr :: String - _tokensOuseFieldIdent :: Bool - _tokensIaddLines :: Int - _tokensIerrors :: (Seq Error) - _tokensItks :: HsTokens - -- "Desugar.ag"(line 60, column 7) - _tokensOaddLines = - 0 - -- use rule "Desugar.ag"(line 31, column 144) - _lhsOerrors = - _tokensIerrors - -- copy rule (up) - _lhsOtks = - _tokensItks - -- copy rule (down) - _tokensOchildInhs = - _lhsIchildInhs - -- copy rule (down) - _tokensOchildSyns = - _lhsIchildSyns - -- copy rule (down) - _tokensOcon = - _lhsIcon - -- copy rule (down) - _tokensOnt = - _lhsInt - -- copy rule (down) - _tokensOruleDescr = - _lhsIruleDescr - -- copy rule (down) - _tokensOuseFieldIdent = - _lhsIuseFieldIdent - ( _tokensIaddLines,_tokensIerrors,_tokensItks) = - (tokens_ _tokensOaddLines _tokensOchildInhs _tokensOchildSyns _tokensOcon _tokensOnt _tokensOruleDescr _tokensOuseFieldIdent) - in ( _lhsOerrors,_lhsOtks)))) --- Nonterminal ------------------------------------------------- -{- - visit 0: - inherited attributes: - forcedIrrefutables : AttrMap - options : Options - synthesized attributes: - allAttributes : AttrMap - errors : Seq Error - output : SELF - alternatives: - alternative Nonterminal: - child nt : {NontermIdent} - child params : {[Identifier]} - child inh : {Attributes} - child syn : {Attributes} - child prods : Productions - visit 0: - local output : _ --} --- cata -sem_Nonterminal :: Nonterminal -> - T_Nonterminal -sem_Nonterminal (Nonterminal _nt _params _inh _syn _prods) = - (sem_Nonterminal_Nonterminal _nt _params _inh _syn (sem_Productions _prods)) --- semantic domain -newtype T_Nonterminal = T_Nonterminal (AttrMap -> - Options -> - ( AttrMap,(Seq Error),Nonterminal)) -data Inh_Nonterminal = Inh_Nonterminal {forcedIrrefutables_Inh_Nonterminal :: AttrMap,options_Inh_Nonterminal :: Options} -data Syn_Nonterminal = Syn_Nonterminal {allAttributes_Syn_Nonterminal :: AttrMap,errors_Syn_Nonterminal :: Seq Error,output_Syn_Nonterminal :: Nonterminal} -wrap_Nonterminal (T_Nonterminal sem) (Inh_Nonterminal _lhsIforcedIrrefutables _lhsIoptions) = - (let ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) = - (sem _lhsIforcedIrrefutables _lhsIoptions) - in (Syn_Nonterminal _lhsOallAttributes _lhsOerrors _lhsOoutput)) -sem_Nonterminal_Nonterminal :: NontermIdent -> - ([Identifier]) -> - Attributes -> - Attributes -> - T_Productions -> - T_Nonterminal -sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ (T_Productions prods_) = - (T_Nonterminal (\ _lhsIforcedIrrefutables - _lhsIoptions -> - (let _prodsOnt :: NontermIdent - _lhsOallAttributes :: AttrMap - _lhsOerrors :: (Seq Error) - _lhsOoutput :: Nonterminal - _prodsOforcedIrrefutables :: AttrMap - _prodsOoptions :: Options - _prodsIallAttributes :: AttrMap - _prodsIerrors :: (Seq Error) - _prodsIoutput :: Productions - -- "Desugar.ag"(line 150, column 7) - _prodsOnt = - nt_ - -- use rule "Desugar.ag"(line 189, column 23) - _lhsOallAttributes = - _prodsIallAttributes - -- use rule "Desugar.ag"(line 31, column 144) - _lhsOerrors = - _prodsIerrors - -- self rule - _output = - Nonterminal nt_ params_ inh_ syn_ _prodsIoutput - -- self rule - _lhsOoutput = - _output - -- copy rule (down) - _prodsOforcedIrrefutables = - _lhsIforcedIrrefutables - -- copy rule (down) - _prodsOoptions = - _lhsIoptions - ( _prodsIallAttributes,_prodsIerrors,_prodsIoutput) = - (prods_ _prodsOforcedIrrefutables _prodsOnt _prodsOoptions) - in ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput)))) --- Nonterminals ------------------------------------------------ -{- - visit 0: - inherited attributes: - forcedIrrefutables : AttrMap - options : Options - synthesized attributes: - allAttributes : AttrMap - errors : Seq Error - output : SELF - alternatives: - alternative Cons: - child hd : Nonterminal - child tl : Nonterminals - visit 0: - local output : _ - alternative Nil: - visit 0: - local output : _ --} --- cata -sem_Nonterminals :: Nonterminals -> - T_Nonterminals -sem_Nonterminals list = - (Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list)) --- semantic domain -newtype T_Nonterminals = T_Nonterminals (AttrMap -> - Options -> - ( AttrMap,(Seq Error),Nonterminals)) -data Inh_Nonterminals = Inh_Nonterminals {forcedIrrefutables_Inh_Nonterminals :: AttrMap,options_Inh_Nonterminals :: Options} -data Syn_Nonterminals = Syn_Nonterminals {allAttributes_Syn_Nonterminals :: AttrMap,errors_Syn_Nonterminals :: Seq Error,output_Syn_Nonterminals :: Nonterminals} -wrap_Nonterminals (T_Nonterminals sem) (Inh_Nonterminals _lhsIforcedIrrefutables _lhsIoptions) = - (let ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) = - (sem _lhsIforcedIrrefutables _lhsIoptions) - in (Syn_Nonterminals _lhsOallAttributes _lhsOerrors _lhsOoutput)) -sem_Nonterminals_Cons :: T_Nonterminal -> - T_Nonterminals -> - T_Nonterminals -sem_Nonterminals_Cons (T_Nonterminal hd_) (T_Nonterminals tl_) = - (T_Nonterminals (\ _lhsIforcedIrrefutables - _lhsIoptions -> - (let _lhsOallAttributes :: AttrMap - _lhsOerrors :: (Seq Error) - _lhsOoutput :: Nonterminals - _hdOforcedIrrefutables :: AttrMap - _hdOoptions :: Options - _tlOforcedIrrefutables :: AttrMap - _tlOoptions :: Options - _hdIallAttributes :: AttrMap - _hdIerrors :: (Seq Error) - _hdIoutput :: Nonterminal - _tlIallAttributes :: AttrMap - _tlIerrors :: (Seq Error) - _tlIoutput :: Nonterminals - -- use rule "Desugar.ag"(line 189, column 23) - _lhsOallAttributes = - _hdIallAttributes `mergeAttributes` _tlIallAttributes - -- use rule "Desugar.ag"(line 31, column 144) - _lhsOerrors = - _hdIerrors Seq.<> _tlIerrors - -- self rule - _output = - (:) _hdIoutput _tlIoutput - -- self rule - _lhsOoutput = - _output - -- copy rule (down) - _hdOforcedIrrefutables = - _lhsIforcedIrrefutables - -- copy rule (down) - _hdOoptions = - _lhsIoptions - -- copy rule (down) - _tlOforcedIrrefutables = - _lhsIforcedIrrefutables - -- copy rule (down) - _tlOoptions = - _lhsIoptions - ( _hdIallAttributes,_hdIerrors,_hdIoutput) = - (hd_ _hdOforcedIrrefutables _hdOoptions) - ( _tlIallAttributes,_tlIerrors,_tlIoutput) = - (tl_ _tlOforcedIrrefutables _tlOoptions) - in ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput)))) -sem_Nonterminals_Nil :: T_Nonterminals -sem_Nonterminals_Nil = - (T_Nonterminals (\ _lhsIforcedIrrefutables - _lhsIoptions -> - (let _lhsOallAttributes :: AttrMap - _lhsOerrors :: (Seq Error) - _lhsOoutput :: Nonterminals - -- use rule "Desugar.ag"(line 189, column 23) - _lhsOallAttributes = - Map.empty - -- use rule "Desugar.ag"(line 31, column 144) - _lhsOerrors = - Seq.empty - -- self rule - _output = - [] - -- self rule - _lhsOoutput = - _output - in ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput)))) --- Pattern ----------------------------------------------------- -{- - visit 0: - inherited attributes: - childInhs : [(Identifier, Identifier)] - childSyns : [(Identifier, Identifier)] - con : ConstructorIdent - defs : Set (Identifier, Identifier) - forcedIrrefutables : AttrMap - nt : NontermIdent - synthesized attributes: - allAttributes : AttrMap - copy : SELF - defsCollect : Set (Identifier, Identifier) - errors : Seq Error - output : SELF - alternatives: - alternative Alias: - child field : {Identifier} - child attr : {Identifier} - child pat : Pattern - child parts : Patterns - visit 0: - local _tup2 : _ - local field' : _ - local err1 : _ - local err2 : _ - local output : _ - local def : _ - local copy : _ - alternative Constr: - child name : {ConstructorIdent} - child pats : Patterns - visit 0: - local copy : _ - local output : _ - alternative Irrefutable: - child pat : Pattern - visit 0: - local copy : _ - local output : _ - alternative Product: - child pos : {Pos} - child pats : Patterns - visit 0: - local copy : _ - local output : _ - alternative Underscore: - child pos : {Pos} - visit 0: - local copy : _ - local output : _ --} --- cata -sem_Pattern :: Pattern -> - T_Pattern -sem_Pattern (Alias _field _attr _pat _parts) = - (sem_Pattern_Alias _field _attr (sem_Pattern _pat) (sem_Patterns _parts)) -sem_Pattern (Constr _name _pats) = - (sem_Pattern_Constr _name (sem_Patterns _pats)) -sem_Pattern (Irrefutable _pat) = - (sem_Pattern_Irrefutable (sem_Pattern _pat)) -sem_Pattern (Product _pos _pats) = - (sem_Pattern_Product _pos (sem_Patterns _pats)) -sem_Pattern (Underscore _pos) = - (sem_Pattern_Underscore _pos) --- semantic domain -newtype T_Pattern = T_Pattern (([(Identifier, Identifier)]) -> - ([(Identifier, Identifier)]) -> - ConstructorIdent -> - (Set (Identifier, Identifier)) -> - AttrMap -> - NontermIdent -> - ( AttrMap,Pattern,(Set (Identifier, Identifier)),(Seq Error),Pattern)) -data Inh_Pattern = Inh_Pattern {childInhs_Inh_Pattern :: [(Identifier, Identifier)],childSyns_Inh_Pattern :: [(Identifier, Identifier)],con_Inh_Pattern :: ConstructorIdent,defs_Inh_Pattern :: Set (Identifier, Identifier),forcedIrrefutables_Inh_Pattern :: AttrMap,nt_Inh_Pattern :: NontermIdent} -data Syn_Pattern = Syn_Pattern {allAttributes_Syn_Pattern :: AttrMap,copy_Syn_Pattern :: Pattern,defsCollect_Syn_Pattern :: Set (Identifier, Identifier),errors_Syn_Pattern :: Seq Error,output_Syn_Pattern :: Pattern} -wrap_Pattern (T_Pattern sem) (Inh_Pattern _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) = - (let ( _lhsOallAttributes,_lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput) = - (sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) - in (Syn_Pattern _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput)) -sem_Pattern_Alias :: Identifier -> - Identifier -> - T_Pattern -> - T_Patterns -> - T_Pattern -sem_Pattern_Alias field_ attr_ (T_Pattern pat_) (T_Patterns parts_) = - (T_Pattern (\ _lhsIchildInhs - _lhsIchildSyns - _lhsIcon - _lhsIdefs - _lhsIforcedIrrefutables - _lhsInt -> - (let _lhsOerrors :: (Seq Error) - _lhsOdefsCollect :: (Set (Identifier, Identifier)) - _lhsOallAttributes :: AttrMap - _lhsOoutput :: Pattern - _lhsOcopy :: Pattern - _patOchildInhs :: ([(Identifier, Identifier)]) - _patOchildSyns :: ([(Identifier, Identifier)]) - _patOcon :: ConstructorIdent - _patOdefs :: (Set (Identifier, Identifier)) - _patOforcedIrrefutables :: AttrMap - _patOnt :: NontermIdent - _partsOchildInhs :: ([(Identifier, Identifier)]) - _partsOchildSyns :: ([(Identifier, Identifier)]) - _partsOcon :: ConstructorIdent - _partsOdefs :: (Set (Identifier, Identifier)) - _partsOforcedIrrefutables :: AttrMap - _partsOnt :: NontermIdent - _patIallAttributes :: AttrMap - _patIcopy :: Pattern - _patIdefsCollect :: (Set (Identifier, Identifier)) - _patIerrors :: (Seq Error) - _patIoutput :: Pattern - _partsIallAttributes :: AttrMap - _partsIcopy :: Patterns - _partsIdefsCollect :: (Set (Identifier, Identifier)) - _partsIerrors :: (Seq Error) - _partsIoutput :: Patterns - -- "Desugar.ag"(line 103, column 7) - __tup2 = - maybeError field_ (UndefAttr _lhsInt _lhsIcon (Ident "" (getPos field_)) attr_ True) $ - findField field_ attr_ _lhsIchildInhs - -- "Desugar.ag"(line 103, column 7) - (_field',_) = - __tup2 - -- "Desugar.ag"(line 103, column 7) - (_,_err1) = - __tup2 - -- "Desugar.ag"(line 105, column 7) - _err2 = - if _field' == field_ - then Seq.empty - else if (_field' , attr_) `Set.member` _lhsIdefs - then Seq.single $ DupRule _lhsInt _lhsIcon field_ attr_ _field' - else Seq.empty - -- "Desugar.ag"(line 110, column 7) - _lhsOerrors = - _err1 Seq.<> _err2 Seq.<> _patIerrors <> _partsIerrors - -- "Desugar.ag"(line 111, column 7) - _output = - Alias _field' attr_ _patIoutput _partsIoutput - -- "Desugar.ag"(line 175, column 7) - _def = - Set.singleton (field_, attr_) - -- "Desugar.ag"(line 176, column 7) - _lhsOdefsCollect = - _def `Set.union` _patIdefsCollect `Set.union` _partsIdefsCollect - -- "Desugar.ag"(line 193, column 7) - _lhsOallAttributes = - (Map.singleton _lhsInt $ Map.singleton _lhsIcon $ Set.singleton (field_, attr_)) `mergeAttributes` _patIallAttributes - -- "Desugar.ag"(line 212, column 7) - _lhsOoutput = - if Set.member (field_, attr_) $ Map.findWithDefault Set.empty _lhsIcon $ Map.findWithDefault Map.empty _lhsInt $ _lhsIforcedIrrefutables - then Irrefutable _output - else _output - -- self rule - _copy = - Alias field_ attr_ _patIcopy _partsIcopy - -- self rule - _lhsOcopy = - _copy - -- copy rule (down) - _patOchildInhs = - _lhsIchildInhs - -- copy rule (down) - _patOchildSyns = - _lhsIchildSyns - -- copy rule (down) - _patOcon = - _lhsIcon - -- copy rule (down) - _patOdefs = - _lhsIdefs - -- copy rule (down) - _patOforcedIrrefutables = - _lhsIforcedIrrefutables - -- copy rule (down) - _patOnt = - _lhsInt - -- copy rule (down) - _partsOchildInhs = - _lhsIchildInhs - -- copy rule (down) - _partsOchildSyns = - _lhsIchildSyns - -- copy rule (down) - _partsOcon = - _lhsIcon - -- copy rule (down) - _partsOdefs = - _lhsIdefs - -- copy rule (down) - _partsOforcedIrrefutables = - _lhsIforcedIrrefutables - -- copy rule (down) - _partsOnt = - _lhsInt - ( _patIallAttributes,_patIcopy,_patIdefsCollect,_patIerrors,_patIoutput) = - (pat_ _patOchildInhs _patOchildSyns _patOcon _patOdefs _patOforcedIrrefutables _patOnt) - ( _partsIallAttributes,_partsIcopy,_partsIdefsCollect,_partsIerrors,_partsIoutput) = - (parts_ _partsOchildInhs _partsOchildSyns _partsOcon _partsOdefs _partsOforcedIrrefutables _partsOnt) - in ( _lhsOallAttributes,_lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput)))) -sem_Pattern_Constr :: ConstructorIdent -> - T_Patterns -> - T_Pattern -sem_Pattern_Constr name_ (T_Patterns pats_) = - (T_Pattern (\ _lhsIchildInhs - _lhsIchildSyns - _lhsIcon - _lhsIdefs - _lhsIforcedIrrefutables - _lhsInt -> - (let _lhsOallAttributes :: AttrMap - _lhsOdefsCollect :: (Set (Identifier, Identifier)) - _lhsOerrors :: (Seq Error) - _lhsOcopy :: Pattern - _lhsOoutput :: Pattern - _patsOchildInhs :: ([(Identifier, Identifier)]) - _patsOchildSyns :: ([(Identifier, Identifier)]) - _patsOcon :: ConstructorIdent - _patsOdefs :: (Set (Identifier, Identifier)) - _patsOforcedIrrefutables :: AttrMap - _patsOnt :: NontermIdent - _patsIallAttributes :: AttrMap - _patsIcopy :: Patterns - _patsIdefsCollect :: (Set (Identifier, Identifier)) - _patsIerrors :: (Seq Error) - _patsIoutput :: Patterns - -- use rule "Desugar.ag"(line 189, column 23) - _lhsOallAttributes = - _patsIallAttributes - -- use rule "Desugar.ag"(line 172, column 52) - _lhsOdefsCollect = - _patsIdefsCollect - -- use rule "Desugar.ag"(line 31, column 144) - _lhsOerrors = - _patsIerrors - -- self rule - _copy = - Constr name_ _patsIcopy - -- self rule - _output = - Constr name_ _patsIoutput - -- self rule - _lhsOcopy = - _copy - -- self rule - _lhsOoutput = - _output - -- copy rule (down) - _patsOchildInhs = - _lhsIchildInhs - -- copy rule (down) - _patsOchildSyns = - _lhsIchildSyns - -- copy rule (down) - _patsOcon = - _lhsIcon - -- copy rule (down) - _patsOdefs = - _lhsIdefs - -- copy rule (down) - _patsOforcedIrrefutables = - _lhsIforcedIrrefutables - -- copy rule (down) - _patsOnt = - _lhsInt - ( _patsIallAttributes,_patsIcopy,_patsIdefsCollect,_patsIerrors,_patsIoutput) = - (pats_ _patsOchildInhs _patsOchildSyns _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt) - in ( _lhsOallAttributes,_lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput)))) -sem_Pattern_Irrefutable :: T_Pattern -> - T_Pattern -sem_Pattern_Irrefutable (T_Pattern pat_) = - (T_Pattern (\ _lhsIchildInhs - _lhsIchildSyns - _lhsIcon - _lhsIdefs - _lhsIforcedIrrefutables - _lhsInt -> - (let _lhsOallAttributes :: AttrMap - _lhsOdefsCollect :: (Set (Identifier, Identifier)) - _lhsOerrors :: (Seq Error) - _lhsOcopy :: Pattern - _lhsOoutput :: Pattern - _patOchildInhs :: ([(Identifier, Identifier)]) - _patOchildSyns :: ([(Identifier, Identifier)]) - _patOcon :: ConstructorIdent - _patOdefs :: (Set (Identifier, Identifier)) - _patOforcedIrrefutables :: AttrMap - _patOnt :: NontermIdent - _patIallAttributes :: AttrMap - _patIcopy :: Pattern - _patIdefsCollect :: (Set (Identifier, Identifier)) - _patIerrors :: (Seq Error) - _patIoutput :: Pattern - -- "Desugar.ag"(line 195, column 7) - _lhsOallAttributes = - Map.empty - -- use rule "Desugar.ag"(line 172, column 52) - _lhsOdefsCollect = - _patIdefsCollect - -- use rule "Desugar.ag"(line 31, column 144) - _lhsOerrors = - _patIerrors - -- self rule - _copy = - Irrefutable _patIcopy - -- self rule - _output = - Irrefutable _patIoutput - -- self rule - _lhsOcopy = - _copy - -- self rule - _lhsOoutput = - _output - -- copy rule (down) - _patOchildInhs = - _lhsIchildInhs - -- copy rule (down) - _patOchildSyns = - _lhsIchildSyns - -- copy rule (down) - _patOcon = - _lhsIcon - -- copy rule (down) - _patOdefs = - _lhsIdefs - -- copy rule (down) - _patOforcedIrrefutables = - _lhsIforcedIrrefutables - -- copy rule (down) - _patOnt = - _lhsInt - ( _patIallAttributes,_patIcopy,_patIdefsCollect,_patIerrors,_patIoutput) = - (pat_ _patOchildInhs _patOchildSyns _patOcon _patOdefs _patOforcedIrrefutables _patOnt) - in ( _lhsOallAttributes,_lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput)))) -sem_Pattern_Product :: Pos -> - T_Patterns -> - T_Pattern -sem_Pattern_Product pos_ (T_Patterns pats_) = - (T_Pattern (\ _lhsIchildInhs - _lhsIchildSyns - _lhsIcon - _lhsIdefs - _lhsIforcedIrrefutables - _lhsInt -> - (let _lhsOallAttributes :: AttrMap - _lhsOdefsCollect :: (Set (Identifier, Identifier)) - _lhsOerrors :: (Seq Error) - _lhsOcopy :: Pattern - _lhsOoutput :: Pattern - _patsOchildInhs :: ([(Identifier, Identifier)]) - _patsOchildSyns :: ([(Identifier, Identifier)]) - _patsOcon :: ConstructorIdent - _patsOdefs :: (Set (Identifier, Identifier)) - _patsOforcedIrrefutables :: AttrMap - _patsOnt :: NontermIdent - _patsIallAttributes :: AttrMap - _patsIcopy :: Patterns - _patsIdefsCollect :: (Set (Identifier, Identifier)) - _patsIerrors :: (Seq Error) - _patsIoutput :: Patterns - -- use rule "Desugar.ag"(line 189, column 23) - _lhsOallAttributes = - _patsIallAttributes - -- use rule "Desugar.ag"(line 172, column 52) - _lhsOdefsCollect = - _patsIdefsCollect - -- use rule "Desugar.ag"(line 31, column 144) - _lhsOerrors = - _patsIerrors - -- self rule - _copy = - Product pos_ _patsIcopy - -- self rule - _output = - Product pos_ _patsIoutput - -- self rule - _lhsOcopy = - _copy - -- self rule - _lhsOoutput = - _output - -- copy rule (down) - _patsOchildInhs = - _lhsIchildInhs - -- copy rule (down) - _patsOchildSyns = - _lhsIchildSyns - -- copy rule (down) - _patsOcon = - _lhsIcon - -- copy rule (down) - _patsOdefs = - _lhsIdefs - -- copy rule (down) - _patsOforcedIrrefutables = - _lhsIforcedIrrefutables - -- copy rule (down) - _patsOnt = - _lhsInt - ( _patsIallAttributes,_patsIcopy,_patsIdefsCollect,_patsIerrors,_patsIoutput) = - (pats_ _patsOchildInhs _patsOchildSyns _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt) - in ( _lhsOallAttributes,_lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput)))) -sem_Pattern_Underscore :: Pos -> - T_Pattern -sem_Pattern_Underscore pos_ = - (T_Pattern (\ _lhsIchildInhs - _lhsIchildSyns - _lhsIcon - _lhsIdefs - _lhsIforcedIrrefutables - _lhsInt -> - (let _lhsOallAttributes :: AttrMap - _lhsOdefsCollect :: (Set (Identifier, Identifier)) - _lhsOerrors :: (Seq Error) - _lhsOcopy :: Pattern - _lhsOoutput :: Pattern - -- use rule "Desugar.ag"(line 189, column 23) - _lhsOallAttributes = - Map.empty - -- use rule "Desugar.ag"(line 172, column 52) - _lhsOdefsCollect = - Set.empty - -- use rule "Desugar.ag"(line 31, column 144) - _lhsOerrors = - Seq.empty - -- self rule - _copy = - Underscore pos_ - -- self rule - _output = - Underscore pos_ - -- self rule - _lhsOcopy = - _copy - -- self rule - _lhsOoutput = - _output - in ( _lhsOallAttributes,_lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput)))) --- Patterns ---------------------------------------------------- -{- - visit 0: - inherited attributes: - childInhs : [(Identifier, Identifier)] - childSyns : [(Identifier, Identifier)] - con : ConstructorIdent - defs : Set (Identifier, Identifier) - forcedIrrefutables : AttrMap - nt : NontermIdent - synthesized attributes: - allAttributes : AttrMap - copy : SELF - defsCollect : Set (Identifier, Identifier) - errors : Seq Error - output : SELF - alternatives: - alternative Cons: - child hd : Pattern - child tl : Patterns - visit 0: - local copy : _ - local output : _ - alternative Nil: - visit 0: - local copy : _ - local output : _ --} --- cata -sem_Patterns :: Patterns -> - T_Patterns -sem_Patterns list = - (Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list)) --- semantic domain -newtype T_Patterns = T_Patterns (([(Identifier, Identifier)]) -> - ([(Identifier, Identifier)]) -> - ConstructorIdent -> - (Set (Identifier, Identifier)) -> - AttrMap -> - NontermIdent -> - ( AttrMap,Patterns,(Set (Identifier, Identifier)),(Seq Error),Patterns)) -data Inh_Patterns = Inh_Patterns {childInhs_Inh_Patterns :: [(Identifier, Identifier)],childSyns_Inh_Patterns :: [(Identifier, Identifier)],con_Inh_Patterns :: ConstructorIdent,defs_Inh_Patterns :: Set (Identifier, Identifier),forcedIrrefutables_Inh_Patterns :: AttrMap,nt_Inh_Patterns :: NontermIdent} -data Syn_Patterns = Syn_Patterns {allAttributes_Syn_Patterns :: AttrMap,copy_Syn_Patterns :: Patterns,defsCollect_Syn_Patterns :: Set (Identifier, Identifier),errors_Syn_Patterns :: Seq Error,output_Syn_Patterns :: Patterns} -wrap_Patterns (T_Patterns sem) (Inh_Patterns _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) = - (let ( _lhsOallAttributes,_lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput) = - (sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) - in (Syn_Patterns _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput)) -sem_Patterns_Cons :: T_Pattern -> - T_Patterns -> - T_Patterns -sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) = - (T_Patterns (\ _lhsIchildInhs - _lhsIchildSyns - _lhsIcon - _lhsIdefs - _lhsIforcedIrrefutables - _lhsInt -> - (let _lhsOallAttributes :: AttrMap - _lhsOdefsCollect :: (Set (Identifier, Identifier)) - _lhsOerrors :: (Seq Error) - _lhsOcopy :: Patterns - _lhsOoutput :: Patterns - _hdOchildInhs :: ([(Identifier, Identifier)]) - _hdOchildSyns :: ([(Identifier, Identifier)]) - _hdOcon :: ConstructorIdent - _hdOdefs :: (Set (Identifier, Identifier)) - _hdOforcedIrrefutables :: AttrMap - _hdOnt :: NontermIdent - _tlOchildInhs :: ([(Identifier, Identifier)]) - _tlOchildSyns :: ([(Identifier, Identifier)]) - _tlOcon :: ConstructorIdent - _tlOdefs :: (Set (Identifier, Identifier)) - _tlOforcedIrrefutables :: AttrMap - _tlOnt :: NontermIdent - _hdIallAttributes :: AttrMap - _hdIcopy :: Pattern - _hdIdefsCollect :: (Set (Identifier, Identifier)) - _hdIerrors :: (Seq Error) - _hdIoutput :: Pattern - _tlIallAttributes :: AttrMap - _tlIcopy :: Patterns - _tlIdefsCollect :: (Set (Identifier, Identifier)) - _tlIerrors :: (Seq Error) - _tlIoutput :: Patterns - -- use rule "Desugar.ag"(line 189, column 23) - _lhsOallAttributes = - _hdIallAttributes `mergeAttributes` _tlIallAttributes - -- use rule "Desugar.ag"(line 172, column 52) - _lhsOdefsCollect = - _hdIdefsCollect `Set.union` _tlIdefsCollect - -- use rule "Desugar.ag"(line 31, column 144) - _lhsOerrors = - _hdIerrors Seq.<> _tlIerrors - -- self rule - _copy = - (:) _hdIcopy _tlIcopy - -- self rule - _output = - (:) _hdIoutput _tlIoutput - -- self rule - _lhsOcopy = - _copy - -- self rule - _lhsOoutput = - _output - -- copy rule (down) - _hdOchildInhs = - _lhsIchildInhs - -- copy rule (down) - _hdOchildSyns = - _lhsIchildSyns - -- copy rule (down) - _hdOcon = - _lhsIcon - -- copy rule (down) - _hdOdefs = - _lhsIdefs - -- copy rule (down) - _hdOforcedIrrefutables = - _lhsIforcedIrrefutables - -- copy rule (down) - _hdOnt = - _lhsInt - -- copy rule (down) - _tlOchildInhs = - _lhsIchildInhs - -- copy rule (down) - _tlOchildSyns = - _lhsIchildSyns - -- copy rule (down) - _tlOcon = - _lhsIcon - -- copy rule (down) - _tlOdefs = - _lhsIdefs - -- copy rule (down) - _tlOforcedIrrefutables = - _lhsIforcedIrrefutables - -- copy rule (down) - _tlOnt = - _lhsInt - ( _hdIallAttributes,_hdIcopy,_hdIdefsCollect,_hdIerrors,_hdIoutput) = - (hd_ _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt) - ( _tlIallAttributes,_tlIcopy,_tlIdefsCollect,_tlIerrors,_tlIoutput) = - (tl_ _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt) - in ( _lhsOallAttributes,_lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput)))) -sem_Patterns_Nil :: T_Patterns -sem_Patterns_Nil = - (T_Patterns (\ _lhsIchildInhs - _lhsIchildSyns - _lhsIcon - _lhsIdefs - _lhsIforcedIrrefutables - _lhsInt -> - (let _lhsOallAttributes :: AttrMap - _lhsOdefsCollect :: (Set (Identifier, Identifier)) - _lhsOerrors :: (Seq Error) - _lhsOcopy :: Patterns - _lhsOoutput :: Patterns - -- use rule "Desugar.ag"(line 189, column 23) - _lhsOallAttributes = - Map.empty - -- use rule "Desugar.ag"(line 172, column 52) - _lhsOdefsCollect = - Set.empty - -- use rule "Desugar.ag"(line 31, column 144) - _lhsOerrors = - Seq.empty - -- self rule - _copy = - [] - -- self rule - _output = - [] - -- self rule - _lhsOcopy = - _copy - -- self rule - _lhsOoutput = - _output - in ( _lhsOallAttributes,_lhsOcopy,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput)))) --- Production -------------------------------------------------- -{- - visit 0: - inherited attributes: - forcedIrrefutables : AttrMap - nt : NontermIdent - options : Options - synthesized attributes: - allAttributes : AttrMap - errors : Seq Error - output : SELF - alternatives: - alternative Production: - child con : {ConstructorIdent} - child children : Children - child rules : Rules - child typeSigs : TypeSigs - visit 0: - local output : _ --} --- cata -sem_Production :: Production -> - T_Production -sem_Production (Production _con _children _rules _typeSigs) = - (sem_Production_Production _con (sem_Children _children) (sem_Rules _rules) (sem_TypeSigs _typeSigs)) --- semantic domain -newtype T_Production = T_Production (AttrMap -> - NontermIdent -> - Options -> - ( AttrMap,(Seq Error),Production)) -data Inh_Production = Inh_Production {forcedIrrefutables_Inh_Production :: AttrMap,nt_Inh_Production :: NontermIdent,options_Inh_Production :: Options} -data Syn_Production = Syn_Production {allAttributes_Syn_Production :: AttrMap,errors_Syn_Production :: Seq Error,output_Syn_Production :: Production} -wrap_Production (T_Production sem) (Inh_Production _lhsIforcedIrrefutables _lhsInt _lhsIoptions) = - (let ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) = - (sem _lhsIforcedIrrefutables _lhsInt _lhsIoptions) - in (Syn_Production _lhsOallAttributes _lhsOerrors _lhsOoutput)) -sem_Production_Production :: ConstructorIdent -> - T_Children -> - T_Rules -> - T_TypeSigs -> - T_Production -sem_Production_Production con_ (T_Children children_) (T_Rules rules_) (T_TypeSigs typeSigs_) = - (T_Production (\ _lhsIforcedIrrefutables - _lhsInt - _lhsIoptions -> - (let _rulesOcon :: ConstructorIdent - _rulesOdefs :: (Set (Identifier, Identifier)) - _lhsOallAttributes :: AttrMap - _lhsOerrors :: (Seq Error) - _lhsOoutput :: Production - _rulesOchildInhs :: ([(Identifier, Identifier)]) - _rulesOchildSyns :: ([(Identifier, Identifier)]) - _rulesOforcedIrrefutables :: AttrMap - _rulesOnt :: NontermIdent - _rulesOoptions :: Options - _childrenIchildInhs :: ([(Identifier, Identifier)]) - _childrenIchildSyns :: ([(Identifier, Identifier)]) - _childrenIoutput :: Children - _rulesIallAttributes :: AttrMap - _rulesIdefsCollect :: (Set (Identifier, Identifier)) - _rulesIerrors :: (Seq Error) - _rulesIoutput :: Rules - _typeSigsIoutput :: TypeSigs - -- "Desugar.ag"(line 154, column 7) - _rulesOcon = - con_ - -- "Desugar.ag"(line 181, column 7) - _rulesOdefs = - _rulesIdefsCollect - -- use rule "Desugar.ag"(line 189, column 23) - _lhsOallAttributes = - _rulesIallAttributes - -- use rule "Desugar.ag"(line 31, column 144) - _lhsOerrors = - _rulesIerrors - -- self rule - _output = - Production con_ _childrenIoutput _rulesIoutput _typeSigsIoutput - -- self rule - _lhsOoutput = - _output - -- copy rule (chain) - _rulesOchildInhs = - _childrenIchildInhs - -- copy rule (chain) - _rulesOchildSyns = - _childrenIchildSyns - -- copy rule (down) - _rulesOforcedIrrefutables = - _lhsIforcedIrrefutables - -- copy rule (down) - _rulesOnt = - _lhsInt - -- copy rule (down) - _rulesOoptions = - _lhsIoptions - ( _childrenIchildInhs,_childrenIchildSyns,_childrenIoutput) = - (children_ ) - ( _rulesIallAttributes,_rulesIdefsCollect,_rulesIerrors,_rulesIoutput) = - (rules_ _rulesOchildInhs _rulesOchildSyns _rulesOcon _rulesOdefs _rulesOforcedIrrefutables _rulesOnt _rulesOoptions) - ( _typeSigsIoutput) = - (typeSigs_ ) - in ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput)))) --- Productions ------------------------------------------------- -{- - visit 0: - inherited attributes: - forcedIrrefutables : AttrMap - nt : NontermIdent - options : Options - synthesized attributes: - allAttributes : AttrMap - errors : Seq Error - output : SELF - alternatives: - alternative Cons: - child hd : Production - child tl : Productions - visit 0: - local output : _ - alternative Nil: - visit 0: - local output : _ --} --- cata -sem_Productions :: Productions -> - T_Productions -sem_Productions list = - (Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list)) --- semantic domain -newtype T_Productions = T_Productions (AttrMap -> - NontermIdent -> - Options -> - ( AttrMap,(Seq Error),Productions)) -data Inh_Productions = Inh_Productions {forcedIrrefutables_Inh_Productions :: AttrMap,nt_Inh_Productions :: NontermIdent,options_Inh_Productions :: Options} -data Syn_Productions = Syn_Productions {allAttributes_Syn_Productions :: AttrMap,errors_Syn_Productions :: Seq Error,output_Syn_Productions :: Productions} -wrap_Productions (T_Productions sem) (Inh_Productions _lhsIforcedIrrefutables _lhsInt _lhsIoptions) = - (let ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) = - (sem _lhsIforcedIrrefutables _lhsInt _lhsIoptions) - in (Syn_Productions _lhsOallAttributes _lhsOerrors _lhsOoutput)) -sem_Productions_Cons :: T_Production -> - T_Productions -> - T_Productions -sem_Productions_Cons (T_Production hd_) (T_Productions tl_) = - (T_Productions (\ _lhsIforcedIrrefutables - _lhsInt - _lhsIoptions -> - (let _lhsOallAttributes :: AttrMap - _lhsOerrors :: (Seq Error) - _lhsOoutput :: Productions - _hdOforcedIrrefutables :: AttrMap - _hdOnt :: NontermIdent - _hdOoptions :: Options - _tlOforcedIrrefutables :: AttrMap - _tlOnt :: NontermIdent - _tlOoptions :: Options - _hdIallAttributes :: AttrMap - _hdIerrors :: (Seq Error) - _hdIoutput :: Production - _tlIallAttributes :: AttrMap - _tlIerrors :: (Seq Error) - _tlIoutput :: Productions - -- use rule "Desugar.ag"(line 189, column 23) - _lhsOallAttributes = - _hdIallAttributes `mergeAttributes` _tlIallAttributes - -- use rule "Desugar.ag"(line 31, column 144) - _lhsOerrors = - _hdIerrors Seq.<> _tlIerrors - -- self rule - _output = - (:) _hdIoutput _tlIoutput - -- self rule - _lhsOoutput = - _output - -- copy rule (down) - _hdOforcedIrrefutables = - _lhsIforcedIrrefutables - -- copy rule (down) - _hdOnt = - _lhsInt - -- copy rule (down) - _hdOoptions = - _lhsIoptions - -- copy rule (down) - _tlOforcedIrrefutables = - _lhsIforcedIrrefutables - -- copy rule (down) - _tlOnt = - _lhsInt - -- copy rule (down) - _tlOoptions = - _lhsIoptions - ( _hdIallAttributes,_hdIerrors,_hdIoutput) = - (hd_ _hdOforcedIrrefutables _hdOnt _hdOoptions) - ( _tlIallAttributes,_tlIerrors,_tlIoutput) = - (tl_ _tlOforcedIrrefutables _tlOnt _tlOoptions) - in ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput)))) -sem_Productions_Nil :: T_Productions -sem_Productions_Nil = - (T_Productions (\ _lhsIforcedIrrefutables - _lhsInt - _lhsIoptions -> - (let _lhsOallAttributes :: AttrMap - _lhsOerrors :: (Seq Error) - _lhsOoutput :: Productions - -- use rule "Desugar.ag"(line 189, column 23) - _lhsOallAttributes = - Map.empty - -- use rule "Desugar.ag"(line 31, column 144) - _lhsOerrors = - Seq.empty - -- self rule - _output = - [] - -- self rule - _lhsOoutput = - _output - in ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput)))) --- Rule -------------------------------------------------------- -{- - visit 0: - inherited attributes: - childInhs : [(Identifier, Identifier)] - childSyns : [(Identifier, Identifier)] - con : ConstructorIdent - defs : Set (Identifier, Identifier) - forcedIrrefutables : AttrMap - nt : NontermIdent - options : Options - synthesized attributes: - allAttributes : AttrMap - defsCollect : Set (Identifier, Identifier) - errors : Seq Error - output : SELF - alternatives: - alternative Rule: - child pattern : Pattern - child rhs : Expression - child owrt : {Bool} - child origin : {String} - visit 0: - local ruleDescr : _ - local output : _ --} --- cata -sem_Rule :: Rule -> - T_Rule -sem_Rule (Rule _pattern _rhs _owrt _origin) = - (sem_Rule_Rule (sem_Pattern _pattern) (sem_Expression _rhs) _owrt _origin) --- semantic domain -newtype T_Rule = T_Rule (([(Identifier, Identifier)]) -> - ([(Identifier, Identifier)]) -> - ConstructorIdent -> - (Set (Identifier, Identifier)) -> - AttrMap -> - NontermIdent -> - Options -> - ( AttrMap,(Set (Identifier, Identifier)),(Seq Error),Rule)) -data Inh_Rule = Inh_Rule {childInhs_Inh_Rule :: [(Identifier, Identifier)],childSyns_Inh_Rule :: [(Identifier, Identifier)],con_Inh_Rule :: ConstructorIdent,defs_Inh_Rule :: Set (Identifier, Identifier),forcedIrrefutables_Inh_Rule :: AttrMap,nt_Inh_Rule :: NontermIdent,options_Inh_Rule :: Options} -data Syn_Rule = Syn_Rule {allAttributes_Syn_Rule :: AttrMap,defsCollect_Syn_Rule :: Set (Identifier, Identifier),errors_Syn_Rule :: Seq Error,output_Syn_Rule :: Rule} -wrap_Rule (T_Rule sem) (Inh_Rule _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions) = - (let ( _lhsOallAttributes,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput) = - (sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions) - in (Syn_Rule _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput)) -sem_Rule_Rule :: T_Pattern -> - T_Expression -> - Bool -> - String -> - T_Rule -sem_Rule_Rule (T_Pattern pattern_) (T_Expression rhs_) owrt_ origin_ = - (T_Rule (\ _lhsIchildInhs - _lhsIchildSyns - _lhsIcon - _lhsIdefs - _lhsIforcedIrrefutables - _lhsInt - _lhsIoptions -> - (let _lhsOallAttributes :: AttrMap - _lhsOdefsCollect :: (Set (Identifier, Identifier)) - _lhsOerrors :: (Seq Error) - _lhsOoutput :: Rule - _patternOchildInhs :: ([(Identifier, Identifier)]) - _patternOchildSyns :: ([(Identifier, Identifier)]) - _patternOcon :: ConstructorIdent - _patternOdefs :: (Set (Identifier, Identifier)) - _patternOforcedIrrefutables :: AttrMap - _patternOnt :: NontermIdent - _rhsOchildInhs :: ([(Identifier, Identifier)]) - _rhsOchildSyns :: ([(Identifier, Identifier)]) - _rhsOcon :: ConstructorIdent - _rhsOnt :: NontermIdent - _rhsOoptions :: Options - _rhsOruleDescr :: String - _patternIallAttributes :: AttrMap - _patternIcopy :: Pattern - _patternIdefsCollect :: (Set (Identifier, Identifier)) - _patternIerrors :: (Seq Error) - _patternIoutput :: Pattern - _rhsIerrors :: (Seq Error) - _rhsIoutput :: Expression - -- "Desugar.ag"(line 165, column 7) - _ruleDescr = - show _lhsInt ++ " :: " ++ show _lhsIcon ++ " :: " ++ (concat $ intersperse "," $ map (\(f,a) -> show f ++ "." ++ show a) $ Set.toList _patternIdefsCollect) - -- use rule "Desugar.ag"(line 189, column 23) - _lhsOallAttributes = - _patternIallAttributes - -- use rule "Desugar.ag"(line 172, column 52) - _lhsOdefsCollect = - _patternIdefsCollect - -- use rule "Desugar.ag"(line 31, column 144) - _lhsOerrors = - _patternIerrors Seq.<> _rhsIerrors - -- self rule - _output = - Rule _patternIoutput _rhsIoutput owrt_ origin_ - -- self rule - _lhsOoutput = - _output - -- copy rule (down) - _patternOchildInhs = - _lhsIchildInhs - -- copy rule (down) - _patternOchildSyns = - _lhsIchildSyns - -- copy rule (down) - _patternOcon = - _lhsIcon - -- copy rule (down) - _patternOdefs = - _lhsIdefs - -- copy rule (down) - _patternOforcedIrrefutables = - _lhsIforcedIrrefutables - -- copy rule (down) - _patternOnt = - _lhsInt - -- copy rule (down) - _rhsOchildInhs = - _lhsIchildInhs - -- copy rule (down) - _rhsOchildSyns = - _lhsIchildSyns - -- copy rule (down) - _rhsOcon = - _lhsIcon - -- copy rule (down) - _rhsOnt = - _lhsInt - -- copy rule (down) - _rhsOoptions = - _lhsIoptions - -- copy rule (from local) - _rhsOruleDescr = - _ruleDescr - ( _patternIallAttributes,_patternIcopy,_patternIdefsCollect,_patternIerrors,_patternIoutput) = - (pattern_ _patternOchildInhs _patternOchildSyns _patternOcon _patternOdefs _patternOforcedIrrefutables _patternOnt) - ( _rhsIerrors,_rhsIoutput) = - (rhs_ _rhsOchildInhs _rhsOchildSyns _rhsOcon _rhsOnt _rhsOoptions _rhsOruleDescr) - in ( _lhsOallAttributes,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput)))) --- Rules ------------------------------------------------------- -{- - visit 0: - inherited attributes: - childInhs : [(Identifier, Identifier)] - childSyns : [(Identifier, Identifier)] - con : ConstructorIdent - defs : Set (Identifier, Identifier) - forcedIrrefutables : AttrMap - nt : NontermIdent - options : Options - synthesized attributes: - allAttributes : AttrMap - defsCollect : Set (Identifier, Identifier) - errors : Seq Error - output : SELF - alternatives: - alternative Cons: - child hd : Rule - child tl : Rules - visit 0: - local output : _ - alternative Nil: - visit 0: - local output : _ --} --- cata -sem_Rules :: Rules -> - T_Rules -sem_Rules list = - (Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list)) --- semantic domain -newtype T_Rules = T_Rules (([(Identifier, Identifier)]) -> - ([(Identifier, Identifier)]) -> - ConstructorIdent -> - (Set (Identifier, Identifier)) -> - AttrMap -> - NontermIdent -> - Options -> - ( AttrMap,(Set (Identifier, Identifier)),(Seq Error),Rules)) -data Inh_Rules = Inh_Rules {childInhs_Inh_Rules :: [(Identifier, Identifier)],childSyns_Inh_Rules :: [(Identifier, Identifier)],con_Inh_Rules :: ConstructorIdent,defs_Inh_Rules :: Set (Identifier, Identifier),forcedIrrefutables_Inh_Rules :: AttrMap,nt_Inh_Rules :: NontermIdent,options_Inh_Rules :: Options} -data Syn_Rules = Syn_Rules {allAttributes_Syn_Rules :: AttrMap,defsCollect_Syn_Rules :: Set (Identifier, Identifier),errors_Syn_Rules :: Seq Error,output_Syn_Rules :: Rules} -wrap_Rules (T_Rules sem) (Inh_Rules _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions) = - (let ( _lhsOallAttributes,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput) = - (sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions) - in (Syn_Rules _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput)) -sem_Rules_Cons :: T_Rule -> - T_Rules -> - T_Rules -sem_Rules_Cons (T_Rule hd_) (T_Rules tl_) = - (T_Rules (\ _lhsIchildInhs - _lhsIchildSyns - _lhsIcon - _lhsIdefs - _lhsIforcedIrrefutables - _lhsInt - _lhsIoptions -> - (let _lhsOallAttributes :: AttrMap - _lhsOdefsCollect :: (Set (Identifier, Identifier)) - _lhsOerrors :: (Seq Error) - _lhsOoutput :: Rules - _hdOchildInhs :: ([(Identifier, Identifier)]) - _hdOchildSyns :: ([(Identifier, Identifier)]) - _hdOcon :: ConstructorIdent - _hdOdefs :: (Set (Identifier, Identifier)) - _hdOforcedIrrefutables :: AttrMap - _hdOnt :: NontermIdent - _hdOoptions :: Options - _tlOchildInhs :: ([(Identifier, Identifier)]) - _tlOchildSyns :: ([(Identifier, Identifier)]) - _tlOcon :: ConstructorIdent - _tlOdefs :: (Set (Identifier, Identifier)) - _tlOforcedIrrefutables :: AttrMap - _tlOnt :: NontermIdent - _tlOoptions :: Options - _hdIallAttributes :: AttrMap - _hdIdefsCollect :: (Set (Identifier, Identifier)) - _hdIerrors :: (Seq Error) - _hdIoutput :: Rule - _tlIallAttributes :: AttrMap - _tlIdefsCollect :: (Set (Identifier, Identifier)) - _tlIerrors :: (Seq Error) - _tlIoutput :: Rules - -- use rule "Desugar.ag"(line 189, column 23) - _lhsOallAttributes = - _hdIallAttributes `mergeAttributes` _tlIallAttributes - -- use rule "Desugar.ag"(line 172, column 52) - _lhsOdefsCollect = - _hdIdefsCollect `Set.union` _tlIdefsCollect - -- use rule "Desugar.ag"(line 31, column 144) - _lhsOerrors = - _hdIerrors Seq.<> _tlIerrors - -- self rule - _output = - (:) _hdIoutput _tlIoutput - -- self rule - _lhsOoutput = - _output - -- copy rule (down) - _hdOchildInhs = - _lhsIchildInhs - -- copy rule (down) - _hdOchildSyns = - _lhsIchildSyns - -- copy rule (down) - _hdOcon = - _lhsIcon - -- copy rule (down) - _hdOdefs = - _lhsIdefs - -- copy rule (down) - _hdOforcedIrrefutables = - _lhsIforcedIrrefutables - -- copy rule (down) - _hdOnt = - _lhsInt - -- copy rule (down) - _hdOoptions = - _lhsIoptions - -- copy rule (down) - _tlOchildInhs = - _lhsIchildInhs - -- copy rule (down) - _tlOchildSyns = - _lhsIchildSyns - -- copy rule (down) - _tlOcon = - _lhsIcon - -- copy rule (down) - _tlOdefs = - _lhsIdefs - -- copy rule (down) - _tlOforcedIrrefutables = - _lhsIforcedIrrefutables - -- copy rule (down) - _tlOnt = - _lhsInt - -- copy rule (down) - _tlOoptions = - _lhsIoptions - ( _hdIallAttributes,_hdIdefsCollect,_hdIerrors,_hdIoutput) = - (hd_ _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt _hdOoptions) - ( _tlIallAttributes,_tlIdefsCollect,_tlIerrors,_tlIoutput) = - (tl_ _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt _tlOoptions) - in ( _lhsOallAttributes,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput)))) -sem_Rules_Nil :: T_Rules -sem_Rules_Nil = - (T_Rules (\ _lhsIchildInhs - _lhsIchildSyns - _lhsIcon - _lhsIdefs - _lhsIforcedIrrefutables - _lhsInt - _lhsIoptions -> - (let _lhsOallAttributes :: AttrMap - _lhsOdefsCollect :: (Set (Identifier, Identifier)) - _lhsOerrors :: (Seq Error) - _lhsOoutput :: Rules - -- use rule "Desugar.ag"(line 189, column 23) - _lhsOallAttributes = - Map.empty - -- use rule "Desugar.ag"(line 172, column 52) - _lhsOdefsCollect = - Set.empty - -- use rule "Desugar.ag"(line 31, column 144) - _lhsOerrors = - Seq.empty - -- self rule - _output = - [] - -- self rule - _lhsOoutput = - _output - in ( _lhsOallAttributes,_lhsOdefsCollect,_lhsOerrors,_lhsOoutput)))) --- TypeSig ----------------------------------------------------- -{- - visit 0: - synthesized attribute: - output : SELF - alternatives: - alternative TypeSig: - child name : {Identifier} - child tp : {Type} - visit 0: - local output : _ --} --- cata -sem_TypeSig :: TypeSig -> - T_TypeSig -sem_TypeSig (TypeSig _name _tp) = - (sem_TypeSig_TypeSig _name _tp) --- semantic domain -newtype T_TypeSig = T_TypeSig (( TypeSig)) -data Inh_TypeSig = Inh_TypeSig {} -data Syn_TypeSig = Syn_TypeSig {output_Syn_TypeSig :: TypeSig} -wrap_TypeSig (T_TypeSig sem) (Inh_TypeSig ) = - (let ( _lhsOoutput) = - (sem ) - in (Syn_TypeSig _lhsOoutput)) -sem_TypeSig_TypeSig :: Identifier -> - Type -> - T_TypeSig -sem_TypeSig_TypeSig name_ tp_ = - (T_TypeSig (let _lhsOoutput :: TypeSig - -- self rule - _output = - TypeSig name_ tp_ - -- self rule - _lhsOoutput = - _output - in ( _lhsOoutput))) --- TypeSigs ---------------------------------------------------- -{- - visit 0: - synthesized attribute: - output : SELF - alternatives: - alternative Cons: - child hd : TypeSig - child tl : TypeSigs - visit 0: - local output : _ - alternative Nil: - visit 0: - local output : _ --} --- cata -sem_TypeSigs :: TypeSigs -> - T_TypeSigs -sem_TypeSigs list = - (Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list)) --- semantic domain -newtype T_TypeSigs = T_TypeSigs (( TypeSigs)) -data Inh_TypeSigs = Inh_TypeSigs {} -data Syn_TypeSigs = Syn_TypeSigs {output_Syn_TypeSigs :: TypeSigs} -wrap_TypeSigs (T_TypeSigs sem) (Inh_TypeSigs ) = - (let ( _lhsOoutput) = - (sem ) - in (Syn_TypeSigs _lhsOoutput)) -sem_TypeSigs_Cons :: T_TypeSig -> - T_TypeSigs -> - T_TypeSigs -sem_TypeSigs_Cons (T_TypeSig hd_) (T_TypeSigs tl_) = - (T_TypeSigs (let _lhsOoutput :: TypeSigs - _hdIoutput :: TypeSig - _tlIoutput :: TypeSigs - -- self rule - _output = - (:) _hdIoutput _tlIoutput - -- self rule - _lhsOoutput = - _output - ( _hdIoutput) = - (hd_ ) - ( _tlIoutput) = - (tl_ ) - in ( _lhsOoutput))) -sem_TypeSigs_Nil :: T_TypeSigs -sem_TypeSigs_Nil = - (T_TypeSigs (let _lhsOoutput :: TypeSigs - -- self rule - _output = - [] - -- self rule - _lhsOoutput = - _output - in ( _lhsOoutput))) +{-# OPTIONS_GHC -fbang-patterns #-} +-- UUAGC 0.9.5 (Desugar.ag) +module Desugar where + +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Map(Map) +import qualified UU.DData.Seq as Seq +import UU.DData.Seq(Seq,(<>)) +import UU.Scanner.Position(Pos(..)) +import Maybe +import Data.List(intersperse) + +import AbstractSyntax +import ErrorMessages +import Options +import HsToken +import HsTokenScanner +import TokenDef + +-- AbstractSyntax.ag imports +import Data.Set(Set) +import Data.Map(Map) +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import CommonTypes + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) + +import UU.Scanner.Position(Pos) +import HsToken + +import CommonTypes +import UU.Scanner.Position(Pos) + +addl :: Int -> Pos -> Pos +addl n (Pos l c f) = Pos (l+n) c f + +maybeError :: a -> Error -> Maybe a -> (a, Seq Error) +maybeError def err mb + = maybe (def, Seq.single err) (\r -> (r, Seq.empty)) mb + +findField :: Identifier -> Identifier -> [(Identifier,Identifier)] -> Maybe Identifier +findField fld attr list + | fld == _FIRST = f list + | fld == _LAST = f (reverse list) + | otherwise = Just fld + where + f = lookup attr + +mergeAttributes :: AttrMap -> AttrMap -> AttrMap +mergeAttributes = Map.unionWith $ Map.unionWith $ Set.union +-- Child ------------------------------------------------------- +{- + visit 0: + synthesized attributes: + childInhs : [(Identifier, Identifier)] + childSyns : [(Identifier, Identifier)] + output : SELF + alternatives: + alternative Child: + child name : {Identifier} + child tp : {Type} + child inh : {Attributes} + child syn : {Attributes} + child higherOrder : {Bool} + visit 0: + local output : _ +-} +-- cata +sem_Child :: Child -> + T_Child +sem_Child !(Child _name _tp _inh _syn _higherOrder) = + (sem_Child_Child _name _tp _inh _syn _higherOrder) +-- semantic domain +newtype T_Child = T_Child (( ([(Identifier, Identifier)]),([(Identifier, Identifier)]),Child)) +data Inh_Child = Inh_Child {} +data Syn_Child = Syn_Child {childInhs_Syn_Child :: !([(Identifier, Identifier)]),childSyns_Syn_Child :: !([(Identifier, Identifier)]),output_Syn_Child :: !(Child)} +wrap_Child !(T_Child sem) !(Inh_Child ) = + (let ( !_lhsOchildInhs,!_lhsOchildSyns,!_lhsOoutput) = + (sem ) + in (Syn_Child _lhsOchildInhs _lhsOchildSyns _lhsOoutput)) +sem_Child_Child :: Identifier -> + Type -> + Attributes -> + Attributes -> + Bool -> + T_Child +sem_Child_Child !name_ !tp_ !inh_ !syn_ !higherOrder_ = + (T_Child (case ([(i, name_) | i <- Map.keys inh_ ]) of + { !_lhsOchildInhs -> + (case ([(s, name_) | s <- Map.keys syn_ ]) of + { !_lhsOchildSyns -> + (case (Child name_ tp_ inh_ syn_ higherOrder_) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput) }) }) }) })) +-- Children ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + childInhs : [(Identifier, Identifier)] + childSyns : [(Identifier, Identifier)] + output : SELF + alternatives: + alternative Cons: + child hd : Child + child tl : Children + visit 0: + local output : _ + alternative Nil: + visit 0: + local output : _ +-} +-- cata +sem_Children :: Children -> + T_Children +sem_Children !list = + (Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list)) +-- semantic domain +newtype T_Children = T_Children (( ([(Identifier, Identifier)]),([(Identifier, Identifier)]),Children)) +data Inh_Children = Inh_Children {} +data Syn_Children = Syn_Children {childInhs_Syn_Children :: !([(Identifier, Identifier)]),childSyns_Syn_Children :: !([(Identifier, Identifier)]),output_Syn_Children :: !(Children)} +wrap_Children !(T_Children sem) !(Inh_Children ) = + (let ( !_lhsOchildInhs,!_lhsOchildSyns,!_lhsOoutput) = + (sem ) + in (Syn_Children _lhsOchildInhs _lhsOchildSyns _lhsOoutput)) +sem_Children_Cons :: T_Child -> + T_Children -> + T_Children +sem_Children_Cons !(T_Child hd_) !(T_Children tl_) = + (T_Children (case ((tl_ )) of + { ( !_tlIchildInhs,!_tlIchildSyns,!_tlIoutput) -> + (case ((hd_ )) of + { ( !_hdIchildInhs,!_hdIchildSyns,!_hdIoutput) -> + (case (_hdIchildInhs ++ _tlIchildInhs) of + { !_lhsOchildInhs -> + (case (_hdIchildSyns ++ _tlIchildSyns) of + { !_lhsOchildSyns -> + (case ((:) _hdIoutput _tlIoutput) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput) }) }) }) }) }) })) +sem_Children_Nil :: T_Children +sem_Children_Nil = + (T_Children (case ([]) of + { !_lhsOchildInhs -> + (case ([]) of + { !_lhsOchildSyns -> + (case ([]) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput) }) }) }) })) +-- Expression -------------------------------------------------- +{- + visit 0: + inherited attributes: + childInhs : [(Identifier, Identifier)] + childSyns : [(Identifier, Identifier)] + con : ConstructorIdent + nt : NontermIdent + options : Options + ruleDescr : String + synthesized attributes: + errors : Seq Error + output : SELF + alternatives: + alternative Expression: + child pos : {Pos} + child tks : {[HsToken]} + visit 0: + local _tup1 : _ + local tks' : _ +-} +-- cata +sem_Expression :: Expression -> + T_Expression +sem_Expression !(Expression _pos _tks) = + (sem_Expression_Expression _pos _tks) +-- semantic domain +newtype T_Expression = T_Expression (([(Identifier, Identifier)]) -> + ([(Identifier, Identifier)]) -> + ConstructorIdent -> + NontermIdent -> + Options -> + String -> + ( (Seq Error),Expression)) +data Inh_Expression = Inh_Expression {childInhs_Inh_Expression :: !([(Identifier, Identifier)]),childSyns_Inh_Expression :: !([(Identifier, Identifier)]),con_Inh_Expression :: !(ConstructorIdent),nt_Inh_Expression :: !(NontermIdent),options_Inh_Expression :: !(Options),ruleDescr_Inh_Expression :: !(String)} +data Syn_Expression = Syn_Expression {errors_Syn_Expression :: !(Seq Error),output_Syn_Expression :: !(Expression)} +wrap_Expression !(T_Expression sem) !(Inh_Expression _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIoptions _lhsIruleDescr) = + (let ( !_lhsOerrors,!_lhsOoutput) = + (sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIoptions _lhsIruleDescr) + in (Syn_Expression _lhsOerrors _lhsOoutput)) +sem_Expression_Expression :: Pos -> + ([HsToken]) -> + T_Expression +sem_Expression_Expression !pos_ !tks_ = + (T_Expression (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsInt) + (!_lhsIoptions) + (!_lhsIruleDescr) -> + (case (let inh = Inh_HsTokensRoot { childInhs_Inh_HsTokensRoot = _lhsIchildInhs + , childSyns_Inh_HsTokensRoot = _lhsIchildSyns + , nt_Inh_HsTokensRoot = _lhsInt + , con_Inh_HsTokensRoot = _lhsIcon + , ruleDescr_Inh_HsTokensRoot = _lhsIruleDescr + , useFieldIdent_Inh_HsTokensRoot = genUseTraces _lhsIoptions + } + sem = sem_HsTokensRoot (HsTokensRoot tks_) + syn = wrap_HsTokensRoot sem inh + in (tks_Syn_HsTokensRoot syn, errors_Syn_HsTokensRoot syn)) of + { !__tup1 -> + (case (__tup1) of + { !(_,!_lhsOerrors) -> + (case (__tup1) of + { !(!_tks',_) -> + (case (Expression pos_ _tks') of + { !_lhsOoutput -> + ( _lhsOerrors,_lhsOoutput) }) }) }) }))) +-- Grammar ----------------------------------------------------- +{- + visit 0: + inherited attributes: + forcedIrrefutables : AttrMap + options : Options + synthesized attributes: + allAttributes : AttrMap + errors : Seq Error + output : SELF + alternatives: + alternative Grammar: + child typeSyns : {TypeSyns} + child useMap : {UseMap} + child derivings : {Derivings} + child wrappers : {Set NontermIdent} + child nonts : Nonterminals + child pragmas : {PragmaMap} + child manualAttrOrderMap : {AttrOrderMap} + child paramMap : {ParamMap} + child contextMap : {ContextMap} + child uniqueMap : {UniqueMap} + visit 0: + local output : _ +-} +-- cata +sem_Grammar :: Grammar -> + T_Grammar +sem_Grammar !(Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap) = + (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts) _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap) +-- semantic domain +newtype T_Grammar = T_Grammar (AttrMap -> + Options -> + ( AttrMap,(Seq Error),Grammar)) +data Inh_Grammar = Inh_Grammar {forcedIrrefutables_Inh_Grammar :: !(AttrMap),options_Inh_Grammar :: !(Options)} +data Syn_Grammar = Syn_Grammar {allAttributes_Syn_Grammar :: !(AttrMap),errors_Syn_Grammar :: !(Seq Error),output_Syn_Grammar :: !(Grammar)} +wrap_Grammar !(T_Grammar sem) !(Inh_Grammar _lhsIforcedIrrefutables _lhsIoptions) = + (let ( !_lhsOallAttributes,!_lhsOerrors,!_lhsOoutput) = + (sem _lhsIforcedIrrefutables _lhsIoptions) + in (Syn_Grammar _lhsOallAttributes _lhsOerrors _lhsOoutput)) +sem_Grammar_Grammar :: TypeSyns -> + UseMap -> + Derivings -> + (Set NontermIdent) -> + T_Nonterminals -> + PragmaMap -> + AttrOrderMap -> + ParamMap -> + ContextMap -> + UniqueMap -> + T_Grammar +sem_Grammar_Grammar !typeSyns_ !useMap_ !derivings_ !wrappers_ !(T_Nonterminals nonts_) !pragmas_ !manualAttrOrderMap_ !paramMap_ !contextMap_ !uniqueMap_ = + (T_Grammar (\ (!_lhsIforcedIrrefutables) + (!_lhsIoptions) -> + (case (_lhsIoptions) of + { !_nontsOoptions -> + (case (_lhsIforcedIrrefutables) of + { !_nontsOforcedIrrefutables -> + (case ((nonts_ _nontsOforcedIrrefutables _nontsOoptions)) of + { ( !_nontsIallAttributes,!_nontsIerrors,!_nontsIoutput) -> + (case (_nontsIallAttributes) of + { !_lhsOallAttributes -> + (case (_nontsIerrors) of + { !_lhsOerrors -> + (case (Grammar typeSyns_ useMap_ derivings_ wrappers_ _nontsIoutput pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ uniqueMap_) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }))) +-- HsToken ----------------------------------------------------- +{- + visit 0: + inherited attributes: + childInhs : [(Identifier, Identifier)] + childSyns : [(Identifier, Identifier)] + con : ConstructorIdent + nt : NontermIdent + ruleDescr : String + useFieldIdent : Bool + chained attribute: + addLines : Int + synthesized attributes: + errors : Seq Error + tks : SELF + alternatives: + alternative AGField: + child field : {Identifier} + child attr : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + visit 0: + local mField : _ + local field' : _ + local tks : _ + alternative AGLocal: + child var : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + visit 0: + local tks : _ + alternative CharToken: + child value : {String} + child pos : {Pos} + visit 0: + local tks : _ + alternative Err: + child mesg : {String} + child pos : {Pos} + visit 0: + local tks : _ + alternative HsToken: + child value : {String} + child pos : {Pos} + visit 0: + local tks : _ + alternative StrToken: + child value : {String} + child pos : {Pos} + visit 0: + local tks : _ +-} +-- cata +sem_HsToken :: HsToken -> + T_HsToken +sem_HsToken !(AGField _field _attr _pos _rdesc) = + (sem_HsToken_AGField _field _attr _pos _rdesc) +sem_HsToken !(AGLocal _var _pos _rdesc) = + (sem_HsToken_AGLocal _var _pos _rdesc) +sem_HsToken !(CharToken _value _pos) = + (sem_HsToken_CharToken _value _pos) +sem_HsToken !(Err _mesg _pos) = + (sem_HsToken_Err _mesg _pos) +sem_HsToken !(HsToken _value _pos) = + (sem_HsToken_HsToken _value _pos) +sem_HsToken !(StrToken _value _pos) = + (sem_HsToken_StrToken _value _pos) +-- semantic domain +newtype T_HsToken = T_HsToken (Int -> + ([(Identifier, Identifier)]) -> + ([(Identifier, Identifier)]) -> + ConstructorIdent -> + NontermIdent -> + String -> + Bool -> + ( Int,(Seq Error),HsToken)) +data Inh_HsToken = Inh_HsToken {addLines_Inh_HsToken :: !(Int),childInhs_Inh_HsToken :: !([(Identifier, Identifier)]),childSyns_Inh_HsToken :: !([(Identifier, Identifier)]),con_Inh_HsToken :: !(ConstructorIdent),nt_Inh_HsToken :: !(NontermIdent),ruleDescr_Inh_HsToken :: !(String),useFieldIdent_Inh_HsToken :: !(Bool)} +data Syn_HsToken = Syn_HsToken {addLines_Syn_HsToken :: !(Int),errors_Syn_HsToken :: !(Seq Error),tks_Syn_HsToken :: !(HsToken)} +wrap_HsToken !(T_HsToken sem) !(Inh_HsToken _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) = + (let ( !_lhsOaddLines,!_lhsOerrors,!_lhsOtks) = + (sem _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) + in (Syn_HsToken _lhsOaddLines _lhsOerrors _lhsOtks)) +sem_HsToken_AGField :: Identifier -> + Identifier -> + Pos -> + (Maybe String) -> + T_HsToken +sem_HsToken_AGField !field_ !attr_ !pos_ !rdesc_ = + (T_HsToken (\ (!_lhsIaddLines) + (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsInt) + (!_lhsIruleDescr) + (!_lhsIuseFieldIdent) -> + (case (findField field_ attr_ _lhsIchildSyns) of + { !_mField -> + (case (maybe field_ id _mField) of + { !_field' -> + (case (if _lhsIuseFieldIdent || length (getName field_) < length (getName _field' ) + then _lhsIaddLines + 1 + else _lhsIaddLines) of + { !_lhsOaddLines -> + (case (maybe (Seq.single (UndefAttr _lhsInt _lhsIcon field_ (Ident "" (getPos field_)) False)) (const Seq.empty) _mField) of + { !_lhsOerrors -> + (case (AGField _field' attr_ (addl _lhsIaddLines pos_) (if _lhsIuseFieldIdent then Just _lhsIruleDescr else Nothing)) of + { !_tks -> + (case (_tks) of + { !_lhsOtks -> + ( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) }) }) }))) +sem_HsToken_AGLocal :: Identifier -> + Pos -> + (Maybe String) -> + T_HsToken +sem_HsToken_AGLocal !var_ !pos_ !rdesc_ = + (T_HsToken (\ (!_lhsIaddLines) + (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsInt) + (!_lhsIruleDescr) + (!_lhsIuseFieldIdent) -> + (case (if _lhsIuseFieldIdent + then _lhsIaddLines + 1 + else _lhsIaddLines) of + { !_lhsOaddLines -> + (case (Seq.empty) of + { !_lhsOerrors -> + (case (AGLocal var_ (addl _lhsIaddLines pos_) (if _lhsIuseFieldIdent then Just _lhsIruleDescr else Nothing)) of + { !_tks -> + (case (_tks) of + { !_lhsOtks -> + ( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) }))) +sem_HsToken_CharToken :: String -> + Pos -> + T_HsToken +sem_HsToken_CharToken !value_ !pos_ = + (T_HsToken (\ (!_lhsIaddLines) + (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsInt) + (!_lhsIruleDescr) + (!_lhsIuseFieldIdent) -> + (case (_lhsIaddLines) of + { !_lhsOaddLines -> + (case (Seq.empty) of + { !_lhsOerrors -> + (case (CharToken value_ (addl _lhsIaddLines pos_)) of + { !_tks -> + (case (_tks) of + { !_lhsOtks -> + ( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) }))) +sem_HsToken_Err :: String -> + Pos -> + T_HsToken +sem_HsToken_Err !mesg_ !pos_ = + (T_HsToken (\ (!_lhsIaddLines) + (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsInt) + (!_lhsIruleDescr) + (!_lhsIuseFieldIdent) -> + (case (_lhsIaddLines) of + { !_lhsOaddLines -> + (case (Seq.empty) of + { !_lhsOerrors -> + (case (Err mesg_ (addl _lhsIaddLines pos_)) of + { !_tks -> + (case (_tks) of + { !_lhsOtks -> + ( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) }))) +sem_HsToken_HsToken :: String -> + Pos -> + T_HsToken +sem_HsToken_HsToken !value_ !pos_ = + (T_HsToken (\ (!_lhsIaddLines) + (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsInt) + (!_lhsIruleDescr) + (!_lhsIuseFieldIdent) -> + (case (_lhsIaddLines) of + { !_lhsOaddLines -> + (case (Seq.empty) of + { !_lhsOerrors -> + (case (HsToken value_ (addl _lhsIaddLines pos_)) of + { !_tks -> + (case (_tks) of + { !_lhsOtks -> + ( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) }))) +sem_HsToken_StrToken :: String -> + Pos -> + T_HsToken +sem_HsToken_StrToken !value_ !pos_ = + (T_HsToken (\ (!_lhsIaddLines) + (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsInt) + (!_lhsIruleDescr) + (!_lhsIuseFieldIdent) -> + (case (_lhsIaddLines) of + { !_lhsOaddLines -> + (case (Seq.empty) of + { !_lhsOerrors -> + (case (StrToken value_ (addl _lhsIaddLines pos_)) of + { !_tks -> + (case (_tks) of + { !_lhsOtks -> + ( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) }))) +-- HsTokens ---------------------------------------------------- +{- + visit 0: + inherited attributes: + childInhs : [(Identifier, Identifier)] + childSyns : [(Identifier, Identifier)] + con : ConstructorIdent + nt : NontermIdent + ruleDescr : String + useFieldIdent : Bool + chained attribute: + addLines : Int + synthesized attributes: + errors : Seq Error + tks : SELF + alternatives: + alternative Cons: + child hd : HsToken + child tl : HsTokens + visit 0: + local tks : _ + alternative Nil: + visit 0: + local tks : _ +-} +-- cata +sem_HsTokens :: HsTokens -> + T_HsTokens +sem_HsTokens !list = + (Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list)) +-- semantic domain +newtype T_HsTokens = T_HsTokens (Int -> + ([(Identifier, Identifier)]) -> + ([(Identifier, Identifier)]) -> + ConstructorIdent -> + NontermIdent -> + String -> + Bool -> + ( Int,(Seq Error),HsTokens)) +data Inh_HsTokens = Inh_HsTokens {addLines_Inh_HsTokens :: !(Int),childInhs_Inh_HsTokens :: !([(Identifier, Identifier)]),childSyns_Inh_HsTokens :: !([(Identifier, Identifier)]),con_Inh_HsTokens :: !(ConstructorIdent),nt_Inh_HsTokens :: !(NontermIdent),ruleDescr_Inh_HsTokens :: !(String),useFieldIdent_Inh_HsTokens :: !(Bool)} +data Syn_HsTokens = Syn_HsTokens {addLines_Syn_HsTokens :: !(Int),errors_Syn_HsTokens :: !(Seq Error),tks_Syn_HsTokens :: !(HsTokens)} +wrap_HsTokens !(T_HsTokens sem) !(Inh_HsTokens _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) = + (let ( !_lhsOaddLines,!_lhsOerrors,!_lhsOtks) = + (sem _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) + in (Syn_HsTokens _lhsOaddLines _lhsOerrors _lhsOtks)) +sem_HsTokens_Cons :: T_HsToken -> + T_HsTokens -> + T_HsTokens +sem_HsTokens_Cons !(T_HsToken hd_) !(T_HsTokens tl_) = + (T_HsTokens (\ (!_lhsIaddLines) + (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsInt) + (!_lhsIruleDescr) + (!_lhsIuseFieldIdent) -> + (case (_lhsIuseFieldIdent) of + { !_tlOuseFieldIdent -> + (case (_lhsIchildSyns) of + { !_tlOchildSyns -> + (case (_lhsIuseFieldIdent) of + { !_hdOuseFieldIdent -> + (case (_lhsIchildSyns) of + { !_hdOchildSyns -> + (case (_lhsIaddLines) of + { !_hdOaddLines -> + (case (_lhsIruleDescr) of + { !_hdOruleDescr -> + (case (_lhsInt) of + { !_hdOnt -> + (case (_lhsIcon) of + { !_hdOcon -> + (case (_lhsIchildInhs) of + { !_hdOchildInhs -> + (case ((hd_ _hdOaddLines _hdOchildInhs _hdOchildSyns _hdOcon _hdOnt _hdOruleDescr _hdOuseFieldIdent)) of + { ( !_hdIaddLines,!_hdIerrors,!_hdItks) -> + (case (_hdIaddLines) of + { !_tlOaddLines -> + (case (_lhsIruleDescr) of + { !_tlOruleDescr -> + (case (_lhsInt) of + { !_tlOnt -> + (case (_lhsIcon) of + { !_tlOcon -> + (case (_lhsIchildInhs) of + { !_tlOchildInhs -> + (case ((tl_ _tlOaddLines _tlOchildInhs _tlOchildSyns _tlOcon _tlOnt _tlOruleDescr _tlOuseFieldIdent)) of + { ( !_tlIaddLines,!_tlIerrors,!_tlItks) -> + (case (_tlIaddLines) of + { !_lhsOaddLines -> + (case (_hdIerrors Seq.<> _tlIerrors) of + { !_lhsOerrors -> + (case ((:) _hdItks _tlItks) of + { !_tks -> + (case (_tks) of + { !_lhsOtks -> + ( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_HsTokens_Nil :: T_HsTokens +sem_HsTokens_Nil = + (T_HsTokens (\ (!_lhsIaddLines) + (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsInt) + (!_lhsIruleDescr) + (!_lhsIuseFieldIdent) -> + (case (_lhsIaddLines) of + { !_lhsOaddLines -> + (case (Seq.empty) of + { !_lhsOerrors -> + (case ([]) of + { !_tks -> + (case (_tks) of + { !_lhsOtks -> + ( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) }))) +-- HsTokensRoot ------------------------------------------------ +{- + visit 0: + inherited attributes: + childInhs : [(Identifier, Identifier)] + childSyns : [(Identifier, Identifier)] + con : ConstructorIdent + nt : NontermIdent + ruleDescr : String + useFieldIdent : Bool + synthesized attributes: + errors : Seq Error + tks : [HsToken] + alternatives: + alternative HsTokensRoot: + child tokens : HsTokens +-} +-- cata +sem_HsTokensRoot :: HsTokensRoot -> + T_HsTokensRoot +sem_HsTokensRoot !(HsTokensRoot _tokens) = + (sem_HsTokensRoot_HsTokensRoot (sem_HsTokens _tokens)) +-- semantic domain +newtype T_HsTokensRoot = T_HsTokensRoot (([(Identifier, Identifier)]) -> + ([(Identifier, Identifier)]) -> + ConstructorIdent -> + NontermIdent -> + String -> + Bool -> + ( (Seq Error),([HsToken]))) +data Inh_HsTokensRoot = Inh_HsTokensRoot {childInhs_Inh_HsTokensRoot :: !([(Identifier, Identifier)]),childSyns_Inh_HsTokensRoot :: !([(Identifier, Identifier)]),con_Inh_HsTokensRoot :: !(ConstructorIdent),nt_Inh_HsTokensRoot :: !(NontermIdent),ruleDescr_Inh_HsTokensRoot :: !(String),useFieldIdent_Inh_HsTokensRoot :: !(Bool)} +data Syn_HsTokensRoot = Syn_HsTokensRoot {errors_Syn_HsTokensRoot :: !(Seq Error),tks_Syn_HsTokensRoot :: !([HsToken])} +wrap_HsTokensRoot !(T_HsTokensRoot sem) !(Inh_HsTokensRoot _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) = + (let ( !_lhsOerrors,!_lhsOtks) = + (sem _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) + in (Syn_HsTokensRoot _lhsOerrors _lhsOtks)) +sem_HsTokensRoot_HsTokensRoot :: T_HsTokens -> + T_HsTokensRoot +sem_HsTokensRoot_HsTokensRoot !(T_HsTokens tokens_) = + (T_HsTokensRoot (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsInt) + (!_lhsIruleDescr) + (!_lhsIuseFieldIdent) -> + (case (_lhsInt) of + { !_tokensOnt -> + (case (_lhsIcon) of + { !_tokensOcon -> + (case (_lhsIchildSyns) of + { !_tokensOchildSyns -> + (case (_lhsIuseFieldIdent) of + { !_tokensOuseFieldIdent -> + (case (_lhsIruleDescr) of + { !_tokensOruleDescr -> + (case (_lhsIchildInhs) of + { !_tokensOchildInhs -> + (case (0) of + { !_tokensOaddLines -> + (case ((tokens_ _tokensOaddLines _tokensOchildInhs _tokensOchildSyns _tokensOcon _tokensOnt _tokensOruleDescr _tokensOuseFieldIdent)) of + { ( !_tokensIaddLines,!_tokensIerrors,!_tokensItks) -> + (case (_tokensIerrors) of + { !_lhsOerrors -> + (case (_tokensItks) of + { !_lhsOtks -> + ( _lhsOerrors,_lhsOtks) }) }) }) }) }) }) }) }) }) }))) +-- Nonterminal ------------------------------------------------- +{- + visit 0: + inherited attributes: + forcedIrrefutables : AttrMap + options : Options + synthesized attributes: + allAttributes : AttrMap + errors : Seq Error + output : SELF + alternatives: + alternative Nonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child inh : {Attributes} + child syn : {Attributes} + child prods : Productions + visit 0: + local output : _ +-} +-- cata +sem_Nonterminal :: Nonterminal -> + T_Nonterminal +sem_Nonterminal !(Nonterminal _nt _params _inh _syn _prods) = + (sem_Nonterminal_Nonterminal _nt _params _inh _syn (sem_Productions _prods)) +-- semantic domain +newtype T_Nonterminal = T_Nonterminal (AttrMap -> + Options -> + ( AttrMap,(Seq Error),Nonterminal)) +data Inh_Nonterminal = Inh_Nonterminal {forcedIrrefutables_Inh_Nonterminal :: !(AttrMap),options_Inh_Nonterminal :: !(Options)} +data Syn_Nonterminal = Syn_Nonterminal {allAttributes_Syn_Nonterminal :: !(AttrMap),errors_Syn_Nonterminal :: !(Seq Error),output_Syn_Nonterminal :: !(Nonterminal)} +wrap_Nonterminal !(T_Nonterminal sem) !(Inh_Nonterminal _lhsIforcedIrrefutables _lhsIoptions) = + (let ( !_lhsOallAttributes,!_lhsOerrors,!_lhsOoutput) = + (sem _lhsIforcedIrrefutables _lhsIoptions) + in (Syn_Nonterminal _lhsOallAttributes _lhsOerrors _lhsOoutput)) +sem_Nonterminal_Nonterminal :: NontermIdent -> + ([Identifier]) -> + Attributes -> + Attributes -> + T_Productions -> + T_Nonterminal +sem_Nonterminal_Nonterminal !nt_ !params_ !inh_ !syn_ !(T_Productions prods_) = + (T_Nonterminal (\ (!_lhsIforcedIrrefutables) + (!_lhsIoptions) -> + (case (nt_) of + { !_prodsOnt -> + (case (_lhsIoptions) of + { !_prodsOoptions -> + (case (_lhsIforcedIrrefutables) of + { !_prodsOforcedIrrefutables -> + (case ((prods_ _prodsOforcedIrrefutables _prodsOnt _prodsOoptions)) of + { ( !_prodsIallAttributes,!_prodsIerrors,!_prodsIoutput) -> + (case (_prodsIallAttributes) of + { !_lhsOallAttributes -> + (case (_prodsIerrors) of + { !_lhsOerrors -> + (case (Nonterminal nt_ params_ inh_ syn_ _prodsIoutput) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }))) +-- Nonterminals ------------------------------------------------ +{- + visit 0: + inherited attributes: + forcedIrrefutables : AttrMap + options : Options + synthesized attributes: + allAttributes : AttrMap + errors : Seq Error + output : SELF + alternatives: + alternative Cons: + child hd : Nonterminal + child tl : Nonterminals + visit 0: + local output : _ + alternative Nil: + visit 0: + local output : _ +-} +-- cata +sem_Nonterminals :: Nonterminals -> + T_Nonterminals +sem_Nonterminals !list = + (Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list)) +-- semantic domain +newtype T_Nonterminals = T_Nonterminals (AttrMap -> + Options -> + ( AttrMap,(Seq Error),Nonterminals)) +data Inh_Nonterminals = Inh_Nonterminals {forcedIrrefutables_Inh_Nonterminals :: !(AttrMap),options_Inh_Nonterminals :: !(Options)} +data Syn_Nonterminals = Syn_Nonterminals {allAttributes_Syn_Nonterminals :: !(AttrMap),errors_Syn_Nonterminals :: !(Seq Error),output_Syn_Nonterminals :: !(Nonterminals)} +wrap_Nonterminals !(T_Nonterminals sem) !(Inh_Nonterminals _lhsIforcedIrrefutables _lhsIoptions) = + (let ( !_lhsOallAttributes,!_lhsOerrors,!_lhsOoutput) = + (sem _lhsIforcedIrrefutables _lhsIoptions) + in (Syn_Nonterminals _lhsOallAttributes _lhsOerrors _lhsOoutput)) +sem_Nonterminals_Cons :: T_Nonterminal -> + T_Nonterminals -> + T_Nonterminals +sem_Nonterminals_Cons !(T_Nonterminal hd_) !(T_Nonterminals tl_) = + (T_Nonterminals (\ (!_lhsIforcedIrrefutables) + (!_lhsIoptions) -> + (case (_lhsIoptions) of + { !_tlOoptions -> + (case (_lhsIforcedIrrefutables) of + { !_tlOforcedIrrefutables -> + (case ((tl_ _tlOforcedIrrefutables _tlOoptions)) of + { ( !_tlIallAttributes,!_tlIerrors,!_tlIoutput) -> + (case (_lhsIoptions) of + { !_hdOoptions -> + (case (_lhsIforcedIrrefutables) of + { !_hdOforcedIrrefutables -> + (case ((hd_ _hdOforcedIrrefutables _hdOoptions)) of + { ( !_hdIallAttributes,!_hdIerrors,!_hdIoutput) -> + (case (_hdIallAttributes `mergeAttributes` _tlIallAttributes) of + { !_lhsOallAttributes -> + (case (_hdIerrors Seq.<> _tlIerrors) of + { !_lhsOerrors -> + (case ((:) _hdIoutput _tlIoutput) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }))) +sem_Nonterminals_Nil :: T_Nonterminals +sem_Nonterminals_Nil = + (T_Nonterminals (\ (!_lhsIforcedIrrefutables) + (!_lhsIoptions) -> + (case (Map.empty) of + { !_lhsOallAttributes -> + (case (Seq.empty) of + { !_lhsOerrors -> + (case ([]) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) }))) +-- Pattern ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + defsCollect : Set (Identifier, Identifier) + visit 1: + inherited attributes: + childInhs : [(Identifier, Identifier)] + childSyns : [(Identifier, Identifier)] + con : ConstructorIdent + defs : Set (Identifier, Identifier) + forcedIrrefutables : AttrMap + nt : NontermIdent + synthesized attributes: + allAttributes : AttrMap + copy : SELF + errors : Seq Error + output : SELF + alternatives: + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + child parts : Patterns + visit 0: + local def : _ + visit 1: + local copy : _ + local _tup2 : _ + local field' : _ + local err2 : _ + local err1 : _ + local output : _ + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 1: + local copy : _ + local output : _ + alternative Irrefutable: + child pat : Pattern + visit 1: + local copy : _ + local output : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 1: + local copy : _ + local output : _ + alternative Underscore: + child pos : {Pos} + visit 1: + local copy : _ + local output : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern !(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 (( (Set (Identifier, Identifier)),T_Pattern_1)) +newtype T_Pattern_1 = T_Pattern_1 (([(Identifier, Identifier)]) -> + ([(Identifier, Identifier)]) -> + ConstructorIdent -> + (Set (Identifier, Identifier)) -> + AttrMap -> + NontermIdent -> + ( AttrMap,Pattern,(Seq Error),Pattern)) +data Inh_Pattern = Inh_Pattern {childInhs_Inh_Pattern :: !([(Identifier, Identifier)]),childSyns_Inh_Pattern :: !([(Identifier, Identifier)]),con_Inh_Pattern :: !(ConstructorIdent),defs_Inh_Pattern :: !(Set (Identifier, Identifier)),forcedIrrefutables_Inh_Pattern :: !(AttrMap),nt_Inh_Pattern :: !(NontermIdent)} +data Syn_Pattern = Syn_Pattern {allAttributes_Syn_Pattern :: !(AttrMap),copy_Syn_Pattern :: !(Pattern),defsCollect_Syn_Pattern :: !(Set (Identifier, Identifier)),errors_Syn_Pattern :: !(Seq Error),output_Syn_Pattern :: !(Pattern)} +wrap_Pattern !(T_Pattern sem) !(Inh_Pattern _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) = + (let ( !_lhsOdefsCollect,!T_Pattern_1 sem_1) = + (sem ) + ( !_lhsOallAttributes,!_lhsOcopy,!_lhsOerrors,!_lhsOoutput) = + (sem_1 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) + in (Syn_Pattern _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput)) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Patterns -> + T_Pattern +sem_Pattern_Alias !field_ !attr_ !(T_Pattern pat_) !(T_Patterns parts_) = + (T_Pattern (case (Set.singleton (field_, attr_)) of + { !_def -> + (case ((parts_ )) of + { ( !_partsIdefsCollect,!T_Patterns_1 parts_1) -> + (case ((pat_ )) of + { ( !_patIdefsCollect,!T_Pattern_1 pat_1) -> + (case (_def `Set.union` _patIdefsCollect `Set.union` _partsIdefsCollect) of + { !_lhsOdefsCollect -> + (case ((sem_Pattern_Alias_1 (T_Pattern_1 pat_1) attr_ field_ (T_Patterns_1 parts_1))) of + { ( !sem_Pattern_1) -> + ( _lhsOdefsCollect,sem_Pattern_1) }) }) }) }) })) +sem_Pattern_Alias_1 :: T_Pattern_1 -> + Identifier -> + Identifier -> + T_Patterns_1 -> + T_Pattern_1 +sem_Pattern_Alias_1 !(T_Pattern_1 pat_1) !attr_ !field_ !(T_Patterns_1 parts_1) = + (T_Pattern_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) -> + (case (_lhsInt) of + { !_patOnt -> + (case (_lhsIcon) of + { !_patOcon -> + (case (_lhsIforcedIrrefutables) of + { !_patOforcedIrrefutables -> + (case (_lhsIdefs) of + { !_patOdefs -> + (case (_lhsIchildSyns) of + { !_patOchildSyns -> + (case (_lhsIchildInhs) of + { !_patOchildInhs -> + (case ((pat_1 _patOchildInhs _patOchildSyns _patOcon _patOdefs _patOforcedIrrefutables _patOnt)) of + { ( !_patIallAttributes,!_patIcopy,!_patIerrors,!_patIoutput) -> + (case ((Map.singleton _lhsInt $ Map.singleton _lhsIcon $ Set.singleton (field_, attr_)) `mergeAttributes` _patIallAttributes) of + { !_lhsOallAttributes -> + (case (_lhsInt) of + { !_partsOnt -> + (case (_lhsIforcedIrrefutables) of + { !_partsOforcedIrrefutables -> + (case (_lhsIdefs) of + { !_partsOdefs -> + (case (_lhsIcon) of + { !_partsOcon -> + (case (_lhsIchildSyns) of + { !_partsOchildSyns -> + (case (_lhsIchildInhs) of + { !_partsOchildInhs -> + (case ((parts_1 _partsOchildInhs _partsOchildSyns _partsOcon _partsOdefs _partsOforcedIrrefutables _partsOnt)) of + { ( !_partsIallAttributes,!_partsIcopy,!_partsIerrors,!_partsIoutput) -> + (case (Alias field_ attr_ _patIcopy _partsIcopy) of + { !_copy -> + (case (_copy) of + { !_lhsOcopy -> + (case (maybeError field_ (UndefAttr _lhsInt _lhsIcon (Ident "" (getPos field_)) attr_ True) $ + findField field_ attr_ _lhsIchildInhs) of + { !__tup2 -> + (case (__tup2) of + { !(!_field',_) -> + (case (if _field' == field_ + then Seq.empty + else if (_field' , attr_) `Set.member` _lhsIdefs + then Seq.single $ DupRule _lhsInt _lhsIcon field_ attr_ _field' + else Seq.empty) of + { !_err2 -> + (case (__tup2) of + { !(_,!_err1) -> + (case (_err1 Seq.<> _err2 Seq.<> _patIerrors <> _partsIerrors) of + { !_lhsOerrors -> + (case (Alias _field' attr_ _patIoutput _partsIoutput) of + { !_output -> + (case (if Set.member (field_, attr_) $ Map.findWithDefault Set.empty _lhsIcon $ Map.findWithDefault Map.empty _lhsInt $ _lhsIforcedIrrefutables + then Irrefutable _output + else _output) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr !name_ !(T_Patterns pats_) = + (T_Pattern (case ((pats_ )) of + { ( !_patsIdefsCollect,!T_Patterns_1 pats_1) -> + (case (_patsIdefsCollect) of + { !_lhsOdefsCollect -> + (case ((sem_Pattern_Constr_1 (T_Patterns_1 pats_1) name_)) of + { ( !sem_Pattern_1) -> + ( _lhsOdefsCollect,sem_Pattern_1) }) }) })) +sem_Pattern_Constr_1 :: T_Patterns_1 -> + ConstructorIdent -> + T_Pattern_1 +sem_Pattern_Constr_1 !(T_Patterns_1 pats_1) !name_ = + (T_Pattern_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) -> + (case (_lhsInt) of + { !_patsOnt -> + (case (_lhsIcon) of + { !_patsOcon -> + (case (_lhsIforcedIrrefutables) of + { !_patsOforcedIrrefutables -> + (case (_lhsIdefs) of + { !_patsOdefs -> + (case (_lhsIchildSyns) of + { !_patsOchildSyns -> + (case (_lhsIchildInhs) of + { !_patsOchildInhs -> + (case ((pats_1 _patsOchildInhs _patsOchildSyns _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt)) of + { ( !_patsIallAttributes,!_patsIcopy,!_patsIerrors,!_patsIoutput) -> + (case (_patsIallAttributes) of + { !_lhsOallAttributes -> + (case (Constr name_ _patsIcopy) of + { !_copy -> + (case (_copy) of + { !_lhsOcopy -> + (case (_patsIerrors) of + { !_lhsOerrors -> + (case (Constr name_ _patsIoutput) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable !(T_Pattern pat_) = + (T_Pattern (case ((pat_ )) of + { ( !_patIdefsCollect,!T_Pattern_1 pat_1) -> + (case (_patIdefsCollect) of + { !_lhsOdefsCollect -> + (case ((sem_Pattern_Irrefutable_1 (T_Pattern_1 pat_1))) of + { ( !sem_Pattern_1) -> + ( _lhsOdefsCollect,sem_Pattern_1) }) }) })) +sem_Pattern_Irrefutable_1 :: T_Pattern_1 -> + T_Pattern_1 +sem_Pattern_Irrefutable_1 !(T_Pattern_1 pat_1) = + (T_Pattern_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) -> + (case (Map.empty) of + { !_lhsOallAttributes -> + (case (_lhsInt) of + { !_patOnt -> + (case (_lhsIforcedIrrefutables) of + { !_patOforcedIrrefutables -> + (case (_lhsIdefs) of + { !_patOdefs -> + (case (_lhsIcon) of + { !_patOcon -> + (case (_lhsIchildSyns) of + { !_patOchildSyns -> + (case (_lhsIchildInhs) of + { !_patOchildInhs -> + (case ((pat_1 _patOchildInhs _patOchildSyns _patOcon _patOdefs _patOforcedIrrefutables _patOnt)) of + { ( !_patIallAttributes,!_patIcopy,!_patIerrors,!_patIoutput) -> + (case (Irrefutable _patIcopy) of + { !_copy -> + (case (_copy) of + { !_lhsOcopy -> + (case (_patIerrors) of + { !_lhsOerrors -> + (case (Irrefutable _patIoutput) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product !pos_ !(T_Patterns pats_) = + (T_Pattern (case ((pats_ )) of + { ( !_patsIdefsCollect,!T_Patterns_1 pats_1) -> + (case (_patsIdefsCollect) of + { !_lhsOdefsCollect -> + (case ((sem_Pattern_Product_1 (T_Patterns_1 pats_1) pos_)) of + { ( !sem_Pattern_1) -> + ( _lhsOdefsCollect,sem_Pattern_1) }) }) })) +sem_Pattern_Product_1 :: T_Patterns_1 -> + Pos -> + T_Pattern_1 +sem_Pattern_Product_1 !(T_Patterns_1 pats_1) !pos_ = + (T_Pattern_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) -> + (case (_lhsInt) of + { !_patsOnt -> + (case (_lhsIcon) of + { !_patsOcon -> + (case (_lhsIforcedIrrefutables) of + { !_patsOforcedIrrefutables -> + (case (_lhsIdefs) of + { !_patsOdefs -> + (case (_lhsIchildSyns) of + { !_patsOchildSyns -> + (case (_lhsIchildInhs) of + { !_patsOchildInhs -> + (case ((pats_1 _patsOchildInhs _patsOchildSyns _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt)) of + { ( !_patsIallAttributes,!_patsIcopy,!_patsIerrors,!_patsIoutput) -> + (case (_patsIallAttributes) of + { !_lhsOallAttributes -> + (case (Product pos_ _patsIcopy) of + { !_copy -> + (case (_copy) of + { !_lhsOcopy -> + (case (_patsIerrors) of + { !_lhsOerrors -> + (case (Product pos_ _patsIoutput) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore !pos_ = + (T_Pattern (case (Set.empty) of + { !_lhsOdefsCollect -> + (case ((sem_Pattern_Underscore_1 pos_)) of + { ( !sem_Pattern_1) -> + ( _lhsOdefsCollect,sem_Pattern_1) }) })) +sem_Pattern_Underscore_1 :: Pos -> + T_Pattern_1 +sem_Pattern_Underscore_1 !pos_ = + (T_Pattern_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) -> + (case (Map.empty) of + { !_lhsOallAttributes -> + (case (Underscore pos_) of + { !_copy -> + (case (_copy) of + { !_lhsOcopy -> + (case (Seq.empty) of + { !_lhsOerrors -> + (case (Underscore pos_) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }))) +-- Patterns ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + defsCollect : Set (Identifier, Identifier) + visit 1: + inherited attributes: + childInhs : [(Identifier, Identifier)] + childSyns : [(Identifier, Identifier)] + con : ConstructorIdent + defs : Set (Identifier, Identifier) + forcedIrrefutables : AttrMap + nt : NontermIdent + synthesized attributes: + allAttributes : AttrMap + copy : SELF + errors : Seq Error + output : SELF + alternatives: + alternative Cons: + child hd : Pattern + child tl : Patterns + visit 1: + local copy : _ + local output : _ + alternative Nil: + visit 1: + local copy : _ + local output : _ +-} +-- cata +sem_Patterns :: Patterns -> + T_Patterns +sem_Patterns !list = + (Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list)) +-- semantic domain +newtype T_Patterns = T_Patterns (( (Set (Identifier, Identifier)),T_Patterns_1)) +newtype T_Patterns_1 = T_Patterns_1 (([(Identifier, Identifier)]) -> + ([(Identifier, Identifier)]) -> + ConstructorIdent -> + (Set (Identifier, Identifier)) -> + AttrMap -> + NontermIdent -> + ( AttrMap,Patterns,(Seq Error),Patterns)) +data Inh_Patterns = Inh_Patterns {childInhs_Inh_Patterns :: !([(Identifier, Identifier)]),childSyns_Inh_Patterns :: !([(Identifier, Identifier)]),con_Inh_Patterns :: !(ConstructorIdent),defs_Inh_Patterns :: !(Set (Identifier, Identifier)),forcedIrrefutables_Inh_Patterns :: !(AttrMap),nt_Inh_Patterns :: !(NontermIdent)} +data Syn_Patterns = Syn_Patterns {allAttributes_Syn_Patterns :: !(AttrMap),copy_Syn_Patterns :: !(Patterns),defsCollect_Syn_Patterns :: !(Set (Identifier, Identifier)),errors_Syn_Patterns :: !(Seq Error),output_Syn_Patterns :: !(Patterns)} +wrap_Patterns !(T_Patterns sem) !(Inh_Patterns _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) = + (let ( !_lhsOdefsCollect,!T_Patterns_1 sem_1) = + (sem ) + ( !_lhsOallAttributes,!_lhsOcopy,!_lhsOerrors,!_lhsOoutput) = + (sem_1 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) + in (Syn_Patterns _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput)) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons !(T_Pattern hd_) !(T_Patterns tl_) = + (T_Patterns (case ((tl_ )) of + { ( !_tlIdefsCollect,!T_Patterns_1 tl_1) -> + (case ((hd_ )) of + { ( !_hdIdefsCollect,!T_Pattern_1 hd_1) -> + (case (_hdIdefsCollect `Set.union` _tlIdefsCollect) of + { !_lhsOdefsCollect -> + (case ((sem_Patterns_Cons_1 (T_Patterns_1 tl_1) (T_Pattern_1 hd_1))) of + { ( !sem_Patterns_1) -> + ( _lhsOdefsCollect,sem_Patterns_1) }) }) }) })) +sem_Patterns_Cons_1 :: T_Patterns_1 -> + T_Pattern_1 -> + T_Patterns_1 +sem_Patterns_Cons_1 !(T_Patterns_1 tl_1) !(T_Pattern_1 hd_1) = + (T_Patterns_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) -> + (case (_lhsInt) of + { !_tlOnt -> + (case (_lhsIcon) of + { !_tlOcon -> + (case (_lhsInt) of + { !_hdOnt -> + (case (_lhsIcon) of + { !_hdOcon -> + (case (_lhsIforcedIrrefutables) of + { !_tlOforcedIrrefutables -> + (case (_lhsIdefs) of + { !_tlOdefs -> + (case (_lhsIchildSyns) of + { !_tlOchildSyns -> + (case (_lhsIchildInhs) of + { !_tlOchildInhs -> + (case ((tl_1 _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt)) of + { ( !_tlIallAttributes,!_tlIcopy,!_tlIerrors,!_tlIoutput) -> + (case (_lhsIforcedIrrefutables) of + { !_hdOforcedIrrefutables -> + (case (_lhsIdefs) of + { !_hdOdefs -> + (case (_lhsIchildSyns) of + { !_hdOchildSyns -> + (case (_lhsIchildInhs) of + { !_hdOchildInhs -> + (case ((hd_1 _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt)) of + { ( !_hdIallAttributes,!_hdIcopy,!_hdIerrors,!_hdIoutput) -> + (case (_hdIallAttributes `mergeAttributes` _tlIallAttributes) of + { !_lhsOallAttributes -> + (case ((:) _hdIcopy _tlIcopy) of + { !_copy -> + (case (_copy) of + { !_lhsOcopy -> + (case (_hdIerrors Seq.<> _tlIerrors) of + { !_lhsOerrors -> + (case ((:) _hdIoutput _tlIoutput) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (case (Set.empty) of + { !_lhsOdefsCollect -> + (case ((sem_Patterns_Nil_1 )) of + { ( !sem_Patterns_1) -> + ( _lhsOdefsCollect,sem_Patterns_1) }) })) +sem_Patterns_Nil_1 :: T_Patterns_1 +sem_Patterns_Nil_1 = + (T_Patterns_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) -> + (case (Map.empty) of + { !_lhsOallAttributes -> + (case ([]) of + { !_copy -> + (case (_copy) of + { !_lhsOcopy -> + (case (Seq.empty) of + { !_lhsOerrors -> + (case ([]) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }))) +-- Production -------------------------------------------------- +{- + visit 0: + inherited attributes: + forcedIrrefutables : AttrMap + nt : NontermIdent + options : Options + synthesized attributes: + allAttributes : AttrMap + errors : Seq Error + output : SELF + alternatives: + alternative Production: + child con : {ConstructorIdent} + child children : Children + child rules : Rules + child typeSigs : TypeSigs + visit 0: + local output : _ +-} +-- cata +sem_Production :: Production -> + T_Production +sem_Production !(Production _con _children _rules _typeSigs) = + (sem_Production_Production _con (sem_Children _children) (sem_Rules _rules) (sem_TypeSigs _typeSigs)) +-- semantic domain +newtype T_Production = T_Production (AttrMap -> + NontermIdent -> + Options -> + ( AttrMap,(Seq Error),Production)) +data Inh_Production = Inh_Production {forcedIrrefutables_Inh_Production :: !(AttrMap),nt_Inh_Production :: !(NontermIdent),options_Inh_Production :: !(Options)} +data Syn_Production = Syn_Production {allAttributes_Syn_Production :: !(AttrMap),errors_Syn_Production :: !(Seq Error),output_Syn_Production :: !(Production)} +wrap_Production !(T_Production sem) !(Inh_Production _lhsIforcedIrrefutables _lhsInt _lhsIoptions) = + (let ( !_lhsOallAttributes,!_lhsOerrors,!_lhsOoutput) = + (sem _lhsIforcedIrrefutables _lhsInt _lhsIoptions) + in (Syn_Production _lhsOallAttributes _lhsOerrors _lhsOoutput)) +sem_Production_Production :: ConstructorIdent -> + T_Children -> + T_Rules -> + T_TypeSigs -> + T_Production +sem_Production_Production !con_ !(T_Children children_) !(T_Rules rules_) !(T_TypeSigs typeSigs_) = + (T_Production (\ (!_lhsIforcedIrrefutables) + (!_lhsInt) + (!_lhsIoptions) -> + (case (_lhsInt) of + { !_rulesOnt -> + (case (con_) of + { !_rulesOcon -> + (case ((rules_ )) of + { ( !_rulesIdefsCollect,!T_Rules_1 rules_1) -> + (case (_lhsIoptions) of + { !_rulesOoptions -> + (case (_lhsIforcedIrrefutables) of + { !_rulesOforcedIrrefutables -> + (case ((children_ )) of + { ( !_childrenIchildInhs,!_childrenIchildSyns,!_childrenIoutput) -> + (case (_childrenIchildSyns) of + { !_rulesOchildSyns -> + (case (_childrenIchildInhs) of + { !_rulesOchildInhs -> + (case (_rulesIdefsCollect) of + { !_rulesOdefs -> + (case ((rules_1 _rulesOchildInhs _rulesOchildSyns _rulesOcon _rulesOdefs _rulesOforcedIrrefutables _rulesOnt _rulesOoptions)) of + { ( !_rulesIallAttributes,!_rulesIerrors,!_rulesIoutput) -> + (case (_rulesIallAttributes) of + { !_lhsOallAttributes -> + (case (_rulesIerrors) of + { !_lhsOerrors -> + (case ((typeSigs_ )) of + { ( !_typeSigsIoutput) -> + (case (Production con_ _childrenIoutput _rulesIoutput _typeSigsIoutput) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +-- Productions ------------------------------------------------- +{- + visit 0: + inherited attributes: + forcedIrrefutables : AttrMap + nt : NontermIdent + options : Options + synthesized attributes: + allAttributes : AttrMap + errors : Seq Error + output : SELF + alternatives: + alternative Cons: + child hd : Production + child tl : Productions + visit 0: + local output : _ + alternative Nil: + visit 0: + local output : _ +-} +-- cata +sem_Productions :: Productions -> + T_Productions +sem_Productions !list = + (Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list)) +-- semantic domain +newtype T_Productions = T_Productions (AttrMap -> + NontermIdent -> + Options -> + ( AttrMap,(Seq Error),Productions)) +data Inh_Productions = Inh_Productions {forcedIrrefutables_Inh_Productions :: !(AttrMap),nt_Inh_Productions :: !(NontermIdent),options_Inh_Productions :: !(Options)} +data Syn_Productions = Syn_Productions {allAttributes_Syn_Productions :: !(AttrMap),errors_Syn_Productions :: !(Seq Error),output_Syn_Productions :: !(Productions)} +wrap_Productions !(T_Productions sem) !(Inh_Productions _lhsIforcedIrrefutables _lhsInt _lhsIoptions) = + (let ( !_lhsOallAttributes,!_lhsOerrors,!_lhsOoutput) = + (sem _lhsIforcedIrrefutables _lhsInt _lhsIoptions) + in (Syn_Productions _lhsOallAttributes _lhsOerrors _lhsOoutput)) +sem_Productions_Cons :: T_Production -> + T_Productions -> + T_Productions +sem_Productions_Cons !(T_Production hd_) !(T_Productions tl_) = + (T_Productions (\ (!_lhsIforcedIrrefutables) + (!_lhsInt) + (!_lhsIoptions) -> + (case (_lhsInt) of + { !_tlOnt -> + (case (_lhsInt) of + { !_hdOnt -> + (case (_lhsIoptions) of + { !_tlOoptions -> + (case (_lhsIforcedIrrefutables) of + { !_tlOforcedIrrefutables -> + (case ((tl_ _tlOforcedIrrefutables _tlOnt _tlOoptions)) of + { ( !_tlIallAttributes,!_tlIerrors,!_tlIoutput) -> + (case (_lhsIoptions) of + { !_hdOoptions -> + (case (_lhsIforcedIrrefutables) of + { !_hdOforcedIrrefutables -> + (case ((hd_ _hdOforcedIrrefutables _hdOnt _hdOoptions)) of + { ( !_hdIallAttributes,!_hdIerrors,!_hdIoutput) -> + (case (_hdIallAttributes `mergeAttributes` _tlIallAttributes) of + { !_lhsOallAttributes -> + (case (_hdIerrors Seq.<> _tlIerrors) of + { !_lhsOerrors -> + (case ((:) _hdIoutput _tlIoutput) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_Productions_Nil :: T_Productions +sem_Productions_Nil = + (T_Productions (\ (!_lhsIforcedIrrefutables) + (!_lhsInt) + (!_lhsIoptions) -> + (case (Map.empty) of + { !_lhsOallAttributes -> + (case (Seq.empty) of + { !_lhsOerrors -> + (case ([]) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) }))) +-- Rule -------------------------------------------------------- +{- + visit 0: + synthesized attribute: + defsCollect : Set (Identifier, Identifier) + visit 1: + inherited attributes: + childInhs : [(Identifier, Identifier)] + childSyns : [(Identifier, Identifier)] + con : ConstructorIdent + defs : Set (Identifier, Identifier) + forcedIrrefutables : AttrMap + nt : NontermIdent + options : Options + synthesized attributes: + allAttributes : AttrMap + errors : Seq Error + output : SELF + alternatives: + alternative Rule: + child pattern : Pattern + child rhs : Expression + child owrt : {Bool} + child origin : {String} + visit 1: + local ruleDescr : _ + local output : _ +-} +-- cata +sem_Rule :: Rule -> + T_Rule +sem_Rule !(Rule _pattern _rhs _owrt _origin) = + (sem_Rule_Rule (sem_Pattern _pattern) (sem_Expression _rhs) _owrt _origin) +-- semantic domain +newtype T_Rule = T_Rule (( (Set (Identifier, Identifier)),T_Rule_1)) +newtype T_Rule_1 = T_Rule_1 (([(Identifier, Identifier)]) -> + ([(Identifier, Identifier)]) -> + ConstructorIdent -> + (Set (Identifier, Identifier)) -> + AttrMap -> + NontermIdent -> + Options -> + ( AttrMap,(Seq Error),Rule)) +data Inh_Rule = Inh_Rule {childInhs_Inh_Rule :: !([(Identifier, Identifier)]),childSyns_Inh_Rule :: !([(Identifier, Identifier)]),con_Inh_Rule :: !(ConstructorIdent),defs_Inh_Rule :: !(Set (Identifier, Identifier)),forcedIrrefutables_Inh_Rule :: !(AttrMap),nt_Inh_Rule :: !(NontermIdent),options_Inh_Rule :: !(Options)} +data Syn_Rule = Syn_Rule {allAttributes_Syn_Rule :: !(AttrMap),defsCollect_Syn_Rule :: !(Set (Identifier, Identifier)),errors_Syn_Rule :: !(Seq Error),output_Syn_Rule :: !(Rule)} +wrap_Rule !(T_Rule sem) !(Inh_Rule _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions) = + (let ( !_lhsOdefsCollect,!T_Rule_1 sem_1) = + (sem ) + ( !_lhsOallAttributes,!_lhsOerrors,!_lhsOoutput) = + (sem_1 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions) + in (Syn_Rule _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput)) +sem_Rule_Rule :: T_Pattern -> + T_Expression -> + Bool -> + String -> + T_Rule +sem_Rule_Rule !(T_Pattern pattern_) !(T_Expression rhs_) !owrt_ !origin_ = + (T_Rule (case ((pattern_ )) of + { ( !_patternIdefsCollect,!T_Pattern_1 pattern_1) -> + (case (_patternIdefsCollect) of + { !_lhsOdefsCollect -> + (case ((sem_Rule_Rule_1 (T_Pattern_1 pattern_1) _patternIdefsCollect (T_Expression rhs_) origin_ owrt_)) of + { ( !sem_Rule_1) -> + ( _lhsOdefsCollect,sem_Rule_1) }) }) })) +sem_Rule_Rule_1 :: T_Pattern_1 -> + (Set (Identifier, Identifier)) -> + T_Expression -> + String -> + Bool -> + T_Rule_1 +sem_Rule_Rule_1 !(T_Pattern_1 pattern_1) !_patternIdefsCollect !(T_Expression rhs_) !origin_ !owrt_ = + (T_Rule_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) + (!_lhsIoptions) -> + (case (_lhsInt) of + { !_patternOnt -> + (case (_lhsIcon) of + { !_patternOcon -> + (case (_lhsIforcedIrrefutables) of + { !_patternOforcedIrrefutables -> + (case (_lhsIdefs) of + { !_patternOdefs -> + (case (_lhsIchildSyns) of + { !_patternOchildSyns -> + (case (_lhsIchildInhs) of + { !_patternOchildInhs -> + (case ((pattern_1 _patternOchildInhs _patternOchildSyns _patternOcon _patternOdefs _patternOforcedIrrefutables _patternOnt)) of + { ( !_patternIallAttributes,!_patternIcopy,!_patternIerrors,!_patternIoutput) -> + (case (_patternIallAttributes) of + { !_lhsOallAttributes -> + (case (show _lhsInt ++ " :: " ++ show _lhsIcon ++ " :: " ++ (concat $ intersperse "," $ map (\(f,a) -> show f ++ "." ++ show a) $ Set.toList _patternIdefsCollect)) of + { !_ruleDescr -> + (case (_ruleDescr) of + { !_rhsOruleDescr -> + (case (_lhsIoptions) of + { !_rhsOoptions -> + (case (_lhsInt) of + { !_rhsOnt -> + (case (_lhsIcon) of + { !_rhsOcon -> + (case (_lhsIchildSyns) of + { !_rhsOchildSyns -> + (case (_lhsIchildInhs) of + { !_rhsOchildInhs -> + (case ((rhs_ _rhsOchildInhs _rhsOchildSyns _rhsOcon _rhsOnt _rhsOoptions _rhsOruleDescr)) of + { ( !_rhsIerrors,!_rhsIoutput) -> + (case (_patternIerrors Seq.<> _rhsIerrors) of + { !_lhsOerrors -> + (case (Rule _patternIoutput _rhsIoutput owrt_ origin_) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +-- Rules ------------------------------------------------------- +{- + visit 0: + synthesized attribute: + defsCollect : Set (Identifier, Identifier) + visit 1: + inherited attributes: + childInhs : [(Identifier, Identifier)] + childSyns : [(Identifier, Identifier)] + con : ConstructorIdent + defs : Set (Identifier, Identifier) + forcedIrrefutables : AttrMap + nt : NontermIdent + options : Options + synthesized attributes: + allAttributes : AttrMap + errors : Seq Error + output : SELF + alternatives: + alternative Cons: + child hd : Rule + child tl : Rules + visit 1: + local output : _ + alternative Nil: + visit 1: + local output : _ +-} +-- cata +sem_Rules :: Rules -> + T_Rules +sem_Rules !list = + (Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list)) +-- semantic domain +newtype T_Rules = T_Rules (( (Set (Identifier, Identifier)),T_Rules_1)) +newtype T_Rules_1 = T_Rules_1 (([(Identifier, Identifier)]) -> + ([(Identifier, Identifier)]) -> + ConstructorIdent -> + (Set (Identifier, Identifier)) -> + AttrMap -> + NontermIdent -> + Options -> + ( AttrMap,(Seq Error),Rules)) +data Inh_Rules = Inh_Rules {childInhs_Inh_Rules :: !([(Identifier, Identifier)]),childSyns_Inh_Rules :: !([(Identifier, Identifier)]),con_Inh_Rules :: !(ConstructorIdent),defs_Inh_Rules :: !(Set (Identifier, Identifier)),forcedIrrefutables_Inh_Rules :: !(AttrMap),nt_Inh_Rules :: !(NontermIdent),options_Inh_Rules :: !(Options)} +data Syn_Rules = Syn_Rules {allAttributes_Syn_Rules :: !(AttrMap),defsCollect_Syn_Rules :: !(Set (Identifier, Identifier)),errors_Syn_Rules :: !(Seq Error),output_Syn_Rules :: !(Rules)} +wrap_Rules !(T_Rules sem) !(Inh_Rules _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions) = + (let ( !_lhsOdefsCollect,!T_Rules_1 sem_1) = + (sem ) + ( !_lhsOallAttributes,!_lhsOerrors,!_lhsOoutput) = + (sem_1 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions) + in (Syn_Rules _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput)) +sem_Rules_Cons :: T_Rule -> + T_Rules -> + T_Rules +sem_Rules_Cons !(T_Rule hd_) !(T_Rules tl_) = + (T_Rules (case ((tl_ )) of + { ( !_tlIdefsCollect,!T_Rules_1 tl_1) -> + (case ((hd_ )) of + { ( !_hdIdefsCollect,!T_Rule_1 hd_1) -> + (case (_hdIdefsCollect `Set.union` _tlIdefsCollect) of + { !_lhsOdefsCollect -> + (case ((sem_Rules_Cons_1 (T_Rules_1 tl_1) (T_Rule_1 hd_1))) of + { ( !sem_Rules_1) -> + ( _lhsOdefsCollect,sem_Rules_1) }) }) }) })) +sem_Rules_Cons_1 :: T_Rules_1 -> + T_Rule_1 -> + T_Rules_1 +sem_Rules_Cons_1 !(T_Rules_1 tl_1) !(T_Rule_1 hd_1) = + (T_Rules_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) + (!_lhsIoptions) -> + (case (_lhsInt) of + { !_tlOnt -> + (case (_lhsIcon) of + { !_tlOcon -> + (case (_lhsInt) of + { !_hdOnt -> + (case (_lhsIcon) of + { !_hdOcon -> + (case (_lhsIoptions) of + { !_tlOoptions -> + (case (_lhsIforcedIrrefutables) of + { !_tlOforcedIrrefutables -> + (case (_lhsIdefs) of + { !_tlOdefs -> + (case (_lhsIchildSyns) of + { !_tlOchildSyns -> + (case (_lhsIchildInhs) of + { !_tlOchildInhs -> + (case ((tl_1 _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt _tlOoptions)) of + { ( !_tlIallAttributes,!_tlIerrors,!_tlIoutput) -> + (case (_lhsIoptions) of + { !_hdOoptions -> + (case (_lhsIforcedIrrefutables) of + { !_hdOforcedIrrefutables -> + (case (_lhsIdefs) of + { !_hdOdefs -> + (case (_lhsIchildSyns) of + { !_hdOchildSyns -> + (case (_lhsIchildInhs) of + { !_hdOchildInhs -> + (case ((hd_1 _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt _hdOoptions)) of + { ( !_hdIallAttributes,!_hdIerrors,!_hdIoutput) -> + (case (_hdIallAttributes `mergeAttributes` _tlIallAttributes) of + { !_lhsOallAttributes -> + (case (_hdIerrors Seq.<> _tlIerrors) of + { !_lhsOerrors -> + (case ((:) _hdIoutput _tlIoutput) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_Rules_Nil :: T_Rules +sem_Rules_Nil = + (T_Rules (case (Set.empty) of + { !_lhsOdefsCollect -> + (case ((sem_Rules_Nil_1 )) of + { ( !sem_Rules_1) -> + ( _lhsOdefsCollect,sem_Rules_1) }) })) +sem_Rules_Nil_1 :: T_Rules_1 +sem_Rules_Nil_1 = + (T_Rules_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) + (!_lhsIoptions) -> + (case (Map.empty) of + { !_lhsOallAttributes -> + (case (Seq.empty) of + { !_lhsOerrors -> + (case ([]) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) }))) +-- TypeSig ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + output : SELF + alternatives: + alternative TypeSig: + child name : {Identifier} + child tp : {Type} + visit 0: + local output : _ +-} +-- cata +sem_TypeSig :: TypeSig -> + T_TypeSig +sem_TypeSig !(TypeSig _name _tp) = + (sem_TypeSig_TypeSig _name _tp) +-- semantic domain +newtype T_TypeSig = T_TypeSig (( TypeSig)) +data Inh_TypeSig = Inh_TypeSig {} +data Syn_TypeSig = Syn_TypeSig {output_Syn_TypeSig :: !(TypeSig)} +wrap_TypeSig !(T_TypeSig sem) !(Inh_TypeSig ) = + (let ( !_lhsOoutput) = + (sem ) + in (Syn_TypeSig _lhsOoutput)) +sem_TypeSig_TypeSig :: Identifier -> + Type -> + T_TypeSig +sem_TypeSig_TypeSig !name_ !tp_ = + (T_TypeSig (case (TypeSig name_ tp_) of + { !_output -> + (case (_output) 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 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 ((:) _hdIoutput _tlIoutput) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + ( _lhsOoutput) }) }) }) })) +sem_TypeSigs_Nil :: T_TypeSigs +sem_TypeSigs_Nil = + (T_TypeSigs (case ([]) of + { !_output -> + (case (_output) of + { !_lhsOoutput -> + ( _lhsOoutput) }) })) diff --git a/src-derived/ErrorMessages.hs b/src-derived/ErrorMessages.hs --- a/src-derived/ErrorMessages.hs +++ b/src-derived/ErrorMessages.hs @@ -56,6 +56,10 @@ alternative DupSynonym: child nt : {NontermIdent} child occ1 : {NontermIdent} + alternative DupUnique: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child attr : {Identifier} alternative InducedCirc: child nt : {NontermIdent} child cinter : {CInterface} @@ -85,6 +89,9 @@ child nt : {NontermIdent} child con : {ConstructorIdent} child attr : {Identifier} + alternative MissingUnique: + child nt : {NontermIdent} + child attr : {Identifier} alternative ParserError: child pos : {Pos} child problem : {String} @@ -126,12 +133,14 @@ | DupSig (NontermIdent) (ConstructorIdent) (Identifier) | DupSynAttr (NontermIdent) (Identifier) (Identifier) | DupSynonym (NontermIdent) (NontermIdent) + | DupUnique (NontermIdent) (ConstructorIdent) (Identifier) | InducedCirc (NontermIdent) (CInterface) ([((Identifier,Identifier),[String],[String])]) | InstCirc (NontermIdent) (ConstructorIdent) (Identifier) (Bool) ([String]) | LocalCirc (NontermIdent) (ConstructorIdent) (Identifier) (Bool) ([String]) | MissingInstSig (NontermIdent) (ConstructorIdent) (Identifier) | MissingRule (NontermIdent) (ConstructorIdent) (Identifier) (Identifier) | MissingTypeSig (NontermIdent) (ConstructorIdent) (Identifier) + | MissingUnique (NontermIdent) (Identifier) | ParserError (Pos) (String) (String) | SuperfluousRule (NontermIdent) (ConstructorIdent) (Identifier) (Identifier) | UndefAlt (NontermIdent) (ConstructorIdent) diff --git a/src-derived/Expression.hs b/src-derived/Expression.hs --- a/src-derived/Expression.hs +++ b/src-derived/Expression.hs @@ -1,4 +1,3 @@ - -- UUAGC 0.9.5 (Expression.ag) module Expression where @@ -11,4 +10,4 @@ child pos : {Pos} child tks : {[HsToken]} -} -data Expression = Expression (Pos) ([HsToken]) +data Expression = Expression (Pos) ([HsToken]) diff --git a/src-derived/GenerateCode.hs b/src-derived/GenerateCode.hs --- a/src-derived/GenerateCode.hs +++ b/src-derived/GenerateCode.hs @@ -1,6 +1,7 @@ -- UUAGC 0.9.5 (GenerateCode.ag) module GenerateCode where +import CommonTypes import SequentialTypes import Code hiding (Type) import qualified Code @@ -171,6 +172,10 @@ typeName nt 0 = "T_" ++ show nt typeName nt n = "T_" ++ show nt ++ "_" ++ show n +ntOfVisit :: NontermIdent -> Int -> NontermIdent +ntOfVisit nt 0 = nt +ntOfVisit nt n = Ident (show nt ++ "_" ++ show n) (getPos nt) + -- Gives the name of a visit function visitname :: String -> NontermIdent -> Int -> String visitname pre nt n = pre ++ getName nt ++ "_" ++ show n @@ -202,8 +207,8 @@ -- semantic domain newtype T_CGrammar = T_CGrammar (Options -> ( (Seq Error),Program)) -data Inh_CGrammar = Inh_CGrammar {options_Inh_CGrammar :: Options} -data Syn_CGrammar = Syn_CGrammar {errors_Syn_CGrammar :: Seq Error,output_Syn_CGrammar :: Program} +data Inh_CGrammar = Inh_CGrammar {options_Inh_CGrammar :: !(Options)} +data Syn_CGrammar = Syn_CGrammar {errors_Syn_CGrammar :: !(Seq Error),output_Syn_CGrammar :: !(Program)} wrap_CGrammar (T_CGrammar sem) (Inh_CGrammar _lhsIoptions) = (let ( _lhsOerrors,_lhsOoutput) = (sem _lhsIoptions) @@ -236,6 +241,7 @@ _nontsOallPragmas :: PragmaMap _nontsOparamMap :: ParamMap _nontsOcontextMap :: ContextMap + _nontsOallNts :: (Set NontermIdent) _nontsOwith_sig :: Bool _nontsOerrors :: (Seq Error) _lhsOoutput :: Program @@ -247,84 +253,88 @@ _nontsIallTpsFound :: Bool _nontsIchunks :: Chunks _nontsIerrors :: (Seq Error) + _nontsIgathNts :: (Set NontermIdent) _nontsIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) - -- "GenerateCode.ag"(line 46, column 17) + -- "GenerateCode.ag"(line 50, column 17) _nontsOo_sig = typeSigs _lhsIoptions - -- "GenerateCode.ag"(line 46, column 17) + -- "GenerateCode.ag"(line 50, column 17) _nontsOo_cata = folds _lhsIoptions - -- "GenerateCode.ag"(line 46, column 17) + -- "GenerateCode.ag"(line 50, column 17) _nontsOo_sem = semfuns _lhsIoptions - -- "GenerateCode.ag"(line 46, column 17) + -- "GenerateCode.ag"(line 50, column 17) _nontsOo_newtypes = newtypes _lhsIoptions - -- "GenerateCode.ag"(line 46, column 17) + -- "GenerateCode.ag"(line 50, column 17) _nontsOo_unbox = unbox _lhsIoptions - -- "GenerateCode.ag"(line 46, column 17) + -- "GenerateCode.ag"(line 50, column 17) _nontsOo_case = cases _lhsIoptions - -- "GenerateCode.ag"(line 46, column 17) + -- "GenerateCode.ag"(line 50, column 17) _nontsOo_pretty = attrInfo _lhsIoptions - -- "GenerateCode.ag"(line 46, column 17) + -- "GenerateCode.ag"(line 50, column 17) _nontsOo_rename = rename _lhsIoptions - -- "GenerateCode.ag"(line 46, column 17) + -- "GenerateCode.ag"(line 50, column 17) _nontsOo_strictwrap = strictWrap _lhsIoptions - -- "GenerateCode.ag"(line 46, column 17) + -- "GenerateCode.ag"(line 50, column 17) _nontsOo_splitsems = splitSems _lhsIoptions - -- "GenerateCode.ag"(line 46, column 17) + -- "GenerateCode.ag"(line 50, column 17) _nontsOo_data = if dataTypes _lhsIoptions then Just (strictData _lhsIoptions) else Nothing - -- "GenerateCode.ag"(line 46, column 17) + -- "GenerateCode.ag"(line 50, column 17) _nontsOprefix = prefix _lhsIoptions - -- "GenerateCode.ag"(line 46, column 17) + -- "GenerateCode.ag"(line 50, column 17) _nontsOo_traces = genTraces _lhsIoptions - -- "GenerateCode.ag"(line 46, column 17) + -- "GenerateCode.ag"(line 50, column 17) _nontsOo_costcentre = genCostCentres _lhsIoptions - -- "GenerateCode.ag"(line 46, column 17) + -- "GenerateCode.ag"(line 50, column 17) _nontsOo_linePragmas = genLinePragmas _lhsIoptions - -- "GenerateCode.ag"(line 65, column 15) + -- "GenerateCode.ag"(line 69, column 15) _nontsOallPragmas = pragmas_ - -- "GenerateCode.ag"(line 87, column 14) + -- "GenerateCode.ag"(line 91, column 14) _nontsOparamMap = paramMap_ - -- "GenerateCode.ag"(line 108, column 7) + -- "GenerateCode.ag"(line 112, column 7) _nontsOcontextMap = contextMap_ - -- "GenerateCode.ag"(line 597, column 7) + -- "GenerateCode.ag"(line 124, column 7) + _nontsOallNts = + _nontsIgathNts + -- "GenerateCode.ag"(line 621, column 7) _unfoldSemDom = \nt nr repl -> - let (params, tp) = Map.findWithDefault (error "No such semantic domain") (nt, nr) _nontsIsemDomUnfoldGath + let (params, tp) = Map.findWithDefault (error ("No such semantic domain: " ++ show nt)) (nt, nr) _nontsIsemDomUnfoldGath replMap = Map.fromList (zip params repl) - replace k = Map.findWithDefault k k replMap + replace k = Map.findWithDefault ('@':k) k replMap in evalType replace tp - -- "GenerateCode.ag"(line 690, column 14) + -- "GenerateCode.ag"(line 714, column 14) _nontsOwith_sig = typeSigs _lhsIoptions && _nontsIallTpsFound - -- "GenerateCode.ag"(line 697, column 15) + -- "GenerateCode.ag"(line 721, column 15) _nontsOerrors = Seq.empty - -- "GenerateCode.ag"(line 761, column 17) + -- "GenerateCode.ag"(line 785, column 17) _lhsOoutput = Program _nontsIchunks - -- "GenerateCode.ag"(line 810, column 14) + -- "GenerateCode.ag"(line 838, column 14) _nontsOtypeSyns = typeSyns_ - -- "GenerateCode.ag"(line 810, column 14) + -- "GenerateCode.ag"(line 838, column 14) _nontsOderivings = derivings_ - -- "GenerateCode.ag"(line 810, column 14) + -- "GenerateCode.ag"(line 838, column 14) _nontsOwrappers = wrappers_ -- copy rule (up) @@ -333,8 +343,8 @@ -- copy rule (from local) _nontsOunfoldSemDom = _unfoldSemDom - ( _nontsIallTpsFound,_nontsIchunks,_nontsIerrors,_nontsIsemDomUnfoldGath) = - (nonts_ _nontsOallPragmas _nontsOcontextMap _nontsOderivings _nontsOerrors _nontsOo_case _nontsOo_cata _nontsOo_costcentre _nontsOo_data _nontsOo_linePragmas _nontsOo_newtypes _nontsOo_pretty _nontsOo_rename _nontsOo_sem _nontsOo_sig _nontsOo_splitsems _nontsOo_strictwrap _nontsOo_traces _nontsOo_unbox _nontsOparamMap _nontsOprefix _nontsOtypeSyns _nontsOunfoldSemDom _nontsOwith_sig _nontsOwrappers) + ( _nontsIallTpsFound,_nontsIchunks,_nontsIerrors,_nontsIgathNts,_nontsIsemDomUnfoldGath) = + (nonts_ _nontsOallNts _nontsOallPragmas _nontsOcontextMap _nontsOderivings _nontsOerrors _nontsOo_case _nontsOo_cata _nontsOo_costcentre _nontsOo_data _nontsOo_linePragmas _nontsOo_newtypes _nontsOo_pretty _nontsOo_rename _nontsOo_sem _nontsOo_sig _nontsOo_splitsems _nontsOo_strictwrap _nontsOo_traces _nontsOo_unbox _nontsOparamMap _nontsOprefix _nontsOtypeSyns _nontsOunfoldSemDom _nontsOwith_sig _nontsOwrappers) in ( _lhsOerrors,_lhsOoutput)))) -- CInterface -------------------------------------------------- {- @@ -394,8 +404,8 @@ String -> Attributes -> ( ([String]),([Decl]),(Map (NontermIdent, Int) ([String], Code.Type)),Decls)) -data Inh_CInterface = Inh_CInterface {inh_Inh_CInterface :: Attributes,nt_Inh_CInterface :: NontermIdent,o_case_Inh_CInterface :: Bool,o_cata_Inh_CInterface :: Bool,o_costcentre_Inh_CInterface :: Bool,o_data_Inh_CInterface :: Maybe Bool,o_linePragmas_Inh_CInterface :: Bool,o_newtypes_Inh_CInterface :: Bool,o_pretty_Inh_CInterface :: Bool,o_rename_Inh_CInterface :: Bool,o_sem_Inh_CInterface :: Bool,o_sig_Inh_CInterface :: Bool,o_splitsems_Inh_CInterface :: Bool,o_strictwrap_Inh_CInterface :: Bool,o_traces_Inh_CInterface :: Bool,o_unbox_Inh_CInterface :: Bool,paramMap_Inh_CInterface :: ParamMap,prefix_Inh_CInterface :: String,syn_Inh_CInterface :: Attributes} -data Syn_CInterface = Syn_CInterface {comments_Syn_CInterface :: [String],semDom_Syn_CInterface :: [Decl],semDomUnfoldGath_Syn_CInterface :: Map (NontermIdent, Int) ([String], Code.Type),wrapDecls_Syn_CInterface :: Decls} +data Inh_CInterface = Inh_CInterface {inh_Inh_CInterface :: !(Attributes),nt_Inh_CInterface :: !(NontermIdent),o_case_Inh_CInterface :: !(Bool),o_cata_Inh_CInterface :: !(Bool),o_costcentre_Inh_CInterface :: !(Bool),o_data_Inh_CInterface :: !(Maybe Bool),o_linePragmas_Inh_CInterface :: !(Bool),o_newtypes_Inh_CInterface :: !(Bool),o_pretty_Inh_CInterface :: !(Bool),o_rename_Inh_CInterface :: !(Bool),o_sem_Inh_CInterface :: !(Bool),o_sig_Inh_CInterface :: !(Bool),o_splitsems_Inh_CInterface :: !(Bool),o_strictwrap_Inh_CInterface :: !(Bool),o_traces_Inh_CInterface :: !(Bool),o_unbox_Inh_CInterface :: !(Bool),paramMap_Inh_CInterface :: !(ParamMap),prefix_Inh_CInterface :: !(String),syn_Inh_CInterface :: !(Attributes)} +data Syn_CInterface = Syn_CInterface {comments_Syn_CInterface :: !([String]),semDom_Syn_CInterface :: !([Decl]),semDomUnfoldGath_Syn_CInterface :: !(Map (NontermIdent, Int) ([String], Code.Type)),wrapDecls_Syn_CInterface :: !(Decls)} wrap_CInterface (T_CInterface sem) (Inh_CInterface _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsIsyn) = (let ( _lhsOcomments,_lhsOsemDom,_lhsOsemDomUnfoldGath,_lhsOwrapDecls) = (sem _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsIsyn) @@ -451,19 +461,19 @@ _segIsemDom :: ([Decl]) _segIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) _segIwrapDecls :: Decls - -- "GenerateCode.ag"(line 198, column 17) + -- "GenerateCode.ag"(line 218, column 17) _segOnr = 0 - -- "GenerateCode.ag"(line 570, column 18) + -- "GenerateCode.ag"(line 594, column 18) _lhsOsemDom = Comment "semantic domain" : _segIsemDom - -- use rule "GenerateCode.ag"(line 714, column 52) + -- use rule "GenerateCode.ag"(line 738, column 52) _lhsOcomments = _segIcomments - -- use rule "GenerateCode.ag"(line 587, column 86) + -- use rule "GenerateCode.ag"(line 611, column 86) _lhsOsemDomUnfoldGath = _segIsemDomUnfoldGath - -- use rule "GenerateCode.ag"(line 663, column 52) + -- use rule "GenerateCode.ag"(line 687, column 52) _lhsOwrapDecls = _segIwrapDecls -- copy rule (down) @@ -530,6 +540,7 @@ {- visit 0: inherited attributes: + allNts : Set NontermIdent allPragmas : PragmaMap contextMap : ContextMap derivings : Derivings @@ -558,6 +569,7 @@ synthesized attributes: allTpsFound : Bool chunks : Chunks + gathNts : Set NontermIdent semDomUnfoldGath : Map (NontermIdent, Int) ([String], Code.Type) alternatives: alternative CNonterminal: @@ -581,7 +593,8 @@ sem_CNonterminal (CNonterminal _nt _params _inh _syn _prods _inter) = (sem_CNonterminal_CNonterminal _nt _params _inh _syn (sem_CProductions _prods) (sem_CInterface _inter)) -- semantic domain -newtype T_CNonterminal = T_CNonterminal (PragmaMap -> +newtype T_CNonterminal = T_CNonterminal ((Set NontermIdent) -> + PragmaMap -> ContextMap -> Derivings -> (Seq Error) -> @@ -605,13 +618,13 @@ (NontermIdent -> Int -> [String] -> Code.Type) -> Bool -> (Set NontermIdent) -> - ( Bool,Chunks,(Seq Error),(Map (NontermIdent, Int) ([String], Code.Type)))) -data Inh_CNonterminal = Inh_CNonterminal {allPragmas_Inh_CNonterminal :: PragmaMap,contextMap_Inh_CNonterminal :: ContextMap,derivings_Inh_CNonterminal :: Derivings,errors_Inh_CNonterminal :: Seq Error,o_case_Inh_CNonterminal :: Bool,o_cata_Inh_CNonterminal :: Bool,o_costcentre_Inh_CNonterminal :: Bool,o_data_Inh_CNonterminal :: Maybe Bool,o_linePragmas_Inh_CNonterminal :: Bool,o_newtypes_Inh_CNonterminal :: Bool,o_pretty_Inh_CNonterminal :: Bool,o_rename_Inh_CNonterminal :: Bool,o_sem_Inh_CNonterminal :: Bool,o_sig_Inh_CNonterminal :: Bool,o_splitsems_Inh_CNonterminal :: Bool,o_strictwrap_Inh_CNonterminal :: Bool,o_traces_Inh_CNonterminal :: Bool,o_unbox_Inh_CNonterminal :: Bool,paramMap_Inh_CNonterminal :: ParamMap,prefix_Inh_CNonterminal :: String,typeSyns_Inh_CNonterminal :: TypeSyns,unfoldSemDom_Inh_CNonterminal :: NontermIdent -> Int -> [String] -> Code.Type,with_sig_Inh_CNonterminal :: Bool,wrappers_Inh_CNonterminal :: Set NontermIdent} -data Syn_CNonterminal = Syn_CNonterminal {allTpsFound_Syn_CNonterminal :: Bool,chunks_Syn_CNonterminal :: Chunks,errors_Syn_CNonterminal :: Seq Error,semDomUnfoldGath_Syn_CNonterminal :: Map (NontermIdent, Int) ([String], Code.Type)} -wrap_CNonterminal (T_CNonterminal sem) (Inh_CNonterminal _lhsIallPragmas _lhsIcontextMap _lhsIderivings _lhsIerrors _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsItypeSyns _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers) = - (let ( _lhsOallTpsFound,_lhsOchunks,_lhsOerrors,_lhsOsemDomUnfoldGath) = - (sem _lhsIallPragmas _lhsIcontextMap _lhsIderivings _lhsIerrors _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsItypeSyns _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers) - in (Syn_CNonterminal _lhsOallTpsFound _lhsOchunks _lhsOerrors _lhsOsemDomUnfoldGath)) + ( Bool,Chunks,(Seq Error),(Set NontermIdent),(Map (NontermIdent, Int) ([String], Code.Type)))) +data Inh_CNonterminal = Inh_CNonterminal {allNts_Inh_CNonterminal :: !(Set NontermIdent),allPragmas_Inh_CNonterminal :: !(PragmaMap),contextMap_Inh_CNonterminal :: !(ContextMap),derivings_Inh_CNonterminal :: !(Derivings),errors_Inh_CNonterminal :: !(Seq Error),o_case_Inh_CNonterminal :: !(Bool),o_cata_Inh_CNonterminal :: !(Bool),o_costcentre_Inh_CNonterminal :: !(Bool),o_data_Inh_CNonterminal :: !(Maybe Bool),o_linePragmas_Inh_CNonterminal :: !(Bool),o_newtypes_Inh_CNonterminal :: !(Bool),o_pretty_Inh_CNonterminal :: !(Bool),o_rename_Inh_CNonterminal :: !(Bool),o_sem_Inh_CNonterminal :: !(Bool),o_sig_Inh_CNonterminal :: !(Bool),o_splitsems_Inh_CNonterminal :: !(Bool),o_strictwrap_Inh_CNonterminal :: !(Bool),o_traces_Inh_CNonterminal :: !(Bool),o_unbox_Inh_CNonterminal :: !(Bool),paramMap_Inh_CNonterminal :: !(ParamMap),prefix_Inh_CNonterminal :: !(String),typeSyns_Inh_CNonterminal :: !(TypeSyns),unfoldSemDom_Inh_CNonterminal :: !(NontermIdent -> Int -> [String] -> Code.Type),with_sig_Inh_CNonterminal :: !(Bool),wrappers_Inh_CNonterminal :: !(Set NontermIdent)} +data Syn_CNonterminal = Syn_CNonterminal {allTpsFound_Syn_CNonterminal :: !(Bool),chunks_Syn_CNonterminal :: !(Chunks),errors_Syn_CNonterminal :: !(Seq Error),gathNts_Syn_CNonterminal :: !(Set NontermIdent),semDomUnfoldGath_Syn_CNonterminal :: !(Map (NontermIdent, Int) ([String], Code.Type))} +wrap_CNonterminal (T_CNonterminal sem) (Inh_CNonterminal _lhsIallNts _lhsIallPragmas _lhsIcontextMap _lhsIderivings _lhsIerrors _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsItypeSyns _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers) = + (let ( _lhsOallTpsFound,_lhsOchunks,_lhsOerrors,_lhsOgathNts,_lhsOsemDomUnfoldGath) = + (sem _lhsIallNts _lhsIallPragmas _lhsIcontextMap _lhsIderivings _lhsIerrors _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsItypeSyns _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers) + in (Syn_CNonterminal _lhsOallTpsFound _lhsOchunks _lhsOerrors _lhsOgathNts _lhsOsemDomUnfoldGath)) sem_CNonterminal_CNonterminal :: NontermIdent -> ([Identifier]) -> Attributes -> @@ -620,7 +633,8 @@ T_CInterface -> T_CNonterminal sem_CNonterminal_CNonterminal nt_ params_ inh_ syn_ (T_CProductions prods_) (T_CInterface inter_) = - (T_CNonterminal (\ _lhsIallPragmas + (T_CNonterminal (\ _lhsIallNts + _lhsIallPragmas _lhsIcontextMap _lhsIderivings _lhsIerrors @@ -652,10 +666,12 @@ _prodsOinh :: Attributes _prodsOsyn :: Attributes _prodsOnt :: NontermIdent + _lhsOgathNts :: (Set NontermIdent) _lhsOchunks :: Chunks _lhsOallTpsFound :: Bool _lhsOerrors :: (Seq Error) _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + _prodsOallNts :: (Set NontermIdent) _prodsOallPragmas :: PragmaMap _prodsOcontextMap :: ContextMap _prodsOerrors :: (Seq Error) @@ -704,31 +720,34 @@ _interIsemDom :: ([Decl]) _interIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) _interIwrapDecls :: Decls - -- "GenerateCode.ag"(line 75, column 26) + -- "GenerateCode.ag"(line 79, column 26) __tup1 = (inh_,syn_,nt_) - -- "GenerateCode.ag"(line 75, column 26) + -- "GenerateCode.ag"(line 79, column 26) (_interOinh,_,_) = __tup1 - -- "GenerateCode.ag"(line 75, column 26) + -- "GenerateCode.ag"(line 79, column 26) (_,_interOsyn,_) = __tup1 - -- "GenerateCode.ag"(line 75, column 26) + -- "GenerateCode.ag"(line 79, column 26) (_,_,_interOnt) = __tup1 - -- "GenerateCode.ag"(line 76, column 25) + -- "GenerateCode.ag"(line 80, column 25) __tup2 = (inh_,syn_,nt_) - -- "GenerateCode.ag"(line 76, column 25) + -- "GenerateCode.ag"(line 80, column 25) (_prodsOinh,_,_) = __tup2 - -- "GenerateCode.ag"(line 76, column 25) + -- "GenerateCode.ag"(line 80, column 25) (_,_prodsOsyn,_) = __tup2 - -- "GenerateCode.ag"(line 76, column 25) + -- "GenerateCode.ag"(line 80, column 25) (_,_,_prodsOnt) = __tup2 - -- "GenerateCode.ag"(line 635, column 18) + -- "GenerateCode.ag"(line 130, column 7) + _lhsOgathNts = + Set.singleton nt_ + -- "GenerateCode.ag"(line 659, column 18) _semWrapper = let params' = map getName params_ inhAttrs = Map.toList inh_ @@ -756,10 +775,10 @@ (Let _interIwrapDecls (App synNT synVars)) Set.empty Set.empty ] - -- "GenerateCode.ag"(line 710, column 18) + -- "GenerateCode.ag"(line 734, column 18) _comment = Comment . unlines . map ind $ ( _interIcomments ++ ("alternatives:" : map ind _prodsIcomments) ) - -- "GenerateCode.ag"(line 764, column 19) + -- "GenerateCode.ag"(line 788, column 19) _lhsOchunks = [ Chunk (getName nt_) (Comment (getName nt_ ++ " " ++ replicate (60 - length (getName nt_)) '-')) @@ -771,21 +790,26 @@ (if _lhsIo_sem then _prodsIdecls else []) (if _lhsIo_sem then _prodsIsemNames else []) ] - -- "GenerateCode.ag"(line 815, column 18) + -- "GenerateCode.ag"(line 843, column 18) _dataDef = let params' = map getName params_ typeSyn tp = let theType = case tp of - CommonTypes.Maybe t -> SimpleType ("Maybe (" ++ typeToHaskellString (Just nt_) params' t ++")") - CommonTypes.List t -> Code.List $ SimpleType (typeToHaskellString (Just nt_) params' t) - CommonTypes.Tuple ts -> Code.TupleType [SimpleType (typeToHaskellString (Just nt_) params' t) + CommonTypes.Maybe t -> SimpleType ("Maybe (" ++ typeToHaskellString (Just nt_) params' t ++")") + CommonTypes.Either t1 t2 -> SimpleType ("Either (" ++ typeToHaskellString (Just nt_) params' t1 ++") (" + ++ typeToHaskellString (Just nt_) params' t2 ++")") + CommonTypes.Map t1 t2 -> SimpleType ("Map (" ++ typeToHaskellString (Just nt_) params' t1 ++") (" + ++ typeToHaskellString (Just nt_) params' t2 ++")") + CommonTypes.IntMap t -> SimpleType ("IntMap (" ++ typeToHaskellString (Just nt_) params' t ++")") + CommonTypes.List t -> Code.List $ SimpleType (typeToHaskellString (Just nt_) params' t) + CommonTypes.Tuple ts -> Code.TupleType [SimpleType (typeToHaskellString (Just nt_) params' t) | (_,t) <- ts ] - in Code.Type (getName nt_) params' theType + in Code.Type (getName nt_) params' (idEvalType theType) derivings = maybe [] (map getName . Set.toList) (Map.lookup nt_ _lhsIderivings) dataDef = Data (getName nt_) (map getName params_) _prodsIdataAlts (maybe False id _lhsIo_data) derivings in maybe dataDef typeSyn $ lookup nt_ _lhsItypeSyns - -- "GenerateCode.ag"(line 844, column 18) + -- "GenerateCode.ag"(line 877, column 18) _cataFun = let appParams nm = TypeApp (SimpleType nm) (map SimpleType (map getName params_)) evalTp | null params_ = id @@ -814,6 +838,40 @@ in [Decl (lhs (App "Prelude.Just" [arg])) (App just [rarg]) Set.empty Set.empty ,Decl (lhs (SimpleExpr "Prelude.Nothing")) (SimpleExpr nothing) Set.empty Set.empty ] + CommonTypes.Either tp1 tp2 -> + let left = semname _lhsIprefix nt_ (identifier "Left") + right = semname _lhsIprefix nt_ (identifier "Right" ) + arg = SimpleExpr "x" + rarg0 = case tp1 of + NT t _ -> App (cataname _lhsIprefix t) [arg] + _ -> arg + rarg1 = case tp2 of + NT t _ -> App (cataname _lhsIprefix t) [arg] + _ -> arg + lhs a = Fun (cataname _lhsIprefix nt_) [a] + in [Decl (lhs (App "Prelude.Left" [arg])) (App left [rarg0]) Set.empty Set.empty + ,Decl (lhs (App "Prelude.Right" [arg])) (App right [rarg1]) Set.empty Set.empty + ] + CommonTypes.Map _ tp -> + let entry = SimpleExpr (semname _lhsIprefix nt_ (identifier "Entry")) + nil = SimpleExpr (semname _lhsIprefix nt_ (identifier "Nil")) + arg = SimpleExpr "m" + rarg = case tp of + NT t _ -> App "Map.map" [SimpleExpr $ cataname _lhsIprefix t, arg] + _ -> arg + lhs = Fun (cataname _lhsIprefix nt_) [arg] + rhs = App "Map.foldWithKey" [entry,nil,rarg] + in [Decl lhs rhs Set.empty Set.empty] + CommonTypes.IntMap tp -> + let entry = SimpleExpr (semname _lhsIprefix nt_ (identifier "Entry")) + nil = SimpleExpr (semname _lhsIprefix nt_ (identifier "Nil")) + arg = SimpleExpr "m" + rarg = case tp of + NT t _ -> App "IntMap.map" [SimpleExpr $ cataname _lhsIprefix t, arg] + _ -> arg + lhs = Fun (cataname _lhsIprefix nt_) [arg] + rhs = App "IntMap.foldWithKey" [entry,nil,rarg] + in [Decl lhs rhs Set.empty Set.empty] CommonTypes.Tuple tps -> let con = semname _lhsIprefix nt_ (identifier "Tuple") tps' = [ (SimpleExpr (getName x),y) | (x,y) <- tps] @@ -827,16 +885,19 @@ in Comment "cata" : (if _lhsIo_sig then [tSig] else []) ++ maybe _prodsIcataAlts special (lookup nt_ _lhsItypeSyns) - -- use rule "GenerateCode.ag"(line 682, column 39) + -- use rule "GenerateCode.ag"(line 706, column 39) _lhsOallTpsFound = _prodsIallTpsFound - -- use rule "GenerateCode.ag"(line 695, column 32) + -- use rule "GenerateCode.ag"(line 719, column 32) _lhsOerrors = _prodsIerrors - -- use rule "GenerateCode.ag"(line 587, column 86) + -- use rule "GenerateCode.ag"(line 611, column 86) _lhsOsemDomUnfoldGath = _interIsemDomUnfoldGath -- copy rule (down) + _prodsOallNts = + _lhsIallNts + -- copy rule (down) _prodsOallPragmas = _lhsIallPragmas -- copy rule (down) @@ -948,14 +1009,15 @@ _interOprefix = _lhsIprefix ( _prodsIallTpsFound,_prodsIcataAlts,_prodsIcomments,_prodsIdataAlts,_prodsIdecls,_prodsIerrors,_prodsIsemNames) = - (prods_ _prodsOallPragmas _prodsOcontextMap _prodsOerrors _prodsOinh _prodsOnt _prodsOo_case _prodsOo_cata _prodsOo_costcentre _prodsOo_data _prodsOo_linePragmas _prodsOo_newtypes _prodsOo_pretty _prodsOo_rename _prodsOo_sem _prodsOo_sig _prodsOo_splitsems _prodsOo_strictwrap _prodsOo_traces _prodsOo_unbox _prodsOparamMap _prodsOprefix _prodsOsyn _prodsOunfoldSemDom _prodsOwith_sig) + (prods_ _prodsOallNts _prodsOallPragmas _prodsOcontextMap _prodsOerrors _prodsOinh _prodsOnt _prodsOo_case _prodsOo_cata _prodsOo_costcentre _prodsOo_data _prodsOo_linePragmas _prodsOo_newtypes _prodsOo_pretty _prodsOo_rename _prodsOo_sem _prodsOo_sig _prodsOo_splitsems _prodsOo_strictwrap _prodsOo_traces _prodsOo_unbox _prodsOparamMap _prodsOprefix _prodsOsyn _prodsOunfoldSemDom _prodsOwith_sig) ( _interIcomments,_interIsemDom,_interIsemDomUnfoldGath,_interIwrapDecls) = (inter_ _interOinh _interOnt _interOo_case _interOo_cata _interOo_costcentre _interOo_data _interOo_linePragmas _interOo_newtypes _interOo_pretty _interOo_rename _interOo_sem _interOo_sig _interOo_splitsems _interOo_strictwrap _interOo_traces _interOo_unbox _interOparamMap _interOprefix _interOsyn) - in ( _lhsOallTpsFound,_lhsOchunks,_lhsOerrors,_lhsOsemDomUnfoldGath)))) + in ( _lhsOallTpsFound,_lhsOchunks,_lhsOerrors,_lhsOgathNts,_lhsOsemDomUnfoldGath)))) -- CNonterminals ----------------------------------------------- {- visit 0: inherited attributes: + allNts : Set NontermIdent allPragmas : PragmaMap contextMap : ContextMap derivings : Derivings @@ -984,6 +1046,7 @@ synthesized attributes: allTpsFound : Bool chunks : Chunks + gathNts : Set NontermIdent semDomUnfoldGath : Map (NontermIdent, Int) ([String], Code.Type) alternatives: alternative Cons: @@ -997,7 +1060,8 @@ sem_CNonterminals list = (Prelude.foldr sem_CNonterminals_Cons sem_CNonterminals_Nil (Prelude.map sem_CNonterminal list)) -- semantic domain -newtype T_CNonterminals = T_CNonterminals (PragmaMap -> +newtype T_CNonterminals = T_CNonterminals ((Set NontermIdent) -> + PragmaMap -> ContextMap -> Derivings -> (Seq Error) -> @@ -1021,18 +1085,19 @@ (NontermIdent -> Int -> [String] -> Code.Type) -> Bool -> (Set NontermIdent) -> - ( Bool,Chunks,(Seq Error),(Map (NontermIdent, Int) ([String], Code.Type)))) -data Inh_CNonterminals = Inh_CNonterminals {allPragmas_Inh_CNonterminals :: PragmaMap,contextMap_Inh_CNonterminals :: ContextMap,derivings_Inh_CNonterminals :: Derivings,errors_Inh_CNonterminals :: Seq Error,o_case_Inh_CNonterminals :: Bool,o_cata_Inh_CNonterminals :: Bool,o_costcentre_Inh_CNonterminals :: Bool,o_data_Inh_CNonterminals :: Maybe Bool,o_linePragmas_Inh_CNonterminals :: Bool,o_newtypes_Inh_CNonterminals :: Bool,o_pretty_Inh_CNonterminals :: Bool,o_rename_Inh_CNonterminals :: Bool,o_sem_Inh_CNonterminals :: Bool,o_sig_Inh_CNonterminals :: Bool,o_splitsems_Inh_CNonterminals :: Bool,o_strictwrap_Inh_CNonterminals :: Bool,o_traces_Inh_CNonterminals :: Bool,o_unbox_Inh_CNonterminals :: Bool,paramMap_Inh_CNonterminals :: ParamMap,prefix_Inh_CNonterminals :: String,typeSyns_Inh_CNonterminals :: TypeSyns,unfoldSemDom_Inh_CNonterminals :: NontermIdent -> Int -> [String] -> Code.Type,with_sig_Inh_CNonterminals :: Bool,wrappers_Inh_CNonterminals :: Set NontermIdent} -data Syn_CNonterminals = Syn_CNonterminals {allTpsFound_Syn_CNonterminals :: Bool,chunks_Syn_CNonterminals :: Chunks,errors_Syn_CNonterminals :: Seq Error,semDomUnfoldGath_Syn_CNonterminals :: Map (NontermIdent, Int) ([String], Code.Type)} -wrap_CNonterminals (T_CNonterminals sem) (Inh_CNonterminals _lhsIallPragmas _lhsIcontextMap _lhsIderivings _lhsIerrors _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsItypeSyns _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers) = - (let ( _lhsOallTpsFound,_lhsOchunks,_lhsOerrors,_lhsOsemDomUnfoldGath) = - (sem _lhsIallPragmas _lhsIcontextMap _lhsIderivings _lhsIerrors _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsItypeSyns _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers) - in (Syn_CNonterminals _lhsOallTpsFound _lhsOchunks _lhsOerrors _lhsOsemDomUnfoldGath)) + ( Bool,Chunks,(Seq Error),(Set NontermIdent),(Map (NontermIdent, Int) ([String], Code.Type)))) +data Inh_CNonterminals = Inh_CNonterminals {allNts_Inh_CNonterminals :: !(Set NontermIdent),allPragmas_Inh_CNonterminals :: !(PragmaMap),contextMap_Inh_CNonterminals :: !(ContextMap),derivings_Inh_CNonterminals :: !(Derivings),errors_Inh_CNonterminals :: !(Seq Error),o_case_Inh_CNonterminals :: !(Bool),o_cata_Inh_CNonterminals :: !(Bool),o_costcentre_Inh_CNonterminals :: !(Bool),o_data_Inh_CNonterminals :: !(Maybe Bool),o_linePragmas_Inh_CNonterminals :: !(Bool),o_newtypes_Inh_CNonterminals :: !(Bool),o_pretty_Inh_CNonterminals :: !(Bool),o_rename_Inh_CNonterminals :: !(Bool),o_sem_Inh_CNonterminals :: !(Bool),o_sig_Inh_CNonterminals :: !(Bool),o_splitsems_Inh_CNonterminals :: !(Bool),o_strictwrap_Inh_CNonterminals :: !(Bool),o_traces_Inh_CNonterminals :: !(Bool),o_unbox_Inh_CNonterminals :: !(Bool),paramMap_Inh_CNonterminals :: !(ParamMap),prefix_Inh_CNonterminals :: !(String),typeSyns_Inh_CNonterminals :: !(TypeSyns),unfoldSemDom_Inh_CNonterminals :: !(NontermIdent -> Int -> [String] -> Code.Type),with_sig_Inh_CNonterminals :: !(Bool),wrappers_Inh_CNonterminals :: !(Set NontermIdent)} +data Syn_CNonterminals = Syn_CNonterminals {allTpsFound_Syn_CNonterminals :: !(Bool),chunks_Syn_CNonterminals :: !(Chunks),errors_Syn_CNonterminals :: !(Seq Error),gathNts_Syn_CNonterminals :: !(Set NontermIdent),semDomUnfoldGath_Syn_CNonterminals :: !(Map (NontermIdent, Int) ([String], Code.Type))} +wrap_CNonterminals (T_CNonterminals sem) (Inh_CNonterminals _lhsIallNts _lhsIallPragmas _lhsIcontextMap _lhsIderivings _lhsIerrors _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsItypeSyns _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers) = + (let ( _lhsOallTpsFound,_lhsOchunks,_lhsOerrors,_lhsOgathNts,_lhsOsemDomUnfoldGath) = + (sem _lhsIallNts _lhsIallPragmas _lhsIcontextMap _lhsIderivings _lhsIerrors _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsItypeSyns _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers) + in (Syn_CNonterminals _lhsOallTpsFound _lhsOchunks _lhsOerrors _lhsOgathNts _lhsOsemDomUnfoldGath)) sem_CNonterminals_Cons :: T_CNonterminal -> T_CNonterminals -> T_CNonterminals sem_CNonterminals_Cons (T_CNonterminal hd_) (T_CNonterminals tl_) = - (T_CNonterminals (\ _lhsIallPragmas + (T_CNonterminals (\ _lhsIallNts + _lhsIallPragmas _lhsIcontextMap _lhsIderivings _lhsIerrors @@ -1059,7 +1124,9 @@ (let _lhsOallTpsFound :: Bool _lhsOchunks :: Chunks _lhsOerrors :: (Seq Error) + _lhsOgathNts :: (Set NontermIdent) _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + _hdOallNts :: (Set NontermIdent) _hdOallPragmas :: PragmaMap _hdOcontextMap :: ContextMap _hdOderivings :: Derivings @@ -1084,6 +1151,7 @@ _hdOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) _hdOwith_sig :: Bool _hdOwrappers :: (Set NontermIdent) + _tlOallNts :: (Set NontermIdent) _tlOallPragmas :: PragmaMap _tlOcontextMap :: ContextMap _tlOderivings :: Derivings @@ -1111,24 +1179,32 @@ _hdIallTpsFound :: Bool _hdIchunks :: Chunks _hdIerrors :: (Seq Error) + _hdIgathNts :: (Set NontermIdent) _hdIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) _tlIallTpsFound :: Bool _tlIchunks :: Chunks _tlIerrors :: (Seq Error) + _tlIgathNts :: (Set NontermIdent) _tlIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) - -- use rule "GenerateCode.ag"(line 682, column 39) + -- use rule "GenerateCode.ag"(line 706, column 39) _lhsOallTpsFound = _hdIallTpsFound && _tlIallTpsFound - -- use rule "GenerateCode.ag"(line 756, column 49) + -- use rule "GenerateCode.ag"(line 780, column 49) _lhsOchunks = _hdIchunks ++ _tlIchunks - -- use rule "GenerateCode.ag"(line 695, column 32) + -- use rule "GenerateCode.ag"(line 719, column 32) _lhsOerrors = _hdIerrors Seq.<> _tlIerrors - -- use rule "GenerateCode.ag"(line 587, column 86) + -- use rule "GenerateCode.ag"(line 126, column 47) + _lhsOgathNts = + _hdIgathNts `Set.union` _tlIgathNts + -- use rule "GenerateCode.ag"(line 611, column 86) _lhsOsemDomUnfoldGath = _hdIsemDomUnfoldGath `Map.union` _tlIsemDomUnfoldGath -- copy rule (down) + _hdOallNts = + _lhsIallNts + -- copy rule (down) _hdOallPragmas = _lhsIallPragmas -- copy rule (down) @@ -1201,6 +1277,9 @@ _hdOwrappers = _lhsIwrappers -- copy rule (down) + _tlOallNts = + _lhsIallNts + -- copy rule (down) _tlOallPragmas = _lhsIallPragmas -- copy rule (down) @@ -1272,14 +1351,15 @@ -- copy rule (down) _tlOwrappers = _lhsIwrappers - ( _hdIallTpsFound,_hdIchunks,_hdIerrors,_hdIsemDomUnfoldGath) = - (hd_ _hdOallPragmas _hdOcontextMap _hdOderivings _hdOerrors _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOparamMap _hdOprefix _hdOtypeSyns _hdOunfoldSemDom _hdOwith_sig _hdOwrappers) - ( _tlIallTpsFound,_tlIchunks,_tlIerrors,_tlIsemDomUnfoldGath) = - (tl_ _tlOallPragmas _tlOcontextMap _tlOderivings _tlOerrors _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOparamMap _tlOprefix _tlOtypeSyns _tlOunfoldSemDom _tlOwith_sig _tlOwrappers) - in ( _lhsOallTpsFound,_lhsOchunks,_lhsOerrors,_lhsOsemDomUnfoldGath)))) + ( _hdIallTpsFound,_hdIchunks,_hdIerrors,_hdIgathNts,_hdIsemDomUnfoldGath) = + (hd_ _hdOallNts _hdOallPragmas _hdOcontextMap _hdOderivings _hdOerrors _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOparamMap _hdOprefix _hdOtypeSyns _hdOunfoldSemDom _hdOwith_sig _hdOwrappers) + ( _tlIallTpsFound,_tlIchunks,_tlIerrors,_tlIgathNts,_tlIsemDomUnfoldGath) = + (tl_ _tlOallNts _tlOallPragmas _tlOcontextMap _tlOderivings _tlOerrors _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOparamMap _tlOprefix _tlOtypeSyns _tlOunfoldSemDom _tlOwith_sig _tlOwrappers) + in ( _lhsOallTpsFound,_lhsOchunks,_lhsOerrors,_lhsOgathNts,_lhsOsemDomUnfoldGath)))) sem_CNonterminals_Nil :: T_CNonterminals sem_CNonterminals_Nil = - (T_CNonterminals (\ _lhsIallPragmas + (T_CNonterminals (\ _lhsIallNts + _lhsIallPragmas _lhsIcontextMap _lhsIderivings _lhsIerrors @@ -1306,24 +1386,29 @@ (let _lhsOallTpsFound :: Bool _lhsOchunks :: Chunks _lhsOerrors :: (Seq Error) + _lhsOgathNts :: (Set NontermIdent) _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) - -- use rule "GenerateCode.ag"(line 682, column 39) + -- use rule "GenerateCode.ag"(line 706, column 39) _lhsOallTpsFound = True - -- use rule "GenerateCode.ag"(line 756, column 49) + -- use rule "GenerateCode.ag"(line 780, column 49) _lhsOchunks = [] - -- use rule "GenerateCode.ag"(line 695, column 32) + -- use rule "GenerateCode.ag"(line 719, column 32) _lhsOerrors = Seq.empty - -- use rule "GenerateCode.ag"(line 587, column 86) + -- use rule "GenerateCode.ag"(line 126, column 47) + _lhsOgathNts = + Set.empty + -- use rule "GenerateCode.ag"(line 611, column 86) _lhsOsemDomUnfoldGath = Map.empty - in ( _lhsOallTpsFound,_lhsOchunks,_lhsOerrors,_lhsOsemDomUnfoldGath)))) + in ( _lhsOallTpsFound,_lhsOchunks,_lhsOerrors,_lhsOgathNts,_lhsOsemDomUnfoldGath)))) -- CProduction ------------------------------------------------- {- visit 0: inherited attributes: + allNts : Set NontermIdent allPragmas : PragmaMap contextMap : ContextMap inh : Attributes @@ -1373,7 +1458,8 @@ sem_CProduction (CProduction _con _visits _children _terminals) = (sem_CProduction_CProduction _con (sem_CVisits _visits) _children _terminals) -- semantic domain -newtype T_CProduction = T_CProduction (PragmaMap -> +newtype T_CProduction = T_CProduction ((Set NontermIdent) -> + PragmaMap -> ContextMap -> (Seq Error) -> Attributes -> @@ -1398,11 +1484,11 @@ (NontermIdent -> Int -> [String] -> Code.Type) -> Bool -> ( Bool,Decl,([String]),DataAlt,Decls,(Seq Error),([String]))) -data Inh_CProduction = Inh_CProduction {allPragmas_Inh_CProduction :: PragmaMap,contextMap_Inh_CProduction :: ContextMap,errors_Inh_CProduction :: Seq Error,inh_Inh_CProduction :: Attributes,nt_Inh_CProduction :: NontermIdent,o_case_Inh_CProduction :: Bool,o_cata_Inh_CProduction :: Bool,o_costcentre_Inh_CProduction :: Bool,o_data_Inh_CProduction :: Maybe Bool,o_linePragmas_Inh_CProduction :: Bool,o_newtypes_Inh_CProduction :: Bool,o_pretty_Inh_CProduction :: Bool,o_rename_Inh_CProduction :: Bool,o_sem_Inh_CProduction :: Bool,o_sig_Inh_CProduction :: Bool,o_splitsems_Inh_CProduction :: Bool,o_strictwrap_Inh_CProduction :: Bool,o_traces_Inh_CProduction :: Bool,o_unbox_Inh_CProduction :: Bool,paramMap_Inh_CProduction :: ParamMap,prefix_Inh_CProduction :: String,syn_Inh_CProduction :: Attributes,unfoldSemDom_Inh_CProduction :: NontermIdent -> Int -> [String] -> Code.Type,with_sig_Inh_CProduction :: Bool} -data Syn_CProduction = Syn_CProduction {allTpsFound_Syn_CProduction :: Bool,cataAlt_Syn_CProduction :: Decl,comments_Syn_CProduction :: [String],dataAlt_Syn_CProduction :: DataAlt,decls_Syn_CProduction :: Decls,errors_Syn_CProduction :: Seq Error,semNames_Syn_CProduction :: [String]} -wrap_CProduction (T_CProduction sem) (Inh_CProduction _lhsIallPragmas _lhsIcontextMap _lhsIerrors _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIunfoldSemDom _lhsIwith_sig) = +data Inh_CProduction = Inh_CProduction {allNts_Inh_CProduction :: !(Set NontermIdent),allPragmas_Inh_CProduction :: !(PragmaMap),contextMap_Inh_CProduction :: !(ContextMap),errors_Inh_CProduction :: !(Seq Error),inh_Inh_CProduction :: !(Attributes),nt_Inh_CProduction :: !(NontermIdent),o_case_Inh_CProduction :: !(Bool),o_cata_Inh_CProduction :: !(Bool),o_costcentre_Inh_CProduction :: !(Bool),o_data_Inh_CProduction :: !(Maybe Bool),o_linePragmas_Inh_CProduction :: !(Bool),o_newtypes_Inh_CProduction :: !(Bool),o_pretty_Inh_CProduction :: !(Bool),o_rename_Inh_CProduction :: !(Bool),o_sem_Inh_CProduction :: !(Bool),o_sig_Inh_CProduction :: !(Bool),o_splitsems_Inh_CProduction :: !(Bool),o_strictwrap_Inh_CProduction :: !(Bool),o_traces_Inh_CProduction :: !(Bool),o_unbox_Inh_CProduction :: !(Bool),paramMap_Inh_CProduction :: !(ParamMap),prefix_Inh_CProduction :: !(String),syn_Inh_CProduction :: !(Attributes),unfoldSemDom_Inh_CProduction :: !(NontermIdent -> Int -> [String] -> Code.Type),with_sig_Inh_CProduction :: !(Bool)} +data Syn_CProduction = Syn_CProduction {allTpsFound_Syn_CProduction :: !(Bool),cataAlt_Syn_CProduction :: !(Decl),comments_Syn_CProduction :: !([String]),dataAlt_Syn_CProduction :: !(DataAlt),decls_Syn_CProduction :: !(Decls),errors_Syn_CProduction :: !(Seq Error),semNames_Syn_CProduction :: !([String])} +wrap_CProduction (T_CProduction sem) (Inh_CProduction _lhsIallNts _lhsIallPragmas _lhsIcontextMap _lhsIerrors _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIunfoldSemDom _lhsIwith_sig) = (let ( _lhsOallTpsFound,_lhsOcataAlt,_lhsOcomments,_lhsOdataAlt,_lhsOdecls,_lhsOerrors,_lhsOsemNames) = - (sem _lhsIallPragmas _lhsIcontextMap _lhsIerrors _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIunfoldSemDom _lhsIwith_sig) + (sem _lhsIallNts _lhsIallPragmas _lhsIcontextMap _lhsIerrors _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIunfoldSemDom _lhsIwith_sig) in (Syn_CProduction _lhsOallTpsFound _lhsOcataAlt _lhsOcomments _lhsOdataAlt _lhsOdecls _lhsOerrors _lhsOsemNames)) sem_CProduction_CProduction :: ConstructorIdent -> T_CVisits -> @@ -1410,7 +1496,8 @@ ([Identifier]) -> T_CProduction sem_CProduction_CProduction con_ (T_CVisits visits_) children_ terminals_ = - (T_CProduction (\ _lhsIallPragmas + (T_CProduction (\ _lhsIallNts + _lhsIallPragmas _lhsIcontextMap _lhsIerrors _lhsIinh @@ -1446,6 +1533,7 @@ _lhsOdecls :: Decls _lhsOerrors :: (Seq Error) _lhsOsemNames :: ([String]) + _visitsOallNts :: (Set NontermIdent) _visitsOallPragmas :: PragmaMap _visitsOcontextMap :: ContextMap _visitsOerrors :: (Seq Error) @@ -1480,40 +1568,40 @@ _visitsIintraVars :: (Set String) _visitsIisNil :: Bool _visitsIsemNames :: ([String]) - -- "GenerateCode.ag"(line 81, column 19) + -- "GenerateCode.ag"(line 85, column 19) _visitsOcon = con_ - -- "GenerateCode.ag"(line 82, column 20) + -- "GenerateCode.ag"(line 86, column 20) _visitsOterminals = terminals_ - -- "GenerateCode.ag"(line 94, column 7) + -- "GenerateCode.ag"(line 98, column 7) _paramInstMap = Map.fromList [(nm, (extractNonterminal tp, tps)) | (nm,tp,_) <- children_, let tps = map cleanupArg $ nontermArgs tp, not (null tps) ] - -- "GenerateCode.ag"(line 194, column 18) + -- "GenerateCode.ag"(line 214, column 18) _visitsOnr = 0 - -- "GenerateCode.ag"(line 316, column 18) + -- "GenerateCode.ag"(line 340, column 18) _visitsOchildren = children_ - -- "GenerateCode.ag"(line 426, column 7) + -- "GenerateCode.ag"(line 450, column 7) _visitsOinstVisitNrs = _visitsIgatherInstVisitNrs - -- "GenerateCode.ag"(line 725, column 17) + -- "GenerateCode.ag"(line 749, column 17) _firstOrderChildren = filter (\(_,_,ho) -> not ho) children_ - -- "GenerateCode.ag"(line 726, column 18) + -- "GenerateCode.ag"(line 750, column 18) _lhsOcomments = ("alternative " ++ getName con_ ++ ":") : map ind ( map (\(x,y,_) -> makeLocalComment 14 "child" x (Just y)) _firstOrderChildren ++ _visitsIcomments ) - -- "GenerateCode.ag"(line 836, column 17) + -- "GenerateCode.ag"(line 869, column 17) _params = map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap - -- "GenerateCode.ag"(line 837, column 17) + -- "GenerateCode.ag"(line 870, column 17) _lhsOdataAlt = DataAlt (conname _lhsIo_rename _lhsInt con_) (map (\(_,t,_) -> typeToHaskellString (Just _lhsInt) _params t) _firstOrderChildren ) - -- "GenerateCode.ag"(line 895, column 17) + -- "GenerateCode.ag"(line 962, column 17) _lhsOcataAlt = let lhs = Fun (cataname _lhsIprefix _lhsInt) [lhs_pat] lhs_pat = App (conname _lhsIo_rename _lhsInt con_) @@ -1524,19 +1612,22 @@ [SimpleExpr (locname nm)] argument (nm, _,_) = SimpleExpr (locname nm) in Decl lhs rhs Set.empty Set.empty - -- use rule "GenerateCode.ag"(line 682, column 39) + -- use rule "GenerateCode.ag"(line 706, column 39) _lhsOallTpsFound = _visitsIallTpsFound - -- use rule "GenerateCode.ag"(line 757, column 44) + -- use rule "GenerateCode.ag"(line 781, column 44) _lhsOdecls = _visitsIdecls - -- use rule "GenerateCode.ag"(line 695, column 32) + -- use rule "GenerateCode.ag"(line 719, column 32) _lhsOerrors = _visitsIerrors - -- use rule "GenerateCode.ag"(line 910, column 61) + -- use rule "GenerateCode.ag"(line 977, column 61) _lhsOsemNames = _visitsIsemNames -- copy rule (down) + _visitsOallNts = + _lhsIallNts + -- copy rule (down) _visitsOallPragmas = _lhsIallPragmas -- copy rule (down) @@ -1612,12 +1703,13 @@ _visitsOwith_sig = _lhsIwith_sig ( _visitsIallTpsFound,_visitsIcomments,_visitsIdecls,_visitsIerrors,_visitsIgatherInstVisitNrs,_visitsIintra,_visitsIintraVars,_visitsIisNil,_visitsIsemNames) = - (visits_ _visitsOallPragmas _visitsOchildren _visitsOcon _visitsOcontextMap _visitsOerrors _visitsOinh _visitsOinstVisitNrs _visitsOnr _visitsOnt _visitsOo_case _visitsOo_cata _visitsOo_costcentre _visitsOo_data _visitsOo_linePragmas _visitsOo_newtypes _visitsOo_pretty _visitsOo_rename _visitsOo_sem _visitsOo_sig _visitsOo_splitsems _visitsOo_strictwrap _visitsOo_traces _visitsOo_unbox _visitsOparamInstMap _visitsOparamMap _visitsOprefix _visitsOsyn _visitsOterminals _visitsOunfoldSemDom _visitsOwith_sig) + (visits_ _visitsOallNts _visitsOallPragmas _visitsOchildren _visitsOcon _visitsOcontextMap _visitsOerrors _visitsOinh _visitsOinstVisitNrs _visitsOnr _visitsOnt _visitsOo_case _visitsOo_cata _visitsOo_costcentre _visitsOo_data _visitsOo_linePragmas _visitsOo_newtypes _visitsOo_pretty _visitsOo_rename _visitsOo_sem _visitsOo_sig _visitsOo_splitsems _visitsOo_strictwrap _visitsOo_traces _visitsOo_unbox _visitsOparamInstMap _visitsOparamMap _visitsOprefix _visitsOsyn _visitsOterminals _visitsOunfoldSemDom _visitsOwith_sig) in ( _lhsOallTpsFound,_lhsOcataAlt,_lhsOcomments,_lhsOdataAlt,_lhsOdecls,_lhsOerrors,_lhsOsemNames)))) -- CProductions ------------------------------------------------ {- visit 0: inherited attributes: + allNts : Set NontermIdent allPragmas : PragmaMap contextMap : ContextMap inh : Attributes @@ -1662,7 +1754,8 @@ sem_CProductions list = (Prelude.foldr sem_CProductions_Cons sem_CProductions_Nil (Prelude.map sem_CProduction list)) -- semantic domain -newtype T_CProductions = T_CProductions (PragmaMap -> +newtype T_CProductions = T_CProductions ((Set NontermIdent) -> + PragmaMap -> ContextMap -> (Seq Error) -> Attributes -> @@ -1687,17 +1780,18 @@ (NontermIdent -> Int -> [String] -> Code.Type) -> Bool -> ( Bool,Decls,([String]),DataAlts,Decls,(Seq Error),([String]))) -data Inh_CProductions = Inh_CProductions {allPragmas_Inh_CProductions :: PragmaMap,contextMap_Inh_CProductions :: ContextMap,errors_Inh_CProductions :: Seq Error,inh_Inh_CProductions :: Attributes,nt_Inh_CProductions :: NontermIdent,o_case_Inh_CProductions :: Bool,o_cata_Inh_CProductions :: Bool,o_costcentre_Inh_CProductions :: Bool,o_data_Inh_CProductions :: Maybe Bool,o_linePragmas_Inh_CProductions :: Bool,o_newtypes_Inh_CProductions :: Bool,o_pretty_Inh_CProductions :: Bool,o_rename_Inh_CProductions :: Bool,o_sem_Inh_CProductions :: Bool,o_sig_Inh_CProductions :: Bool,o_splitsems_Inh_CProductions :: Bool,o_strictwrap_Inh_CProductions :: Bool,o_traces_Inh_CProductions :: Bool,o_unbox_Inh_CProductions :: Bool,paramMap_Inh_CProductions :: ParamMap,prefix_Inh_CProductions :: String,syn_Inh_CProductions :: Attributes,unfoldSemDom_Inh_CProductions :: NontermIdent -> Int -> [String] -> Code.Type,with_sig_Inh_CProductions :: Bool} -data Syn_CProductions = Syn_CProductions {allTpsFound_Syn_CProductions :: Bool,cataAlts_Syn_CProductions :: Decls,comments_Syn_CProductions :: [String],dataAlts_Syn_CProductions :: DataAlts,decls_Syn_CProductions :: Decls,errors_Syn_CProductions :: Seq Error,semNames_Syn_CProductions :: [String]} -wrap_CProductions (T_CProductions sem) (Inh_CProductions _lhsIallPragmas _lhsIcontextMap _lhsIerrors _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIunfoldSemDom _lhsIwith_sig) = +data Inh_CProductions = Inh_CProductions {allNts_Inh_CProductions :: !(Set NontermIdent),allPragmas_Inh_CProductions :: !(PragmaMap),contextMap_Inh_CProductions :: !(ContextMap),errors_Inh_CProductions :: !(Seq Error),inh_Inh_CProductions :: !(Attributes),nt_Inh_CProductions :: !(NontermIdent),o_case_Inh_CProductions :: !(Bool),o_cata_Inh_CProductions :: !(Bool),o_costcentre_Inh_CProductions :: !(Bool),o_data_Inh_CProductions :: !(Maybe Bool),o_linePragmas_Inh_CProductions :: !(Bool),o_newtypes_Inh_CProductions :: !(Bool),o_pretty_Inh_CProductions :: !(Bool),o_rename_Inh_CProductions :: !(Bool),o_sem_Inh_CProductions :: !(Bool),o_sig_Inh_CProductions :: !(Bool),o_splitsems_Inh_CProductions :: !(Bool),o_strictwrap_Inh_CProductions :: !(Bool),o_traces_Inh_CProductions :: !(Bool),o_unbox_Inh_CProductions :: !(Bool),paramMap_Inh_CProductions :: !(ParamMap),prefix_Inh_CProductions :: !(String),syn_Inh_CProductions :: !(Attributes),unfoldSemDom_Inh_CProductions :: !(NontermIdent -> Int -> [String] -> Code.Type),with_sig_Inh_CProductions :: !(Bool)} +data Syn_CProductions = Syn_CProductions {allTpsFound_Syn_CProductions :: !(Bool),cataAlts_Syn_CProductions :: !(Decls),comments_Syn_CProductions :: !([String]),dataAlts_Syn_CProductions :: !(DataAlts),decls_Syn_CProductions :: !(Decls),errors_Syn_CProductions :: !(Seq Error),semNames_Syn_CProductions :: !([String])} +wrap_CProductions (T_CProductions sem) (Inh_CProductions _lhsIallNts _lhsIallPragmas _lhsIcontextMap _lhsIerrors _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIunfoldSemDom _lhsIwith_sig) = (let ( _lhsOallTpsFound,_lhsOcataAlts,_lhsOcomments,_lhsOdataAlts,_lhsOdecls,_lhsOerrors,_lhsOsemNames) = - (sem _lhsIallPragmas _lhsIcontextMap _lhsIerrors _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIunfoldSemDom _lhsIwith_sig) + (sem _lhsIallNts _lhsIallPragmas _lhsIcontextMap _lhsIerrors _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIunfoldSemDom _lhsIwith_sig) in (Syn_CProductions _lhsOallTpsFound _lhsOcataAlts _lhsOcomments _lhsOdataAlts _lhsOdecls _lhsOerrors _lhsOsemNames)) sem_CProductions_Cons :: T_CProduction -> T_CProductions -> T_CProductions sem_CProductions_Cons (T_CProduction hd_) (T_CProductions tl_) = - (T_CProductions (\ _lhsIallPragmas + (T_CProductions (\ _lhsIallNts + _lhsIallPragmas _lhsIcontextMap _lhsIerrors _lhsIinh @@ -1728,6 +1822,7 @@ _lhsOdecls :: Decls _lhsOerrors :: (Seq Error) _lhsOsemNames :: ([String]) + _hdOallNts :: (Set NontermIdent) _hdOallPragmas :: PragmaMap _hdOcontextMap :: ContextMap _hdOerrors :: (Seq Error) @@ -1752,6 +1847,7 @@ _hdOsyn :: Attributes _hdOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) _hdOwith_sig :: Bool + _tlOallNts :: (Set NontermIdent) _tlOallPragmas :: PragmaMap _tlOcontextMap :: ContextMap _tlOerrors :: (Seq Error) @@ -1790,28 +1886,31 @@ _tlIdecls :: Decls _tlIerrors :: (Seq Error) _tlIsemNames :: ([String]) - -- "GenerateCode.ag"(line 832, column 17) + -- "GenerateCode.ag"(line 865, column 17) _lhsOdataAlts = _hdIdataAlt : _tlIdataAlts - -- "GenerateCode.ag"(line 891, column 10) + -- "GenerateCode.ag"(line 958, column 10) _lhsOcataAlts = _hdIcataAlt : _tlIcataAlts - -- use rule "GenerateCode.ag"(line 682, column 39) + -- use rule "GenerateCode.ag"(line 706, column 39) _lhsOallTpsFound = _hdIallTpsFound && _tlIallTpsFound - -- use rule "GenerateCode.ag"(line 714, column 52) + -- use rule "GenerateCode.ag"(line 738, column 52) _lhsOcomments = _hdIcomments ++ _tlIcomments - -- use rule "GenerateCode.ag"(line 757, column 44) + -- use rule "GenerateCode.ag"(line 781, column 44) _lhsOdecls = _hdIdecls ++ _tlIdecls - -- use rule "GenerateCode.ag"(line 695, column 32) + -- use rule "GenerateCode.ag"(line 719, column 32) _lhsOerrors = _hdIerrors Seq.<> _tlIerrors - -- use rule "GenerateCode.ag"(line 910, column 61) + -- use rule "GenerateCode.ag"(line 977, column 61) _lhsOsemNames = _hdIsemNames ++ _tlIsemNames -- copy rule (down) + _hdOallNts = + _lhsIallNts + -- copy rule (down) _hdOallPragmas = _lhsIallPragmas -- copy rule (down) @@ -1884,6 +1983,9 @@ _hdOwith_sig = _lhsIwith_sig -- copy rule (down) + _tlOallNts = + _lhsIallNts + -- copy rule (down) _tlOallPragmas = _lhsIallPragmas -- copy rule (down) @@ -1956,13 +2058,14 @@ _tlOwith_sig = _lhsIwith_sig ( _hdIallTpsFound,_hdIcataAlt,_hdIcomments,_hdIdataAlt,_hdIdecls,_hdIerrors,_hdIsemNames) = - (hd_ _hdOallPragmas _hdOcontextMap _hdOerrors _hdOinh _hdOnt _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOparamMap _hdOprefix _hdOsyn _hdOunfoldSemDom _hdOwith_sig) + (hd_ _hdOallNts _hdOallPragmas _hdOcontextMap _hdOerrors _hdOinh _hdOnt _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOparamMap _hdOprefix _hdOsyn _hdOunfoldSemDom _hdOwith_sig) ( _tlIallTpsFound,_tlIcataAlts,_tlIcomments,_tlIdataAlts,_tlIdecls,_tlIerrors,_tlIsemNames) = - (tl_ _tlOallPragmas _tlOcontextMap _tlOerrors _tlOinh _tlOnt _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOparamMap _tlOprefix _tlOsyn _tlOunfoldSemDom _tlOwith_sig) + (tl_ _tlOallNts _tlOallPragmas _tlOcontextMap _tlOerrors _tlOinh _tlOnt _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOparamMap _tlOprefix _tlOsyn _tlOunfoldSemDom _tlOwith_sig) in ( _lhsOallTpsFound,_lhsOcataAlts,_lhsOcomments,_lhsOdataAlts,_lhsOdecls,_lhsOerrors,_lhsOsemNames)))) sem_CProductions_Nil :: T_CProductions sem_CProductions_Nil = - (T_CProductions (\ _lhsIallPragmas + (T_CProductions (\ _lhsIallNts + _lhsIallPragmas _lhsIcontextMap _lhsIerrors _lhsIinh @@ -1993,25 +2096,25 @@ _lhsOdecls :: Decls _lhsOerrors :: (Seq Error) _lhsOsemNames :: ([String]) - -- "GenerateCode.ag"(line 833, column 17) + -- "GenerateCode.ag"(line 866, column 17) _lhsOdataAlts = [] - -- "GenerateCode.ag"(line 892, column 10) + -- "GenerateCode.ag"(line 959, column 10) _lhsOcataAlts = [] - -- use rule "GenerateCode.ag"(line 682, column 39) + -- use rule "GenerateCode.ag"(line 706, column 39) _lhsOallTpsFound = True - -- use rule "GenerateCode.ag"(line 714, column 52) + -- use rule "GenerateCode.ag"(line 738, column 52) _lhsOcomments = [] - -- use rule "GenerateCode.ag"(line 757, column 44) + -- use rule "GenerateCode.ag"(line 781, column 44) _lhsOdecls = [] - -- use rule "GenerateCode.ag"(line 695, column 32) + -- use rule "GenerateCode.ag"(line 719, column 32) _lhsOerrors = Seq.empty - -- use rule "GenerateCode.ag"(line 910, column 61) + -- use rule "GenerateCode.ag"(line 977, column 61) _lhsOsemNames = [] in ( _lhsOallTpsFound,_lhsOcataAlts,_lhsOcomments,_lhsOdataAlts,_lhsOdecls,_lhsOerrors,_lhsOsemNames)))) @@ -2019,6 +2122,7 @@ {- visit 0: inherited attributes: + allNts : Set NontermIdent children : [(Identifier,Type,Bool)] con : ConstructorIdent higherOrderChildren : [(Identifier,Type,Bool)] @@ -2045,6 +2149,7 @@ prefix : String syn : Attributes terminals : [Identifier] + unfoldSemDom : NontermIdent -> Int -> [String] -> Code.Type what : String chained attributes: declsAbove : [Decl] @@ -2108,7 +2213,7 @@ local addLinePragma : _ local decls : _ local definedInsts : _ - local name : _ + local rulename : _ local mkTp : _ local orgParams : _ local evalTp : _ @@ -2122,7 +2227,8 @@ sem_CRule (CRule _name _isIn _hasCode _nt _con _field _childnt _tp _pattern _rhs _defines _owrt _origin _uses) = (sem_CRule_CRule _name _isIn _hasCode _nt _con _field _childnt _tp (sem_Pattern _pattern) _rhs _defines _owrt _origin _uses) -- semantic domain -newtype T_CRule = T_CRule (([(Identifier,Type,Bool)]) -> +newtype T_CRule = T_CRule ((Set NontermIdent) -> + ([(Identifier,Type,Bool)]) -> ConstructorIdent -> ([Decl]) -> (Seq Error) -> @@ -2150,13 +2256,14 @@ String -> Attributes -> ([Identifier]) -> + (NontermIdent -> Int -> [String] -> Code.Type) -> String -> ( Bool,(DeclBlocks -> DeclBlocks),([String]),Decls,([Decl]),([Identifier]),(Seq Error),Exprs,([Decl]),([Type]),(Set String))) -data Inh_CRule = Inh_CRule {children_Inh_CRule :: [(Identifier,Type,Bool)],con_Inh_CRule :: ConstructorIdent,declsAbove_Inh_CRule :: [Decl],errors_Inh_CRule :: Seq Error,higherOrderChildren_Inh_CRule :: [(Identifier,Type,Bool)],inh_Inh_CRule :: Attributes,instVisitNrs_Inh_CRule :: Map Identifier Int,nr_Inh_CRule :: Int,nt_Inh_CRule :: NontermIdent,o_case_Inh_CRule :: Bool,o_cata_Inh_CRule :: Bool,o_costcentre_Inh_CRule :: Bool,o_data_Inh_CRule :: Maybe Bool,o_linePragmas_Inh_CRule :: Bool,o_newtypes_Inh_CRule :: Bool,o_pretty_Inh_CRule :: Bool,o_rename_Inh_CRule :: Bool,o_sem_Inh_CRule :: Bool,o_sig_Inh_CRule :: Bool,o_splitsems_Inh_CRule :: Bool,o_strictwrap_Inh_CRule :: Bool,o_traces_Inh_CRule :: Bool,o_unbox_Inh_CRule :: Bool,paramInstMap_Inh_CRule :: Map Identifier (NontermIdent, [String]),paramMap_Inh_CRule :: ParamMap,prefix_Inh_CRule :: String,syn_Inh_CRule :: Attributes,terminals_Inh_CRule :: [Identifier],what_Inh_CRule :: String} -data Syn_CRule = Syn_CRule {allTpsFound_Syn_CRule :: Bool,bldBlocksFun_Syn_CRule :: DeclBlocks -> DeclBlocks,comments_Syn_CRule :: [String],decls_Syn_CRule :: Decls,declsAbove_Syn_CRule :: [Decl],definedInsts_Syn_CRule :: [Identifier],errors_Syn_CRule :: Seq Error,exprs_Syn_CRule :: Exprs,tSigs_Syn_CRule :: [Decl],tps_Syn_CRule :: [Type],usedVars_Syn_CRule :: Set String} -wrap_CRule (T_CRule sem) (Inh_CRule _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIerrors _lhsIhigherOrderChildren _lhsIinh _lhsIinstVisitNrs _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIwhat) = +data Inh_CRule = Inh_CRule {allNts_Inh_CRule :: !(Set NontermIdent),children_Inh_CRule :: !([(Identifier,Type,Bool)]),con_Inh_CRule :: !(ConstructorIdent),declsAbove_Inh_CRule :: !([Decl]),errors_Inh_CRule :: !(Seq Error),higherOrderChildren_Inh_CRule :: !([(Identifier,Type,Bool)]),inh_Inh_CRule :: !(Attributes),instVisitNrs_Inh_CRule :: !(Map Identifier Int),nr_Inh_CRule :: !(Int),nt_Inh_CRule :: !(NontermIdent),o_case_Inh_CRule :: !(Bool),o_cata_Inh_CRule :: !(Bool),o_costcentre_Inh_CRule :: !(Bool),o_data_Inh_CRule :: !(Maybe Bool),o_linePragmas_Inh_CRule :: !(Bool),o_newtypes_Inh_CRule :: !(Bool),o_pretty_Inh_CRule :: !(Bool),o_rename_Inh_CRule :: !(Bool),o_sem_Inh_CRule :: !(Bool),o_sig_Inh_CRule :: !(Bool),o_splitsems_Inh_CRule :: !(Bool),o_strictwrap_Inh_CRule :: !(Bool),o_traces_Inh_CRule :: !(Bool),o_unbox_Inh_CRule :: !(Bool),paramInstMap_Inh_CRule :: !(Map Identifier (NontermIdent, [String])),paramMap_Inh_CRule :: !(ParamMap),prefix_Inh_CRule :: !(String),syn_Inh_CRule :: !(Attributes),terminals_Inh_CRule :: !([Identifier]),unfoldSemDom_Inh_CRule :: !(NontermIdent -> Int -> [String] -> Code.Type),what_Inh_CRule :: !(String)} +data Syn_CRule = Syn_CRule {allTpsFound_Syn_CRule :: !(Bool),bldBlocksFun_Syn_CRule :: !(DeclBlocks -> DeclBlocks),comments_Syn_CRule :: !([String]),decls_Syn_CRule :: !(Decls),declsAbove_Syn_CRule :: !([Decl]),definedInsts_Syn_CRule :: !([Identifier]),errors_Syn_CRule :: !(Seq Error),exprs_Syn_CRule :: !(Exprs),tSigs_Syn_CRule :: !([Decl]),tps_Syn_CRule :: !([Type]),usedVars_Syn_CRule :: !(Set String)} +wrap_CRule (T_CRule sem) (Inh_CRule _lhsIallNts _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIerrors _lhsIhigherOrderChildren _lhsIinh _lhsIinstVisitNrs _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIwhat) = (let ( _lhsOallTpsFound,_lhsObldBlocksFun,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOerrors,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars) = - (sem _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIerrors _lhsIhigherOrderChildren _lhsIinh _lhsIinstVisitNrs _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIwhat) + (sem _lhsIallNts _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIerrors _lhsIhigherOrderChildren _lhsIinh _lhsIinstVisitNrs _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIwhat) in (Syn_CRule _lhsOallTpsFound _lhsObldBlocksFun _lhsOcomments _lhsOdecls _lhsOdeclsAbove _lhsOdefinedInsts _lhsOerrors _lhsOexprs _lhsOtSigs _lhsOtps _lhsOusedVars)) sem_CRule_CChildVisit :: Identifier -> NontermIdent -> @@ -2166,7 +2273,8 @@ Bool -> T_CRule sem_CRule_CChildVisit name_ nt_ nr_ inh_ syn_ isLast_ = - (T_CRule (\ _lhsIchildren + (T_CRule (\ _lhsIallNts + _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIerrors @@ -2194,6 +2302,7 @@ _lhsIprefix _lhsIsyn _lhsIterminals + _lhsIunfoldSemDom _lhsIwhat -> (let _lhsOexprs :: Exprs _lhsOusedVars :: (Set String) @@ -2206,15 +2315,15 @@ _lhsOdecls :: Decls _lhsOdefinedInsts :: ([Identifier]) _lhsOerrors :: (Seq Error) - -- "GenerateCode.ag"(line 161, column 18) + -- "GenerateCode.ag"(line 181, column 18) _costCentreDescr = show _lhsInt ++ ":" ++ show _lhsIcon ++ ":" ++ show name_ ++ ":" ++ show nt_ ++ ":" ++ show nr_ - -- "GenerateCode.ag"(line 162, column 18) + -- "GenerateCode.ag"(line 182, column 18) _addCostCentre = \v -> if _lhsIo_costcentre then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v else v - -- "GenerateCode.ag"(line 165, column 18) + -- "GenerateCode.ag"(line 185, column 18) _decls = let lhsVars = map (attrname True name_) (Map.keys syn_) ++ if isLast_ then [] else [unwrap ++ funname name_ (nr_+1)] @@ -2223,72 +2332,74 @@ tuple = mkTupleLhs _lhsIo_unbox (null $ Map.keys inh_) lhsVars rhs = _addCostCentre $ App (funname name_ nr_) (map SimpleExpr rhsVars) in [Decl tuple rhs (Set.fromList lhsVars) (Set.fromList (funname name_ nr_ : rhsVars))] - -- "GenerateCode.ag"(line 241, column 7) + -- "GenerateCode.ag"(line 261, column 7) _isSuperfluousHigherOrderIntra = _lhsInr <= Map.findWithDefault (-1) name_ _lhsIinstVisitNrs - -- "GenerateCode.ag"(line 255, column 8) + -- "GenerateCode.ag"(line 275, column 8) _names = if _isSuperfluousHigherOrderIntra then [] else [funname name_ (nr_+1)] - -- "GenerateCode.ag"(line 259, column 8) + -- "GenerateCode.ag"(line 279, column 8) _lhsOexprs = let wrap = if _lhsIo_newtypes then \x -> App (typeName nt_ (nr_ + 1)) [x] else id - in map (wrap . SimpleExpr) _names - -- "GenerateCode.ag"(line 267, column 7) + addType expr | null _instParams = expr + | otherwise = TypedExpr expr (_lhsIunfoldSemDom nt_ (nr_+1) _instParams ) + in map (wrap . addType . SimpleExpr) _names + -- "GenerateCode.ag"(line 291, column 7) _lhsOusedVars = Set.fromList _names - -- "GenerateCode.ag"(line 291, column 19) + -- "GenerateCode.ag"(line 315, column 19) _mkTp = _evalTp . SimpleType . typeToHaskellString (Just nt_) _orgParams - -- "GenerateCode.ag"(line 292, column 19) + -- "GenerateCode.ag"(line 316, column 19) _definedTps = [ TSig (attrname True name_ a) (_mkTp tp) | (a,tp) <- Map.toList syn_ ] - -- "GenerateCode.ag"(line 293, column 19) + -- "GenerateCode.ag"(line 317, column 19) _nextTp = typeName nt_ (nr_+1) - -- "GenerateCode.ag"(line 294, column 19) + -- "GenerateCode.ag"(line 318, column 19) _lhsOtSigs = (if isLast_ then id else (TSig (funname name_ (nr_+1)) (TypeApp (SimpleType _nextTp) (map SimpleType _instParams )) :)) _definedTps - -- "GenerateCode.ag"(line 296, column 19) + -- "GenerateCode.ag"(line 320, column 19) _orgParams = map getName $ Map.findWithDefault [] nt_ _lhsIparamMap - -- "GenerateCode.ag"(line 297, column 19) + -- "GenerateCode.ag"(line 321, column 19) _instParams = snd $ Map.findWithDefault (nt_,[]) name_ _lhsIparamInstMap - -- "GenerateCode.ag"(line 298, column 19) + -- "GenerateCode.ag"(line 322, column 19) _replParamMap = Map.fromList (zip _orgParams _instParams ) - -- "GenerateCode.ag"(line 299, column 19) + -- "GenerateCode.ag"(line 323, column 19) _replace = \k -> Map.findWithDefault k k _replParamMap - -- "GenerateCode.ag"(line 300, column 19) + -- "GenerateCode.ag"(line 324, column 19) _evalTp = if null _orgParams then id else evalType _replace - -- "GenerateCode.ag"(line 323, column 19) + -- "GenerateCode.ag"(line 347, column 19) _lhsOtps = if _isSuperfluousHigherOrderIntra then [] - else [Haskell _nextTp] - -- "GenerateCode.ag"(line 448, column 7) + else [NT (ntOfVisit nt_ (nr_+1)) _instParams ] + -- "GenerateCode.ag"(line 472, column 7) _lhsOdeclsAbove = [] - -- "GenerateCode.ag"(line 461, column 7) + -- "GenerateCode.ag"(line 485, column 7) _lhsObldBlocksFun = DeclBlock _lhsIdeclsAbove (head _decls ) - -- use rule "GenerateCode.ag"(line 320, column 39) + -- use rule "GenerateCode.ag"(line 344, column 39) _lhsOallTpsFound = True - -- use rule "GenerateCode.ag"(line 714, column 52) + -- use rule "GenerateCode.ag"(line 738, column 52) _lhsOcomments = [] - -- use rule "GenerateCode.ag"(line 122, column 34) + -- use rule "GenerateCode.ag"(line 138, column 34) _lhsOdecls = _decls - -- use rule "GenerateCode.ag"(line 175, column 55) + -- use rule "GenerateCode.ag"(line 195, column 55) _lhsOdefinedInsts = [] - -- use rule "GenerateCode.ag"(line 695, column 32) + -- use rule "GenerateCode.ag"(line 719, column 32) _lhsOerrors = Seq.empty in ( _lhsOallTpsFound,_lhsObldBlocksFun,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOerrors,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars)))) @@ -2308,7 +2419,8 @@ (Set (Identifier, Identifier)) -> T_CRule sem_CRule_CRule name_ isIn_ hasCode_ nt_ con_ field_ childnt_ tp_ (T_Pattern pattern_) rhs_ defines_ owrt_ origin_ uses_ = - (T_CRule (\ _lhsIchildren + (T_CRule (\ _lhsIallNts + _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIerrors @@ -2336,6 +2448,7 @@ _lhsIprefix _lhsIsyn _lhsIterminals + _lhsIunfoldSemDom _lhsIwhat -> (let _lhsOexprs :: Exprs _lhsOusedVars :: (Set String) @@ -2352,46 +2465,50 @@ _patternIcopy :: Pattern _patternIdefinedInsts :: ([Identifier]) _patternIpatternAttributes :: ([(Identifier, Identifier)]) - -- "GenerateCode.ag"(line 124, column 12) + -- "GenerateCode.ag"(line 140, column 12) _instTypes = map (\(n,NT t _,_) -> (n,t)) _lhsIhigherOrderChildren - -- "GenerateCode.ag"(line 125, column 12) + -- "GenerateCode.ag"(line 141, column 12) _originComment = if _lhsIo_pretty then (Comment origin_:) else id - -- "GenerateCode.ag"(line 128, column 12) + -- "GenerateCode.ag"(line 144, column 12) _instDecls = [ Decl (Pattern3 (Alias _INST' inst (Underscore (getPos inst)) [])) - (App (cataname _lhsIprefix (fromJust $ inst `lookup` _instTypes )) - [SimpleExpr instLocFieldName]) + ( let nm = fromJust $ inst `lookup` _instTypes + in case nm `Set.member` _lhsIallNts of + True -> App (cataname _lhsIprefix nm) + [SimpleExpr instLocFieldName] + False -> SimpleExpr instLocFieldName + ) (Set.singleton instSemFieldName) (Set.singleton instLocFieldName) | inst <- _definedInsts , let instLocFieldName = attrname True _INST inst , let instSemFieldName = attrname False _INST' inst ] - -- "GenerateCode.ag"(line 136, column 12) + -- "GenerateCode.ag"(line 156, column 12) _patDescr = if isIn_ then "_" else concat $ intersperse "," (map (\(f,a) -> show f ++ "." ++ show a) _patternIpatternAttributes) - -- "GenerateCode.ag"(line 139, column 12) + -- "GenerateCode.ag"(line 159, column 12) _traceDescr = show nt_ ++ " :: " ++ show con_ ++ " :: " ++ _patDescr - -- "GenerateCode.ag"(line 141, column 12) + -- "GenerateCode.ag"(line 161, column 12) _addTrace = \v -> if _lhsIo_traces then Trace _traceDescr v else v - -- "GenerateCode.ag"(line 144, column 12) + -- "GenerateCode.ag"(line 164, column 12) _costCentreDescr = show nt_ ++ ":" ++ show con_ ++ ":" ++ _patDescr - -- "GenerateCode.ag"(line 145, column 12) + -- "GenerateCode.ag"(line 165, column 12) _addCostCentre = \v -> if _lhsIo_costcentre then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v else v - -- "GenerateCode.ag"(line 148, column 12) + -- "GenerateCode.ag"(line 168, column 12) _addLinePragma = \v -> let p = getPos name_ hasPos = line p > 0 && column p >= 0 && not (null (file p)) @@ -2400,7 +2517,7 @@ $ LineExpr $ v else v - -- "GenerateCode.ag"(line 155, column 12) + -- "GenerateCode.ag"(line 175, column 12) _decls = if hasCode_ then _originComment ( Decl (Pattern3 _patternIcopy) (_addTrace $ _addCostCentre $ _addLinePragma $ (TextExpr rhs_)) @@ -2408,69 +2525,69 @@ (Set.fromList [attrname True fld nm | (fld,nm) <- Set.toList uses_]) : _instDecls ) else _instDecls - -- "GenerateCode.ag"(line 180, column 12) + -- "GenerateCode.ag"(line 200, column 12) _definedInsts = if isIn_ then [] else _patternIdefinedInsts - -- "GenerateCode.ag"(line 250, column 12) - _name = + -- "GenerateCode.ag"(line 270, column 12) + _rulename = if field_ == _LOC && name_ `elem` _lhsIterminals then funname name_ 0 else attrname isIn_ field_ name_ - -- "GenerateCode.ag"(line 253, column 12) + -- "GenerateCode.ag"(line 273, column 12) _lhsOexprs = - [SimpleExpr _name ] - -- "GenerateCode.ag"(line 265, column 7) + [SimpleExpr _rulename ] + -- "GenerateCode.ag"(line 289, column 7) _lhsOusedVars = - Set.singleton _name - -- "GenerateCode.ag"(line 275, column 19) + Set.singleton _rulename + -- "GenerateCode.ag"(line 299, column 19) _mkTp = SimpleType . typeToHaskellString (Just _lhsInt) _orgParams - -- "GenerateCode.ag"(line 276, column 19) + -- "GenerateCode.ag"(line 300, column 19) _lhsOtSigs = [ TSig (attrname False field attr) (_evalTp field $ _mkTp (fromJust tp)) | (field,attr,tp) <- Map.elems defines_, isJust tp ] - -- "GenerateCode.ag"(line 279, column 19) + -- "GenerateCode.ag"(line 303, column 19) _orgParams = map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap - -- "GenerateCode.ag"(line 280, column 19) + -- "GenerateCode.ag"(line 304, column 19) _evalTp = \field tp -> let orgFldParams = map getName $ Map.findWithDefault [] childNt _lhsIparamMap (childNt,instParams) = Map.findWithDefault (_lhsInt,[]) field _lhsIparamInstMap replMap = Map.fromList (zip orgFldParams instParams) - replace k = Map.findWithDefault k k replMap + replace k = Map.findWithDefault ('@':k) k replMap in if null instParams then if null _orgParams then tp else idEvalType tp else evalType replace tp - -- "GenerateCode.ag"(line 322, column 23) + -- "GenerateCode.ag"(line 346, column 23) __tup3 = maybe ([],False) (\tp -> ([substSelf (fromJust childnt_) tp],True)) tp_ - -- "GenerateCode.ag"(line 322, column 23) + -- "GenerateCode.ag"(line 346, column 23) (_lhsOtps,_) = __tup3 - -- "GenerateCode.ag"(line 322, column 23) + -- "GenerateCode.ag"(line 346, column 23) (_,_lhsOallTpsFound) = __tup3 - -- "GenerateCode.ag"(line 446, column 7) + -- "GenerateCode.ag"(line 470, column 7) _lhsOdeclsAbove = _lhsIdeclsAbove ++ _decls - -- "GenerateCode.ag"(line 459, column 7) + -- "GenerateCode.ag"(line 483, column 7) _lhsObldBlocksFun = id - -- "GenerateCode.ag"(line 701, column 12) + -- "GenerateCode.ag"(line 725, column 12) _lhsOerrors = let nameOf (Alias _ _ _ pats@(_:_)) = Ident (show (map (\(Alias _ a _ _)->a) pats)) (getPos name_) nameOf _ = name_ in maybe (Seq.single (MissingTypeSig _lhsInt _lhsIcon (nameOf _patternIcopy))) (const Seq.empty) tp_ - -- "GenerateCode.ag"(line 741, column 18) + -- "GenerateCode.ag"(line 765, column 18) _lhsOcomments = [ makeLocalComment 11 _lhsIwhat name tp | (field,name,tp) <- Map.elems defines_, field == _LOC ] ++ [ makeLocalComment 11 "inst " name tp | (field,name,tp) <- Map.elems defines_, field == _INST ] - -- use rule "GenerateCode.ag"(line 122, column 34) + -- use rule "GenerateCode.ag"(line 138, column 34) _lhsOdecls = _decls - -- use rule "GenerateCode.ag"(line 175, column 55) + -- use rule "GenerateCode.ag"(line 195, column 55) _lhsOdefinedInsts = _definedInsts ( _patternIcopy,_patternIdefinedInsts,_patternIpatternAttributes) = @@ -2545,8 +2662,8 @@ String -> Attributes -> ( ([String]),([Decl]),(Map (NontermIdent, Int) ([String], Code.Type)),Decls)) -data Inh_CSegment = Inh_CSegment {inh_Inh_CSegment :: Attributes,isLast_Inh_CSegment :: Bool,nr_Inh_CSegment :: Int,nt_Inh_CSegment :: NontermIdent,o_case_Inh_CSegment :: Bool,o_cata_Inh_CSegment :: Bool,o_costcentre_Inh_CSegment :: Bool,o_data_Inh_CSegment :: Maybe Bool,o_linePragmas_Inh_CSegment :: Bool,o_newtypes_Inh_CSegment :: Bool,o_pretty_Inh_CSegment :: Bool,o_rename_Inh_CSegment :: Bool,o_sem_Inh_CSegment :: Bool,o_sig_Inh_CSegment :: Bool,o_splitsems_Inh_CSegment :: Bool,o_strictwrap_Inh_CSegment :: Bool,o_traces_Inh_CSegment :: Bool,o_unbox_Inh_CSegment :: Bool,paramMap_Inh_CSegment :: ParamMap,prefix_Inh_CSegment :: String,syn_Inh_CSegment :: Attributes} -data Syn_CSegment = Syn_CSegment {comments_Syn_CSegment :: [String],semDom_Syn_CSegment :: [Decl],semDomUnfoldGath_Syn_CSegment :: Map (NontermIdent, Int) ([String], Code.Type),wrapDecls_Syn_CSegment :: Decls} +data Inh_CSegment = Inh_CSegment {inh_Inh_CSegment :: !(Attributes),isLast_Inh_CSegment :: !(Bool),nr_Inh_CSegment :: !(Int),nt_Inh_CSegment :: !(NontermIdent),o_case_Inh_CSegment :: !(Bool),o_cata_Inh_CSegment :: !(Bool),o_costcentre_Inh_CSegment :: !(Bool),o_data_Inh_CSegment :: !(Maybe Bool),o_linePragmas_Inh_CSegment :: !(Bool),o_newtypes_Inh_CSegment :: !(Bool),o_pretty_Inh_CSegment :: !(Bool),o_rename_Inh_CSegment :: !(Bool),o_sem_Inh_CSegment :: !(Bool),o_sig_Inh_CSegment :: !(Bool),o_splitsems_Inh_CSegment :: !(Bool),o_strictwrap_Inh_CSegment :: !(Bool),o_traces_Inh_CSegment :: !(Bool),o_unbox_Inh_CSegment :: !(Bool),paramMap_Inh_CSegment :: !(ParamMap),prefix_Inh_CSegment :: !(String),syn_Inh_CSegment :: !(Attributes)} +data Syn_CSegment = Syn_CSegment {comments_Syn_CSegment :: !([String]),semDom_Syn_CSegment :: !([Decl]),semDomUnfoldGath_Syn_CSegment :: !(Map (NontermIdent, Int) ([String], Code.Type)),wrapDecls_Syn_CSegment :: !(Decls)} wrap_CSegment (T_CSegment sem) (Inh_CSegment _lhsIinh _lhsIisLast _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsIsyn) = (let ( _lhsOcomments,_lhsOsemDom,_lhsOsemDomUnfoldGath,_lhsOwrapDecls) = (sem _lhsIinh _lhsIisLast _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsIsyn) @@ -2580,24 +2697,24 @@ _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) _lhsOwrapDecls :: Decls _lhsOcomments :: ([String]) - -- "GenerateCode.ag"(line 573, column 15) + -- "GenerateCode.ag"(line 597, column 15) _tp = foldr Arr _synTps _inhTps - -- "GenerateCode.ag"(line 574, column 15) + -- "GenerateCode.ag"(line 598, column 15) _inhTps = [SimpleType (typeToHaskellString (Just _lhsInt) _params tp) | tp <- Map.elems inh_] - -- "GenerateCode.ag"(line 575, column 15) + -- "GenerateCode.ag"(line 599, column 15) _synTps = mkTupleType _lhsIo_unbox (null _inhTps ) ([SimpleType (typeToHaskellString (Just _lhsInt) _params tp) | tp <- Map.elems syn_] ++ _continuation ) - -- "GenerateCode.ag"(line 576, column 15) + -- "GenerateCode.ag"(line 600, column 15) _continuation = if _lhsIisLast then [] - else [TypeApp (SimpleType (typeName _lhsInt (_lhsInr + 1))) (map SimpleType _params )] - -- "GenerateCode.ag"(line 579, column 15) + else [TypeApp (SimpleType (typeName _lhsInt (_lhsInr + 1))) (map (SimpleType . ('@':)) _params )] + -- "GenerateCode.ag"(line 603, column 15) _params = map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap - -- "GenerateCode.ag"(line 580, column 15) + -- "GenerateCode.ag"(line 604, column 15) _lhsOsemDom = let name = typeName _lhsInt _lhsInr evalTp | null _params = id @@ -2605,10 +2722,10 @@ in if _lhsIo_newtypes then [ Code.NewType name _params name (evalTp _tp ) ] else [ Code.Type name _params (evalTp _tp ) ] - -- "GenerateCode.ag"(line 591, column 7) + -- "GenerateCode.ag"(line 615, column 7) _lhsOsemDomUnfoldGath = Map.singleton (_lhsInt, _lhsInr) (_params , _tp ) - -- "GenerateCode.ag"(line 665, column 15) + -- "GenerateCode.ag"(line 689, column 15) _lhsOwrapDecls = let lhsVars = map (lhsname False) (Map.keys syn_) ++ if _lhsIisLast then [] else [unwrap ++ sem (_lhsInr+1)] @@ -2619,7 +2736,7 @@ sem 0 = var sem n = var ++ "_" ++ show n in [ Decl (mkTupleLhs _lhsIo_unbox (null $ Map.keys inh_) lhsVars) (App (sem _lhsInr) rhs) (Set.fromList lhsVars) (Set.fromList rhsVars) ] - -- "GenerateCode.ag"(line 719, column 18) + -- "GenerateCode.ag"(line 743, column 18) _lhsOcomments = let body = map ind (showsSegment (CSegment inh_ syn_)) in if null body @@ -2689,8 +2806,8 @@ String -> Attributes -> ( ([String]),Bool,([Decl]),(Map (NontermIdent, Int) ([String], Code.Type)),Decls)) -data Inh_CSegments = Inh_CSegments {inh_Inh_CSegments :: Attributes,nr_Inh_CSegments :: Int,nt_Inh_CSegments :: NontermIdent,o_case_Inh_CSegments :: Bool,o_cata_Inh_CSegments :: Bool,o_costcentre_Inh_CSegments :: Bool,o_data_Inh_CSegments :: Maybe Bool,o_linePragmas_Inh_CSegments :: Bool,o_newtypes_Inh_CSegments :: Bool,o_pretty_Inh_CSegments :: Bool,o_rename_Inh_CSegments :: Bool,o_sem_Inh_CSegments :: Bool,o_sig_Inh_CSegments :: Bool,o_splitsems_Inh_CSegments :: Bool,o_strictwrap_Inh_CSegments :: Bool,o_traces_Inh_CSegments :: Bool,o_unbox_Inh_CSegments :: Bool,paramMap_Inh_CSegments :: ParamMap,prefix_Inh_CSegments :: String,syn_Inh_CSegments :: Attributes} -data Syn_CSegments = Syn_CSegments {comments_Syn_CSegments :: [String],isNil_Syn_CSegments :: Bool,semDom_Syn_CSegments :: [Decl],semDomUnfoldGath_Syn_CSegments :: Map (NontermIdent, Int) ([String], Code.Type),wrapDecls_Syn_CSegments :: Decls} +data Inh_CSegments = Inh_CSegments {inh_Inh_CSegments :: !(Attributes),nr_Inh_CSegments :: !(Int),nt_Inh_CSegments :: !(NontermIdent),o_case_Inh_CSegments :: !(Bool),o_cata_Inh_CSegments :: !(Bool),o_costcentre_Inh_CSegments :: !(Bool),o_data_Inh_CSegments :: !(Maybe Bool),o_linePragmas_Inh_CSegments :: !(Bool),o_newtypes_Inh_CSegments :: !(Bool),o_pretty_Inh_CSegments :: !(Bool),o_rename_Inh_CSegments :: !(Bool),o_sem_Inh_CSegments :: !(Bool),o_sig_Inh_CSegments :: !(Bool),o_splitsems_Inh_CSegments :: !(Bool),o_strictwrap_Inh_CSegments :: !(Bool),o_traces_Inh_CSegments :: !(Bool),o_unbox_Inh_CSegments :: !(Bool),paramMap_Inh_CSegments :: !(ParamMap),prefix_Inh_CSegments :: !(String),syn_Inh_CSegments :: !(Attributes)} +data Syn_CSegments = Syn_CSegments {comments_Syn_CSegments :: !([String]),isNil_Syn_CSegments :: !(Bool),semDom_Syn_CSegments :: !([Decl]),semDomUnfoldGath_Syn_CSegments :: !(Map (NontermIdent, Int) ([String], Code.Type)),wrapDecls_Syn_CSegments :: !(Decls)} wrap_CSegments (T_CSegments sem) (Inh_CSegments _lhsIinh _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsIsyn) = (let ( _lhsOcomments,_lhsOisNil,_lhsOsemDom,_lhsOsemDomUnfoldGath,_lhsOwrapDecls) = (sem _lhsIinh _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamMap _lhsIprefix _lhsIsyn) @@ -2774,25 +2891,25 @@ _tlIsemDom :: ([Decl]) _tlIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) _tlIwrapDecls :: Decls - -- "GenerateCode.ag"(line 200, column 11) + -- "GenerateCode.ag"(line 220, column 11) _tlOnr = _lhsInr + 1 - -- "GenerateCode.ag"(line 213, column 12) + -- "GenerateCode.ag"(line 233, column 12) _lhsOisNil = False - -- "GenerateCode.ag"(line 214, column 12) + -- "GenerateCode.ag"(line 234, column 12) _hdOisLast = _tlIisNil - -- use rule "GenerateCode.ag"(line 714, column 52) + -- use rule "GenerateCode.ag"(line 738, column 52) _lhsOcomments = _hdIcomments ++ _tlIcomments - -- use rule "GenerateCode.ag"(line 568, column 50) + -- use rule "GenerateCode.ag"(line 592, column 50) _lhsOsemDom = _hdIsemDom ++ _tlIsemDom - -- use rule "GenerateCode.ag"(line 587, column 86) + -- use rule "GenerateCode.ag"(line 611, column 86) _lhsOsemDomUnfoldGath = _hdIsemDomUnfoldGath `Map.union` _tlIsemDomUnfoldGath - -- use rule "GenerateCode.ag"(line 663, column 52) + -- use rule "GenerateCode.ag"(line 687, column 52) _lhsOwrapDecls = _hdIwrapDecls ++ _tlIwrapDecls -- copy rule (down) @@ -2944,19 +3061,19 @@ _lhsOsemDom :: ([Decl]) _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) _lhsOwrapDecls :: Decls - -- "GenerateCode.ag"(line 215, column 10) + -- "GenerateCode.ag"(line 235, column 10) _lhsOisNil = True - -- use rule "GenerateCode.ag"(line 714, column 52) + -- use rule "GenerateCode.ag"(line 738, column 52) _lhsOcomments = [] - -- use rule "GenerateCode.ag"(line 568, column 50) + -- use rule "GenerateCode.ag"(line 592, column 50) _lhsOsemDom = [] - -- use rule "GenerateCode.ag"(line 587, column 86) + -- use rule "GenerateCode.ag"(line 611, column 86) _lhsOsemDomUnfoldGath = Map.empty - -- use rule "GenerateCode.ag"(line 663, column 52) + -- use rule "GenerateCode.ag"(line 687, column 52) _lhsOwrapDecls = [] in ( _lhsOcomments,_lhsOisNil,_lhsOsemDom,_lhsOsemDomUnfoldGath,_lhsOwrapDecls)))) @@ -2964,6 +3081,7 @@ {- visit 0: inherited attributes: + allNts : Set NontermIdent allPragmas : PragmaMap children : [(Identifier,Type,Bool)] con : ConstructorIdent @@ -3041,7 +3159,8 @@ sem_CVisit (CVisit _inh _syn _vss _intra _ordered) = (sem_CVisit_CVisit _inh _syn (sem_Sequence _vss) (sem_Sequence _intra) _ordered) -- semantic domain -newtype T_CVisit = T_CVisit (PragmaMap -> +newtype T_CVisit = T_CVisit ((Set NontermIdent) -> + PragmaMap -> ([(Identifier,Type,Bool)]) -> ConstructorIdent -> ContextMap -> @@ -3075,11 +3194,11 @@ (NontermIdent -> Int -> [String] -> Code.Type) -> Bool -> ( Bool,([String]),Decls,(Seq Error),(Map Identifier Int),Exprs,(Set String),([String]))) -data Inh_CVisit = Inh_CVisit {allPragmas_Inh_CVisit :: PragmaMap,children_Inh_CVisit :: [(Identifier,Type,Bool)],con_Inh_CVisit :: ConstructorIdent,contextMap_Inh_CVisit :: ContextMap,errors_Inh_CVisit :: Seq Error,inh_Inh_CVisit :: Attributes,instVisitNrs_Inh_CVisit :: Map Identifier Int,isLast_Inh_CVisit :: Bool,nextIntra_Inh_CVisit :: Exprs,nextIntraVars_Inh_CVisit :: Set String,nr_Inh_CVisit :: Int,nt_Inh_CVisit :: NontermIdent,o_case_Inh_CVisit :: Bool,o_cata_Inh_CVisit :: Bool,o_costcentre_Inh_CVisit :: Bool,o_data_Inh_CVisit :: Maybe Bool,o_linePragmas_Inh_CVisit :: Bool,o_newtypes_Inh_CVisit :: Bool,o_pretty_Inh_CVisit :: Bool,o_rename_Inh_CVisit :: Bool,o_sem_Inh_CVisit :: Bool,o_sig_Inh_CVisit :: Bool,o_splitsems_Inh_CVisit :: Bool,o_strictwrap_Inh_CVisit :: Bool,o_traces_Inh_CVisit :: Bool,o_unbox_Inh_CVisit :: Bool,paramInstMap_Inh_CVisit :: Map Identifier (NontermIdent, [String]),paramMap_Inh_CVisit :: ParamMap,prefix_Inh_CVisit :: String,syn_Inh_CVisit :: Attributes,terminals_Inh_CVisit :: [Identifier],unfoldSemDom_Inh_CVisit :: NontermIdent -> Int -> [String] -> Code.Type,with_sig_Inh_CVisit :: Bool} -data Syn_CVisit = Syn_CVisit {allTpsFound_Syn_CVisit :: Bool,comments_Syn_CVisit :: [String],decls_Syn_CVisit :: Decls,errors_Syn_CVisit :: Seq Error,gatherInstVisitNrs_Syn_CVisit :: Map Identifier Int,intra_Syn_CVisit :: Exprs,intraVars_Syn_CVisit :: Set String,semNames_Syn_CVisit :: [String]} -wrap_CVisit (T_CVisit sem) (Inh_CVisit _lhsIallPragmas _lhsIchildren _lhsIcon _lhsIcontextMap _lhsIerrors _lhsIinh _lhsIinstVisitNrs _lhsIisLast _lhsInextIntra _lhsInextIntraVars _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIwith_sig) = +data Inh_CVisit = Inh_CVisit {allNts_Inh_CVisit :: !(Set NontermIdent),allPragmas_Inh_CVisit :: !(PragmaMap),children_Inh_CVisit :: !([(Identifier,Type,Bool)]),con_Inh_CVisit :: !(ConstructorIdent),contextMap_Inh_CVisit :: !(ContextMap),errors_Inh_CVisit :: !(Seq Error),inh_Inh_CVisit :: !(Attributes),instVisitNrs_Inh_CVisit :: !(Map Identifier Int),isLast_Inh_CVisit :: !(Bool),nextIntra_Inh_CVisit :: !(Exprs),nextIntraVars_Inh_CVisit :: !(Set String),nr_Inh_CVisit :: !(Int),nt_Inh_CVisit :: !(NontermIdent),o_case_Inh_CVisit :: !(Bool),o_cata_Inh_CVisit :: !(Bool),o_costcentre_Inh_CVisit :: !(Bool),o_data_Inh_CVisit :: !(Maybe Bool),o_linePragmas_Inh_CVisit :: !(Bool),o_newtypes_Inh_CVisit :: !(Bool),o_pretty_Inh_CVisit :: !(Bool),o_rename_Inh_CVisit :: !(Bool),o_sem_Inh_CVisit :: !(Bool),o_sig_Inh_CVisit :: !(Bool),o_splitsems_Inh_CVisit :: !(Bool),o_strictwrap_Inh_CVisit :: !(Bool),o_traces_Inh_CVisit :: !(Bool),o_unbox_Inh_CVisit :: !(Bool),paramInstMap_Inh_CVisit :: !(Map Identifier (NontermIdent, [String])),paramMap_Inh_CVisit :: !(ParamMap),prefix_Inh_CVisit :: !(String),syn_Inh_CVisit :: !(Attributes),terminals_Inh_CVisit :: !([Identifier]),unfoldSemDom_Inh_CVisit :: !(NontermIdent -> Int -> [String] -> Code.Type),with_sig_Inh_CVisit :: !(Bool)} +data Syn_CVisit = Syn_CVisit {allTpsFound_Syn_CVisit :: !(Bool),comments_Syn_CVisit :: !([String]),decls_Syn_CVisit :: !(Decls),errors_Syn_CVisit :: !(Seq Error),gatherInstVisitNrs_Syn_CVisit :: !(Map Identifier Int),intra_Syn_CVisit :: !(Exprs),intraVars_Syn_CVisit :: !(Set String),semNames_Syn_CVisit :: !([String])} +wrap_CVisit (T_CVisit sem) (Inh_CVisit _lhsIallNts _lhsIallPragmas _lhsIchildren _lhsIcon _lhsIcontextMap _lhsIerrors _lhsIinh _lhsIinstVisitNrs _lhsIisLast _lhsInextIntra _lhsInextIntraVars _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIwith_sig) = (let ( _lhsOallTpsFound,_lhsOcomments,_lhsOdecls,_lhsOerrors,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOsemNames) = - (sem _lhsIallPragmas _lhsIchildren _lhsIcon _lhsIcontextMap _lhsIerrors _lhsIinh _lhsIinstVisitNrs _lhsIisLast _lhsInextIntra _lhsInextIntraVars _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIwith_sig) + (sem _lhsIallNts _lhsIallPragmas _lhsIchildren _lhsIcon _lhsIcontextMap _lhsIerrors _lhsIinh _lhsIinstVisitNrs _lhsIisLast _lhsInextIntra _lhsInextIntraVars _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIwith_sig) in (Syn_CVisit _lhsOallTpsFound _lhsOcomments _lhsOdecls _lhsOerrors _lhsOgatherInstVisitNrs _lhsOintra _lhsOintraVars _lhsOsemNames)) sem_CVisit_CVisit :: Attributes -> Attributes -> @@ -3088,7 +3207,8 @@ Bool -> T_CVisit sem_CVisit_CVisit inh_ syn_ (T_Sequence vss_) (T_Sequence intra_) ordered_ = - (T_CVisit (\ _lhsIallPragmas + (T_CVisit (\ _lhsIallNts + _lhsIallPragmas _lhsIchildren _lhsIcon _lhsIcontextMap @@ -3135,6 +3255,7 @@ _vssOwhat :: String _intraOwhat :: String _lhsOsemNames :: ([String]) + _vssOallNts :: (Set NontermIdent) _vssOchildren :: ([(Identifier,Type,Bool)]) _vssOcon :: ConstructorIdent _vssOerrors :: (Seq Error) @@ -3162,6 +3283,8 @@ _vssOprefix :: String _vssOsyn :: Attributes _vssOterminals :: ([Identifier]) + _vssOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) + _intraOallNts :: (Set NontermIdent) _intraOchildren :: ([(Identifier,Type,Bool)]) _intraOcon :: ConstructorIdent _intraOerrors :: (Seq Error) @@ -3189,6 +3312,7 @@ _intraOprefix :: String _intraOsyn :: Attributes _intraOterminals :: ([Identifier]) + _intraOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) _vssIallTpsFound :: Bool _vssIblockDecls :: DeclBlocks _vssIcomments :: ([String]) @@ -3211,28 +3335,28 @@ _intraItSigs :: ([Decl]) _intraItps :: ([Type]) _intraIusedVars :: (Set String) - -- "GenerateCode.ag"(line 224, column 13) + -- "GenerateCode.ag"(line 244, column 13) _lhsOintra = _intraIexprs - -- "GenerateCode.ag"(line 225, column 13) + -- "GenerateCode.ag"(line 245, column 13) _lhsOintraVars = _intraIusedVars - -- "GenerateCode.ag"(line 333, column 13) + -- "GenerateCode.ag"(line 357, column 13) __tup4 = partition (\(_,_,ho) -> ho) _lhsIchildren - -- "GenerateCode.ag"(line 333, column 13) + -- "GenerateCode.ag"(line 357, column 13) (_higherOrderChildren,_) = __tup4 - -- "GenerateCode.ag"(line 333, column 13) + -- "GenerateCode.ag"(line 357, column 13) (_,_firstOrderChildren) = __tup4 - -- "GenerateCode.ag"(line 334, column 13) + -- "GenerateCode.ag"(line 358, column 13) _funcname = seqSemname _lhsIprefix _lhsInt _lhsIcon _lhsInr - -- "GenerateCode.ag"(line 335, column 13) + -- "GenerateCode.ag"(line 359, column 13) _nextVisitName = if _lhsIisLast then [] else [visitname _lhsIprefix _lhsInt (_lhsInr+1)] - -- "GenerateCode.ag"(line 336, column 13) + -- "GenerateCode.ag"(line 360, column 13) _nextVisitDecl = let lhs = TupleLhs _nextVisitName rhs = App fun _lhsInextIntra @@ -3240,39 +3364,39 @@ in if _lhsIisLast then [] else [Decl lhs rhs (Set.fromList _nextVisitName) _lhsInextIntraVars] - -- "GenerateCode.ag"(line 342, column 13) + -- "GenerateCode.ag"(line 366, column 13) _decls = _typeSigs ++ _vssIdecls ++ _nextVisitDecl - -- "GenerateCode.ag"(line 343, column 13) + -- "GenerateCode.ag"(line 367, column 13) _vssOlastExpr = mkTupleExpr _lhsIo_unbox (null $ Map.keys inh_) $ map (SimpleExpr . lhsname False) (Map.keys syn_) ++ map SimpleExpr _nextVisitName - -- "GenerateCode.ag"(line 344, column 13) + -- "GenerateCode.ag"(line 368, column 13) _intraOlastExpr = error "lastExpr: not used here" - -- "GenerateCode.ag"(line 345, column 13) + -- "GenerateCode.ag"(line 369, column 13) _lastExprVars = map (lhsname False) (Map.keys syn_) ++ _nextVisitName - -- "GenerateCode.ag"(line 346, column 13) + -- "GenerateCode.ag"(line 370, column 13) __tup5 = mkPartitionedFunction _funcname _o_case _nextVisitDecl _lastExprVars _vssIblockDecls - -- "GenerateCode.ag"(line 346, column 13) + -- "GenerateCode.ag"(line 370, column 13) (_blockFunDecls,_) = __tup5 - -- "GenerateCode.ag"(line 346, column 13) + -- "GenerateCode.ag"(line 370, column 13) (_,_blockFirstFunCall) = __tup5 - -- "GenerateCode.ag"(line 348, column 13) + -- "GenerateCode.ag"(line 372, column 13) _costCentreDescr = "b" ++ ":" ++ show _lhsInt ++ ":" ++ show _lhsIcon ++ ":" ++ show _lhsInr - -- "GenerateCode.ag"(line 349, column 13) + -- "GenerateCode.ag"(line 373, column 13) _addCostCentre = \v -> if _lhsIo_costcentre then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v else v - -- "GenerateCode.ag"(line 353, column 13) + -- "GenerateCode.ag"(line 377, column 13) _params = map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap - -- "GenerateCode.ag"(line 354, column 13) + -- "GenerateCode.ag"(line 378, column 13) _semFun = let lhs = Fun _funcname lhs_args lhs_args = if _lhsInr == 0 then map field _firstOrderChildren else _intraIexprs @@ -3284,7 +3408,7 @@ field (name,tp,_) = let expr = SimpleExpr (funname name 0) in if null _params then expr - else TypedExpr expr (SimpleType (typeToHaskellString (Just _lhsInt) _params tp)) + else TypedExpr expr (idEvalType $ SimpleType (typeToHaskellString (Just _lhsInt) _params tp)) mbEvalTp | null _params = const Nothing | otherwise = Just . idEvalType rhs = wrap @@ -3299,10 +3423,10 @@ then \x -> App (typeName _lhsInt _lhsInr) [x] else id in Decl lhs rhs Set.empty Set.empty - -- "GenerateCode.ag"(line 384, column 13) + -- "GenerateCode.ag"(line 408, column 13) _tsig = TSig _funcname _semType - -- "GenerateCode.ag"(line 385, column 13) + -- "GenerateCode.ag"(line 409, column 13) _semType = let argType (NT tp tps) rec | tp /= _SELF = typeAppStrs (sdtype tp) tps `Arr` rec | tp == _SELF = error "GenerateCode: found an intra-type with type SELF, which should have been prevented by CRule.tps" @@ -3313,7 +3437,7 @@ if _lhsInr == 0 then foldr argType (typeAppStrs (sdtype _lhsInt ) _params ) (map (\(_,t,_) -> t) _firstOrderChildren ) else foldr argType (typeAppStrs (typeName _lhsInt _lhsInr) _params ) _intraItps - -- "GenerateCode.ag"(line 396, column 13) + -- "GenerateCode.ag"(line 420, column 13) _lhsOdecls = ( if _lhsIwith_sig then [_tsig, _semFun] @@ -3323,48 +3447,51 @@ then _blockFunDecls else [] ) - -- "GenerateCode.ag"(line 404, column 13) + -- "GenerateCode.ag"(line 428, column 13) _typeSigs = if _lhsIo_sig && not _o_case then _vssItSigs else [] - -- "GenerateCode.ag"(line 407, column 13) + -- "GenerateCode.ag"(line 431, column 13) _o_case = _lhsIo_case && ordered_ && not (hasPragma _lhsIallPragmas _lhsInt _lhsIcon _NOCASE) - -- "GenerateCode.ag"(line 408, column 13) + -- "GenerateCode.ag"(line 432, column 13) _o_splitsems = ordered_ && _lhsIo_splitsems - -- "GenerateCode.ag"(line 430, column 7) + -- "GenerateCode.ag"(line 454, column 7) _lhsOgatherInstVisitNrs = Map.fromList [(i,_lhsInr) | i <- _vssIdefinedInsts] - -- "GenerateCode.ag"(line 441, column 7) + -- "GenerateCode.ag"(line 465, column 7) _vssOdeclsAbove = [] - -- "GenerateCode.ag"(line 442, column 7) + -- "GenerateCode.ag"(line 466, column 7) _intraOdeclsAbove = error "declsAbove: not used here" - -- "GenerateCode.ag"(line 688, column 13) + -- "GenerateCode.ag"(line 712, column 13) _lhsOallTpsFound = _intraIallTpsFound - -- "GenerateCode.ag"(line 699, column 13) + -- "GenerateCode.ag"(line 723, column 13) _lhsOerrors = _intraIerrors - -- "GenerateCode.ag"(line 732, column 18) + -- "GenerateCode.ag"(line 756, column 18) _lhsOcomments = let body = map ind (_vssIcomments ++ _intraIcomments) in if null body then [] else ("visit " ++ show _lhsInr ++ ":") : body - -- "GenerateCode.ag"(line 736, column 18) + -- "GenerateCode.ag"(line 760, column 18) _vssOwhat = "local" - -- "GenerateCode.ag"(line 737, column 18) + -- "GenerateCode.ag"(line 761, column 18) _intraOwhat = "intra" - -- "GenerateCode.ag"(line 920, column 7) + -- "GenerateCode.ag"(line 987, column 7) _lhsOsemNames = [_funcname ] -- copy rule (down) + _vssOallNts = + _lhsIallNts + -- copy rule (down) _vssOchildren = _lhsIchildren -- copy rule (down) @@ -3446,6 +3573,12 @@ _vssOterminals = _lhsIterminals -- copy rule (down) + _vssOunfoldSemDom = + _lhsIunfoldSemDom + -- copy rule (down) + _intraOallNts = + _lhsIallNts + -- copy rule (down) _intraOchildren = _lhsIchildren -- copy rule (down) @@ -3526,15 +3659,19 @@ -- copy rule (down) _intraOterminals = _lhsIterminals + -- copy rule (down) + _intraOunfoldSemDom = + _lhsIunfoldSemDom ( _vssIallTpsFound,_vssIblockDecls,_vssIcomments,_vssIdecls,_vssIdeclsAbove,_vssIdefinedInsts,_vssIerrors,_vssIexprs,_vssItSigs,_vssItps,_vssIusedVars) = - (vss_ _vssOchildren _vssOcon _vssOdeclsAbove _vssOerrors _vssOhigherOrderChildren _vssOinh _vssOinstVisitNrs _vssOlastExpr _vssOnr _vssOnt _vssOo_case _vssOo_cata _vssOo_costcentre _vssOo_data _vssOo_linePragmas _vssOo_newtypes _vssOo_pretty _vssOo_rename _vssOo_sem _vssOo_sig _vssOo_splitsems _vssOo_strictwrap _vssOo_traces _vssOo_unbox _vssOparamInstMap _vssOparamMap _vssOprefix _vssOsyn _vssOterminals _vssOwhat) + (vss_ _vssOallNts _vssOchildren _vssOcon _vssOdeclsAbove _vssOerrors _vssOhigherOrderChildren _vssOinh _vssOinstVisitNrs _vssOlastExpr _vssOnr _vssOnt _vssOo_case _vssOo_cata _vssOo_costcentre _vssOo_data _vssOo_linePragmas _vssOo_newtypes _vssOo_pretty _vssOo_rename _vssOo_sem _vssOo_sig _vssOo_splitsems _vssOo_strictwrap _vssOo_traces _vssOo_unbox _vssOparamInstMap _vssOparamMap _vssOprefix _vssOsyn _vssOterminals _vssOunfoldSemDom _vssOwhat) ( _intraIallTpsFound,_intraIblockDecls,_intraIcomments,_intraIdecls,_intraIdeclsAbove,_intraIdefinedInsts,_intraIerrors,_intraIexprs,_intraItSigs,_intraItps,_intraIusedVars) = - (intra_ _intraOchildren _intraOcon _intraOdeclsAbove _intraOerrors _intraOhigherOrderChildren _intraOinh _intraOinstVisitNrs _intraOlastExpr _intraOnr _intraOnt _intraOo_case _intraOo_cata _intraOo_costcentre _intraOo_data _intraOo_linePragmas _intraOo_newtypes _intraOo_pretty _intraOo_rename _intraOo_sem _intraOo_sig _intraOo_splitsems _intraOo_strictwrap _intraOo_traces _intraOo_unbox _intraOparamInstMap _intraOparamMap _intraOprefix _intraOsyn _intraOterminals _intraOwhat) + (intra_ _intraOallNts _intraOchildren _intraOcon _intraOdeclsAbove _intraOerrors _intraOhigherOrderChildren _intraOinh _intraOinstVisitNrs _intraOlastExpr _intraOnr _intraOnt _intraOo_case _intraOo_cata _intraOo_costcentre _intraOo_data _intraOo_linePragmas _intraOo_newtypes _intraOo_pretty _intraOo_rename _intraOo_sem _intraOo_sig _intraOo_splitsems _intraOo_strictwrap _intraOo_traces _intraOo_unbox _intraOparamInstMap _intraOparamMap _intraOprefix _intraOsyn _intraOterminals _intraOunfoldSemDom _intraOwhat) in ( _lhsOallTpsFound,_lhsOcomments,_lhsOdecls,_lhsOerrors,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOsemNames)))) -- CVisits ----------------------------------------------------- {- visit 0: inherited attributes: + allNts : Set NontermIdent allPragmas : PragmaMap children : [(Identifier,Type,Bool)] con : ConstructorIdent @@ -3587,7 +3724,8 @@ sem_CVisits list = (Prelude.foldr sem_CVisits_Cons sem_CVisits_Nil (Prelude.map sem_CVisit list)) -- semantic domain -newtype T_CVisits = T_CVisits (PragmaMap -> +newtype T_CVisits = T_CVisits ((Set NontermIdent) -> + PragmaMap -> ([(Identifier,Type,Bool)]) -> ConstructorIdent -> ContextMap -> @@ -3618,17 +3756,18 @@ (NontermIdent -> Int -> [String] -> Code.Type) -> Bool -> ( Bool,([String]),Decls,(Seq Error),(Map Identifier Int),Exprs,(Set String),Bool,([String]))) -data Inh_CVisits = Inh_CVisits {allPragmas_Inh_CVisits :: PragmaMap,children_Inh_CVisits :: [(Identifier,Type,Bool)],con_Inh_CVisits :: ConstructorIdent,contextMap_Inh_CVisits :: ContextMap,errors_Inh_CVisits :: Seq Error,inh_Inh_CVisits :: Attributes,instVisitNrs_Inh_CVisits :: Map Identifier Int,nr_Inh_CVisits :: Int,nt_Inh_CVisits :: NontermIdent,o_case_Inh_CVisits :: Bool,o_cata_Inh_CVisits :: Bool,o_costcentre_Inh_CVisits :: Bool,o_data_Inh_CVisits :: Maybe Bool,o_linePragmas_Inh_CVisits :: Bool,o_newtypes_Inh_CVisits :: Bool,o_pretty_Inh_CVisits :: Bool,o_rename_Inh_CVisits :: Bool,o_sem_Inh_CVisits :: Bool,o_sig_Inh_CVisits :: Bool,o_splitsems_Inh_CVisits :: Bool,o_strictwrap_Inh_CVisits :: Bool,o_traces_Inh_CVisits :: Bool,o_unbox_Inh_CVisits :: Bool,paramInstMap_Inh_CVisits :: Map Identifier (NontermIdent, [String]),paramMap_Inh_CVisits :: ParamMap,prefix_Inh_CVisits :: String,syn_Inh_CVisits :: Attributes,terminals_Inh_CVisits :: [Identifier],unfoldSemDom_Inh_CVisits :: NontermIdent -> Int -> [String] -> Code.Type,with_sig_Inh_CVisits :: Bool} -data Syn_CVisits = Syn_CVisits {allTpsFound_Syn_CVisits :: Bool,comments_Syn_CVisits :: [String],decls_Syn_CVisits :: Decls,errors_Syn_CVisits :: Seq Error,gatherInstVisitNrs_Syn_CVisits :: Map Identifier Int,intra_Syn_CVisits :: Exprs,intraVars_Syn_CVisits :: Set String,isNil_Syn_CVisits :: Bool,semNames_Syn_CVisits :: [String]} -wrap_CVisits (T_CVisits sem) (Inh_CVisits _lhsIallPragmas _lhsIchildren _lhsIcon _lhsIcontextMap _lhsIerrors _lhsIinh _lhsIinstVisitNrs _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIwith_sig) = +data Inh_CVisits = Inh_CVisits {allNts_Inh_CVisits :: !(Set NontermIdent),allPragmas_Inh_CVisits :: !(PragmaMap),children_Inh_CVisits :: !([(Identifier,Type,Bool)]),con_Inh_CVisits :: !(ConstructorIdent),contextMap_Inh_CVisits :: !(ContextMap),errors_Inh_CVisits :: !(Seq Error),inh_Inh_CVisits :: !(Attributes),instVisitNrs_Inh_CVisits :: !(Map Identifier Int),nr_Inh_CVisits :: !(Int),nt_Inh_CVisits :: !(NontermIdent),o_case_Inh_CVisits :: !(Bool),o_cata_Inh_CVisits :: !(Bool),o_costcentre_Inh_CVisits :: !(Bool),o_data_Inh_CVisits :: !(Maybe Bool),o_linePragmas_Inh_CVisits :: !(Bool),o_newtypes_Inh_CVisits :: !(Bool),o_pretty_Inh_CVisits :: !(Bool),o_rename_Inh_CVisits :: !(Bool),o_sem_Inh_CVisits :: !(Bool),o_sig_Inh_CVisits :: !(Bool),o_splitsems_Inh_CVisits :: !(Bool),o_strictwrap_Inh_CVisits :: !(Bool),o_traces_Inh_CVisits :: !(Bool),o_unbox_Inh_CVisits :: !(Bool),paramInstMap_Inh_CVisits :: !(Map Identifier (NontermIdent, [String])),paramMap_Inh_CVisits :: !(ParamMap),prefix_Inh_CVisits :: !(String),syn_Inh_CVisits :: !(Attributes),terminals_Inh_CVisits :: !([Identifier]),unfoldSemDom_Inh_CVisits :: !(NontermIdent -> Int -> [String] -> Code.Type),with_sig_Inh_CVisits :: !(Bool)} +data Syn_CVisits = Syn_CVisits {allTpsFound_Syn_CVisits :: !(Bool),comments_Syn_CVisits :: !([String]),decls_Syn_CVisits :: !(Decls),errors_Syn_CVisits :: !(Seq Error),gatherInstVisitNrs_Syn_CVisits :: !(Map Identifier Int),intra_Syn_CVisits :: !(Exprs),intraVars_Syn_CVisits :: !(Set String),isNil_Syn_CVisits :: !(Bool),semNames_Syn_CVisits :: !([String])} +wrap_CVisits (T_CVisits sem) (Inh_CVisits _lhsIallNts _lhsIallPragmas _lhsIchildren _lhsIcon _lhsIcontextMap _lhsIerrors _lhsIinh _lhsIinstVisitNrs _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIwith_sig) = (let ( _lhsOallTpsFound,_lhsOcomments,_lhsOdecls,_lhsOerrors,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOisNil,_lhsOsemNames) = - (sem _lhsIallPragmas _lhsIchildren _lhsIcon _lhsIcontextMap _lhsIerrors _lhsIinh _lhsIinstVisitNrs _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIwith_sig) + (sem _lhsIallNts _lhsIallPragmas _lhsIchildren _lhsIcon _lhsIcontextMap _lhsIerrors _lhsIinh _lhsIinstVisitNrs _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIwith_sig) in (Syn_CVisits _lhsOallTpsFound _lhsOcomments _lhsOdecls _lhsOerrors _lhsOgatherInstVisitNrs _lhsOintra _lhsOintraVars _lhsOisNil _lhsOsemNames)) sem_CVisits_Cons :: T_CVisit -> T_CVisits -> T_CVisits sem_CVisits_Cons (T_CVisit hd_) (T_CVisits tl_) = - (T_CVisits (\ _lhsIallPragmas + (T_CVisits (\ _lhsIallNts + _lhsIallPragmas _lhsIchildren _lhsIcon _lhsIcontextMap @@ -3671,6 +3810,7 @@ _lhsOerrors :: (Seq Error) _lhsOgatherInstVisitNrs :: (Map Identifier Int) _lhsOsemNames :: ([String]) + _hdOallNts :: (Set NontermIdent) _hdOallPragmas :: PragmaMap _hdOchildren :: ([(Identifier,Type,Bool)]) _hdOcon :: ConstructorIdent @@ -3701,6 +3841,7 @@ _hdOterminals :: ([Identifier]) _hdOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) _hdOwith_sig :: Bool + _tlOallNts :: (Set NontermIdent) _tlOallPragmas :: PragmaMap _tlOchildren :: ([(Identifier,Type,Bool)]) _tlOcon :: ConstructorIdent @@ -3747,46 +3888,49 @@ _tlIintraVars :: (Set String) _tlIisNil :: Bool _tlIsemNames :: ([String]) - -- "GenerateCode.ag"(line 196, column 11) + -- "GenerateCode.ag"(line 216, column 11) _tlOnr = _lhsInr + 1 - -- "GenerateCode.ag"(line 209, column 12) + -- "GenerateCode.ag"(line 229, column 12) _lhsOisNil = False - -- "GenerateCode.ag"(line 210, column 12) + -- "GenerateCode.ag"(line 230, column 12) _hdOisLast = _tlIisNil - -- "GenerateCode.ag"(line 227, column 12) + -- "GenerateCode.ag"(line 247, column 12) _hdOnextIntra = _tlIintra - -- "GenerateCode.ag"(line 228, column 12) + -- "GenerateCode.ag"(line 248, column 12) _hdOnextIntraVars = _tlIintraVars - -- "GenerateCode.ag"(line 229, column 12) + -- "GenerateCode.ag"(line 249, column 12) _lhsOintra = _hdIintra - -- "GenerateCode.ag"(line 230, column 12) + -- "GenerateCode.ag"(line 250, column 12) _lhsOintraVars = _hdIintraVars - -- use rule "GenerateCode.ag"(line 682, column 39) + -- use rule "GenerateCode.ag"(line 706, column 39) _lhsOallTpsFound = _hdIallTpsFound && _tlIallTpsFound - -- use rule "GenerateCode.ag"(line 714, column 52) + -- use rule "GenerateCode.ag"(line 738, column 52) _lhsOcomments = _hdIcomments ++ _tlIcomments - -- use rule "GenerateCode.ag"(line 331, column 33) + -- use rule "GenerateCode.ag"(line 355, column 33) _lhsOdecls = _hdIdecls ++ _tlIdecls - -- use rule "GenerateCode.ag"(line 695, column 32) + -- use rule "GenerateCode.ag"(line 719, column 32) _lhsOerrors = _hdIerrors Seq.<> _tlIerrors - -- use rule "GenerateCode.ag"(line 423, column 44) + -- use rule "GenerateCode.ag"(line 447, column 44) _lhsOgatherInstVisitNrs = _hdIgatherInstVisitNrs `Map.union` _tlIgatherInstVisitNrs - -- use rule "GenerateCode.ag"(line 910, column 61) + -- use rule "GenerateCode.ag"(line 977, column 61) _lhsOsemNames = _hdIsemNames ++ _tlIsemNames -- copy rule (down) + _hdOallNts = + _lhsIallNts + -- copy rule (down) _hdOallPragmas = _lhsIallPragmas -- copy rule (down) @@ -3877,6 +4021,9 @@ _hdOwith_sig = _lhsIwith_sig -- copy rule (down) + _tlOallNts = + _lhsIallNts + -- copy rule (down) _tlOallPragmas = _lhsIallPragmas -- copy rule (down) @@ -3964,13 +4111,14 @@ _tlOwith_sig = _lhsIwith_sig ( _hdIallTpsFound,_hdIcomments,_hdIdecls,_hdIerrors,_hdIgatherInstVisitNrs,_hdIintra,_hdIintraVars,_hdIsemNames) = - (hd_ _hdOallPragmas _hdOchildren _hdOcon _hdOcontextMap _hdOerrors _hdOinh _hdOinstVisitNrs _hdOisLast _hdOnextIntra _hdOnextIntraVars _hdOnr _hdOnt _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOparamInstMap _hdOparamMap _hdOprefix _hdOsyn _hdOterminals _hdOunfoldSemDom _hdOwith_sig) + (hd_ _hdOallNts _hdOallPragmas _hdOchildren _hdOcon _hdOcontextMap _hdOerrors _hdOinh _hdOinstVisitNrs _hdOisLast _hdOnextIntra _hdOnextIntraVars _hdOnr _hdOnt _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOparamInstMap _hdOparamMap _hdOprefix _hdOsyn _hdOterminals _hdOunfoldSemDom _hdOwith_sig) ( _tlIallTpsFound,_tlIcomments,_tlIdecls,_tlIerrors,_tlIgatherInstVisitNrs,_tlIintra,_tlIintraVars,_tlIisNil,_tlIsemNames) = - (tl_ _tlOallPragmas _tlOchildren _tlOcon _tlOcontextMap _tlOerrors _tlOinh _tlOinstVisitNrs _tlOnr _tlOnt _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOparamInstMap _tlOparamMap _tlOprefix _tlOsyn _tlOterminals _tlOunfoldSemDom _tlOwith_sig) + (tl_ _tlOallNts _tlOallPragmas _tlOchildren _tlOcon _tlOcontextMap _tlOerrors _tlOinh _tlOinstVisitNrs _tlOnr _tlOnt _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOparamInstMap _tlOparamMap _tlOprefix _tlOsyn _tlOterminals _tlOunfoldSemDom _tlOwith_sig) in ( _lhsOallTpsFound,_lhsOcomments,_lhsOdecls,_lhsOerrors,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOisNil,_lhsOsemNames)))) sem_CVisits_Nil :: T_CVisits sem_CVisits_Nil = - (T_CVisits (\ _lhsIallPragmas + (T_CVisits (\ _lhsIallNts + _lhsIallPragmas _lhsIchildren _lhsIcon _lhsIcontextMap @@ -4009,31 +4157,31 @@ _lhsOerrors :: (Seq Error) _lhsOgatherInstVisitNrs :: (Map Identifier Int) _lhsOsemNames :: ([String]) - -- "GenerateCode.ag"(line 211, column 10) + -- "GenerateCode.ag"(line 231, column 10) _lhsOisNil = True - -- "GenerateCode.ag"(line 231, column 10) + -- "GenerateCode.ag"(line 251, column 10) _lhsOintra = [] - -- "GenerateCode.ag"(line 232, column 10) + -- "GenerateCode.ag"(line 252, column 10) _lhsOintraVars = Set.empty - -- use rule "GenerateCode.ag"(line 682, column 39) + -- use rule "GenerateCode.ag"(line 706, column 39) _lhsOallTpsFound = True - -- use rule "GenerateCode.ag"(line 714, column 52) + -- use rule "GenerateCode.ag"(line 738, column 52) _lhsOcomments = [] - -- use rule "GenerateCode.ag"(line 331, column 33) + -- use rule "GenerateCode.ag"(line 355, column 33) _lhsOdecls = [] - -- use rule "GenerateCode.ag"(line 695, column 32) + -- use rule "GenerateCode.ag"(line 719, column 32) _lhsOerrors = Seq.empty - -- use rule "GenerateCode.ag"(line 423, column 44) + -- use rule "GenerateCode.ag"(line 447, column 44) _lhsOgatherInstVisitNrs = Map.empty - -- use rule "GenerateCode.ag"(line 910, column 61) + -- use rule "GenerateCode.ag"(line 977, column 61) _lhsOsemNames = [] in ( _lhsOallTpsFound,_lhsOcomments,_lhsOdecls,_lhsOerrors,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOisNil,_lhsOsemNames)))) @@ -4082,8 +4230,8 @@ Bool -> String -> ( Expr,([Decl]),([String]))) -data Inh_DeclBlocks = Inh_DeclBlocks {blockNr_Inh_DeclBlocks :: Int,lastExprVars_Inh_DeclBlocks :: [String],nextVisitDecls_Inh_DeclBlocks :: [Decl],optCase_Inh_DeclBlocks :: Bool,prefix_Inh_DeclBlocks :: String} -data Syn_DeclBlocks = Syn_DeclBlocks {callExpr_Syn_DeclBlocks :: Expr,decls_Syn_DeclBlocks :: [Decl],freeVars_Syn_DeclBlocks :: [String]} +data Inh_DeclBlocks = Inh_DeclBlocks {blockNr_Inh_DeclBlocks :: !(Int),lastExprVars_Inh_DeclBlocks :: !([String]),nextVisitDecls_Inh_DeclBlocks :: !([Decl]),optCase_Inh_DeclBlocks :: !(Bool),prefix_Inh_DeclBlocks :: !(String)} +data Syn_DeclBlocks = Syn_DeclBlocks {callExpr_Syn_DeclBlocks :: !(Expr),decls_Syn_DeclBlocks :: !([Decl]),freeVars_Syn_DeclBlocks :: !([String])} wrap_DeclBlocks (T_DeclBlocks sem) (Inh_DeclBlocks _lhsIblockNr _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix) = (let ( _lhsOcallExpr,_lhsOdecls,_lhsOfreeVars) = (sem _lhsIblockNr _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix) @@ -4109,25 +4257,25 @@ _nextIcallExpr :: Expr _nextIdecls :: ([Decl]) _nextIfreeVars :: ([String]) - -- "GenerateCode.ag"(line 520, column 7) + -- "GenerateCode.ag"(line 544, column 7) _nextOblockNr = _lhsIblockNr + 1 - -- "GenerateCode.ag"(line 525, column 7) + -- "GenerateCode.ag"(line 549, column 7) _lambdaName = _lhsIprefix ++ "_block" ++ show _lhsIblockNr - -- "GenerateCode.ag"(line 526, column 7) + -- "GenerateCode.ag"(line 550, column 7) _pragmaDecl = PragmaDecl ("NOINLINE " ++ _lambdaName ) - -- "GenerateCode.ag"(line 527, column 7) + -- "GenerateCode.ag"(line 551, column 7) _lhsOcallExpr = App _lambdaName (map SimpleExpr _freeVars ) - -- "GenerateCode.ag"(line 531, column 7) + -- "GenerateCode.ag"(line 555, column 7) _freeVars = freevars _nextIfreeVars (visit_ : defs_) - -- "GenerateCode.ag"(line 538, column 7) + -- "GenerateCode.ag"(line 562, column 7) _decl = mkBlockLambda _lhsIoptCase _lambdaName _freeVars (defs_ ++ [visit_]) _nextIcallExpr - -- "GenerateCode.ag"(line 539, column 7) + -- "GenerateCode.ag"(line 563, column 7) _lhsOdecls = (if _lhsIblockNr > 1 then [_pragmaDecl ] else []) ++ [_decl ] ++ _nextIdecls -- copy rule (from local) @@ -4160,19 +4308,19 @@ (let _lhsOcallExpr :: Expr _lhsOdecls :: ([Decl]) _lhsOfreeVars :: ([String]) - -- "GenerateCode.ag"(line 525, column 7) + -- "GenerateCode.ag"(line 549, column 7) _lambdaName = _lhsIprefix ++ "_block" ++ show _lhsIblockNr - -- "GenerateCode.ag"(line 526, column 7) + -- "GenerateCode.ag"(line 550, column 7) _pragmaDecl = PragmaDecl ("NOINLINE " ++ _lambdaName ) - -- "GenerateCode.ag"(line 527, column 7) + -- "GenerateCode.ag"(line 551, column 7) _lhsOcallExpr = App _lambdaName (map SimpleExpr _freeVars ) - -- "GenerateCode.ag"(line 529, column 7) + -- "GenerateCode.ag"(line 553, column 7) _freeVars = freevars _lhsIlastExprVars (defs_ ++ _lhsInextVisitDecls) - -- "GenerateCode.ag"(line 536, column 7) + -- "GenerateCode.ag"(line 560, column 7) _lhsOdecls = [ mkBlockLambda _lhsIoptCase _lambdaName _freeVars (defs_ ++ _lhsInextVisitDecls) result_ ] -- copy rule (from local) @@ -4205,8 +4353,8 @@ Bool -> String -> ( Expr,([Decl]))) -data Inh_DeclBlocksRoot = Inh_DeclBlocksRoot {lastExprVars_Inh_DeclBlocksRoot :: [String],nextVisitDecls_Inh_DeclBlocksRoot :: [Decl],optCase_Inh_DeclBlocksRoot :: Bool,prefix_Inh_DeclBlocksRoot :: String} -data Syn_DeclBlocksRoot = Syn_DeclBlocksRoot {firstCall_Syn_DeclBlocksRoot :: Expr,lambdas_Syn_DeclBlocksRoot :: [Decl]} +data Inh_DeclBlocksRoot = Inh_DeclBlocksRoot {lastExprVars_Inh_DeclBlocksRoot :: !([String]),nextVisitDecls_Inh_DeclBlocksRoot :: !([Decl]),optCase_Inh_DeclBlocksRoot :: !(Bool),prefix_Inh_DeclBlocksRoot :: !(String)} +data Syn_DeclBlocksRoot = Syn_DeclBlocksRoot {firstCall_Syn_DeclBlocksRoot :: !(Expr),lambdas_Syn_DeclBlocksRoot :: !([Decl])} wrap_DeclBlocksRoot (T_DeclBlocksRoot sem) (Inh_DeclBlocksRoot _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix) = (let ( _lhsOfirstCall,_lhsOlambdas) = (sem _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix) @@ -4228,13 +4376,13 @@ _blocksIcallExpr :: Expr _blocksIdecls :: ([Decl]) _blocksIfreeVars :: ([String]) - -- "GenerateCode.ag"(line 511, column 7) + -- "GenerateCode.ag"(line 535, column 7) _lhsOlambdas = _blocksIdecls - -- "GenerateCode.ag"(line 512, column 7) + -- "GenerateCode.ag"(line 536, column 7) _lhsOfirstCall = _blocksIcallExpr - -- "GenerateCode.ag"(line 517, column 7) + -- "GenerateCode.ag"(line 541, column 7) _blocksOblockNr = 1 -- copy rule (down) @@ -4302,7 +4450,7 @@ -- semantic domain newtype T_Pattern = T_Pattern (( Pattern,([Identifier]),([(Identifier, Identifier)]))) data Inh_Pattern = Inh_Pattern {} -data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern,definedInsts_Syn_Pattern :: [Identifier],patternAttributes_Syn_Pattern :: [(Identifier, Identifier)]} +data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: !(Pattern),definedInsts_Syn_Pattern :: !([Identifier]),patternAttributes_Syn_Pattern :: !([(Identifier, Identifier)])} wrap_Pattern (T_Pattern sem) (Inh_Pattern ) = (let ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes) = (sem ) @@ -4322,10 +4470,10 @@ _partsIcopy :: Patterns _partsIdefinedInsts :: ([Identifier]) _partsIpatternAttributes :: ([(Identifier, Identifier)]) - -- "GenerateCode.ag"(line 177, column 11) + -- "GenerateCode.ag"(line 197, column 11) _lhsOdefinedInsts = (if field_ == _INST then [attr_] else []) ++ _patIdefinedInsts - -- "GenerateCode.ag"(line 185, column 7) + -- "GenerateCode.ag"(line 205, column 7) _lhsOpatternAttributes = (field_,attr_) : (_patIpatternAttributes ++ _partsIpatternAttributes) -- self rule @@ -4349,10 +4497,10 @@ _patsIcopy :: Patterns _patsIdefinedInsts :: ([Identifier]) _patsIpatternAttributes :: ([(Identifier, Identifier)]) - -- use rule "GenerateCode.ag"(line 175, column 55) + -- use rule "GenerateCode.ag"(line 195, column 55) _lhsOdefinedInsts = _patsIdefinedInsts - -- use rule "GenerateCode.ag"(line 182, column 47) + -- use rule "GenerateCode.ag"(line 202, column 47) _lhsOpatternAttributes = _patsIpatternAttributes -- self rule @@ -4373,10 +4521,10 @@ _patIcopy :: Pattern _patIdefinedInsts :: ([Identifier]) _patIpatternAttributes :: ([(Identifier, Identifier)]) - -- use rule "GenerateCode.ag"(line 175, column 55) + -- use rule "GenerateCode.ag"(line 195, column 55) _lhsOdefinedInsts = _patIdefinedInsts - -- use rule "GenerateCode.ag"(line 182, column 47) + -- use rule "GenerateCode.ag"(line 202, column 47) _lhsOpatternAttributes = _patIpatternAttributes -- self rule @@ -4398,10 +4546,10 @@ _patsIcopy :: Patterns _patsIdefinedInsts :: ([Identifier]) _patsIpatternAttributes :: ([(Identifier, Identifier)]) - -- use rule "GenerateCode.ag"(line 175, column 55) + -- use rule "GenerateCode.ag"(line 195, column 55) _lhsOdefinedInsts = _patsIdefinedInsts - -- use rule "GenerateCode.ag"(line 182, column 47) + -- use rule "GenerateCode.ag"(line 202, column 47) _lhsOpatternAttributes = _patsIpatternAttributes -- self rule @@ -4419,10 +4567,10 @@ (T_Pattern (let _lhsOdefinedInsts :: ([Identifier]) _lhsOpatternAttributes :: ([(Identifier, Identifier)]) _lhsOcopy :: Pattern - -- use rule "GenerateCode.ag"(line 175, column 55) + -- use rule "GenerateCode.ag"(line 195, column 55) _lhsOdefinedInsts = [] - -- use rule "GenerateCode.ag"(line 182, column 47) + -- use rule "GenerateCode.ag"(line 202, column 47) _lhsOpatternAttributes = [] -- self rule @@ -4457,7 +4605,7 @@ -- semantic domain newtype T_Patterns = T_Patterns (( Patterns,([Identifier]),([(Identifier, Identifier)]))) data Inh_Patterns = Inh_Patterns {} -data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns,definedInsts_Syn_Patterns :: [Identifier],patternAttributes_Syn_Patterns :: [(Identifier, Identifier)]} +data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: !(Patterns),definedInsts_Syn_Patterns :: !([Identifier]),patternAttributes_Syn_Patterns :: !([(Identifier, Identifier)])} wrap_Patterns (T_Patterns sem) (Inh_Patterns ) = (let ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes) = (sem ) @@ -4475,10 +4623,10 @@ _tlIcopy :: Patterns _tlIdefinedInsts :: ([Identifier]) _tlIpatternAttributes :: ([(Identifier, Identifier)]) - -- use rule "GenerateCode.ag"(line 175, column 55) + -- use rule "GenerateCode.ag"(line 195, column 55) _lhsOdefinedInsts = _hdIdefinedInsts ++ _tlIdefinedInsts - -- use rule "GenerateCode.ag"(line 182, column 47) + -- use rule "GenerateCode.ag"(line 202, column 47) _lhsOpatternAttributes = _hdIpatternAttributes ++ _tlIpatternAttributes -- self rule @@ -4497,10 +4645,10 @@ (T_Patterns (let _lhsOdefinedInsts :: ([Identifier]) _lhsOpatternAttributes :: ([(Identifier, Identifier)]) _lhsOcopy :: Patterns - -- use rule "GenerateCode.ag"(line 175, column 55) + -- use rule "GenerateCode.ag"(line 195, column 55) _lhsOdefinedInsts = [] - -- use rule "GenerateCode.ag"(line 182, column 47) + -- use rule "GenerateCode.ag"(line 202, column 47) _lhsOpatternAttributes = [] -- self rule @@ -4514,6 +4662,7 @@ {- visit 0: inherited attributes: + allNts : Set NontermIdent children : [(Identifier,Type,Bool)] con : ConstructorIdent higherOrderChildren : [(Identifier,Type,Bool)] @@ -4541,6 +4690,7 @@ prefix : String syn : Attributes terminals : [Identifier] + unfoldSemDom : NontermIdent -> Int -> [String] -> Code.Type what : String chained attributes: declsAbove : [Decl] @@ -4567,7 +4717,8 @@ sem_Sequence list = (Prelude.foldr sem_Sequence_Cons sem_Sequence_Nil (Prelude.map sem_CRule list)) -- semantic domain -newtype T_Sequence = T_Sequence (([(Identifier,Type,Bool)]) -> +newtype T_Sequence = T_Sequence ((Set NontermIdent) -> + ([(Identifier,Type,Bool)]) -> ConstructorIdent -> ([Decl]) -> (Seq Error) -> @@ -4596,19 +4747,21 @@ String -> Attributes -> ([Identifier]) -> + (NontermIdent -> Int -> [String] -> Code.Type) -> String -> ( Bool,DeclBlocks,([String]),Decls,([Decl]),([Identifier]),(Seq Error),Exprs,([Decl]),([Type]),(Set String))) -data Inh_Sequence = Inh_Sequence {children_Inh_Sequence :: [(Identifier,Type,Bool)],con_Inh_Sequence :: ConstructorIdent,declsAbove_Inh_Sequence :: [Decl],errors_Inh_Sequence :: Seq Error,higherOrderChildren_Inh_Sequence :: [(Identifier,Type,Bool)],inh_Inh_Sequence :: Attributes,instVisitNrs_Inh_Sequence :: Map Identifier Int,lastExpr_Inh_Sequence :: Expr,nr_Inh_Sequence :: Int,nt_Inh_Sequence :: NontermIdent,o_case_Inh_Sequence :: Bool,o_cata_Inh_Sequence :: Bool,o_costcentre_Inh_Sequence :: Bool,o_data_Inh_Sequence :: Maybe Bool,o_linePragmas_Inh_Sequence :: Bool,o_newtypes_Inh_Sequence :: Bool,o_pretty_Inh_Sequence :: Bool,o_rename_Inh_Sequence :: Bool,o_sem_Inh_Sequence :: Bool,o_sig_Inh_Sequence :: Bool,o_splitsems_Inh_Sequence :: Bool,o_strictwrap_Inh_Sequence :: Bool,o_traces_Inh_Sequence :: Bool,o_unbox_Inh_Sequence :: Bool,paramInstMap_Inh_Sequence :: Map Identifier (NontermIdent, [String]),paramMap_Inh_Sequence :: ParamMap,prefix_Inh_Sequence :: String,syn_Inh_Sequence :: Attributes,terminals_Inh_Sequence :: [Identifier],what_Inh_Sequence :: String} -data Syn_Sequence = Syn_Sequence {allTpsFound_Syn_Sequence :: Bool,blockDecls_Syn_Sequence :: DeclBlocks,comments_Syn_Sequence :: [String],decls_Syn_Sequence :: Decls,declsAbove_Syn_Sequence :: [Decl],definedInsts_Syn_Sequence :: [Identifier],errors_Syn_Sequence :: Seq Error,exprs_Syn_Sequence :: Exprs,tSigs_Syn_Sequence :: [Decl],tps_Syn_Sequence :: [Type],usedVars_Syn_Sequence :: Set String} -wrap_Sequence (T_Sequence sem) (Inh_Sequence _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIerrors _lhsIhigherOrderChildren _lhsIinh _lhsIinstVisitNrs _lhsIlastExpr _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIwhat) = +data Inh_Sequence = Inh_Sequence {allNts_Inh_Sequence :: !(Set NontermIdent),children_Inh_Sequence :: !([(Identifier,Type,Bool)]),con_Inh_Sequence :: !(ConstructorIdent),declsAbove_Inh_Sequence :: !([Decl]),errors_Inh_Sequence :: !(Seq Error),higherOrderChildren_Inh_Sequence :: !([(Identifier,Type,Bool)]),inh_Inh_Sequence :: !(Attributes),instVisitNrs_Inh_Sequence :: !(Map Identifier Int),lastExpr_Inh_Sequence :: !(Expr),nr_Inh_Sequence :: !(Int),nt_Inh_Sequence :: !(NontermIdent),o_case_Inh_Sequence :: !(Bool),o_cata_Inh_Sequence :: !(Bool),o_costcentre_Inh_Sequence :: !(Bool),o_data_Inh_Sequence :: !(Maybe Bool),o_linePragmas_Inh_Sequence :: !(Bool),o_newtypes_Inh_Sequence :: !(Bool),o_pretty_Inh_Sequence :: !(Bool),o_rename_Inh_Sequence :: !(Bool),o_sem_Inh_Sequence :: !(Bool),o_sig_Inh_Sequence :: !(Bool),o_splitsems_Inh_Sequence :: !(Bool),o_strictwrap_Inh_Sequence :: !(Bool),o_traces_Inh_Sequence :: !(Bool),o_unbox_Inh_Sequence :: !(Bool),paramInstMap_Inh_Sequence :: !(Map Identifier (NontermIdent, [String])),paramMap_Inh_Sequence :: !(ParamMap),prefix_Inh_Sequence :: !(String),syn_Inh_Sequence :: !(Attributes),terminals_Inh_Sequence :: !([Identifier]),unfoldSemDom_Inh_Sequence :: !(NontermIdent -> Int -> [String] -> Code.Type),what_Inh_Sequence :: !(String)} +data Syn_Sequence = Syn_Sequence {allTpsFound_Syn_Sequence :: !(Bool),blockDecls_Syn_Sequence :: !(DeclBlocks),comments_Syn_Sequence :: !([String]),decls_Syn_Sequence :: !(Decls),declsAbove_Syn_Sequence :: !([Decl]),definedInsts_Syn_Sequence :: !([Identifier]),errors_Syn_Sequence :: !(Seq Error),exprs_Syn_Sequence :: !(Exprs),tSigs_Syn_Sequence :: !([Decl]),tps_Syn_Sequence :: !([Type]),usedVars_Syn_Sequence :: !(Set String)} +wrap_Sequence (T_Sequence sem) (Inh_Sequence _lhsIallNts _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIerrors _lhsIhigherOrderChildren _lhsIinh _lhsIinstVisitNrs _lhsIlastExpr _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIwhat) = (let ( _lhsOallTpsFound,_lhsOblockDecls,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOerrors,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars) = - (sem _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIerrors _lhsIhigherOrderChildren _lhsIinh _lhsIinstVisitNrs _lhsIlastExpr _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIwhat) + (sem _lhsIallNts _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIerrors _lhsIhigherOrderChildren _lhsIinh _lhsIinstVisitNrs _lhsIlastExpr _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIwhat) in (Syn_Sequence _lhsOallTpsFound _lhsOblockDecls _lhsOcomments _lhsOdecls _lhsOdeclsAbove _lhsOdefinedInsts _lhsOerrors _lhsOexprs _lhsOtSigs _lhsOtps _lhsOusedVars)) sem_Sequence_Cons :: T_CRule -> T_Sequence -> T_Sequence sem_Sequence_Cons (T_CRule hd_) (T_Sequence tl_) = - (T_Sequence (\ _lhsIchildren + (T_Sequence (\ _lhsIallNts + _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIerrors @@ -4637,6 +4790,7 @@ _lhsIprefix _lhsIsyn _lhsIterminals + _lhsIunfoldSemDom _lhsIwhat -> (let _lhsOblockDecls :: DeclBlocks _lhsOallTpsFound :: Bool @@ -4649,6 +4803,7 @@ _lhsOtps :: ([Type]) _lhsOusedVars :: (Set String) _lhsOdeclsAbove :: ([Decl]) + _hdOallNts :: (Set NontermIdent) _hdOchildren :: ([(Identifier,Type,Bool)]) _hdOcon :: ConstructorIdent _hdOdeclsAbove :: ([Decl]) @@ -4677,7 +4832,9 @@ _hdOprefix :: String _hdOsyn :: Attributes _hdOterminals :: ([Identifier]) + _hdOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) _hdOwhat :: String + _tlOallNts :: (Set NontermIdent) _tlOchildren :: ([(Identifier,Type,Bool)]) _tlOcon :: ConstructorIdent _tlOdeclsAbove :: ([Decl]) @@ -4707,6 +4864,7 @@ _tlOprefix :: String _tlOsyn :: Attributes _tlOterminals :: ([Identifier]) + _tlOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) _tlOwhat :: String _hdIallTpsFound :: Bool _hdIbldBlocksFun :: (DeclBlocks -> DeclBlocks) @@ -4730,40 +4888,43 @@ _tlItSigs :: ([Decl]) _tlItps :: ([Type]) _tlIusedVars :: (Set String) - -- "GenerateCode.ag"(line 452, column 7) + -- "GenerateCode.ag"(line 476, column 7) _lhsOblockDecls = _hdIbldBlocksFun _tlIblockDecls - -- use rule "GenerateCode.ag"(line 320, column 39) + -- use rule "GenerateCode.ag"(line 344, column 39) _lhsOallTpsFound = _hdIallTpsFound && _tlIallTpsFound - -- use rule "GenerateCode.ag"(line 714, column 52) + -- use rule "GenerateCode.ag"(line 738, column 52) _lhsOcomments = _hdIcomments ++ _tlIcomments - -- use rule "GenerateCode.ag"(line 122, column 34) + -- use rule "GenerateCode.ag"(line 138, column 34) _lhsOdecls = _hdIdecls ++ _tlIdecls - -- use rule "GenerateCode.ag"(line 175, column 55) + -- use rule "GenerateCode.ag"(line 195, column 55) _lhsOdefinedInsts = _hdIdefinedInsts ++ _tlIdefinedInsts - -- use rule "GenerateCode.ag"(line 695, column 32) + -- use rule "GenerateCode.ag"(line 719, column 32) _lhsOerrors = _hdIerrors Seq.<> _tlIerrors - -- use rule "GenerateCode.ag"(line 248, column 34) + -- use rule "GenerateCode.ag"(line 268, column 34) _lhsOexprs = _hdIexprs ++ _tlIexprs - -- use rule "GenerateCode.ag"(line 273, column 33) + -- use rule "GenerateCode.ag"(line 297, column 33) _lhsOtSigs = _hdItSigs ++ _tlItSigs - -- use rule "GenerateCode.ag"(line 319, column 31) + -- use rule "GenerateCode.ag"(line 343, column 31) _lhsOtps = _hdItps ++ _tlItps - -- use rule "GenerateCode.ag"(line 262, column 37) + -- use rule "GenerateCode.ag"(line 286, column 37) _lhsOusedVars = _hdIusedVars `Set.union` _tlIusedVars -- copy rule (up) _lhsOdeclsAbove = _tlIdeclsAbove -- copy rule (down) + _hdOallNts = + _lhsIallNts + -- copy rule (down) _hdOchildren = _lhsIchildren -- copy rule (down) @@ -4848,9 +5009,15 @@ _hdOterminals = _lhsIterminals -- copy rule (down) + _hdOunfoldSemDom = + _lhsIunfoldSemDom + -- copy rule (down) _hdOwhat = _lhsIwhat -- copy rule (down) + _tlOallNts = + _lhsIallNts + -- copy rule (down) _tlOchildren = _lhsIchildren -- copy rule (down) @@ -4938,16 +5105,20 @@ _tlOterminals = _lhsIterminals -- copy rule (down) + _tlOunfoldSemDom = + _lhsIunfoldSemDom + -- copy rule (down) _tlOwhat = _lhsIwhat ( _hdIallTpsFound,_hdIbldBlocksFun,_hdIcomments,_hdIdecls,_hdIdeclsAbove,_hdIdefinedInsts,_hdIerrors,_hdIexprs,_hdItSigs,_hdItps,_hdIusedVars) = - (hd_ _hdOchildren _hdOcon _hdOdeclsAbove _hdOerrors _hdOhigherOrderChildren _hdOinh _hdOinstVisitNrs _hdOnr _hdOnt _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOparamInstMap _hdOparamMap _hdOprefix _hdOsyn _hdOterminals _hdOwhat) + (hd_ _hdOallNts _hdOchildren _hdOcon _hdOdeclsAbove _hdOerrors _hdOhigherOrderChildren _hdOinh _hdOinstVisitNrs _hdOnr _hdOnt _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOparamInstMap _hdOparamMap _hdOprefix _hdOsyn _hdOterminals _hdOunfoldSemDom _hdOwhat) ( _tlIallTpsFound,_tlIblockDecls,_tlIcomments,_tlIdecls,_tlIdeclsAbove,_tlIdefinedInsts,_tlIerrors,_tlIexprs,_tlItSigs,_tlItps,_tlIusedVars) = - (tl_ _tlOchildren _tlOcon _tlOdeclsAbove _tlOerrors _tlOhigherOrderChildren _tlOinh _tlOinstVisitNrs _tlOlastExpr _tlOnr _tlOnt _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOparamInstMap _tlOparamMap _tlOprefix _tlOsyn _tlOterminals _tlOwhat) + (tl_ _tlOallNts _tlOchildren _tlOcon _tlOdeclsAbove _tlOerrors _tlOhigherOrderChildren _tlOinh _tlOinstVisitNrs _tlOlastExpr _tlOnr _tlOnt _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOparamInstMap _tlOparamMap _tlOprefix _tlOsyn _tlOterminals _tlOunfoldSemDom _tlOwhat) in ( _lhsOallTpsFound,_lhsOblockDecls,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOerrors,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars)))) sem_Sequence_Nil :: T_Sequence sem_Sequence_Nil = - (T_Sequence (\ _lhsIchildren + (T_Sequence (\ _lhsIallNts + _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIerrors @@ -4976,6 +5147,7 @@ _lhsIprefix _lhsIsyn _lhsIterminals + _lhsIunfoldSemDom _lhsIwhat -> (let _lhsOblockDecls :: DeclBlocks _lhsOallTpsFound :: Bool @@ -4988,34 +5160,34 @@ _lhsOtps :: ([Type]) _lhsOusedVars :: (Set String) _lhsOdeclsAbove :: ([Decl]) - -- "GenerateCode.ag"(line 454, column 7) + -- "GenerateCode.ag"(line 478, column 7) _lhsOblockDecls = DeclTerminator _lhsIdeclsAbove _lhsIlastExpr - -- use rule "GenerateCode.ag"(line 320, column 39) + -- use rule "GenerateCode.ag"(line 344, column 39) _lhsOallTpsFound = True - -- use rule "GenerateCode.ag"(line 714, column 52) + -- use rule "GenerateCode.ag"(line 738, column 52) _lhsOcomments = [] - -- use rule "GenerateCode.ag"(line 122, column 34) + -- use rule "GenerateCode.ag"(line 138, column 34) _lhsOdecls = [] - -- use rule "GenerateCode.ag"(line 175, column 55) + -- use rule "GenerateCode.ag"(line 195, column 55) _lhsOdefinedInsts = [] - -- use rule "GenerateCode.ag"(line 695, column 32) + -- use rule "GenerateCode.ag"(line 719, column 32) _lhsOerrors = Seq.empty - -- use rule "GenerateCode.ag"(line 248, column 34) + -- use rule "GenerateCode.ag"(line 268, column 34) _lhsOexprs = [] - -- use rule "GenerateCode.ag"(line 273, column 33) + -- use rule "GenerateCode.ag"(line 297, column 33) _lhsOtSigs = [] - -- use rule "GenerateCode.ag"(line 319, column 31) + -- use rule "GenerateCode.ag"(line 343, column 31) _lhsOtps = [] - -- use rule "GenerateCode.ag"(line 262, column 37) + -- use rule "GenerateCode.ag"(line 286, column 37) _lhsOusedVars = Set.empty -- copy rule (chain) diff --git a/src-derived/Interfaces.hs b/src-derived/Interfaces.hs --- a/src-derived/Interfaces.hs +++ b/src-derived/Interfaces.hs @@ -1,4 +1,3 @@ - -- UUAGC 0.9.5 (Interfaces.ag) module Interfaces where @@ -8,24 +7,24 @@ {- alternatives: alternative IRoot: - child inters : Interfaces + child inters : Interfaces -} -data IRoot = IRoot (Interfaces) +data IRoot = IRoot (Interfaces) -- Interface --------------------------------------------------- {- alternatives: alternative Interface: child nt : {NontermIdent} child cons : {[ConstructorIdent]} - child seg : Segments + child seg : Segments -} -data Interface = Interface (NontermIdent) ([ConstructorIdent]) (Segments) +data Interface = Interface (NontermIdent) ([ConstructorIdent]) (Segments) -- Interfaces -------------------------------------------------- {- alternatives: alternative Cons: - child hd : Interface - child tl : Interfaces + child hd : Interface + child tl : Interfaces alternative Nil: -} type Interfaces = [Interface] @@ -36,13 +35,13 @@ child inh : {[Vertex]} child syn : {[Vertex]} -} -data Segment = Segment ([Vertex]) ([Vertex]) +data Segment = Segment ([Vertex]) ([Vertex]) -- Segments ---------------------------------------------------- {- alternatives: alternative Cons: - child hd : Segment - child tl : Segments + child hd : Segment + child tl : Segments alternative Nil: -} type Segments = [Segment] diff --git a/src-derived/InterfacesRules.hs b/src-derived/InterfacesRules.hs --- a/src-derived/InterfacesRules.hs +++ b/src-derived/InterfacesRules.hs @@ -1,1080 +1,951 @@ - --- UUAGC 0.9.5 (InterfacesRules.lag) -module InterfacesRules where - -import Interfaces -import SequentialTypes -import CodeSyntax -import GrammarInfo - -import UU.DData.Seq as Seq -import qualified Data.Map as Map -import Data.Map(Map) -import qualified Data.Set as Set -import Data.Set(Set) -import Data.Tree(Tree(Node)) -import Data.Graph(Graph, dfs, edges, buildG, transposeG) -import Data.Maybe (fromJust) -import Data.List (partition,transpose,(\\),nub,intersect, findIndex) -import Data.Array ((!),inRange,bounds,assocs) - -import Debug.Trace(trace) - - -import CommonTypes -import SequentialTypes - -type VisitSS = [Vertex] - - -gather :: Info -> [Vertex] -> [[Vertex]] -gather info = eqClasses comp - where comp a b = isEqualField (ruleTable info ! a) (ruleTable info ! b) - - --- Only non-empty syn will ever be forced, because visits with empty syn are never performed --- Right hand side synthesized attributes always have a field -cv :: (Vertex -> CRule) -> Int -> Vertex -> ([Vertex],[Vertex]) -> (Vertex,ChildVisit) -cv look n v (inh,syn) = let fld = getField (look (head syn)) - rnt = fromJust (getRhsNt (look (head syn))) - d = ChildVisit fld rnt n inh syn - in (v,d) - - -ed v (inh,syn) = map (\i -> (i,v)) inh ++ map (\s -> (v,s)) syn - - -postorder (Node a ts) = postorderF ts ++ [a] -postorderF = concatMap postorder -postOrd g = postorderF . dfs g -topSort' g = postOrd g - - -type IntraVisit = [Vertex] - - -swap (a,b) = (b,a) - - -ccv :: Identifier -> NontermIdent -> Int -> CInterfaceMap -> CRule -ccv name nt n table - = CChildVisit name nt n inh syn last - where CInterface segs = Map.findWithDefault (error ("InterfacesRules::ccv::interfaces not in table for nt: " ++ show nt)) nt table - (seg:remain) = drop n segs - CSegment inh syn = seg - last = null remain --- IRoot ------------------------------------------------------- -{- - visit 0: - inherited attributes: - dpr : [Edge] - info : Info - tdp : Graph - synthesized attributes: - edp : [Edge] - inters : CInterfaceMap - visits : CVisitsMap - alternatives: - alternative IRoot: - child inters : Interfaces - visit 0: - local newedges : _ - local visitssGraph : _ - local descr : _ --} --- cata -sem_IRoot :: IRoot -> - T_IRoot -sem_IRoot (IRoot _inters ) = - (sem_IRoot_IRoot (sem_Interfaces _inters ) ) --- semantic domain -newtype T_IRoot = T_IRoot (([Edge]) -> - Info -> - Graph -> - ( ([Edge]),CInterfaceMap,CVisitsMap)) -data Inh_IRoot = Inh_IRoot {dpr_Inh_IRoot :: [Edge],info_Inh_IRoot :: Info,tdp_Inh_IRoot :: Graph} -data Syn_IRoot = Syn_IRoot {edp_Syn_IRoot :: [Edge],inters_Syn_IRoot :: CInterfaceMap,visits_Syn_IRoot :: CVisitsMap} -wrap_IRoot (T_IRoot sem ) (Inh_IRoot _lhsIdpr _lhsIinfo _lhsItdp ) = - (let ( _lhsOedp,_lhsOinters,_lhsOvisits) = - (sem _lhsIdpr _lhsIinfo _lhsItdp ) - in (Syn_IRoot _lhsOedp _lhsOinters _lhsOvisits )) -sem_IRoot_IRoot :: T_Interfaces -> - T_IRoot -sem_IRoot_IRoot (T_Interfaces inters_ ) = - (T_IRoot (\ _lhsIdpr - _lhsIinfo - _lhsItdp -> - (let _intersOv :: Vertex - _intersOvisitDescr :: (Map Vertex ChildVisit) - _intersOvssGraph :: Graph - _intersOprev :: ([Vertex]) - _intersOddp :: Graph - _intersOallInters :: CInterfaceMap - _lhsOedp :: ([Edge]) - _lhsOinters :: CInterfaceMap - _lhsOvisits :: CVisitsMap - _intersOinfo :: Info - _intersIdescr :: (Seq (Vertex,ChildVisit)) - _intersIedp :: (Seq Edge) - _intersIfirstvisitvertices :: ([Vertex]) - _intersIinters :: CInterfaceMap - _intersInewedges :: (Seq Edge ) - _intersIv :: Vertex - _intersIvisits :: CVisitsMap - -- "InterfacesRules.lag"(line 64, column 12) - _newedges = - Seq.toList _intersInewedges - -- "InterfacesRules.lag"(line 65, column 12) - _visitssGraph = - let graph = buildG (0,_intersIv-1) es - es = _newedges ++ edges _lhsItdp - in transposeG graph - -- "InterfacesRules.lag"(line 78, column 12) - _intersOv = - snd (bounds _lhsItdp) + 1 - -- "InterfacesRules.lag"(line 115, column 13) - _intersOvisitDescr = - Map.fromList _descr - -- "InterfacesRules.lag"(line 135, column 12) - _descr = - Seq.toList _intersIdescr - -- "InterfacesRules.lag"(line 204, column 12) - _intersOvssGraph = - _visitssGraph - -- "InterfacesRules.lag"(line 246, column 12) - _intersOprev = - let terminals = [ v | (v,cr) <- assocs (ruleTable _lhsIinfo), not (getHasCode cr), isLocal cr ] - in _intersIfirstvisitvertices ++ terminals - -- "InterfacesRules.lag"(line 328, column 12) - _intersOddp = - buildG (0,_intersIv-1) (map swap (_lhsIdpr ++ _newedges)) - -- "InterfacesRules.lag"(line 365, column 13) - _intersOallInters = - _intersIinters - -- "InterfacesRules.lag"(line 425, column 13) - _lhsOedp = - Seq.toList _intersIedp - -- copy rule (up) - _lhsOinters = - _intersIinters - -- copy rule (up) - _lhsOvisits = - _intersIvisits - -- copy rule (down) - _intersOinfo = - _lhsIinfo - ( _intersIdescr,_intersIedp,_intersIfirstvisitvertices,_intersIinters,_intersInewedges,_intersIv,_intersIvisits) = - (inters_ _intersOallInters _intersOddp _intersOinfo _intersOprev _intersOv _intersOvisitDescr _intersOvssGraph ) - in ( _lhsOedp,_lhsOinters,_lhsOvisits))) ) --- Interface --------------------------------------------------- -{- - visit 0: - inherited attributes: - allInters : CInterfaceMap - ddp : Graph - info : Info - prev : [Vertex] - visitDescr : Map Vertex ChildVisit - vssGraph : Graph - chained attribute: - v : Vertex - synthesized attributes: - descr : Seq (Vertex,ChildVisit) - edp : Seq Edge - firstvisitvertices : [Vertex] - inter : CInterface - newedges : Seq Edge - nt : NontermIdent - visits : Map ConstructorIdent CVisits - alternatives: - alternative Interface: - child nt : {NontermIdent} - child cons : {[ConstructorIdent]} - child seg : Segments - visit 0: - local v : _ - local firstvisitvertices : _ - local newedges : _ - local look : _ - local descr : _ --} --- cata -sem_Interface :: Interface -> - T_Interface -sem_Interface (Interface _nt _cons _seg ) = - (sem_Interface_Interface _nt _cons (sem_Segments _seg ) ) --- semantic domain -newtype T_Interface = T_Interface (CInterfaceMap -> - Graph -> - Info -> - ([Vertex]) -> - Vertex -> - (Map Vertex ChildVisit) -> - Graph -> - ( (Seq (Vertex,ChildVisit)),(Seq Edge),([Vertex]),CInterface,(Seq Edge ),NontermIdent,Vertex,(Map ConstructorIdent CVisits))) -data Inh_Interface = Inh_Interface {allInters_Inh_Interface :: CInterfaceMap,ddp_Inh_Interface :: Graph,info_Inh_Interface :: Info,prev_Inh_Interface :: [Vertex],v_Inh_Interface :: Vertex,visitDescr_Inh_Interface :: Map Vertex ChildVisit,vssGraph_Inh_Interface :: Graph} -data Syn_Interface = Syn_Interface {descr_Syn_Interface :: Seq (Vertex,ChildVisit),edp_Syn_Interface :: Seq Edge,firstvisitvertices_Syn_Interface :: [Vertex],inter_Syn_Interface :: CInterface,newedges_Syn_Interface :: Seq Edge ,nt_Syn_Interface :: NontermIdent,v_Syn_Interface :: Vertex,visits_Syn_Interface :: Map ConstructorIdent CVisits} -wrap_Interface (T_Interface sem ) (Inh_Interface _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) = - (let ( _lhsOdescr,_lhsOedp,_lhsOfirstvisitvertices,_lhsOinter,_lhsOnewedges,_lhsOnt,_lhsOv,_lhsOvisits) = - (sem _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) - in (Syn_Interface _lhsOdescr _lhsOedp _lhsOfirstvisitvertices _lhsOinter _lhsOnewedges _lhsOnt _lhsOv _lhsOvisits )) -sem_Interface_Interface :: NontermIdent -> - ([ConstructorIdent]) -> - T_Segments -> - T_Interface -sem_Interface_Interface nt_ cons_ (T_Segments seg_ ) = - (T_Interface (\ _lhsIallInters - _lhsIddp - _lhsIinfo - _lhsIprev - _lhsIv - _lhsIvisitDescr - _lhsIvssGraph -> - (let _segOv :: Vertex - _lhsOv :: Vertex - _lhsOnewedges :: (Seq Edge ) - _lhsOdescr :: (Seq (Vertex,ChildVisit)) - _segOn :: Int - _segOcons :: ([ConstructorIdent]) - _segOisFirst :: Bool - _segOfromLhs :: ([Vertex]) - _lhsOnt :: NontermIdent - _lhsOinter :: CInterface - _lhsOvisits :: (Map ConstructorIdent CVisits) - _lhsOedp :: (Seq Edge) - _lhsOfirstvisitvertices :: ([Vertex]) - _segOallInters :: CInterfaceMap - _segOddp :: Graph - _segOinfo :: Info - _segOprev :: ([Vertex]) - _segOvisitDescr :: (Map Vertex ChildVisit) - _segOvssGraph :: Graph - _segIcvisits :: ([[CVisit]]) - _segIdescr :: (Seq (Vertex,ChildVisit)) - _segIedp :: (Seq Edge) - _segIfirstInh :: ([Vertex]) - _segIgroups :: ([([Vertex],[Vertex])]) - _segIhdIntravisits :: ([IntraVisit]) - _segInewedges :: (Seq Edge ) - _segInewvertices :: ([Vertex]) - _segIprev :: ([Vertex]) - _segIsegs :: CSegments - _segIv :: Vertex - -- "InterfacesRules.lag"(line 175, column 17) - _segOv = - _lhsIv - -- "InterfacesRules.lag"(line 176, column 17) - _v = - _segIv + length _segInewvertices - -- "InterfacesRules.lag"(line 177, column 17) - _lhsOv = - _v - -- "InterfacesRules.lag"(line 178, column 17) - _firstvisitvertices = - [_segIv .. _v-1] - -- "InterfacesRules.lag"(line 179, column 17) - _newedges = - zip _firstvisitvertices _segInewvertices - -- "InterfacesRules.lag"(line 180, column 17) - _lhsOnewedges = - _segInewedges Seq.<> Seq.fromList _newedges - -- "InterfacesRules.lag"(line 181, column 17) - _look = - \a -> ruleTable _lhsIinfo ! a - -- "InterfacesRules.lag"(line 182, column 17) - _descr = - zipWith (cv _look (-1)) _firstvisitvertices _segIgroups - -- "InterfacesRules.lag"(line 183, column 17) - _lhsOdescr = - _segIdescr Seq.<> Seq.fromList _descr - -- "InterfacesRules.lag"(line 191, column 16) - _segOn = - 0 - -- "InterfacesRules.lag"(line 223, column 16) - _segOcons = - cons_ - -- "InterfacesRules.lag"(line 299, column 16) - _segOisFirst = - True - -- "InterfacesRules.lag"(line 336, column 16) - _segOfromLhs = - _lhsIprev - -- "InterfacesRules.lag"(line 376, column 16) - _lhsOnt = - nt_ - -- "InterfacesRules.lag"(line 380, column 17) - _lhsOinter = - CInterface _segIsegs - -- "InterfacesRules.lag"(line 381, column 17) - _lhsOvisits = - Map.fromList (zip cons_ (transpose _segIcvisits)) - -- use rule "InterfacesRules.lag"(line 420, column 54) - _lhsOedp = - _segIedp - -- use rule "InterfacesRules.lag"(line 244, column 70) - _lhsOfirstvisitvertices = - _firstvisitvertices - -- copy rule (down) - _segOallInters = - _lhsIallInters - -- copy rule (down) - _segOddp = - _lhsIddp - -- copy rule (down) - _segOinfo = - _lhsIinfo - -- copy rule (down) - _segOprev = - _lhsIprev - -- copy rule (down) - _segOvisitDescr = - _lhsIvisitDescr - -- copy rule (down) - _segOvssGraph = - _lhsIvssGraph - ( _segIcvisits,_segIdescr,_segIedp,_segIfirstInh,_segIgroups,_segIhdIntravisits,_segInewedges,_segInewvertices,_segIprev,_segIsegs,_segIv) = - (seg_ _segOallInters _segOcons _segOddp _segOfromLhs _segOinfo _segOisFirst _segOn _segOprev _segOv _segOvisitDescr _segOvssGraph ) - in ( _lhsOdescr,_lhsOedp,_lhsOfirstvisitvertices,_lhsOinter,_lhsOnewedges,_lhsOnt,_lhsOv,_lhsOvisits))) ) --- Interfaces -------------------------------------------------- -{- - visit 0: - inherited attributes: - allInters : CInterfaceMap - ddp : Graph - info : Info - prev : [Vertex] - visitDescr : Map Vertex ChildVisit - vssGraph : Graph - chained attribute: - v : Vertex - synthesized attributes: - descr : Seq (Vertex,ChildVisit) - edp : Seq Edge - firstvisitvertices : [Vertex] - inters : CInterfaceMap - newedges : Seq Edge - visits : CVisitsMap - alternatives: - alternative Cons: - child hd : Interface - child tl : Interfaces - alternative Nil: --} --- cata -sem_Interfaces :: Interfaces -> - T_Interfaces -sem_Interfaces list = - (Prelude.foldr sem_Interfaces_Cons sem_Interfaces_Nil (Prelude.map sem_Interface list) ) --- semantic domain -newtype T_Interfaces = T_Interfaces (CInterfaceMap -> - Graph -> - Info -> - ([Vertex]) -> - Vertex -> - (Map Vertex ChildVisit) -> - Graph -> - ( (Seq (Vertex,ChildVisit)),(Seq Edge),([Vertex]),CInterfaceMap,(Seq Edge ),Vertex,CVisitsMap)) -data Inh_Interfaces = Inh_Interfaces {allInters_Inh_Interfaces :: CInterfaceMap,ddp_Inh_Interfaces :: Graph,info_Inh_Interfaces :: Info,prev_Inh_Interfaces :: [Vertex],v_Inh_Interfaces :: Vertex,visitDescr_Inh_Interfaces :: Map Vertex ChildVisit,vssGraph_Inh_Interfaces :: Graph} -data Syn_Interfaces = Syn_Interfaces {descr_Syn_Interfaces :: Seq (Vertex,ChildVisit),edp_Syn_Interfaces :: Seq Edge,firstvisitvertices_Syn_Interfaces :: [Vertex],inters_Syn_Interfaces :: CInterfaceMap,newedges_Syn_Interfaces :: Seq Edge ,v_Syn_Interfaces :: Vertex,visits_Syn_Interfaces :: CVisitsMap} -wrap_Interfaces (T_Interfaces sem ) (Inh_Interfaces _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) = - (let ( _lhsOdescr,_lhsOedp,_lhsOfirstvisitvertices,_lhsOinters,_lhsOnewedges,_lhsOv,_lhsOvisits) = - (sem _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) - in (Syn_Interfaces _lhsOdescr _lhsOedp _lhsOfirstvisitvertices _lhsOinters _lhsOnewedges _lhsOv _lhsOvisits )) -sem_Interfaces_Cons :: T_Interface -> - T_Interfaces -> - T_Interfaces -sem_Interfaces_Cons (T_Interface hd_ ) (T_Interfaces tl_ ) = - (T_Interfaces (\ _lhsIallInters - _lhsIddp - _lhsIinfo - _lhsIprev - _lhsIv - _lhsIvisitDescr - _lhsIvssGraph -> - (let _lhsOinters :: CInterfaceMap - _lhsOvisits :: CVisitsMap - _lhsOdescr :: (Seq (Vertex,ChildVisit)) - _lhsOedp :: (Seq Edge) - _lhsOfirstvisitvertices :: ([Vertex]) - _lhsOnewedges :: (Seq Edge ) - _lhsOv :: Vertex - _hdOallInters :: CInterfaceMap - _hdOddp :: Graph - _hdOinfo :: Info - _hdOprev :: ([Vertex]) - _hdOv :: Vertex - _hdOvisitDescr :: (Map Vertex ChildVisit) - _hdOvssGraph :: Graph - _tlOallInters :: CInterfaceMap - _tlOddp :: Graph - _tlOinfo :: Info - _tlOprev :: ([Vertex]) - _tlOv :: Vertex - _tlOvisitDescr :: (Map Vertex ChildVisit) - _tlOvssGraph :: Graph - _hdIdescr :: (Seq (Vertex,ChildVisit)) - _hdIedp :: (Seq Edge) - _hdIfirstvisitvertices :: ([Vertex]) - _hdIinter :: CInterface - _hdInewedges :: (Seq Edge ) - _hdInt :: NontermIdent - _hdIv :: Vertex - _hdIvisits :: (Map ConstructorIdent CVisits) - _tlIdescr :: (Seq (Vertex,ChildVisit)) - _tlIedp :: (Seq Edge) - _tlIfirstvisitvertices :: ([Vertex]) - _tlIinters :: CInterfaceMap - _tlInewedges :: (Seq Edge ) - _tlIv :: Vertex - _tlIvisits :: CVisitsMap - -- "InterfacesRules.lag"(line 370, column 12) - _lhsOinters = - Map.insert _hdInt _hdIinter _tlIinters - -- "InterfacesRules.lag"(line 371, column 12) - _lhsOvisits = - Map.insert _hdInt _hdIvisits _tlIvisits - -- use rule "InterfacesRules.lag"(line 118, column 20) - _lhsOdescr = - _hdIdescr Seq.<> _tlIdescr - -- use rule "InterfacesRules.lag"(line 420, column 54) - _lhsOedp = - _hdIedp Seq.<> _tlIedp - -- use rule "InterfacesRules.lag"(line 244, column 70) - _lhsOfirstvisitvertices = - _hdIfirstvisitvertices ++ _tlIfirstvisitvertices - -- use rule "InterfacesRules.lag"(line 117, column 23) - _lhsOnewedges = - _hdInewedges Seq.<> _tlInewedges - -- copy rule (up) - _lhsOv = - _tlIv - -- copy rule (down) - _hdOallInters = - _lhsIallInters - -- copy rule (down) - _hdOddp = - _lhsIddp - -- copy rule (down) - _hdOinfo = - _lhsIinfo - -- copy rule (down) - _hdOprev = - _lhsIprev - -- copy rule (down) - _hdOv = - _lhsIv - -- copy rule (down) - _hdOvisitDescr = - _lhsIvisitDescr - -- copy rule (down) - _hdOvssGraph = - _lhsIvssGraph - -- copy rule (down) - _tlOallInters = - _lhsIallInters - -- copy rule (down) - _tlOddp = - _lhsIddp - -- copy rule (down) - _tlOinfo = - _lhsIinfo - -- copy rule (down) - _tlOprev = - _lhsIprev - -- copy rule (chain) - _tlOv = - _hdIv - -- copy rule (down) - _tlOvisitDescr = - _lhsIvisitDescr - -- copy rule (down) - _tlOvssGraph = - _lhsIvssGraph - ( _hdIdescr,_hdIedp,_hdIfirstvisitvertices,_hdIinter,_hdInewedges,_hdInt,_hdIv,_hdIvisits) = - (hd_ _hdOallInters _hdOddp _hdOinfo _hdOprev _hdOv _hdOvisitDescr _hdOvssGraph ) - ( _tlIdescr,_tlIedp,_tlIfirstvisitvertices,_tlIinters,_tlInewedges,_tlIv,_tlIvisits) = - (tl_ _tlOallInters _tlOddp _tlOinfo _tlOprev _tlOv _tlOvisitDescr _tlOvssGraph ) - in ( _lhsOdescr,_lhsOedp,_lhsOfirstvisitvertices,_lhsOinters,_lhsOnewedges,_lhsOv,_lhsOvisits))) ) -sem_Interfaces_Nil :: T_Interfaces -sem_Interfaces_Nil = - (T_Interfaces (\ _lhsIallInters - _lhsIddp - _lhsIinfo - _lhsIprev - _lhsIv - _lhsIvisitDescr - _lhsIvssGraph -> - (let _lhsOinters :: CInterfaceMap - _lhsOvisits :: CVisitsMap - _lhsOdescr :: (Seq (Vertex,ChildVisit)) - _lhsOedp :: (Seq Edge) - _lhsOfirstvisitvertices :: ([Vertex]) - _lhsOnewedges :: (Seq Edge ) - _lhsOv :: Vertex - -- "InterfacesRules.lag"(line 372, column 12) - _lhsOinters = - Map.empty - -- "InterfacesRules.lag"(line 373, column 12) - _lhsOvisits = - Map.empty - -- use rule "InterfacesRules.lag"(line 118, column 20) - _lhsOdescr = - Seq.empty - -- use rule "InterfacesRules.lag"(line 420, column 54) - _lhsOedp = - Seq.empty - -- use rule "InterfacesRules.lag"(line 244, column 70) - _lhsOfirstvisitvertices = - [] - -- use rule "InterfacesRules.lag"(line 117, column 23) - _lhsOnewedges = - Seq.empty - -- copy rule (chain) - _lhsOv = - _lhsIv - in ( _lhsOdescr,_lhsOedp,_lhsOfirstvisitvertices,_lhsOinters,_lhsOnewedges,_lhsOv,_lhsOvisits))) ) --- Segment ----------------------------------------------------- -{- - visit 0: - inherited attributes: - allInters : CInterfaceMap - cons : [ConstructorIdent] - ddp : Graph - fromLhs : [Vertex] - info : Info - isFirst : Bool - n : Int - nextInh : [Vertex] - nextIntravisits : [IntraVisit] - nextNewvertices : [Vertex] - visitDescr : Map Vertex ChildVisit - vssGraph : Graph - chained attributes: - prev : [Vertex] - v : Vertex - synthesized attributes: - cvisits : [CVisit] - descr : Seq (Vertex,ChildVisit) - edp : Seq Edge - groups : [([Vertex],[Vertex])] - inh : [Vertex] - intravisits : [IntraVisit] - newedges : Seq Edge - newvertices : [Vertex] - seg : CSegment - visitss : [VisitSS] - alternatives: - alternative Segment: - child inh : {[Vertex]} - child syn : {[Vertex]} - visit 0: - local look : _ - local occurAs : _ - local groups : _ - local v : _ - local newvertices : _ - local attredges : _ - local visitedges : _ - local synOccur : _ - local vss : _ - local visitss' : _ - local defined : _ - local visitss : _ - local fromLhs : _ - local computed : _ - local intravisits : _ - local iv : _ - local _tup1 : _ - local inhmap : _ - local synmap : _ --} --- cata -sem_Segment :: Segment -> - T_Segment -sem_Segment (Segment _inh _syn ) = - (sem_Segment_Segment _inh _syn ) --- semantic domain -newtype T_Segment = T_Segment (CInterfaceMap -> - ([ConstructorIdent]) -> - Graph -> - ([Vertex]) -> - Info -> - Bool -> - Int -> - ([Vertex]) -> - ([IntraVisit]) -> - ([Vertex]) -> - ([Vertex]) -> - Vertex -> - (Map Vertex ChildVisit) -> - Graph -> - ( ([CVisit]),(Seq (Vertex,ChildVisit)),(Seq Edge),([([Vertex],[Vertex])]),([Vertex]),([IntraVisit]),(Seq Edge ),([Vertex]),([Vertex]),CSegment,Vertex,([VisitSS]))) -data Inh_Segment = Inh_Segment {allInters_Inh_Segment :: CInterfaceMap,cons_Inh_Segment :: [ConstructorIdent],ddp_Inh_Segment :: Graph,fromLhs_Inh_Segment :: [Vertex],info_Inh_Segment :: Info,isFirst_Inh_Segment :: Bool,n_Inh_Segment :: Int,nextInh_Inh_Segment :: [Vertex],nextIntravisits_Inh_Segment :: [IntraVisit],nextNewvertices_Inh_Segment :: [Vertex],prev_Inh_Segment :: [Vertex],v_Inh_Segment :: Vertex,visitDescr_Inh_Segment :: Map Vertex ChildVisit,vssGraph_Inh_Segment :: Graph} -data Syn_Segment = Syn_Segment {cvisits_Syn_Segment :: [CVisit],descr_Syn_Segment :: Seq (Vertex,ChildVisit),edp_Syn_Segment :: Seq Edge,groups_Syn_Segment :: [([Vertex],[Vertex])],inh_Syn_Segment :: [Vertex],intravisits_Syn_Segment :: [IntraVisit],newedges_Syn_Segment :: Seq Edge ,newvertices_Syn_Segment :: [Vertex],prev_Syn_Segment :: [Vertex],seg_Syn_Segment :: CSegment,v_Syn_Segment :: Vertex,visitss_Syn_Segment :: [VisitSS]} -wrap_Segment (T_Segment sem ) (Inh_Segment _lhsIallInters _lhsIcons _lhsIddp _lhsIfromLhs _lhsIinfo _lhsIisFirst _lhsIn _lhsInextInh _lhsInextIntravisits _lhsInextNewvertices _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) = - (let ( _lhsOcvisits,_lhsOdescr,_lhsOedp,_lhsOgroups,_lhsOinh,_lhsOintravisits,_lhsOnewedges,_lhsOnewvertices,_lhsOprev,_lhsOseg,_lhsOv,_lhsOvisitss) = - (sem _lhsIallInters _lhsIcons _lhsIddp _lhsIfromLhs _lhsIinfo _lhsIisFirst _lhsIn _lhsInextInh _lhsInextIntravisits _lhsInextNewvertices _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) - in (Syn_Segment _lhsOcvisits _lhsOdescr _lhsOedp _lhsOgroups _lhsOinh _lhsOintravisits _lhsOnewedges _lhsOnewvertices _lhsOprev _lhsOseg _lhsOv _lhsOvisitss )) -sem_Segment_Segment :: ([Vertex]) -> - ([Vertex]) -> - T_Segment -sem_Segment_Segment inh_ syn_ = - (T_Segment (\ _lhsIallInters - _lhsIcons - _lhsIddp - _lhsIfromLhs - _lhsIinfo - _lhsIisFirst - _lhsIn - _lhsInextInh - _lhsInextIntravisits - _lhsInextNewvertices - _lhsIprev - _lhsIv - _lhsIvisitDescr - _lhsIvssGraph -> - (let _lhsOdescr :: (Seq (Vertex,ChildVisit)) - _lhsOnewedges :: (Seq Edge ) - _lhsOprev :: ([Vertex]) - _lhsOseg :: CSegment - _lhsOcvisits :: ([CVisit]) - _lhsOedp :: (Seq Edge) - _lhsOinh :: ([Vertex]) - _lhsOgroups :: ([([Vertex],[Vertex])]) - _lhsOintravisits :: ([IntraVisit]) - _lhsOnewvertices :: ([Vertex]) - _lhsOv :: Vertex - _lhsOvisitss :: ([VisitSS]) - -- "InterfacesRules.lag"(line 98, column 15) - _look = - \a -> ruleTable _lhsIinfo ! a - -- "InterfacesRules.lag"(line 99, column 15) - _occurAs = - \p us -> [ a | u <- us - , a <- tdsToTdp _lhsIinfo ! u - , p (_look a)] - -- "InterfacesRules.lag"(line 102, column 15) - _groups = - let group as = gather _lhsIinfo (_occurAs isRhs as) - in map (partition (isInh . _look)) (group (inh_ ++ syn_)) - -- "InterfacesRules.lag"(line 104, column 15) - _v = - _lhsIv + length _groups - -- "InterfacesRules.lag"(line 105, column 15) - _newvertices = - [_lhsIv .. _v -1] - -- "InterfacesRules.lag"(line 120, column 14) - _lhsOdescr = - Seq.fromList $ zipWith (cv _look _lhsIn) _newvertices _groups - -- "InterfacesRules.lag"(line 143, column 14) - _attredges = - concat (zipWith ed _newvertices _groups) - -- "InterfacesRules.lag"(line 162, column 15) - _visitedges = - zip _newvertices _lhsInextNewvertices - -- "InterfacesRules.lag"(line 163, column 15) - _lhsOnewedges = - Seq.fromList _attredges Seq.<> Seq.fromList _visitedges - -- "InterfacesRules.lag"(line 215, column 15) - _synOccur = - gather _lhsIinfo (_occurAs isLhs syn_) - -- "InterfacesRules.lag"(line 216, column 15) - _vss = - let hasCode v | inRange (bounds (ruleTable _lhsIinfo)) v = getHasCode (ruleTable _lhsIinfo ! v) - | otherwise = True - in if null syn_ - then replicate (length _lhsIcons) [] - else map (filter hasCode . topSort' _lhsIvssGraph) _synOccur - -- "InterfacesRules.lag"(line 256, column 15) - _visitss' = - map (\\ _lhsIprev) _vss - -- "InterfacesRules.lag"(line 257, column 15) - _defined = - let defines v = case Map.lookup v _lhsIvisitDescr of - Nothing -> [v] - Just (ChildVisit _ _ _ inh _) -> v:inh - in concatMap (concatMap defines) _visitss - -- "InterfacesRules.lag"(line 261, column 15) - _lhsOprev = - _lhsIprev ++ _defined - -- "InterfacesRules.lag"(line 269, column 15) - _visitss = - let rem :: [(Identifier,Identifier,Maybe Type)] -> [Vertex] -> [Vertex] - rem prev [] = [] - rem prev (v:vs) - | inRange (bounds table) v - = let cr = table ! v - addV = case findIndex cmp prev of - Just _ -> id - _ -> (v:) - cmp (fld,attr,tp) = getField cr == fld && getAttr cr == attr && sameNT (getType cr) tp - sameNT (Just (NT ntA _)) (Just (NT ntB _)) = ntA == ntB - sameNT _ _ = False - def = Map.elems (getDefines cr) - in addV (rem (def ++ prev) vs) - | otherwise = v:rem prev vs - table = ruleTable _lhsIinfo - in map (rem []) _visitss' - -- "InterfacesRules.lag"(line 341, column 15) - _fromLhs = - _occurAs isLhs inh_ ++ _lhsIfromLhs - -- "InterfacesRules.lag"(line 342, column 15) - _computed = - let computes v = case Map.lookup v _lhsIvisitDescr of - Nothing -> Map.keys (getDefines (ruleTable _lhsIinfo ! v)) - Just (ChildVisit _ _ _ _ syn) -> v:syn - in concatMap (concatMap computes) _visitss - -- "InterfacesRules.lag"(line 346, column 15) - _intravisits = - zipWith _iv _visitss _lhsInextIntravisits - -- "InterfacesRules.lag"(line 347, column 15) - _iv = - \vs next -> - let needed = concatMap (_lhsIddp !) vs - in nub (needed ++ next) \\ (_fromLhs ++ _computed) - -- "InterfacesRules.lag"(line 390, column 15) - _lhsOseg = - if False then undefined _lhsIvssGraph _lhsIvisitDescr _lhsIprev else CSegment _inhmap _synmap - -- "InterfacesRules.lag"(line 392, column 19) - __tup1 = - let makemap = Map.fromList . map findType - findType v = getNtaNameType (attrTable _lhsIinfo ! v) - in (makemap inh_,makemap syn_) - -- "InterfacesRules.lag"(line 392, column 19) - (_inhmap,_) = - __tup1 - -- "InterfacesRules.lag"(line 392, column 19) - (_,_synmap) = - __tup1 - -- "InterfacesRules.lag"(line 395, column 15) - _lhsOcvisits = - let mkVisit vss intra = CVisit _inhmap _synmap (mkSequence vss) (mkSequence intra) True - mkSequence = map mkRule - mkRule v = case Map.lookup v _lhsIvisitDescr of - Nothing -> ruleTable _lhsIinfo ! v - Just (ChildVisit name nt n _ _) -> ccv name nt n _lhsIallInters - in zipWith mkVisit _visitss _intravisits - -- "InterfacesRules.lag"(line 422, column 14) - _lhsOedp = - Seq.fromList [(i,s) | i <- inh_, s <- syn_] - Seq.<> Seq.fromList [(s,i) | s <- syn_, i <- _lhsInextInh ] - -- "InterfacesRules.lag"(line 427, column 14) - _lhsOinh = - inh_ - -- copy rule (from local) - _lhsOgroups = - _groups - -- copy rule (from local) - _lhsOintravisits = - _intravisits - -- copy rule (from local) - _lhsOnewvertices = - _newvertices - -- copy rule (from local) - _lhsOv = - _v - -- copy rule (from local) - _lhsOvisitss = - _visitss - in ( _lhsOcvisits,_lhsOdescr,_lhsOedp,_lhsOgroups,_lhsOinh,_lhsOintravisits,_lhsOnewedges,_lhsOnewvertices,_lhsOprev,_lhsOseg,_lhsOv,_lhsOvisitss))) ) --- Segments ---------------------------------------------------- -{- - visit 0: - inherited attributes: - allInters : CInterfaceMap - cons : [ConstructorIdent] - ddp : Graph - fromLhs : [Vertex] - info : Info - isFirst : Bool - n : Int - visitDescr : Map Vertex ChildVisit - vssGraph : Graph - chained attributes: - prev : [Vertex] - v : Vertex - synthesized attributes: - cvisits : [[CVisit]] - descr : Seq (Vertex,ChildVisit) - edp : Seq Edge - firstInh : [Vertex] - groups : [([Vertex],[Vertex])] - hdIntravisits : [IntraVisit] - newedges : Seq Edge - newvertices : [Vertex] - segs : CSegments - alternatives: - alternative Cons: - child hd : Segment - child tl : Segments - alternative Nil: --} --- cata -sem_Segments :: Segments -> - T_Segments -sem_Segments list = - (Prelude.foldr sem_Segments_Cons sem_Segments_Nil (Prelude.map sem_Segment list) ) --- semantic domain -newtype T_Segments = T_Segments (CInterfaceMap -> - ([ConstructorIdent]) -> - Graph -> - ([Vertex]) -> - Info -> - Bool -> - Int -> - ([Vertex]) -> - Vertex -> - (Map Vertex ChildVisit) -> - Graph -> - ( ([[CVisit]]),(Seq (Vertex,ChildVisit)),(Seq Edge),([Vertex]),([([Vertex],[Vertex])]),([IntraVisit]),(Seq Edge ),([Vertex]),([Vertex]),CSegments,Vertex)) -data Inh_Segments = Inh_Segments {allInters_Inh_Segments :: CInterfaceMap,cons_Inh_Segments :: [ConstructorIdent],ddp_Inh_Segments :: Graph,fromLhs_Inh_Segments :: [Vertex],info_Inh_Segments :: Info,isFirst_Inh_Segments :: Bool,n_Inh_Segments :: Int,prev_Inh_Segments :: [Vertex],v_Inh_Segments :: Vertex,visitDescr_Inh_Segments :: Map Vertex ChildVisit,vssGraph_Inh_Segments :: Graph} -data Syn_Segments = Syn_Segments {cvisits_Syn_Segments :: [[CVisit]],descr_Syn_Segments :: Seq (Vertex,ChildVisit),edp_Syn_Segments :: Seq Edge,firstInh_Syn_Segments :: [Vertex],groups_Syn_Segments :: [([Vertex],[Vertex])],hdIntravisits_Syn_Segments :: [IntraVisit],newedges_Syn_Segments :: Seq Edge ,newvertices_Syn_Segments :: [Vertex],prev_Syn_Segments :: [Vertex],segs_Syn_Segments :: CSegments,v_Syn_Segments :: Vertex} -wrap_Segments (T_Segments sem ) (Inh_Segments _lhsIallInters _lhsIcons _lhsIddp _lhsIfromLhs _lhsIinfo _lhsIisFirst _lhsIn _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) = - (let ( _lhsOcvisits,_lhsOdescr,_lhsOedp,_lhsOfirstInh,_lhsOgroups,_lhsOhdIntravisits,_lhsOnewedges,_lhsOnewvertices,_lhsOprev,_lhsOsegs,_lhsOv) = - (sem _lhsIallInters _lhsIcons _lhsIddp _lhsIfromLhs _lhsIinfo _lhsIisFirst _lhsIn _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) - in (Syn_Segments _lhsOcvisits _lhsOdescr _lhsOedp _lhsOfirstInh _lhsOgroups _lhsOhdIntravisits _lhsOnewedges _lhsOnewvertices _lhsOprev _lhsOsegs _lhsOv )) -sem_Segments_Cons :: T_Segment -> - T_Segments -> - T_Segments -sem_Segments_Cons (T_Segment hd_ ) (T_Segments tl_ ) = - (T_Segments (\ _lhsIallInters - _lhsIcons - _lhsIddp - _lhsIfromLhs - _lhsIinfo - _lhsIisFirst - _lhsIn - _lhsIprev - _lhsIv - _lhsIvisitDescr - _lhsIvssGraph -> - (let _hdOnextNewvertices :: ([Vertex]) - _lhsOnewvertices :: ([Vertex]) - _lhsOgroups :: ([([Vertex],[Vertex])]) - _tlOn :: Int - _tlOisFirst :: Bool - _hdOnextIntravisits :: ([IntraVisit]) - _lhsOhdIntravisits :: ([IntraVisit]) - _hdOfromLhs :: ([Vertex]) - _tlOfromLhs :: ([Vertex]) - _lhsOsegs :: CSegments - _hdOnextInh :: ([Vertex]) - _lhsOfirstInh :: ([Vertex]) - _lhsOcvisits :: ([[CVisit]]) - _lhsOdescr :: (Seq (Vertex,ChildVisit)) - _lhsOedp :: (Seq Edge) - _lhsOnewedges :: (Seq Edge ) - _lhsOprev :: ([Vertex]) - _lhsOv :: Vertex - _hdOallInters :: CInterfaceMap - _hdOcons :: ([ConstructorIdent]) - _hdOddp :: Graph - _hdOinfo :: Info - _hdOisFirst :: Bool - _hdOn :: Int - _hdOprev :: ([Vertex]) - _hdOv :: Vertex - _hdOvisitDescr :: (Map Vertex ChildVisit) - _hdOvssGraph :: Graph - _tlOallInters :: CInterfaceMap - _tlOcons :: ([ConstructorIdent]) - _tlOddp :: Graph - _tlOinfo :: Info - _tlOprev :: ([Vertex]) - _tlOv :: Vertex - _tlOvisitDescr :: (Map Vertex ChildVisit) - _tlOvssGraph :: Graph - _hdIcvisits :: ([CVisit]) - _hdIdescr :: (Seq (Vertex,ChildVisit)) - _hdIedp :: (Seq Edge) - _hdIgroups :: ([([Vertex],[Vertex])]) - _hdIinh :: ([Vertex]) - _hdIintravisits :: ([IntraVisit]) - _hdInewedges :: (Seq Edge ) - _hdInewvertices :: ([Vertex]) - _hdIprev :: ([Vertex]) - _hdIseg :: CSegment - _hdIv :: Vertex - _hdIvisitss :: ([VisitSS]) - _tlIcvisits :: ([[CVisit]]) - _tlIdescr :: (Seq (Vertex,ChildVisit)) - _tlIedp :: (Seq Edge) - _tlIfirstInh :: ([Vertex]) - _tlIgroups :: ([([Vertex],[Vertex])]) - _tlIhdIntravisits :: ([IntraVisit]) - _tlInewedges :: (Seq Edge ) - _tlInewvertices :: ([Vertex]) - _tlIprev :: ([Vertex]) - _tlIsegs :: CSegments - _tlIv :: Vertex - -- "InterfacesRules.lag"(line 157, column 12) - _hdOnextNewvertices = - _tlInewvertices - -- "InterfacesRules.lag"(line 158, column 12) - _lhsOnewvertices = - _hdInewvertices - -- "InterfacesRules.lag"(line 172, column 11) - _lhsOgroups = - _hdIgroups - -- "InterfacesRules.lag"(line 193, column 11) - _tlOn = - _lhsIn + 1 - -- "InterfacesRules.lag"(line 301, column 11) - _tlOisFirst = - False - -- "InterfacesRules.lag"(line 314, column 12) - _hdOnextIntravisits = - _tlIhdIntravisits - -- "InterfacesRules.lag"(line 315, column 12) - _lhsOhdIntravisits = - _hdIintravisits - -- "InterfacesRules.lag"(line 338, column 12) - _hdOfromLhs = - _lhsIfromLhs - -- "InterfacesRules.lag"(line 339, column 12) - _tlOfromLhs = - [] - -- "InterfacesRules.lag"(line 385, column 12) - _lhsOsegs = - _hdIseg : _tlIsegs - -- "InterfacesRules.lag"(line 429, column 12) - _hdOnextInh = - _tlIfirstInh - -- "InterfacesRules.lag"(line 430, column 12) - _lhsOfirstInh = - _hdIinh - -- use rule "InterfacesRules.lag"(line 384, column 29) - _lhsOcvisits = - _hdIcvisits : _tlIcvisits - -- use rule "InterfacesRules.lag"(line 118, column 20) - _lhsOdescr = - _hdIdescr Seq.<> _tlIdescr - -- use rule "InterfacesRules.lag"(line 420, column 54) - _lhsOedp = - _hdIedp Seq.<> _tlIedp - -- use rule "InterfacesRules.lag"(line 117, column 23) - _lhsOnewedges = - _hdInewedges Seq.<> _tlInewedges - -- copy rule (up) - _lhsOprev = - _tlIprev - -- copy rule (up) - _lhsOv = - _tlIv - -- copy rule (down) - _hdOallInters = - _lhsIallInters - -- copy rule (down) - _hdOcons = - _lhsIcons - -- copy rule (down) - _hdOddp = - _lhsIddp - -- copy rule (down) - _hdOinfo = - _lhsIinfo - -- copy rule (down) - _hdOisFirst = - _lhsIisFirst - -- copy rule (down) - _hdOn = - _lhsIn - -- copy rule (down) - _hdOprev = - _lhsIprev - -- copy rule (down) - _hdOv = - _lhsIv - -- copy rule (down) - _hdOvisitDescr = - _lhsIvisitDescr - -- copy rule (down) - _hdOvssGraph = - _lhsIvssGraph - -- copy rule (down) - _tlOallInters = - _lhsIallInters - -- copy rule (down) - _tlOcons = - _lhsIcons - -- copy rule (down) - _tlOddp = - _lhsIddp - -- copy rule (down) - _tlOinfo = - _lhsIinfo - -- copy rule (chain) - _tlOprev = - _hdIprev - -- copy rule (chain) - _tlOv = - _hdIv - -- copy rule (down) - _tlOvisitDescr = - _lhsIvisitDescr - -- copy rule (down) - _tlOvssGraph = - _lhsIvssGraph - ( _hdIcvisits,_hdIdescr,_hdIedp,_hdIgroups,_hdIinh,_hdIintravisits,_hdInewedges,_hdInewvertices,_hdIprev,_hdIseg,_hdIv,_hdIvisitss) = - (hd_ _hdOallInters _hdOcons _hdOddp _hdOfromLhs _hdOinfo _hdOisFirst _hdOn _hdOnextInh _hdOnextIntravisits _hdOnextNewvertices _hdOprev _hdOv _hdOvisitDescr _hdOvssGraph ) - ( _tlIcvisits,_tlIdescr,_tlIedp,_tlIfirstInh,_tlIgroups,_tlIhdIntravisits,_tlInewedges,_tlInewvertices,_tlIprev,_tlIsegs,_tlIv) = - (tl_ _tlOallInters _tlOcons _tlOddp _tlOfromLhs _tlOinfo _tlOisFirst _tlOn _tlOprev _tlOv _tlOvisitDescr _tlOvssGraph ) - in ( _lhsOcvisits,_lhsOdescr,_lhsOedp,_lhsOfirstInh,_lhsOgroups,_lhsOhdIntravisits,_lhsOnewedges,_lhsOnewvertices,_lhsOprev,_lhsOsegs,_lhsOv))) ) -sem_Segments_Nil :: T_Segments -sem_Segments_Nil = - (T_Segments (\ _lhsIallInters - _lhsIcons - _lhsIddp - _lhsIfromLhs - _lhsIinfo - _lhsIisFirst - _lhsIn - _lhsIprev - _lhsIv - _lhsIvisitDescr - _lhsIvssGraph -> - (let _lhsOnewvertices :: ([Vertex]) - _lhsOgroups :: ([([Vertex],[Vertex])]) - _lhsOhdIntravisits :: ([IntraVisit]) - _lhsOsegs :: CSegments - _lhsOfirstInh :: ([Vertex]) - _lhsOcvisits :: ([[CVisit]]) - _lhsOdescr :: (Seq (Vertex,ChildVisit)) - _lhsOedp :: (Seq Edge) - _lhsOnewedges :: (Seq Edge ) - _lhsOprev :: ([Vertex]) - _lhsOv :: Vertex - -- "InterfacesRules.lag"(line 159, column 12) - _lhsOnewvertices = - [] - -- "InterfacesRules.lag"(line 173, column 11) - _lhsOgroups = - [] - -- "InterfacesRules.lag"(line 316, column 10) - _lhsOhdIntravisits = - repeat [] - -- "InterfacesRules.lag"(line 386, column 12) - _lhsOsegs = - [] - -- "InterfacesRules.lag"(line 431, column 11) - _lhsOfirstInh = - [] - -- use rule "InterfacesRules.lag"(line 384, column 29) - _lhsOcvisits = - [] - -- use rule "InterfacesRules.lag"(line 118, column 20) - _lhsOdescr = - Seq.empty - -- use rule "InterfacesRules.lag"(line 420, column 54) - _lhsOedp = - Seq.empty - -- use rule "InterfacesRules.lag"(line 117, column 23) - _lhsOnewedges = - Seq.empty - -- copy rule (chain) - _lhsOprev = - _lhsIprev - -- copy rule (chain) - _lhsOv = - _lhsIv - in ( _lhsOcvisits,_lhsOdescr,_lhsOedp,_lhsOfirstInh,_lhsOgroups,_lhsOhdIntravisits,_lhsOnewedges,_lhsOnewvertices,_lhsOprev,_lhsOsegs,_lhsOv))) ) +{-# OPTIONS_GHC -fbang-patterns #-} +-- UUAGC 0.9.5 (InterfacesRules.lag) +module InterfacesRules where + +import Interfaces +import SequentialTypes +import CodeSyntax +import GrammarInfo + +import UU.DData.Seq as Seq +import qualified Data.Map as Map +import Data.Map(Map) +import qualified Data.Set as Set +import Data.Set(Set) +import Data.Tree(Tree(Node)) +import Data.Graph(Graph, dfs, edges, buildG, transposeG) +import Data.Maybe (fromJust) +import Data.List (partition,transpose,(\\),nub,intersect, findIndex) +import Data.Array ((!),inRange,bounds,assocs) + +import Debug.Trace(trace) + +import CommonTypes +import SequentialTypes + +type VisitSS = [Vertex] + +gather :: Info -> [Vertex] -> [[Vertex]] +gather info = eqClasses comp + where comp a b = isEqualField (ruleTable info ! a) (ruleTable info ! b) + +-- Only non-empty syn will ever be forced, because visits with empty syn are never performed +-- Right hand side synthesized attributes always have a field +cv :: (Vertex -> CRule) -> Int -> Vertex -> ([Vertex],[Vertex]) -> (Vertex,ChildVisit) +cv look n v (inh,syn) = let fld = getField (look (head syn)) + rnt = fromJust (getRhsNt (look (head syn))) + d = ChildVisit fld rnt n inh syn + in (v,d) + +ed v (inh,syn) = map (\i -> (i,v)) inh ++ map (\s -> (v,s)) syn + +postorder (Node a ts) = postorderF ts ++ [a] +postorderF = concatMap postorder +postOrd g = postorderF . dfs g +topSort' g = postOrd g + +type IntraVisit = [Vertex] + +swap (a,b) = (b,a) + +ccv :: Identifier -> NontermIdent -> Int -> CInterfaceMap -> CRule +ccv name nt n table + = CChildVisit name nt n inh syn last + where CInterface segs = Map.findWithDefault (error ("InterfacesRules::ccv::interfaces not in table for nt: " ++ show nt)) nt table + (seg:remain) = drop n segs + CSegment inh syn = seg + last = null remain +-- IRoot ------------------------------------------------------- +{- + visit 0: + inherited attributes: + dpr : [Edge] + info : Info + tdp : Graph + synthesized attributes: + edp : [Edge] + inters : CInterfaceMap + visits : CVisitsMap + alternatives: + alternative IRoot: + child inters : Interfaces + visit 0: + local newedges : _ + local visitssGraph : _ + local descr : _ +-} +-- cata +sem_IRoot :: IRoot -> + T_IRoot +sem_IRoot !(IRoot _inters) = + (sem_IRoot_IRoot (sem_Interfaces _inters)) +-- semantic domain +newtype T_IRoot = T_IRoot (([Edge]) -> + Info -> + Graph -> + ( ([Edge]),CInterfaceMap,CVisitsMap)) +data Inh_IRoot = Inh_IRoot {dpr_Inh_IRoot :: !([Edge]),info_Inh_IRoot :: !(Info),tdp_Inh_IRoot :: !(Graph)} +data Syn_IRoot = Syn_IRoot {edp_Syn_IRoot :: !([Edge]),inters_Syn_IRoot :: !(CInterfaceMap),visits_Syn_IRoot :: !(CVisitsMap)} +wrap_IRoot !(T_IRoot sem) !(Inh_IRoot _lhsIdpr _lhsIinfo _lhsItdp) = + (let ( !_lhsOedp,!_lhsOinters,!_lhsOvisits) = + (sem _lhsIdpr _lhsIinfo _lhsItdp) + in (Syn_IRoot _lhsOedp _lhsOinters _lhsOvisits)) +sem_IRoot_IRoot :: T_Interfaces -> + T_IRoot +sem_IRoot_IRoot !(T_Interfaces inters_) = + (T_IRoot (\ (!_lhsIdpr) + (!_lhsIinfo) + (!_lhsItdp) -> + (case (_lhsIinfo) of + { !_intersOinfo -> + (case (snd (bounds _lhsItdp) + 1) of + { !_intersOv -> + (case ((inters_ _intersOinfo _intersOv)) of + { ( !_intersIdescr,!_intersIfirstvisitvertices,!_intersInewedges,!_intersIv,!T_Interfaces_1 inters_1) -> + (case (let terminals = [ v | (v,cr) <- assocs (ruleTable _lhsIinfo), not (getHasCode cr), isLocal cr ] + in _intersIfirstvisitvertices ++ terminals) of + { !_intersOprev -> + (case (Seq.toList _intersInewedges) of + { !_newedges -> + (case (let graph = buildG (0,_intersIv-1) es + es = _newedges ++ edges _lhsItdp + in transposeG graph) of + { !_visitssGraph -> + (case (_visitssGraph) of + { !_intersOvssGraph -> + (case (Seq.toList _intersIdescr) of + { !_descr -> + (case (Map.fromList _descr) of + { !_intersOvisitDescr -> + (case ((inters_1 _intersOprev _intersOvisitDescr _intersOvssGraph)) of + { ( !_intersIinters,!T_Interfaces_2 inters_2) -> + (case (_intersIinters) of + { !_intersOallInters -> + (case (buildG (0,_intersIv-1) (map swap (_lhsIdpr ++ _newedges))) of + { !_intersOddp -> + (case ((inters_2 _intersOallInters _intersOddp)) of + { ( !_intersIedp,!_intersIvisits) -> + (case (Seq.toList _intersIedp) of + { !_lhsOedp -> + (case (_intersIinters) of + { !_lhsOinters -> + (case (_intersIvisits) of + { !_lhsOvisits -> + ( _lhsOedp,_lhsOinters,_lhsOvisits) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +-- Interface --------------------------------------------------- +{- + visit 0: + inherited attribute: + info : Info + chained attribute: + v : Vertex + synthesized attributes: + descr : Seq (Vertex,ChildVisit) + firstvisitvertices : [Vertex] + newedges : Seq Edge + visit 1: + inherited attributes: + prev : [Vertex] + visitDescr : Map Vertex ChildVisit + vssGraph : Graph + synthesized attributes: + inter : CInterface + nt : NontermIdent + visit 2: + inherited attributes: + allInters : CInterfaceMap + ddp : Graph + synthesized attributes: + edp : Seq Edge + visits : Map ConstructorIdent CVisits + alternatives: + alternative Interface: + child nt : {NontermIdent} + child cons : {[ConstructorIdent]} + child seg : Segments + visit 0: + local look : {Vertex -> CRule} + local v : _ + local firstvisitvertices : _ + local descr : _ + local newedges : _ +-} +-- cata +sem_Interface :: Interface -> + T_Interface +sem_Interface !(Interface _nt _cons _seg) = + (sem_Interface_Interface _nt _cons (sem_Segments _seg)) +-- semantic domain +newtype T_Interface = T_Interface (Info -> + Vertex -> + ( (Seq (Vertex,ChildVisit)),([Vertex]),(Seq Edge ),Vertex,T_Interface_1)) +newtype T_Interface_1 = T_Interface_1 (([Vertex]) -> + (Map Vertex ChildVisit) -> + Graph -> + ( CInterface,NontermIdent,T_Interface_2)) +newtype T_Interface_2 = T_Interface_2 (CInterfaceMap -> + Graph -> + ( (Seq Edge),(Map ConstructorIdent CVisits))) +data Inh_Interface = Inh_Interface {allInters_Inh_Interface :: !(CInterfaceMap),ddp_Inh_Interface :: !(Graph),info_Inh_Interface :: !(Info),prev_Inh_Interface :: !([Vertex]),v_Inh_Interface :: !(Vertex),visitDescr_Inh_Interface :: !(Map Vertex ChildVisit),vssGraph_Inh_Interface :: !(Graph)} +data Syn_Interface = Syn_Interface {descr_Syn_Interface :: !(Seq (Vertex,ChildVisit)),edp_Syn_Interface :: !(Seq Edge),firstvisitvertices_Syn_Interface :: !([Vertex]),inter_Syn_Interface :: !(CInterface),newedges_Syn_Interface :: !(Seq Edge ),nt_Syn_Interface :: !(NontermIdent),v_Syn_Interface :: !(Vertex),visits_Syn_Interface :: !(Map ConstructorIdent CVisits)} +wrap_Interface !(T_Interface sem) !(Inh_Interface _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph) = + (let ( !_lhsOdescr,!_lhsOfirstvisitvertices,!_lhsOnewedges,!_lhsOv,!T_Interface_1 sem_1) = + (sem _lhsIinfo _lhsIv) + ( !_lhsOinter,!_lhsOnt,!T_Interface_2 sem_2) = + (sem_1 _lhsIprev _lhsIvisitDescr _lhsIvssGraph) + ( !_lhsOedp,!_lhsOvisits) = + (sem_2 _lhsIallInters _lhsIddp) + in (Syn_Interface _lhsOdescr _lhsOedp _lhsOfirstvisitvertices _lhsOinter _lhsOnewedges _lhsOnt _lhsOv _lhsOvisits)) +sem_Interface_Interface :: NontermIdent -> + ([ConstructorIdent]) -> + T_Segments -> + T_Interface +sem_Interface_Interface !nt_ !cons_ !(T_Segments seg_) = + (T_Interface (\ (!_lhsIinfo) + (!_lhsIv) -> + (case (_lhsIinfo) of + { !_segOinfo -> + (case (0) of + { !_segOn -> + (case (\a -> ruleTable _lhsIinfo ! a) of + { !_look -> + (case (_lhsIv) of + { !_segOv -> + (case ((seg_ _segOinfo _segOn _segOv)) of + { ( !_segIdescr,!_segIgroups,!_segInewedges,!_segInewvertices,!_segIv,!T_Segments_1 seg_1) -> + (case (_segIv + length _segInewvertices) of + { !_v -> + (case ([_segIv .. _v-1]) of + { !_firstvisitvertices -> + (case (zipWith (cv _look (-1)) _firstvisitvertices _segIgroups) of + { !_descr -> + (case (_segIdescr Seq.<> Seq.fromList _descr) of + { !_lhsOdescr -> + (case (_firstvisitvertices) of + { !_lhsOfirstvisitvertices -> + (case (zip _firstvisitvertices _segInewvertices) of + { !_newedges -> + (case (_segInewedges Seq.<> Seq.fromList _newedges) of + { !_lhsOnewedges -> + (case (_v) of + { !_lhsOv -> + (case ((sem_Interface_Interface_1 cons_ (T_Segments_1 seg_1) nt_)) of + { ( !sem_Interface_1) -> + ( _lhsOdescr,_lhsOfirstvisitvertices,_lhsOnewedges,_lhsOv,sem_Interface_1) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_Interface_Interface_1 :: ([ConstructorIdent]) -> + T_Segments_1 -> + NontermIdent -> + T_Interface_1 +sem_Interface_Interface_1 !cons_ !(T_Segments_1 seg_1) !nt_ = + (T_Interface_1 (\ (!_lhsIprev) + (!_lhsIvisitDescr) + (!_lhsIvssGraph) -> + (case (_lhsIvssGraph) of + { !_segOvssGraph -> + (case (_lhsIvisitDescr) of + { !_segOvisitDescr -> + (case (_lhsIprev) of + { !_segOprev -> + (case (cons_) of + { !_segOcons -> + (case ((seg_1 _segOcons _segOprev _segOvisitDescr _segOvssGraph)) of + { ( !_segIsegs,!T_Segments_2 seg_2) -> + (case (CInterface _segIsegs) of + { !_lhsOinter -> + (case (nt_) of + { !_lhsOnt -> + (case ((sem_Interface_Interface_2 _lhsIprev (T_Segments_2 seg_2) cons_)) of + { ( !sem_Interface_2) -> + ( _lhsOinter,_lhsOnt,sem_Interface_2) }) }) }) }) }) }) }) }))) +sem_Interface_Interface_2 :: ([Vertex]) -> + T_Segments_2 -> + ([ConstructorIdent]) -> + T_Interface_2 +sem_Interface_Interface_2 !_lhsIprev !(T_Segments_2 seg_2) !cons_ = + (T_Interface_2 (\ (!_lhsIallInters) + (!_lhsIddp) -> + (case (_lhsIddp) of + { !_segOddp -> + (case (_lhsIallInters) of + { !_segOallInters -> + (case (_lhsIprev) of + { !_segOfromLhs -> + (case (True) of + { !_segOisFirst -> + (case ((seg_2 _segOallInters _segOddp _segOfromLhs _segOisFirst)) of + { ( !_segIcvisits,!_segIedp,!_segIfirstInh,!_segIhdIntravisits,!_segIprev) -> + (case (_segIedp) of + { !_lhsOedp -> + (case (Map.fromList (zip cons_ (transpose _segIcvisits))) of + { !_lhsOvisits -> + ( _lhsOedp,_lhsOvisits) }) }) }) }) }) }) }))) +-- Interfaces -------------------------------------------------- +{- + visit 0: + inherited attribute: + info : Info + chained attribute: + v : Vertex + synthesized attributes: + descr : Seq (Vertex,ChildVisit) + firstvisitvertices : [Vertex] + newedges : Seq Edge + visit 1: + inherited attributes: + prev : [Vertex] + visitDescr : Map Vertex ChildVisit + vssGraph : Graph + synthesized attribute: + inters : CInterfaceMap + visit 2: + inherited attributes: + allInters : CInterfaceMap + ddp : Graph + synthesized attributes: + edp : Seq Edge + visits : CVisitsMap + alternatives: + alternative Cons: + child hd : Interface + child tl : Interfaces + alternative Nil: +-} +-- cata +sem_Interfaces :: Interfaces -> + T_Interfaces +sem_Interfaces !list = + (Prelude.foldr sem_Interfaces_Cons sem_Interfaces_Nil (Prelude.map sem_Interface list)) +-- semantic domain +newtype T_Interfaces = T_Interfaces (Info -> + Vertex -> + ( (Seq (Vertex,ChildVisit)),([Vertex]),(Seq Edge ),Vertex,T_Interfaces_1)) +newtype T_Interfaces_1 = T_Interfaces_1 (([Vertex]) -> + (Map Vertex ChildVisit) -> + Graph -> + ( CInterfaceMap,T_Interfaces_2)) +newtype T_Interfaces_2 = T_Interfaces_2 (CInterfaceMap -> + Graph -> + ( (Seq Edge),CVisitsMap)) +data Inh_Interfaces = Inh_Interfaces {allInters_Inh_Interfaces :: !(CInterfaceMap),ddp_Inh_Interfaces :: !(Graph),info_Inh_Interfaces :: !(Info),prev_Inh_Interfaces :: !([Vertex]),v_Inh_Interfaces :: !(Vertex),visitDescr_Inh_Interfaces :: !(Map Vertex ChildVisit),vssGraph_Inh_Interfaces :: !(Graph)} +data Syn_Interfaces = Syn_Interfaces {descr_Syn_Interfaces :: !(Seq (Vertex,ChildVisit)),edp_Syn_Interfaces :: !(Seq Edge),firstvisitvertices_Syn_Interfaces :: !([Vertex]),inters_Syn_Interfaces :: !(CInterfaceMap),newedges_Syn_Interfaces :: !(Seq Edge ),v_Syn_Interfaces :: !(Vertex),visits_Syn_Interfaces :: !(CVisitsMap)} +wrap_Interfaces !(T_Interfaces sem) !(Inh_Interfaces _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph) = + (let ( !_lhsOdescr,!_lhsOfirstvisitvertices,!_lhsOnewedges,!_lhsOv,!T_Interfaces_1 sem_1) = + (sem _lhsIinfo _lhsIv) + ( !_lhsOinters,!T_Interfaces_2 sem_2) = + (sem_1 _lhsIprev _lhsIvisitDescr _lhsIvssGraph) + ( !_lhsOedp,!_lhsOvisits) = + (sem_2 _lhsIallInters _lhsIddp) + in (Syn_Interfaces _lhsOdescr _lhsOedp _lhsOfirstvisitvertices _lhsOinters _lhsOnewedges _lhsOv _lhsOvisits)) +sem_Interfaces_Cons :: T_Interface -> + T_Interfaces -> + T_Interfaces +sem_Interfaces_Cons !(T_Interface hd_) !(T_Interfaces tl_) = + (T_Interfaces (\ (!_lhsIinfo) + (!_lhsIv) -> + (case (_lhsIv) of + { !_hdOv -> + (case (_lhsIinfo) of + { !_hdOinfo -> + (case ((hd_ _hdOinfo _hdOv)) of + { ( !_hdIdescr,!_hdIfirstvisitvertices,!_hdInewedges,!_hdIv,!T_Interface_1 hd_1) -> + (case (_hdIv) of + { !_tlOv -> + (case (_lhsIinfo) of + { !_tlOinfo -> + (case ((tl_ _tlOinfo _tlOv)) of + { ( !_tlIdescr,!_tlIfirstvisitvertices,!_tlInewedges,!_tlIv,!T_Interfaces_1 tl_1) -> + (case (_hdIdescr Seq.<> _tlIdescr) of + { !_lhsOdescr -> + (case (_hdIfirstvisitvertices ++ _tlIfirstvisitvertices) of + { !_lhsOfirstvisitvertices -> + (case (_hdInewedges Seq.<> _tlInewedges) of + { !_lhsOnewedges -> + (case (_tlIv) of + { !_lhsOv -> + (case ((sem_Interfaces_Cons_1 (T_Interfaces_1 tl_1) (T_Interface_1 hd_1))) of + { ( !sem_Interfaces_1) -> + ( _lhsOdescr,_lhsOfirstvisitvertices,_lhsOnewedges,_lhsOv,sem_Interfaces_1) }) }) }) }) }) }) }) }) }) }) }))) +sem_Interfaces_Cons_1 :: T_Interfaces_1 -> + T_Interface_1 -> + T_Interfaces_1 +sem_Interfaces_Cons_1 !(T_Interfaces_1 tl_1) !(T_Interface_1 hd_1) = + (T_Interfaces_1 (\ (!_lhsIprev) + (!_lhsIvisitDescr) + (!_lhsIvssGraph) -> + (case (_lhsIvssGraph) of + { !_tlOvssGraph -> + (case (_lhsIvisitDescr) of + { !_tlOvisitDescr -> + (case (_lhsIprev) of + { !_tlOprev -> + (case (_lhsIvssGraph) of + { !_hdOvssGraph -> + (case (_lhsIvisitDescr) of + { !_hdOvisitDescr -> + (case (_lhsIprev) of + { !_hdOprev -> + (case ((tl_1 _tlOprev _tlOvisitDescr _tlOvssGraph)) of + { ( !_tlIinters,!T_Interfaces_2 tl_2) -> + (case ((hd_1 _hdOprev _hdOvisitDescr _hdOvssGraph)) of + { ( !_hdIinter,!_hdInt,!T_Interface_2 hd_2) -> + (case (Map.insert _hdInt _hdIinter _tlIinters) of + { !_lhsOinters -> + (case ((sem_Interfaces_Cons_2 (T_Interfaces_2 tl_2) (T_Interface_2 hd_2) _hdInt)) of + { ( !sem_Interfaces_2) -> + ( _lhsOinters,sem_Interfaces_2) }) }) }) }) }) }) }) }) }) }))) +sem_Interfaces_Cons_2 :: T_Interfaces_2 -> + T_Interface_2 -> + NontermIdent -> + T_Interfaces_2 +sem_Interfaces_Cons_2 !(T_Interfaces_2 tl_2) !(T_Interface_2 hd_2) !_hdInt = + (T_Interfaces_2 (\ (!_lhsIallInters) + (!_lhsIddp) -> + (case (_lhsIddp) of + { !_tlOddp -> + (case (_lhsIallInters) of + { !_tlOallInters -> + (case ((tl_2 _tlOallInters _tlOddp)) of + { ( !_tlIedp,!_tlIvisits) -> + (case (_lhsIddp) of + { !_hdOddp -> + (case (_lhsIallInters) of + { !_hdOallInters -> + (case ((hd_2 _hdOallInters _hdOddp)) of + { ( !_hdIedp,!_hdIvisits) -> + (case (_hdIedp Seq.<> _tlIedp) of + { !_lhsOedp -> + (case (Map.insert _hdInt _hdIvisits _tlIvisits) of + { !_lhsOvisits -> + ( _lhsOedp,_lhsOvisits) }) }) }) }) }) }) }) }))) +sem_Interfaces_Nil :: T_Interfaces +sem_Interfaces_Nil = + (T_Interfaces (\ (!_lhsIinfo) + (!_lhsIv) -> + (case (Seq.empty) of + { !_lhsOdescr -> + (case ([]) of + { !_lhsOfirstvisitvertices -> + (case (Seq.empty) of + { !_lhsOnewedges -> + (case (_lhsIv) of + { !_lhsOv -> + (case ((sem_Interfaces_Nil_1 )) of + { ( !sem_Interfaces_1) -> + ( _lhsOdescr,_lhsOfirstvisitvertices,_lhsOnewedges,_lhsOv,sem_Interfaces_1) }) }) }) }) }))) +sem_Interfaces_Nil_1 :: T_Interfaces_1 +sem_Interfaces_Nil_1 = + (T_Interfaces_1 (\ (!_lhsIprev) + (!_lhsIvisitDescr) + (!_lhsIvssGraph) -> + (case (Map.empty) of + { !_lhsOinters -> + (case ((sem_Interfaces_Nil_2 )) of + { ( !sem_Interfaces_2) -> + ( _lhsOinters,sem_Interfaces_2) }) }))) +sem_Interfaces_Nil_2 :: T_Interfaces_2 +sem_Interfaces_Nil_2 = + (T_Interfaces_2 (\ (!_lhsIallInters) + (!_lhsIddp) -> + (case (Seq.empty) of + { !_lhsOedp -> + (case (Map.empty) of + { !_lhsOvisits -> + ( _lhsOedp,_lhsOvisits) }) }))) +-- Segment ----------------------------------------------------- +{- + visit 0: + inherited attribute: + info : Info + chained attribute: + v : Vertex + visit 1: + inherited attributes: + n : Int + nextNewvertices : [Vertex] + synthesized attributes: + descr : Seq (Vertex,ChildVisit) + groups : [([Vertex],[Vertex])] + newedges : Seq Edge + newvertices : [Vertex] + visit 2: + inherited attributes: + cons : [ConstructorIdent] + visitDescr : Map Vertex ChildVisit + vssGraph : Graph + chained attribute: + prev : [Vertex] + synthesized attribute: + seg : CSegment + visit 3: + inherited attributes: + allInters : CInterfaceMap + ddp : Graph + fromLhs : [Vertex] + isFirst : Bool + nextInh : [Vertex] + nextIntravisits : [IntraVisit] + synthesized attributes: + cvisits : [CVisit] + edp : Seq Edge + inh : [Vertex] + intravisits : [IntraVisit] + visitss : [VisitSS] + alternatives: + alternative Segment: + child inh : {[Vertex]} + child syn : {[Vertex]} + visit 0: + local look : {Vertex -> CRule} + local occurAs : {(CRule -> Bool) -> [Vertex] -> [Vertex]} + local groups : {[([Vertex],[Vertex])]} + local v : {Int} + visit 1: + local newvertices : _ + local visitedges : _ + local attredges : _ + intra v : {Int} + intra groups : {[([Vertex],[Vertex])]} + intra look : {Vertex -> CRule} + intra occurAs : {(CRule -> Bool) -> [Vertex] -> [Vertex]} + visit 2: + local synOccur : _ + local vss : _ + local visitss' : _ + local visitss : {[[Vertex]]} + local defined : _ + local _tup1 : {(Map Identifier Type,Map Identifier Type)} + local synmap : {Map Identifier Type} + local inhmap : {Map Identifier Type} + intra occurAs : {(CRule -> Bool) -> [Vertex] -> [Vertex]} + visit 3: + local computed : _ + local fromLhs : _ + local iv : _ + local intravisits : _ + intra visitss : {[[Vertex]]} + intra occurAs : {(CRule -> Bool) -> [Vertex] -> [Vertex]} + intra synmap : {Map Identifier Type} + intra inhmap : {Map Identifier Type} +-} +-- cata +sem_Segment :: Segment -> + T_Segment +sem_Segment !(Segment _inh _syn) = + (sem_Segment_Segment _inh _syn) +-- semantic domain +newtype T_Segment = T_Segment (Info -> + Vertex -> + ( Vertex,T_Segment_1)) +newtype T_Segment_1 = T_Segment_1 (Int -> + ([Vertex]) -> + ( (Seq (Vertex,ChildVisit)),([([Vertex],[Vertex])]),(Seq Edge ),([Vertex]),T_Segment_2)) +newtype T_Segment_2 = T_Segment_2 (([ConstructorIdent]) -> + ([Vertex]) -> + (Map Vertex ChildVisit) -> + Graph -> + ( ([Vertex]),CSegment,T_Segment_3)) +newtype T_Segment_3 = T_Segment_3 (CInterfaceMap -> + Graph -> + ([Vertex]) -> + Bool -> + ([Vertex]) -> + ([IntraVisit]) -> + ( ([CVisit]),(Seq Edge),([Vertex]),([IntraVisit]),([VisitSS]))) +data Inh_Segment = Inh_Segment {allInters_Inh_Segment :: !(CInterfaceMap),cons_Inh_Segment :: !([ConstructorIdent]),ddp_Inh_Segment :: !(Graph),fromLhs_Inh_Segment :: !([Vertex]),info_Inh_Segment :: !(Info),isFirst_Inh_Segment :: !(Bool),n_Inh_Segment :: !(Int),nextInh_Inh_Segment :: !([Vertex]),nextIntravisits_Inh_Segment :: !([IntraVisit]),nextNewvertices_Inh_Segment :: !([Vertex]),prev_Inh_Segment :: !([Vertex]),v_Inh_Segment :: !(Vertex),visitDescr_Inh_Segment :: !(Map Vertex ChildVisit),vssGraph_Inh_Segment :: !(Graph)} +data Syn_Segment = Syn_Segment {cvisits_Syn_Segment :: !([CVisit]),descr_Syn_Segment :: !(Seq (Vertex,ChildVisit)),edp_Syn_Segment :: !(Seq Edge),groups_Syn_Segment :: !([([Vertex],[Vertex])]),inh_Syn_Segment :: !([Vertex]),intravisits_Syn_Segment :: !([IntraVisit]),newedges_Syn_Segment :: !(Seq Edge ),newvertices_Syn_Segment :: !([Vertex]),prev_Syn_Segment :: !([Vertex]),seg_Syn_Segment :: !(CSegment),v_Syn_Segment :: !(Vertex),visitss_Syn_Segment :: !([VisitSS])} +wrap_Segment !(T_Segment sem) !(Inh_Segment _lhsIallInters _lhsIcons _lhsIddp _lhsIfromLhs _lhsIinfo _lhsIisFirst _lhsIn _lhsInextInh _lhsInextIntravisits _lhsInextNewvertices _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph) = + (let ( !_lhsOv,!T_Segment_1 sem_1) = + (sem _lhsIinfo _lhsIv) + ( !_lhsOdescr,!_lhsOgroups,!_lhsOnewedges,!_lhsOnewvertices,!T_Segment_2 sem_2) = + (sem_1 _lhsIn _lhsInextNewvertices) + ( !_lhsOprev,!_lhsOseg,!T_Segment_3 sem_3) = + (sem_2 _lhsIcons _lhsIprev _lhsIvisitDescr _lhsIvssGraph) + ( !_lhsOcvisits,!_lhsOedp,!_lhsOinh,!_lhsOintravisits,!_lhsOvisitss) = + (sem_3 _lhsIallInters _lhsIddp _lhsIfromLhs _lhsIisFirst _lhsInextInh _lhsInextIntravisits) + in (Syn_Segment _lhsOcvisits _lhsOdescr _lhsOedp _lhsOgroups _lhsOinh _lhsOintravisits _lhsOnewedges _lhsOnewvertices _lhsOprev _lhsOseg _lhsOv _lhsOvisitss)) +sem_Segment_Segment :: ([Vertex]) -> + ([Vertex]) -> + T_Segment +sem_Segment_Segment !inh_ !syn_ = + (T_Segment (\ (!_lhsIinfo) + (!_lhsIv) -> + (case (\a -> ruleTable _lhsIinfo ! a) of + { !_look -> + (case (\p us -> [ a | u <- us + , a <- tdsToTdp _lhsIinfo ! u + , p (_look a)]) of + { !_occurAs -> + (case (let group as = gather _lhsIinfo (_occurAs isRhs as) + in map (partition (isInh . _look)) (group (inh_ ++ syn_))) of + { !_groups -> + (case (_lhsIv + length _groups) of + { !_v -> + (case (_v) of + { !_lhsOv -> + (case ((sem_Segment_Segment_1 _v _lhsIv _groups _look syn_ _occurAs _lhsIinfo inh_)) of + { ( !sem_Segment_1) -> + ( _lhsOv,sem_Segment_1) }) }) }) }) }) }))) +sem_Segment_Segment_1 :: Int -> + Vertex -> + ([([Vertex],[Vertex])]) -> + (Vertex -> CRule) -> + ([Vertex]) -> + ((CRule -> Bool) -> [Vertex] -> [Vertex]) -> + Info -> + ([Vertex]) -> + T_Segment_1 +sem_Segment_Segment_1 !_v !_lhsIv !_groups !_look !syn_ !_occurAs !_lhsIinfo !inh_ = + (T_Segment_1 (\ (!_lhsIn) + (!_lhsInextNewvertices) -> + (case ([_lhsIv .. _v -1]) of + { !_newvertices -> + (case (Seq.fromList $ zipWith (cv _look _lhsIn) _newvertices _groups) of + { !_lhsOdescr -> + (case (_groups) of + { !_lhsOgroups -> + (case (zip _newvertices _lhsInextNewvertices) of + { !_visitedges -> + (case (concat (zipWith ed _newvertices _groups)) of + { !_attredges -> + (case (Seq.fromList _attredges Seq.<> Seq.fromList _visitedges) of + { !_lhsOnewedges -> + (case (_newvertices) of + { !_lhsOnewvertices -> + (case ((sem_Segment_Segment_2 syn_ _occurAs _lhsIinfo inh_)) of + { ( !sem_Segment_2) -> + ( _lhsOdescr,_lhsOgroups,_lhsOnewedges,_lhsOnewvertices,sem_Segment_2) }) }) }) }) }) }) }) }))) +sem_Segment_Segment_2 :: ([Vertex]) -> + ((CRule -> Bool) -> [Vertex] -> [Vertex]) -> + Info -> + ([Vertex]) -> + T_Segment_2 +sem_Segment_Segment_2 !syn_ !_occurAs !_lhsIinfo !inh_ = + (T_Segment_2 (\ (!_lhsIcons) + (!_lhsIprev) + (!_lhsIvisitDescr) + (!_lhsIvssGraph) -> + (case (gather _lhsIinfo (_occurAs isLhs syn_)) of + { !_synOccur -> + (case (let hasCode v | inRange (bounds (ruleTable _lhsIinfo)) v = getHasCode (ruleTable _lhsIinfo ! v) + | otherwise = True + in if null syn_ + then replicate (length _lhsIcons) [] + else map (filter hasCode . topSort' _lhsIvssGraph) _synOccur) of + { !_vss -> + (case (map (\\ _lhsIprev) _vss) of + { !_visitss' -> + (case (let rem :: [(Identifier,Identifier,Maybe Type)] -> [Vertex] -> [Vertex] + rem prev [] = [] + rem prev (v:vs) + | inRange (bounds table) v + = let cr = table ! v + addV = case findIndex cmp prev of + Just _ -> id + _ -> (v:) + cmp (fld,attr,tp) = getField cr == fld && getAttr cr == attr && sameNT (getType cr) tp + sameNT (Just (NT ntA _)) (Just (NT ntB _)) = ntA == ntB + sameNT _ _ = False + def = Map.elems (getDefines cr) + in addV (rem (def ++ prev) vs) + | otherwise = v:rem prev vs + table = ruleTable _lhsIinfo + in map (rem []) _visitss') of + { !_visitss -> + (case (let defines v = case Map.lookup v _lhsIvisitDescr of + Nothing -> [v] + Just (ChildVisit _ _ _ inh _) -> v:inh + in concatMap (concatMap defines) _visitss) of + { !_defined -> + (case (_lhsIprev ++ _defined) of + { !_lhsOprev -> + (case (let makemap = Map.fromList . map findType + findType v = getNtaNameType (attrTable _lhsIinfo ! v) + in (makemap inh_,makemap syn_)) of + { !__tup1 -> + (case (__tup1) of + { !(_,!_synmap) -> + (case (__tup1) of + { !(!_inhmap,_) -> + (case (if False then undefined _lhsIvssGraph _lhsIvisitDescr _lhsIprev else CSegment _inhmap _synmap) of + { !_lhsOseg -> + (case ((sem_Segment_Segment_3 _visitss _lhsIinfo _lhsIvisitDescr inh_ _occurAs _synmap _inhmap syn_)) of + { ( !sem_Segment_3) -> + ( _lhsOprev,_lhsOseg,sem_Segment_3) }) }) }) }) }) }) }) }) }) }) }))) +sem_Segment_Segment_3 :: ([[Vertex]]) -> + Info -> + (Map Vertex ChildVisit) -> + ([Vertex]) -> + ((CRule -> Bool) -> [Vertex] -> [Vertex]) -> + (Map Identifier Type) -> + (Map Identifier Type) -> + ([Vertex]) -> + T_Segment_3 +sem_Segment_Segment_3 !_visitss !_lhsIinfo !_lhsIvisitDescr !inh_ !_occurAs !_synmap !_inhmap !syn_ = + (T_Segment_3 (\ (!_lhsIallInters) + (!_lhsIddp) + (!_lhsIfromLhs) + (!_lhsIisFirst) + (!_lhsInextInh) + (!_lhsInextIntravisits) -> + (case (let computes v = case Map.lookup v _lhsIvisitDescr of + Nothing -> Map.keys (getDefines (ruleTable _lhsIinfo ! v)) + Just (ChildVisit _ _ _ _ syn) -> v:syn + in concatMap (concatMap computes) _visitss) of + { !_computed -> + (case (_occurAs isLhs inh_ ++ _lhsIfromLhs) of + { !_fromLhs -> + (case (\vs next -> + let needed = concatMap (_lhsIddp !) vs + in nub (needed ++ next) \\ (_fromLhs ++ _computed)) of + { !_iv -> + (case (zipWith _iv _visitss _lhsInextIntravisits) of + { !_intravisits -> + (case (let mkVisit vss intra = CVisit _inhmap _synmap (mkSequence vss) (mkSequence intra) True + mkSequence = map mkRule + mkRule v = case Map.lookup v _lhsIvisitDescr of + Nothing -> ruleTable _lhsIinfo ! v + Just (ChildVisit name nt n _ _) -> ccv name nt n _lhsIallInters + in zipWith mkVisit _visitss _intravisits) of + { !_lhsOcvisits -> + (case (Seq.fromList [(i,s) | i <- inh_, s <- syn_] + Seq.<> Seq.fromList [(s,i) | s <- syn_, i <- _lhsInextInh ]) of + { !_lhsOedp -> + (case (inh_) of + { !_lhsOinh -> + (case (_intravisits) of + { !_lhsOintravisits -> + (case (_visitss) of + { !_lhsOvisitss -> + ( _lhsOcvisits,_lhsOedp,_lhsOinh,_lhsOintravisits,_lhsOvisitss) }) }) }) }) }) }) }) }) }))) +-- Segments ---------------------------------------------------- +{- + visit 0: + inherited attributes: + info : Info + n : Int + chained attribute: + v : Vertex + synthesized attributes: + descr : Seq (Vertex,ChildVisit) + groups : [([Vertex],[Vertex])] + newedges : Seq Edge + newvertices : [Vertex] + visit 1: + inherited attributes: + cons : [ConstructorIdent] + prev : [Vertex] + visitDescr : Map Vertex ChildVisit + vssGraph : Graph + synthesized attribute: + segs : CSegments + visit 2: + inherited attributes: + allInters : CInterfaceMap + ddp : Graph + fromLhs : [Vertex] + isFirst : Bool + synthesized attributes: + cvisits : [[CVisit]] + edp : Seq Edge + firstInh : [Vertex] + hdIntravisits : [IntraVisit] + prev : [Vertex] + alternatives: + alternative Cons: + child hd : Segment + child tl : Segments + alternative Nil: +-} +-- cata +sem_Segments :: Segments -> + T_Segments +sem_Segments !list = + (Prelude.foldr sem_Segments_Cons sem_Segments_Nil (Prelude.map sem_Segment list)) +-- semantic domain +newtype T_Segments = T_Segments (Info -> + Int -> + Vertex -> + ( (Seq (Vertex,ChildVisit)),([([Vertex],[Vertex])]),(Seq Edge ),([Vertex]),Vertex,T_Segments_1)) +newtype T_Segments_1 = T_Segments_1 (([ConstructorIdent]) -> + ([Vertex]) -> + (Map Vertex ChildVisit) -> + Graph -> + ( CSegments,T_Segments_2)) +newtype T_Segments_2 = T_Segments_2 (CInterfaceMap -> + Graph -> + ([Vertex]) -> + Bool -> + ( ([[CVisit]]),(Seq Edge),([Vertex]),([IntraVisit]),([Vertex]))) +data Inh_Segments = Inh_Segments {allInters_Inh_Segments :: !(CInterfaceMap),cons_Inh_Segments :: !([ConstructorIdent]),ddp_Inh_Segments :: !(Graph),fromLhs_Inh_Segments :: !([Vertex]),info_Inh_Segments :: !(Info),isFirst_Inh_Segments :: !(Bool),n_Inh_Segments :: !(Int),prev_Inh_Segments :: !([Vertex]),v_Inh_Segments :: !(Vertex),visitDescr_Inh_Segments :: !(Map Vertex ChildVisit),vssGraph_Inh_Segments :: !(Graph)} +data Syn_Segments = Syn_Segments {cvisits_Syn_Segments :: !([[CVisit]]),descr_Syn_Segments :: !(Seq (Vertex,ChildVisit)),edp_Syn_Segments :: !(Seq Edge),firstInh_Syn_Segments :: !([Vertex]),groups_Syn_Segments :: !([([Vertex],[Vertex])]),hdIntravisits_Syn_Segments :: !([IntraVisit]),newedges_Syn_Segments :: !(Seq Edge ),newvertices_Syn_Segments :: !([Vertex]),prev_Syn_Segments :: !([Vertex]),segs_Syn_Segments :: !(CSegments),v_Syn_Segments :: !(Vertex)} +wrap_Segments !(T_Segments sem) !(Inh_Segments _lhsIallInters _lhsIcons _lhsIddp _lhsIfromLhs _lhsIinfo _lhsIisFirst _lhsIn _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph) = + (let ( !_lhsOdescr,!_lhsOgroups,!_lhsOnewedges,!_lhsOnewvertices,!_lhsOv,!T_Segments_1 sem_1) = + (sem _lhsIinfo _lhsIn _lhsIv) + ( !_lhsOsegs,!T_Segments_2 sem_2) = + (sem_1 _lhsIcons _lhsIprev _lhsIvisitDescr _lhsIvssGraph) + ( !_lhsOcvisits,!_lhsOedp,!_lhsOfirstInh,!_lhsOhdIntravisits,!_lhsOprev) = + (sem_2 _lhsIallInters _lhsIddp _lhsIfromLhs _lhsIisFirst) + in (Syn_Segments _lhsOcvisits _lhsOdescr _lhsOedp _lhsOfirstInh _lhsOgroups _lhsOhdIntravisits _lhsOnewedges _lhsOnewvertices _lhsOprev _lhsOsegs _lhsOv)) +sem_Segments_Cons :: T_Segment -> + T_Segments -> + T_Segments +sem_Segments_Cons !(T_Segment hd_) !(T_Segments tl_) = + (T_Segments (\ (!_lhsIinfo) + (!_lhsIn) + (!_lhsIv) -> + (case (_lhsIv) of + { !_hdOv -> + (case (_lhsIinfo) of + { !_hdOinfo -> + (case ((hd_ _hdOinfo _hdOv)) of + { ( !_hdIv,!T_Segment_1 hd_1) -> + (case (_hdIv) of + { !_tlOv -> + (case (_lhsIinfo) of + { !_tlOinfo -> + (case (_lhsIn) of + { !_hdOn -> + (case (_lhsIn + 1) of + { !_tlOn -> + (case ((tl_ _tlOinfo _tlOn _tlOv)) of + { ( !_tlIdescr,!_tlIgroups,!_tlInewedges,!_tlInewvertices,!_tlIv,!T_Segments_1 tl_1) -> + (case (_tlInewvertices) of + { !_hdOnextNewvertices -> + (case ((hd_1 _hdOn _hdOnextNewvertices)) of + { ( !_hdIdescr,!_hdIgroups,!_hdInewedges,!_hdInewvertices,!T_Segment_2 hd_2) -> + (case (_hdIdescr Seq.<> _tlIdescr) of + { !_lhsOdescr -> + (case (_hdIgroups) of + { !_lhsOgroups -> + (case (_hdInewedges Seq.<> _tlInewedges) of + { !_lhsOnewedges -> + (case (_hdInewvertices) of + { !_lhsOnewvertices -> + (case (_tlIv) of + { !_lhsOv -> + (case ((sem_Segments_Cons_1 (T_Segment_2 hd_2) (T_Segments_1 tl_1))) of + { ( !sem_Segments_1) -> + ( _lhsOdescr,_lhsOgroups,_lhsOnewedges,_lhsOnewvertices,_lhsOv,sem_Segments_1) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_Segments_Cons_1 :: T_Segment_2 -> + T_Segments_1 -> + T_Segments_1 +sem_Segments_Cons_1 !(T_Segment_2 hd_2) !(T_Segments_1 tl_1) = + (T_Segments_1 (\ (!_lhsIcons) + (!_lhsIprev) + (!_lhsIvisitDescr) + (!_lhsIvssGraph) -> + (case (_lhsIvssGraph) of + { !_tlOvssGraph -> + (case (_lhsIvisitDescr) of + { !_tlOvisitDescr -> + (case (_lhsIvssGraph) of + { !_hdOvssGraph -> + (case (_lhsIvisitDescr) of + { !_hdOvisitDescr -> + (case (_lhsIprev) of + { !_hdOprev -> + (case (_lhsIcons) of + { !_hdOcons -> + (case ((hd_2 _hdOcons _hdOprev _hdOvisitDescr _hdOvssGraph)) of + { ( !_hdIprev,!_hdIseg,!T_Segment_3 hd_3) -> + (case (_hdIprev) of + { !_tlOprev -> + (case (_lhsIcons) of + { !_tlOcons -> + (case ((tl_1 _tlOcons _tlOprev _tlOvisitDescr _tlOvssGraph)) of + { ( !_tlIsegs,!T_Segments_2 tl_2) -> + (case (_hdIseg : _tlIsegs) of + { !_lhsOsegs -> + (case ((sem_Segments_Cons_2 (T_Segments_2 tl_2) (T_Segment_3 hd_3))) of + { ( !sem_Segments_2) -> + ( _lhsOsegs,sem_Segments_2) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_Segments_Cons_2 :: T_Segments_2 -> + T_Segment_3 -> + T_Segments_2 +sem_Segments_Cons_2 !(T_Segments_2 tl_2) !(T_Segment_3 hd_3) = + (T_Segments_2 (\ (!_lhsIallInters) + (!_lhsIddp) + (!_lhsIfromLhs) + (!_lhsIisFirst) -> + (case (_lhsIddp) of + { !_tlOddp -> + (case (_lhsIallInters) of + { !_tlOallInters -> + (case (_lhsIddp) of + { !_hdOddp -> + (case (_lhsIallInters) of + { !_hdOallInters -> + (case ([]) of + { !_tlOfromLhs -> + (case (_lhsIfromLhs) of + { !_hdOfromLhs -> + (case (False) of + { !_tlOisFirst -> + (case ((tl_2 _tlOallInters _tlOddp _tlOfromLhs _tlOisFirst)) of + { ( !_tlIcvisits,!_tlIedp,!_tlIfirstInh,!_tlIhdIntravisits,!_tlIprev) -> + (case (_tlIhdIntravisits) of + { !_hdOnextIntravisits -> + (case (_lhsIisFirst) of + { !_hdOisFirst -> + (case (_tlIfirstInh) of + { !_hdOnextInh -> + (case ((hd_3 _hdOallInters _hdOddp _hdOfromLhs _hdOisFirst _hdOnextInh _hdOnextIntravisits)) of + { ( !_hdIcvisits,!_hdIedp,!_hdIinh,!_hdIintravisits,!_hdIvisitss) -> + (case (_hdIcvisits : _tlIcvisits) of + { !_lhsOcvisits -> + (case (_hdIedp Seq.<> _tlIedp) of + { !_lhsOedp -> + (case (_hdIinh) of + { !_lhsOfirstInh -> + (case (_hdIintravisits) of + { !_lhsOhdIntravisits -> + (case (_tlIprev) of + { !_lhsOprev -> + ( _lhsOcvisits,_lhsOedp,_lhsOfirstInh,_lhsOhdIntravisits,_lhsOprev) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_Segments_Nil :: T_Segments +sem_Segments_Nil = + (T_Segments (\ (!_lhsIinfo) + (!_lhsIn) + (!_lhsIv) -> + (case (Seq.empty) of + { !_lhsOdescr -> + (case ([]) of + { !_lhsOgroups -> + (case (Seq.empty) of + { !_lhsOnewedges -> + (case ([]) of + { !_lhsOnewvertices -> + (case (_lhsIv) of + { !_lhsOv -> + (case ((sem_Segments_Nil_1 )) of + { ( !sem_Segments_1) -> + ( _lhsOdescr,_lhsOgroups,_lhsOnewedges,_lhsOnewvertices,_lhsOv,sem_Segments_1) }) }) }) }) }) }))) +sem_Segments_Nil_1 :: T_Segments_1 +sem_Segments_Nil_1 = + (T_Segments_1 (\ (!_lhsIcons) + (!_lhsIprev) + (!_lhsIvisitDescr) + (!_lhsIvssGraph) -> + (case ([]) of + { !_lhsOsegs -> + (case ((sem_Segments_Nil_2 _lhsIprev)) of + { ( !sem_Segments_2) -> + ( _lhsOsegs,sem_Segments_2) }) }))) +sem_Segments_Nil_2 :: ([Vertex]) -> + T_Segments_2 +sem_Segments_Nil_2 !_lhsIprev = + (T_Segments_2 (\ (!_lhsIallInters) + (!_lhsIddp) + (!_lhsIfromLhs) + (!_lhsIisFirst) -> + (case ([]) of + { !_lhsOcvisits -> + (case (Seq.empty) of + { !_lhsOedp -> + (case ([]) of + { !_lhsOfirstInh -> + (case (repeat []) of + { !_lhsOhdIntravisits -> + (case (_lhsIprev) of + { !_lhsOprev -> + ( _lhsOcvisits,_lhsOedp,_lhsOfirstInh,_lhsOhdIntravisits,_lhsOprev) }) }) }) }) }))) diff --git a/src-derived/Order.hs b/src-derived/Order.hs --- a/src-derived/Order.hs +++ b/src-derived/Order.hs @@ -246,8 +246,8 @@ Bool -> Attributes -> ( ([(Identifier,Attributes,Attributes)]),(Map Identifier Attributes ),(Seq Error),((Identifier,Type,Bool)),([AltAttr]),(Seq CRule),(Seq (Identifier,Attributes)),(Seq (Identifier,NontermIdent)),([CRule]),([Identifier]))) -data Inh_Child = Inh_Child {allfields_Inh_Child :: [(Identifier,Type,Bool)],allnts_Inh_Child :: [Identifier],attrs_Inh_Child :: [(Identifier,Identifier)],con_Inh_Child :: Identifier,inh_Inh_Child :: Attributes,nt_Inh_Child :: Identifier,o_unbox_Inh_Child :: Bool,syn_Inh_Child :: Attributes} -data Syn_Child = Syn_Child {attributes_Syn_Child :: [(Identifier,Attributes,Attributes)],collectChildrenSyns_Syn_Child :: Map Identifier Attributes ,errors_Syn_Child :: Seq Error,field_Syn_Child :: (Identifier,Type,Bool),gathAltAttrs_Syn_Child :: [AltAttr],gathRules_Syn_Child :: Seq CRule,inhs_Syn_Child :: Seq (Identifier,Attributes),nts_Syn_Child :: Seq (Identifier,NontermIdent),singlevisits_Syn_Child :: [CRule],terminals_Syn_Child :: [Identifier]} +data Inh_Child = Inh_Child {allfields_Inh_Child :: !([(Identifier,Type,Bool)]),allnts_Inh_Child :: !([Identifier]),attrs_Inh_Child :: !([(Identifier,Identifier)]),con_Inh_Child :: !(Identifier),inh_Inh_Child :: !(Attributes),nt_Inh_Child :: !(Identifier),o_unbox_Inh_Child :: !(Bool),syn_Inh_Child :: !(Attributes)} +data Syn_Child = Syn_Child {attributes_Syn_Child :: !([(Identifier,Attributes,Attributes)]),collectChildrenSyns_Syn_Child :: !(Map Identifier Attributes ),errors_Syn_Child :: !(Seq Error),field_Syn_Child :: !((Identifier,Type,Bool)),gathAltAttrs_Syn_Child :: !([AltAttr]),gathRules_Syn_Child :: !(Seq CRule),inhs_Syn_Child :: !(Seq (Identifier,Attributes)),nts_Syn_Child :: !(Seq (Identifier,NontermIdent)),singlevisits_Syn_Child :: !([CRule]),terminals_Syn_Child :: !([Identifier])} wrap_Child (T_Child sem) (Inh_Child _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsInt _lhsIo_unbox _lhsIsyn) = (let ( _lhsOattributes,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfield,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals) = (sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsInt _lhsIo_unbox _lhsIsyn) @@ -277,50 +277,50 @@ _lhsOfield :: ((Identifier,Type,Bool)) _lhsOerrors :: (Seq Error) _lhsOgathRules :: (Seq CRule) - -- "Order.ag"(line 153, column 13) + -- "Order.ag"(line 156, column 13) _maptolocal = case tp_ of NT nt _ -> Map.null syn_ _ -> True - -- "Order.ag"(line 156, column 13) + -- "Order.ag"(line 159, column 13) _lhsOgathAltAttrs = if _maptolocal then [ AltAttr _LOC name_ True ] else [ AltAttr name_ syn True | syn <- Map.keys syn_ ] - -- "Order.ag"(line 171, column 13) + -- "Order.ag"(line 174, column 13) _lhsOnts = Seq.single (name_,getNtName tp_) - -- "Order.ag"(line 172, column 13) + -- "Order.ag"(line 175, column 13) _lhsOinhs = Seq.single (name_,inh_) - -- "Order.ag"(line 188, column 13) + -- "Order.ag"(line 191, column 13) _gathRules = if _maptolocal then Seq.single (cRuleTerminal name_ _lhsInt _lhsIcon tp_) else Seq.fromList [ cRuleRhsSyn syn _lhsInt _lhsIcon tp name_ (getNtName tp_) | (syn,tp) <- Map.assocs syn_] - -- "Order.ag"(line 313, column 12) + -- "Order.ag"(line 316, column 12) _lhsOcollectChildrenSyns = Map.singleton name_ syn_ - -- "Order.ag"(line 473, column 11) + -- "Order.ag"(line 476, column 11) _lhsOsinglevisits = if _maptolocal then [] else [CChildVisit name_ (getNtName tp_) 0 inh_ syn_ True] - -- "Order.ag"(line 494, column 11) + -- "Order.ag"(line 497, column 11) _lhsOterminals = if _maptolocal then [name_] else [] - -- "Order.ag"(line 523, column 11) + -- "Order.ag"(line 526, column 11) _lhsOattributes = [(name_, inh_, syn_)] - -- "Order.ag"(line 527, column 11) + -- "Order.ag"(line 530, column 11) _lhsOfield = (name_, tp_, higherOrder_) - -- use rule "Order.ag"(line 60, column 70) + -- use rule "Order.ag"(line 63, column 70) _lhsOerrors = Seq.empty - -- use rule "Order.ag"(line 182, column 23) + -- use rule "Order.ag"(line 185, column 23) _lhsOgathRules = _gathRules in ( _lhsOattributes,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfield,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals)))) @@ -368,8 +368,8 @@ Bool -> Attributes -> ( ([(Identifier,Attributes,Attributes)]),(Map Identifier Attributes ),(Seq Error),([(Identifier,Type,Bool)]),([AltAttr]),(Seq CRule),(Seq (Identifier,Attributes)),(Seq (Identifier,NontermIdent)),([CRule]),([Identifier]))) -data Inh_Children = Inh_Children {allfields_Inh_Children :: [(Identifier,Type,Bool)],allnts_Inh_Children :: [Identifier],attrs_Inh_Children :: [(Identifier,Identifier)],con_Inh_Children :: Identifier,inh_Inh_Children :: Attributes,nt_Inh_Children :: Identifier,o_unbox_Inh_Children :: Bool,syn_Inh_Children :: Attributes} -data Syn_Children = Syn_Children {attributes_Syn_Children :: [(Identifier,Attributes,Attributes)],collectChildrenSyns_Syn_Children :: Map Identifier Attributes ,errors_Syn_Children :: Seq Error,fields_Syn_Children :: [(Identifier,Type,Bool)],gathAltAttrs_Syn_Children :: [AltAttr],gathRules_Syn_Children :: Seq CRule,inhs_Syn_Children :: Seq (Identifier,Attributes),nts_Syn_Children :: Seq (Identifier,NontermIdent),singlevisits_Syn_Children :: [CRule],terminals_Syn_Children :: [Identifier]} +data Inh_Children = Inh_Children {allfields_Inh_Children :: !([(Identifier,Type,Bool)]),allnts_Inh_Children :: !([Identifier]),attrs_Inh_Children :: !([(Identifier,Identifier)]),con_Inh_Children :: !(Identifier),inh_Inh_Children :: !(Attributes),nt_Inh_Children :: !(Identifier),o_unbox_Inh_Children :: !(Bool),syn_Inh_Children :: !(Attributes)} +data Syn_Children = Syn_Children {attributes_Syn_Children :: !([(Identifier,Attributes,Attributes)]),collectChildrenSyns_Syn_Children :: !(Map Identifier Attributes ),errors_Syn_Children :: !(Seq Error),fields_Syn_Children :: !([(Identifier,Type,Bool)]),gathAltAttrs_Syn_Children :: !([AltAttr]),gathRules_Syn_Children :: !(Seq CRule),inhs_Syn_Children :: !(Seq (Identifier,Attributes)),nts_Syn_Children :: !(Seq (Identifier,NontermIdent)),singlevisits_Syn_Children :: !([CRule]),terminals_Syn_Children :: !([Identifier])} wrap_Children (T_Children sem) (Inh_Children _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsInt _lhsIo_unbox _lhsIsyn) = (let ( _lhsOattributes,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfields,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals) = (sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsInt _lhsIo_unbox _lhsIsyn) @@ -432,34 +432,34 @@ _tlInts :: (Seq (Identifier,NontermIdent)) _tlIsinglevisits :: ([CRule]) _tlIterminals :: ([Identifier]) - -- "Order.ag"(line 530, column 11) + -- "Order.ag"(line 533, column 11) _lhsOfields = _hdIfield : _tlIfields - -- use rule "Order.ag"(line 521, column 32) + -- use rule "Order.ag"(line 524, column 32) _lhsOattributes = _hdIattributes ++ _tlIattributes - -- use rule "Order.ag"(line 311, column 47) + -- use rule "Order.ag"(line 314, column 47) _lhsOcollectChildrenSyns = _hdIcollectChildrenSyns `Map.union` _tlIcollectChildrenSyns - -- use rule "Order.ag"(line 60, column 70) + -- use rule "Order.ag"(line 63, column 70) _lhsOerrors = _hdIerrors Seq.<> _tlIerrors - -- use rule "Order.ag"(line 146, column 68) + -- use rule "Order.ag"(line 149, column 68) _lhsOgathAltAttrs = _hdIgathAltAttrs ++ _tlIgathAltAttrs - -- use rule "Order.ag"(line 182, column 23) + -- use rule "Order.ag"(line 185, column 23) _lhsOgathRules = _hdIgathRules Seq.<> _tlIgathRules - -- use rule "Order.ag"(line 169, column 20) + -- use rule "Order.ag"(line 172, column 20) _lhsOinhs = _hdIinhs Seq.<> _tlIinhs - -- use rule "Order.ag"(line 168, column 19) + -- use rule "Order.ag"(line 171, column 19) _lhsOnts = _hdInts Seq.<> _tlInts - -- use rule "Order.ag"(line 471, column 40) + -- use rule "Order.ag"(line 474, column 40) _lhsOsinglevisits = _hdIsinglevisits ++ _tlIsinglevisits - -- use rule "Order.ag"(line 492, column 38) + -- use rule "Order.ag"(line 495, column 38) _lhsOterminals = _hdIterminals ++ _tlIterminals -- copy rule (down) @@ -535,34 +535,34 @@ _lhsOnts :: (Seq (Identifier,NontermIdent)) _lhsOsinglevisits :: ([CRule]) _lhsOterminals :: ([Identifier]) - -- "Order.ag"(line 531, column 11) + -- "Order.ag"(line 534, column 11) _lhsOfields = [] - -- use rule "Order.ag"(line 521, column 32) + -- use rule "Order.ag"(line 524, column 32) _lhsOattributes = [] - -- use rule "Order.ag"(line 311, column 47) + -- use rule "Order.ag"(line 314, column 47) _lhsOcollectChildrenSyns = Map.empty - -- use rule "Order.ag"(line 60, column 70) + -- use rule "Order.ag"(line 63, column 70) _lhsOerrors = Seq.empty - -- use rule "Order.ag"(line 146, column 68) + -- use rule "Order.ag"(line 149, column 68) _lhsOgathAltAttrs = [] - -- use rule "Order.ag"(line 182, column 23) + -- use rule "Order.ag"(line 185, column 23) _lhsOgathRules = Seq.empty - -- use rule "Order.ag"(line 169, column 20) + -- use rule "Order.ag"(line 172, column 20) _lhsOinhs = Seq.empty - -- use rule "Order.ag"(line 168, column 19) + -- use rule "Order.ag"(line 171, column 19) _lhsOnts = Seq.empty - -- use rule "Order.ag"(line 471, column 40) + -- use rule "Order.ag"(line 474, column 40) _lhsOsinglevisits = [] - -- use rule "Order.ag"(line 492, column 38) + -- use rule "Order.ag"(line 495, column 38) _lhsOterminals = [] in ( _lhsOattributes,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfields,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals)))) @@ -608,8 +608,8 @@ Identifier -> Identifier -> ( (Set (Identifier,Identifier)),Expression,(Seq Error),([String]),([(Identifier,Identifier)]),([Identifier]),([Identifier]))) -data Inh_Expression = Inh_Expression {allfields_Inh_Expression :: [(Identifier,Type,Bool)],allnts_Inh_Expression :: [Identifier],attrs_Inh_Expression :: [(Identifier,Identifier)],con_Inh_Expression :: Identifier,nt_Inh_Expression :: Identifier} -data Syn_Expression = Syn_Expression {allRhsVars_Syn_Expression :: Set (Identifier,Identifier),copy_Syn_Expression :: Expression,errors_Syn_Expression :: Seq Error,textLines_Syn_Expression :: [String],usedAttrs_Syn_Expression :: [(Identifier,Identifier)],usedFields_Syn_Expression :: [Identifier],usedLocals_Syn_Expression :: [Identifier]} +data Inh_Expression = Inh_Expression {allfields_Inh_Expression :: !([(Identifier,Type,Bool)]),allnts_Inh_Expression :: !([Identifier]),attrs_Inh_Expression :: !([(Identifier,Identifier)]),con_Inh_Expression :: !(Identifier),nt_Inh_Expression :: !(Identifier)} +data Syn_Expression = Syn_Expression {allRhsVars_Syn_Expression :: !(Set (Identifier,Identifier)),copy_Syn_Expression :: !(Expression),errors_Syn_Expression :: !(Seq Error),textLines_Syn_Expression :: !([String]),usedAttrs_Syn_Expression :: !([(Identifier,Identifier)]),usedFields_Syn_Expression :: !([Identifier]),usedLocals_Syn_Expression :: !([Identifier])} wrap_Expression (T_Expression sem) (Inh_Expression _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsInt) = (let ( _lhsOallRhsVars,_lhsOcopy,_lhsOerrors,_lhsOtextLines,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals) = (sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsInt) @@ -630,7 +630,7 @@ _lhsOusedAttrs :: ([(Identifier,Identifier)]) _lhsOusedFields :: ([Identifier]) _lhsOusedLocals :: ([Identifier]) - -- "Order.ag"(line 333, column 21) + -- "Order.ag"(line 336, column 21) __tup1 = let inherited = Inh_HsTokensRoot { attrs_Inh_HsTokensRoot = _lhsIattrs @@ -648,22 +648,22 @@ , usedLocals_Syn_HsTokensRoot = usedLocals , usedFields_Syn_HsTokensRoot = usedFields } -> (errors,textLines,usedAttrs,usedLocals,usedFields) - -- "Order.ag"(line 333, column 21) + -- "Order.ag"(line 336, column 21) (_errors,_,_,_,_) = __tup1 - -- "Order.ag"(line 333, column 21) + -- "Order.ag"(line 336, column 21) (_,_textLines,_,_,_) = __tup1 - -- "Order.ag"(line 333, column 21) + -- "Order.ag"(line 336, column 21) (_,_,_usedAttrs,_,_) = __tup1 - -- "Order.ag"(line 333, column 21) + -- "Order.ag"(line 336, column 21) (_,_,_,_usedLocals,_) = __tup1 - -- "Order.ag"(line 333, column 21) + -- "Order.ag"(line 336, column 21) (_,_,_,_,_usedFields) = __tup1 - -- "Order.ag"(line 351, column 17) + -- "Order.ag"(line 354, column 17) _lhsOallRhsVars = Set.fromList _usedAttrs `Set.union` @@ -711,6 +711,7 @@ child manualAttrOrderMap : {AttrOrderMap} child paramMap : {ParamMap} child contextMap : {ContextMap} + child uniqueMap : {UniqueMap} visit 0: local ruleTable : _ local attrTable : _ @@ -728,13 +729,13 @@ -- cata sem_Grammar :: Grammar -> T_Grammar -sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap) = - (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts) _pragmas _manualAttrOrderMap _paramMap _contextMap) +sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap) = + (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts) _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap) -- semantic domain newtype T_Grammar = T_Grammar (Options -> ( (Seq Error),CGrammar)) -data Inh_Grammar = Inh_Grammar {options_Inh_Grammar :: Options} -data Syn_Grammar = Syn_Grammar {errors_Syn_Grammar :: Seq Error,output_Syn_Grammar :: CGrammar} +data Inh_Grammar = Inh_Grammar {options_Inh_Grammar :: !(Options)} +data Syn_Grammar = Syn_Grammar {errors_Syn_Grammar :: !(Seq Error),output_Syn_Grammar :: !(CGrammar)} wrap_Grammar (T_Grammar sem) (Inh_Grammar _lhsIoptions) = (let ( _lhsOerrors,_lhsOoutput) = (sem _lhsIoptions) @@ -748,8 +749,9 @@ AttrOrderMap -> ParamMap -> ContextMap -> + UniqueMap -> T_Grammar -sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ = +sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ uniqueMap_ = (T_Grammar (\ _lhsIoptions -> (let _nontsOo_cata :: Bool _nontsOo_data :: Bool @@ -781,74 +783,74 @@ _nontsIntattrs :: (Seq (Vertex,NTAttr)) _nontsIrules :: (Seq (Vertex,CRule)) _nontsIvcount :: Int - -- "Order.ag"(line 99, column 17) + -- "Order.ag"(line 102, column 17) _nontsOo_cata = folds _lhsIoptions - -- "Order.ag"(line 99, column 17) + -- "Order.ag"(line 102, column 17) _nontsOo_data = dataTypes _lhsIoptions - -- "Order.ag"(line 99, column 17) + -- "Order.ag"(line 102, column 17) _nontsOo_sig = typeSigs _lhsIoptions - -- "Order.ag"(line 99, column 17) + -- "Order.ag"(line 102, column 17) _nontsOo_sem = semfuns _lhsIoptions - -- "Order.ag"(line 99, column 17) + -- "Order.ag"(line 102, column 17) _nontsOo_rename = rename _lhsIoptions - -- "Order.ag"(line 99, column 17) + -- "Order.ag"(line 102, column 17) _nontsOo_newtypes = newtypes _lhsIoptions - -- "Order.ag"(line 99, column 17) + -- "Order.ag"(line 102, column 17) _nontsOo_wantvisit = visit _lhsIoptions - -- "Order.ag"(line 99, column 17) + -- "Order.ag"(line 102, column 17) _nontsOo_dovisit = visit _lhsIoptions && null _cyclesErrors - -- "Order.ag"(line 99, column 17) + -- "Order.ag"(line 102, column 17) _nontsOo_unbox = unbox _lhsIoptions - -- "Order.ag"(line 99, column 17) + -- "Order.ag"(line 102, column 17) _nontsOo_case = cases _lhsIoptions - -- "Order.ag"(line 99, column 17) + -- "Order.ag"(line 102, column 17) _nontsOprefix = prefix _lhsIoptions - -- "Order.ag"(line 237, column 15) + -- "Order.ag"(line 240, column 15) _nontsOvcount = 0 - -- "Order.ag"(line 262, column 7) + -- "Order.ag"(line 265, column 7) _nontsOmanualAttrDepMap = manualAttrOrderMap_ - -- "Order.ag"(line 365, column 13) + -- "Order.ag"(line 368, column 13) _nontsOacount = 0 - -- "Order.ag"(line 403, column 13) + -- "Order.ag"(line 406, column 13) _ruleTable = Array.array (0,_nontsIvcount-1) (Seq.toList _nontsIrules) - -- "Order.ag"(line 404, column 13) + -- "Order.ag"(line 407, column 13) _attrTable = Array.array (0,_nontsIacount-1) (Seq.toList _nontsIntattrs) - -- "Order.ag"(line 405, column 13) + -- "Order.ag"(line 408, column 13) _attrVertex = Map.fromList (map swap (Seq.toList _nontsIntattrs)) - -- "Order.ag"(line 406, column 13) + -- "Order.ag"(line 409, column 13) _tdpToTds = [ (s, maybe (-1) (\v -> findWithErr1 "Grammar.tdpToTds" v _attrVertex) (ntattr cr)) | (s,cr) <- Seq.toList _nontsIrules] - -- "Order.ag"(line 408, column 13) + -- "Order.ag"(line 411, column 13) _tdsToTdp = let eq (_,v) (_,v') = v == v' conv ((s,v):svs) | v == -1 = Nothing | otherwise = Just (v,s:map fst svs) in mapMaybe conv (eqClasses eq _tdpToTds) - -- "Order.ag"(line 412, column 13) + -- "Order.ag"(line 415, column 13) _directDep = Seq.toList (_nontsIdirectDep Seq.<> _nontsIadditionalDep) - -- "Order.ag"(line 413, column 13) + -- "Order.ag"(line 416, column 13) _instDep = Seq.toList _nontsIinstDep - -- "Order.ag"(line 414, column 13) + -- "Order.ag"(line 417, column 13) _info = let def [] = -1 def (v:vs) = v @@ -860,7 +862,7 @@ , nonts = _nontsInonts , wraps = wrappers_ } - -- "Order.ag"(line 425, column 17) + -- "Order.ag"(line 428, column 17) __tup2 = case computeSequential _info _directDep _instDep of CycleFree cim cvm -> ( cim @@ -883,23 +885,23 @@ , error "No visit sub-sequences for AG with induced cycles" , inducedCycleErrs _attrTable _ruleTable cim errs ) - -- "Order.ag"(line 425, column 17) + -- "Order.ag"(line 428, column 17) (_cInterfaceMap,_,_) = __tup2 - -- "Order.ag"(line 425, column 17) + -- "Order.ag"(line 428, column 17) (_,_cVisitsMap,_) = __tup2 - -- "Order.ag"(line 425, column 17) + -- "Order.ag"(line 428, column 17) (_,_,_cyclesErrors) = __tup2 - -- "Order.ag"(line 447, column 13) + -- "Order.ag"(line 450, column 13) _lhsOerrors = (if withCycle _lhsIoptions then Seq.fromList _cyclesErrors else Seq.empty) Seq.<> _nontsIerrors - -- "Order.ag"(line 479, column 15) + -- "Order.ag"(line 482, column 15) _lhsOoutput = CGrammar typeSyns_ derivings_ wrappers_ _nontsIcNonterminals pragmas_ paramMap_ contextMap_ - -- "Order.ag"(line 506, column 13) + -- "Order.ag"(line 509, column 13) _nontsOallnts = map fst (_nontsInonts) -- copy rule (from local) @@ -978,8 +980,8 @@ String -> Int -> ( Int,(Seq Edge),(Seq (Int,Int,Int)),CNonterminal,(Seq Edge),(Seq Error),(Seq Edge),([(NontermIdent,[ConstructorIdent])]),(Seq (Vertex,NTAttr)),(Seq (Vertex,CRule)),Int)) -data Inh_Nonterminal = Inh_Nonterminal {acount_Inh_Nonterminal :: Int,allnts_Inh_Nonterminal :: [Identifier],cInterfaceMap_Inh_Nonterminal :: CInterfaceMap,cVisitsMap_Inh_Nonterminal :: CVisitsMap,manualAttrDepMap_Inh_Nonterminal :: AttrOrderMap,o_case_Inh_Nonterminal :: Bool,o_cata_Inh_Nonterminal :: Bool,o_data_Inh_Nonterminal :: Bool,o_dovisit_Inh_Nonterminal :: Bool,o_newtypes_Inh_Nonterminal :: Bool,o_rename_Inh_Nonterminal :: Bool,o_sem_Inh_Nonterminal :: Bool,o_sig_Inh_Nonterminal :: Bool,o_unbox_Inh_Nonterminal :: Bool,o_wantvisit_Inh_Nonterminal :: Bool,prefix_Inh_Nonterminal :: String,vcount_Inh_Nonterminal :: Int} -data Syn_Nonterminal = Syn_Nonterminal {acount_Syn_Nonterminal :: Int,additionalDep_Syn_Nonterminal :: Seq Edge,aranges_Syn_Nonterminal :: Seq (Int,Int,Int),cNonterminal_Syn_Nonterminal :: CNonterminal,directDep_Syn_Nonterminal :: Seq Edge,errors_Syn_Nonterminal :: Seq Error,instDep_Syn_Nonterminal :: Seq Edge,nonts_Syn_Nonterminal :: [(NontermIdent,[ConstructorIdent])],ntattrs_Syn_Nonterminal :: Seq (Vertex,NTAttr),rules_Syn_Nonterminal :: Seq (Vertex,CRule),vcount_Syn_Nonterminal :: Int} +data Inh_Nonterminal = Inh_Nonterminal {acount_Inh_Nonterminal :: !(Int),allnts_Inh_Nonterminal :: !([Identifier]),cInterfaceMap_Inh_Nonterminal :: !(CInterfaceMap),cVisitsMap_Inh_Nonterminal :: !(CVisitsMap),manualAttrDepMap_Inh_Nonterminal :: !(AttrOrderMap),o_case_Inh_Nonterminal :: !(Bool),o_cata_Inh_Nonterminal :: !(Bool),o_data_Inh_Nonterminal :: !(Bool),o_dovisit_Inh_Nonterminal :: !(Bool),o_newtypes_Inh_Nonterminal :: !(Bool),o_rename_Inh_Nonterminal :: !(Bool),o_sem_Inh_Nonterminal :: !(Bool),o_sig_Inh_Nonterminal :: !(Bool),o_unbox_Inh_Nonterminal :: !(Bool),o_wantvisit_Inh_Nonterminal :: !(Bool),prefix_Inh_Nonterminal :: !(String),vcount_Inh_Nonterminal :: !(Int)} +data Syn_Nonterminal = Syn_Nonterminal {acount_Syn_Nonterminal :: !(Int),additionalDep_Syn_Nonterminal :: !(Seq Edge),aranges_Syn_Nonterminal :: !(Seq (Int,Int,Int)),cNonterminal_Syn_Nonterminal :: !(CNonterminal),directDep_Syn_Nonterminal :: !(Seq Edge),errors_Syn_Nonterminal :: !(Seq Error),instDep_Syn_Nonterminal :: !(Seq Edge),nonts_Syn_Nonterminal :: !([(NontermIdent,[ConstructorIdent])]),ntattrs_Syn_Nonterminal :: !(Seq (Vertex,NTAttr)),rules_Syn_Nonterminal :: !(Seq (Vertex,CRule)),vcount_Syn_Nonterminal :: !(Int)} wrap_Nonterminal (T_Nonterminal sem) (Inh_Nonterminal _lhsIacount _lhsIallnts _lhsIcInterfaceMap _lhsIcVisitsMap _lhsImanualAttrDepMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIvcount) = (let ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOcNonterminal,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOnonts,_lhsOntattrs,_lhsOrules,_lhsOvcount) = (sem _lhsIacount _lhsIallnts _lhsIcInterfaceMap _lhsIcVisitsMap _lhsImanualAttrDepMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIvcount) @@ -1044,55 +1046,55 @@ _prodsIinstDep :: (Seq Edge) _prodsIrules :: (Seq (Vertex,CRule)) _prodsIvcount :: Int - -- "Order.ag"(line 73, column 17) + -- "Order.ag"(line 76, column 17) _prodsOnt = nt_ - -- "Order.ag"(line 76, column 17) + -- "Order.ag"(line 79, column 17) _prodsOinh = inh_ - -- "Order.ag"(line 77, column 17) + -- "Order.ag"(line 80, column 17) _prodsOsyn = syn_ - -- "Order.ag"(line 368, column 17) + -- "Order.ag"(line 371, column 17) _ntattrs = [ NTAInh nt_ inh tp | (inh,tp) <- Map.assocs inh_ ] ++ [NTASyn nt_ syn tp | (syn,tp) <- Map.assocs syn_ ] - -- "Order.ag"(line 370, column 17) + -- "Order.ag"(line 373, column 17) _lhsOntattrs = Seq.fromList (zip [_lhsIacount ..] _ntattrs) - -- "Order.ag"(line 371, column 17) + -- "Order.ag"(line 374, column 17) _lhsOacount = _lhsIacount + Map.size inh_ + Map.size syn_ - -- "Order.ag"(line 372, column 17) + -- "Order.ag"(line 375, column 17) _lhsOaranges = Seq.single (_lhsIacount ,_lhsIacount + Map.size inh_ ,_lhsIacount + Map.size syn_ + Map.size inh_ - 1) - -- "Order.ag"(line 381, column 19) + -- "Order.ag"(line 384, column 19) _lhsOnonts = [(nt_,_prodsIcons)] - -- "Order.ag"(line 456, column 19) + -- "Order.ag"(line 459, column 19) _cInter = if _lhsIo_dovisit then findWithErr1 "Nonterminal.cInter" nt_ _lhsIcInterfaceMap else CInterface [CSegment inh_ syn_] - -- "Order.ag"(line 484, column 19) + -- "Order.ag"(line 487, column 19) _lhsOcNonterminal = CNonterminal nt_ params_ inh_ syn_ _prodsIcProductions _cInter - -- use rule "Order.ag"(line 259, column 71) + -- use rule "Order.ag"(line 262, column 71) _lhsOadditionalDep = _prodsIadditionalDep - -- use rule "Order.ag"(line 245, column 33) + -- use rule "Order.ag"(line 248, column 33) _lhsOdirectDep = _prodsIdirectDep - -- use rule "Order.ag"(line 60, column 70) + -- use rule "Order.ag"(line 63, column 70) _lhsOerrors = _prodsIerrors - -- use rule "Order.ag"(line 292, column 31) + -- use rule "Order.ag"(line 295, column 31) _lhsOinstDep = _prodsIinstDep - -- use rule "Order.ag"(line 235, column 18) + -- use rule "Order.ag"(line 238, column 18) _lhsOrules = _prodsIrules -- copy rule (up) @@ -1205,8 +1207,8 @@ String -> Int -> ( Int,(Seq Edge),(Seq (Int,Int,Int)),CNonterminals,(Seq Edge),(Seq Error),(Seq Edge),([(NontermIdent,[ConstructorIdent])]),(Seq (Vertex,NTAttr)),(Seq (Vertex,CRule)),Int)) -data Inh_Nonterminals = Inh_Nonterminals {acount_Inh_Nonterminals :: Int,allnts_Inh_Nonterminals :: [Identifier],cInterfaceMap_Inh_Nonterminals :: CInterfaceMap,cVisitsMap_Inh_Nonterminals :: CVisitsMap,manualAttrDepMap_Inh_Nonterminals :: AttrOrderMap,o_case_Inh_Nonterminals :: Bool,o_cata_Inh_Nonterminals :: Bool,o_data_Inh_Nonterminals :: Bool,o_dovisit_Inh_Nonterminals :: Bool,o_newtypes_Inh_Nonterminals :: Bool,o_rename_Inh_Nonterminals :: Bool,o_sem_Inh_Nonterminals :: Bool,o_sig_Inh_Nonterminals :: Bool,o_unbox_Inh_Nonterminals :: Bool,o_wantvisit_Inh_Nonterminals :: Bool,prefix_Inh_Nonterminals :: String,vcount_Inh_Nonterminals :: Int} -data Syn_Nonterminals = Syn_Nonterminals {acount_Syn_Nonterminals :: Int,additionalDep_Syn_Nonterminals :: Seq Edge,aranges_Syn_Nonterminals :: Seq (Int,Int,Int),cNonterminals_Syn_Nonterminals :: CNonterminals,directDep_Syn_Nonterminals :: Seq Edge,errors_Syn_Nonterminals :: Seq Error,instDep_Syn_Nonterminals :: Seq Edge,nonts_Syn_Nonterminals :: [(NontermIdent,[ConstructorIdent])],ntattrs_Syn_Nonterminals :: Seq (Vertex,NTAttr),rules_Syn_Nonterminals :: Seq (Vertex,CRule),vcount_Syn_Nonterminals :: Int} +data Inh_Nonterminals = Inh_Nonterminals {acount_Inh_Nonterminals :: !(Int),allnts_Inh_Nonterminals :: !([Identifier]),cInterfaceMap_Inh_Nonterminals :: !(CInterfaceMap),cVisitsMap_Inh_Nonterminals :: !(CVisitsMap),manualAttrDepMap_Inh_Nonterminals :: !(AttrOrderMap),o_case_Inh_Nonterminals :: !(Bool),o_cata_Inh_Nonterminals :: !(Bool),o_data_Inh_Nonterminals :: !(Bool),o_dovisit_Inh_Nonterminals :: !(Bool),o_newtypes_Inh_Nonterminals :: !(Bool),o_rename_Inh_Nonterminals :: !(Bool),o_sem_Inh_Nonterminals :: !(Bool),o_sig_Inh_Nonterminals :: !(Bool),o_unbox_Inh_Nonterminals :: !(Bool),o_wantvisit_Inh_Nonterminals :: !(Bool),prefix_Inh_Nonterminals :: !(String),vcount_Inh_Nonterminals :: !(Int)} +data Syn_Nonterminals = Syn_Nonterminals {acount_Syn_Nonterminals :: !(Int),additionalDep_Syn_Nonterminals :: !(Seq Edge),aranges_Syn_Nonterminals :: !(Seq (Int,Int,Int)),cNonterminals_Syn_Nonterminals :: !(CNonterminals),directDep_Syn_Nonterminals :: !(Seq Edge),errors_Syn_Nonterminals :: !(Seq Error),instDep_Syn_Nonterminals :: !(Seq Edge),nonts_Syn_Nonterminals :: !([(NontermIdent,[ConstructorIdent])]),ntattrs_Syn_Nonterminals :: !(Seq (Vertex,NTAttr)),rules_Syn_Nonterminals :: !(Seq (Vertex,CRule)),vcount_Syn_Nonterminals :: !(Int)} wrap_Nonterminals (T_Nonterminals sem) (Inh_Nonterminals _lhsIacount _lhsIallnts _lhsIcInterfaceMap _lhsIcVisitsMap _lhsImanualAttrDepMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIvcount) = (let ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOcNonterminals,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOnonts,_lhsOntattrs,_lhsOrules,_lhsOvcount) = (sem _lhsIacount _lhsIallnts _lhsIcInterfaceMap _lhsIcVisitsMap _lhsImanualAttrDepMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIvcount) @@ -1299,31 +1301,31 @@ _tlIntattrs :: (Seq (Vertex,NTAttr)) _tlIrules :: (Seq (Vertex,CRule)) _tlIvcount :: Int - -- "Order.ag"(line 481, column 12) + -- "Order.ag"(line 484, column 12) _lhsOcNonterminals = _hdIcNonterminal : _tlIcNonterminals - -- use rule "Order.ag"(line 259, column 71) + -- use rule "Order.ag"(line 262, column 71) _lhsOadditionalDep = _hdIadditionalDep Seq.<> _tlIadditionalDep - -- use rule "Order.ag"(line 362, column 36) + -- use rule "Order.ag"(line 365, column 36) _lhsOaranges = _hdIaranges Seq.<> _tlIaranges - -- use rule "Order.ag"(line 245, column 33) + -- use rule "Order.ag"(line 248, column 33) _lhsOdirectDep = _hdIdirectDep Seq.<> _tlIdirectDep - -- use rule "Order.ag"(line 60, column 70) + -- use rule "Order.ag"(line 63, column 70) _lhsOerrors = _hdIerrors Seq.<> _tlIerrors - -- use rule "Order.ag"(line 292, column 31) + -- use rule "Order.ag"(line 295, column 31) _lhsOinstDep = _hdIinstDep Seq.<> _tlIinstDep - -- use rule "Order.ag"(line 379, column 43) + -- use rule "Order.ag"(line 382, column 43) _lhsOnonts = _hdInonts ++ _tlInonts - -- use rule "Order.ag"(line 361, column 35) + -- use rule "Order.ag"(line 364, column 35) _lhsOntattrs = _hdIntattrs Seq.<> _tlIntattrs - -- use rule "Order.ag"(line 235, column 18) + -- use rule "Order.ag"(line 238, column 18) _lhsOrules = _hdIrules Seq.<> _tlIrules -- copy rule (up) @@ -1469,31 +1471,31 @@ _lhsOrules :: (Seq (Vertex,CRule)) _lhsOacount :: Int _lhsOvcount :: Int - -- "Order.ag"(line 482, column 12) + -- "Order.ag"(line 485, column 12) _lhsOcNonterminals = [] - -- use rule "Order.ag"(line 259, column 71) + -- use rule "Order.ag"(line 262, column 71) _lhsOadditionalDep = Seq.empty - -- use rule "Order.ag"(line 362, column 36) + -- use rule "Order.ag"(line 365, column 36) _lhsOaranges = Seq.empty - -- use rule "Order.ag"(line 245, column 33) + -- use rule "Order.ag"(line 248, column 33) _lhsOdirectDep = Seq.empty - -- use rule "Order.ag"(line 60, column 70) + -- use rule "Order.ag"(line 63, column 70) _lhsOerrors = Seq.empty - -- use rule "Order.ag"(line 292, column 31) + -- use rule "Order.ag"(line 295, column 31) _lhsOinstDep = Seq.empty - -- use rule "Order.ag"(line 379, column 43) + -- use rule "Order.ag"(line 382, column 43) _lhsOnonts = [] - -- use rule "Order.ag"(line 361, column 35) + -- use rule "Order.ag"(line 364, column 35) _lhsOntattrs = Seq.empty - -- use rule "Order.ag"(line 235, column 18) + -- use rule "Order.ag"(line 238, column 18) _lhsOrules = Seq.empty -- copy rule (chain) @@ -1568,8 +1570,8 @@ Identifier -> Attributes -> ( Pattern,(Seq Error),([AltAttr]),([Identifier]),([Identifier]),([(Identifier,Identifier,Bool,Patterns)]))) -data Inh_Pattern = Inh_Pattern {allTypeSigs_Inh_Pattern :: Map Identifier Type,altAttrs_Inh_Pattern :: Map AltAttr Vertex,con_Inh_Pattern :: Identifier,inh_Inh_Pattern :: Attributes,nt_Inh_Pattern :: Identifier,syn_Inh_Pattern :: Attributes} -data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern,errors_Syn_Pattern :: Seq Error,gathAltAttrs_Syn_Pattern :: [AltAttr],instVars_Syn_Pattern :: [Identifier],locVars_Syn_Pattern :: [Identifier],patternAttrs_Syn_Pattern :: [(Identifier,Identifier,Bool,Patterns)]} +data Inh_Pattern = Inh_Pattern {allTypeSigs_Inh_Pattern :: !(Map Identifier Type),altAttrs_Inh_Pattern :: !(Map AltAttr Vertex),con_Inh_Pattern :: !(Identifier),inh_Inh_Pattern :: !(Attributes),nt_Inh_Pattern :: !(Identifier),syn_Inh_Pattern :: !(Attributes)} +data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: !(Pattern),errors_Syn_Pattern :: !(Seq Error),gathAltAttrs_Syn_Pattern :: !([AltAttr]),instVars_Syn_Pattern :: !([Identifier]),locVars_Syn_Pattern :: !([Identifier]),patternAttrs_Syn_Pattern :: !([(Identifier,Identifier,Bool,Patterns)])} wrap_Pattern (T_Pattern sem) (Inh_Pattern _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn) = (let ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs) = (sem _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn) @@ -1616,23 +1618,23 @@ _partsIinstVars :: ([Identifier]) _partsIlocVars :: ([Identifier]) _partsIpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)]) - -- "Order.ag"(line 160, column 12) + -- "Order.ag"(line 163, column 12) _lhsOgathAltAttrs = [AltAttr field_ attr_ (field_ == _LOC || field_ == _INST)] - -- "Order.ag"(line 228, column 12) + -- "Order.ag"(line 231, column 12) _lhsOpatternAttrs = [(field_,attr_,(field_ == _LOC || field_ == _INST),_partsIcopy)] - -- "Order.ag"(line 536, column 14) + -- "Order.ag"(line 539, column 14) _lhsOlocVars = if field_ == _LOC then [attr_] else [] - -- "Order.ag"(line 539, column 14) + -- "Order.ag"(line 542, column 14) _lhsOinstVars = if field_ == _INST then [attr_] else [] - -- use rule "Order.ag"(line 60, column 70) + -- use rule "Order.ag"(line 63, column 70) _lhsOerrors = _patIerrors Seq.<> _partsIerrors -- self rule @@ -1710,19 +1712,19 @@ _patsIinstVars :: ([Identifier]) _patsIlocVars :: ([Identifier]) _patsIpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)]) - -- use rule "Order.ag"(line 60, column 70) + -- use rule "Order.ag"(line 63, column 70) _lhsOerrors = _patsIerrors - -- use rule "Order.ag"(line 146, column 68) + -- use rule "Order.ag"(line 149, column 68) _lhsOgathAltAttrs = _patsIgathAltAttrs - -- use rule "Order.ag"(line 533, column 86) + -- use rule "Order.ag"(line 536, column 86) _lhsOinstVars = _patsIinstVars - -- use rule "Order.ag"(line 533, column 48) + -- use rule "Order.ag"(line 536, column 48) _lhsOlocVars = _patsIlocVars - -- use rule "Order.ag"(line 225, column 42) + -- use rule "Order.ag"(line 228, column 42) _lhsOpatternAttrs = _patsIpatternAttrs -- self rule @@ -1779,19 +1781,19 @@ _patIinstVars :: ([Identifier]) _patIlocVars :: ([Identifier]) _patIpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)]) - -- use rule "Order.ag"(line 60, column 70) + -- use rule "Order.ag"(line 63, column 70) _lhsOerrors = _patIerrors - -- use rule "Order.ag"(line 146, column 68) + -- use rule "Order.ag"(line 149, column 68) _lhsOgathAltAttrs = _patIgathAltAttrs - -- use rule "Order.ag"(line 533, column 86) + -- use rule "Order.ag"(line 536, column 86) _lhsOinstVars = _patIinstVars - -- use rule "Order.ag"(line 533, column 48) + -- use rule "Order.ag"(line 536, column 48) _lhsOlocVars = _patIlocVars - -- use rule "Order.ag"(line 225, column 42) + -- use rule "Order.ag"(line 228, column 42) _lhsOpatternAttrs = _patIpatternAttrs -- self rule @@ -1849,19 +1851,19 @@ _patsIinstVars :: ([Identifier]) _patsIlocVars :: ([Identifier]) _patsIpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)]) - -- use rule "Order.ag"(line 60, column 70) + -- use rule "Order.ag"(line 63, column 70) _lhsOerrors = _patsIerrors - -- use rule "Order.ag"(line 146, column 68) + -- use rule "Order.ag"(line 149, column 68) _lhsOgathAltAttrs = _patsIgathAltAttrs - -- use rule "Order.ag"(line 533, column 86) + -- use rule "Order.ag"(line 536, column 86) _lhsOinstVars = _patsIinstVars - -- use rule "Order.ag"(line 533, column 48) + -- use rule "Order.ag"(line 536, column 48) _lhsOlocVars = _patsIlocVars - -- use rule "Order.ag"(line 225, column 42) + -- use rule "Order.ag"(line 228, column 42) _lhsOpatternAttrs = _patsIpatternAttrs -- self rule @@ -1906,19 +1908,19 @@ _lhsOlocVars :: ([Identifier]) _lhsOpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)]) _lhsOcopy :: Pattern - -- use rule "Order.ag"(line 60, column 70) + -- use rule "Order.ag"(line 63, column 70) _lhsOerrors = Seq.empty - -- use rule "Order.ag"(line 146, column 68) + -- use rule "Order.ag"(line 149, column 68) _lhsOgathAltAttrs = [] - -- use rule "Order.ag"(line 533, column 86) + -- use rule "Order.ag"(line 536, column 86) _lhsOinstVars = [] - -- use rule "Order.ag"(line 533, column 48) + -- use rule "Order.ag"(line 536, column 48) _lhsOlocVars = [] - -- use rule "Order.ag"(line 225, column 42) + -- use rule "Order.ag"(line 228, column 42) _lhsOpatternAttrs = [] -- self rule @@ -1968,8 +1970,8 @@ Identifier -> Attributes -> ( Patterns,(Seq Error),([AltAttr]),([Identifier]),([Identifier]),([(Identifier,Identifier,Bool,Patterns)]))) -data Inh_Patterns = Inh_Patterns {allTypeSigs_Inh_Patterns :: Map Identifier Type,altAttrs_Inh_Patterns :: Map AltAttr Vertex,con_Inh_Patterns :: Identifier,inh_Inh_Patterns :: Attributes,nt_Inh_Patterns :: Identifier,syn_Inh_Patterns :: Attributes} -data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns,errors_Syn_Patterns :: Seq Error,gathAltAttrs_Syn_Patterns :: [AltAttr],instVars_Syn_Patterns :: [Identifier],locVars_Syn_Patterns :: [Identifier],patternAttrs_Syn_Patterns :: [(Identifier,Identifier,Bool,Patterns)]} +data Inh_Patterns = Inh_Patterns {allTypeSigs_Inh_Patterns :: !(Map Identifier Type),altAttrs_Inh_Patterns :: !(Map AltAttr Vertex),con_Inh_Patterns :: !(Identifier),inh_Inh_Patterns :: !(Attributes),nt_Inh_Patterns :: !(Identifier),syn_Inh_Patterns :: !(Attributes)} +data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: !(Patterns),errors_Syn_Patterns :: !(Seq Error),gathAltAttrs_Syn_Patterns :: !([AltAttr]),instVars_Syn_Patterns :: !([Identifier]),locVars_Syn_Patterns :: !([Identifier]),patternAttrs_Syn_Patterns :: !([(Identifier,Identifier,Bool,Patterns)])} wrap_Patterns (T_Patterns sem) (Inh_Patterns _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn) = (let ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs) = (sem _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn) @@ -2014,19 +2016,19 @@ _tlIinstVars :: ([Identifier]) _tlIlocVars :: ([Identifier]) _tlIpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)]) - -- use rule "Order.ag"(line 60, column 70) + -- use rule "Order.ag"(line 63, column 70) _lhsOerrors = _hdIerrors Seq.<> _tlIerrors - -- use rule "Order.ag"(line 146, column 68) + -- use rule "Order.ag"(line 149, column 68) _lhsOgathAltAttrs = _hdIgathAltAttrs ++ _tlIgathAltAttrs - -- use rule "Order.ag"(line 533, column 86) + -- use rule "Order.ag"(line 536, column 86) _lhsOinstVars = _hdIinstVars ++ _tlIinstVars - -- use rule "Order.ag"(line 533, column 48) + -- use rule "Order.ag"(line 536, column 48) _lhsOlocVars = _hdIlocVars ++ _tlIlocVars - -- use rule "Order.ag"(line 225, column 42) + -- use rule "Order.ag"(line 228, column 42) _lhsOpatternAttrs = _hdIpatternAttrs ++ _tlIpatternAttrs -- self rule @@ -2090,19 +2092,19 @@ _lhsOlocVars :: ([Identifier]) _lhsOpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)]) _lhsOcopy :: Patterns - -- use rule "Order.ag"(line 60, column 70) + -- use rule "Order.ag"(line 63, column 70) _lhsOerrors = Seq.empty - -- use rule "Order.ag"(line 146, column 68) + -- use rule "Order.ag"(line 149, column 68) _lhsOgathAltAttrs = [] - -- use rule "Order.ag"(line 533, column 86) + -- use rule "Order.ag"(line 536, column 86) _lhsOinstVars = [] - -- use rule "Order.ag"(line 533, column 48) + -- use rule "Order.ag"(line 536, column 48) _lhsOlocVars = [] - -- use rule "Order.ag"(line 225, column 42) + -- use rule "Order.ag"(line 228, column 42) _lhsOpatternAttrs = [] -- self rule @@ -2182,8 +2184,8 @@ Attributes -> Int -> ( (Seq Edge),CProduction,([ConstructorIdent]),(Seq Edge),(Seq Error),(Seq Edge),(Seq (Vertex,CRule)),Int)) -data Inh_Production = Inh_Production {allnts_Inh_Production :: [Identifier],cVisitsMap_Inh_Production :: CVisitsMap,inh_Inh_Production :: Attributes,manualAttrDepMap_Inh_Production :: AttrOrderMap,nt_Inh_Production :: Identifier,o_case_Inh_Production :: Bool,o_cata_Inh_Production :: Bool,o_dovisit_Inh_Production :: Bool,o_newtypes_Inh_Production :: Bool,o_rename_Inh_Production :: Bool,o_sem_Inh_Production :: Bool,o_sig_Inh_Production :: Bool,o_unbox_Inh_Production :: Bool,o_wantvisit_Inh_Production :: Bool,prefix_Inh_Production :: String,syn_Inh_Production :: Attributes,vcount_Inh_Production :: Int} -data Syn_Production = Syn_Production {additionalDep_Syn_Production :: Seq Edge,cProduction_Syn_Production :: CProduction,cons_Syn_Production :: [ConstructorIdent],directDep_Syn_Production :: Seq Edge,errors_Syn_Production :: Seq Error,instDep_Syn_Production :: Seq Edge,rules_Syn_Production :: Seq (Vertex,CRule),vcount_Syn_Production :: Int} +data Inh_Production = Inh_Production {allnts_Inh_Production :: !([Identifier]),cVisitsMap_Inh_Production :: !(CVisitsMap),inh_Inh_Production :: !(Attributes),manualAttrDepMap_Inh_Production :: !(AttrOrderMap),nt_Inh_Production :: !(Identifier),o_case_Inh_Production :: !(Bool),o_cata_Inh_Production :: !(Bool),o_dovisit_Inh_Production :: !(Bool),o_newtypes_Inh_Production :: !(Bool),o_rename_Inh_Production :: !(Bool),o_sem_Inh_Production :: !(Bool),o_sig_Inh_Production :: !(Bool),o_unbox_Inh_Production :: !(Bool),o_wantvisit_Inh_Production :: !(Bool),prefix_Inh_Production :: !(String),syn_Inh_Production :: !(Attributes),vcount_Inh_Production :: !(Int)} +data Syn_Production = Syn_Production {additionalDep_Syn_Production :: !(Seq Edge),cProduction_Syn_Production :: !(CProduction),cons_Syn_Production :: !([ConstructorIdent]),directDep_Syn_Production :: !(Seq Edge),errors_Syn_Production :: !(Seq Error),instDep_Syn_Production :: !(Seq Edge),rules_Syn_Production :: !(Seq (Vertex,CRule)),vcount_Syn_Production :: !(Int)} wrap_Production (T_Production sem) (Inh_Production _lhsIallnts _lhsIcVisitsMap _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIvcount) = (let ( _lhsOadditionalDep,_lhsOcProduction,_lhsOcons,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOrules,_lhsOvcount) = (sem _lhsIallnts _lhsIcVisitsMap _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIvcount) @@ -2269,51 +2271,51 @@ _rulesIinstVars :: ([Identifier]) _rulesIlocVars :: ([Identifier]) _typeSigsItypeSigs :: (Map Identifier Type) - -- "Order.ag"(line 69, column 16) + -- "Order.ag"(line 72, column 16) _childrenOcon = con_ - -- "Order.ag"(line 71, column 16) + -- "Order.ag"(line 74, column 16) _rulesOcon = con_ - -- "Order.ag"(line 148, column 18) + -- "Order.ag"(line 151, column 18) _gathAltAttrs = [ AltAttr _LHS inh True | inh <- Map.keys _lhsIinh ] ++ _childrenIgathAltAttrs ++ _rulesIgathAltAttrs - -- "Order.ag"(line 164, column 17) + -- "Order.ag"(line 167, column 17) _rulesOaltAttrs = Map.fromList (zip _gathAltAttrs [_lhsIvcount..]) - -- "Order.ag"(line 177, column 18) + -- "Order.ag"(line 180, column 18) _rulesOchildNts = Map.fromList (Seq.toList _childrenInts) - -- "Order.ag"(line 178, column 19) + -- "Order.ag"(line 181, column 19) _rulesOchildInhs = Map.fromList (Seq.toList _childrenIinhs) - -- "Order.ag"(line 184, column 18) + -- "Order.ag"(line 187, column 18) _inhRules = [ cRuleLhsInh inh _lhsInt con_ tp | (inh,tp) <- Map.assocs _lhsIinh ] - -- "Order.ag"(line 185, column 19) + -- "Order.ag"(line 188, column 19) _gathRules = _inhRules ++ Seq.toList (_childrenIgathRules Seq.<> _rulesIgathRules) - -- "Order.ag"(line 239, column 18) + -- "Order.ag"(line 242, column 18) _lhsOrules = Seq.fromList (zip [_lhsIvcount..] _gathRules) - -- "Order.ag"(line 240, column 19) + -- "Order.ag"(line 243, column 19) _lhsOvcount = _lhsIvcount + length _gathRules - -- "Order.ag"(line 309, column 17) + -- "Order.ag"(line 312, column 17) _rulesOsynsOfChildren = _childrenIcollectChildrenSyns - -- "Order.ag"(line 384, column 18) + -- "Order.ag"(line 387, column 18) _lhsOcons = [con_] - -- "Order.ag"(line 391, column 16) + -- "Order.ag"(line 394, column 16) _typeSigsOtypeSigs = Map.empty - -- "Order.ag"(line 397, column 17) + -- "Order.ag"(line 400, column 17) _rulesOallTypeSigs = _typeSigsItypeSigs - -- "Order.ag"(line 463, column 17) + -- "Order.ag"(line 466, column 17) _cVisits = if _lhsIo_dovisit then let prodsVisitsMap = findWithErr1 "Production.cVisits.nt" _lhsInt _lhsIcVisitsMap @@ -2321,34 +2323,34 @@ in visits else let vss = nubBy eqCRuleDefines _gathRules ++ _childrenIsinglevisits in [CVisit _lhsIinh _lhsIsyn vss [] False] - -- "Order.ag"(line 489, column 18) + -- "Order.ag"(line 492, column 18) _lhsOcProduction = CProduction con_ _cVisits _childrenIfields _childrenIterminals - -- "Order.ag"(line 513, column 16) + -- "Order.ag"(line 516, column 16) _allfields = _childrenIfields - -- "Order.ag"(line 513, column 16) + -- "Order.ag"(line 516, column 16) _attrs = map ((,) _LOC) _rulesIlocVars ++ map ((,) _INST) _rulesIinstVars ++ map ((,) _LHS) _inhnames ++ concat [map ((,) nm) (Map.keys as) | (nm,_,as) <- _childrenIattributes] - -- "Order.ag"(line 513, column 16) + -- "Order.ag"(line 516, column 16) _inhnames = Map.keys _lhsIinh - -- "Order.ag"(line 513, column 16) + -- "Order.ag"(line 516, column 16) _synnames = Map.keys _lhsIsyn - -- use rule "Order.ag"(line 259, column 71) + -- use rule "Order.ag"(line 262, column 71) _lhsOadditionalDep = _rulesIadditionalDep - -- use rule "Order.ag"(line 245, column 33) + -- use rule "Order.ag"(line 248, column 33) _lhsOdirectDep = _rulesIdirectDep - -- use rule "Order.ag"(line 60, column 70) + -- use rule "Order.ag"(line 63, column 70) _lhsOerrors = _childrenIerrors Seq.<> _rulesIerrors - -- use rule "Order.ag"(line 292, column 31) + -- use rule "Order.ag"(line 295, column 31) _lhsOinstDep = _rulesIinstDep -- copy rule (from local) @@ -2487,8 +2489,8 @@ Attributes -> Int -> ( (Seq Edge),CProductions,([ConstructorIdent]),(Seq Edge),(Seq Error),(Seq Edge),(Seq (Vertex,CRule)),Int)) -data Inh_Productions = Inh_Productions {allnts_Inh_Productions :: [Identifier],cVisitsMap_Inh_Productions :: CVisitsMap,inh_Inh_Productions :: Attributes,manualAttrDepMap_Inh_Productions :: AttrOrderMap,nt_Inh_Productions :: Identifier,o_case_Inh_Productions :: Bool,o_cata_Inh_Productions :: Bool,o_dovisit_Inh_Productions :: Bool,o_newtypes_Inh_Productions :: Bool,o_rename_Inh_Productions :: Bool,o_sem_Inh_Productions :: Bool,o_sig_Inh_Productions :: Bool,o_unbox_Inh_Productions :: Bool,o_wantvisit_Inh_Productions :: Bool,prefix_Inh_Productions :: String,syn_Inh_Productions :: Attributes,vcount_Inh_Productions :: Int} -data Syn_Productions = Syn_Productions {additionalDep_Syn_Productions :: Seq Edge,cProductions_Syn_Productions :: CProductions,cons_Syn_Productions :: [ConstructorIdent],directDep_Syn_Productions :: Seq Edge,errors_Syn_Productions :: Seq Error,instDep_Syn_Productions :: Seq Edge,rules_Syn_Productions :: Seq (Vertex,CRule),vcount_Syn_Productions :: Int} +data Inh_Productions = Inh_Productions {allnts_Inh_Productions :: !([Identifier]),cVisitsMap_Inh_Productions :: !(CVisitsMap),inh_Inh_Productions :: !(Attributes),manualAttrDepMap_Inh_Productions :: !(AttrOrderMap),nt_Inh_Productions :: !(Identifier),o_case_Inh_Productions :: !(Bool),o_cata_Inh_Productions :: !(Bool),o_dovisit_Inh_Productions :: !(Bool),o_newtypes_Inh_Productions :: !(Bool),o_rename_Inh_Productions :: !(Bool),o_sem_Inh_Productions :: !(Bool),o_sig_Inh_Productions :: !(Bool),o_unbox_Inh_Productions :: !(Bool),o_wantvisit_Inh_Productions :: !(Bool),prefix_Inh_Productions :: !(String),syn_Inh_Productions :: !(Attributes),vcount_Inh_Productions :: !(Int)} +data Syn_Productions = Syn_Productions {additionalDep_Syn_Productions :: !(Seq Edge),cProductions_Syn_Productions :: !(CProductions),cons_Syn_Productions :: !([ConstructorIdent]),directDep_Syn_Productions :: !(Seq Edge),errors_Syn_Productions :: !(Seq Error),instDep_Syn_Productions :: !(Seq Edge),rules_Syn_Productions :: !(Seq (Vertex,CRule)),vcount_Syn_Productions :: !(Int)} wrap_Productions (T_Productions sem) (Inh_Productions _lhsIallnts _lhsIcVisitsMap _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIvcount) = (let ( _lhsOadditionalDep,_lhsOcProductions,_lhsOcons,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOrules,_lhsOvcount) = (sem _lhsIallnts _lhsIcVisitsMap _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIvcount) @@ -2572,25 +2574,25 @@ _tlIinstDep :: (Seq Edge) _tlIrules :: (Seq (Vertex,CRule)) _tlIvcount :: Int - -- "Order.ag"(line 486, column 12) + -- "Order.ag"(line 489, column 12) _lhsOcProductions = _hdIcProduction : _tlIcProductions - -- use rule "Order.ag"(line 259, column 71) + -- use rule "Order.ag"(line 262, column 71) _lhsOadditionalDep = _hdIadditionalDep Seq.<> _tlIadditionalDep - -- use rule "Order.ag"(line 382, column 40) + -- use rule "Order.ag"(line 385, column 40) _lhsOcons = _hdIcons ++ _tlIcons - -- use rule "Order.ag"(line 245, column 33) + -- use rule "Order.ag"(line 248, column 33) _lhsOdirectDep = _hdIdirectDep Seq.<> _tlIdirectDep - -- use rule "Order.ag"(line 60, column 70) + -- use rule "Order.ag"(line 63, column 70) _lhsOerrors = _hdIerrors Seq.<> _tlIerrors - -- use rule "Order.ag"(line 292, column 31) + -- use rule "Order.ag"(line 295, column 31) _lhsOinstDep = _hdIinstDep Seq.<> _tlIinstDep - -- use rule "Order.ag"(line 235, column 18) + -- use rule "Order.ag"(line 238, column 18) _lhsOrules = _hdIrules Seq.<> _tlIrules -- copy rule (up) @@ -2730,25 +2732,25 @@ _lhsOinstDep :: (Seq Edge) _lhsOrules :: (Seq (Vertex,CRule)) _lhsOvcount :: Int - -- "Order.ag"(line 487, column 12) + -- "Order.ag"(line 490, column 12) _lhsOcProductions = [] - -- use rule "Order.ag"(line 259, column 71) + -- use rule "Order.ag"(line 262, column 71) _lhsOadditionalDep = Seq.empty - -- use rule "Order.ag"(line 382, column 40) + -- use rule "Order.ag"(line 385, column 40) _lhsOcons = [] - -- use rule "Order.ag"(line 245, column 33) + -- use rule "Order.ag"(line 248, column 33) _lhsOdirectDep = Seq.empty - -- use rule "Order.ag"(line 60, column 70) + -- use rule "Order.ag"(line 63, column 70) _lhsOerrors = Seq.empty - -- use rule "Order.ag"(line 292, column 31) + -- use rule "Order.ag"(line 295, column 31) _lhsOinstDep = Seq.empty - -- use rule "Order.ag"(line 235, column 18) + -- use rule "Order.ag"(line 238, column 18) _lhsOrules = Seq.empty -- copy rule (chain) @@ -2830,8 +2832,8 @@ Attributes -> (Map Identifier Attributes) -> ( (Seq Edge),(Seq Edge),(Seq Error),([AltAttr]),(Seq CRule),(Seq Edge),([Identifier]),([Identifier]))) -data Inh_Rule = Inh_Rule {allTypeSigs_Inh_Rule :: Map Identifier Type,allfields_Inh_Rule :: [(Identifier,Type,Bool)],allnts_Inh_Rule :: [Identifier],altAttrs_Inh_Rule :: Map AltAttr Vertex,attrs_Inh_Rule :: [(Identifier,Identifier)],childInhs_Inh_Rule :: Map Identifier Attributes,childNts_Inh_Rule :: Map Identifier NontermIdent,con_Inh_Rule :: Identifier,inh_Inh_Rule :: Attributes,manualAttrDepMap_Inh_Rule :: AttrOrderMap,nt_Inh_Rule :: Identifier,o_case_Inh_Rule :: Bool,o_cata_Inh_Rule :: Bool,o_dovisit_Inh_Rule :: Bool,o_newtypes_Inh_Rule :: Bool,o_rename_Inh_Rule :: Bool,o_sem_Inh_Rule :: Bool,o_sig_Inh_Rule :: Bool,o_wantvisit_Inh_Rule :: Bool,prefix_Inh_Rule :: String,syn_Inh_Rule :: Attributes,synsOfChildren_Inh_Rule :: Map Identifier Attributes} -data Syn_Rule = Syn_Rule {additionalDep_Syn_Rule :: Seq Edge,directDep_Syn_Rule :: Seq Edge,errors_Syn_Rule :: Seq Error,gathAltAttrs_Syn_Rule :: [AltAttr],gathRules_Syn_Rule :: Seq CRule,instDep_Syn_Rule :: Seq Edge,instVars_Syn_Rule :: [Identifier],locVars_Syn_Rule :: [Identifier]} +data Inh_Rule = Inh_Rule {allTypeSigs_Inh_Rule :: !(Map Identifier Type),allfields_Inh_Rule :: !([(Identifier,Type,Bool)]),allnts_Inh_Rule :: !([Identifier]),altAttrs_Inh_Rule :: !(Map AltAttr Vertex),attrs_Inh_Rule :: !([(Identifier,Identifier)]),childInhs_Inh_Rule :: !(Map Identifier Attributes),childNts_Inh_Rule :: !(Map Identifier NontermIdent),con_Inh_Rule :: !(Identifier),inh_Inh_Rule :: !(Attributes),manualAttrDepMap_Inh_Rule :: !(AttrOrderMap),nt_Inh_Rule :: !(Identifier),o_case_Inh_Rule :: !(Bool),o_cata_Inh_Rule :: !(Bool),o_dovisit_Inh_Rule :: !(Bool),o_newtypes_Inh_Rule :: !(Bool),o_rename_Inh_Rule :: !(Bool),o_sem_Inh_Rule :: !(Bool),o_sig_Inh_Rule :: !(Bool),o_wantvisit_Inh_Rule :: !(Bool),prefix_Inh_Rule :: !(String),syn_Inh_Rule :: !(Attributes),synsOfChildren_Inh_Rule :: !(Map Identifier Attributes)} +data Syn_Rule = Syn_Rule {additionalDep_Syn_Rule :: !(Seq Edge),directDep_Syn_Rule :: !(Seq Edge),errors_Syn_Rule :: !(Seq Error),gathAltAttrs_Syn_Rule :: !([AltAttr]),gathRules_Syn_Rule :: !(Seq CRule),instDep_Syn_Rule :: !(Seq Edge),instVars_Syn_Rule :: !([Identifier]),locVars_Syn_Rule :: !([Identifier])} wrap_Rule (T_Rule sem) (Inh_Rule _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIsynsOfChildren) = (let ( _lhsOadditionalDep,_lhsOdirectDep,_lhsOerrors,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinstDep,_lhsOinstVars,_lhsOlocVars) = (sem _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIsynsOfChildren) @@ -2896,7 +2898,7 @@ _rhsIusedAttrs :: ([(Identifier,Identifier)]) _rhsIusedFields :: ([Identifier]) _rhsIusedLocals :: ([Identifier]) - -- "Order.ag"(line 193, column 12) + -- "Order.ag"(line 196, column 12) _defines = let tp field attr parts | field == _LOC || field == _INST = case parts of @@ -2913,29 +2915,29 @@ | (field,attr,isLocalOrInst,parts) <- _patternIpatternAttrs , let aa = AltAttr field attr isLocalOrInst ] - -- "Order.ag"(line 209, column 12) + -- "Order.ag"(line 212, column 12) _gathRules = let childnt field = Map.lookup field _lhsIchildNts in Seq.fromList [ CRule attr False True _lhsInt _lhsIcon field (childnt field) tp _patternIcopy _rhsItextLines _defines owrt_ origin_ _rhsIallRhsVars | (field,attr,tp) <- Map.elems _defines ] - -- "Order.ag"(line 247, column 12) + -- "Order.ag"(line 250, column 12) _lhsOdirectDep = let defined = Map.keys _defines used = [ Map.lookup (AltAttr field attr True) _lhsIaltAttrs | (field,attr) <- _rhsIusedAttrs] ++ [ Map.lookup (AltAttr _LOC attr True) _lhsIaltAttrs | attr <- _rhsIusedLocals ++ _rhsIusedFields ] in Seq.fromList [ (x,y) | Just x <- used, y <- defined ] - -- "Order.ag"(line 265, column 7) + -- "Order.ag"(line 268, column 7) _manualDeps = Set.toList $ Map.findWithDefault Set.empty _lhsIcon $ Map.findWithDefault Map.empty _lhsInt _lhsImanualAttrDepMap - -- "Order.ag"(line 267, column 7) + -- "Order.ag"(line 270, column 7) _lhsOadditionalDep = Seq.fromList [ (vertexA, vertexB) | Dependency (fldA,nmA) (fldB,nmB) <- _manualDeps , let vertexA = findWithErr2 (AltAttr fldA nmA True) _lhsIaltAttrs , vertexB <- lookupVertices fldB nmB _lhsIaltAttrs ] - -- "Order.ag"(line 295, column 7) + -- "Order.ag"(line 298, column 7) _lhsOinstDep = Seq.fromList $ [ (instVert, synVert) @@ -2947,19 +2949,19 @@ instVert = findWithErr2 instAttr _lhsIaltAttrs synVert = findWithErr2 synAttr _lhsIaltAttrs ] - -- use rule "Order.ag"(line 60, column 70) + -- use rule "Order.ag"(line 63, column 70) _lhsOerrors = _patternIerrors Seq.<> _rhsIerrors - -- use rule "Order.ag"(line 146, column 68) + -- use rule "Order.ag"(line 149, column 68) _lhsOgathAltAttrs = _patternIgathAltAttrs - -- use rule "Order.ag"(line 182, column 23) + -- use rule "Order.ag"(line 185, column 23) _lhsOgathRules = _gathRules - -- use rule "Order.ag"(line 533, column 86) + -- use rule "Order.ag"(line 536, column 86) _lhsOinstVars = _patternIinstVars - -- use rule "Order.ag"(line 533, column 48) + -- use rule "Order.ag"(line 536, column 48) _lhsOlocVars = _patternIlocVars -- copy rule (down) @@ -3070,8 +3072,8 @@ Attributes -> (Map Identifier Attributes) -> ( (Seq Edge),(Seq Edge),(Seq Error),([AltAttr]),(Seq CRule),(Seq Edge),([Identifier]),([Identifier]))) -data Inh_Rules = Inh_Rules {allTypeSigs_Inh_Rules :: Map Identifier Type,allfields_Inh_Rules :: [(Identifier,Type,Bool)],allnts_Inh_Rules :: [Identifier],altAttrs_Inh_Rules :: Map AltAttr Vertex,attrs_Inh_Rules :: [(Identifier,Identifier)],childInhs_Inh_Rules :: Map Identifier Attributes,childNts_Inh_Rules :: Map Identifier NontermIdent,con_Inh_Rules :: Identifier,inh_Inh_Rules :: Attributes,manualAttrDepMap_Inh_Rules :: AttrOrderMap,nt_Inh_Rules :: Identifier,o_case_Inh_Rules :: Bool,o_cata_Inh_Rules :: Bool,o_dovisit_Inh_Rules :: Bool,o_newtypes_Inh_Rules :: Bool,o_rename_Inh_Rules :: Bool,o_sem_Inh_Rules :: Bool,o_sig_Inh_Rules :: Bool,o_wantvisit_Inh_Rules :: Bool,prefix_Inh_Rules :: String,syn_Inh_Rules :: Attributes,synsOfChildren_Inh_Rules :: Map Identifier Attributes} -data Syn_Rules = Syn_Rules {additionalDep_Syn_Rules :: Seq Edge,directDep_Syn_Rules :: Seq Edge,errors_Syn_Rules :: Seq Error,gathAltAttrs_Syn_Rules :: [AltAttr],gathRules_Syn_Rules :: Seq CRule,instDep_Syn_Rules :: Seq Edge,instVars_Syn_Rules :: [Identifier],locVars_Syn_Rules :: [Identifier]} +data Inh_Rules = Inh_Rules {allTypeSigs_Inh_Rules :: !(Map Identifier Type),allfields_Inh_Rules :: !([(Identifier,Type,Bool)]),allnts_Inh_Rules :: !([Identifier]),altAttrs_Inh_Rules :: !(Map AltAttr Vertex),attrs_Inh_Rules :: !([(Identifier,Identifier)]),childInhs_Inh_Rules :: !(Map Identifier Attributes),childNts_Inh_Rules :: !(Map Identifier NontermIdent),con_Inh_Rules :: !(Identifier),inh_Inh_Rules :: !(Attributes),manualAttrDepMap_Inh_Rules :: !(AttrOrderMap),nt_Inh_Rules :: !(Identifier),o_case_Inh_Rules :: !(Bool),o_cata_Inh_Rules :: !(Bool),o_dovisit_Inh_Rules :: !(Bool),o_newtypes_Inh_Rules :: !(Bool),o_rename_Inh_Rules :: !(Bool),o_sem_Inh_Rules :: !(Bool),o_sig_Inh_Rules :: !(Bool),o_wantvisit_Inh_Rules :: !(Bool),prefix_Inh_Rules :: !(String),syn_Inh_Rules :: !(Attributes),synsOfChildren_Inh_Rules :: !(Map Identifier Attributes)} +data Syn_Rules = Syn_Rules {additionalDep_Syn_Rules :: !(Seq Edge),directDep_Syn_Rules :: !(Seq Edge),errors_Syn_Rules :: !(Seq Error),gathAltAttrs_Syn_Rules :: !([AltAttr]),gathRules_Syn_Rules :: !(Seq CRule),instDep_Syn_Rules :: !(Seq Edge),instVars_Syn_Rules :: !([Identifier]),locVars_Syn_Rules :: !([Identifier])} wrap_Rules (T_Rules sem) (Inh_Rules _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIsynsOfChildren) = (let ( _lhsOadditionalDep,_lhsOdirectDep,_lhsOerrors,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinstDep,_lhsOinstVars,_lhsOlocVars) = (sem _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsImanualAttrDepMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIsynsOfChildren) @@ -3170,28 +3172,28 @@ _tlIinstDep :: (Seq Edge) _tlIinstVars :: ([Identifier]) _tlIlocVars :: ([Identifier]) - -- use rule "Order.ag"(line 259, column 71) + -- use rule "Order.ag"(line 262, column 71) _lhsOadditionalDep = _hdIadditionalDep Seq.<> _tlIadditionalDep - -- use rule "Order.ag"(line 245, column 33) + -- use rule "Order.ag"(line 248, column 33) _lhsOdirectDep = _hdIdirectDep Seq.<> _tlIdirectDep - -- use rule "Order.ag"(line 60, column 70) + -- use rule "Order.ag"(line 63, column 70) _lhsOerrors = _hdIerrors Seq.<> _tlIerrors - -- use rule "Order.ag"(line 146, column 68) + -- use rule "Order.ag"(line 149, column 68) _lhsOgathAltAttrs = _hdIgathAltAttrs ++ _tlIgathAltAttrs - -- use rule "Order.ag"(line 182, column 23) + -- use rule "Order.ag"(line 185, column 23) _lhsOgathRules = _hdIgathRules Seq.<> _tlIgathRules - -- use rule "Order.ag"(line 292, column 31) + -- use rule "Order.ag"(line 295, column 31) _lhsOinstDep = _hdIinstDep Seq.<> _tlIinstDep - -- use rule "Order.ag"(line 533, column 86) + -- use rule "Order.ag"(line 536, column 86) _lhsOinstVars = _hdIinstVars ++ _tlIinstVars - -- use rule "Order.ag"(line 533, column 48) + -- use rule "Order.ag"(line 536, column 48) _lhsOlocVars = _hdIlocVars ++ _tlIlocVars -- copy rule (down) @@ -3363,28 +3365,28 @@ _lhsOinstDep :: (Seq Edge) _lhsOinstVars :: ([Identifier]) _lhsOlocVars :: ([Identifier]) - -- use rule "Order.ag"(line 259, column 71) + -- use rule "Order.ag"(line 262, column 71) _lhsOadditionalDep = Seq.empty - -- use rule "Order.ag"(line 245, column 33) + -- use rule "Order.ag"(line 248, column 33) _lhsOdirectDep = Seq.empty - -- use rule "Order.ag"(line 60, column 70) + -- use rule "Order.ag"(line 63, column 70) _lhsOerrors = Seq.empty - -- use rule "Order.ag"(line 146, column 68) + -- use rule "Order.ag"(line 149, column 68) _lhsOgathAltAttrs = [] - -- use rule "Order.ag"(line 182, column 23) + -- use rule "Order.ag"(line 185, column 23) _lhsOgathRules = Seq.empty - -- use rule "Order.ag"(line 292, column 31) + -- use rule "Order.ag"(line 295, column 31) _lhsOinstDep = Seq.empty - -- use rule "Order.ag"(line 533, column 86) + -- use rule "Order.ag"(line 536, column 86) _lhsOinstVars = [] - -- use rule "Order.ag"(line 533, column 48) + -- use rule "Order.ag"(line 536, column 48) _lhsOlocVars = [] in ( _lhsOadditionalDep,_lhsOdirectDep,_lhsOerrors,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinstDep,_lhsOinstVars,_lhsOlocVars)))) @@ -3406,8 +3408,8 @@ -- semantic domain newtype T_TypeSig = T_TypeSig ((Map Identifier Type) -> ( (Map Identifier Type))) -data Inh_TypeSig = Inh_TypeSig {typeSigs_Inh_TypeSig :: Map Identifier Type} -data Syn_TypeSig = Syn_TypeSig {typeSigs_Syn_TypeSig :: Map Identifier Type} +data Inh_TypeSig = Inh_TypeSig {typeSigs_Inh_TypeSig :: !(Map Identifier Type)} +data Syn_TypeSig = Syn_TypeSig {typeSigs_Syn_TypeSig :: !(Map Identifier Type)} wrap_TypeSig (T_TypeSig sem) (Inh_TypeSig _lhsItypeSigs) = (let ( _lhsOtypeSigs) = (sem _lhsItypeSigs) @@ -3418,7 +3420,7 @@ sem_TypeSig_TypeSig name_ tp_ = (T_TypeSig (\ _lhsItypeSigs -> (let _lhsOtypeSigs :: (Map Identifier Type) - -- "Order.ag"(line 393, column 13) + -- "Order.ag"(line 396, column 13) _lhsOtypeSigs = Map.insert name_ tp_ _lhsItypeSigs in ( _lhsOtypeSigs)))) @@ -3441,8 +3443,8 @@ -- semantic domain newtype T_TypeSigs = T_TypeSigs ((Map Identifier Type) -> ( (Map Identifier Type))) -data Inh_TypeSigs = Inh_TypeSigs {typeSigs_Inh_TypeSigs :: Map Identifier Type} -data Syn_TypeSigs = Syn_TypeSigs {typeSigs_Syn_TypeSigs :: Map Identifier Type} +data Inh_TypeSigs = Inh_TypeSigs {typeSigs_Inh_TypeSigs :: !(Map Identifier Type)} +data Syn_TypeSigs = Syn_TypeSigs {typeSigs_Syn_TypeSigs :: !(Map Identifier Type)} wrap_TypeSigs (T_TypeSigs sem) (Inh_TypeSigs _lhsItypeSigs) = (let ( _lhsOtypeSigs) = (sem _lhsItypeSigs) diff --git a/src-derived/PrintCode.hs b/src-derived/PrintCode.hs --- a/src-derived/PrintCode.hs +++ b/src-derived/PrintCode.hs @@ -1,2858 +1,2161 @@ --- UUAGC 0.9.5 (PrintCode.ag) -module PrintCode where - -import Char (isAlphaNum) -import Pretty -import Code -import Patterns -import Options -import CommonTypes (attrname, _LOC, getName, nullIdent) -import Data.List(intersperse) -import System.IO -import System.Directory - -import Pretty -import Patterns -import Data.List(partition) -import Data.Set(Set) -import qualified UU.DData.Set as Set -import Data.Map(Map) -import qualified Data.Map as Map - --- Patterns.ag imports -import UU.Scanner.Position(Pos) -import CommonTypes (ConstructorIdent,Identifier) - -type PP_Docs = [PP_Doc] - -ppMultiSeqH :: [PP_Doc] -> PP_Doc -> PP_Doc -ppMultiSeqH = ppMultiSeq' (>#<) - -ppMultiSeqV :: [PP_Doc] -> PP_Doc -> PP_Doc -ppMultiSeqV = ppMultiSeq' (>-<) - -ppMultiSeq' :: (PP_Doc -> PP_Doc -> PP_Doc) -> [PP_Doc] -> PP_Doc -> PP_Doc -ppMultiSeq' next strictArgs expr - = foldr (\v r -> (v >#< "`seq`") `next` pp_parens r) expr strictArgs - - -reallySimple :: String -> Bool -reallySimple = and . map (\x -> isAlphaNum x || x=='_') - -ppTuple True pps = "(" >|< pp_block " " (replicate (length pps `max` 1) ')') ",(" pps -ppTuple False pps = "(" >|< pp_block " " ")" "," pps -ppUnboxedTuple True pps = "(# " >|< pp_block " " (concat $ replicate (length pps `max` 1) " #)") ",(# " pps -ppUnboxedTuple False pps = "(# " >|< pp_block " " " #)" "," pps - - -locname' n = "_loc_" ++ getName n - -renderDocs :: [PP_Doc] -> String -renderDocs pps = foldr (.) id (map (\d -> (disp d 50000) . ( '\n':) ) pps) "" - -writeModule :: FilePath -> [PP_Doc] -> IO () -writeModule path docs - = do bExists <- doesFileExist path - if bExists - then do input <- readFile path - seq (length input) (return ()) - if input /= output - then dumpIt - else return () - else dumpIt - where - output = renderDocs docs - dumpIt = writeFile path output - --- Unboxed tuples --- unbox Whether unboxed tuples are wanted or not --- inh The inherited attributes. --- If there are none, no unboxing can take place, --- because in that case the semantic function (a top-level identifier) would have an unboxed type. --- Of course we can't have an unboxed 1-tuple -mkTupleExpr :: Bool -> Bool -> Exprs -> Expr -mkTupleExpr unbox noInh exprs | not unbox || noInh || length exprs == 1 = TupleExpr exprs - | otherwise = UnboxedTupleExpr exprs -mkTupleType :: Bool -> Bool -> Types -> Type -mkTupleType unbox noInh tps | not unbox || noInh || length tps == 1 = TupleType tps - | otherwise = UnboxedTupleType tps -mkTupleLhs :: Bool -> Bool -> [String] -> Lhs -mkTupleLhs unbox noInh comps | not unbox || noInh || length comps == 1 = TupleLhs comps - | otherwise = UnboxedTupleLhs comps --- CaseAlt ----------------------------------------------------- -{- - visit 0: - inherited attributes: - nested : Bool - options : Options - outputfile : String - synthesized attribute: - pps : PP_Docs - alternatives: - alternative CaseAlt: - child left : Lhs - child expr : Expr --} --- cata -sem_CaseAlt :: CaseAlt -> - T_CaseAlt -sem_CaseAlt (CaseAlt _left _expr) = - (sem_CaseAlt_CaseAlt (sem_Lhs _left) (sem_Expr _expr)) --- semantic domain -newtype T_CaseAlt = T_CaseAlt (Bool -> - Options -> - String -> - ( PP_Docs)) -data Inh_CaseAlt = Inh_CaseAlt {nested_Inh_CaseAlt :: Bool,options_Inh_CaseAlt :: Options,outputfile_Inh_CaseAlt :: String} -data Syn_CaseAlt = Syn_CaseAlt {pps_Syn_CaseAlt :: PP_Docs} -wrap_CaseAlt (T_CaseAlt sem) (Inh_CaseAlt _lhsInested _lhsIoptions _lhsIoutputfile) = - (let ( _lhsOpps) = - (sem _lhsInested _lhsIoptions _lhsIoutputfile) - in (Syn_CaseAlt _lhsOpps)) -sem_CaseAlt_CaseAlt :: T_Lhs -> - T_Expr -> - T_CaseAlt -sem_CaseAlt_CaseAlt (T_Lhs left_) (T_Expr expr_) = - (T_CaseAlt (\ _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpps :: PP_Docs - _leftOisDeclOfLet :: Bool - _leftOnested :: Bool - _leftOoptions :: Options - _leftOoutputfile :: String - _exprOnested :: Bool - _exprOoptions :: Options - _exprOoutputfile :: String - _leftIpp :: PP_Doc - _exprIpp :: PP_Doc - -- "PrintCode.ag"(line 150, column 16) - _lhsOpps = - ["{" >#< _leftIpp >#< "->", _exprIpp >#< "}"] - -- "PrintCode.ag"(line 326, column 7) - _leftOisDeclOfLet = - False - -- copy rule (down) - _leftOnested = - _lhsInested - -- copy rule (down) - _leftOoptions = - _lhsIoptions - -- copy rule (down) - _leftOoutputfile = - _lhsIoutputfile - -- copy rule (down) - _exprOnested = - _lhsInested - -- copy rule (down) - _exprOoptions = - _lhsIoptions - -- copy rule (down) - _exprOoutputfile = - _lhsIoutputfile - ( _leftIpp) = - (left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile) - ( _exprIpp) = - (expr_ _exprOnested _exprOoptions _exprOoutputfile) - in ( _lhsOpps)))) --- CaseAlts ---------------------------------------------------- -{- - visit 0: - inherited attributes: - nested : Bool - options : Options - outputfile : String - synthesized attribute: - pps : PP_Docs - alternatives: - alternative Cons: - child hd : CaseAlt - child tl : CaseAlts - alternative Nil: --} --- cata -sem_CaseAlts :: CaseAlts -> - T_CaseAlts -sem_CaseAlts list = - (Prelude.foldr sem_CaseAlts_Cons sem_CaseAlts_Nil (Prelude.map sem_CaseAlt list)) --- semantic domain -newtype T_CaseAlts = T_CaseAlts (Bool -> - Options -> - String -> - ( PP_Docs)) -data Inh_CaseAlts = Inh_CaseAlts {nested_Inh_CaseAlts :: Bool,options_Inh_CaseAlts :: Options,outputfile_Inh_CaseAlts :: String} -data Syn_CaseAlts = Syn_CaseAlts {pps_Syn_CaseAlts :: PP_Docs} -wrap_CaseAlts (T_CaseAlts sem) (Inh_CaseAlts _lhsInested _lhsIoptions _lhsIoutputfile) = - (let ( _lhsOpps) = - (sem _lhsInested _lhsIoptions _lhsIoutputfile) - in (Syn_CaseAlts _lhsOpps)) -sem_CaseAlts_Cons :: T_CaseAlt -> - T_CaseAlts -> - T_CaseAlts -sem_CaseAlts_Cons (T_CaseAlt hd_) (T_CaseAlts tl_) = - (T_CaseAlts (\ _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpps :: PP_Docs - _hdOnested :: Bool - _hdOoptions :: Options - _hdOoutputfile :: String - _tlOnested :: Bool - _tlOoptions :: Options - _tlOoutputfile :: String - _hdIpps :: PP_Docs - _tlIpps :: PP_Docs - -- "PrintCode.ag"(line 59, column 10) - _lhsOpps = - _hdIpps ++ _tlIpps - -- copy rule (down) - _hdOnested = - _lhsInested - -- copy rule (down) - _hdOoptions = - _lhsIoptions - -- copy rule (down) - _hdOoutputfile = - _lhsIoutputfile - -- copy rule (down) - _tlOnested = - _lhsInested - -- copy rule (down) - _tlOoptions = - _lhsIoptions - -- copy rule (down) - _tlOoutputfile = - _lhsIoutputfile - ( _hdIpps) = - (hd_ _hdOnested _hdOoptions _hdOoutputfile) - ( _tlIpps) = - (tl_ _tlOnested _tlOoptions _tlOoutputfile) - in ( _lhsOpps)))) -sem_CaseAlts_Nil :: T_CaseAlts -sem_CaseAlts_Nil = - (T_CaseAlts (\ _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpps :: PP_Docs - -- "PrintCode.ag"(line 60, column 10) - _lhsOpps = - [] - in ( _lhsOpps)))) --- Chunk ------------------------------------------------------- -{- - visit 0: - inherited attributes: - importBlocks : PP_Doc - isDeclOfLet : Bool - mainFile : String - mainName : String - moduleHeader : String -> String -> String -> Bool -> String - nested : Bool - options : Options - optionsLine : String - pragmaBlocks : String - textBlocks : PP_Doc - synthesized attributes: - appendCommon : [[PP_Doc]] - appendMain : [[PP_Doc]] - genSems : IO () - imports : [String] - pps : PP_Docs - alternatives: - alternative Chunk: - child name : {String} - child comment : Decl - child info : Decls - child dataDef : Decls - child cataFun : Decls - child semDom : Decls - child semWrapper : Decls - child semFunctions : Decls - child semNames : {[String]} - visit 0: - local outputfile : _ - local exports : _ --} --- cata -sem_Chunk :: Chunk -> - T_Chunk -sem_Chunk (Chunk _name _comment _info _dataDef _cataFun _semDom _semWrapper _semFunctions _semNames) = - (sem_Chunk_Chunk _name (sem_Decl _comment) (sem_Decls _info) (sem_Decls _dataDef) (sem_Decls _cataFun) (sem_Decls _semDom) (sem_Decls _semWrapper) (sem_Decls _semFunctions) _semNames) --- semantic domain -newtype T_Chunk = T_Chunk (PP_Doc -> - Bool -> - String -> - String -> - (String -> String -> String -> Bool -> String) -> - Bool -> - Options -> - String -> - String -> - PP_Doc -> - ( ([[PP_Doc]]),([[PP_Doc]]),(IO ()),([String]),PP_Docs)) -data Inh_Chunk = Inh_Chunk {importBlocks_Inh_Chunk :: PP_Doc,isDeclOfLet_Inh_Chunk :: Bool,mainFile_Inh_Chunk :: String,mainName_Inh_Chunk :: String,moduleHeader_Inh_Chunk :: String -> String -> String -> Bool -> String,nested_Inh_Chunk :: Bool,options_Inh_Chunk :: Options,optionsLine_Inh_Chunk :: String,pragmaBlocks_Inh_Chunk :: String,textBlocks_Inh_Chunk :: PP_Doc} -data Syn_Chunk = Syn_Chunk {appendCommon_Syn_Chunk :: [[PP_Doc]],appendMain_Syn_Chunk :: [[PP_Doc]],genSems_Syn_Chunk :: IO (),imports_Syn_Chunk :: [String],pps_Syn_Chunk :: PP_Docs} -wrap_Chunk (T_Chunk sem) (Inh_Chunk _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks) = - (let ( _lhsOappendCommon,_lhsOappendMain,_lhsOgenSems,_lhsOimports,_lhsOpps) = - (sem _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks) - in (Syn_Chunk _lhsOappendCommon _lhsOappendMain _lhsOgenSems _lhsOimports _lhsOpps)) -sem_Chunk_Chunk :: String -> - T_Decl -> - T_Decls -> - T_Decls -> - T_Decls -> - T_Decls -> - T_Decls -> - T_Decls -> - ([String]) -> - T_Chunk -sem_Chunk_Chunk name_ (T_Decl comment_) (T_Decls info_) (T_Decls dataDef_) (T_Decls cataFun_) (T_Decls semDom_) (T_Decls semWrapper_) (T_Decls semFunctions_) semNames_ = - (T_Chunk (\ _lhsIimportBlocks - _lhsIisDeclOfLet - _lhsImainFile - _lhsImainName - _lhsImoduleHeader - _lhsInested - _lhsIoptions - _lhsIoptionsLine - _lhsIpragmaBlocks - _lhsItextBlocks -> - (let _lhsOpps :: PP_Docs - _lhsOimports :: ([String]) - _lhsOappendCommon :: ([[PP_Doc]]) - _lhsOappendMain :: ([[PP_Doc]]) - _lhsOgenSems :: (IO ()) - _commentOisDeclOfLet :: Bool - _commentOnested :: Bool - _commentOoptions :: Options - _commentOoutputfile :: String - _infoOisDeclOfLet :: Bool - _infoOnested :: Bool - _infoOoptions :: Options - _infoOoutputfile :: String - _dataDefOisDeclOfLet :: Bool - _dataDefOnested :: Bool - _dataDefOoptions :: Options - _dataDefOoutputfile :: String - _cataFunOisDeclOfLet :: Bool - _cataFunOnested :: Bool - _cataFunOoptions :: Options - _cataFunOoutputfile :: String - _semDomOisDeclOfLet :: Bool - _semDomOnested :: Bool - _semDomOoptions :: Options - _semDomOoutputfile :: String - _semWrapperOisDeclOfLet :: Bool - _semWrapperOnested :: Bool - _semWrapperOoptions :: Options - _semWrapperOoutputfile :: String - _semFunctionsOisDeclOfLet :: Bool - _semFunctionsOnested :: Bool - _semFunctionsOoptions :: Options - _semFunctionsOoutputfile :: String - _commentIpp :: PP_Doc - _infoIpps :: PP_Docs - _dataDefIpps :: PP_Docs - _cataFunIpps :: PP_Docs - _semDomIpps :: PP_Docs - _semWrapperIpps :: PP_Docs - _semFunctionsIpps :: PP_Docs - -- "PrintCode.ag"(line 37, column 7) - _outputfile = - if sepSemMods _lhsIoptions - then _lhsImainFile ++ "_" ++ name_ ++ ".hs" - else _lhsImainFile ++ ".hs" - -- "PrintCode.ag"(line 83, column 16) - _lhsOpps = - _commentIpp - : _infoIpps - ++ _dataDefIpps - ++ _cataFunIpps - ++ _semDomIpps - ++ _semWrapperIpps - ++ _semFunctionsIpps - -- "PrintCode.ag"(line 383, column 7) - _lhsOimports = - ["import " ++ _lhsImainName ++ "_" ++ name_ ++ "\n"] - -- "PrintCode.ag"(line 389, column 7) - _lhsOappendCommon = - [ [_commentIpp] - , _dataDefIpps - , _semDomIpps - ] - -- "PrintCode.ag"(line 394, column 7) - _lhsOappendMain = - [ [_commentIpp] - , _cataFunIpps - , _semWrapperIpps - ] - -- "PrintCode.ag"(line 404, column 7) - _lhsOgenSems = - writeModule _outputfile - [ pp $ _lhsIpragmaBlocks - , pp $ _lhsIoptionsLine - , pp $ _lhsImoduleHeader _lhsImainName ("_" ++ name_) _exports True - , pp $ ("import " ++ _lhsImainName ++ "_common\n") - , _commentIpp - , vlist_sep "" _infoIpps - , vlist_sep "" _semFunctionsIpps - ] - -- "PrintCode.ag"(line 417, column 7) - _exports = - concat $ intersperse "," semNames_ - -- copy rule (down) - _commentOisDeclOfLet = - _lhsIisDeclOfLet - -- copy rule (down) - _commentOnested = - _lhsInested - -- copy rule (down) - _commentOoptions = - _lhsIoptions - -- copy rule (from local) - _commentOoutputfile = - _outputfile - -- copy rule (down) - _infoOisDeclOfLet = - _lhsIisDeclOfLet - -- copy rule (down) - _infoOnested = - _lhsInested - -- copy rule (down) - _infoOoptions = - _lhsIoptions - -- copy rule (from local) - _infoOoutputfile = - _outputfile - -- copy rule (down) - _dataDefOisDeclOfLet = - _lhsIisDeclOfLet - -- copy rule (down) - _dataDefOnested = - _lhsInested - -- copy rule (down) - _dataDefOoptions = - _lhsIoptions - -- copy rule (from local) - _dataDefOoutputfile = - _outputfile - -- copy rule (down) - _cataFunOisDeclOfLet = - _lhsIisDeclOfLet - -- copy rule (down) - _cataFunOnested = - _lhsInested - -- copy rule (down) - _cataFunOoptions = - _lhsIoptions - -- copy rule (from local) - _cataFunOoutputfile = - _outputfile - -- copy rule (down) - _semDomOisDeclOfLet = - _lhsIisDeclOfLet - -- copy rule (down) - _semDomOnested = - _lhsInested - -- copy rule (down) - _semDomOoptions = - _lhsIoptions - -- copy rule (from local) - _semDomOoutputfile = - _outputfile - -- copy rule (down) - _semWrapperOisDeclOfLet = - _lhsIisDeclOfLet - -- copy rule (down) - _semWrapperOnested = - _lhsInested - -- copy rule (down) - _semWrapperOoptions = - _lhsIoptions - -- copy rule (from local) - _semWrapperOoutputfile = - _outputfile - -- copy rule (down) - _semFunctionsOisDeclOfLet = - _lhsIisDeclOfLet - -- copy rule (down) - _semFunctionsOnested = - _lhsInested - -- copy rule (down) - _semFunctionsOoptions = - _lhsIoptions - -- copy rule (from local) - _semFunctionsOoutputfile = - _outputfile - ( _commentIpp) = - (comment_ _commentOisDeclOfLet _commentOnested _commentOoptions _commentOoutputfile) - ( _infoIpps) = - (info_ _infoOisDeclOfLet _infoOnested _infoOoptions _infoOoutputfile) - ( _dataDefIpps) = - (dataDef_ _dataDefOisDeclOfLet _dataDefOnested _dataDefOoptions _dataDefOoutputfile) - ( _cataFunIpps) = - (cataFun_ _cataFunOisDeclOfLet _cataFunOnested _cataFunOoptions _cataFunOoutputfile) - ( _semDomIpps) = - (semDom_ _semDomOisDeclOfLet _semDomOnested _semDomOoptions _semDomOoutputfile) - ( _semWrapperIpps) = - (semWrapper_ _semWrapperOisDeclOfLet _semWrapperOnested _semWrapperOoptions _semWrapperOoutputfile) - ( _semFunctionsIpps) = - (semFunctions_ _semFunctionsOisDeclOfLet _semFunctionsOnested _semFunctionsOoptions _semFunctionsOoutputfile) - in ( _lhsOappendCommon,_lhsOappendMain,_lhsOgenSems,_lhsOimports,_lhsOpps)))) --- Chunks ------------------------------------------------------ -{- - visit 0: - inherited attributes: - importBlocks : PP_Doc - isDeclOfLet : Bool - mainFile : String - mainName : String - moduleHeader : String -> String -> String -> Bool -> String - nested : Bool - options : Options - optionsLine : String - pragmaBlocks : String - textBlocks : PP_Doc - synthesized attributes: - appendCommon : [[PP_Doc]] - appendMain : [[PP_Doc]] - genSems : IO () - imports : [String] - pps : PP_Docs - alternatives: - alternative Cons: - child hd : Chunk - child tl : Chunks - alternative Nil: --} --- cata -sem_Chunks :: Chunks -> - T_Chunks -sem_Chunks list = - (Prelude.foldr sem_Chunks_Cons sem_Chunks_Nil (Prelude.map sem_Chunk list)) --- semantic domain -newtype T_Chunks = T_Chunks (PP_Doc -> - Bool -> - String -> - String -> - (String -> String -> String -> Bool -> String) -> - Bool -> - Options -> - String -> - String -> - PP_Doc -> - ( ([[PP_Doc]]),([[PP_Doc]]),(IO ()),([String]),PP_Docs)) -data Inh_Chunks = Inh_Chunks {importBlocks_Inh_Chunks :: PP_Doc,isDeclOfLet_Inh_Chunks :: Bool,mainFile_Inh_Chunks :: String,mainName_Inh_Chunks :: String,moduleHeader_Inh_Chunks :: String -> String -> String -> Bool -> String,nested_Inh_Chunks :: Bool,options_Inh_Chunks :: Options,optionsLine_Inh_Chunks :: String,pragmaBlocks_Inh_Chunks :: String,textBlocks_Inh_Chunks :: PP_Doc} -data Syn_Chunks = Syn_Chunks {appendCommon_Syn_Chunks :: [[PP_Doc]],appendMain_Syn_Chunks :: [[PP_Doc]],genSems_Syn_Chunks :: IO (),imports_Syn_Chunks :: [String],pps_Syn_Chunks :: PP_Docs} -wrap_Chunks (T_Chunks sem) (Inh_Chunks _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks) = - (let ( _lhsOappendCommon,_lhsOappendMain,_lhsOgenSems,_lhsOimports,_lhsOpps) = - (sem _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks) - in (Syn_Chunks _lhsOappendCommon _lhsOappendMain _lhsOgenSems _lhsOimports _lhsOpps)) -sem_Chunks_Cons :: T_Chunk -> - T_Chunks -> - T_Chunks -sem_Chunks_Cons (T_Chunk hd_) (T_Chunks tl_) = - (T_Chunks (\ _lhsIimportBlocks - _lhsIisDeclOfLet - _lhsImainFile - _lhsImainName - _lhsImoduleHeader - _lhsInested - _lhsIoptions - _lhsIoptionsLine - _lhsIpragmaBlocks - _lhsItextBlocks -> - (let _lhsOpps :: PP_Docs - _lhsOappendCommon :: ([[PP_Doc]]) - _lhsOappendMain :: ([[PP_Doc]]) - _lhsOgenSems :: (IO ()) - _lhsOimports :: ([String]) - _hdOimportBlocks :: PP_Doc - _hdOisDeclOfLet :: Bool - _hdOmainFile :: String - _hdOmainName :: String - _hdOmoduleHeader :: (String -> String -> String -> Bool -> String) - _hdOnested :: Bool - _hdOoptions :: Options - _hdOoptionsLine :: String - _hdOpragmaBlocks :: String - _hdOtextBlocks :: PP_Doc - _tlOimportBlocks :: PP_Doc - _tlOisDeclOfLet :: Bool - _tlOmainFile :: String - _tlOmainName :: String - _tlOmoduleHeader :: (String -> String -> String -> Bool -> String) - _tlOnested :: Bool - _tlOoptions :: Options - _tlOoptionsLine :: String - _tlOpragmaBlocks :: String - _tlOtextBlocks :: PP_Doc - _hdIappendCommon :: ([[PP_Doc]]) - _hdIappendMain :: ([[PP_Doc]]) - _hdIgenSems :: (IO ()) - _hdIimports :: ([String]) - _hdIpps :: PP_Docs - _tlIappendCommon :: ([[PP_Doc]]) - _tlIappendMain :: ([[PP_Doc]]) - _tlIgenSems :: (IO ()) - _tlIimports :: ([String]) - _tlIpps :: PP_Docs - -- "PrintCode.ag"(line 75, column 10) - _lhsOpps = - _hdIpps ++ _tlIpps - -- use rule "PrintCode.ag"(line 385, column 50) - _lhsOappendCommon = - _hdIappendCommon ++ _tlIappendCommon - -- use rule "PrintCode.ag"(line 385, column 50) - _lhsOappendMain = - _hdIappendMain ++ _tlIappendMain - -- use rule "PrintCode.ag"(line 400, column 33) - _lhsOgenSems = - _hdIgenSems >> _tlIgenSems - -- use rule "PrintCode.ag"(line 380, column 33) - _lhsOimports = - _hdIimports ++ _tlIimports - -- copy rule (down) - _hdOimportBlocks = - _lhsIimportBlocks - -- copy rule (down) - _hdOisDeclOfLet = - _lhsIisDeclOfLet - -- copy rule (down) - _hdOmainFile = - _lhsImainFile - -- copy rule (down) - _hdOmainName = - _lhsImainName - -- copy rule (down) - _hdOmoduleHeader = - _lhsImoduleHeader - -- copy rule (down) - _hdOnested = - _lhsInested - -- copy rule (down) - _hdOoptions = - _lhsIoptions - -- copy rule (down) - _hdOoptionsLine = - _lhsIoptionsLine - -- copy rule (down) - _hdOpragmaBlocks = - _lhsIpragmaBlocks - -- copy rule (down) - _hdOtextBlocks = - _lhsItextBlocks - -- copy rule (down) - _tlOimportBlocks = - _lhsIimportBlocks - -- copy rule (down) - _tlOisDeclOfLet = - _lhsIisDeclOfLet - -- copy rule (down) - _tlOmainFile = - _lhsImainFile - -- copy rule (down) - _tlOmainName = - _lhsImainName - -- copy rule (down) - _tlOmoduleHeader = - _lhsImoduleHeader - -- copy rule (down) - _tlOnested = - _lhsInested - -- copy rule (down) - _tlOoptions = - _lhsIoptions - -- copy rule (down) - _tlOoptionsLine = - _lhsIoptionsLine - -- copy rule (down) - _tlOpragmaBlocks = - _lhsIpragmaBlocks - -- copy rule (down) - _tlOtextBlocks = - _lhsItextBlocks - ( _hdIappendCommon,_hdIappendMain,_hdIgenSems,_hdIimports,_hdIpps) = - (hd_ _hdOimportBlocks _hdOisDeclOfLet _hdOmainFile _hdOmainName _hdOmoduleHeader _hdOnested _hdOoptions _hdOoptionsLine _hdOpragmaBlocks _hdOtextBlocks) - ( _tlIappendCommon,_tlIappendMain,_tlIgenSems,_tlIimports,_tlIpps) = - (tl_ _tlOimportBlocks _tlOisDeclOfLet _tlOmainFile _tlOmainName _tlOmoduleHeader _tlOnested _tlOoptions _tlOoptionsLine _tlOpragmaBlocks _tlOtextBlocks) - in ( _lhsOappendCommon,_lhsOappendMain,_lhsOgenSems,_lhsOimports,_lhsOpps)))) -sem_Chunks_Nil :: T_Chunks -sem_Chunks_Nil = - (T_Chunks (\ _lhsIimportBlocks - _lhsIisDeclOfLet - _lhsImainFile - _lhsImainName - _lhsImoduleHeader - _lhsInested - _lhsIoptions - _lhsIoptionsLine - _lhsIpragmaBlocks - _lhsItextBlocks -> - (let _lhsOpps :: PP_Docs - _lhsOappendCommon :: ([[PP_Doc]]) - _lhsOappendMain :: ([[PP_Doc]]) - _lhsOgenSems :: (IO ()) - _lhsOimports :: ([String]) - -- "PrintCode.ag"(line 76, column 10) - _lhsOpps = - [] - -- use rule "PrintCode.ag"(line 385, column 50) - _lhsOappendCommon = - [] - -- use rule "PrintCode.ag"(line 385, column 50) - _lhsOappendMain = - [] - -- use rule "PrintCode.ag"(line 400, column 33) - _lhsOgenSems = - return () - -- use rule "PrintCode.ag"(line 380, column 33) - _lhsOimports = - [] - in ( _lhsOappendCommon,_lhsOappendMain,_lhsOgenSems,_lhsOimports,_lhsOpps)))) --- DataAlt ----------------------------------------------------- -{- - visit 0: - inherited attributes: - nested : Bool - strictPre : PP_Doc - synthesized attribute: - pp : PP_Doc - alternatives: - alternative DataAlt: - child name : {String} - child args : {[String]} - alternative Record: - child name : {String} - child args : {[(String,String)]} --} --- cata -sem_DataAlt :: DataAlt -> - T_DataAlt -sem_DataAlt (DataAlt _name _args) = - (sem_DataAlt_DataAlt _name _args) -sem_DataAlt (Record _name _args) = - (sem_DataAlt_Record _name _args) --- semantic domain -newtype T_DataAlt = T_DataAlt (Bool -> - PP_Doc -> - ( PP_Doc)) -data Inh_DataAlt = Inh_DataAlt {nested_Inh_DataAlt :: Bool,strictPre_Inh_DataAlt :: PP_Doc} -data Syn_DataAlt = Syn_DataAlt {pp_Syn_DataAlt :: PP_Doc} -wrap_DataAlt (T_DataAlt sem) (Inh_DataAlt _lhsInested _lhsIstrictPre) = - (let ( _lhsOpp) = - (sem _lhsInested _lhsIstrictPre) - in (Syn_DataAlt _lhsOpp)) -sem_DataAlt_DataAlt :: String -> - ([String]) -> - T_DataAlt -sem_DataAlt_DataAlt name_ args_ = - (T_DataAlt (\ _lhsInested - _lhsIstrictPre -> - (let _lhsOpp :: PP_Doc - -- "PrintCode.ag"(line 153, column 16) - _lhsOpp = - name_ >#< hv_sp (map ((_lhsIstrictPre >|<) . pp_parens . text) args_) - in ( _lhsOpp)))) -sem_DataAlt_Record :: String -> - ([(String,String)]) -> - T_DataAlt -sem_DataAlt_Record name_ args_ = - (T_DataAlt (\ _lhsInested - _lhsIstrictPre -> - (let _lhsOpp :: PP_Doc - -- "PrintCode.ag"(line 154, column 16) - _lhsOpp = - name_ >#< pp_block "{" "}" "," - [ f >#< "::" >#< t | (f,t) <- args_ ] - in ( _lhsOpp)))) --- DataAlts ---------------------------------------------------- -{- - visit 0: - inherited attributes: - nested : Bool - strictPre : PP_Doc - synthesized attribute: - pps : PP_Docs - alternatives: - alternative Cons: - child hd : DataAlt - child tl : DataAlts - alternative Nil: --} --- cata -sem_DataAlts :: DataAlts -> - T_DataAlts -sem_DataAlts list = - (Prelude.foldr sem_DataAlts_Cons sem_DataAlts_Nil (Prelude.map sem_DataAlt list)) --- semantic domain -newtype T_DataAlts = T_DataAlts (Bool -> - PP_Doc -> - ( PP_Docs)) -data Inh_DataAlts = Inh_DataAlts {nested_Inh_DataAlts :: Bool,strictPre_Inh_DataAlts :: PP_Doc} -data Syn_DataAlts = Syn_DataAlts {pps_Syn_DataAlts :: PP_Docs} -wrap_DataAlts (T_DataAlts sem) (Inh_DataAlts _lhsInested _lhsIstrictPre) = - (let ( _lhsOpps) = - (sem _lhsInested _lhsIstrictPre) - in (Syn_DataAlts _lhsOpps)) -sem_DataAlts_Cons :: T_DataAlt -> - T_DataAlts -> - T_DataAlts -sem_DataAlts_Cons (T_DataAlt hd_) (T_DataAlts tl_) = - (T_DataAlts (\ _lhsInested - _lhsIstrictPre -> - (let _lhsOpps :: PP_Docs - _hdOnested :: Bool - _hdOstrictPre :: PP_Doc - _tlOnested :: Bool - _tlOstrictPre :: PP_Doc - _hdIpp :: PP_Doc - _tlIpps :: PP_Docs - -- "PrintCode.ag"(line 63, column 10) - _lhsOpps = - _hdIpp : _tlIpps - -- copy rule (down) - _hdOnested = - _lhsInested - -- copy rule (down) - _hdOstrictPre = - _lhsIstrictPre - -- copy rule (down) - _tlOnested = - _lhsInested - -- copy rule (down) - _tlOstrictPre = - _lhsIstrictPre - ( _hdIpp) = - (hd_ _hdOnested _hdOstrictPre) - ( _tlIpps) = - (tl_ _tlOnested _tlOstrictPre) - in ( _lhsOpps)))) -sem_DataAlts_Nil :: T_DataAlts -sem_DataAlts_Nil = - (T_DataAlts (\ _lhsInested - _lhsIstrictPre -> - (let _lhsOpps :: PP_Docs - -- "PrintCode.ag"(line 64, column 10) - _lhsOpps = - [] - in ( _lhsOpps)))) --- Decl -------------------------------------------------------- -{- - visit 0: - inherited attributes: - isDeclOfLet : Bool - nested : Bool - options : Options - outputfile : String - synthesized attribute: - pp : PP_Doc - alternatives: - alternative Comment: - child txt : {String} - alternative Data: - child name : {String} - child params : {[String]} - child alts : DataAlts - child strict : {Bool} - child derivings : {[String]} - alternative Decl: - child left : Lhs - child rhs : Expr - child binds : {Set String} - child uses : {Set String} - alternative NewType: - child name : {String} - child params : {[String]} - child con : {String} - child tp : Type - alternative PragmaDecl: - child txt : {String} - alternative TSig: - child name : {String} - child tp : Type - alternative Type: - child name : {String} - child params : {[String]} - child tp : Type --} --- cata -sem_Decl :: Decl -> - T_Decl -sem_Decl (Comment _txt) = - (sem_Decl_Comment _txt) -sem_Decl (Data _name _params _alts _strict _derivings) = - (sem_Decl_Data _name _params (sem_DataAlts _alts) _strict _derivings) -sem_Decl (Decl _left _rhs _binds _uses) = - (sem_Decl_Decl (sem_Lhs _left) (sem_Expr _rhs) _binds _uses) -sem_Decl (NewType _name _params _con _tp) = - (sem_Decl_NewType _name _params _con (sem_Type _tp)) -sem_Decl (PragmaDecl _txt) = - (sem_Decl_PragmaDecl _txt) -sem_Decl (TSig _name _tp) = - (sem_Decl_TSig _name (sem_Type _tp)) -sem_Decl (Type _name _params _tp) = - (sem_Decl_Type _name _params (sem_Type _tp)) --- semantic domain -newtype T_Decl = T_Decl (Bool -> - Bool -> - Options -> - String -> - ( PP_Doc)) -data Inh_Decl = Inh_Decl {isDeclOfLet_Inh_Decl :: Bool,nested_Inh_Decl :: Bool,options_Inh_Decl :: Options,outputfile_Inh_Decl :: String} -data Syn_Decl = Syn_Decl {pp_Syn_Decl :: PP_Doc} -wrap_Decl (T_Decl sem) (Inh_Decl _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) = - (let ( _lhsOpp) = - (sem _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) - in (Syn_Decl _lhsOpp)) -sem_Decl_Comment :: String -> - T_Decl -sem_Decl_Comment txt_ = - (T_Decl (\ _lhsIisDeclOfLet - _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpp :: PP_Doc - -- "PrintCode.ag"(line 106, column 16) - _lhsOpp = - if '\n' `elem` txt_ - then "{-" >-< vlist (lines txt_) >-< "-}" - else "--" >#< txt_ - in ( _lhsOpp)))) -sem_Decl_Data :: String -> - ([String]) -> - T_DataAlts -> - Bool -> - ([String]) -> - T_Decl -sem_Decl_Data name_ params_ (T_DataAlts alts_) strict_ derivings_ = - (T_Decl (\ _lhsIisDeclOfLet - _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpp :: PP_Doc - _altsOstrictPre :: PP_Doc - _altsOnested :: Bool - _altsIpps :: PP_Docs - -- "PrintCode.ag"(line 94, column 16) - _lhsOpp = - "data" >#< hv_sp (name_ : params_) - >#< ( case _altsIpps of - [] -> empty - (x:xs) -> "=" >#< x - >-< vlist (map ("|" >#<) xs) - >-< if null derivings_ - then empty - else "deriving" >#< ppTuple False (map text derivings_) - ) - -- "PrintCode.ag"(line 228, column 10) - _altsOstrictPre = - if strict_ then pp "!" else empty - -- copy rule (down) - _altsOnested = - _lhsInested - ( _altsIpps) = - (alts_ _altsOnested _altsOstrictPre) - in ( _lhsOpp)))) -sem_Decl_Decl :: T_Lhs -> - T_Expr -> - (Set String) -> - (Set String) -> - T_Decl -sem_Decl_Decl (T_Lhs left_) (T_Expr rhs_) binds_ uses_ = - (T_Decl (\ _lhsIisDeclOfLet - _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpp :: PP_Doc - _leftOisDeclOfLet :: Bool - _leftOnested :: Bool - _leftOoptions :: Options - _leftOoutputfile :: String - _rhsOnested :: Bool - _rhsOoptions :: Options - _rhsOoutputfile :: String - _leftIpp :: PP_Doc - _rhsIpp :: PP_Doc - -- "PrintCode.ag"(line 92, column 16) - _lhsOpp = - _leftIpp >#< "=" - >-< indent 4 _rhsIpp - -- copy rule (down) - _leftOisDeclOfLet = - _lhsIisDeclOfLet - -- copy rule (down) - _leftOnested = - _lhsInested - -- copy rule (down) - _leftOoptions = - _lhsIoptions - -- copy rule (down) - _leftOoutputfile = - _lhsIoutputfile - -- copy rule (down) - _rhsOnested = - _lhsInested - -- copy rule (down) - _rhsOoptions = - _lhsIoptions - -- copy rule (down) - _rhsOoutputfile = - _lhsIoutputfile - ( _leftIpp) = - (left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile) - ( _rhsIpp) = - (rhs_ _rhsOnested _rhsOoptions _rhsOoutputfile) - in ( _lhsOpp)))) -sem_Decl_NewType :: String -> - ([String]) -> - String -> - T_Type -> - T_Decl -sem_Decl_NewType name_ params_ con_ (T_Type tp_) = - (T_Decl (\ _lhsIisDeclOfLet - _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpp :: PP_Doc - _tpOnested :: Bool - _tpIpp :: PP_Doc - _tpIprec :: Int - -- "PrintCode.ag"(line 103, column 16) - _lhsOpp = - "newtype" >#< hv_sp (name_ : params_) >#< "=" >#< con_ >#< pp_parens _tpIpp - -- copy rule (down) - _tpOnested = - _lhsInested - ( _tpIpp,_tpIprec) = - (tp_ _tpOnested) - in ( _lhsOpp)))) -sem_Decl_PragmaDecl :: String -> - T_Decl -sem_Decl_PragmaDecl txt_ = - (T_Decl (\ _lhsIisDeclOfLet - _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpp :: PP_Doc - -- "PrintCode.ag"(line 109, column 16) - _lhsOpp = - "{-#" >#< text txt_ >#< "#-}" - in ( _lhsOpp)))) -sem_Decl_TSig :: String -> - T_Type -> - T_Decl -sem_Decl_TSig name_ (T_Type tp_) = - (T_Decl (\ _lhsIisDeclOfLet - _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpp :: PP_Doc - _tpOnested :: Bool - _tpIpp :: PP_Doc - _tpIprec :: Int - -- "PrintCode.ag"(line 105, column 16) - _lhsOpp = - name_ >#< "::" >#< _tpIpp - -- copy rule (down) - _tpOnested = - _lhsInested - ( _tpIpp,_tpIprec) = - (tp_ _tpOnested) - in ( _lhsOpp)))) -sem_Decl_Type :: String -> - ([String]) -> - T_Type -> - T_Decl -sem_Decl_Type name_ params_ (T_Type tp_) = - (T_Decl (\ _lhsIisDeclOfLet - _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpp :: PP_Doc - _tpOnested :: Bool - _tpIpp :: PP_Doc - _tpIprec :: Int - -- "PrintCode.ag"(line 104, column 16) - _lhsOpp = - "type" >#< hv_sp (name_ : params_) >#< "=" >#< _tpIpp - -- copy rule (down) - _tpOnested = - _lhsInested - ( _tpIpp,_tpIprec) = - (tp_ _tpOnested) - in ( _lhsOpp)))) --- Decls ------------------------------------------------------- -{- - visit 0: - inherited attributes: - isDeclOfLet : Bool - nested : Bool - options : Options - outputfile : String - synthesized attribute: - pps : PP_Docs - alternatives: - alternative Cons: - child hd : Decl - child tl : Decls - alternative Nil: --} --- cata -sem_Decls :: Decls -> - T_Decls -sem_Decls list = - (Prelude.foldr sem_Decls_Cons sem_Decls_Nil (Prelude.map sem_Decl list)) --- semantic domain -newtype T_Decls = T_Decls (Bool -> - Bool -> - Options -> - String -> - ( PP_Docs)) -data Inh_Decls = Inh_Decls {isDeclOfLet_Inh_Decls :: Bool,nested_Inh_Decls :: Bool,options_Inh_Decls :: Options,outputfile_Inh_Decls :: String} -data Syn_Decls = Syn_Decls {pps_Syn_Decls :: PP_Docs} -wrap_Decls (T_Decls sem) (Inh_Decls _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) = - (let ( _lhsOpps) = - (sem _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) - in (Syn_Decls _lhsOpps)) -sem_Decls_Cons :: T_Decl -> - T_Decls -> - T_Decls -sem_Decls_Cons (T_Decl hd_) (T_Decls tl_) = - (T_Decls (\ _lhsIisDeclOfLet - _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpps :: PP_Docs - _hdOisDeclOfLet :: Bool - _hdOnested :: Bool - _hdOoptions :: Options - _hdOoutputfile :: String - _tlOisDeclOfLet :: Bool - _tlOnested :: Bool - _tlOoptions :: Options - _tlOoutputfile :: String - _hdIpp :: PP_Doc - _tlIpps :: PP_Docs - -- "PrintCode.ag"(line 71, column 10) - _lhsOpps = - _hdIpp : _tlIpps - -- copy rule (down) - _hdOisDeclOfLet = - _lhsIisDeclOfLet - -- copy rule (down) - _hdOnested = - _lhsInested - -- copy rule (down) - _hdOoptions = - _lhsIoptions - -- copy rule (down) - _hdOoutputfile = - _lhsIoutputfile - -- copy rule (down) - _tlOisDeclOfLet = - _lhsIisDeclOfLet - -- copy rule (down) - _tlOnested = - _lhsInested - -- copy rule (down) - _tlOoptions = - _lhsIoptions - -- copy rule (down) - _tlOoutputfile = - _lhsIoutputfile - ( _hdIpp) = - (hd_ _hdOisDeclOfLet _hdOnested _hdOoptions _hdOoutputfile) - ( _tlIpps) = - (tl_ _tlOisDeclOfLet _tlOnested _tlOoptions _tlOoutputfile) - in ( _lhsOpps)))) -sem_Decls_Nil :: T_Decls -sem_Decls_Nil = - (T_Decls (\ _lhsIisDeclOfLet - _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpps :: PP_Docs - -- "PrintCode.ag"(line 72, column 10) - _lhsOpps = - [] - in ( _lhsOpps)))) --- Expr -------------------------------------------------------- -{- - visit 0: - inherited attributes: - nested : Bool - options : Options - outputfile : String - synthesized attribute: - pp : PP_Doc - alternatives: - alternative App: - child name : {String} - child args : Exprs - alternative Case: - child expr : Expr - child alts : CaseAlts - alternative Lambda: - child args : Exprs - child body : Expr - visit 0: - local strictParams : _ - local addBang : _ - alternative Let: - child decls : Decls - child body : Expr - alternative LineExpr: - child expr : Expr - alternative PragmaExpr: - child onLeftSide : {Bool} - child onNewLine : {Bool} - child txt : {String} - child expr : Expr - alternative SimpleExpr: - child txt : {String} - alternative TextExpr: - child lns : {[String]} - alternative Trace: - child txt : {String} - child expr : Expr - alternative TupleExpr: - child exprs : Exprs - alternative TypedExpr: - child expr : Expr - child tp : Type - alternative UnboxedTupleExpr: - child exprs : Exprs --} --- cata -sem_Expr :: Expr -> - T_Expr -sem_Expr (App _name _args) = - (sem_Expr_App _name (sem_Exprs _args)) -sem_Expr (Case _expr _alts) = - (sem_Expr_Case (sem_Expr _expr) (sem_CaseAlts _alts)) -sem_Expr (Lambda _args _body) = - (sem_Expr_Lambda (sem_Exprs _args) (sem_Expr _body)) -sem_Expr (Let _decls _body) = - (sem_Expr_Let (sem_Decls _decls) (sem_Expr _body)) -sem_Expr (LineExpr _expr) = - (sem_Expr_LineExpr (sem_Expr _expr)) -sem_Expr (PragmaExpr _onLeftSide _onNewLine _txt _expr) = - (sem_Expr_PragmaExpr _onLeftSide _onNewLine _txt (sem_Expr _expr)) -sem_Expr (SimpleExpr _txt) = - (sem_Expr_SimpleExpr _txt) -sem_Expr (TextExpr _lns) = - (sem_Expr_TextExpr _lns) -sem_Expr (Trace _txt _expr) = - (sem_Expr_Trace _txt (sem_Expr _expr)) -sem_Expr (TupleExpr _exprs) = - (sem_Expr_TupleExpr (sem_Exprs _exprs)) -sem_Expr (TypedExpr _expr _tp) = - (sem_Expr_TypedExpr (sem_Expr _expr) (sem_Type _tp)) -sem_Expr (UnboxedTupleExpr _exprs) = - (sem_Expr_UnboxedTupleExpr (sem_Exprs _exprs)) --- semantic domain -newtype T_Expr = T_Expr (Bool -> - Options -> - String -> - ( PP_Doc)) -data Inh_Expr = Inh_Expr {nested_Inh_Expr :: Bool,options_Inh_Expr :: Options,outputfile_Inh_Expr :: String} -data Syn_Expr = Syn_Expr {pp_Syn_Expr :: PP_Doc} -wrap_Expr (T_Expr sem) (Inh_Expr _lhsInested _lhsIoptions _lhsIoutputfile) = - (let ( _lhsOpp) = - (sem _lhsInested _lhsIoptions _lhsIoutputfile) - in (Syn_Expr _lhsOpp)) -sem_Expr_App :: String -> - T_Exprs -> - T_Expr -sem_Expr_App name_ (T_Exprs args_) = - (T_Expr (\ _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpp :: PP_Doc - _argsOnested :: Bool - _argsOoptions :: Options - _argsOoutputfile :: String - _argsIpps :: PP_Docs - -- "PrintCode.ag"(line 129, column 16) - _lhsOpp = - pp_parens $ name_ >#< hv_sp _argsIpps - -- copy rule (down) - _argsOnested = - _lhsInested - -- copy rule (down) - _argsOoptions = - _lhsIoptions - -- copy rule (down) - _argsOoutputfile = - _lhsIoutputfile - ( _argsIpps) = - (args_ _argsOnested _argsOoptions _argsOoutputfile) - in ( _lhsOpp)))) -sem_Expr_Case :: T_Expr -> - T_CaseAlts -> - T_Expr -sem_Expr_Case (T_Expr expr_) (T_CaseAlts alts_) = - (T_Expr (\ _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpp :: PP_Doc - _exprOnested :: Bool - _exprOoptions :: Options - _exprOoutputfile :: String - _altsOnested :: Bool - _altsOoptions :: Options - _altsOoutputfile :: String - _exprIpp :: PP_Doc - _altsIpps :: PP_Docs - -- "PrintCode.ag"(line 115, column 16) - _lhsOpp = - pp_parens ( "case" >#< pp_parens _exprIpp >#< "of" - >-< (vlist _altsIpps) - ) - -- copy rule (down) - _exprOnested = - _lhsInested - -- copy rule (down) - _exprOoptions = - _lhsIoptions - -- copy rule (down) - _exprOoutputfile = - _lhsIoutputfile - -- copy rule (down) - _altsOnested = - _lhsInested - -- copy rule (down) - _altsOoptions = - _lhsIoptions - -- copy rule (down) - _altsOoutputfile = - _lhsIoutputfile - ( _exprIpp) = - (expr_ _exprOnested _exprOoptions _exprOoutputfile) - ( _altsIpps) = - (alts_ _altsOnested _altsOoptions _altsOoutputfile) - in ( _lhsOpp)))) -sem_Expr_Lambda :: T_Exprs -> - T_Expr -> - T_Expr -sem_Expr_Lambda (T_Exprs args_) (T_Expr body_) = - (T_Expr (\ _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpp :: PP_Doc - _argsOnested :: Bool - _argsOoptions :: Options - _argsOoutputfile :: String - _bodyOnested :: Bool - _bodyOoptions :: Options - _bodyOoutputfile :: String - _argsIpps :: PP_Docs - _bodyIpp :: PP_Doc - -- "PrintCode.ag"(line 118, column 16) - _strictParams = - if strictSems _lhsIoptions - then _argsIpps - else [] - -- "PrintCode.ag"(line 121, column 16) - _addBang = - if bangpats _lhsIoptions - then \p -> pp_parens ("!" >|< p) - else id - -- "PrintCode.ag"(line 124, column 16) - _lhsOpp = - pp_parens ( "\\" >#< (vlist (map _addBang _argsIpps)) >#< "->" - >-< indent 4 (_strictParams `ppMultiSeqV` _bodyIpp) - ) - -- copy rule (down) - _argsOnested = - _lhsInested - -- copy rule (down) - _argsOoptions = - _lhsIoptions - -- copy rule (down) - _argsOoutputfile = - _lhsIoutputfile - -- copy rule (down) - _bodyOnested = - _lhsInested - -- copy rule (down) - _bodyOoptions = - _lhsIoptions - -- copy rule (down) - _bodyOoutputfile = - _lhsIoutputfile - ( _argsIpps) = - (args_ _argsOnested _argsOoptions _argsOoutputfile) - ( _bodyIpp) = - (body_ _bodyOnested _bodyOoptions _bodyOoutputfile) - in ( _lhsOpp)))) -sem_Expr_Let :: T_Decls -> - T_Expr -> - T_Expr -sem_Expr_Let (T_Decls decls_) (T_Expr body_) = - (T_Expr (\ _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpp :: PP_Doc - _declsOisDeclOfLet :: Bool - _declsOnested :: Bool - _declsOoptions :: Options - _declsOoutputfile :: String - _bodyOnested :: Bool - _bodyOoptions :: Options - _bodyOoutputfile :: String - _declsIpps :: PP_Docs - _bodyIpp :: PP_Doc - -- "PrintCode.ag"(line 112, column 16) - _lhsOpp = - pp_parens ( "let" >#< (vlist _declsIpps) - >-< "in " >#< _bodyIpp - ) - -- "PrintCode.ag"(line 322, column 7) - _declsOisDeclOfLet = - True - -- copy rule (down) - _declsOnested = - _lhsInested - -- copy rule (down) - _declsOoptions = - _lhsIoptions - -- copy rule (down) - _declsOoutputfile = - _lhsIoutputfile - -- copy rule (down) - _bodyOnested = - _lhsInested - -- copy rule (down) - _bodyOoptions = - _lhsIoptions - -- copy rule (down) - _bodyOoutputfile = - _lhsIoutputfile - ( _declsIpps) = - (decls_ _declsOisDeclOfLet _declsOnested _declsOoptions _declsOoutputfile) - ( _bodyIpp) = - (body_ _bodyOnested _bodyOoptions _bodyOoutputfile) - in ( _lhsOpp)))) -sem_Expr_LineExpr :: T_Expr -> - T_Expr -sem_Expr_LineExpr (T_Expr expr_) = - (T_Expr (\ _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpp :: PP_Doc - _exprOnested :: Bool - _exprOoptions :: Options - _exprOoutputfile :: String - _exprIpp :: PP_Doc - -- "PrintCode.ag"(line 146, column 16) - _lhsOpp = - _exprIpp >-< "{-# LINE" >#< ppWithLineNr (\n -> pp $ show $ n + 1) >#< show _lhsIoutputfile >#< "#-}" - -- copy rule (down) - _exprOnested = - _lhsInested - -- copy rule (down) - _exprOoptions = - _lhsIoptions - -- copy rule (down) - _exprOoutputfile = - _lhsIoutputfile - ( _exprIpp) = - (expr_ _exprOnested _exprOoptions _exprOoutputfile) - in ( _lhsOpp)))) -sem_Expr_PragmaExpr :: Bool -> - Bool -> - String -> - T_Expr -> - T_Expr -sem_Expr_PragmaExpr onLeftSide_ onNewLine_ txt_ (T_Expr expr_) = - (T_Expr (\ _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpp :: PP_Doc - _exprOnested :: Bool - _exprOoptions :: Options - _exprOoutputfile :: String - _exprIpp :: PP_Doc - -- "PrintCode.ag"(line 135, column 16) - _lhsOpp = - let pragmaDoc = "{-#" >#< txt_ >#< "#-}" - op = if onNewLine_ - then (>-<) - else (>#<) - leftOp x y = if onLeftSide_ - then x `op` y - else y - rightOp x y = if onLeftSide_ - then x - else x `op` y - in pragmaDoc `leftOp` _exprIpp `rightOp` pragmaDoc - -- copy rule (down) - _exprOnested = - _lhsInested - -- copy rule (down) - _exprOoptions = - _lhsIoptions - -- copy rule (down) - _exprOoutputfile = - _lhsIoutputfile - ( _exprIpp) = - (expr_ _exprOnested _exprOoptions _exprOoutputfile) - in ( _lhsOpp)))) -sem_Expr_SimpleExpr :: String -> - T_Expr -sem_Expr_SimpleExpr txt_ = - (T_Expr (\ _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpp :: PP_Doc - -- "PrintCode.ag"(line 130, column 16) - _lhsOpp = - text txt_ - in ( _lhsOpp)))) -sem_Expr_TextExpr :: ([String]) -> - T_Expr -sem_Expr_TextExpr lns_ = - (T_Expr (\ _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpp :: PP_Doc - -- "PrintCode.ag"(line 131, column 16) - _lhsOpp = - vlist (map text lns_) - in ( _lhsOpp)))) -sem_Expr_Trace :: String -> - T_Expr -> - T_Expr -sem_Expr_Trace txt_ (T_Expr expr_) = - (T_Expr (\ _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpp :: PP_Doc - _exprOnested :: Bool - _exprOoptions :: Options - _exprOoutputfile :: String - _exprIpp :: PP_Doc - -- "PrintCode.ag"(line 132, column 16) - _lhsOpp = - "trace" >#< ( pp_parens ("\"" >|< text txt_ >|< "\"") - >-< pp_parens _exprIpp - ) - -- copy rule (down) - _exprOnested = - _lhsInested - -- copy rule (down) - _exprOoptions = - _lhsIoptions - -- copy rule (down) - _exprOoutputfile = - _lhsIoutputfile - ( _exprIpp) = - (expr_ _exprOnested _exprOoptions _exprOoutputfile) - in ( _lhsOpp)))) -sem_Expr_TupleExpr :: T_Exprs -> - T_Expr -sem_Expr_TupleExpr (T_Exprs exprs_) = - (T_Expr (\ _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpp :: PP_Doc - _exprsOnested :: Bool - _exprsOoptions :: Options - _exprsOoutputfile :: String - _exprsIpps :: PP_Docs - -- "PrintCode.ag"(line 127, column 16) - _lhsOpp = - ppTuple _lhsInested _exprsIpps - -- copy rule (down) - _exprsOnested = - _lhsInested - -- copy rule (down) - _exprsOoptions = - _lhsIoptions - -- copy rule (down) - _exprsOoutputfile = - _lhsIoutputfile - ( _exprsIpps) = - (exprs_ _exprsOnested _exprsOoptions _exprsOoutputfile) - in ( _lhsOpp)))) -sem_Expr_TypedExpr :: T_Expr -> - T_Type -> - T_Expr -sem_Expr_TypedExpr (T_Expr expr_) (T_Type tp_) = - (T_Expr (\ _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpp :: PP_Doc - _exprOnested :: Bool - _exprOoptions :: Options - _exprOoutputfile :: String - _tpOnested :: Bool - _exprIpp :: PP_Doc - _tpIpp :: PP_Doc - _tpIprec :: Int - -- "PrintCode.ag"(line 147, column 16) - _lhsOpp = - pp_parens (_exprIpp >#< "::" >#< _tpIpp) - -- copy rule (down) - _exprOnested = - _lhsInested - -- copy rule (down) - _exprOoptions = - _lhsIoptions - -- copy rule (down) - _exprOoutputfile = - _lhsIoutputfile - -- copy rule (down) - _tpOnested = - _lhsInested - ( _exprIpp) = - (expr_ _exprOnested _exprOoptions _exprOoutputfile) - ( _tpIpp,_tpIprec) = - (tp_ _tpOnested) - in ( _lhsOpp)))) -sem_Expr_UnboxedTupleExpr :: T_Exprs -> - T_Expr -sem_Expr_UnboxedTupleExpr (T_Exprs exprs_) = - (T_Expr (\ _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpp :: PP_Doc - _exprsOnested :: Bool - _exprsOoptions :: Options - _exprsOoutputfile :: String - _exprsIpps :: PP_Docs - -- "PrintCode.ag"(line 128, column 23) - _lhsOpp = - ppUnboxedTuple _lhsInested _exprsIpps - -- copy rule (down) - _exprsOnested = - _lhsInested - -- copy rule (down) - _exprsOoptions = - _lhsIoptions - -- copy rule (down) - _exprsOoutputfile = - _lhsIoutputfile - ( _exprsIpps) = - (exprs_ _exprsOnested _exprsOoptions _exprsOoutputfile) - in ( _lhsOpp)))) --- Exprs ------------------------------------------------------- -{- - visit 0: - inherited attributes: - nested : Bool - options : Options - outputfile : String - synthesized attribute: - pps : PP_Docs - alternatives: - alternative Cons: - child hd : Expr - child tl : Exprs - alternative Nil: --} --- cata -sem_Exprs :: Exprs -> - T_Exprs -sem_Exprs list = - (Prelude.foldr sem_Exprs_Cons sem_Exprs_Nil (Prelude.map sem_Expr list)) --- semantic domain -newtype T_Exprs = T_Exprs (Bool -> - Options -> - String -> - ( PP_Docs)) -data Inh_Exprs = Inh_Exprs {nested_Inh_Exprs :: Bool,options_Inh_Exprs :: Options,outputfile_Inh_Exprs :: String} -data Syn_Exprs = Syn_Exprs {pps_Syn_Exprs :: PP_Docs} -wrap_Exprs (T_Exprs sem) (Inh_Exprs _lhsInested _lhsIoptions _lhsIoutputfile) = - (let ( _lhsOpps) = - (sem _lhsInested _lhsIoptions _lhsIoutputfile) - in (Syn_Exprs _lhsOpps)) -sem_Exprs_Cons :: T_Expr -> - T_Exprs -> - T_Exprs -sem_Exprs_Cons (T_Expr hd_) (T_Exprs tl_) = - (T_Exprs (\ _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpps :: PP_Docs - _hdOnested :: Bool - _hdOoptions :: Options - _hdOoutputfile :: String - _tlOnested :: Bool - _tlOoptions :: Options - _tlOoutputfile :: String - _hdIpp :: PP_Doc - _tlIpps :: PP_Docs - -- "PrintCode.ag"(line 55, column 10) - _lhsOpps = - _hdIpp : _tlIpps - -- copy rule (down) - _hdOnested = - _lhsInested - -- copy rule (down) - _hdOoptions = - _lhsIoptions - -- copy rule (down) - _hdOoutputfile = - _lhsIoutputfile - -- copy rule (down) - _tlOnested = - _lhsInested - -- copy rule (down) - _tlOoptions = - _lhsIoptions - -- copy rule (down) - _tlOoutputfile = - _lhsIoutputfile - ( _hdIpp) = - (hd_ _hdOnested _hdOoptions _hdOoutputfile) - ( _tlIpps) = - (tl_ _tlOnested _tlOoptions _tlOoutputfile) - in ( _lhsOpps)))) -sem_Exprs_Nil :: T_Exprs -sem_Exprs_Nil = - (T_Exprs (\ _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpps :: PP_Docs - -- "PrintCode.ag"(line 56, column 10) - _lhsOpps = - [] - in ( _lhsOpps)))) --- Lhs --------------------------------------------------------- -{- - visit 0: - inherited attributes: - isDeclOfLet : Bool - nested : Bool - options : Options - outputfile : String - synthesized attribute: - pp : PP_Doc - alternatives: - alternative Fun: - child name : {String} - child args : Exprs - visit 0: - local addStrictGuard : _ - local hasStrictVars : _ - local strictGuard : _ - local addBang : _ - alternative Pattern3: - child pat3 : Pattern - visit 0: - local addStrictGuard : _ - local strictGuard : _ - local hasStrictVars : _ - alternative Pattern3SM: - child pat3 : Pattern - alternative TupleLhs: - child comps : {[String]} - visit 0: - local addStrictGuard : _ - local strictGuard : _ - local hasStrictVars : _ - local addBang : _ - alternative UnboxedTupleLhs: - child comps : {[String]} - visit 0: - local addStrictGuard : _ - local strictGuard : _ - local hasStrictVars : _ - local addBang : _ --} --- cata -sem_Lhs :: Lhs -> - T_Lhs -sem_Lhs (Fun _name _args) = - (sem_Lhs_Fun _name (sem_Exprs _args)) -sem_Lhs (Pattern3 _pat3) = - (sem_Lhs_Pattern3 (sem_Pattern _pat3)) -sem_Lhs (Pattern3SM _pat3) = - (sem_Lhs_Pattern3SM (sem_Pattern _pat3)) -sem_Lhs (TupleLhs _comps) = - (sem_Lhs_TupleLhs _comps) -sem_Lhs (UnboxedTupleLhs _comps) = - (sem_Lhs_UnboxedTupleLhs _comps) --- semantic domain -newtype T_Lhs = T_Lhs (Bool -> - Bool -> - Options -> - String -> - ( PP_Doc)) -data Inh_Lhs = Inh_Lhs {isDeclOfLet_Inh_Lhs :: Bool,nested_Inh_Lhs :: Bool,options_Inh_Lhs :: Options,outputfile_Inh_Lhs :: String} -data Syn_Lhs = Syn_Lhs {pp_Syn_Lhs :: PP_Doc} -wrap_Lhs (T_Lhs sem) (Inh_Lhs _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) = - (let ( _lhsOpp) = - (sem _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) - in (Syn_Lhs _lhsOpp)) -sem_Lhs_Fun :: String -> - T_Exprs -> - T_Lhs -sem_Lhs_Fun name_ (T_Exprs args_) = - (T_Lhs (\ _lhsIisDeclOfLet - _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpp :: PP_Doc - _argsOnested :: Bool - _argsOoptions :: Options - _argsOoutputfile :: String - _argsIpps :: PP_Docs - -- "PrintCode.ag"(line 169, column 7) - _addStrictGuard = - if strictSems _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id - -- "PrintCode.ag"(line 170, column 7) - _hasStrictVars = - not (null _argsIpps) - -- "PrintCode.ag"(line 171, column 7) - _strictGuard = - _argsIpps `ppMultiSeqH` (pp "True") - -- "PrintCode.ag"(line 174, column 7) - _addBang = - if bangpats _lhsIoptions - then \p -> "!" >|< p - else id - -- "PrintCode.ag"(line 182, column 16) - _lhsOpp = - _addStrictGuard (name_ >#< hv_sp (map _addBang _argsIpps)) - -- copy rule (down) - _argsOnested = - _lhsInested - -- copy rule (down) - _argsOoptions = - _lhsIoptions - -- copy rule (down) - _argsOoutputfile = - _lhsIoutputfile - ( _argsIpps) = - (args_ _argsOnested _argsOoptions _argsOoutputfile) - in ( _lhsOpp)))) -sem_Lhs_Pattern3 :: T_Pattern -> - T_Lhs -sem_Lhs_Pattern3 (T_Pattern pat3_) = - (T_Lhs (\ _lhsIisDeclOfLet - _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpp :: PP_Doc - _pat3ObelowIrrefutable :: Bool - _pat3OisDeclOfLet :: Bool - _pat3Ooptions :: Options - _pat3Icopy :: Pattern - _pat3IisUnderscore :: Bool - _pat3Ipp :: PP_Doc - _pat3Ipp' :: PP_Doc - _pat3IstrictVars :: ([PP_Doc]) - -- "PrintCode.ag"(line 158, column 7) - _addStrictGuard = - if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id - -- "PrintCode.ag"(line 160, column 7) - _strictGuard = - _pat3IstrictVars `ppMultiSeqH` (pp "True") - -- "PrintCode.ag"(line 161, column 7) - _hasStrictVars = - not (null _pat3IstrictVars) - -- "PrintCode.ag"(line 178, column 16) - _lhsOpp = - _addStrictGuard _pat3Ipp - -- "PrintCode.ag"(line 288, column 7) - _pat3ObelowIrrefutable = - False - -- copy rule (down) - _pat3OisDeclOfLet = - _lhsIisDeclOfLet - -- copy rule (down) - _pat3Ooptions = - _lhsIoptions - ( _pat3Icopy,_pat3IisUnderscore,_pat3Ipp,_pat3Ipp',_pat3IstrictVars) = - (pat3_ _pat3ObelowIrrefutable _pat3OisDeclOfLet _pat3Ooptions) - in ( _lhsOpp)))) -sem_Lhs_Pattern3SM :: T_Pattern -> - T_Lhs -sem_Lhs_Pattern3SM (T_Pattern pat3_) = - (T_Lhs (\ _lhsIisDeclOfLet - _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpp :: PP_Doc - _pat3ObelowIrrefutable :: Bool - _pat3OisDeclOfLet :: Bool - _pat3Ooptions :: Options - _pat3Icopy :: Pattern - _pat3IisUnderscore :: Bool - _pat3Ipp :: PP_Doc - _pat3Ipp' :: PP_Doc - _pat3IstrictVars :: ([PP_Doc]) - -- "PrintCode.ag"(line 179, column 16) - _lhsOpp = - _pat3Ipp' - -- "PrintCode.ag"(line 288, column 7) - _pat3ObelowIrrefutable = - False - -- copy rule (down) - _pat3OisDeclOfLet = - _lhsIisDeclOfLet - -- copy rule (down) - _pat3Ooptions = - _lhsIoptions - ( _pat3Icopy,_pat3IisUnderscore,_pat3Ipp,_pat3Ipp',_pat3IstrictVars) = - (pat3_ _pat3ObelowIrrefutable _pat3OisDeclOfLet _pat3Ooptions) - in ( _lhsOpp)))) -sem_Lhs_TupleLhs :: ([String]) -> - T_Lhs -sem_Lhs_TupleLhs comps_ = - (T_Lhs (\ _lhsIisDeclOfLet - _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpp :: PP_Doc - -- "PrintCode.ag"(line 158, column 7) - _addStrictGuard = - if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id - -- "PrintCode.ag"(line 163, column 7) - _strictGuard = - if stricterCases _lhsIoptions && not _lhsIisDeclOfLet - then map text comps_ `ppMultiSeqH` (pp "True") - else pp "True" - -- "PrintCode.ag"(line 166, column 7) - _hasStrictVars = - not (null comps_) - -- "PrintCode.ag"(line 174, column 7) - _addBang = - if bangpats _lhsIoptions - then \p -> "!" >|< p - else id - -- "PrintCode.ag"(line 180, column 16) - _lhsOpp = - _addStrictGuard $ ppTuple _lhsInested (map (_addBang . text) comps_) - in ( _lhsOpp)))) -sem_Lhs_UnboxedTupleLhs :: ([String]) -> - T_Lhs -sem_Lhs_UnboxedTupleLhs comps_ = - (T_Lhs (\ _lhsIisDeclOfLet - _lhsInested - _lhsIoptions - _lhsIoutputfile -> - (let _lhsOpp :: PP_Doc - -- "PrintCode.ag"(line 158, column 7) - _addStrictGuard = - if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id - -- "PrintCode.ag"(line 163, column 7) - _strictGuard = - if stricterCases _lhsIoptions && not _lhsIisDeclOfLet - then map text comps_ `ppMultiSeqH` (pp "True") - else pp "True" - -- "PrintCode.ag"(line 166, column 7) - _hasStrictVars = - not (null comps_) - -- "PrintCode.ag"(line 174, column 7) - _addBang = - if bangpats _lhsIoptions - then \p -> "!" >|< p - else id - -- "PrintCode.ag"(line 181, column 23) - _lhsOpp = - _addStrictGuard $ ppUnboxedTuple _lhsInested (map (_addBang . text) comps_) - in ( _lhsOpp)))) --- Pattern ----------------------------------------------------- -{- - visit 0: - inherited attributes: - belowIrrefutable : Bool - isDeclOfLet : Bool - options : Options - synthesized attributes: - copy : SELF - isUnderscore : Bool - pp : PP_Doc - pp' : PP_Doc - strictVars : [PP_Doc] - alternatives: - alternative Alias: - child field : {Identifier} - child attr : {Identifier} - child pat : Pattern - child parts : Patterns - visit 0: - local strictVar : _ - local strictPatVars : _ - local addBang : _ - local ppVar : _ - local ppVarBang : _ - local copy : _ - alternative Constr: - child name : {ConstructorIdent} - child pats : Patterns - visit 0: - local addBang : _ - local copy : _ - alternative Irrefutable: - child pat : Pattern - visit 0: - local copy : _ - alternative Product: - child pos : {Pos} - child pats : Patterns - visit 0: - local addBang : _ - local copy : _ - alternative Underscore: - child pos : {Pos} - visit 0: - local copy : _ --} --- 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 (Bool -> - Bool -> - Options -> - ( Pattern,Bool,PP_Doc,PP_Doc,([PP_Doc]))) -data Inh_Pattern = Inh_Pattern {belowIrrefutable_Inh_Pattern :: Bool,isDeclOfLet_Inh_Pattern :: Bool,options_Inh_Pattern :: Options} -data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern,isUnderscore_Syn_Pattern :: Bool,pp_Syn_Pattern :: PP_Doc,pp'_Syn_Pattern :: PP_Doc,strictVars_Syn_Pattern :: [PP_Doc]} -wrap_Pattern (T_Pattern sem) (Inh_Pattern _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) = - (let ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars) = - (sem _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) - in (Syn_Pattern _lhsOcopy _lhsOisUnderscore _lhsOpp _lhsOpp' _lhsOstrictVars)) -sem_Pattern_Alias :: Identifier -> - Identifier -> - T_Pattern -> - T_Patterns -> - T_Pattern -sem_Pattern_Alias field_ attr_ (T_Pattern pat_) (T_Patterns parts_) = - (T_Pattern (\ _lhsIbelowIrrefutable - _lhsIisDeclOfLet - _lhsIoptions -> - (let _lhsOstrictVars :: ([PP_Doc]) - _lhsOpp :: PP_Doc - _lhsOisUnderscore :: Bool - _lhsOpp' :: PP_Doc - _lhsOcopy :: Pattern - _patObelowIrrefutable :: Bool - _patOisDeclOfLet :: Bool - _patOoptions :: Options - _partsObelowIrrefutable :: Bool - _partsOisDeclOfLet :: Bool - _partsOoptions :: Options - _patIcopy :: Pattern - _patIisUnderscore :: Bool - _patIpp :: PP_Doc - _patIpp' :: PP_Doc - _patIstrictVars :: ([PP_Doc]) - _partsIcopy :: Patterns - _partsIpps :: ([PP_Doc]) - _partsIpps' :: ([PP_Doc]) - _partsIstrictVars :: ([PP_Doc]) - -- "PrintCode.ag"(line 237, column 7) - _strictVar = - if strictCases _lhsIoptions && not _lhsIisDeclOfLet - then [_ppVar ] - else [] - -- "PrintCode.ag"(line 241, column 7) - _strictPatVars = - if stricterCases _lhsIoptions && not _lhsIisDeclOfLet - then _patIstrictVars - else [] - -- "PrintCode.ag"(line 245, column 7) - _lhsOstrictVars = - _strictVar ++ _strictPatVars - -- "PrintCode.ag"(line 260, column 7) - _addBang = - if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable - then \p -> "!" >|< p - else id - -- "PrintCode.ag"(line 267, column 13) - _ppVar = - pp (attrname False field_ attr_) - -- "PrintCode.ag"(line 268, column 13) - _ppVarBang = - _addBang $ _ppVar - -- "PrintCode.ag"(line 269, column 13) - _lhsOpp = - if _patIisUnderscore - then _ppVarBang - else _ppVarBang >|< "@" >|< _patIpp - -- "PrintCode.ag"(line 278, column 16) - _lhsOisUnderscore = - False - -- "PrintCode.ag"(line 301, column 13) - _lhsOpp' = - let attribute | field_ == _LOC || field_ == nullIdent = locname' attr_ - | otherwise = attrname False field_ attr_ - in attribute >|< "@" >|< _patIpp' - -- self rule - _copy = - Alias field_ attr_ _patIcopy _partsIcopy - -- self rule - _lhsOcopy = - _copy - -- copy rule (down) - _patObelowIrrefutable = - _lhsIbelowIrrefutable - -- copy rule (down) - _patOisDeclOfLet = - _lhsIisDeclOfLet - -- copy rule (down) - _patOoptions = - _lhsIoptions - -- copy rule (down) - _partsObelowIrrefutable = - _lhsIbelowIrrefutable - -- copy rule (down) - _partsOisDeclOfLet = - _lhsIisDeclOfLet - -- copy rule (down) - _partsOoptions = - _lhsIoptions - ( _patIcopy,_patIisUnderscore,_patIpp,_patIpp',_patIstrictVars) = - (pat_ _patObelowIrrefutable _patOisDeclOfLet _patOoptions) - ( _partsIcopy,_partsIpps,_partsIpps',_partsIstrictVars) = - (parts_ _partsObelowIrrefutable _partsOisDeclOfLet _partsOoptions) - in ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars)))) -sem_Pattern_Constr :: ConstructorIdent -> - T_Patterns -> - T_Pattern -sem_Pattern_Constr name_ (T_Patterns pats_) = - (T_Pattern (\ _lhsIbelowIrrefutable - _lhsIisDeclOfLet - _lhsIoptions -> - (let _lhsOpp :: PP_Doc - _lhsOisUnderscore :: Bool - _lhsOpp' :: PP_Doc - _lhsOstrictVars :: ([PP_Doc]) - _lhsOcopy :: Pattern - _patsObelowIrrefutable :: Bool - _patsOisDeclOfLet :: Bool - _patsOoptions :: Options - _patsIcopy :: Patterns - _patsIpps :: ([PP_Doc]) - _patsIpps' :: ([PP_Doc]) - _patsIstrictVars :: ([PP_Doc]) - -- "PrintCode.ag"(line 260, column 7) - _addBang = - if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable - then \p -> "!" >|< p - else id - -- "PrintCode.ag"(line 265, column 13) - _lhsOpp = - _addBang $ pp_parens $ name_ >#< hv_sp _patsIpps - -- "PrintCode.ag"(line 276, column 16) - _lhsOisUnderscore = - False - -- "PrintCode.ag"(line 299, column 13) - _lhsOpp' = - pp_parens $ name_ >#< hv_sp (map pp_parens _patsIpps') - -- use rule "PrintCode.ag"(line 234, column 40) - _lhsOstrictVars = - _patsIstrictVars - -- self rule - _copy = - Constr name_ _patsIcopy - -- self rule - _lhsOcopy = - _copy - -- copy rule (down) - _patsObelowIrrefutable = - _lhsIbelowIrrefutable - -- copy rule (down) - _patsOisDeclOfLet = - _lhsIisDeclOfLet - -- copy rule (down) - _patsOoptions = - _lhsIoptions - ( _patsIcopy,_patsIpps,_patsIpps',_patsIstrictVars) = - (pats_ _patsObelowIrrefutable _patsOisDeclOfLet _patsOoptions) - in ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars)))) -sem_Pattern_Irrefutable :: T_Pattern -> - T_Pattern -sem_Pattern_Irrefutable (T_Pattern pat_) = - (T_Pattern (\ _lhsIbelowIrrefutable - _lhsIisDeclOfLet - _lhsIoptions -> - (let _lhsOstrictVars :: ([PP_Doc]) - _lhsOpp :: PP_Doc - _patObelowIrrefutable :: Bool - _lhsOpp' :: PP_Doc - _lhsOcopy :: Pattern - _lhsOisUnderscore :: Bool - _patOisDeclOfLet :: Bool - _patOoptions :: Options - _patIcopy :: Pattern - _patIisUnderscore :: Bool - _patIpp :: PP_Doc - _patIpp' :: PP_Doc - _patIstrictVars :: ([PP_Doc]) - -- "PrintCode.ag"(line 248, column 7) - _lhsOstrictVars = - [] - -- "PrintCode.ag"(line 272, column 17) - _lhsOpp = - text "~" >|< pp_parens _patIpp - -- "PrintCode.ag"(line 284, column 7) - _patObelowIrrefutable = - True - -- "PrintCode.ag"(line 304, column 17) - _lhsOpp' = - text "~" >|< pp_parens _patIpp - -- self rule - _copy = - Irrefutable _patIcopy - -- self rule - _lhsOcopy = - _copy - -- copy rule (up) - _lhsOisUnderscore = - _patIisUnderscore - -- copy rule (down) - _patOisDeclOfLet = - _lhsIisDeclOfLet - -- copy rule (down) - _patOoptions = - _lhsIoptions - ( _patIcopy,_patIisUnderscore,_patIpp,_patIpp',_patIstrictVars) = - (pat_ _patObelowIrrefutable _patOisDeclOfLet _patOoptions) - in ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars)))) -sem_Pattern_Product :: Pos -> - T_Patterns -> - T_Pattern -sem_Pattern_Product pos_ (T_Patterns pats_) = - (T_Pattern (\ _lhsIbelowIrrefutable - _lhsIisDeclOfLet - _lhsIoptions -> - (let _lhsOpp :: PP_Doc - _lhsOisUnderscore :: Bool - _lhsOpp' :: PP_Doc - _lhsOstrictVars :: ([PP_Doc]) - _lhsOcopy :: Pattern - _patsObelowIrrefutable :: Bool - _patsOisDeclOfLet :: Bool - _patsOoptions :: Options - _patsIcopy :: Patterns - _patsIpps :: ([PP_Doc]) - _patsIpps' :: ([PP_Doc]) - _patsIstrictVars :: ([PP_Doc]) - -- "PrintCode.ag"(line 260, column 7) - _addBang = - if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable - then \p -> "!" >|< p - else id - -- "PrintCode.ag"(line 266, column 13) - _lhsOpp = - _addBang $ pp_block "(" ")" "," _patsIpps - -- "PrintCode.ag"(line 277, column 16) - _lhsOisUnderscore = - False - -- "PrintCode.ag"(line 300, column 13) - _lhsOpp' = - pp_block "(" ")" "," _patsIpps' - -- use rule "PrintCode.ag"(line 234, column 40) - _lhsOstrictVars = - _patsIstrictVars - -- self rule - _copy = - Product pos_ _patsIcopy - -- self rule - _lhsOcopy = - _copy - -- copy rule (down) - _patsObelowIrrefutable = - _lhsIbelowIrrefutable - -- copy rule (down) - _patsOisDeclOfLet = - _lhsIisDeclOfLet - -- copy rule (down) - _patsOoptions = - _lhsIoptions - ( _patsIcopy,_patsIpps,_patsIpps',_patsIstrictVars) = - (pats_ _patsObelowIrrefutable _patsOisDeclOfLet _patsOoptions) - in ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars)))) -sem_Pattern_Underscore :: Pos -> - T_Pattern -sem_Pattern_Underscore pos_ = - (T_Pattern (\ _lhsIbelowIrrefutable - _lhsIisDeclOfLet - _lhsIoptions -> - (let _lhsOpp :: PP_Doc - _lhsOisUnderscore :: Bool - _lhsOpp' :: PP_Doc - _lhsOstrictVars :: ([PP_Doc]) - _lhsOcopy :: Pattern - -- "PrintCode.ag"(line 273, column 16) - _lhsOpp = - text "_" - -- "PrintCode.ag"(line 279, column 16) - _lhsOisUnderscore = - True - -- "PrintCode.ag"(line 305, column 16) - _lhsOpp' = - text "_" - -- use rule "PrintCode.ag"(line 234, column 40) - _lhsOstrictVars = - [] - -- self rule - _copy = - Underscore pos_ - -- self rule - _lhsOcopy = - _copy - in ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars)))) --- Patterns ---------------------------------------------------- -{- - visit 0: - inherited attributes: - belowIrrefutable : Bool - isDeclOfLet : Bool - options : Options - synthesized attributes: - copy : SELF - pps : [PP_Doc] - pps' : [PP_Doc] - strictVars : [PP_Doc] - alternatives: - alternative Cons: - child hd : Pattern - child tl : Patterns - visit 0: - local copy : _ - alternative Nil: - visit 0: - local copy : _ --} --- 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 (Bool -> - Bool -> - Options -> - ( Patterns,([PP_Doc]),([PP_Doc]),([PP_Doc]))) -data Inh_Patterns = Inh_Patterns {belowIrrefutable_Inh_Patterns :: Bool,isDeclOfLet_Inh_Patterns :: Bool,options_Inh_Patterns :: Options} -data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns,pps_Syn_Patterns :: [PP_Doc],pps'_Syn_Patterns :: [PP_Doc],strictVars_Syn_Patterns :: [PP_Doc]} -wrap_Patterns (T_Patterns sem) (Inh_Patterns _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) = - (let ( _lhsOcopy,_lhsOpps,_lhsOpps',_lhsOstrictVars) = - (sem _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) - in (Syn_Patterns _lhsOcopy _lhsOpps _lhsOpps' _lhsOstrictVars)) -sem_Patterns_Cons :: T_Pattern -> - T_Patterns -> - T_Patterns -sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) = - (T_Patterns (\ _lhsIbelowIrrefutable - _lhsIisDeclOfLet - _lhsIoptions -> - (let _lhsOpps :: ([PP_Doc]) - _lhsOpps' :: ([PP_Doc]) - _lhsOstrictVars :: ([PP_Doc]) - _lhsOcopy :: Patterns - _hdObelowIrrefutable :: Bool - _hdOisDeclOfLet :: Bool - _hdOoptions :: Options - _tlObelowIrrefutable :: Bool - _tlOisDeclOfLet :: Bool - _tlOoptions :: Options - _hdIcopy :: Pattern - _hdIisUnderscore :: Bool - _hdIpp :: PP_Doc - _hdIpp' :: PP_Doc - _hdIstrictVars :: ([PP_Doc]) - _tlIcopy :: Patterns - _tlIpps :: ([PP_Doc]) - _tlIpps' :: ([PP_Doc]) - _tlIstrictVars :: ([PP_Doc]) - -- "PrintCode.ag"(line 255, column 10) - _lhsOpps = - _hdIpp : _tlIpps - -- "PrintCode.ag"(line 295, column 10) - _lhsOpps' = - _hdIpp' : _tlIpps' - -- use rule "PrintCode.ag"(line 234, column 40) - _lhsOstrictVars = - _hdIstrictVars ++ _tlIstrictVars - -- self rule - _copy = - (:) _hdIcopy _tlIcopy - -- self rule - _lhsOcopy = - _copy - -- copy rule (down) - _hdObelowIrrefutable = - _lhsIbelowIrrefutable - -- copy rule (down) - _hdOisDeclOfLet = - _lhsIisDeclOfLet - -- copy rule (down) - _hdOoptions = - _lhsIoptions - -- copy rule (down) - _tlObelowIrrefutable = - _lhsIbelowIrrefutable - -- copy rule (down) - _tlOisDeclOfLet = - _lhsIisDeclOfLet - -- copy rule (down) - _tlOoptions = - _lhsIoptions - ( _hdIcopy,_hdIisUnderscore,_hdIpp,_hdIpp',_hdIstrictVars) = - (hd_ _hdObelowIrrefutable _hdOisDeclOfLet _hdOoptions) - ( _tlIcopy,_tlIpps,_tlIpps',_tlIstrictVars) = - (tl_ _tlObelowIrrefutable _tlOisDeclOfLet _tlOoptions) - in ( _lhsOcopy,_lhsOpps,_lhsOpps',_lhsOstrictVars)))) -sem_Patterns_Nil :: T_Patterns -sem_Patterns_Nil = - (T_Patterns (\ _lhsIbelowIrrefutable - _lhsIisDeclOfLet - _lhsIoptions -> - (let _lhsOpps :: ([PP_Doc]) - _lhsOpps' :: ([PP_Doc]) - _lhsOstrictVars :: ([PP_Doc]) - _lhsOcopy :: Patterns - -- "PrintCode.ag"(line 256, column 10) - _lhsOpps = - [] - -- "PrintCode.ag"(line 296, column 10) - _lhsOpps' = - [] - -- use rule "PrintCode.ag"(line 234, column 40) - _lhsOstrictVars = - [] - -- self rule - _copy = - [] - -- self rule - _lhsOcopy = - _copy - in ( _lhsOcopy,_lhsOpps,_lhsOpps',_lhsOstrictVars)))) --- Program ----------------------------------------------------- -{- - visit 0: - inherited attributes: - importBlocks : PP_Doc - mainFile : String - mainName : String - moduleHeader : String -> String -> String -> Bool -> String - options : Options - optionsLine : String - pragmaBlocks : String - textBlocks : PP_Doc - synthesized attributes: - genIO : IO () - output : PP_Docs - alternatives: - alternative Program: - child chunks : Chunks - visit 0: - local mainModuleFile : _ - local genMainModule : _ - local commonFile : _ - local genCommonModule : _ --} --- cata -sem_Program :: Program -> - T_Program -sem_Program (Program _chunks) = - (sem_Program_Program (sem_Chunks _chunks)) --- semantic domain -newtype T_Program = T_Program (PP_Doc -> - String -> - String -> - (String -> String -> String -> Bool -> String) -> - Options -> - String -> - String -> - PP_Doc -> - ( (IO ()),PP_Docs)) -data Inh_Program = Inh_Program {importBlocks_Inh_Program :: PP_Doc,mainFile_Inh_Program :: String,mainName_Inh_Program :: String,moduleHeader_Inh_Program :: String -> String -> String -> Bool -> String,options_Inh_Program :: Options,optionsLine_Inh_Program :: String,pragmaBlocks_Inh_Program :: String,textBlocks_Inh_Program :: PP_Doc} -data Syn_Program = Syn_Program {genIO_Syn_Program :: IO (),output_Syn_Program :: PP_Docs} -wrap_Program (T_Program sem) (Inh_Program _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks) = - (let ( _lhsOgenIO,_lhsOoutput) = - (sem _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks) - in (Syn_Program _lhsOgenIO _lhsOoutput)) -sem_Program_Program :: T_Chunks -> - T_Program -sem_Program_Program (T_Chunks chunks_) = - (T_Program (\ _lhsIimportBlocks - _lhsImainFile - _lhsImainName - _lhsImoduleHeader - _lhsIoptions - _lhsIoptionsLine - _lhsIpragmaBlocks - _lhsItextBlocks -> - (let _chunksOnested :: Bool - _lhsOoutput :: PP_Docs - _chunksOisDeclOfLet :: Bool - _lhsOgenIO :: (IO ()) - _chunksOimportBlocks :: PP_Doc - _chunksOmainFile :: String - _chunksOmainName :: String - _chunksOmoduleHeader :: (String -> String -> String -> Bool -> String) - _chunksOoptions :: Options - _chunksOoptionsLine :: String - _chunksOpragmaBlocks :: String - _chunksOtextBlocks :: PP_Doc - _chunksIappendCommon :: ([[PP_Doc]]) - _chunksIappendMain :: ([[PP_Doc]]) - _chunksIgenSems :: (IO ()) - _chunksIimports :: ([String]) - _chunksIpps :: PP_Docs - -- "PrintCode.ag"(line 52, column 13) - _chunksOnested = - nest _lhsIoptions - -- "PrintCode.ag"(line 80, column 16) - _lhsOoutput = - _chunksIpps - -- "PrintCode.ag"(line 318, column 7) - _chunksOisDeclOfLet = - False - -- "PrintCode.ag"(line 347, column 7) - _mainModuleFile = - _lhsImainFile ++ ".hs" - -- "PrintCode.ag"(line 348, column 7) - _genMainModule = - writeModule _mainModuleFile - ( [ pp $ _lhsIpragmaBlocks - , pp $ _lhsIoptionsLine - , pp $ _lhsImoduleHeader _lhsImainName "" "" False - , pp $ ("import " ++ _lhsImainName ++ "_common\n") - ] - ++ map pp _chunksIimports - ++ map vlist _chunksIappendMain - ) - -- "PrintCode.ag"(line 359, column 7) - _commonFile = - _lhsImainFile ++ "_common.hs" - -- "PrintCode.ag"(line 360, column 7) - _genCommonModule = - writeModule _commonFile - ( [ pp $ _lhsIpragmaBlocks - , pp $ _lhsIoptionsLine - , pp $ _lhsImoduleHeader _lhsImainName "_common" "" True - , _lhsIimportBlocks - , _lhsItextBlocks - ] - ++ map vlist _chunksIappendCommon - ) - -- "PrintCode.ag"(line 371, column 7) - _lhsOgenIO = - do _genMainModule - _genCommonModule - _chunksIgenSems - -- copy rule (down) - _chunksOimportBlocks = - _lhsIimportBlocks - -- copy rule (down) - _chunksOmainFile = - _lhsImainFile - -- copy rule (down) - _chunksOmainName = - _lhsImainName - -- copy rule (down) - _chunksOmoduleHeader = - _lhsImoduleHeader - -- copy rule (down) - _chunksOoptions = - _lhsIoptions - -- copy rule (down) - _chunksOoptionsLine = - _lhsIoptionsLine - -- copy rule (down) - _chunksOpragmaBlocks = - _lhsIpragmaBlocks - -- copy rule (down) - _chunksOtextBlocks = - _lhsItextBlocks - ( _chunksIappendCommon,_chunksIappendMain,_chunksIgenSems,_chunksIimports,_chunksIpps) = - (chunks_ _chunksOimportBlocks _chunksOisDeclOfLet _chunksOmainFile _chunksOmainName _chunksOmoduleHeader _chunksOnested _chunksOoptions _chunksOoptionsLine _chunksOpragmaBlocks _chunksOtextBlocks) - in ( _lhsOgenIO,_lhsOoutput)))) --- Type -------------------------------------------------------- -{- - visit 0: - inherited attribute: - nested : Bool - synthesized attributes: - pp : PP_Doc - prec : Int - alternatives: - alternative Arr: - child left : Type - child right : Type - visit 0: - local l : _ - local r : _ - alternative CtxApp: - child left : {[(String, [String])]} - child right : Type - alternative List: - child tp : Type - alternative SimpleType: - child txt : {String} - alternative TupleType: - child tps : Types - alternative TypeApp: - child func : Type - child args : Types - alternative UnboxedTupleType: - child tps : Types --} --- cata -sem_Type :: Type -> - T_Type -sem_Type (Arr _left _right) = - (sem_Type_Arr (sem_Type _left) (sem_Type _right)) -sem_Type (CtxApp _left _right) = - (sem_Type_CtxApp _left (sem_Type _right)) -sem_Type (List _tp) = - (sem_Type_List (sem_Type _tp)) -sem_Type (SimpleType _txt) = - (sem_Type_SimpleType _txt) -sem_Type (TupleType _tps) = - (sem_Type_TupleType (sem_Types _tps)) -sem_Type (TypeApp _func _args) = - (sem_Type_TypeApp (sem_Type _func) (sem_Types _args)) -sem_Type (UnboxedTupleType _tps) = - (sem_Type_UnboxedTupleType (sem_Types _tps)) --- semantic domain -newtype T_Type = T_Type (Bool -> - ( PP_Doc,Int)) -data Inh_Type = Inh_Type {nested_Inh_Type :: Bool} -data Syn_Type = Syn_Type {pp_Syn_Type :: PP_Doc,prec_Syn_Type :: Int} -wrap_Type (T_Type sem) (Inh_Type _lhsInested) = - (let ( _lhsOpp,_lhsOprec) = - (sem _lhsInested) - in (Syn_Type _lhsOpp _lhsOprec)) -sem_Type_Arr :: T_Type -> - T_Type -> - T_Type -sem_Type_Arr (T_Type left_) (T_Type right_) = - (T_Type (\ _lhsInested -> - (let _lhsOprec :: Int - _lhsOpp :: PP_Doc - _leftOnested :: Bool - _rightOnested :: Bool - _leftIpp :: PP_Doc - _leftIprec :: Int - _rightIpp :: PP_Doc - _rightIprec :: Int - -- "PrintCode.ag"(line 185, column 16) - _lhsOprec = - 2 - -- "PrintCode.ag"(line 185, column 16) - _lhsOpp = - _l >#< "->" >-< _r - -- "PrintCode.ag"(line 187, column 16) - _l = - if _leftIprec <= 2 then pp_parens _leftIpp else _leftIpp - -- "PrintCode.ag"(line 187, column 16) - _r = - if _rightIprec < 2 then pp_parens _rightIpp else _rightIpp - -- copy rule (down) - _leftOnested = - _lhsInested - -- copy rule (down) - _rightOnested = - _lhsInested - ( _leftIpp,_leftIprec) = - (left_ _leftOnested) - ( _rightIpp,_rightIprec) = - (right_ _rightOnested) - in ( _lhsOpp,_lhsOprec)))) -sem_Type_CtxApp :: ([(String, [String])]) -> - T_Type -> - T_Type -sem_Type_CtxApp left_ (T_Type right_) = - (T_Type (\ _lhsInested -> - (let _lhsOpp :: PP_Doc - _lhsOprec :: Int - _rightOnested :: Bool - _rightIpp :: PP_Doc - _rightIprec :: Int - -- "PrintCode.ag"(line 194, column 7) - _lhsOpp = - (pp_block "(" ")" "," $ map (\(n,ns) -> hv_sp $ map pp (n:ns)) left_) >#< "=>" >#< _rightIpp - -- copy rule (up) - _lhsOprec = - _rightIprec - -- copy rule (down) - _rightOnested = - _lhsInested - ( _rightIpp,_rightIprec) = - (right_ _rightOnested) - in ( _lhsOpp,_lhsOprec)))) -sem_Type_List :: T_Type -> - T_Type -sem_Type_List (T_Type tp_) = - (T_Type (\ _lhsInested -> - (let _lhsOprec :: Int - _lhsOpp :: PP_Doc - _tpOnested :: Bool - _tpIpp :: PP_Doc - _tpIprec :: Int - -- "PrintCode.ag"(line 202, column 16) - _lhsOprec = - 5 - -- "PrintCode.ag"(line 202, column 16) - _lhsOpp = - "[" >|< _tpIpp >|< "]" - -- copy rule (down) - _tpOnested = - _lhsInested - ( _tpIpp,_tpIprec) = - (tp_ _tpOnested) - in ( _lhsOpp,_lhsOprec)))) -sem_Type_SimpleType :: String -> - T_Type -sem_Type_SimpleType txt_ = - (T_Type (\ _lhsInested -> - (let _lhsOprec :: Int - _lhsOpp :: PP_Doc - -- "PrintCode.ag"(line 205, column 16) - _lhsOprec = - 5 - -- "PrintCode.ag"(line 205, column 16) - _lhsOpp = - if reallySimple txt_ then text txt_ else pp_parens (text txt_) - in ( _lhsOpp,_lhsOprec)))) -sem_Type_TupleType :: T_Types -> - T_Type -sem_Type_TupleType (T_Types tps_) = - (T_Type (\ _lhsInested -> - (let _lhsOprec :: Int - _lhsOpp :: PP_Doc - _tpsOnested :: Bool - _tpsIpps :: PP_Docs - -- "PrintCode.ag"(line 196, column 16) - _lhsOprec = - 5 - -- "PrintCode.ag"(line 196, column 16) - _lhsOpp = - ppTuple _lhsInested _tpsIpps - -- copy rule (down) - _tpsOnested = - _lhsInested - ( _tpsIpps) = - (tps_ _tpsOnested) - in ( _lhsOpp,_lhsOprec)))) -sem_Type_TypeApp :: T_Type -> - T_Types -> - T_Type -sem_Type_TypeApp (T_Type func_) (T_Types args_) = - (T_Type (\ _lhsInested -> - (let _lhsOpp :: PP_Doc - _lhsOprec :: Int - _funcOnested :: Bool - _argsOnested :: Bool - _funcIpp :: PP_Doc - _funcIprec :: Int - _argsIpps :: PP_Docs - -- "PrintCode.ag"(line 191, column 7) - _lhsOpp = - hv_sp (_funcIpp : _argsIpps) - -- copy rule (up) - _lhsOprec = - _funcIprec - -- copy rule (down) - _funcOnested = - _lhsInested - -- copy rule (down) - _argsOnested = - _lhsInested - ( _funcIpp,_funcIprec) = - (func_ _funcOnested) - ( _argsIpps) = - (args_ _argsOnested) - in ( _lhsOpp,_lhsOprec)))) -sem_Type_UnboxedTupleType :: T_Types -> - T_Type -sem_Type_UnboxedTupleType (T_Types tps_) = - (T_Type (\ _lhsInested -> - (let _lhsOprec :: Int - _lhsOpp :: PP_Doc - _tpsOnested :: Bool - _tpsIpps :: PP_Docs - -- "PrintCode.ag"(line 199, column 23) - _lhsOprec = - 5 - -- "PrintCode.ag"(line 199, column 23) - _lhsOpp = - ppUnboxedTuple _lhsInested _tpsIpps - -- copy rule (down) - _tpsOnested = - _lhsInested - ( _tpsIpps) = - (tps_ _tpsOnested) - in ( _lhsOpp,_lhsOprec)))) --- Types ------------------------------------------------------- -{- - visit 0: - inherited attribute: - nested : Bool - synthesized attribute: - pps : PP_Docs - alternatives: - alternative Cons: - child hd : Type - child tl : Types - alternative Nil: --} --- cata -sem_Types :: Types -> - T_Types -sem_Types list = - (Prelude.foldr sem_Types_Cons sem_Types_Nil (Prelude.map sem_Type list)) --- semantic domain -newtype T_Types = T_Types (Bool -> - ( PP_Docs)) -data Inh_Types = Inh_Types {nested_Inh_Types :: Bool} -data Syn_Types = Syn_Types {pps_Syn_Types :: PP_Docs} -wrap_Types (T_Types sem) (Inh_Types _lhsInested) = - (let ( _lhsOpps) = - (sem _lhsInested) - in (Syn_Types _lhsOpps)) -sem_Types_Cons :: T_Type -> - T_Types -> - T_Types -sem_Types_Cons (T_Type hd_) (T_Types tl_) = - (T_Types (\ _lhsInested -> - (let _lhsOpps :: PP_Docs - _hdOnested :: Bool - _tlOnested :: Bool - _hdIpp :: PP_Doc - _hdIprec :: Int - _tlIpps :: PP_Docs - -- "PrintCode.ag"(line 67, column 10) - _lhsOpps = - _hdIpp : _tlIpps - -- copy rule (down) - _hdOnested = - _lhsInested - -- copy rule (down) - _tlOnested = - _lhsInested - ( _hdIpp,_hdIprec) = - (hd_ _hdOnested) - ( _tlIpps) = - (tl_ _tlOnested) - in ( _lhsOpps)))) -sem_Types_Nil :: T_Types -sem_Types_Nil = - (T_Types (\ _lhsInested -> - (let _lhsOpps :: PP_Docs - -- "PrintCode.ag"(line 68, column 10) - _lhsOpps = - [] - in ( _lhsOpps)))) +{-# OPTIONS_GHC -fbang-patterns #-} +-- UUAGC 0.9.5 (PrintCode.ag) +module PrintCode where + +import Char (isAlphaNum) +import Pretty +import Code +import Patterns +import Options +import CommonTypes (attrname, _LOC, getName, nullIdent) +import Data.List(intersperse) +import System.IO +import System.Directory +import CommonTypes(BlockInfo, BlockType(..), identifier) + +import Pretty +import Patterns +import Data.List(partition) +import Data.Set(Set) +import qualified UU.DData.Set as Set +import Data.Map(Map) +import qualified Data.Map as Map + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) + +type PP_Docs = [PP_Doc] + +ppMultiSeqH :: [PP_Doc] -> PP_Doc -> PP_Doc +ppMultiSeqH = ppMultiSeq' (>#<) + +ppMultiSeqV :: [PP_Doc] -> PP_Doc -> PP_Doc +ppMultiSeqV = ppMultiSeq' (>-<) + +ppMultiSeq' :: (PP_Doc -> PP_Doc -> PP_Doc) -> [PP_Doc] -> PP_Doc -> PP_Doc +ppMultiSeq' next strictArgs expr + = foldr (\v r -> (v >#< "`seq`") `next` pp_parens r) expr strictArgs + + +reallySimple :: String -> Bool +reallySimple = and . map (\x -> isAlphaNum x || x=='_') + +ppTuple True pps = "(" >|< pp_block " " (replicate (length pps `max` 1) ')') ",(" pps +ppTuple False pps = "(" >|< pp_block " " ")" "," pps +ppUnboxedTuple True pps = "(# " >|< pp_block " " (concat $ replicate (length pps `max` 1) " #)") ",(# " pps +ppUnboxedTuple False pps = "(# " >|< pp_block " " " #)" "," pps + + +locname' n = "_loc_" ++ getName n + +renderDocs :: [PP_Doc] -> String +renderDocs pps = foldr (.) id (map (\d -> (disp d 50000) . ( '\n':) ) pps) "" + +writeModule :: FilePath -> [PP_Doc] -> IO () +writeModule path docs + = do bExists <- doesFileExist path + if bExists + then do input <- readFile path + seq (length input) (return ()) + if input /= output + then dumpIt + else return () + else dumpIt + where + output = renderDocs docs + dumpIt = writeFile path output + +-- Unboxed tuples +-- unbox Whether unboxed tuples are wanted or not +-- inh The inherited attributes. +-- If there are none, no unboxing can take place, +-- because in that case the semantic function (a top-level identifier) would have an unboxed type. +-- Of course we can't have an unboxed 1-tuple +mkTupleExpr :: Bool -> Bool -> Exprs -> Expr +mkTupleExpr unbox noInh exprs | not unbox || noInh || length exprs == 1 = TupleExpr exprs + | otherwise = UnboxedTupleExpr exprs +mkTupleType :: Bool -> Bool -> Types -> Type +mkTupleType unbox noInh tps | not unbox || noInh || length tps == 1 = TupleType tps + | otherwise = UnboxedTupleType tps +mkTupleLhs :: Bool -> Bool -> [String] -> Lhs +mkTupleLhs unbox noInh comps | not unbox || noInh || length comps == 1 = TupleLhs comps + | otherwise = UnboxedTupleLhs comps +-- CaseAlt ----------------------------------------------------- +{- + visit 0: + inherited attributes: + nested : Bool + options : Options + outputfile : String + synthesized attribute: + pps : PP_Docs + alternatives: + alternative CaseAlt: + child left : Lhs + child expr : Expr +-} +-- cata +sem_CaseAlt :: CaseAlt -> + T_CaseAlt +sem_CaseAlt !(CaseAlt _left _expr) = + (sem_CaseAlt_CaseAlt (sem_Lhs _left) (sem_Expr _expr)) +-- semantic domain +newtype T_CaseAlt = T_CaseAlt (Bool -> + Options -> + String -> + ( PP_Docs)) +data Inh_CaseAlt = Inh_CaseAlt {nested_Inh_CaseAlt :: !(Bool),options_Inh_CaseAlt :: !(Options),outputfile_Inh_CaseAlt :: !(String)} +data Syn_CaseAlt = Syn_CaseAlt {pps_Syn_CaseAlt :: !(PP_Docs)} +wrap_CaseAlt !(T_CaseAlt sem) !(Inh_CaseAlt _lhsInested _lhsIoptions _lhsIoutputfile) = + (let ( !_lhsOpps) = + (sem _lhsInested _lhsIoptions _lhsIoutputfile) + in (Syn_CaseAlt _lhsOpps)) +sem_CaseAlt_CaseAlt :: T_Lhs -> + T_Expr -> + T_CaseAlt +sem_CaseAlt_CaseAlt !(T_Lhs left_) !(T_Expr expr_) = + (T_CaseAlt (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (_lhsIoutputfile) of + { !_exprOoutputfile -> + (case (_lhsIoptions) of + { !_exprOoptions -> + (case (_lhsInested) of + { !_exprOnested -> + (case (_lhsIoutputfile) of + { !_leftOoutputfile -> + (case (_lhsIoptions) of + { !_leftOoptions -> + (case (_lhsInested) of + { !_leftOnested -> + (case (False) of + { !_leftOisDeclOfLet -> + (case ((expr_ _exprOnested _exprOoptions _exprOoutputfile)) of + { ( !_exprIpp) -> + (case ((left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile)) of + { ( !_leftIpp) -> + (case (["{" >#< _leftIpp >#< "->", _exprIpp >#< "}"]) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) }) }) }) }) }) }) }))) +-- CaseAlts ---------------------------------------------------- +{- + visit 0: + inherited attributes: + nested : Bool + options : Options + outputfile : String + synthesized attribute: + pps : PP_Docs + alternatives: + alternative Cons: + child hd : CaseAlt + child tl : CaseAlts + alternative Nil: +-} +-- cata +sem_CaseAlts :: CaseAlts -> + T_CaseAlts +sem_CaseAlts !list = + (Prelude.foldr sem_CaseAlts_Cons sem_CaseAlts_Nil (Prelude.map sem_CaseAlt list)) +-- semantic domain +newtype T_CaseAlts = T_CaseAlts (Bool -> + Options -> + String -> + ( PP_Docs)) +data Inh_CaseAlts = Inh_CaseAlts {nested_Inh_CaseAlts :: !(Bool),options_Inh_CaseAlts :: !(Options),outputfile_Inh_CaseAlts :: !(String)} +data Syn_CaseAlts = Syn_CaseAlts {pps_Syn_CaseAlts :: !(PP_Docs)} +wrap_CaseAlts !(T_CaseAlts sem) !(Inh_CaseAlts _lhsInested _lhsIoptions _lhsIoutputfile) = + (let ( !_lhsOpps) = + (sem _lhsInested _lhsIoptions _lhsIoutputfile) + in (Syn_CaseAlts _lhsOpps)) +sem_CaseAlts_Cons :: T_CaseAlt -> + T_CaseAlts -> + T_CaseAlts +sem_CaseAlts_Cons !(T_CaseAlt hd_) !(T_CaseAlts tl_) = + (T_CaseAlts (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (_lhsIoutputfile) of + { !_tlOoutputfile -> + (case (_lhsIoptions) of + { !_tlOoptions -> + (case (_lhsInested) of + { !_tlOnested -> + (case (_lhsIoutputfile) of + { !_hdOoutputfile -> + (case (_lhsIoptions) of + { !_hdOoptions -> + (case (_lhsInested) of + { !_hdOnested -> + (case ((tl_ _tlOnested _tlOoptions _tlOoutputfile)) of + { ( !_tlIpps) -> + (case ((hd_ _hdOnested _hdOoptions _hdOoutputfile)) of + { ( !_hdIpps) -> + (case (_hdIpps ++ _tlIpps) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) }) }) }) }) }) }))) +sem_CaseAlts_Nil :: T_CaseAlts +sem_CaseAlts_Nil = + (T_CaseAlts (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case ([]) of + { !_lhsOpps -> + ( _lhsOpps) }))) +-- Chunk ------------------------------------------------------- +{- + visit 0: + inherited attributes: + importBlocks : PP_Doc + isDeclOfLet : Bool + mainFile : String + mainName : String + moduleHeader : String -> String -> String -> Bool -> String + nested : Bool + options : Options + optionsLine : String + pragmaBlocks : String + textBlockMap : Map BlockInfo PP_Doc + textBlocks : PP_Doc + synthesized attributes: + appendCommon : [[PP_Doc]] + appendMain : [[PP_Doc]] + genSems : IO () + imports : [String] + pps : PP_Docs + alternatives: + alternative Chunk: + child name : {String} + child comment : Decl + child info : Decls + child dataDef : Decls + child cataFun : Decls + child semDom : Decls + child semWrapper : Decls + child semFunctions : Decls + child semNames : {[String]} + visit 0: + local outputfile : _ + local exports : _ +-} +-- cata +sem_Chunk :: Chunk -> + T_Chunk +sem_Chunk !(Chunk _name _comment _info _dataDef _cataFun _semDom _semWrapper _semFunctions _semNames) = + (sem_Chunk_Chunk _name (sem_Decl _comment) (sem_Decls _info) (sem_Decls _dataDef) (sem_Decls _cataFun) (sem_Decls _semDom) (sem_Decls _semWrapper) (sem_Decls _semFunctions) _semNames) +-- semantic domain +newtype T_Chunk = T_Chunk (PP_Doc -> + Bool -> + String -> + String -> + (String -> String -> String -> Bool -> String) -> + Bool -> + Options -> + String -> + String -> + (Map BlockInfo PP_Doc) -> + PP_Doc -> + ( ([[PP_Doc]]),([[PP_Doc]]),(IO ()),([String]),PP_Docs)) +data Inh_Chunk = Inh_Chunk {importBlocks_Inh_Chunk :: !(PP_Doc),isDeclOfLet_Inh_Chunk :: !(Bool),mainFile_Inh_Chunk :: !(String),mainName_Inh_Chunk :: !(String),moduleHeader_Inh_Chunk :: !(String -> String -> String -> Bool -> String),nested_Inh_Chunk :: !(Bool),options_Inh_Chunk :: !(Options),optionsLine_Inh_Chunk :: !(String),pragmaBlocks_Inh_Chunk :: !(String),textBlockMap_Inh_Chunk :: !(Map BlockInfo PP_Doc),textBlocks_Inh_Chunk :: !(PP_Doc)} +data Syn_Chunk = Syn_Chunk {appendCommon_Syn_Chunk :: !([[PP_Doc]]),appendMain_Syn_Chunk :: !([[PP_Doc]]),genSems_Syn_Chunk :: !(IO ()),imports_Syn_Chunk :: !([String]),pps_Syn_Chunk :: !(PP_Docs)} +wrap_Chunk !(T_Chunk sem) !(Inh_Chunk _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks) = + (let ( !_lhsOappendCommon,!_lhsOappendMain,!_lhsOgenSems,!_lhsOimports,!_lhsOpps) = + (sem _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks) + in (Syn_Chunk _lhsOappendCommon _lhsOappendMain _lhsOgenSems _lhsOimports _lhsOpps)) +sem_Chunk_Chunk :: String -> + T_Decl -> + T_Decls -> + T_Decls -> + T_Decls -> + T_Decls -> + T_Decls -> + T_Decls -> + ([String]) -> + T_Chunk +sem_Chunk_Chunk !name_ !(T_Decl comment_) !(T_Decls info_) !(T_Decls dataDef_) !(T_Decls cataFun_) !(T_Decls semDom_) !(T_Decls semWrapper_) !(T_Decls semFunctions_) !semNames_ = + (T_Chunk (\ (!_lhsIimportBlocks) + (!_lhsIisDeclOfLet) + (!_lhsImainFile) + (!_lhsImainName) + (!_lhsImoduleHeader) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoptionsLine) + (!_lhsIpragmaBlocks) + (!_lhsItextBlockMap) + (!_lhsItextBlocks) -> + (case (if sepSemMods _lhsIoptions + then _lhsImainFile ++ "_" ++ name_ ++ ".hs" + else _lhsImainFile ++ ".hs") of + { !_outputfile -> + (case (_outputfile) of + { !_semDomOoutputfile -> + (case (_lhsIoptions) of + { !_semDomOoptions -> + (case (_lhsInested) of + { !_semDomOnested -> + (case (_lhsIisDeclOfLet) of + { !_semDomOisDeclOfLet -> + (case (_outputfile) of + { !_dataDefOoutputfile -> + (case (_lhsIoptions) of + { !_dataDefOoptions -> + (case (_lhsInested) of + { !_dataDefOnested -> + (case (_lhsIisDeclOfLet) of + { !_dataDefOisDeclOfLet -> + (case (_outputfile) of + { !_commentOoutputfile -> + (case (_lhsIoptions) of + { !_commentOoptions -> + (case (_lhsInested) of + { !_commentOnested -> + (case (_lhsIisDeclOfLet) of + { !_commentOisDeclOfLet -> + (case ((semDom_ _semDomOisDeclOfLet _semDomOnested _semDomOoptions _semDomOoutputfile)) of + { ( !_semDomIpps) -> + (case ((dataDef_ _dataDefOisDeclOfLet _dataDefOnested _dataDefOoptions _dataDefOoutputfile)) of + { ( !_dataDefIpps) -> + (case ((comment_ _commentOisDeclOfLet _commentOnested _commentOoptions _commentOoutputfile)) of + { ( !_commentIpp) -> + (case ([ [_commentIpp] + , _dataDefIpps + , _semDomIpps + ]) of + { !_lhsOappendCommon -> + (case (_outputfile) of + { !_semWrapperOoutputfile -> + (case (_lhsIoptions) of + { !_semWrapperOoptions -> + (case (_lhsInested) of + { !_semWrapperOnested -> + (case (_lhsIisDeclOfLet) of + { !_semWrapperOisDeclOfLet -> + (case (_outputfile) of + { !_cataFunOoutputfile -> + (case (_lhsIoptions) of + { !_cataFunOoptions -> + (case (_lhsInested) of + { !_cataFunOnested -> + (case (_lhsIisDeclOfLet) of + { !_cataFunOisDeclOfLet -> + (case ((semWrapper_ _semWrapperOisDeclOfLet _semWrapperOnested _semWrapperOoptions _semWrapperOoutputfile)) of + { ( !_semWrapperIpps) -> + (case ((cataFun_ _cataFunOisDeclOfLet _cataFunOnested _cataFunOoptions _cataFunOoutputfile)) of + { ( !_cataFunIpps) -> + (case ([ [_commentIpp] + , _cataFunIpps + , _semWrapperIpps + ]) of + { !_lhsOappendMain -> + (case (_outputfile) of + { !_semFunctionsOoutputfile -> + (case (_lhsIoptions) of + { !_semFunctionsOoptions -> + (case (_lhsInested) of + { !_semFunctionsOnested -> + (case (_lhsIisDeclOfLet) of + { !_semFunctionsOisDeclOfLet -> + (case (_outputfile) of + { !_infoOoutputfile -> + (case (_lhsIoptions) of + { !_infoOoptions -> + (case (_lhsInested) of + { !_infoOnested -> + (case (_lhsIisDeclOfLet) of + { !_infoOisDeclOfLet -> + (case (concat $ intersperse "," semNames_) of + { !_exports -> + (case ((semFunctions_ _semFunctionsOisDeclOfLet _semFunctionsOnested _semFunctionsOoptions _semFunctionsOoutputfile)) of + { ( !_semFunctionsIpps) -> + (case ((info_ _infoOisDeclOfLet _infoOnested _infoOoptions _infoOoutputfile)) of + { ( !_infoIpps) -> + (case (writeModule _outputfile + [ pp $ _lhsIpragmaBlocks + , pp $ Map.findWithDefault empty (BlockPragma, Just $ identifier name_) _lhsItextBlockMap + , pp $ _lhsIoptionsLine + , pp $ _lhsImoduleHeader _lhsImainName ("_" ++ name_) _exports True + , pp $ ("import " ++ _lhsImainName ++ "_common\n") + , pp $ Map.findWithDefault empty (BlockImport, Just $ identifier name_) _lhsItextBlockMap + , _commentIpp + , vlist_sep "" _infoIpps + , vlist_sep "" _semFunctionsIpps + , Map.findWithDefault empty (BlockOther, Just $ identifier name_) _lhsItextBlockMap + ]) of + { !_lhsOgenSems -> + (case (["import " ++ _lhsImainName ++ "_" ++ name_ ++ "\n"]) of + { !_lhsOimports -> + (case (_commentIpp + : _infoIpps + ++ _dataDefIpps + ++ _cataFunIpps + ++ _semDomIpps + ++ _semWrapperIpps + ++ _semFunctionsIpps + ++ [Map.findWithDefault empty (BlockOther, Just $ identifier name_) _lhsItextBlockMap]) of + { !_lhsOpps -> + ( _lhsOappendCommon,_lhsOappendMain,_lhsOgenSems,_lhsOimports,_lhsOpps) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +-- Chunks ------------------------------------------------------ +{- + visit 0: + inherited attributes: + importBlocks : PP_Doc + isDeclOfLet : Bool + mainFile : String + mainName : String + moduleHeader : String -> String -> String -> Bool -> String + nested : Bool + options : Options + optionsLine : String + pragmaBlocks : String + textBlockMap : Map BlockInfo PP_Doc + textBlocks : PP_Doc + synthesized attributes: + appendCommon : [[PP_Doc]] + appendMain : [[PP_Doc]] + genSems : IO () + imports : [String] + pps : PP_Docs + alternatives: + alternative Cons: + child hd : Chunk + child tl : Chunks + alternative Nil: +-} +-- cata +sem_Chunks :: Chunks -> + T_Chunks +sem_Chunks !list = + (Prelude.foldr sem_Chunks_Cons sem_Chunks_Nil (Prelude.map sem_Chunk list)) +-- semantic domain +newtype T_Chunks = T_Chunks (PP_Doc -> + Bool -> + String -> + String -> + (String -> String -> String -> Bool -> String) -> + Bool -> + Options -> + String -> + String -> + (Map BlockInfo PP_Doc) -> + PP_Doc -> + ( ([[PP_Doc]]),([[PP_Doc]]),(IO ()),([String]),PP_Docs)) +data Inh_Chunks = Inh_Chunks {importBlocks_Inh_Chunks :: !(PP_Doc),isDeclOfLet_Inh_Chunks :: !(Bool),mainFile_Inh_Chunks :: !(String),mainName_Inh_Chunks :: !(String),moduleHeader_Inh_Chunks :: !(String -> String -> String -> Bool -> String),nested_Inh_Chunks :: !(Bool),options_Inh_Chunks :: !(Options),optionsLine_Inh_Chunks :: !(String),pragmaBlocks_Inh_Chunks :: !(String),textBlockMap_Inh_Chunks :: !(Map BlockInfo PP_Doc),textBlocks_Inh_Chunks :: !(PP_Doc)} +data Syn_Chunks = Syn_Chunks {appendCommon_Syn_Chunks :: !([[PP_Doc]]),appendMain_Syn_Chunks :: !([[PP_Doc]]),genSems_Syn_Chunks :: !(IO ()),imports_Syn_Chunks :: !([String]),pps_Syn_Chunks :: !(PP_Docs)} +wrap_Chunks !(T_Chunks sem) !(Inh_Chunks _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks) = + (let ( !_lhsOappendCommon,!_lhsOappendMain,!_lhsOgenSems,!_lhsOimports,!_lhsOpps) = + (sem _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks) + in (Syn_Chunks _lhsOappendCommon _lhsOappendMain _lhsOgenSems _lhsOimports _lhsOpps)) +sem_Chunks_Cons :: T_Chunk -> + T_Chunks -> + T_Chunks +sem_Chunks_Cons !(T_Chunk hd_) !(T_Chunks tl_) = + (T_Chunks (\ (!_lhsIimportBlocks) + (!_lhsIisDeclOfLet) + (!_lhsImainFile) + (!_lhsImainName) + (!_lhsImoduleHeader) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoptionsLine) + (!_lhsIpragmaBlocks) + (!_lhsItextBlockMap) + (!_lhsItextBlocks) -> + (case (_lhsIoptions) of + { !_tlOoptions -> + (case (_lhsInested) of + { !_tlOnested -> + (case (_lhsImainFile) of + { !_tlOmainFile -> + (case (_lhsIisDeclOfLet) of + { !_tlOisDeclOfLet -> + (case (_lhsIoptions) of + { !_hdOoptions -> + (case (_lhsInested) of + { !_hdOnested -> + (case (_lhsImainFile) of + { !_hdOmainFile -> + (case (_lhsIisDeclOfLet) of + { !_hdOisDeclOfLet -> + (case (_lhsItextBlocks) of + { !_tlOtextBlocks -> + (case (_lhsItextBlockMap) of + { !_tlOtextBlockMap -> + (case (_lhsIpragmaBlocks) of + { !_tlOpragmaBlocks -> + (case (_lhsIoptionsLine) of + { !_tlOoptionsLine -> + (case (_lhsImoduleHeader) of + { !_tlOmoduleHeader -> + (case (_lhsImainName) of + { !_tlOmainName -> + (case (_lhsIimportBlocks) of + { !_tlOimportBlocks -> + (case ((tl_ _tlOimportBlocks _tlOisDeclOfLet _tlOmainFile _tlOmainName _tlOmoduleHeader _tlOnested _tlOoptions _tlOoptionsLine _tlOpragmaBlocks _tlOtextBlockMap _tlOtextBlocks)) of + { ( !_tlIappendCommon,!_tlIappendMain,!_tlIgenSems,!_tlIimports,!_tlIpps) -> + (case (_lhsItextBlocks) of + { !_hdOtextBlocks -> + (case (_lhsItextBlockMap) of + { !_hdOtextBlockMap -> + (case (_lhsIpragmaBlocks) of + { !_hdOpragmaBlocks -> + (case (_lhsIoptionsLine) of + { !_hdOoptionsLine -> + (case (_lhsImoduleHeader) of + { !_hdOmoduleHeader -> + (case (_lhsImainName) of + { !_hdOmainName -> + (case (_lhsIimportBlocks) of + { !_hdOimportBlocks -> + (case ((hd_ _hdOimportBlocks _hdOisDeclOfLet _hdOmainFile _hdOmainName _hdOmoduleHeader _hdOnested _hdOoptions _hdOoptionsLine _hdOpragmaBlocks _hdOtextBlockMap _hdOtextBlocks)) of + { ( !_hdIappendCommon,!_hdIappendMain,!_hdIgenSems,!_hdIimports,!_hdIpps) -> + (case (_hdIappendCommon ++ _tlIappendCommon) of + { !_lhsOappendCommon -> + (case (_hdIappendMain ++ _tlIappendMain) of + { !_lhsOappendMain -> + (case (_hdIgenSems >> _tlIgenSems) of + { !_lhsOgenSems -> + (case (_hdIimports ++ _tlIimports) of + { !_lhsOimports -> + (case (_hdIpps ++ _tlIpps) of + { !_lhsOpps -> + ( _lhsOappendCommon,_lhsOappendMain,_lhsOgenSems,_lhsOimports,_lhsOpps) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_Chunks_Nil :: T_Chunks +sem_Chunks_Nil = + (T_Chunks (\ (!_lhsIimportBlocks) + (!_lhsIisDeclOfLet) + (!_lhsImainFile) + (!_lhsImainName) + (!_lhsImoduleHeader) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoptionsLine) + (!_lhsIpragmaBlocks) + (!_lhsItextBlockMap) + (!_lhsItextBlocks) -> + (case ([]) of + { !_lhsOappendCommon -> + (case ([]) of + { !_lhsOappendMain -> + (case (return ()) of + { !_lhsOgenSems -> + (case ([]) of + { !_lhsOimports -> + (case ([]) of + { !_lhsOpps -> + ( _lhsOappendCommon,_lhsOappendMain,_lhsOgenSems,_lhsOimports,_lhsOpps) }) }) }) }) }))) +-- DataAlt ----------------------------------------------------- +{- + visit 0: + inherited attributes: + nested : Bool + strictPre : PP_Doc + synthesized attribute: + pp : PP_Doc + alternatives: + alternative DataAlt: + child name : {String} + child args : {[String]} + alternative Record: + child name : {String} + child args : {[(String,String)]} +-} +-- cata +sem_DataAlt :: DataAlt -> + T_DataAlt +sem_DataAlt !(DataAlt _name _args) = + (sem_DataAlt_DataAlt _name _args) +sem_DataAlt !(Record _name _args) = + (sem_DataAlt_Record _name _args) +-- semantic domain +newtype T_DataAlt = T_DataAlt (Bool -> + PP_Doc -> + ( PP_Doc)) +data Inh_DataAlt = Inh_DataAlt {nested_Inh_DataAlt :: !(Bool),strictPre_Inh_DataAlt :: !(PP_Doc)} +data Syn_DataAlt = Syn_DataAlt {pp_Syn_DataAlt :: !(PP_Doc)} +wrap_DataAlt !(T_DataAlt sem) !(Inh_DataAlt _lhsInested _lhsIstrictPre) = + (let ( !_lhsOpp) = + (sem _lhsInested _lhsIstrictPre) + in (Syn_DataAlt _lhsOpp)) +sem_DataAlt_DataAlt :: String -> + ([String]) -> + T_DataAlt +sem_DataAlt_DataAlt !name_ !args_ = + (T_DataAlt (\ (!_lhsInested) + (!_lhsIstrictPre) -> + (case (name_ >#< hv_sp (map ((_lhsIstrictPre >|<) . pp_parens . text) args_)) of + { !_lhsOpp -> + ( _lhsOpp) }))) +sem_DataAlt_Record :: String -> + ([(String,String)]) -> + T_DataAlt +sem_DataAlt_Record !name_ !args_ = + (T_DataAlt (\ (!_lhsInested) + (!_lhsIstrictPre) -> + (case (name_ >#< pp_block "{" "}" "," + [ f >#< "::" >#< t | (f,t) <- args_ ]) of + { !_lhsOpp -> + ( _lhsOpp) }))) +-- DataAlts ---------------------------------------------------- +{- + visit 0: + inherited attributes: + nested : Bool + strictPre : PP_Doc + synthesized attribute: + pps : PP_Docs + alternatives: + alternative Cons: + child hd : DataAlt + child tl : DataAlts + alternative Nil: +-} +-- cata +sem_DataAlts :: DataAlts -> + T_DataAlts +sem_DataAlts !list = + (Prelude.foldr sem_DataAlts_Cons sem_DataAlts_Nil (Prelude.map sem_DataAlt list)) +-- semantic domain +newtype T_DataAlts = T_DataAlts (Bool -> + PP_Doc -> + ( PP_Docs)) +data Inh_DataAlts = Inh_DataAlts {nested_Inh_DataAlts :: !(Bool),strictPre_Inh_DataAlts :: !(PP_Doc)} +data Syn_DataAlts = Syn_DataAlts {pps_Syn_DataAlts :: !(PP_Docs)} +wrap_DataAlts !(T_DataAlts sem) !(Inh_DataAlts _lhsInested _lhsIstrictPre) = + (let ( !_lhsOpps) = + (sem _lhsInested _lhsIstrictPre) + in (Syn_DataAlts _lhsOpps)) +sem_DataAlts_Cons :: T_DataAlt -> + T_DataAlts -> + T_DataAlts +sem_DataAlts_Cons !(T_DataAlt hd_) !(T_DataAlts tl_) = + (T_DataAlts (\ (!_lhsInested) + (!_lhsIstrictPre) -> + (case (_lhsIstrictPre) of + { !_tlOstrictPre -> + (case (_lhsIstrictPre) of + { !_hdOstrictPre -> + (case (_lhsInested) of + { !_tlOnested -> + (case ((tl_ _tlOnested _tlOstrictPre)) of + { ( !_tlIpps) -> + (case (_lhsInested) of + { !_hdOnested -> + (case ((hd_ _hdOnested _hdOstrictPre)) of + { ( !_hdIpp) -> + (case (_hdIpp : _tlIpps) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) }) }) }) }))) +sem_DataAlts_Nil :: T_DataAlts +sem_DataAlts_Nil = + (T_DataAlts (\ (!_lhsInested) + (!_lhsIstrictPre) -> + (case ([]) of + { !_lhsOpps -> + ( _lhsOpps) }))) +-- Decl -------------------------------------------------------- +{- + visit 0: + inherited attributes: + isDeclOfLet : Bool + nested : Bool + options : Options + outputfile : String + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Comment: + child txt : {String} + alternative Data: + child name : {String} + child params : {[String]} + child alts : DataAlts + child strict : {Bool} + child derivings : {[String]} + alternative Decl: + child left : Lhs + child rhs : Expr + child binds : {Set String} + child uses : {Set String} + alternative NewType: + child name : {String} + child params : {[String]} + child con : {String} + child tp : Type + alternative PragmaDecl: + child txt : {String} + alternative TSig: + child name : {String} + child tp : Type + alternative Type: + child name : {String} + child params : {[String]} + child tp : Type +-} +-- cata +sem_Decl :: Decl -> + T_Decl +sem_Decl !(Comment _txt) = + (sem_Decl_Comment _txt) +sem_Decl !(Data _name _params _alts _strict _derivings) = + (sem_Decl_Data _name _params (sem_DataAlts _alts) _strict _derivings) +sem_Decl !(Decl _left _rhs _binds _uses) = + (sem_Decl_Decl (sem_Lhs _left) (sem_Expr _rhs) _binds _uses) +sem_Decl !(NewType _name _params _con _tp) = + (sem_Decl_NewType _name _params _con (sem_Type _tp)) +sem_Decl !(PragmaDecl _txt) = + (sem_Decl_PragmaDecl _txt) +sem_Decl !(TSig _name _tp) = + (sem_Decl_TSig _name (sem_Type _tp)) +sem_Decl !(Type _name _params _tp) = + (sem_Decl_Type _name _params (sem_Type _tp)) +-- semantic domain +newtype T_Decl = T_Decl (Bool -> + Bool -> + Options -> + String -> + ( PP_Doc)) +data Inh_Decl = Inh_Decl {isDeclOfLet_Inh_Decl :: !(Bool),nested_Inh_Decl :: !(Bool),options_Inh_Decl :: !(Options),outputfile_Inh_Decl :: !(String)} +data Syn_Decl = Syn_Decl {pp_Syn_Decl :: !(PP_Doc)} +wrap_Decl !(T_Decl sem) !(Inh_Decl _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) = + (let ( !_lhsOpp) = + (sem _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) + in (Syn_Decl _lhsOpp)) +sem_Decl_Comment :: String -> + T_Decl +sem_Decl_Comment !txt_ = + (T_Decl (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (if '\n' `elem` txt_ + then "{-" >-< vlist (lines txt_) >-< "-}" + else "--" >#< txt_) of + { !_lhsOpp -> + ( _lhsOpp) }))) +sem_Decl_Data :: String -> + ([String]) -> + T_DataAlts -> + Bool -> + ([String]) -> + T_Decl +sem_Decl_Data !name_ !params_ !(T_DataAlts alts_) !strict_ !derivings_ = + (T_Decl (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (if strict_ then pp "!" else empty) of + { !_altsOstrictPre -> + (case (_lhsInested) of + { !_altsOnested -> + (case ((alts_ _altsOnested _altsOstrictPre)) of + { ( !_altsIpps) -> + (case ("data" >#< hv_sp (name_ : params_) + >#< ( case _altsIpps of + [] -> empty + (x:xs) -> "=" >#< x + >-< vlist (map ("|" >#<) xs) + >-< if null derivings_ + then empty + else "deriving" >#< ppTuple False (map text derivings_) + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }))) +sem_Decl_Decl :: T_Lhs -> + T_Expr -> + (Set String) -> + (Set String) -> + T_Decl +sem_Decl_Decl !(T_Lhs left_) !(T_Expr rhs_) !binds_ !uses_ = + (T_Decl (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (_lhsIoutputfile) of + { !_rhsOoutputfile -> + (case (_lhsIoptions) of + { !_rhsOoptions -> + (case (_lhsInested) of + { !_rhsOnested -> + (case (_lhsIoutputfile) of + { !_leftOoutputfile -> + (case (_lhsIoptions) of + { !_leftOoptions -> + (case (_lhsInested) of + { !_leftOnested -> + (case (_lhsIisDeclOfLet) of + { !_leftOisDeclOfLet -> + (case ((rhs_ _rhsOnested _rhsOoptions _rhsOoutputfile)) of + { ( !_rhsIpp) -> + (case ((left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile)) of + { ( !_leftIpp) -> + (case (_leftIpp >#< "=" + >-< indent 4 _rhsIpp) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) }) }))) +sem_Decl_NewType :: String -> + ([String]) -> + String -> + T_Type -> + T_Decl +sem_Decl_NewType !name_ !params_ !con_ !(T_Type tp_) = + (T_Decl (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (_lhsInested) of + { !_tpOnested -> + (case ((tp_ _tpOnested)) of + { ( !_tpIpp,!_tpIprec) -> + (case ("newtype" >#< hv_sp (name_ : params_) >#< "=" >#< con_ >#< pp_parens _tpIpp) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }))) +sem_Decl_PragmaDecl :: String -> + T_Decl +sem_Decl_PragmaDecl !txt_ = + (T_Decl (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case ("{-#" >#< text txt_ >#< "#-}") of + { !_lhsOpp -> + ( _lhsOpp) }))) +sem_Decl_TSig :: String -> + T_Type -> + T_Decl +sem_Decl_TSig !name_ !(T_Type tp_) = + (T_Decl (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (_lhsInested) of + { !_tpOnested -> + (case ((tp_ _tpOnested)) of + { ( !_tpIpp,!_tpIprec) -> + (case (name_ >#< "::" >#< _tpIpp) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }))) +sem_Decl_Type :: String -> + ([String]) -> + T_Type -> + T_Decl +sem_Decl_Type !name_ !params_ !(T_Type tp_) = + (T_Decl (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (_lhsInested) of + { !_tpOnested -> + (case ((tp_ _tpOnested)) of + { ( !_tpIpp,!_tpIprec) -> + (case ("type" >#< hv_sp (name_ : params_) >#< "=" >#< _tpIpp) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }))) +-- Decls ------------------------------------------------------- +{- + visit 0: + inherited attributes: + isDeclOfLet : Bool + nested : Bool + options : Options + outputfile : String + synthesized attribute: + pps : PP_Docs + alternatives: + alternative Cons: + child hd : Decl + child tl : Decls + alternative Nil: +-} +-- cata +sem_Decls :: Decls -> + T_Decls +sem_Decls !list = + (Prelude.foldr sem_Decls_Cons sem_Decls_Nil (Prelude.map sem_Decl list)) +-- semantic domain +newtype T_Decls = T_Decls (Bool -> + Bool -> + Options -> + String -> + ( PP_Docs)) +data Inh_Decls = Inh_Decls {isDeclOfLet_Inh_Decls :: !(Bool),nested_Inh_Decls :: !(Bool),options_Inh_Decls :: !(Options),outputfile_Inh_Decls :: !(String)} +data Syn_Decls = Syn_Decls {pps_Syn_Decls :: !(PP_Docs)} +wrap_Decls !(T_Decls sem) !(Inh_Decls _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) = + (let ( !_lhsOpps) = + (sem _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) + in (Syn_Decls _lhsOpps)) +sem_Decls_Cons :: T_Decl -> + T_Decls -> + T_Decls +sem_Decls_Cons !(T_Decl hd_) !(T_Decls tl_) = + (T_Decls (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (_lhsIoutputfile) of + { !_tlOoutputfile -> + (case (_lhsIoptions) of + { !_tlOoptions -> + (case (_lhsInested) of + { !_tlOnested -> + (case (_lhsIisDeclOfLet) of + { !_tlOisDeclOfLet -> + (case (_lhsIoutputfile) of + { !_hdOoutputfile -> + (case (_lhsIoptions) of + { !_hdOoptions -> + (case (_lhsInested) of + { !_hdOnested -> + (case (_lhsIisDeclOfLet) of + { !_hdOisDeclOfLet -> + (case ((tl_ _tlOisDeclOfLet _tlOnested _tlOoptions _tlOoutputfile)) of + { ( !_tlIpps) -> + (case ((hd_ _hdOisDeclOfLet _hdOnested _hdOoptions _hdOoutputfile)) of + { ( !_hdIpp) -> + (case (_hdIpp : _tlIpps) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) }) }) }) }) }) }) }) }))) +sem_Decls_Nil :: T_Decls +sem_Decls_Nil = + (T_Decls (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case ([]) of + { !_lhsOpps -> + ( _lhsOpps) }))) +-- Expr -------------------------------------------------------- +{- + visit 0: + inherited attributes: + nested : Bool + options : Options + outputfile : String + synthesized attribute: + pp : PP_Doc + alternatives: + alternative App: + child name : {String} + child args : Exprs + alternative Case: + child expr : Expr + child alts : CaseAlts + alternative Lambda: + child args : Exprs + child body : Expr + visit 0: + local addBang : _ + local strictParams : _ + alternative Let: + child decls : Decls + child body : Expr + alternative LineExpr: + child expr : Expr + alternative PragmaExpr: + child onLeftSide : {Bool} + child onNewLine : {Bool} + child txt : {String} + child expr : Expr + alternative SimpleExpr: + child txt : {String} + alternative TextExpr: + child lns : {[String]} + alternative Trace: + child txt : {String} + child expr : Expr + alternative TupleExpr: + child exprs : Exprs + alternative TypedExpr: + child expr : Expr + child tp : Type + alternative UnboxedTupleExpr: + child exprs : Exprs +-} +-- cata +sem_Expr :: Expr -> + T_Expr +sem_Expr !(App _name _args) = + (sem_Expr_App _name (sem_Exprs _args)) +sem_Expr !(Case _expr _alts) = + (sem_Expr_Case (sem_Expr _expr) (sem_CaseAlts _alts)) +sem_Expr !(Lambda _args _body) = + (sem_Expr_Lambda (sem_Exprs _args) (sem_Expr _body)) +sem_Expr !(Let _decls _body) = + (sem_Expr_Let (sem_Decls _decls) (sem_Expr _body)) +sem_Expr !(LineExpr _expr) = + (sem_Expr_LineExpr (sem_Expr _expr)) +sem_Expr !(PragmaExpr _onLeftSide _onNewLine _txt _expr) = + (sem_Expr_PragmaExpr _onLeftSide _onNewLine _txt (sem_Expr _expr)) +sem_Expr !(SimpleExpr _txt) = + (sem_Expr_SimpleExpr _txt) +sem_Expr !(TextExpr _lns) = + (sem_Expr_TextExpr _lns) +sem_Expr !(Trace _txt _expr) = + (sem_Expr_Trace _txt (sem_Expr _expr)) +sem_Expr !(TupleExpr _exprs) = + (sem_Expr_TupleExpr (sem_Exprs _exprs)) +sem_Expr !(TypedExpr _expr _tp) = + (sem_Expr_TypedExpr (sem_Expr _expr) (sem_Type _tp)) +sem_Expr !(UnboxedTupleExpr _exprs) = + (sem_Expr_UnboxedTupleExpr (sem_Exprs _exprs)) +-- semantic domain +newtype T_Expr = T_Expr (Bool -> + Options -> + String -> + ( PP_Doc)) +data Inh_Expr = Inh_Expr {nested_Inh_Expr :: !(Bool),options_Inh_Expr :: !(Options),outputfile_Inh_Expr :: !(String)} +data Syn_Expr = Syn_Expr {pp_Syn_Expr :: !(PP_Doc)} +wrap_Expr !(T_Expr sem) !(Inh_Expr _lhsInested _lhsIoptions _lhsIoutputfile) = + (let ( !_lhsOpp) = + (sem _lhsInested _lhsIoptions _lhsIoutputfile) + in (Syn_Expr _lhsOpp)) +sem_Expr_App :: String -> + T_Exprs -> + T_Expr +sem_Expr_App !name_ !(T_Exprs args_) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (_lhsIoutputfile) of + { !_argsOoutputfile -> + (case (_lhsIoptions) of + { !_argsOoptions -> + (case (_lhsInested) of + { !_argsOnested -> + (case ((args_ _argsOnested _argsOoptions _argsOoutputfile)) of + { ( !_argsIpps) -> + (case (pp_parens $ name_ >#< hv_sp _argsIpps) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }))) +sem_Expr_Case :: T_Expr -> + T_CaseAlts -> + T_Expr +sem_Expr_Case !(T_Expr expr_) !(T_CaseAlts alts_) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (_lhsIoutputfile) of + { !_altsOoutputfile -> + (case (_lhsIoptions) of + { !_altsOoptions -> + (case (_lhsInested) of + { !_altsOnested -> + (case (_lhsIoutputfile) of + { !_exprOoutputfile -> + (case (_lhsIoptions) of + { !_exprOoptions -> + (case (_lhsInested) of + { !_exprOnested -> + (case ((alts_ _altsOnested _altsOoptions _altsOoutputfile)) of + { ( !_altsIpps) -> + (case ((expr_ _exprOnested _exprOoptions _exprOoutputfile)) of + { ( !_exprIpp) -> + (case (pp_parens ( "case" >#< pp_parens _exprIpp >#< "of" + >-< (vlist _altsIpps) + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) }))) +sem_Expr_Lambda :: T_Exprs -> + T_Expr -> + T_Expr +sem_Expr_Lambda !(T_Exprs args_) !(T_Expr body_) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (_lhsIoutputfile) of + { !_bodyOoutputfile -> + (case (_lhsIoptions) of + { !_bodyOoptions -> + (case (_lhsInested) of + { !_bodyOnested -> + (case (_lhsIoutputfile) of + { !_argsOoutputfile -> + (case (_lhsIoptions) of + { !_argsOoptions -> + (case (_lhsInested) of + { !_argsOnested -> + (case (if bangpats _lhsIoptions + then \p -> pp_parens ("!" >|< p) + else id) of + { !_addBang -> + (case ((args_ _argsOnested _argsOoptions _argsOoutputfile)) of + { ( !_argsIpps) -> + (case (if strictSems _lhsIoptions + then _argsIpps + else []) of + { !_strictParams -> + (case ((body_ _bodyOnested _bodyOoptions _bodyOoutputfile)) of + { ( !_bodyIpp) -> + (case (pp_parens ( "\\" >#< (vlist (map _addBang _argsIpps)) >#< "->" + >-< indent 4 (_strictParams `ppMultiSeqV` _bodyIpp) + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) }) }) }))) +sem_Expr_Let :: T_Decls -> + T_Expr -> + T_Expr +sem_Expr_Let !(T_Decls decls_) !(T_Expr body_) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (_lhsIoutputfile) of + { !_bodyOoutputfile -> + (case (_lhsIoptions) of + { !_bodyOoptions -> + (case (_lhsInested) of + { !_bodyOnested -> + (case (_lhsIoutputfile) of + { !_declsOoutputfile -> + (case (_lhsIoptions) of + { !_declsOoptions -> + (case (_lhsInested) of + { !_declsOnested -> + (case (True) of + { !_declsOisDeclOfLet -> + (case ((body_ _bodyOnested _bodyOoptions _bodyOoutputfile)) of + { ( !_bodyIpp) -> + (case ((decls_ _declsOisDeclOfLet _declsOnested _declsOoptions _declsOoutputfile)) of + { ( !_declsIpps) -> + (case (pp_parens ( "let" >#< (vlist _declsIpps) + >-< "in " >#< _bodyIpp + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) }) }))) +sem_Expr_LineExpr :: T_Expr -> + T_Expr +sem_Expr_LineExpr !(T_Expr expr_) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (_lhsIoutputfile) of + { !_exprOoutputfile -> + (case (_lhsIoptions) of + { !_exprOoptions -> + (case (_lhsInested) of + { !_exprOnested -> + (case ((expr_ _exprOnested _exprOoptions _exprOoutputfile)) of + { ( !_exprIpp) -> + (case (_exprIpp >-< "{-# LINE" >#< ppWithLineNr (\n -> pp $ show $ n + 1) >#< show _lhsIoutputfile >#< "#-}") of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }))) +sem_Expr_PragmaExpr :: Bool -> + Bool -> + String -> + T_Expr -> + T_Expr +sem_Expr_PragmaExpr !onLeftSide_ !onNewLine_ !txt_ !(T_Expr expr_) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (_lhsIoutputfile) of + { !_exprOoutputfile -> + (case (_lhsIoptions) of + { !_exprOoptions -> + (case (_lhsInested) of + { !_exprOnested -> + (case ((expr_ _exprOnested _exprOoptions _exprOoutputfile)) of + { ( !_exprIpp) -> + (case (let pragmaDoc = "{-#" >#< txt_ >#< "#-}" + op = if onNewLine_ + then (>-<) + else (>#<) + leftOp x y = if onLeftSide_ + then x `op` y + else y + rightOp x y = if onLeftSide_ + then x + else x `op` y + in pragmaDoc `leftOp` _exprIpp `rightOp` pragmaDoc) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }))) +sem_Expr_SimpleExpr :: String -> + T_Expr +sem_Expr_SimpleExpr !txt_ = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (text txt_) of + { !_lhsOpp -> + ( _lhsOpp) }))) +sem_Expr_TextExpr :: ([String]) -> + T_Expr +sem_Expr_TextExpr !lns_ = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (vlist (map text lns_)) of + { !_lhsOpp -> + ( _lhsOpp) }))) +sem_Expr_Trace :: String -> + T_Expr -> + T_Expr +sem_Expr_Trace !txt_ !(T_Expr expr_) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (_lhsIoutputfile) of + { !_exprOoutputfile -> + (case (_lhsIoptions) of + { !_exprOoptions -> + (case (_lhsInested) of + { !_exprOnested -> + (case ((expr_ _exprOnested _exprOoptions _exprOoutputfile)) of + { ( !_exprIpp) -> + (case ("trace" >#< ( pp_parens ("\"" >|< text txt_ >|< "\"") + >-< pp_parens _exprIpp + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }))) +sem_Expr_TupleExpr :: T_Exprs -> + T_Expr +sem_Expr_TupleExpr !(T_Exprs exprs_) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (_lhsIoutputfile) of + { !_exprsOoutputfile -> + (case (_lhsIoptions) of + { !_exprsOoptions -> + (case (_lhsInested) of + { !_exprsOnested -> + (case ((exprs_ _exprsOnested _exprsOoptions _exprsOoutputfile)) of + { ( !_exprsIpps) -> + (case (ppTuple _lhsInested _exprsIpps) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }))) +sem_Expr_TypedExpr :: T_Expr -> + T_Type -> + T_Expr +sem_Expr_TypedExpr !(T_Expr expr_) !(T_Type tp_) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (_lhsInested) of + { !_tpOnested -> + (case (_lhsIoutputfile) of + { !_exprOoutputfile -> + (case (_lhsIoptions) of + { !_exprOoptions -> + (case (_lhsInested) of + { !_exprOnested -> + (case ((tp_ _tpOnested)) of + { ( !_tpIpp,!_tpIprec) -> + (case ((expr_ _exprOnested _exprOoptions _exprOoutputfile)) of + { ( !_exprIpp) -> + (case (pp_parens (_exprIpp >#< "::" >#< _tpIpp)) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }))) +sem_Expr_UnboxedTupleExpr :: T_Exprs -> + T_Expr +sem_Expr_UnboxedTupleExpr !(T_Exprs exprs_) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (_lhsIoutputfile) of + { !_exprsOoutputfile -> + (case (_lhsIoptions) of + { !_exprsOoptions -> + (case (_lhsInested) of + { !_exprsOnested -> + (case ((exprs_ _exprsOnested _exprsOoptions _exprsOoutputfile)) of + { ( !_exprsIpps) -> + (case (ppUnboxedTuple _lhsInested _exprsIpps) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }))) +-- Exprs ------------------------------------------------------- +{- + visit 0: + inherited attributes: + nested : Bool + options : Options + outputfile : String + synthesized attribute: + pps : PP_Docs + alternatives: + alternative Cons: + child hd : Expr + child tl : Exprs + alternative Nil: +-} +-- cata +sem_Exprs :: Exprs -> + T_Exprs +sem_Exprs !list = + (Prelude.foldr sem_Exprs_Cons sem_Exprs_Nil (Prelude.map sem_Expr list)) +-- semantic domain +newtype T_Exprs = T_Exprs (Bool -> + Options -> + String -> + ( PP_Docs)) +data Inh_Exprs = Inh_Exprs {nested_Inh_Exprs :: !(Bool),options_Inh_Exprs :: !(Options),outputfile_Inh_Exprs :: !(String)} +data Syn_Exprs = Syn_Exprs {pps_Syn_Exprs :: !(PP_Docs)} +wrap_Exprs !(T_Exprs sem) !(Inh_Exprs _lhsInested _lhsIoptions _lhsIoutputfile) = + (let ( !_lhsOpps) = + (sem _lhsInested _lhsIoptions _lhsIoutputfile) + in (Syn_Exprs _lhsOpps)) +sem_Exprs_Cons :: T_Expr -> + T_Exprs -> + T_Exprs +sem_Exprs_Cons !(T_Expr hd_) !(T_Exprs tl_) = + (T_Exprs (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (_lhsIoutputfile) of + { !_tlOoutputfile -> + (case (_lhsIoptions) of + { !_tlOoptions -> + (case (_lhsInested) of + { !_tlOnested -> + (case (_lhsIoutputfile) of + { !_hdOoutputfile -> + (case (_lhsIoptions) of + { !_hdOoptions -> + (case (_lhsInested) of + { !_hdOnested -> + (case ((tl_ _tlOnested _tlOoptions _tlOoutputfile)) of + { ( !_tlIpps) -> + (case ((hd_ _hdOnested _hdOoptions _hdOoutputfile)) of + { ( !_hdIpp) -> + (case (_hdIpp : _tlIpps) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) }) }) }) }) }) }))) +sem_Exprs_Nil :: T_Exprs +sem_Exprs_Nil = + (T_Exprs (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case ([]) of + { !_lhsOpps -> + ( _lhsOpps) }))) +-- Lhs --------------------------------------------------------- +{- + visit 0: + inherited attributes: + isDeclOfLet : Bool + nested : Bool + options : Options + outputfile : String + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Fun: + child name : {String} + child args : Exprs + visit 0: + local addBang : _ + local strictGuard : _ + local hasStrictVars : _ + local addStrictGuard : _ + alternative Pattern3: + child pat3 : Pattern + visit 0: + local hasStrictVars : _ + local strictGuard : _ + local addStrictGuard : _ + alternative Pattern3SM: + child pat3 : Pattern + alternative TupleLhs: + child comps : {[String]} + visit 0: + local addBang : _ + local hasStrictVars : _ + local strictGuard : _ + local addStrictGuard : _ + alternative UnboxedTupleLhs: + child comps : {[String]} + visit 0: + local addBang : _ + local hasStrictVars : _ + local strictGuard : _ + local addStrictGuard : _ +-} +-- cata +sem_Lhs :: Lhs -> + T_Lhs +sem_Lhs !(Fun _name _args) = + (sem_Lhs_Fun _name (sem_Exprs _args)) +sem_Lhs !(Pattern3 _pat3) = + (sem_Lhs_Pattern3 (sem_Pattern _pat3)) +sem_Lhs !(Pattern3SM _pat3) = + (sem_Lhs_Pattern3SM (sem_Pattern _pat3)) +sem_Lhs !(TupleLhs _comps) = + (sem_Lhs_TupleLhs _comps) +sem_Lhs !(UnboxedTupleLhs _comps) = + (sem_Lhs_UnboxedTupleLhs _comps) +-- semantic domain +newtype T_Lhs = T_Lhs (Bool -> + Bool -> + Options -> + String -> + ( PP_Doc)) +data Inh_Lhs = Inh_Lhs {isDeclOfLet_Inh_Lhs :: !(Bool),nested_Inh_Lhs :: !(Bool),options_Inh_Lhs :: !(Options),outputfile_Inh_Lhs :: !(String)} +data Syn_Lhs = Syn_Lhs {pp_Syn_Lhs :: !(PP_Doc)} +wrap_Lhs !(T_Lhs sem) !(Inh_Lhs _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) = + (let ( !_lhsOpp) = + (sem _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) + in (Syn_Lhs _lhsOpp)) +sem_Lhs_Fun :: String -> + T_Exprs -> + T_Lhs +sem_Lhs_Fun !name_ !(T_Exprs args_) = + (T_Lhs (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (_lhsIoutputfile) of + { !_argsOoutputfile -> + (case (_lhsIoptions) of + { !_argsOoptions -> + (case (_lhsInested) of + { !_argsOnested -> + (case (if bangpats _lhsIoptions + then \p -> "!" >|< p + else id) of + { !_addBang -> + (case ((args_ _argsOnested _argsOoptions _argsOoutputfile)) of + { ( !_argsIpps) -> + (case (_argsIpps `ppMultiSeqH` (pp "True")) of + { !_strictGuard -> + (case (not (null _argsIpps)) of + { !_hasStrictVars -> + (case (if strictSems _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id) of + { !_addStrictGuard -> + (case (_addStrictGuard (name_ >#< hv_sp (map _addBang _argsIpps))) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) }))) +sem_Lhs_Pattern3 :: T_Pattern -> + T_Lhs +sem_Lhs_Pattern3 !(T_Pattern pat3_) = + (T_Lhs (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (_lhsIoptions) of + { !_pat3Ooptions -> + (case (_lhsIisDeclOfLet) of + { !_pat3OisDeclOfLet -> + (case (False) of + { !_pat3ObelowIrrefutable -> + (case ((pat3_ _pat3ObelowIrrefutable _pat3OisDeclOfLet _pat3Ooptions)) of + { ( !_pat3Icopy,!_pat3IisUnderscore,!_pat3Ipp,!_pat3Ipp',!_pat3IstrictVars) -> + (case (not (null _pat3IstrictVars)) of + { !_hasStrictVars -> + (case (_pat3IstrictVars `ppMultiSeqH` (pp "True")) of + { !_strictGuard -> + (case (if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id) of + { !_addStrictGuard -> + (case (_addStrictGuard _pat3Ipp) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }))) +sem_Lhs_Pattern3SM :: T_Pattern -> + T_Lhs +sem_Lhs_Pattern3SM !(T_Pattern pat3_) = + (T_Lhs (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (_lhsIoptions) of + { !_pat3Ooptions -> + (case (_lhsIisDeclOfLet) of + { !_pat3OisDeclOfLet -> + (case (False) of + { !_pat3ObelowIrrefutable -> + (case ((pat3_ _pat3ObelowIrrefutable _pat3OisDeclOfLet _pat3Ooptions)) of + { ( !_pat3Icopy,!_pat3IisUnderscore,!_pat3Ipp,!_pat3Ipp',!_pat3IstrictVars) -> + (case (_pat3Ipp') of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }))) +sem_Lhs_TupleLhs :: ([String]) -> + T_Lhs +sem_Lhs_TupleLhs !comps_ = + (T_Lhs (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (if bangpats _lhsIoptions + then \p -> "!" >|< p + else id) of + { !_addBang -> + (case (not (null comps_)) of + { !_hasStrictVars -> + (case (if stricterCases _lhsIoptions && not _lhsIisDeclOfLet + then map text comps_ `ppMultiSeqH` (pp "True") + else pp "True") of + { !_strictGuard -> + (case (if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id) of + { !_addStrictGuard -> + (case (_addStrictGuard $ ppTuple _lhsInested (map (_addBang . text) comps_)) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }))) +sem_Lhs_UnboxedTupleLhs :: ([String]) -> + T_Lhs +sem_Lhs_UnboxedTupleLhs !comps_ = + (T_Lhs (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (if bangpats _lhsIoptions + then \p -> "!" >|< p + else id) of + { !_addBang -> + (case (not (null comps_)) of + { !_hasStrictVars -> + (case (if stricterCases _lhsIoptions && not _lhsIisDeclOfLet + then map text comps_ `ppMultiSeqH` (pp "True") + else pp "True") of + { !_strictGuard -> + (case (if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id) of + { !_addStrictGuard -> + (case (_addStrictGuard $ ppUnboxedTuple _lhsInested (map (_addBang . text) comps_)) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }))) +-- Pattern ----------------------------------------------------- +{- + visit 0: + inherited attributes: + belowIrrefutable : Bool + isDeclOfLet : Bool + options : Options + synthesized attributes: + copy : SELF + isUnderscore : Bool + pp : PP_Doc + pp' : PP_Doc + strictVars : [PP_Doc] + alternatives: + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + child parts : Patterns + visit 0: + local copy : _ + local ppVar : _ + local addBang : _ + local ppVarBang : _ + local strictPatVars : _ + local strictVar : _ + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + local addBang : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + local addBang : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ +-} +-- 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 (Bool -> + Bool -> + Options -> + ( Pattern,Bool,PP_Doc,PP_Doc,([PP_Doc]))) +data Inh_Pattern = Inh_Pattern {belowIrrefutable_Inh_Pattern :: !(Bool),isDeclOfLet_Inh_Pattern :: !(Bool),options_Inh_Pattern :: !(Options)} +data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: !(Pattern),isUnderscore_Syn_Pattern :: !(Bool),pp_Syn_Pattern :: !(PP_Doc),pp'_Syn_Pattern :: !(PP_Doc),strictVars_Syn_Pattern :: !([PP_Doc])} +wrap_Pattern !(T_Pattern sem) !(Inh_Pattern _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) = + (let ( !_lhsOcopy,!_lhsOisUnderscore,!_lhsOpp,!_lhsOpp',!_lhsOstrictVars) = + (sem _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) + in (Syn_Pattern _lhsOcopy _lhsOisUnderscore _lhsOpp _lhsOpp' _lhsOstrictVars)) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Patterns -> + T_Pattern +sem_Pattern_Alias !field_ !attr_ !(T_Pattern pat_) !(T_Patterns parts_) = + (T_Pattern (\ (!_lhsIbelowIrrefutable) + (!_lhsIisDeclOfLet) + (!_lhsIoptions) -> + (case (_lhsIoptions) of + { !_partsOoptions -> + (case (_lhsIisDeclOfLet) of + { !_partsOisDeclOfLet -> + (case (_lhsIbelowIrrefutable) of + { !_partsObelowIrrefutable -> + (case ((parts_ _partsObelowIrrefutable _partsOisDeclOfLet _partsOoptions)) of + { ( !_partsIcopy,!_partsIpps,!_partsIpps',!_partsIstrictVars) -> + (case (_lhsIoptions) of + { !_patOoptions -> + (case (_lhsIisDeclOfLet) of + { !_patOisDeclOfLet -> + (case (_lhsIbelowIrrefutable) of + { !_patObelowIrrefutable -> + (case ((pat_ _patObelowIrrefutable _patOisDeclOfLet _patOoptions)) of + { ( !_patIcopy,!_patIisUnderscore,!_patIpp,!_patIpp',!_patIstrictVars) -> + (case (Alias field_ attr_ _patIcopy _partsIcopy) of + { !_copy -> + (case (_copy) of + { !_lhsOcopy -> + (case (False) of + { !_lhsOisUnderscore -> + (case (pp (attrname False field_ attr_)) of + { !_ppVar -> + (case (if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable + then \p -> "!" >|< p + else id) of + { !_addBang -> + (case (_addBang $ _ppVar) of + { !_ppVarBang -> + (case (if _patIisUnderscore + then _ppVarBang + else _ppVarBang >|< "@" >|< _patIpp) of + { !_lhsOpp -> + (case (let attribute | field_ == _LOC || field_ == nullIdent = locname' attr_ + | otherwise = attrname False field_ attr_ + in attribute >|< "@" >|< _patIpp') of + { !_lhsOpp' -> + (case (if stricterCases _lhsIoptions && not _lhsIisDeclOfLet + then _patIstrictVars + else []) of + { !_strictPatVars -> + (case (if strictCases _lhsIoptions && not _lhsIisDeclOfLet + then [_ppVar ] + else []) of + { !_strictVar -> + (case (_strictVar ++ _strictPatVars) of + { !_lhsOstrictVars -> + ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr !name_ !(T_Patterns pats_) = + (T_Pattern (\ (!_lhsIbelowIrrefutable) + (!_lhsIisDeclOfLet) + (!_lhsIoptions) -> + (case (_lhsIoptions) of + { !_patsOoptions -> + (case (_lhsIisDeclOfLet) of + { !_patsOisDeclOfLet -> + (case (_lhsIbelowIrrefutable) of + { !_patsObelowIrrefutable -> + (case ((pats_ _patsObelowIrrefutable _patsOisDeclOfLet _patsOoptions)) of + { ( !_patsIcopy,!_patsIpps,!_patsIpps',!_patsIstrictVars) -> + (case (Constr name_ _patsIcopy) of + { !_copy -> + (case (_copy) of + { !_lhsOcopy -> + (case (False) of + { !_lhsOisUnderscore -> + (case (if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable + then \p -> "!" >|< p + else id) of + { !_addBang -> + (case (_addBang $ pp_parens $ name_ >#< hv_sp _patsIpps) of + { !_lhsOpp -> + (case (pp_parens $ name_ >#< hv_sp (map pp_parens _patsIpps')) of + { !_lhsOpp' -> + (case (_patsIstrictVars) of + { !_lhsOstrictVars -> + ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars) }) }) }) }) }) }) }) }) }) }) }))) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable !(T_Pattern pat_) = + (T_Pattern (\ (!_lhsIbelowIrrefutable) + (!_lhsIisDeclOfLet) + (!_lhsIoptions) -> + (case (_lhsIoptions) of + { !_patOoptions -> + (case (_lhsIisDeclOfLet) of + { !_patOisDeclOfLet -> + (case (True) of + { !_patObelowIrrefutable -> + (case ((pat_ _patObelowIrrefutable _patOisDeclOfLet _patOoptions)) of + { ( !_patIcopy,!_patIisUnderscore,!_patIpp,!_patIpp',!_patIstrictVars) -> + (case (Irrefutable _patIcopy) of + { !_copy -> + (case (_copy) of + { !_lhsOcopy -> + (case (_patIisUnderscore) of + { !_lhsOisUnderscore -> + (case (text "~" >|< pp_parens _patIpp) of + { !_lhsOpp -> + (case (text "~" >|< pp_parens _patIpp) of + { !_lhsOpp' -> + (case ([]) of + { !_lhsOstrictVars -> + ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars) }) }) }) }) }) }) }) }) }) }))) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product !pos_ !(T_Patterns pats_) = + (T_Pattern (\ (!_lhsIbelowIrrefutable) + (!_lhsIisDeclOfLet) + (!_lhsIoptions) -> + (case (_lhsIoptions) of + { !_patsOoptions -> + (case (_lhsIisDeclOfLet) of + { !_patsOisDeclOfLet -> + (case (_lhsIbelowIrrefutable) of + { !_patsObelowIrrefutable -> + (case ((pats_ _patsObelowIrrefutable _patsOisDeclOfLet _patsOoptions)) of + { ( !_patsIcopy,!_patsIpps,!_patsIpps',!_patsIstrictVars) -> + (case (Product pos_ _patsIcopy) of + { !_copy -> + (case (_copy) of + { !_lhsOcopy -> + (case (False) of + { !_lhsOisUnderscore -> + (case (if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable + then \p -> "!" >|< p + else id) of + { !_addBang -> + (case (_addBang $ pp_block "(" ")" "," _patsIpps) of + { !_lhsOpp -> + (case (pp_block "(" ")" "," _patsIpps') of + { !_lhsOpp' -> + (case (_patsIstrictVars) of + { !_lhsOstrictVars -> + ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars) }) }) }) }) }) }) }) }) }) }) }))) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore !pos_ = + (T_Pattern (\ (!_lhsIbelowIrrefutable) + (!_lhsIisDeclOfLet) + (!_lhsIoptions) -> + (case (Underscore pos_) of + { !_copy -> + (case (_copy) of + { !_lhsOcopy -> + (case (True) of + { !_lhsOisUnderscore -> + (case (text "_") of + { !_lhsOpp -> + (case (text "_") of + { !_lhsOpp' -> + (case ([]) of + { !_lhsOstrictVars -> + ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars) }) }) }) }) }) }))) +-- Patterns ---------------------------------------------------- +{- + visit 0: + inherited attributes: + belowIrrefutable : Bool + isDeclOfLet : Bool + options : Options + synthesized attributes: + copy : SELF + pps : [PP_Doc] + pps' : [PP_Doc] + strictVars : [PP_Doc] + alternatives: + alternative Cons: + child hd : Pattern + child tl : Patterns + visit 0: + local copy : _ + alternative Nil: + visit 0: + local copy : _ +-} +-- 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 (Bool -> + Bool -> + Options -> + ( Patterns,([PP_Doc]),([PP_Doc]),([PP_Doc]))) +data Inh_Patterns = Inh_Patterns {belowIrrefutable_Inh_Patterns :: !(Bool),isDeclOfLet_Inh_Patterns :: !(Bool),options_Inh_Patterns :: !(Options)} +data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: !(Patterns),pps_Syn_Patterns :: !([PP_Doc]),pps'_Syn_Patterns :: !([PP_Doc]),strictVars_Syn_Patterns :: !([PP_Doc])} +wrap_Patterns !(T_Patterns sem) !(Inh_Patterns _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) = + (let ( !_lhsOcopy,!_lhsOpps,!_lhsOpps',!_lhsOstrictVars) = + (sem _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) + in (Syn_Patterns _lhsOcopy _lhsOpps _lhsOpps' _lhsOstrictVars)) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons !(T_Pattern hd_) !(T_Patterns tl_) = + (T_Patterns (\ (!_lhsIbelowIrrefutable) + (!_lhsIisDeclOfLet) + (!_lhsIoptions) -> + (case (_lhsIoptions) of + { !_tlOoptions -> + (case (_lhsIisDeclOfLet) of + { !_tlOisDeclOfLet -> + (case (_lhsIbelowIrrefutable) of + { !_tlObelowIrrefutable -> + (case ((tl_ _tlObelowIrrefutable _tlOisDeclOfLet _tlOoptions)) of + { ( !_tlIcopy,!_tlIpps,!_tlIpps',!_tlIstrictVars) -> + (case (_lhsIoptions) of + { !_hdOoptions -> + (case (_lhsIisDeclOfLet) of + { !_hdOisDeclOfLet -> + (case (_lhsIbelowIrrefutable) of + { !_hdObelowIrrefutable -> + (case ((hd_ _hdObelowIrrefutable _hdOisDeclOfLet _hdOoptions)) of + { ( !_hdIcopy,!_hdIisUnderscore,!_hdIpp,!_hdIpp',!_hdIstrictVars) -> + (case ((:) _hdIcopy _tlIcopy) of + { !_copy -> + (case (_copy) of + { !_lhsOcopy -> + (case (_hdIpp : _tlIpps) of + { !_lhsOpps -> + (case (_hdIpp' : _tlIpps') of + { !_lhsOpps' -> + (case (_hdIstrictVars ++ _tlIstrictVars) of + { !_lhsOstrictVars -> + ( _lhsOcopy,_lhsOpps,_lhsOpps',_lhsOstrictVars) }) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (\ (!_lhsIbelowIrrefutable) + (!_lhsIisDeclOfLet) + (!_lhsIoptions) -> + (case ([]) of + { !_copy -> + (case (_copy) of + { !_lhsOcopy -> + (case ([]) of + { !_lhsOpps -> + (case ([]) of + { !_lhsOpps' -> + (case ([]) of + { !_lhsOstrictVars -> + ( _lhsOcopy,_lhsOpps,_lhsOpps',_lhsOstrictVars) }) }) }) }) }))) +-- Program ----------------------------------------------------- +{- + visit 0: + inherited attributes: + importBlocks : PP_Doc + mainFile : String + mainName : String + moduleHeader : String -> String -> String -> Bool -> String + options : Options + optionsLine : String + pragmaBlocks : String + textBlockMap : Map BlockInfo PP_Doc + textBlocks : PP_Doc + synthesized attributes: + genIO : IO () + output : PP_Docs + alternatives: + alternative Program: + child chunks : Chunks + visit 0: + local commonFile : _ + local genCommonModule : _ + local mainModuleFile : _ + local genMainModule : _ +-} +-- cata +sem_Program :: Program -> + T_Program +sem_Program !(Program _chunks) = + (sem_Program_Program (sem_Chunks _chunks)) +-- semantic domain +newtype T_Program = T_Program (PP_Doc -> + String -> + String -> + (String -> String -> String -> Bool -> String) -> + Options -> + String -> + String -> + (Map BlockInfo PP_Doc) -> + PP_Doc -> + ( (IO ()),PP_Docs)) +data Inh_Program = Inh_Program {importBlocks_Inh_Program :: !(PP_Doc),mainFile_Inh_Program :: !(String),mainName_Inh_Program :: !(String),moduleHeader_Inh_Program :: !(String -> String -> String -> Bool -> String),options_Inh_Program :: !(Options),optionsLine_Inh_Program :: !(String),pragmaBlocks_Inh_Program :: !(String),textBlockMap_Inh_Program :: !(Map BlockInfo PP_Doc),textBlocks_Inh_Program :: !(PP_Doc)} +data Syn_Program = Syn_Program {genIO_Syn_Program :: !(IO ()),output_Syn_Program :: !(PP_Docs)} +wrap_Program !(T_Program sem) !(Inh_Program _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks) = + (let ( !_lhsOgenIO,!_lhsOoutput) = + (sem _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks) + in (Syn_Program _lhsOgenIO _lhsOoutput)) +sem_Program_Program :: T_Chunks -> + T_Program +sem_Program_Program !(T_Chunks chunks_) = + (T_Program (\ (!_lhsIimportBlocks) + (!_lhsImainFile) + (!_lhsImainName) + (!_lhsImoduleHeader) + (!_lhsIoptions) + (!_lhsIoptionsLine) + (!_lhsIpragmaBlocks) + (!_lhsItextBlockMap) + (!_lhsItextBlocks) -> + (case (_lhsItextBlockMap) of + { !_chunksOtextBlockMap -> + (case (_lhsIpragmaBlocks) of + { !_chunksOpragmaBlocks -> + (case (_lhsIoptionsLine) of + { !_chunksOoptionsLine -> + (case (_lhsIoptions) of + { !_chunksOoptions -> + (case (_lhsImoduleHeader) of + { !_chunksOmoduleHeader -> + (case (_lhsImainName) of + { !_chunksOmainName -> + (case (_lhsImainFile) of + { !_chunksOmainFile -> + (case (_lhsImainFile ++ "_common.hs") of + { !_commonFile -> + (case (False) of + { !_chunksOisDeclOfLet -> + (case (nest _lhsIoptions) of + { !_chunksOnested -> + (case (_lhsItextBlocks) of + { !_chunksOtextBlocks -> + (case (_lhsIimportBlocks) of + { !_chunksOimportBlocks -> + (case ((chunks_ _chunksOimportBlocks _chunksOisDeclOfLet _chunksOmainFile _chunksOmainName _chunksOmoduleHeader _chunksOnested _chunksOoptions _chunksOoptionsLine _chunksOpragmaBlocks _chunksOtextBlockMap _chunksOtextBlocks)) of + { ( !_chunksIappendCommon,!_chunksIappendMain,!_chunksIgenSems,!_chunksIimports,!_chunksIpps) -> + (case (writeModule _commonFile + ( [ pp $ _lhsIpragmaBlocks + , pp $ _lhsIoptionsLine + , pp $ _lhsImoduleHeader _lhsImainName "_common" "" True + , _lhsIimportBlocks + , _lhsItextBlocks + ] + ++ map vlist _chunksIappendCommon + )) of + { !_genCommonModule -> + (case (_lhsImainFile ++ ".hs") of + { !_mainModuleFile -> + (case (writeModule _mainModuleFile + ( [ pp $ _lhsIpragmaBlocks + , pp $ _lhsIoptionsLine + , pp $ _lhsImoduleHeader _lhsImainName "" "" False + , pp $ ("import " ++ _lhsImainName ++ "_common\n") + ] + ++ map pp _chunksIimports + ++ map vlist _chunksIappendMain + )) of + { !_genMainModule -> + (case (do _genMainModule + _genCommonModule + _chunksIgenSems) of + { !_lhsOgenIO -> + (case (_chunksIpps) of + { !_lhsOoutput -> + ( _lhsOgenIO,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +-- Type -------------------------------------------------------- +{- + visit 0: + inherited attribute: + nested : Bool + synthesized attributes: + pp : PP_Doc + prec : Int + alternatives: + alternative Arr: + child left : Type + child right : Type + visit 0: + local r : _ + local l : _ + alternative CtxApp: + child left : {[(String, [String])]} + child right : Type + alternative List: + child tp : Type + alternative SimpleType: + child txt : {String} + alternative TupleType: + child tps : Types + alternative TypeApp: + child func : Type + child args : Types + alternative UnboxedTupleType: + child tps : Types +-} +-- cata +sem_Type :: Type -> + T_Type +sem_Type !(Arr _left _right) = + (sem_Type_Arr (sem_Type _left) (sem_Type _right)) +sem_Type !(CtxApp _left _right) = + (sem_Type_CtxApp _left (sem_Type _right)) +sem_Type !(List _tp) = + (sem_Type_List (sem_Type _tp)) +sem_Type !(SimpleType _txt) = + (sem_Type_SimpleType _txt) +sem_Type !(TupleType _tps) = + (sem_Type_TupleType (sem_Types _tps)) +sem_Type !(TypeApp _func _args) = + (sem_Type_TypeApp (sem_Type _func) (sem_Types _args)) +sem_Type !(UnboxedTupleType _tps) = + (sem_Type_UnboxedTupleType (sem_Types _tps)) +-- semantic domain +newtype T_Type = T_Type (Bool -> + ( PP_Doc,Int)) +data Inh_Type = Inh_Type {nested_Inh_Type :: !(Bool)} +data Syn_Type = Syn_Type {pp_Syn_Type :: !(PP_Doc),prec_Syn_Type :: !(Int)} +wrap_Type !(T_Type sem) !(Inh_Type _lhsInested) = + (let ( !_lhsOpp,!_lhsOprec) = + (sem _lhsInested) + in (Syn_Type _lhsOpp _lhsOprec)) +sem_Type_Arr :: T_Type -> + T_Type -> + T_Type +sem_Type_Arr !(T_Type left_) !(T_Type right_) = + (T_Type (\ (!_lhsInested) -> + (case (_lhsInested) of + { !_rightOnested -> + (case (_lhsInested) of + { !_leftOnested -> + (case ((right_ _rightOnested)) of + { ( !_rightIpp,!_rightIprec) -> + (case (if _rightIprec < 2 then pp_parens _rightIpp else _rightIpp) of + { !_r -> + (case ((left_ _leftOnested)) of + { ( !_leftIpp,!_leftIprec) -> + (case (if _leftIprec <= 2 then pp_parens _leftIpp else _leftIpp) of + { !_l -> + (case (_l >#< "->" >-< _r) of + { !_lhsOpp -> + (case (2) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) }) }) }) }) }) }) }))) +sem_Type_CtxApp :: ([(String, [String])]) -> + T_Type -> + T_Type +sem_Type_CtxApp !left_ !(T_Type right_) = + (T_Type (\ (!_lhsInested) -> + (case (_lhsInested) of + { !_rightOnested -> + (case ((right_ _rightOnested)) of + { ( !_rightIpp,!_rightIprec) -> + (case ((pp_block "(" ")" "," $ map (\(n,ns) -> hv_sp $ map pp (n:ns)) left_) >#< "=>" >#< _rightIpp) of + { !_lhsOpp -> + (case (_rightIprec) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) }) }) }))) +sem_Type_List :: T_Type -> + T_Type +sem_Type_List !(T_Type tp_) = + (T_Type (\ (!_lhsInested) -> + (case (_lhsInested) of + { !_tpOnested -> + (case ((tp_ _tpOnested)) of + { ( !_tpIpp,!_tpIprec) -> + (case ("[" >|< _tpIpp >|< "]") of + { !_lhsOpp -> + (case (5) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) }) }) }))) +sem_Type_SimpleType :: String -> + T_Type +sem_Type_SimpleType !txt_ = + (T_Type (\ (!_lhsInested) -> + (case (if reallySimple txt_ then text txt_ else pp_parens (text txt_)) of + { !_lhsOpp -> + (case (5) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) }))) +sem_Type_TupleType :: T_Types -> + T_Type +sem_Type_TupleType !(T_Types tps_) = + (T_Type (\ (!_lhsInested) -> + (case (_lhsInested) of + { !_tpsOnested -> + (case ((tps_ _tpsOnested)) of + { ( !_tpsIpps) -> + (case (ppTuple _lhsInested _tpsIpps) of + { !_lhsOpp -> + (case (5) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) }) }) }))) +sem_Type_TypeApp :: T_Type -> + T_Types -> + T_Type +sem_Type_TypeApp !(T_Type func_) !(T_Types args_) = + (T_Type (\ (!_lhsInested) -> + (case (_lhsInested) of + { !_argsOnested -> + (case (_lhsInested) of + { !_funcOnested -> + (case ((args_ _argsOnested)) of + { ( !_argsIpps) -> + (case ((func_ _funcOnested)) of + { ( !_funcIpp,!_funcIprec) -> + (case (hv_sp (_funcIpp : _argsIpps)) of + { !_lhsOpp -> + (case (_funcIprec) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) }) }) }) }) }))) +sem_Type_UnboxedTupleType :: T_Types -> + T_Type +sem_Type_UnboxedTupleType !(T_Types tps_) = + (T_Type (\ (!_lhsInested) -> + (case (_lhsInested) of + { !_tpsOnested -> + (case ((tps_ _tpsOnested)) of + { ( !_tpsIpps) -> + (case (ppUnboxedTuple _lhsInested _tpsIpps) of + { !_lhsOpp -> + (case (5) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) }) }) }))) +-- Types ------------------------------------------------------- +{- + visit 0: + inherited attribute: + nested : Bool + synthesized attribute: + pps : PP_Docs + alternatives: + alternative Cons: + child hd : Type + child tl : Types + alternative Nil: +-} +-- cata +sem_Types :: Types -> + T_Types +sem_Types !list = + (Prelude.foldr sem_Types_Cons sem_Types_Nil (Prelude.map sem_Type list)) +-- semantic domain +newtype T_Types = T_Types (Bool -> + ( PP_Docs)) +data Inh_Types = Inh_Types {nested_Inh_Types :: !(Bool)} +data Syn_Types = Syn_Types {pps_Syn_Types :: !(PP_Docs)} +wrap_Types !(T_Types sem) !(Inh_Types _lhsInested) = + (let ( !_lhsOpps) = + (sem _lhsInested) + in (Syn_Types _lhsOpps)) +sem_Types_Cons :: T_Type -> + T_Types -> + T_Types +sem_Types_Cons !(T_Type hd_) !(T_Types tl_) = + (T_Types (\ (!_lhsInested) -> + (case (_lhsInested) of + { !_tlOnested -> + (case (_lhsInested) of + { !_hdOnested -> + (case ((tl_ _tlOnested)) of + { ( !_tlIpps) -> + (case ((hd_ _hdOnested)) of + { ( !_hdIpp,!_hdIprec) -> + (case (_hdIpp : _tlIpps) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) }) }))) +sem_Types_Nil :: T_Types +sem_Types_Nil = + (T_Types (\ (!_lhsInested) -> + (case ([]) of + { !_lhsOpps -> + ( _lhsOpps) }))) diff --git a/src-derived/PrintErrorMessages.hs b/src-derived/PrintErrorMessages.hs --- a/src-derived/PrintErrorMessages.hs +++ b/src-derived/PrintErrorMessages.hs @@ -41,6 +41,8 @@ isError opts (InducedCirc _ _ _ ) = cycleIsDangerous opts isError opts (MissingTypeSig _ _ _ ) = False isError opts (MissingInstSig _ _ _ ) = True +isError opts (DupUnique _ _ _ ) = False +isError opts (MissingUnique _ _ ) = True cycleIsDangerous :: Options -> Bool cycleIsDangerous opts @@ -233,6 +235,12 @@ child occ1 : {NontermIdent} visit 0: local me : _ + alternative DupUnique: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child attr : {Identifier} + visit 0: + local me : _ alternative InducedCirc: child nt : {NontermIdent} child cinter : {CInterface} @@ -274,6 +282,11 @@ child attr : {Identifier} visit 0: local me : _ + alternative MissingUnique: + child nt : {NontermIdent} + child attr : {Identifier} + visit 0: + local me : _ alternative ParserError: child pos : {Pos} child problem : {String} @@ -344,6 +357,8 @@ (sem_Error_DupSynAttr _nt _attr _occ1) sem_Error (DupSynonym _nt _occ1) = (sem_Error_DupSynonym _nt _occ1) +sem_Error (DupUnique _nt _con _attr) = + (sem_Error_DupUnique _nt _con _attr) sem_Error (InducedCirc _nt _cinter _cyclic) = (sem_Error_InducedCirc _nt _cinter _cyclic) sem_Error (InstCirc _nt _con _attr _o_visit _path) = @@ -356,6 +371,8 @@ (sem_Error_MissingRule _nt _con _field _attr) sem_Error (MissingTypeSig _nt _con _attr) = (sem_Error_MissingTypeSig _nt _con _attr) +sem_Error (MissingUnique _nt _attr) = + (sem_Error_MissingUnique _nt _attr) sem_Error (ParserError _pos _problem _action) = (sem_Error_ParserError _pos _problem _action) sem_Error (SuperfluousRule _nt _con _field _attr) = @@ -389,7 +406,7 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 300, column 21) + -- "PrintErrorMessages.ag"(line 302, column 21) _lhsOpp = let mesg = wfill ["Nontrivial field ",getName var_, "is used as local at constructor" , getName con_ , "of nonterminal",getName nt_, "." @@ -419,7 +436,7 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 342, column 21) + -- "PrintErrorMessages.ag"(line 344, column 21) _lhsOpp = let pat = text "unknown" help = wfill ["not available."] @@ -439,7 +456,7 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 333, column 21) + -- "PrintErrorMessages.ag"(line 335, column 21) _lhsOpp = let mesg = wfill ["Cyclic definition for nonterminal set", getName name_] pat = "SET" >#< getName name_ >#< "=" >#< "..." >#< getName name_ >#< "..." @@ -465,7 +482,7 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 371, column 21) + -- "PrintErrorMessages.ag"(line 373, column 21) _lhsOpp = let mesg = wfill ["In nonterminal", getName nt_, "synthesized and inherited attributes are mutually dependent" ] >-< vlist (map showEdge cyclic_) @@ -490,7 +507,7 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 73, column 21) + -- "PrintErrorMessages.ag"(line 75, column 21) _lhsOpp = let mesg = wfill ["Repeated definition for alternative", getName con_ ,"of nonterminal", getName nt_, "." @@ -527,7 +544,7 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 166, column 21) + -- "PrintErrorMessages.ag"(line 168, column 21) _lhsOpp = let mesg = wfill ["Repeated declaration for field", getName name_, "of alternative" ,getName con_, "of nonterminal", getName nt_, "." @@ -562,7 +579,7 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 128, column 21) + -- "PrintErrorMessages.ag"(line 130, column 21) _lhsOpp = let mesg = wfill ["Repeated declaration of inherited attribute", getName attr_ , "of nonterminal", getName nt_, "." @@ -598,7 +615,7 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 186, column 21) + -- "PrintErrorMessages.ag"(line 188, column 21) _lhsOpp = let mesg = wfill ["At constructor",getName con_, "of nonterminal", getName nt_, "there are two or more rules for" ,showAttrDef field_ attr_,"." @@ -630,7 +647,7 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 112, column 21) + -- "PrintErrorMessages.ag"(line 114, column 21) _lhsOpp = let mesg = wfill ["Definition of nonterminal set", getName name_, "clashes with another" ,"set, a type synonym or a data definition." @@ -663,7 +680,7 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 204, column 21) + -- "PrintErrorMessages.ag"(line 206, column 21) _lhsOpp = let mesg = wfill ["At constructor",getName con_, "of nonterminal", getName nt_, "there are two or more typesignatures for" ,showAttrDef _LOC attr_,"." @@ -695,7 +712,7 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 147, column 21) + -- "PrintErrorMessages.ag"(line 149, column 21) _lhsOpp = let mesg = wfill ["Repeated declaration of synthesized attribute", getName attr_ , "of nonterminal", getName nt_, "." @@ -728,7 +745,7 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 95, column 21) + -- "PrintErrorMessages.ag"(line 97, column 21) _lhsOpp = let mesg = wfill ["Definition of type synonym", getName nt_, "clashes with another" ,"type synonym." @@ -753,6 +770,38 @@ _lhsOme = _me in ( _lhsOme,_lhsOpp)))) +sem_Error_DupUnique :: NontermIdent -> + ConstructorIdent -> + Identifier -> + T_Error +sem_Error_DupUnique nt_ con_ attr_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 434, column 21) + _lhsOpp = + let mesg = wfill ["At constructor",getName con_, "of nonterminal", getName nt_, "there are two or more unique-attribute signatures for" + ,showAttrDef _LOC attr_,"." + ] >-< + wfill ["First signature:", (showPos attr_),"."] + pat = "SEM" >#< getName nt_ + >-< indent 2 ("|" >#< getName con_ >#< ppAttr _LOC attr_ >#< " : UNIQUEREF ...") + >-< indent 2 ("|" >#< getName con_ >#< ppAttr _LOC attr_ >#< " : UNIQUEREF ...") + help = wfill ["In the rules for alternative" , getName con_ , "of nonterminal" , getName nt_ + ,", there is more than one unique-attribute signature for the" , showAttrDef _LOC attr_ + ,". You should remove enough of them to make all unique-signatures for alternative" + ,getName con_ , "of nonterminal " ,getName nt_ , "unique." + ] + act = wfill ["Unpredicatable sharing of unique numbers may occur."] + in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose + -- self rule + _me = + DupUnique nt_ con_ attr_ + -- self rule + _lhsOme = + _me + in ( _lhsOme,_lhsOpp)))) sem_Error_InducedCirc :: NontermIdent -> CInterface -> ([((Identifier,Identifier),[String],[String])]) -> @@ -762,7 +811,7 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 379, column 21) + -- "PrintErrorMessages.ag"(line 381, column 21) _lhsOpp = let mesg = wfill ["After scheduling, in nonterminal", getName nt_, "synthesized and inherited attributes have an INDUCED mutual dependency" ] >-< vlist (map showEdge cyclic_) @@ -790,7 +839,7 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 359, column 21) + -- "PrintErrorMessages.ag"(line 361, column 21) _lhsOpp = let mesg = wfill ["Circular dependency for inst attribute", getName attr_ , "of alternative", getName con_, "of nonterminal", getName nt_] @@ -821,7 +870,7 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 347, column 21) + -- "PrintErrorMessages.ag"(line 349, column 21) _lhsOpp = let mesg = wfill ["Circular dependency for local attribute", getName attr_ , "of alternative", getName con_, "of nonterminal", getName nt_] @@ -850,7 +899,7 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 402, column 21) + -- "PrintErrorMessages.ag"(line 404, column 21) _lhsOpp = let mesg = wfill ["Type signature needed, but not found for", showAttrDef _INST attr_ , "in alternative" , getName con_ , "of nonterminal",getName nt_ ,"." @@ -882,7 +931,7 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 258, column 21) + -- "PrintErrorMessages.ag"(line 260, column 21) _lhsOpp = let mesg = wfill ["Missing rule for", showAttrDef field_ attr_ , "in alternative" , getName con_ , "of nonterminal",getName nt_ ,"." @@ -911,7 +960,7 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 388, column 21) + -- "PrintErrorMessages.ag"(line 390, column 21) _lhsOpp = let mesg = wfill ["Type signature needed, but not found for", showAttrDef _LOC attr_ , "in alternative" , getName con_ , "of nonterminal",getName nt_ ,"." @@ -933,6 +982,37 @@ _lhsOme = _me in ( _lhsOme,_lhsOpp)))) +sem_Error_MissingUnique :: NontermIdent -> + Identifier -> + T_Error +sem_Error_MissingUnique nt_ attr_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "PrintErrorMessages.ag"(line 418, column 21) + _lhsOpp = + let mesg = wfill ["Missing unique counter (chained attribute)" + , getName attr_ + , "at nonterminal" + , getName nt_, "." + ] + pat = "ATTR" >#< getName nt_ >#< "[ |" >#< getName attr_ >#< " : ... | ]" + help = wfill ["A unique attribute signature in a constructor for nonterminal" , getName nt_ + , "refers to an unique counter (chained attribute) named " + , getName attr_ + ,"Maybe you misspelled it?" + ,"Otherwise either remove the signature or add an appropriate attribute definition." + ] + act = wfill ["It is not possible to proceed without this declaration."] + in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose + -- self rule + _me = + MissingUnique nt_ attr_ + -- self rule + _lhsOme = + _me + in ( _lhsOme,_lhsOpp)))) sem_Error_ParserError :: Pos -> String -> String -> @@ -942,7 +1022,7 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 67, column 21) + -- "PrintErrorMessages.ag"(line 69, column 21) _lhsOpp = let mesg = text ("parser expecting " ++ problem_) pat = text "" @@ -966,7 +1046,7 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 271, column 21) + -- "PrintErrorMessages.ag"(line 273, column 21) _lhsOpp = let mesg = wfill ["Rule for non-existing", showAttrDef field_ attr_ , "at alternative" , getName con_ , "of nonterminal",getName nt_, "." @@ -994,7 +1074,7 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 231, column 21) + -- "PrintErrorMessages.ag"(line 233, column 21) _lhsOpp = let mesg = wfill ["Constructor", getName con_, "of nonterminal" ,getName nt_, "is not defined." ] @@ -1024,7 +1104,7 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 314, column 21) + -- "PrintErrorMessages.ag"(line 316, column 21) _lhsOpp = let mesg = wfill ["Undefined" , if isOut_ @@ -1059,7 +1139,7 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 243, column 21) + -- "PrintErrorMessages.ag"(line 245, column 21) _lhsOpp = let mesg = wfill ["Constructor", getName con_, "of nonterminal" ,getName nt_ , "does not have a nontrivial field named", getName name_ , "." @@ -1090,7 +1170,7 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 285, column 21) + -- "PrintErrorMessages.ag"(line 287, column 21) _lhsOpp = let mesg = wfill ["Undefined local variable or field",getName var_, "at constructor" , getName con_ , "of nonterminal",getName nt_, "." @@ -1119,7 +1199,7 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "PrintErrorMessages.ag"(line 221, column 21) + -- "PrintErrorMessages.ag"(line 223, column 21) _lhsOpp = let mesg = wfill ["Nonterminal", getName nt_, "is not defined." ] @@ -1179,10 +1259,10 @@ _hdIme :: Error _hdIpp :: PP_Doc _tlIpp :: PP_Doc - -- "PrintErrorMessages.ag"(line 62, column 8) + -- "PrintErrorMessages.ag"(line 64, column 8) _verbose = verbose _lhsIoptions - -- use rule "PrintErrorMessages.ag"(line 58, column 49) + -- use rule "PrintErrorMessages.ag"(line 60, column 49) _lhsOpp = _hdIpp >-< _tlIpp -- copy rule (down) @@ -1203,10 +1283,10 @@ sem_Errors_Nil = (T_Errors (\ _lhsIoptions -> (let _lhsOpp :: PP_Doc - -- "PrintErrorMessages.ag"(line 62, column 8) + -- "PrintErrorMessages.ag"(line 64, column 8) _verbose = verbose _lhsIoptions - -- use rule "PrintErrorMessages.ag"(line 58, column 49) + -- use rule "PrintErrorMessages.ag"(line 60, column 49) _lhsOpp = text "" in ( _lhsOpp)))) diff --git a/src-derived/TfmToVisage.hs b/src-derived/TfmToVisage.hs --- a/src-derived/TfmToVisage.hs +++ b/src-derived/TfmToVisage.hs @@ -226,12 +226,13 @@ child manualAttrOrderMap : {AttrOrderMap} child paramMap : {ParamMap} child contextMap : {ContextMap} + child uniqueMap : {UniqueMap} -} -- cata sem_Grammar :: Grammar -> T_Grammar -sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap) = - (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts) _pragmas _manualAttrOrderMap _paramMap _contextMap) +sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap) = + (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts) _pragmas _manualAttrOrderMap _paramMap _contextMap _uniqueMap) -- semantic domain newtype T_Grammar = T_Grammar (( VisageGrammar)) data Inh_Grammar = Inh_Grammar {} @@ -249,8 +250,9 @@ AttrOrderMap -> ParamMap -> ContextMap -> + UniqueMap -> T_Grammar -sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ = +sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ uniqueMap_ = (T_Grammar (let _lhsOvisage :: VisageGrammar _nontsIvnonts :: ([VisageNonterminal]) -- "TfmToVisage.ag"(line 86, column 17) diff --git a/src-derived/Transform.hs b/src-derived/Transform.hs --- a/src-derived/Transform.hs +++ b/src-derived/Transform.hs @@ -2,3663 +2,3912 @@ module Transform where import Control.Monad(mplus,mzero) -import List (partition, elem, nub) -import Data.Maybe -import qualified Data.Map as Map -import Data.Map (Map) -import Data.Set as Set (Set, member, union, toList, fromList, empty, singleton, member, unions, size, fold, intersection, difference, insert) -import UU.DData.Seq as Seq (Seq, empty, (<>), single, cons, toList, fromList) -import UU.Scanner.Position(noPos) - -import ConcreteSyntax -import AbstractSyntax -import ErrorMessages -import Patterns (Patterns(..),Pattern(..)) -import Expression (Expression(..)) - -import Options -import CommonTypes - -import UU.Scanner.Position (Pos) -import Patterns (Pattern) -import Expression (Expression) -import CommonTypes - --- Patterns.ag imports -import UU.Scanner.Position(Pos) -import CommonTypes (ConstructorIdent,Identifier) -type DefinedSets = Map Identifier (Set NontermIdent) -type FieldMap = [(Identifier, Type)] -type DataTypes = Map.Map NontermIdent (Map.Map ConstructorIdent FieldMap) -type AttrName = (Identifier,Identifier) -type RuleInfo = ([AttrName]->Pattern, Expression, [AttrName], Bool, String) -type SigInfo = (Identifier,Type) - - -checkDuplicate :: (Identifier -> Identifier -> Error) - -> Identifier -> val -> Map Identifier val -> (Map Identifier val,Seq Error) -checkDuplicate dupError key val m - = case Map.lookupIndex key m of - Just ix -> let (key',_) = Map.elemAt ix m - in (m,Seq.single (dupError key key')) - Nothing -> (Map.insert key val m,Seq.empty) - -checkDuplicates :: (Identifier -> Identifier -> Error) - -> [(Identifier, val)] -> Map Identifier val -> (Map Identifier val,Seq Error) -checkDuplicates dupError new m = foldErrors check m new - where check = uncurry (checkDuplicate dupError) - -foldErrors f e xs = foldl g (e,Seq.empty) xs - where g ~(e,es) x = let (e',es') = f x e - in (e', es <> es') - - -checkForDuplicates :: (Identifier -> Identifier -> Error) -> [Identifier] -> [Error] -checkForDuplicates err [] = [] -checkForDuplicates err (x:xs) = let (same,other) = List.partition (equalId x) xs - in map (err x) same ++ checkForDuplicates err other - -equalId :: Identifier -> Identifier -> Bool -equalId x y = getName x == getName y - - -type RulesAndErrors = ([Rule], Seq Error) -type SigsAndErrors = ([TypeSig], Seq Error) -type InstsAndErrors = ([(Identifier, Type)], Seq Error) -type AttrOverwrite = Map AttrName Bool -type AccumRuleCheck = (RulesAndErrors, AttrOverwrite) -type AccumDefiCheck = (Seq Error, AttrOverwrite, [AttrName], [AttrName]) - -checkRules :: Map NontermIdent (Attributes, Attributes) -> Map NontermIdent (Map ConstructorIdent FieldMap) -> - Map NontermIdent (Map ConstructorIdent [Identifier]) -> Map NontermIdent (Map ConstructorIdent [SigInfo]) -> - NontermIdent -> ConstructorIdent -> [RuleInfo] -> RulesAndErrors -checkRules attributes fields allinsts allsigs nt con rs - = let fieldmap :: FieldMap - fieldmap = (_LHS,NT nt undefined) : (_LOC,NT undefined undefined) : (_INST, NT undefined undefined) : (_FIRST, NT undefined undefined) : (_LAST, NT undefined undefined) - : Map.findWithDefault [] con (Map.findWithDefault Map.empty nt fields) - ++ mapMaybe (\instNm -> lookup instNm sigs >>= \tp -> return (instNm, tp)) (Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allinsts)) - - sigs = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allsigs) - - hasAttrib f tp attr = Map.member attr (f (Map.findWithDefault (Map.empty,Map.empty) tp attributes)) - - checkRule :: RuleInfo -> AccumRuleCheck -> AccumRuleCheck - checkRule (pat,exp,as,owrt,str) ((r1,e1),m1) - = let (e2,m2,u2,b2) = foldr (checkDefi owrt) (e1,m1,[],[]) as - in ( (Rule (pat u2) exp owrt str : r1, e2), m2) - - checkDefi :: Bool -> AttrName -> AccumDefiCheck -> AccumDefiCheck - checkDefi owrt fa@(field,attr) (e,m,u,bs) - = case lookup field fieldmap - of Just (NT tp _) -> if field == _LOC || field == _INST || field == _FIRST || field == _LAST - || hasAttrib (if getName field==getName _LHS then snd else fst) tp attr - then case Map.lookupIndex fa m of - Just ix -> let ((_,attr2),b) = Map.elemAt ix m - in if b && not (fa `elem` bs) - then ( e, Map.insert fa owrt m, fa:u, fa:bs) - else (Seq.cons (DupRule nt con field attr2 attr) e, m, fa:u, bs) - Nothing -> ( e, Map.insert fa owrt m, u, fa:bs) - else (Seq.cons (SuperfluousRule nt con field attr) e, m, fa:u, bs) - _ -> (Seq.cons (UndefChild nt con field) e, m, fa:u, bs ) - - in fst (foldr checkRule (([],Seq.empty),Map.empty) rs) - -checkSigs :: NontermIdent -> ConstructorIdent -> [SigInfo] -> SigsAndErrors -checkSigs nt con sis - = let checkSig (ide,typ) (sigs,errs) - = if ide `elem` map (\(TypeSig n t)-> n) sigs - then (sigs, Seq.cons (DupSig nt con ide) errs) - -- else if not (ide `elem` locattrdefs) - -- then (sigs, Seq.cons (SupSig nt con ide) errs) - else (TypeSig ide typ:sigs, errs) - in foldr checkSig ([],Seq.empty) sis - -checkInsts :: Map NontermIdent (Map ConstructorIdent [SigInfo]) -> NontermIdent -> ConstructorIdent -> [Identifier] -> InstsAndErrors -checkInsts sigMap nt con - = foldr (\inst (insts, errs) -> maybe (insts, Seq.single (MissingInstSig nt con inst) <> errs) - (\info -> (info : insts, errs)) $ findSig inst) ([], Seq.empty) - where - sigs = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt sigMap) - - findSig name - = do tp@(NT _ _) <- lookup name sigs - return (name, tp) - -flattenDatas :: DataTypes -> Map NontermIdent (Set NontermIdent) -flattenDatas ds = Map.map flatten ds - where flatten cs = Set.fromList [ nt | (_,NT nt _) <- concatMap snd (Map.toList cs)] - -reachableFrom :: Map NontermIdent (Set NontermIdent) -> Set NontermIdent -> Set NontermIdent -reachableFrom table nts = reach nts - where reach nts = let nts' = Set.unions (nts : [ ns | nt <- Set.toList nts - , let ns = Map.findWithDefault Set.empty nt table ]) - in if Set.size nts' > Set.size nts - then reach nts' - else nts -invert :: Map NontermIdent (Set NontermIdent) -> Map NontermIdent (Set NontermIdent) -invert m = foldr inv Map.empty (Map.toList m) - where inv (x,ns) m = fold (\n m -> Map.insertWith Set.union n (Set.singleton x) m) m ns - -path :: Map NontermIdent (Set NontermIdent) -> NontermIdent -> NontermIdent -> Set NontermIdent -path table from to = let children = Map.findWithDefault Set.empty from table - forward = reachableFrom table children - backward = reachableFrom (invert table) - (Set.singleton to) - in Set.intersection forward backward - -pragmaMapUnion :: PragmaMap -> PragmaMap -> PragmaMap -pragmaMapUnion = Map.unionWith (Map.unionWith Set.union) - -pragmaMapSingle :: NontermIdent -> ConstructorIdent -> Set Identifier -> PragmaMap -pragmaMapSingle nt con nms = Map.singleton nt (Map.singleton con nms) - -orderMapUnion :: AttrOrderMap -> AttrOrderMap -> AttrOrderMap -orderMapUnion = Map.unionWith (Map.unionWith Set.union) - -orderMapSingle :: NontermIdent -> ConstructorIdent -> Set Dependency -> AttrOrderMap -orderMapSingle nt con deps = Map.singleton nt (Map.singleton con deps) - -mergeParams :: ParamMap -> ParamMap -> ParamMap -mergeParams = Map.unionWith (++) - -mergeCtx :: ContextMap -> ContextMap -> ContextMap -mergeCtx - = Map.unionWith nubconcat - where nubconcat a b = nub (a ++ b) - -mergeDerivings m1 m2 = foldr (\(n,cs) m -> Map.insertWith Set.union n cs m) m2 (Map.toList m1) - -merge x y = foldr f y (Map.toList x) - where f ~(k,v) m = Map.insertWith (Map.union) k v m - -checkAttrs allFields nts inherited synthesized decls = foldErrors check decls nts where - check nt decls | not (nt `Map.member` allFields) = (decls,Seq.single(UndefNont nt)) - | otherwise = let (inh,syn) = Map.findWithDefault (Map.empty,Map.empty) nt decls - (inh',einh) = checkDuplicates (DupInhAttr nt) inherited inh - (syn',esyn) = checkDuplicates (DupSynAttr nt) synthesized syn - in (Map.insert nt (inh',syn') decls,einh <> esyn) - -addSelf name atMap = let (eInh,eSyn) = Map.findWithDefault(Map.empty,Map.empty) name atMap - in Map.insert name (eInh, Map.insert (Ident "self" noPos) (NT _SELF []) eSyn)atMap - -makeType :: Set NontermIdent -> Type -> Type -makeType nts tp@(NT x _) | x == _SELF = tp - | Set.member x nts = tp - | otherwise = Haskell (typeToHaskellString Nothing [] tp) -makeType _ tp = tp - -constructGrammar :: Set NontermIdent - -> ParamMap - -> DataTypes - -> Map NontermIdent (Attributes, Attributes) - -> Map NontermIdent (Map Identifier (String, String, String)) - -> Derivings - -> Set NontermIdent - -> Map NontermIdent (Map ConstructorIdent [Rule]) - -> Map NontermIdent (Map ConstructorIdent [TypeSig]) - -> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) - -> TypeSyns - -> PragmaMap - -> AttrOrderMap - -> ContextMap - -> Grammar - -constructGrammar nts ntParams gram attrs uses derivings wrappers allrules tsigs allinsts tsyns pragmaMap orderMap contextMap = - let gr = [ (nt,Map.toList alts) | (nt,alts) <- Map.toList gram] - nonts = map nont gr - nont (nt,alts) = let (inh,syn) = Map.findWithDefault (Map.empty,Map.empty) nt attrs - rmap = Map.findWithDefault Map.empty nt allrules - tsmap = Map.findWithDefault Map.empty nt tsigs - instsmap = Map.findWithDefault Map.empty nt allinsts - params = Map.findWithDefault [] nt ntParams - alt (con,flds) = - let rules = maybe [] id (Map.lookup con rmap) - tsigs = maybe [] id (Map.lookup con tsmap) - insts = maybe [] id (Map.lookup con instsmap) - cldrn = map (child False) flds ++ map (child True) insts - child isVirtual (nm, tp) = - let (inh,syn) = case tp of - NT nt _ -> Map.findWithDefault (Map.empty,Map.empty) nt attrs - _ -> (Map.empty,Map.empty) - in Child nm tp inh syn isVirtual - in Production con cldrn rules tsigs - in Nonterminal nt params inh syn (map alt alts) - in Grammar tsyns uses derivings wrappers nonts pragmaMap orderMap ntParams contextMap - -mapUnionWithSetUnion = Map.unionWith Set.union -mapUnionWithPlusPlus = Map.unionWith (++) --- AG ---------------------------------------------------------- -{- - visit 0: - inherited attribute: - options : Options - synthesized attributes: - blocks : Blocks - errors : Seq Error - moduleDecl : Maybe (String,String,String) - output : Grammar - pragmas : Options -> Options - alternatives: - alternative AG: - child elems : Elems - visit 0: - local allFields : _ - local allConstrs : _ - local allRules : _ - local allSigs : _ - local allInsts : _ - local allRulesErrs : _ - local allSigsErrs : _ - local allInstsErrs : _ - local checkedRules : _ - local checkedSigs : _ - local checkedInsts : _ - local errs1 : _ - local errs2 : _ - local errs3 : _ - local errs4 : _ - local errs5 : _ - local errs6 : _ - local allNonterminals : _ - local allAttrDecls : _ --} --- cata -sem_AG :: AG -> - T_AG -sem_AG (AG _elems) = - (sem_AG_AG (sem_Elems _elems)) --- semantic domain -newtype T_AG = T_AG (Options -> - ( Blocks,(Seq Error),(Maybe (String,String,String)),Grammar,(Options -> Options))) -data Inh_AG = Inh_AG {options_Inh_AG :: Options} -data Syn_AG = Syn_AG {blocks_Syn_AG :: Blocks,errors_Syn_AG :: Seq Error,moduleDecl_Syn_AG :: Maybe (String,String,String),output_Syn_AG :: Grammar,pragmas_Syn_AG :: Options -> Options} -wrap_AG (T_AG sem) (Inh_AG _lhsIoptions) = - (let ( _lhsOblocks,_lhsOerrors,_lhsOmoduleDecl,_lhsOoutput,_lhsOpragmas) = - (sem _lhsIoptions) - in (Syn_AG _lhsOblocks _lhsOerrors _lhsOmoduleDecl _lhsOoutput _lhsOpragmas)) -sem_AG_AG :: T_Elems -> - T_AG -sem_AG_AG (T_Elems elems_) = - (T_AG (\ _lhsIoptions -> - (let _lhsOoutput :: Grammar - _lhsOerrors :: (Seq Error) - _elemsOallConstructors :: (Map NontermIdent (Set ConstructorIdent)) - _elemsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) - _elemsOdefinedSets :: DefinedSets - _elemsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) - _lhsOblocks :: Blocks - _lhsOmoduleDecl :: (Maybe (String,String,String)) - _lhsOpragmas :: (Options -> Options) - _elemsOallAttrDecls :: (Map NontermIdent (Attributes, Attributes)) - _elemsOallFields :: DataTypes - _elemsOallNonterminals :: (Set NontermIdent) - _elemsIattrDecls :: (Map NontermIdent (Attributes, Attributes)) - _elemsIattrOrderCollect :: AttrOrderMap - _elemsIblocks :: Blocks - _elemsIcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _elemsIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _elemsIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _elemsIcollectedNames :: (Set Identifier) - _elemsIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) - _elemsIcollectedSetNames :: (Set Identifier) - _elemsIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) - _elemsIctxCollect :: ContextMap - _elemsIdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) - _elemsIderivings :: Derivings - _elemsIerrors :: (Seq Error) - _elemsImoduleDecl :: (Maybe (String,String,String)) - _elemsIparamsCollect :: ParamMap - _elemsIpragmas :: (Options -> Options) - _elemsIsemPragmasCollect :: PragmaMap - _elemsItypeSyns :: TypeSyns - _elemsIuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) - _elemsIwrappers :: (Set NontermIdent) - -- "Transform.ag"(line 45, column 8) - _lhsOoutput = - constructGrammar _allNonterminals - _elemsIparamsCollect - _allFields - _allAttrDecls - _elemsIuseMap - _elemsIderivings - (if wrappers _lhsIoptions then _allNonterminals else _elemsIwrappers) - _checkedRules - _checkedSigs - _checkedInsts - _elemsItypeSyns - _elemsIsemPragmasCollect - _elemsIattrOrderCollect - _elemsIctxCollect - -- "Transform.ag"(line 219, column 10) - _allFields = - let f (nt,con,fm) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con fm) - in foldr f (Map.empty) _elemsIcollectedFields - -- "Transform.ag"(line 222, column 10) - _allConstrs = - let f (nt,con,_) = Map.insertWith (++) nt [con] - in foldr f (Map.empty) _elemsIcollectedFields - -- "Transform.ag"(line 225, column 10) - _allRules = - let f (nt,con,r) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con [r]) - in foldr f (Map.empty) _elemsIcollectedRules - -- "Transform.ag"(line 228, column 10) - _allSigs = - let f (nt,con,t) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con [t]) - in foldr f (Map.empty) _elemsIcollectedSigs - -- "Transform.ag"(line 231, column 10) - _allInsts = - let f (nt,con,is) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con is) - in foldr f (Map.empty) _elemsIcollectedInsts - -- "Transform.ag"(line 234, column 10) - _allRulesErrs = - Map.mapWithKey (Map.mapWithKey . (checkRules _allAttrDecls _allFields _allInsts _allSigs )) _allRules - -- "Transform.ag"(line 235, column 10) - _allSigsErrs = - Map.mapWithKey (Map.mapWithKey . (checkSigs )) _allSigs - -- "Transform.ag"(line 236, column 10) - _allInstsErrs = - Map.mapWithKey (Map.mapWithKey . (checkInsts _allSigs )) _allInsts - -- "Transform.ag"(line 238, column 10) - _checkedRules = - Map.map (Map.map fst) _allRulesErrs - -- "Transform.ag"(line 239, column 10) - _checkedSigs = - Map.map (Map.map fst) _allSigsErrs - -- "Transform.ag"(line 240, column 10) - _checkedInsts = - Map.map (Map.map fst) _allInstsErrs - -- "Transform.ag"(line 242, column 10) - _errs1 = - let f = checkForDuplicates (DupSynonym) - in Seq.fromList . f . map fst $ _elemsItypeSyns - -- "Transform.ag"(line 245, column 10) - _errs2 = - let g nt (con,fm) = checkForDuplicates (DupChild nt con) (map fst fm) - f (nt,cfm) = concat . map (g nt) . Map.toList $ cfm - in Seq.fromList . concat . map f . Map.toList $ _allFields - -- "Transform.ag"(line 249, column 10) - _errs3 = - let f (nt,cons) = checkForDuplicates (DupAlt nt) cons - in Seq.empty - -- "Transform.ag"(line 253, column 10) - _errs4 = - let f m s = Map.fold ((<>) . snd) s m - in Map.fold f Seq.empty _allRulesErrs - -- "Transform.ag"(line 256, column 10) - _errs5 = - let f m s = Map.fold ((<>) . snd) s m - in Map.fold f Seq.empty _allSigsErrs - -- "Transform.ag"(line 259, column 10) - _errs6 = - let f m s = Map.fold ((<>) . snd) s m - in Map.fold f Seq.empty _allInstsErrs - -- "Transform.ag"(line 262, column 10) - _lhsOerrors = - _elemsIerrors <> _errs1 <> _errs2 <> _errs3 <> _errs4 <> _errs5 <> _errs6 - -- "Transform.ag"(line 345, column 10) - _allNonterminals = - _elemsIcollectedNames `Set.difference` _elemsIcollectedSetNames - -- "Transform.ag"(line 365, column 8) - _elemsOallConstructors = - _elemsIcollectedConstructorsMap - -- "Transform.ag"(line 419, column 8) - _elemsOdefSets = - Map.fromList (map (\x->(x,(Set.singleton x, Set.empty))) (Set.toList _allNonterminals )) - -- "Transform.ag"(line 420, column 8) - _elemsOdefinedSets = - Map.map fst _elemsIdefSets - -- "Transform.ag"(line 664, column 8) - _elemsOattrDecls = - Map.empty - -- "Transform.ag"(line 703, column 9) - _allAttrDecls = - if withSelf _lhsIoptions - then foldr addSelf _elemsIattrDecls (Set.toList _allNonterminals ) - else _elemsIattrDecls - -- use rule "Transform.ag"(line 38, column 19) - _lhsOblocks = - _elemsIblocks - -- use rule "Transform.ag"(line 787, column 37) - _lhsOmoduleDecl = - _elemsImoduleDecl - -- use rule "Transform.ag"(line 501, column 34) - _lhsOpragmas = - _elemsIpragmas - -- copy rule (from local) - _elemsOallAttrDecls = - _allAttrDecls - -- copy rule (from local) - _elemsOallFields = - _allFields - -- copy rule (from local) - _elemsOallNonterminals = - _allNonterminals - ( _elemsIattrDecls,_elemsIattrOrderCollect,_elemsIblocks,_elemsIcollectedConstructorsMap,_elemsIcollectedFields,_elemsIcollectedInsts,_elemsIcollectedNames,_elemsIcollectedRules,_elemsIcollectedSetNames,_elemsIcollectedSigs,_elemsIctxCollect,_elemsIdefSets,_elemsIderivings,_elemsIerrors,_elemsImoduleDecl,_elemsIparamsCollect,_elemsIpragmas,_elemsIsemPragmasCollect,_elemsItypeSyns,_elemsIuseMap,_elemsIwrappers) = - (elems_ _elemsOallAttrDecls _elemsOallConstructors _elemsOallFields _elemsOallNonterminals _elemsOattrDecls _elemsOdefSets _elemsOdefinedSets) - in ( _lhsOblocks,_lhsOerrors,_lhsOmoduleDecl,_lhsOoutput,_lhsOpragmas)))) --- Alt --------------------------------------------------------- -{- - visit 0: - inherited attributes: - allConstructors : Map NontermIdent (Set ConstructorIdent) - allNonterminals : Set NontermIdent - nts : Set NontermIdent - synthesized attributes: - collectedConstructorNames : Set ConstructorIdent - collectedFields : [(NontermIdent, ConstructorIdent, FieldMap)] - alternatives: - alternative Alt: - child pos : {Pos} - child names : ConstructorSet - child fields : {Fields} --} --- cata -sem_Alt :: Alt -> - T_Alt -sem_Alt (Alt _pos _names _fields) = - (sem_Alt_Alt _pos (sem_ConstructorSet _names) _fields) --- semantic domain -newtype T_Alt = T_Alt ((Map NontermIdent (Set ConstructorIdent)) -> - (Set NontermIdent) -> - (Set NontermIdent) -> - ( (Set ConstructorIdent),([(NontermIdent, ConstructorIdent, FieldMap)]))) -data Inh_Alt = Inh_Alt {allConstructors_Inh_Alt :: Map NontermIdent (Set ConstructorIdent),allNonterminals_Inh_Alt :: Set NontermIdent,nts_Inh_Alt :: Set NontermIdent} -data Syn_Alt = Syn_Alt {collectedConstructorNames_Syn_Alt :: Set ConstructorIdent,collectedFields_Syn_Alt :: [(NontermIdent, ConstructorIdent, FieldMap)]} -wrap_Alt (T_Alt sem) (Inh_Alt _lhsIallConstructors _lhsIallNonterminals _lhsInts) = - (let ( _lhsOcollectedConstructorNames,_lhsOcollectedFields) = - (sem _lhsIallConstructors _lhsIallNonterminals _lhsInts) - in (Syn_Alt _lhsOcollectedConstructorNames _lhsOcollectedFields)) -sem_Alt_Alt :: Pos -> - T_ConstructorSet -> - Fields -> - T_Alt -sem_Alt_Alt pos_ (T_ConstructorSet names_) fields_ = - (T_Alt (\ _lhsIallConstructors - _lhsIallNonterminals - _lhsInts -> - (let _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _lhsOcollectedConstructorNames :: (Set ConstructorIdent) - _namesIcollectedConstructorNames :: (Set ConstructorIdent) - _namesIconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) - _namesIerrors :: (Seq Error) - -- "Transform.ag"(line 204, column 10) - _lhsOcollectedFields = - let fieldTable = - [ (attr, makeType _lhsIallNonterminals tp) - | (attr, tp) <- fields_ - ] - in [ (nt, con, fieldTable) - | nt <- Set.toList _lhsInts - , con <- Set.toList (_namesIconstructors (Map.findWithDefault Set.empty nt _lhsIallConstructors)) - ] - -- use rule "Transform.ag"(line 82, column 62) - _lhsOcollectedConstructorNames = - _namesIcollectedConstructorNames - ( _namesIcollectedConstructorNames,_namesIconstructors,_namesIerrors) = - (names_ ) - in ( _lhsOcollectedConstructorNames,_lhsOcollectedFields)))) --- Alts -------------------------------------------------------- -{- - visit 0: - inherited attributes: - allConstructors : Map NontermIdent (Set ConstructorIdent) - allNonterminals : Set NontermIdent - nts : Set NontermIdent - synthesized attributes: - collectedConstructorNames : Set ConstructorIdent - collectedFields : [(NontermIdent, ConstructorIdent, FieldMap)] - alternatives: - alternative Cons: - child hd : Alt - child tl : Alts - alternative Nil: --} --- cata -sem_Alts :: Alts -> - T_Alts -sem_Alts list = - (Prelude.foldr sem_Alts_Cons sem_Alts_Nil (Prelude.map sem_Alt list)) --- semantic domain -newtype T_Alts = T_Alts ((Map NontermIdent (Set ConstructorIdent)) -> - (Set NontermIdent) -> - (Set NontermIdent) -> - ( (Set ConstructorIdent),([(NontermIdent, ConstructorIdent, FieldMap)]))) -data Inh_Alts = Inh_Alts {allConstructors_Inh_Alts :: Map NontermIdent (Set ConstructorIdent),allNonterminals_Inh_Alts :: Set NontermIdent,nts_Inh_Alts :: Set NontermIdent} -data Syn_Alts = Syn_Alts {collectedConstructorNames_Syn_Alts :: Set ConstructorIdent,collectedFields_Syn_Alts :: [(NontermIdent, ConstructorIdent, FieldMap)]} -wrap_Alts (T_Alts sem) (Inh_Alts _lhsIallConstructors _lhsIallNonterminals _lhsInts) = - (let ( _lhsOcollectedConstructorNames,_lhsOcollectedFields) = - (sem _lhsIallConstructors _lhsIallNonterminals _lhsInts) - in (Syn_Alts _lhsOcollectedConstructorNames _lhsOcollectedFields)) -sem_Alts_Cons :: T_Alt -> - T_Alts -> - T_Alts -sem_Alts_Cons (T_Alt hd_) (T_Alts tl_) = - (T_Alts (\ _lhsIallConstructors - _lhsIallNonterminals - _lhsInts -> - (let _lhsOcollectedConstructorNames :: (Set ConstructorIdent) - _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _hdOallConstructors :: (Map NontermIdent (Set ConstructorIdent)) - _hdOallNonterminals :: (Set NontermIdent) - _hdOnts :: (Set NontermIdent) - _tlOallConstructors :: (Map NontermIdent (Set ConstructorIdent)) - _tlOallNonterminals :: (Set NontermIdent) - _tlOnts :: (Set NontermIdent) - _hdIcollectedConstructorNames :: (Set ConstructorIdent) - _hdIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _tlIcollectedConstructorNames :: (Set ConstructorIdent) - _tlIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - -- use rule "Transform.ag"(line 82, column 62) - _lhsOcollectedConstructorNames = - _hdIcollectedConstructorNames `Set.union` _tlIcollectedConstructorNames - -- use rule "Transform.ag"(line 114, column 28) - _lhsOcollectedFields = - _hdIcollectedFields ++ _tlIcollectedFields - -- copy rule (down) - _hdOallConstructors = - _lhsIallConstructors - -- copy rule (down) - _hdOallNonterminals = - _lhsIallNonterminals - -- copy rule (down) - _hdOnts = - _lhsInts - -- copy rule (down) - _tlOallConstructors = - _lhsIallConstructors - -- copy rule (down) - _tlOallNonterminals = - _lhsIallNonterminals - -- copy rule (down) - _tlOnts = - _lhsInts - ( _hdIcollectedConstructorNames,_hdIcollectedFields) = - (hd_ _hdOallConstructors _hdOallNonterminals _hdOnts) - ( _tlIcollectedConstructorNames,_tlIcollectedFields) = - (tl_ _tlOallConstructors _tlOallNonterminals _tlOnts) - in ( _lhsOcollectedConstructorNames,_lhsOcollectedFields)))) -sem_Alts_Nil :: T_Alts -sem_Alts_Nil = - (T_Alts (\ _lhsIallConstructors - _lhsIallNonterminals - _lhsInts -> - (let _lhsOcollectedConstructorNames :: (Set ConstructorIdent) - _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - -- use rule "Transform.ag"(line 82, column 62) - _lhsOcollectedConstructorNames = - Set.empty - -- use rule "Transform.ag"(line 114, column 28) - _lhsOcollectedFields = - [] - in ( _lhsOcollectedConstructorNames,_lhsOcollectedFields)))) --- Attrs ------------------------------------------------------- -{- - visit 0: - inherited attributes: - allFields : DataTypes - allNonterminals : Set NontermIdent - nts : Set NontermIdent - chained attribute: - attrDecls : Map NontermIdent (Attributes, Attributes) - synthesized attributes: - errors : Seq Error - useMap : Map NontermIdent (Map Identifier (String,String,String)) - alternatives: - alternative Attrs: - child pos : {Pos} - child inh : {AttrNames} - child chn : {AttrNames} - child syn : {AttrNames} - visit 0: - local _tup1 : _ - local attrDecls : _ - local errors : _ - local _tup2 : _ - local inherited : _ - local synthesized : _ - local useMap : _ --} --- cata -sem_Attrs :: Attrs -> - T_Attrs -sem_Attrs (Attrs _pos _inh _chn _syn) = - (sem_Attrs_Attrs _pos _inh _chn _syn) --- semantic domain -newtype T_Attrs = T_Attrs (DataTypes -> - (Set NontermIdent) -> - (Map NontermIdent (Attributes, Attributes)) -> - (Set NontermIdent) -> - ( (Map NontermIdent (Attributes, Attributes)),(Seq Error),(Map NontermIdent (Map Identifier (String,String,String))))) -data Inh_Attrs = Inh_Attrs {allFields_Inh_Attrs :: DataTypes,allNonterminals_Inh_Attrs :: Set NontermIdent,attrDecls_Inh_Attrs :: Map NontermIdent (Attributes, Attributes),nts_Inh_Attrs :: Set NontermIdent} -data Syn_Attrs = Syn_Attrs {attrDecls_Syn_Attrs :: Map NontermIdent (Attributes, Attributes),errors_Syn_Attrs :: Seq Error,useMap_Syn_Attrs :: Map NontermIdent (Map Identifier (String,String,String))} -wrap_Attrs (T_Attrs sem) (Inh_Attrs _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsInts) = - (let ( _lhsOattrDecls,_lhsOerrors,_lhsOuseMap) = - (sem _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsInts) - in (Syn_Attrs _lhsOattrDecls _lhsOerrors _lhsOuseMap)) -sem_Attrs_Attrs :: Pos -> - AttrNames -> - AttrNames -> - AttrNames -> - T_Attrs -sem_Attrs_Attrs pos_ inh_ chn_ syn_ = - (T_Attrs (\ _lhsIallFields - _lhsIallNonterminals - _lhsIattrDecls - _lhsInts -> - (let _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) - _lhsOerrors :: (Seq Error) - _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) - -- "Transform.ag"(line 672, column 15) - __tup1 = - checkAttrs _lhsIallFields (Set.toList _lhsInts) _inherited _synthesized _lhsIattrDecls - -- "Transform.ag"(line 672, column 15) - (_attrDecls,_) = - __tup1 - -- "Transform.ag"(line 672, column 15) - (_,_errors) = - __tup1 - -- "Transform.ag"(line 674, column 15) - __tup2 = - let splitAttrs xs = unzip [ ((n,makeType _lhsIallNonterminals t),(n,ud)) - | (n,t,ud) <- xs - ] - (inh,_) = splitAttrs inh_ - (chn,uses1) = splitAttrs chn_ - (syn,uses2) = splitAttrs syn_ - isUse (n,(e1,e2,_)) = not (null e1 || null e2) - in (inh++chn,chn++syn, Map.fromList (Prelude.filter isUse (uses1++uses2))) - -- "Transform.ag"(line 674, column 15) - (_inherited,_,_) = - __tup2 - -- "Transform.ag"(line 674, column 15) - (_,_synthesized,_) = - __tup2 - -- "Transform.ag"(line 674, column 15) - (_,_,_useMap) = - __tup2 - -- "Transform.ag"(line 682, column 11) - _lhsOuseMap = - Map.fromList (zip (Set.toList _lhsInts) (repeat _useMap)) - -- use rule "Transform.ag"(line 36, column 19) - _lhsOerrors = - _errors - -- copy rule (from local) - _lhsOattrDecls = - _attrDecls - in ( _lhsOattrDecls,_lhsOerrors,_lhsOuseMap)))) --- ConstructorSet ---------------------------------------------- -{- - visit 0: - synthesized attributes: - collectedConstructorNames : Set ConstructorIdent - constructors : (Set ConstructorIdent->Set ConstructorIdent) - errors : Seq Error - alternatives: - alternative CAll: - alternative CDifference: - child set1 : ConstructorSet - child set2 : ConstructorSet - alternative CName: - child name : {ConstructorIdent} - alternative CUnion: - child set1 : ConstructorSet - child set2 : ConstructorSet --} --- cata -sem_ConstructorSet :: ConstructorSet -> - T_ConstructorSet -sem_ConstructorSet (CAll ) = - (sem_ConstructorSet_CAll ) -sem_ConstructorSet (CDifference _set1 _set2) = - (sem_ConstructorSet_CDifference (sem_ConstructorSet _set1) (sem_ConstructorSet _set2)) -sem_ConstructorSet (CName _name) = - (sem_ConstructorSet_CName _name) -sem_ConstructorSet (CUnion _set1 _set2) = - (sem_ConstructorSet_CUnion (sem_ConstructorSet _set1) (sem_ConstructorSet _set2)) --- semantic domain -newtype T_ConstructorSet = T_ConstructorSet (( (Set ConstructorIdent),((Set ConstructorIdent->Set ConstructorIdent)),(Seq Error))) -data Inh_ConstructorSet = Inh_ConstructorSet {} -data Syn_ConstructorSet = Syn_ConstructorSet {collectedConstructorNames_Syn_ConstructorSet :: Set ConstructorIdent,constructors_Syn_ConstructorSet :: (Set ConstructorIdent->Set ConstructorIdent),errors_Syn_ConstructorSet :: Seq Error} -wrap_ConstructorSet (T_ConstructorSet sem) (Inh_ConstructorSet ) = - (let ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors) = - (sem ) - in (Syn_ConstructorSet _lhsOcollectedConstructorNames _lhsOconstructors _lhsOerrors)) -sem_ConstructorSet_CAll :: T_ConstructorSet -sem_ConstructorSet_CAll = - (T_ConstructorSet (let _lhsOconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) - _lhsOcollectedConstructorNames :: (Set ConstructorIdent) - _lhsOerrors :: (Seq Error) - -- "Transform.ag"(line 486, column 17) - _lhsOconstructors = - \ds -> ds - -- use rule "Transform.ag"(line 82, column 62) - _lhsOcollectedConstructorNames = - Set.empty - -- use rule "Transform.ag"(line 36, column 19) - _lhsOerrors = - Seq.empty - in ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors))) -sem_ConstructorSet_CDifference :: T_ConstructorSet -> - T_ConstructorSet -> - T_ConstructorSet -sem_ConstructorSet_CDifference (T_ConstructorSet set1_) (T_ConstructorSet set2_) = - (T_ConstructorSet (let _lhsOconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) - _lhsOcollectedConstructorNames :: (Set ConstructorIdent) - _lhsOerrors :: (Seq Error) - _set1IcollectedConstructorNames :: (Set ConstructorIdent) - _set1Iconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) - _set1Ierrors :: (Seq Error) - _set2IcollectedConstructorNames :: (Set ConstructorIdent) - _set2Iconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) - _set2Ierrors :: (Seq Error) - -- "Transform.ag"(line 485, column 17) - _lhsOconstructors = - \ds -> _set1Iconstructors ds `Set.difference` _set2Iconstructors ds - -- use rule "Transform.ag"(line 82, column 62) - _lhsOcollectedConstructorNames = - _set1IcollectedConstructorNames `Set.union` _set2IcollectedConstructorNames - -- use rule "Transform.ag"(line 36, column 19) - _lhsOerrors = - _set1Ierrors Seq.<> _set2Ierrors - ( _set1IcollectedConstructorNames,_set1Iconstructors,_set1Ierrors) = - (set1_ ) - ( _set2IcollectedConstructorNames,_set2Iconstructors,_set2Ierrors) = - (set2_ ) - in ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors))) -sem_ConstructorSet_CName :: ConstructorIdent -> - T_ConstructorSet -sem_ConstructorSet_CName name_ = - (T_ConstructorSet (let _lhsOcollectedConstructorNames :: (Set ConstructorIdent) - _lhsOconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) - _lhsOerrors :: (Seq Error) - -- "Transform.ag"(line 353, column 11) - _lhsOcollectedConstructorNames = - Set.singleton name_ - -- "Transform.ag"(line 483, column 17) - _lhsOconstructors = - \ds -> Set.singleton name_ - -- use rule "Transform.ag"(line 36, column 19) - _lhsOerrors = - Seq.empty - in ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors))) -sem_ConstructorSet_CUnion :: T_ConstructorSet -> - T_ConstructorSet -> - T_ConstructorSet -sem_ConstructorSet_CUnion (T_ConstructorSet set1_) (T_ConstructorSet set2_) = - (T_ConstructorSet (let _lhsOconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) - _lhsOcollectedConstructorNames :: (Set ConstructorIdent) - _lhsOerrors :: (Seq Error) - _set1IcollectedConstructorNames :: (Set ConstructorIdent) - _set1Iconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) - _set1Ierrors :: (Seq Error) - _set2IcollectedConstructorNames :: (Set ConstructorIdent) - _set2Iconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) - _set2Ierrors :: (Seq Error) - -- "Transform.ag"(line 484, column 17) - _lhsOconstructors = - \ds -> _set1Iconstructors ds `Set.union` _set2Iconstructors ds - -- use rule "Transform.ag"(line 82, column 62) - _lhsOcollectedConstructorNames = - _set1IcollectedConstructorNames `Set.union` _set2IcollectedConstructorNames - -- use rule "Transform.ag"(line 36, column 19) - _lhsOerrors = - _set1Ierrors Seq.<> _set2Ierrors - ( _set1IcollectedConstructorNames,_set1Iconstructors,_set1Ierrors) = - (set1_ ) - ( _set2IcollectedConstructorNames,_set2Iconstructors,_set2Ierrors) = - (set2_ ) - in ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors))) --- Elem -------------------------------------------------------- -{- - visit 0: - inherited attributes: - allAttrDecls : Map NontermIdent (Attributes, Attributes) - allConstructors : Map NontermIdent (Set ConstructorIdent) - allFields : DataTypes - allNonterminals : Set NontermIdent - definedSets : DefinedSets - chained attributes: - attrDecls : Map NontermIdent (Attributes, Attributes) - defSets : Map Identifier (Set NontermIdent,Set Identifier) - synthesized attributes: - attrOrderCollect : AttrOrderMap - blocks : Blocks - collectedConstructorsMap : Map NontermIdent (Set ConstructorIdent) - collectedFields : [(NontermIdent, ConstructorIdent, FieldMap)] - collectedInsts : [ (NontermIdent, ConstructorIdent, [Identifier]) ] - collectedNames : Set Identifier - collectedRules : [ (NontermIdent, ConstructorIdent, RuleInfo)] - collectedSetNames : Set Identifier - collectedSigs : [ (NontermIdent, ConstructorIdent, SigInfo) ] - ctxCollect : ContextMap - derivings : Derivings - errors : Seq Error - moduleDecl : Maybe (String,String,String) - paramsCollect : ParamMap - pragmas : Options -> Options - semPragmasCollect : PragmaMap - typeSyns : TypeSyns - useMap : Map NontermIdent (Map Identifier (String,String,String)) - wrappers : Set NontermIdent - alternatives: - alternative Attr: - child pos : {Pos} - child ctx : {ClassContext} - child names : NontSet - child attrs : Attrs - alternative Data: - child pos : {Pos} - child ctx : {ClassContext} - child names : NontSet - child params : {[Identifier]} - child attrs : Attrs - child alts : Alts - child ext : {Bool} - alternative Deriving: - child pos : {Pos} - child set : NontSet - child classes : {[NontermIdent]} - alternative Module: - child pos : {Pos} - child name : {String} - child exports : {String} - child imports : {String} - alternative Pragma: - child pos : {Pos} - child names : {[NontermIdent]} - alternative Sem: - child pos : {Pos} - child ctx : {ClassContext} - child names : NontSet - child attrs : Attrs - child alts : SemAlts - alternative Set: - child pos : {Pos} - child name : {NontermIdent} - child set : NontSet - visit 0: - local _tup3 : _ - local defSets2 : _ - local errs : _ - alternative Txt: - child pos : {Pos} - child name : {NontermIdent} - child lines : {[String]} - alternative Type: - child pos : {Pos} - child ctx : {ClassContext} - child name : {NontermIdent} - child params : {[Identifier]} - child type : {ComplexType} - visit 0: - local expanded : _ - local argType : _ - alternative Wrapper: - child pos : {Pos} - child set : NontSet --} --- cata -sem_Elem :: Elem -> - T_Elem -sem_Elem (Attr _pos _ctx _names _attrs) = - (sem_Elem_Attr _pos _ctx (sem_NontSet _names) (sem_Attrs _attrs)) -sem_Elem (Data _pos _ctx _names _params _attrs _alts _ext) = - (sem_Elem_Data _pos _ctx (sem_NontSet _names) _params (sem_Attrs _attrs) (sem_Alts _alts) _ext) -sem_Elem (Deriving _pos _set _classes) = - (sem_Elem_Deriving _pos (sem_NontSet _set) _classes) -sem_Elem (Module _pos _name _exports _imports) = - (sem_Elem_Module _pos _name _exports _imports) -sem_Elem (Pragma _pos _names) = - (sem_Elem_Pragma _pos _names) -sem_Elem (Sem _pos _ctx _names _attrs _alts) = - (sem_Elem_Sem _pos _ctx (sem_NontSet _names) (sem_Attrs _attrs) (sem_SemAlts _alts)) -sem_Elem (Set _pos _name _set) = - (sem_Elem_Set _pos _name (sem_NontSet _set)) -sem_Elem (Txt _pos _name _lines) = - (sem_Elem_Txt _pos _name _lines) -sem_Elem (Type _pos _ctx _name _params _type) = - (sem_Elem_Type _pos _ctx _name _params _type) -sem_Elem (Wrapper _pos _set) = - (sem_Elem_Wrapper _pos (sem_NontSet _set)) --- semantic domain -newtype T_Elem = T_Elem ((Map NontermIdent (Attributes, Attributes)) -> - (Map NontermIdent (Set ConstructorIdent)) -> - DataTypes -> - (Set NontermIdent) -> - (Map NontermIdent (Attributes, Attributes)) -> - (Map Identifier (Set NontermIdent,Set Identifier)) -> - DefinedSets -> - ( (Map NontermIdent (Attributes, Attributes)),AttrOrderMap,Blocks,(Map NontermIdent (Set ConstructorIdent)),([(NontermIdent, ConstructorIdent, FieldMap)]),([ (NontermIdent, ConstructorIdent, [Identifier]) ]),(Set Identifier),([ (NontermIdent, ConstructorIdent, RuleInfo)]),(Set Identifier),([ (NontermIdent, ConstructorIdent, SigInfo) ]),ContextMap,(Map Identifier (Set NontermIdent,Set Identifier)),Derivings,(Seq Error),(Maybe (String,String,String)),ParamMap,(Options -> Options),PragmaMap,TypeSyns,(Map NontermIdent (Map Identifier (String,String,String))),(Set NontermIdent))) -data Inh_Elem = Inh_Elem {allAttrDecls_Inh_Elem :: Map NontermIdent (Attributes, Attributes),allConstructors_Inh_Elem :: Map NontermIdent (Set ConstructorIdent),allFields_Inh_Elem :: DataTypes,allNonterminals_Inh_Elem :: Set NontermIdent,attrDecls_Inh_Elem :: Map NontermIdent (Attributes, Attributes),defSets_Inh_Elem :: Map Identifier (Set NontermIdent,Set Identifier),definedSets_Inh_Elem :: DefinedSets} -data Syn_Elem = Syn_Elem {attrDecls_Syn_Elem :: Map NontermIdent (Attributes, Attributes),attrOrderCollect_Syn_Elem :: AttrOrderMap,blocks_Syn_Elem :: Blocks,collectedConstructorsMap_Syn_Elem :: Map NontermIdent (Set ConstructorIdent),collectedFields_Syn_Elem :: [(NontermIdent, ConstructorIdent, FieldMap)],collectedInsts_Syn_Elem :: [ (NontermIdent, ConstructorIdent, [Identifier]) ],collectedNames_Syn_Elem :: Set Identifier,collectedRules_Syn_Elem :: [ (NontermIdent, ConstructorIdent, RuleInfo)],collectedSetNames_Syn_Elem :: Set Identifier,collectedSigs_Syn_Elem :: [ (NontermIdent, ConstructorIdent, SigInfo) ],ctxCollect_Syn_Elem :: ContextMap,defSets_Syn_Elem :: Map Identifier (Set NontermIdent,Set Identifier),derivings_Syn_Elem :: Derivings,errors_Syn_Elem :: Seq Error,moduleDecl_Syn_Elem :: Maybe (String,String,String),paramsCollect_Syn_Elem :: ParamMap,pragmas_Syn_Elem :: Options -> Options,semPragmasCollect_Syn_Elem :: PragmaMap,typeSyns_Syn_Elem :: TypeSyns,useMap_Syn_Elem :: Map NontermIdent (Map Identifier (String,String,String)),wrappers_Syn_Elem :: Set NontermIdent} -wrap_Elem (T_Elem sem) (Inh_Elem _lhsIallAttrDecls _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIdefSets _lhsIdefinedSets) = - (let ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers) = - (sem _lhsIallAttrDecls _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIdefSets _lhsIdefinedSets) - in (Syn_Elem _lhsOattrDecls _lhsOattrOrderCollect _lhsOblocks _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOctxCollect _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOparamsCollect _lhsOpragmas _lhsOsemPragmasCollect _lhsOtypeSyns _lhsOuseMap _lhsOwrappers)) -sem_Elem_Attr :: Pos -> - ClassContext -> - T_NontSet -> - T_Attrs -> - T_Elem -sem_Elem_Attr pos_ ctx_ (T_NontSet names_) (T_Attrs attrs_) = - (T_Elem (\ _lhsIallAttrDecls - _lhsIallConstructors - _lhsIallFields - _lhsIallNonterminals - _lhsIattrDecls - _lhsIdefSets - _lhsIdefinedSets -> - (let _lhsOctxCollect :: ContextMap - _attrsOnts :: (Set NontermIdent) - _lhsOattrOrderCollect :: AttrOrderMap - _lhsOblocks :: Blocks - _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _lhsOcollectedNames :: (Set Identifier) - _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) - _lhsOcollectedSetNames :: (Set Identifier) - _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) - _lhsOderivings :: Derivings - _lhsOerrors :: (Seq Error) - _lhsOmoduleDecl :: (Maybe (String,String,String)) - _lhsOparamsCollect :: ParamMap - _lhsOpragmas :: (Options -> Options) - _lhsOsemPragmasCollect :: PragmaMap - _lhsOtypeSyns :: TypeSyns - _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) - _lhsOwrappers :: (Set NontermIdent) - _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) - _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) - _namesOallFields :: DataTypes - _namesOallNonterminals :: (Set NontermIdent) - _namesOdefinedSets :: DefinedSets - _attrsOallFields :: DataTypes - _attrsOallNonterminals :: (Set NontermIdent) - _attrsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) - _namesIcollectedNames :: (Set Identifier) - _namesIerrors :: (Seq Error) - _namesInontSet :: (Set NontermIdent) - _attrsIattrDecls :: (Map NontermIdent (Attributes, Attributes)) - _attrsIerrors :: (Seq Error) - _attrsIuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) - -- "Transform.ag"(line 624, column 7) - _lhsOctxCollect = - if null ctx_ - then Map.empty - else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet] - -- "Transform.ag"(line 668, column 10) - _attrsOnts = - _namesInontSet - -- use rule "Transform.ag"(line 565, column 55) - _lhsOattrOrderCollect = - Map.empty - -- use rule "Transform.ag"(line 38, column 19) - _lhsOblocks = - Map.empty - -- use rule "Transform.ag"(line 83, column 48) - _lhsOcollectedConstructorsMap = - Map.empty - -- use rule "Transform.ag"(line 114, column 28) - _lhsOcollectedFields = - [] - -- use rule "Transform.ag"(line 138, column 29) - _lhsOcollectedInsts = - [] - -- use rule "Transform.ag"(line 75, column 50) - _lhsOcollectedNames = - _namesIcollectedNames - -- use rule "Transform.ag"(line 136, column 29) - _lhsOcollectedRules = - [] - -- use rule "Transform.ag"(line 74, column 50) - _lhsOcollectedSetNames = - Set.empty - -- use rule "Transform.ag"(line 137, column 29) - _lhsOcollectedSigs = - [] - -- use rule "Transform.ag"(line 645, column 33) - _lhsOderivings = - Map.empty - -- use rule "Transform.ag"(line 36, column 19) - _lhsOerrors = - _namesIerrors Seq.<> _attrsIerrors - -- use rule "Transform.ag"(line 787, column 37) - _lhsOmoduleDecl = - mzero - -- use rule "Transform.ag"(line 597, column 37) - _lhsOparamsCollect = - Map.empty - -- use rule "Transform.ag"(line 501, column 34) - _lhsOpragmas = - id - -- use rule "Transform.ag"(line 537, column 56) - _lhsOsemPragmasCollect = - Map.empty - -- use rule "Transform.ag"(line 380, column 32) - _lhsOtypeSyns = - [] - -- use rule "Transform.ag"(line 126, column 15) - _lhsOuseMap = - _attrsIuseMap - -- use rule "Transform.ag"(line 492, column 32) - _lhsOwrappers = - Set.empty - -- copy rule (up) - _lhsOattrDecls = - _attrsIattrDecls - -- copy rule (chain) - _lhsOdefSets = - _lhsIdefSets - -- copy rule (down) - _namesOallFields = - _lhsIallFields - -- copy rule (down) - _namesOallNonterminals = - _lhsIallNonterminals - -- copy rule (down) - _namesOdefinedSets = - _lhsIdefinedSets - -- copy rule (down) - _attrsOallFields = - _lhsIallFields - -- copy rule (down) - _attrsOallNonterminals = - _lhsIallNonterminals - -- copy rule (down) - _attrsOattrDecls = - _lhsIattrDecls - ( _namesIcollectedNames,_namesIerrors,_namesInontSet) = - (names_ _namesOallFields _namesOallNonterminals _namesOdefinedSets) - ( _attrsIattrDecls,_attrsIerrors,_attrsIuseMap) = - (attrs_ _attrsOallFields _attrsOallNonterminals _attrsOattrDecls _attrsOnts) - in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) -sem_Elem_Data :: Pos -> - ClassContext -> - T_NontSet -> - ([Identifier]) -> - T_Attrs -> - T_Alts -> - Bool -> - T_Elem -sem_Elem_Data pos_ ctx_ (T_NontSet names_) params_ (T_Attrs attrs_) (T_Alts alts_) ext_ = - (T_Elem (\ _lhsIallAttrDecls - _lhsIallConstructors - _lhsIallFields - _lhsIallNonterminals - _lhsIattrDecls - _lhsIdefSets - _lhsIdefinedSets -> - (let _altsOnts :: (Set NontermIdent) - _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _lhsOparamsCollect :: ParamMap - _lhsOctxCollect :: ContextMap - _attrsOnts :: (Set NontermIdent) - _lhsOattrOrderCollect :: AttrOrderMap - _lhsOblocks :: Blocks - _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _lhsOcollectedNames :: (Set Identifier) - _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) - _lhsOcollectedSetNames :: (Set Identifier) - _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) - _lhsOderivings :: Derivings - _lhsOerrors :: (Seq Error) - _lhsOmoduleDecl :: (Maybe (String,String,String)) - _lhsOpragmas :: (Options -> Options) - _lhsOsemPragmasCollect :: PragmaMap - _lhsOtypeSyns :: TypeSyns - _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) - _lhsOwrappers :: (Set NontermIdent) - _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) - _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) - _namesOallFields :: DataTypes - _namesOallNonterminals :: (Set NontermIdent) - _namesOdefinedSets :: DefinedSets - _attrsOallFields :: DataTypes - _attrsOallNonterminals :: (Set NontermIdent) - _attrsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) - _altsOallConstructors :: (Map NontermIdent (Set ConstructorIdent)) - _altsOallNonterminals :: (Set NontermIdent) - _namesIcollectedNames :: (Set Identifier) - _namesIerrors :: (Seq Error) - _namesInontSet :: (Set NontermIdent) - _attrsIattrDecls :: (Map NontermIdent (Attributes, Attributes)) - _attrsIerrors :: (Seq Error) - _attrsIuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) - _altsIcollectedConstructorNames :: (Set ConstructorIdent) - _altsIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - -- "Transform.ag"(line 151, column 10) - _altsOnts = - _namesInontSet - -- "Transform.ag"(line 359, column 11) - _lhsOcollectedConstructorsMap = - Map.fromList - [ (n, _altsIcollectedConstructorNames) - | n <- Set.toList _namesInontSet - ] - -- "Transform.ag"(line 601, column 7) - _lhsOparamsCollect = - if null params_ - then Map.empty - else Map.fromList [(nt, params_) | nt <- Set.toList _namesInontSet] - -- "Transform.ag"(line 624, column 7) - _lhsOctxCollect = - if null ctx_ - then Map.empty - else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet] - -- "Transform.ag"(line 667, column 10) - _attrsOnts = - _namesInontSet - -- use rule "Transform.ag"(line 565, column 55) - _lhsOattrOrderCollect = - Map.empty - -- use rule "Transform.ag"(line 38, column 19) - _lhsOblocks = - Map.empty - -- use rule "Transform.ag"(line 114, column 28) - _lhsOcollectedFields = - _altsIcollectedFields - -- use rule "Transform.ag"(line 138, column 29) - _lhsOcollectedInsts = - [] - -- use rule "Transform.ag"(line 75, column 50) - _lhsOcollectedNames = - _namesIcollectedNames - -- use rule "Transform.ag"(line 136, column 29) - _lhsOcollectedRules = - [] - -- use rule "Transform.ag"(line 74, column 50) - _lhsOcollectedSetNames = - Set.empty - -- use rule "Transform.ag"(line 137, column 29) - _lhsOcollectedSigs = - [] - -- use rule "Transform.ag"(line 645, column 33) - _lhsOderivings = - Map.empty - -- use rule "Transform.ag"(line 36, column 19) - _lhsOerrors = - _namesIerrors Seq.<> _attrsIerrors - -- use rule "Transform.ag"(line 787, column 37) - _lhsOmoduleDecl = - mzero - -- use rule "Transform.ag"(line 501, column 34) - _lhsOpragmas = - id - -- use rule "Transform.ag"(line 537, column 56) - _lhsOsemPragmasCollect = - Map.empty - -- use rule "Transform.ag"(line 380, column 32) - _lhsOtypeSyns = - [] - -- use rule "Transform.ag"(line 126, column 15) - _lhsOuseMap = - _attrsIuseMap - -- use rule "Transform.ag"(line 492, column 32) - _lhsOwrappers = - Set.empty - -- copy rule (up) - _lhsOattrDecls = - _attrsIattrDecls - -- copy rule (chain) - _lhsOdefSets = - _lhsIdefSets - -- copy rule (down) - _namesOallFields = - _lhsIallFields - -- copy rule (down) - _namesOallNonterminals = - _lhsIallNonterminals - -- copy rule (down) - _namesOdefinedSets = - _lhsIdefinedSets - -- copy rule (down) - _attrsOallFields = - _lhsIallFields - -- copy rule (down) - _attrsOallNonterminals = - _lhsIallNonterminals - -- copy rule (down) - _attrsOattrDecls = - _lhsIattrDecls - -- copy rule (down) - _altsOallConstructors = - _lhsIallConstructors - -- copy rule (down) - _altsOallNonterminals = - _lhsIallNonterminals - ( _namesIcollectedNames,_namesIerrors,_namesInontSet) = - (names_ _namesOallFields _namesOallNonterminals _namesOdefinedSets) - ( _attrsIattrDecls,_attrsIerrors,_attrsIuseMap) = - (attrs_ _attrsOallFields _attrsOallNonterminals _attrsOattrDecls _attrsOnts) - ( _altsIcollectedConstructorNames,_altsIcollectedFields) = - (alts_ _altsOallConstructors _altsOallNonterminals _altsOnts) - in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) -sem_Elem_Deriving :: Pos -> - T_NontSet -> - ([NontermIdent]) -> - T_Elem -sem_Elem_Deriving pos_ (T_NontSet set_) classes_ = - (T_Elem (\ _lhsIallAttrDecls - _lhsIallConstructors - _lhsIallFields - _lhsIallNonterminals - _lhsIattrDecls - _lhsIdefSets - _lhsIdefinedSets -> - (let _lhsOderivings :: Derivings - _lhsOattrOrderCollect :: AttrOrderMap - _lhsOblocks :: Blocks - _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _lhsOcollectedNames :: (Set Identifier) - _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) - _lhsOcollectedSetNames :: (Set Identifier) - _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) - _lhsOctxCollect :: ContextMap - _lhsOerrors :: (Seq Error) - _lhsOmoduleDecl :: (Maybe (String,String,String)) - _lhsOparamsCollect :: ParamMap - _lhsOpragmas :: (Options -> Options) - _lhsOsemPragmasCollect :: PragmaMap - _lhsOtypeSyns :: TypeSyns - _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) - _lhsOwrappers :: (Set NontermIdent) - _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) - _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) - _setOallFields :: DataTypes - _setOallNonterminals :: (Set NontermIdent) - _setOdefinedSets :: DefinedSets - _setIcollectedNames :: (Set Identifier) - _setIerrors :: (Seq Error) - _setInontSet :: (Set NontermIdent) - -- "Transform.ag"(line 652, column 14) - _lhsOderivings = - Map.fromList [(nt,Set.fromList classes_) | nt <- Set.toList _setInontSet] - -- use rule "Transform.ag"(line 565, column 55) - _lhsOattrOrderCollect = - Map.empty - -- use rule "Transform.ag"(line 38, column 19) - _lhsOblocks = - Map.empty - -- use rule "Transform.ag"(line 83, column 48) - _lhsOcollectedConstructorsMap = - Map.empty - -- use rule "Transform.ag"(line 114, column 28) - _lhsOcollectedFields = - [] - -- use rule "Transform.ag"(line 138, column 29) - _lhsOcollectedInsts = - [] - -- use rule "Transform.ag"(line 75, column 50) - _lhsOcollectedNames = - _setIcollectedNames - -- use rule "Transform.ag"(line 136, column 29) - _lhsOcollectedRules = - [] - -- use rule "Transform.ag"(line 74, column 50) - _lhsOcollectedSetNames = - Set.empty - -- use rule "Transform.ag"(line 137, column 29) - _lhsOcollectedSigs = - [] - -- use rule "Transform.ag"(line 620, column 34) - _lhsOctxCollect = - Map.empty - -- use rule "Transform.ag"(line 36, column 19) - _lhsOerrors = - _setIerrors - -- use rule "Transform.ag"(line 787, column 37) - _lhsOmoduleDecl = - mzero - -- use rule "Transform.ag"(line 597, column 37) - _lhsOparamsCollect = - Map.empty - -- use rule "Transform.ag"(line 501, column 34) - _lhsOpragmas = - id - -- use rule "Transform.ag"(line 537, column 56) - _lhsOsemPragmasCollect = - Map.empty - -- use rule "Transform.ag"(line 380, column 32) - _lhsOtypeSyns = - [] - -- use rule "Transform.ag"(line 126, column 15) - _lhsOuseMap = - Map.empty - -- use rule "Transform.ag"(line 492, column 32) - _lhsOwrappers = - Set.empty - -- copy rule (chain) - _lhsOattrDecls = - _lhsIattrDecls - -- copy rule (chain) - _lhsOdefSets = - _lhsIdefSets - -- copy rule (down) - _setOallFields = - _lhsIallFields - -- copy rule (down) - _setOallNonterminals = - _lhsIallNonterminals - -- copy rule (down) - _setOdefinedSets = - _lhsIdefinedSets - ( _setIcollectedNames,_setIerrors,_setInontSet) = - (set_ _setOallFields _setOallNonterminals _setOdefinedSets) - in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) -sem_Elem_Module :: Pos -> - String -> - String -> - String -> - T_Elem -sem_Elem_Module pos_ name_ exports_ imports_ = - (T_Elem (\ _lhsIallAttrDecls - _lhsIallConstructors - _lhsIallFields - _lhsIallNonterminals - _lhsIattrDecls - _lhsIdefSets - _lhsIdefinedSets -> - (let _lhsOmoduleDecl :: (Maybe (String,String,String)) - _lhsOattrOrderCollect :: AttrOrderMap - _lhsOblocks :: Blocks - _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _lhsOcollectedNames :: (Set Identifier) - _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) - _lhsOcollectedSetNames :: (Set Identifier) - _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) - _lhsOctxCollect :: ContextMap - _lhsOderivings :: Derivings - _lhsOerrors :: (Seq Error) - _lhsOparamsCollect :: ParamMap - _lhsOpragmas :: (Options -> Options) - _lhsOsemPragmasCollect :: PragmaMap - _lhsOtypeSyns :: TypeSyns - _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) - _lhsOwrappers :: (Set NontermIdent) - _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) - _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) - -- "Transform.ag"(line 791, column 7) - _lhsOmoduleDecl = - Just (name_, exports_, imports_) - -- use rule "Transform.ag"(line 565, column 55) - _lhsOattrOrderCollect = - Map.empty - -- use rule "Transform.ag"(line 38, column 19) - _lhsOblocks = - Map.empty - -- use rule "Transform.ag"(line 83, column 48) - _lhsOcollectedConstructorsMap = - Map.empty - -- use rule "Transform.ag"(line 114, column 28) - _lhsOcollectedFields = - [] - -- use rule "Transform.ag"(line 138, column 29) - _lhsOcollectedInsts = - [] - -- use rule "Transform.ag"(line 75, column 50) - _lhsOcollectedNames = - Set.empty - -- use rule "Transform.ag"(line 136, column 29) - _lhsOcollectedRules = - [] - -- use rule "Transform.ag"(line 74, column 50) - _lhsOcollectedSetNames = - Set.empty - -- use rule "Transform.ag"(line 137, column 29) - _lhsOcollectedSigs = - [] - -- use rule "Transform.ag"(line 620, column 34) - _lhsOctxCollect = - Map.empty - -- use rule "Transform.ag"(line 645, column 33) - _lhsOderivings = - Map.empty - -- use rule "Transform.ag"(line 36, column 19) - _lhsOerrors = - Seq.empty - -- use rule "Transform.ag"(line 597, column 37) - _lhsOparamsCollect = - Map.empty - -- use rule "Transform.ag"(line 501, column 34) - _lhsOpragmas = - id - -- use rule "Transform.ag"(line 537, column 56) - _lhsOsemPragmasCollect = - Map.empty - -- use rule "Transform.ag"(line 380, column 32) - _lhsOtypeSyns = - [] - -- use rule "Transform.ag"(line 126, column 15) - _lhsOuseMap = - Map.empty - -- use rule "Transform.ag"(line 492, column 32) - _lhsOwrappers = - Set.empty - -- copy rule (chain) - _lhsOattrDecls = - _lhsIattrDecls - -- copy rule (chain) - _lhsOdefSets = - _lhsIdefSets - in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) -sem_Elem_Pragma :: Pos -> - ([NontermIdent]) -> - T_Elem -sem_Elem_Pragma pos_ names_ = - (T_Elem (\ _lhsIallAttrDecls - _lhsIallConstructors - _lhsIallFields - _lhsIallNonterminals - _lhsIattrDecls - _lhsIdefSets - _lhsIdefinedSets -> - (let _lhsOpragmas :: (Options -> Options) - _lhsOattrOrderCollect :: AttrOrderMap - _lhsOblocks :: Blocks - _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _lhsOcollectedNames :: (Set Identifier) - _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) - _lhsOcollectedSetNames :: (Set Identifier) - _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) - _lhsOctxCollect :: ContextMap - _lhsOderivings :: Derivings - _lhsOerrors :: (Seq Error) - _lhsOmoduleDecl :: (Maybe (String,String,String)) - _lhsOparamsCollect :: ParamMap - _lhsOsemPragmasCollect :: PragmaMap - _lhsOtypeSyns :: TypeSyns - _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) - _lhsOwrappers :: (Set NontermIdent) - _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) - _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) - -- "Transform.ag"(line 504, column 13) - _lhsOpragmas = - let mk n o = case getName n of - "nocycle" -> o { withCycle = False } - "cycle" -> o { withCycle = True } - "nostrictdata" -> o { strictData = False } - "strictdata" -> o { strictData = True } - "nostrictcase" -> o { strictCases = False } - "strictcase" -> o { strictCases = True } - "strictercase" -> o { strictCases = True, stricterCases = True } - "nostrictwrap" -> o { strictWrap = False } - "strictwrap" -> o { strictWrap = True } - "novisit" -> o { visit = False } - "visit" -> o { visit = True } - "nocase" -> o { cases = False } - "case" -> o { cases = True } - "noseq" -> o { withSeq = False } - "seq" -> o { withSeq = True } - "nounbox" -> o { unbox = False } - "unbox" -> o { unbox = True } - "bangpats" -> o { bangpats = True } - "nooptimize" -> o { cases = False , visit = False } - "optimize" -> o { cases = True , visit = True } - "strictsem" -> o { strictSems = True } - "gentraces" -> o { genTraces = True } - "genusetraces" -> o { genUseTraces = True } - "splitsems" -> o { splitSems = True } - "gencostcentres" -> o { genCostCentres = True } - "sepsemmods" -> o { sepSemMods = True } - "genlinepragmas" -> o { genLinePragmas = True } - "newtypes" -> o { newtypes = True } - "nonewtypes" -> o { newtypes = False } - _ -> o - in \o -> foldr mk o names_ - -- use rule "Transform.ag"(line 565, column 55) - _lhsOattrOrderCollect = - Map.empty - -- use rule "Transform.ag"(line 38, column 19) - _lhsOblocks = - Map.empty - -- use rule "Transform.ag"(line 83, column 48) - _lhsOcollectedConstructorsMap = - Map.empty - -- use rule "Transform.ag"(line 114, column 28) - _lhsOcollectedFields = - [] - -- use rule "Transform.ag"(line 138, column 29) - _lhsOcollectedInsts = - [] - -- use rule "Transform.ag"(line 75, column 50) - _lhsOcollectedNames = - Set.empty - -- use rule "Transform.ag"(line 136, column 29) - _lhsOcollectedRules = - [] - -- use rule "Transform.ag"(line 74, column 50) - _lhsOcollectedSetNames = - Set.empty - -- use rule "Transform.ag"(line 137, column 29) - _lhsOcollectedSigs = - [] - -- use rule "Transform.ag"(line 620, column 34) - _lhsOctxCollect = - Map.empty - -- use rule "Transform.ag"(line 645, column 33) - _lhsOderivings = - Map.empty - -- use rule "Transform.ag"(line 36, column 19) - _lhsOerrors = - Seq.empty - -- use rule "Transform.ag"(line 787, column 37) - _lhsOmoduleDecl = - mzero - -- use rule "Transform.ag"(line 597, column 37) - _lhsOparamsCollect = - Map.empty - -- use rule "Transform.ag"(line 537, column 56) - _lhsOsemPragmasCollect = - Map.empty - -- use rule "Transform.ag"(line 380, column 32) - _lhsOtypeSyns = - [] - -- use rule "Transform.ag"(line 126, column 15) - _lhsOuseMap = - Map.empty - -- use rule "Transform.ag"(line 492, column 32) - _lhsOwrappers = - Set.empty - -- copy rule (chain) - _lhsOattrDecls = - _lhsIattrDecls - -- copy rule (chain) - _lhsOdefSets = - _lhsIdefSets - in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) -sem_Elem_Sem :: Pos -> - ClassContext -> - T_NontSet -> - T_Attrs -> - T_SemAlts -> - T_Elem -sem_Elem_Sem pos_ ctx_ (T_NontSet names_) (T_Attrs attrs_) (T_SemAlts alts_) = - (T_Elem (\ _lhsIallAttrDecls - _lhsIallConstructors - _lhsIallFields - _lhsIallNonterminals - _lhsIattrDecls - _lhsIdefSets - _lhsIdefinedSets -> - (let _altsOnts :: (Set NontermIdent) - _lhsOctxCollect :: ContextMap - _attrsOnts :: (Set NontermIdent) - _lhsOattrOrderCollect :: AttrOrderMap - _lhsOblocks :: Blocks - _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _lhsOcollectedNames :: (Set Identifier) - _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) - _lhsOcollectedSetNames :: (Set Identifier) - _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) - _lhsOderivings :: Derivings - _lhsOerrors :: (Seq Error) - _lhsOmoduleDecl :: (Maybe (String,String,String)) - _lhsOparamsCollect :: ParamMap - _lhsOpragmas :: (Options -> Options) - _lhsOsemPragmasCollect :: PragmaMap - _lhsOtypeSyns :: TypeSyns - _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) - _lhsOwrappers :: (Set NontermIdent) - _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) - _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) - _namesOallFields :: DataTypes - _namesOallNonterminals :: (Set NontermIdent) - _namesOdefinedSets :: DefinedSets - _attrsOallFields :: DataTypes - _attrsOallNonterminals :: (Set NontermIdent) - _attrsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) - _altsOallAttrDecls :: (Map NontermIdent (Attributes, Attributes)) - _altsOallFields :: DataTypes - _namesIcollectedNames :: (Set Identifier) - _namesIerrors :: (Seq Error) - _namesInontSet :: (Set NontermIdent) - _attrsIattrDecls :: (Map NontermIdent (Attributes, Attributes)) - _attrsIerrors :: (Seq Error) - _attrsIuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) - _altsIattrOrderCollect :: AttrOrderMap - _altsIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _altsIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) - _altsIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) - _altsIerrors :: (Seq Error) - _altsIsemPragmasCollect :: PragmaMap - -- "Transform.ag"(line 152, column 10) - _altsOnts = - _namesInontSet - -- "Transform.ag"(line 624, column 7) - _lhsOctxCollect = - if null ctx_ - then Map.empty - else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet] - -- "Transform.ag"(line 669, column 10) - _attrsOnts = - _namesInontSet - -- use rule "Transform.ag"(line 565, column 55) - _lhsOattrOrderCollect = - _altsIattrOrderCollect - -- use rule "Transform.ag"(line 38, column 19) - _lhsOblocks = - Map.empty - -- use rule "Transform.ag"(line 83, column 48) - _lhsOcollectedConstructorsMap = - Map.empty - -- use rule "Transform.ag"(line 114, column 28) - _lhsOcollectedFields = - [] - -- use rule "Transform.ag"(line 138, column 29) - _lhsOcollectedInsts = - _altsIcollectedInsts - -- use rule "Transform.ag"(line 75, column 50) - _lhsOcollectedNames = - _namesIcollectedNames - -- use rule "Transform.ag"(line 136, column 29) - _lhsOcollectedRules = - _altsIcollectedRules - -- use rule "Transform.ag"(line 74, column 50) - _lhsOcollectedSetNames = - Set.empty - -- use rule "Transform.ag"(line 137, column 29) - _lhsOcollectedSigs = - _altsIcollectedSigs - -- use rule "Transform.ag"(line 645, column 33) - _lhsOderivings = - Map.empty - -- use rule "Transform.ag"(line 36, column 19) - _lhsOerrors = - _namesIerrors Seq.<> _attrsIerrors Seq.<> _altsIerrors - -- use rule "Transform.ag"(line 787, column 37) - _lhsOmoduleDecl = - mzero - -- use rule "Transform.ag"(line 597, column 37) - _lhsOparamsCollect = - Map.empty - -- use rule "Transform.ag"(line 501, column 34) - _lhsOpragmas = - id - -- use rule "Transform.ag"(line 537, column 56) - _lhsOsemPragmasCollect = - _altsIsemPragmasCollect - -- use rule "Transform.ag"(line 380, column 32) - _lhsOtypeSyns = - [] - -- use rule "Transform.ag"(line 126, column 15) - _lhsOuseMap = - _attrsIuseMap - -- use rule "Transform.ag"(line 492, column 32) - _lhsOwrappers = - Set.empty - -- copy rule (up) - _lhsOattrDecls = - _attrsIattrDecls - -- copy rule (chain) - _lhsOdefSets = - _lhsIdefSets - -- copy rule (down) - _namesOallFields = - _lhsIallFields - -- copy rule (down) - _namesOallNonterminals = - _lhsIallNonterminals - -- copy rule (down) - _namesOdefinedSets = - _lhsIdefinedSets - -- copy rule (down) - _attrsOallFields = - _lhsIallFields - -- copy rule (down) - _attrsOallNonterminals = - _lhsIallNonterminals - -- copy rule (down) - _attrsOattrDecls = - _lhsIattrDecls - -- copy rule (down) - _altsOallAttrDecls = - _lhsIallAttrDecls - -- copy rule (down) - _altsOallFields = - _lhsIallFields - ( _namesIcollectedNames,_namesIerrors,_namesInontSet) = - (names_ _namesOallFields _namesOallNonterminals _namesOdefinedSets) - ( _attrsIattrDecls,_attrsIerrors,_attrsIuseMap) = - (attrs_ _attrsOallFields _attrsOallNonterminals _attrsOattrDecls _attrsOnts) - ( _altsIattrOrderCollect,_altsIcollectedInsts,_altsIcollectedRules,_altsIcollectedSigs,_altsIerrors,_altsIsemPragmasCollect) = - (alts_ _altsOallAttrDecls _altsOallFields _altsOnts) - in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) -sem_Elem_Set :: Pos -> - NontermIdent -> - T_NontSet -> - T_Elem -sem_Elem_Set pos_ name_ (T_NontSet set_) = - (T_Elem (\ _lhsIallAttrDecls - _lhsIallConstructors - _lhsIallFields - _lhsIallNonterminals - _lhsIattrDecls - _lhsIdefSets - _lhsIdefinedSets -> - (let _lhsOcollectedSetNames :: (Set Identifier) - _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) - _lhsOerrors :: (Seq Error) - _lhsOattrOrderCollect :: AttrOrderMap - _lhsOblocks :: Blocks - _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _lhsOcollectedNames :: (Set Identifier) - _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) - _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) - _lhsOctxCollect :: ContextMap - _lhsOderivings :: Derivings - _lhsOmoduleDecl :: (Maybe (String,String,String)) - _lhsOparamsCollect :: ParamMap - _lhsOpragmas :: (Options -> Options) - _lhsOsemPragmasCollect :: PragmaMap - _lhsOtypeSyns :: TypeSyns - _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) - _lhsOwrappers :: (Set NontermIdent) - _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) - _setOallFields :: DataTypes - _setOallNonterminals :: (Set NontermIdent) - _setOdefinedSets :: DefinedSets - _setIcollectedNames :: (Set Identifier) - _setIerrors :: (Seq Error) - _setInontSet :: (Set NontermIdent) - -- "Transform.ag"(line 336, column 10) - _lhsOcollectedSetNames = - Set.singleton name_ - -- "Transform.ag"(line 424, column 13) - __tup3 = - let allUsedNames = Set.unions [ maybe (Set.singleton n) - snd - (Map.lookup n _lhsIdefSets) - | n <- Set.toList _setIcollectedNames - ] - (nontSet,e1) | Set.member name_ allUsedNames - = (Set.empty, Seq.single(CyclicSet name_)) - | otherwise = (_setInontSet, Seq.empty) - (res, e2) = checkDuplicate DupSet name_ (nontSet,Set.insert name_ allUsedNames) _lhsIdefSets - in (res, e1 Seq.<> e2) - -- "Transform.ag"(line 424, column 13) - (_defSets2,_) = - __tup3 - -- "Transform.ag"(line 424, column 13) - (_,_errs) = - __tup3 - -- "Transform.ag"(line 434, column 9) - _lhsOdefSets = - _defSets2 - -- "Transform.ag"(line 434, column 9) - _lhsOerrors = - _errs <> _setIerrors - -- use rule "Transform.ag"(line 565, column 55) - _lhsOattrOrderCollect = - Map.empty - -- use rule "Transform.ag"(line 38, column 19) - _lhsOblocks = - Map.empty - -- use rule "Transform.ag"(line 83, column 48) - _lhsOcollectedConstructorsMap = - Map.empty - -- use rule "Transform.ag"(line 114, column 28) - _lhsOcollectedFields = - [] - -- use rule "Transform.ag"(line 138, column 29) - _lhsOcollectedInsts = - [] - -- use rule "Transform.ag"(line 75, column 50) - _lhsOcollectedNames = - _setIcollectedNames - -- use rule "Transform.ag"(line 136, column 29) - _lhsOcollectedRules = - [] - -- use rule "Transform.ag"(line 137, column 29) - _lhsOcollectedSigs = - [] - -- use rule "Transform.ag"(line 620, column 34) - _lhsOctxCollect = - Map.empty - -- use rule "Transform.ag"(line 645, column 33) - _lhsOderivings = - Map.empty - -- use rule "Transform.ag"(line 787, column 37) - _lhsOmoduleDecl = - mzero - -- use rule "Transform.ag"(line 597, column 37) - _lhsOparamsCollect = - Map.empty - -- use rule "Transform.ag"(line 501, column 34) - _lhsOpragmas = - id - -- use rule "Transform.ag"(line 537, column 56) - _lhsOsemPragmasCollect = - Map.empty - -- use rule "Transform.ag"(line 380, column 32) - _lhsOtypeSyns = - [] - -- use rule "Transform.ag"(line 126, column 15) - _lhsOuseMap = - Map.empty - -- use rule "Transform.ag"(line 492, column 32) - _lhsOwrappers = - Set.empty - -- copy rule (chain) - _lhsOattrDecls = - _lhsIattrDecls - -- copy rule (down) - _setOallFields = - _lhsIallFields - -- copy rule (down) - _setOallNonterminals = - _lhsIallNonterminals - -- copy rule (down) - _setOdefinedSets = - _lhsIdefinedSets - ( _setIcollectedNames,_setIerrors,_setInontSet) = - (set_ _setOallFields _setOallNonterminals _setOdefinedSets) - in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) -sem_Elem_Txt :: Pos -> - NontermIdent -> - ([String]) -> - T_Elem -sem_Elem_Txt pos_ name_ lines_ = - (T_Elem (\ _lhsIallAttrDecls - _lhsIallConstructors - _lhsIallFields - _lhsIallNonterminals - _lhsIattrDecls - _lhsIdefSets - _lhsIdefinedSets -> - (let _lhsOblocks :: Blocks - _lhsOattrOrderCollect :: AttrOrderMap - _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _lhsOcollectedNames :: (Set Identifier) - _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) - _lhsOcollectedSetNames :: (Set Identifier) - _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) - _lhsOctxCollect :: ContextMap - _lhsOderivings :: Derivings - _lhsOerrors :: (Seq Error) - _lhsOmoduleDecl :: (Maybe (String,String,String)) - _lhsOparamsCollect :: ParamMap - _lhsOpragmas :: (Options -> Options) - _lhsOsemPragmasCollect :: PragmaMap - _lhsOtypeSyns :: TypeSyns - _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) - _lhsOwrappers :: (Set NontermIdent) - _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) - _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) - -- "Transform.ag"(line 161, column 11) - _lhsOblocks = - Map.singleton (getName name_) [(lines_, pos_)] - -- use rule "Transform.ag"(line 565, column 55) - _lhsOattrOrderCollect = - Map.empty - -- use rule "Transform.ag"(line 83, column 48) - _lhsOcollectedConstructorsMap = - Map.empty - -- use rule "Transform.ag"(line 114, column 28) - _lhsOcollectedFields = - [] - -- use rule "Transform.ag"(line 138, column 29) - _lhsOcollectedInsts = - [] - -- use rule "Transform.ag"(line 75, column 50) - _lhsOcollectedNames = - Set.empty - -- use rule "Transform.ag"(line 136, column 29) - _lhsOcollectedRules = - [] - -- use rule "Transform.ag"(line 74, column 50) - _lhsOcollectedSetNames = - Set.empty - -- use rule "Transform.ag"(line 137, column 29) - _lhsOcollectedSigs = - [] - -- use rule "Transform.ag"(line 620, column 34) - _lhsOctxCollect = - Map.empty - -- use rule "Transform.ag"(line 645, column 33) - _lhsOderivings = - Map.empty - -- use rule "Transform.ag"(line 36, column 19) - _lhsOerrors = - Seq.empty - -- use rule "Transform.ag"(line 787, column 37) - _lhsOmoduleDecl = - mzero - -- use rule "Transform.ag"(line 597, column 37) - _lhsOparamsCollect = - Map.empty - -- use rule "Transform.ag"(line 501, column 34) - _lhsOpragmas = - id - -- use rule "Transform.ag"(line 537, column 56) - _lhsOsemPragmasCollect = - Map.empty - -- use rule "Transform.ag"(line 380, column 32) - _lhsOtypeSyns = - [] - -- use rule "Transform.ag"(line 126, column 15) - _lhsOuseMap = - Map.empty - -- use rule "Transform.ag"(line 492, column 32) - _lhsOwrappers = - Set.empty - -- copy rule (chain) - _lhsOattrDecls = - _lhsIattrDecls - -- copy rule (chain) - _lhsOdefSets = - _lhsIdefSets - in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) -sem_Elem_Type :: Pos -> - ClassContext -> - NontermIdent -> - ([Identifier]) -> - ComplexType -> - T_Elem -sem_Elem_Type pos_ ctx_ name_ params_ type_ = - (T_Elem (\ _lhsIallAttrDecls - _lhsIallConstructors - _lhsIallFields - _lhsIallNonterminals - _lhsIattrDecls - _lhsIdefSets - _lhsIdefinedSets -> - (let _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _lhsOcollectedNames :: (Set Identifier) - _lhsOtypeSyns :: TypeSyns - _lhsOparamsCollect :: ParamMap - _lhsOctxCollect :: ContextMap - _lhsOattrOrderCollect :: AttrOrderMap - _lhsOblocks :: Blocks - _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) - _lhsOcollectedSetNames :: (Set Identifier) - _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) - _lhsOderivings :: Derivings - _lhsOerrors :: (Seq Error) - _lhsOmoduleDecl :: (Maybe (String,String,String)) - _lhsOpragmas :: (Options -> Options) - _lhsOsemPragmasCollect :: PragmaMap - _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) - _lhsOwrappers :: (Set NontermIdent) - _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) - _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) - -- "Transform.ag"(line 214, column 10) - _lhsOcollectedFields = - map (\(x,y)->(name_, x, y)) _expanded - -- "Transform.ag"(line 339, column 11) - _lhsOcollectedNames = - Set.singleton name_ - -- "Transform.ag"(line 393, column 11) - _expanded = - case _argType of - List tp -> [(Ident "Cons" pos_, [(Ident "hd" pos_, tp) - ,(Ident "tl" pos_, NT name_ (map getName params_)) - ] - ) - ,(Ident "Nil" pos_, []) - ] - Maybe tp -> [(Ident "Just" pos_, [(Ident "just" pos_, tp) - ] - ) - ,(Ident "Nothing" pos_, []) - ] - Tuple xs -> [(Ident "Tuple" pos_, xs)] - -- "Transform.ag"(line 406, column 11) - _argType = - case type_ of - Maybe tp -> Maybe ( makeType _lhsIallNonterminals tp) - List tp -> List ( makeType _lhsIallNonterminals tp) - Tuple xs -> Tuple [(f,makeType _lhsIallNonterminals tp) | (f,tp) <- xs] - -- "Transform.ag"(line 410, column 11) - _lhsOtypeSyns = - [(name_,_argType)] - -- "Transform.ag"(line 607, column 7) - _lhsOparamsCollect = - if null params_ - then Map.empty - else Map.singleton name_ params_ - -- "Transform.ag"(line 630, column 7) - _lhsOctxCollect = - if null ctx_ - then Map.empty - else Map.singleton name_ ctx_ - -- use rule "Transform.ag"(line 565, column 55) - _lhsOattrOrderCollect = - Map.empty - -- use rule "Transform.ag"(line 38, column 19) - _lhsOblocks = - Map.empty - -- use rule "Transform.ag"(line 83, column 48) - _lhsOcollectedConstructorsMap = - Map.empty - -- use rule "Transform.ag"(line 138, column 29) - _lhsOcollectedInsts = - [] - -- use rule "Transform.ag"(line 136, column 29) - _lhsOcollectedRules = - [] - -- use rule "Transform.ag"(line 74, column 50) - _lhsOcollectedSetNames = - Set.empty - -- use rule "Transform.ag"(line 137, column 29) - _lhsOcollectedSigs = - [] - -- use rule "Transform.ag"(line 645, column 33) - _lhsOderivings = - Map.empty - -- use rule "Transform.ag"(line 36, column 19) - _lhsOerrors = - Seq.empty - -- use rule "Transform.ag"(line 787, column 37) - _lhsOmoduleDecl = - mzero - -- use rule "Transform.ag"(line 501, column 34) - _lhsOpragmas = - id - -- use rule "Transform.ag"(line 537, column 56) - _lhsOsemPragmasCollect = - Map.empty - -- use rule "Transform.ag"(line 126, column 15) - _lhsOuseMap = - Map.empty - -- use rule "Transform.ag"(line 492, column 32) - _lhsOwrappers = - Set.empty - -- copy rule (chain) - _lhsOattrDecls = - _lhsIattrDecls - -- copy rule (chain) - _lhsOdefSets = - _lhsIdefSets - in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) -sem_Elem_Wrapper :: Pos -> - T_NontSet -> - T_Elem -sem_Elem_Wrapper pos_ (T_NontSet set_) = - (T_Elem (\ _lhsIallAttrDecls - _lhsIallConstructors - _lhsIallFields - _lhsIallNonterminals - _lhsIattrDecls - _lhsIdefSets - _lhsIdefinedSets -> - (let _lhsOwrappers :: (Set NontermIdent) - _lhsOattrOrderCollect :: AttrOrderMap - _lhsOblocks :: Blocks - _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _lhsOcollectedNames :: (Set Identifier) - _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) - _lhsOcollectedSetNames :: (Set Identifier) - _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) - _lhsOctxCollect :: ContextMap - _lhsOderivings :: Derivings - _lhsOerrors :: (Seq Error) - _lhsOmoduleDecl :: (Maybe (String,String,String)) - _lhsOparamsCollect :: ParamMap - _lhsOpragmas :: (Options -> Options) - _lhsOsemPragmasCollect :: PragmaMap - _lhsOtypeSyns :: TypeSyns - _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) - _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) - _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) - _setOallFields :: DataTypes - _setOallNonterminals :: (Set NontermIdent) - _setOdefinedSets :: DefinedSets - _setIcollectedNames :: (Set Identifier) - _setIerrors :: (Seq Error) - _setInontSet :: (Set NontermIdent) - -- "Transform.ag"(line 495, column 13) - _lhsOwrappers = - _setInontSet - -- use rule "Transform.ag"(line 565, column 55) - _lhsOattrOrderCollect = - Map.empty - -- use rule "Transform.ag"(line 38, column 19) - _lhsOblocks = - Map.empty - -- use rule "Transform.ag"(line 83, column 48) - _lhsOcollectedConstructorsMap = - Map.empty - -- use rule "Transform.ag"(line 114, column 28) - _lhsOcollectedFields = - [] - -- use rule "Transform.ag"(line 138, column 29) - _lhsOcollectedInsts = - [] - -- use rule "Transform.ag"(line 75, column 50) - _lhsOcollectedNames = - _setIcollectedNames - -- use rule "Transform.ag"(line 136, column 29) - _lhsOcollectedRules = - [] - -- use rule "Transform.ag"(line 74, column 50) - _lhsOcollectedSetNames = - Set.empty - -- use rule "Transform.ag"(line 137, column 29) - _lhsOcollectedSigs = - [] - -- use rule "Transform.ag"(line 620, column 34) - _lhsOctxCollect = - Map.empty - -- use rule "Transform.ag"(line 645, column 33) - _lhsOderivings = - Map.empty - -- use rule "Transform.ag"(line 36, column 19) - _lhsOerrors = - _setIerrors - -- use rule "Transform.ag"(line 787, column 37) - _lhsOmoduleDecl = - mzero - -- use rule "Transform.ag"(line 597, column 37) - _lhsOparamsCollect = - Map.empty - -- use rule "Transform.ag"(line 501, column 34) - _lhsOpragmas = - id - -- use rule "Transform.ag"(line 537, column 56) - _lhsOsemPragmasCollect = - Map.empty - -- use rule "Transform.ag"(line 380, column 32) - _lhsOtypeSyns = - [] - -- use rule "Transform.ag"(line 126, column 15) - _lhsOuseMap = - Map.empty - -- copy rule (chain) - _lhsOattrDecls = - _lhsIattrDecls - -- copy rule (chain) - _lhsOdefSets = - _lhsIdefSets - -- copy rule (down) - _setOallFields = - _lhsIallFields - -- copy rule (down) - _setOallNonterminals = - _lhsIallNonterminals - -- copy rule (down) - _setOdefinedSets = - _lhsIdefinedSets - ( _setIcollectedNames,_setIerrors,_setInontSet) = - (set_ _setOallFields _setOallNonterminals _setOdefinedSets) - in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) --- Elems ------------------------------------------------------- -{- - visit 0: - inherited attributes: - allAttrDecls : Map NontermIdent (Attributes, Attributes) - allConstructors : Map NontermIdent (Set ConstructorIdent) - allFields : DataTypes - allNonterminals : Set NontermIdent - definedSets : DefinedSets - chained attributes: - attrDecls : Map NontermIdent (Attributes, Attributes) - defSets : Map Identifier (Set NontermIdent,Set Identifier) - synthesized attributes: - attrOrderCollect : AttrOrderMap - blocks : Blocks - collectedConstructorsMap : Map NontermIdent (Set ConstructorIdent) - collectedFields : [(NontermIdent, ConstructorIdent, FieldMap)] - collectedInsts : [ (NontermIdent, ConstructorIdent, [Identifier]) ] - collectedNames : Set Identifier - collectedRules : [ (NontermIdent, ConstructorIdent, RuleInfo)] - collectedSetNames : Set Identifier - collectedSigs : [ (NontermIdent, ConstructorIdent, SigInfo) ] - ctxCollect : ContextMap - derivings : Derivings - errors : Seq Error - moduleDecl : Maybe (String,String,String) - paramsCollect : ParamMap - pragmas : Options -> Options - semPragmasCollect : PragmaMap - typeSyns : TypeSyns - useMap : Map NontermIdent (Map Identifier (String,String,String)) - wrappers : Set NontermIdent - alternatives: - alternative Cons: - child hd : Elem - child tl : Elems - alternative Nil: --} --- cata -sem_Elems :: Elems -> - T_Elems -sem_Elems list = - (Prelude.foldr sem_Elems_Cons sem_Elems_Nil (Prelude.map sem_Elem list)) --- semantic domain -newtype T_Elems = T_Elems ((Map NontermIdent (Attributes, Attributes)) -> - (Map NontermIdent (Set ConstructorIdent)) -> - DataTypes -> - (Set NontermIdent) -> - (Map NontermIdent (Attributes, Attributes)) -> - (Map Identifier (Set NontermIdent,Set Identifier)) -> - DefinedSets -> - ( (Map NontermIdent (Attributes, Attributes)),AttrOrderMap,Blocks,(Map NontermIdent (Set ConstructorIdent)),([(NontermIdent, ConstructorIdent, FieldMap)]),([ (NontermIdent, ConstructorIdent, [Identifier]) ]),(Set Identifier),([ (NontermIdent, ConstructorIdent, RuleInfo)]),(Set Identifier),([ (NontermIdent, ConstructorIdent, SigInfo) ]),ContextMap,(Map Identifier (Set NontermIdent,Set Identifier)),Derivings,(Seq Error),(Maybe (String,String,String)),ParamMap,(Options -> Options),PragmaMap,TypeSyns,(Map NontermIdent (Map Identifier (String,String,String))),(Set NontermIdent))) -data Inh_Elems = Inh_Elems {allAttrDecls_Inh_Elems :: Map NontermIdent (Attributes, Attributes),allConstructors_Inh_Elems :: Map NontermIdent (Set ConstructorIdent),allFields_Inh_Elems :: DataTypes,allNonterminals_Inh_Elems :: Set NontermIdent,attrDecls_Inh_Elems :: Map NontermIdent (Attributes, Attributes),defSets_Inh_Elems :: Map Identifier (Set NontermIdent,Set Identifier),definedSets_Inh_Elems :: DefinedSets} -data Syn_Elems = Syn_Elems {attrDecls_Syn_Elems :: Map NontermIdent (Attributes, Attributes),attrOrderCollect_Syn_Elems :: AttrOrderMap,blocks_Syn_Elems :: Blocks,collectedConstructorsMap_Syn_Elems :: Map NontermIdent (Set ConstructorIdent),collectedFields_Syn_Elems :: [(NontermIdent, ConstructorIdent, FieldMap)],collectedInsts_Syn_Elems :: [ (NontermIdent, ConstructorIdent, [Identifier]) ],collectedNames_Syn_Elems :: Set Identifier,collectedRules_Syn_Elems :: [ (NontermIdent, ConstructorIdent, RuleInfo)],collectedSetNames_Syn_Elems :: Set Identifier,collectedSigs_Syn_Elems :: [ (NontermIdent, ConstructorIdent, SigInfo) ],ctxCollect_Syn_Elems :: ContextMap,defSets_Syn_Elems :: Map Identifier (Set NontermIdent,Set Identifier),derivings_Syn_Elems :: Derivings,errors_Syn_Elems :: Seq Error,moduleDecl_Syn_Elems :: Maybe (String,String,String),paramsCollect_Syn_Elems :: ParamMap,pragmas_Syn_Elems :: Options -> Options,semPragmasCollect_Syn_Elems :: PragmaMap,typeSyns_Syn_Elems :: TypeSyns,useMap_Syn_Elems :: Map NontermIdent (Map Identifier (String,String,String)),wrappers_Syn_Elems :: Set NontermIdent} -wrap_Elems (T_Elems sem) (Inh_Elems _lhsIallAttrDecls _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIdefSets _lhsIdefinedSets) = - (let ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers) = - (sem _lhsIallAttrDecls _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIdefSets _lhsIdefinedSets) - in (Syn_Elems _lhsOattrDecls _lhsOattrOrderCollect _lhsOblocks _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOctxCollect _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOparamsCollect _lhsOpragmas _lhsOsemPragmasCollect _lhsOtypeSyns _lhsOuseMap _lhsOwrappers)) -sem_Elems_Cons :: T_Elem -> - T_Elems -> - T_Elems -sem_Elems_Cons (T_Elem hd_) (T_Elems tl_) = - (T_Elems (\ _lhsIallAttrDecls - _lhsIallConstructors - _lhsIallFields - _lhsIallNonterminals - _lhsIattrDecls - _lhsIdefSets - _lhsIdefinedSets -> - (let _lhsOattrOrderCollect :: AttrOrderMap - _lhsOblocks :: Blocks - _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _lhsOcollectedNames :: (Set Identifier) - _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) - _lhsOcollectedSetNames :: (Set Identifier) - _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) - _lhsOctxCollect :: ContextMap - _lhsOderivings :: Derivings - _lhsOerrors :: (Seq Error) - _lhsOmoduleDecl :: (Maybe (String,String,String)) - _lhsOparamsCollect :: ParamMap - _lhsOpragmas :: (Options -> Options) - _lhsOsemPragmasCollect :: PragmaMap - _lhsOtypeSyns :: TypeSyns - _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) - _lhsOwrappers :: (Set NontermIdent) - _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) - _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) - _hdOallAttrDecls :: (Map NontermIdent (Attributes, Attributes)) - _hdOallConstructors :: (Map NontermIdent (Set ConstructorIdent)) - _hdOallFields :: DataTypes - _hdOallNonterminals :: (Set NontermIdent) - _hdOattrDecls :: (Map NontermIdent (Attributes, Attributes)) - _hdOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) - _hdOdefinedSets :: DefinedSets - _tlOallAttrDecls :: (Map NontermIdent (Attributes, Attributes)) - _tlOallConstructors :: (Map NontermIdent (Set ConstructorIdent)) - _tlOallFields :: DataTypes - _tlOallNonterminals :: (Set NontermIdent) - _tlOattrDecls :: (Map NontermIdent (Attributes, Attributes)) - _tlOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) - _tlOdefinedSets :: DefinedSets - _hdIattrDecls :: (Map NontermIdent (Attributes, Attributes)) - _hdIattrOrderCollect :: AttrOrderMap - _hdIblocks :: Blocks - _hdIcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _hdIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _hdIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _hdIcollectedNames :: (Set Identifier) - _hdIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) - _hdIcollectedSetNames :: (Set Identifier) - _hdIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) - _hdIctxCollect :: ContextMap - _hdIdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) - _hdIderivings :: Derivings - _hdIerrors :: (Seq Error) - _hdImoduleDecl :: (Maybe (String,String,String)) - _hdIparamsCollect :: ParamMap - _hdIpragmas :: (Options -> Options) - _hdIsemPragmasCollect :: PragmaMap - _hdItypeSyns :: TypeSyns - _hdIuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) - _hdIwrappers :: (Set NontermIdent) - _tlIattrDecls :: (Map NontermIdent (Attributes, Attributes)) - _tlIattrOrderCollect :: AttrOrderMap - _tlIblocks :: Blocks - _tlIcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _tlIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _tlIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _tlIcollectedNames :: (Set Identifier) - _tlIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) - _tlIcollectedSetNames :: (Set Identifier) - _tlIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) - _tlIctxCollect :: ContextMap - _tlIdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) - _tlIderivings :: Derivings - _tlIerrors :: (Seq Error) - _tlImoduleDecl :: (Maybe (String,String,String)) - _tlIparamsCollect :: ParamMap - _tlIpragmas :: (Options -> Options) - _tlIsemPragmasCollect :: PragmaMap - _tlItypeSyns :: TypeSyns - _tlIuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) - _tlIwrappers :: (Set NontermIdent) - -- use rule "Transform.ag"(line 565, column 55) - _lhsOattrOrderCollect = - _hdIattrOrderCollect `orderMapUnion` _tlIattrOrderCollect - -- use rule "Transform.ag"(line 38, column 19) - _lhsOblocks = - _hdIblocks `mapUnionWithPlusPlus` _tlIblocks - -- use rule "Transform.ag"(line 83, column 48) - _lhsOcollectedConstructorsMap = - _hdIcollectedConstructorsMap `mapUnionWithSetUnion` _tlIcollectedConstructorsMap - -- use rule "Transform.ag"(line 114, column 28) - _lhsOcollectedFields = - _hdIcollectedFields ++ _tlIcollectedFields - -- use rule "Transform.ag"(line 138, column 29) - _lhsOcollectedInsts = - _hdIcollectedInsts ++ _tlIcollectedInsts - -- use rule "Transform.ag"(line 75, column 50) - _lhsOcollectedNames = - _hdIcollectedNames `Set.union` _tlIcollectedNames - -- use rule "Transform.ag"(line 136, column 29) - _lhsOcollectedRules = - _hdIcollectedRules ++ _tlIcollectedRules - -- use rule "Transform.ag"(line 74, column 50) - _lhsOcollectedSetNames = - _hdIcollectedSetNames `Set.union` _tlIcollectedSetNames - -- use rule "Transform.ag"(line 137, column 29) - _lhsOcollectedSigs = - _hdIcollectedSigs ++ _tlIcollectedSigs - -- use rule "Transform.ag"(line 620, column 34) - _lhsOctxCollect = - _hdIctxCollect `mergeCtx` _tlIctxCollect - -- use rule "Transform.ag"(line 645, column 33) - _lhsOderivings = - _hdIderivings `mergeDerivings` _tlIderivings - -- use rule "Transform.ag"(line 36, column 19) - _lhsOerrors = - _hdIerrors Seq.<> _tlIerrors - -- use rule "Transform.ag"(line 787, column 37) - _lhsOmoduleDecl = - _hdImoduleDecl `mplus` _tlImoduleDecl - -- use rule "Transform.ag"(line 597, column 37) - _lhsOparamsCollect = - _hdIparamsCollect `mergeParams` _tlIparamsCollect - -- use rule "Transform.ag"(line 501, column 34) - _lhsOpragmas = - _hdIpragmas . _tlIpragmas - -- use rule "Transform.ag"(line 537, column 56) - _lhsOsemPragmasCollect = - _hdIsemPragmasCollect `pragmaMapUnion` _tlIsemPragmasCollect - -- use rule "Transform.ag"(line 380, column 32) - _lhsOtypeSyns = - _hdItypeSyns ++ _tlItypeSyns - -- use rule "Transform.ag"(line 126, column 15) - _lhsOuseMap = - _hdIuseMap `merge` _tlIuseMap - -- use rule "Transform.ag"(line 492, column 32) - _lhsOwrappers = - _hdIwrappers `Set.union` _tlIwrappers - -- copy rule (up) - _lhsOattrDecls = - _tlIattrDecls - -- copy rule (up) - _lhsOdefSets = - _tlIdefSets - -- copy rule (down) - _hdOallAttrDecls = - _lhsIallAttrDecls - -- copy rule (down) - _hdOallConstructors = - _lhsIallConstructors - -- copy rule (down) - _hdOallFields = - _lhsIallFields - -- copy rule (down) - _hdOallNonterminals = - _lhsIallNonterminals - -- copy rule (down) - _hdOattrDecls = - _lhsIattrDecls - -- copy rule (down) - _hdOdefSets = - _lhsIdefSets - -- copy rule (down) - _hdOdefinedSets = - _lhsIdefinedSets - -- copy rule (down) - _tlOallAttrDecls = - _lhsIallAttrDecls - -- copy rule (down) - _tlOallConstructors = - _lhsIallConstructors - -- copy rule (down) - _tlOallFields = - _lhsIallFields - -- copy rule (down) - _tlOallNonterminals = - _lhsIallNonterminals - -- copy rule (chain) - _tlOattrDecls = - _hdIattrDecls - -- copy rule (chain) - _tlOdefSets = - _hdIdefSets - -- copy rule (down) - _tlOdefinedSets = - _lhsIdefinedSets - ( _hdIattrDecls,_hdIattrOrderCollect,_hdIblocks,_hdIcollectedConstructorsMap,_hdIcollectedFields,_hdIcollectedInsts,_hdIcollectedNames,_hdIcollectedRules,_hdIcollectedSetNames,_hdIcollectedSigs,_hdIctxCollect,_hdIdefSets,_hdIderivings,_hdIerrors,_hdImoduleDecl,_hdIparamsCollect,_hdIpragmas,_hdIsemPragmasCollect,_hdItypeSyns,_hdIuseMap,_hdIwrappers) = - (hd_ _hdOallAttrDecls _hdOallConstructors _hdOallFields _hdOallNonterminals _hdOattrDecls _hdOdefSets _hdOdefinedSets) - ( _tlIattrDecls,_tlIattrOrderCollect,_tlIblocks,_tlIcollectedConstructorsMap,_tlIcollectedFields,_tlIcollectedInsts,_tlIcollectedNames,_tlIcollectedRules,_tlIcollectedSetNames,_tlIcollectedSigs,_tlIctxCollect,_tlIdefSets,_tlIderivings,_tlIerrors,_tlImoduleDecl,_tlIparamsCollect,_tlIpragmas,_tlIsemPragmasCollect,_tlItypeSyns,_tlIuseMap,_tlIwrappers) = - (tl_ _tlOallAttrDecls _tlOallConstructors _tlOallFields _tlOallNonterminals _tlOattrDecls _tlOdefSets _tlOdefinedSets) - in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) -sem_Elems_Nil :: T_Elems -sem_Elems_Nil = - (T_Elems (\ _lhsIallAttrDecls - _lhsIallConstructors - _lhsIallFields - _lhsIallNonterminals - _lhsIattrDecls - _lhsIdefSets - _lhsIdefinedSets -> - (let _lhsOattrOrderCollect :: AttrOrderMap - _lhsOblocks :: Blocks - _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _lhsOcollectedNames :: (Set Identifier) - _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) - _lhsOcollectedSetNames :: (Set Identifier) - _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) - _lhsOctxCollect :: ContextMap - _lhsOderivings :: Derivings - _lhsOerrors :: (Seq Error) - _lhsOmoduleDecl :: (Maybe (String,String,String)) - _lhsOparamsCollect :: ParamMap - _lhsOpragmas :: (Options -> Options) - _lhsOsemPragmasCollect :: PragmaMap - _lhsOtypeSyns :: TypeSyns - _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) - _lhsOwrappers :: (Set NontermIdent) - _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) - _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) - -- use rule "Transform.ag"(line 565, column 55) - _lhsOattrOrderCollect = - Map.empty - -- use rule "Transform.ag"(line 38, column 19) - _lhsOblocks = - Map.empty - -- use rule "Transform.ag"(line 83, column 48) - _lhsOcollectedConstructorsMap = - Map.empty - -- use rule "Transform.ag"(line 114, column 28) - _lhsOcollectedFields = - [] - -- use rule "Transform.ag"(line 138, column 29) - _lhsOcollectedInsts = - [] - -- use rule "Transform.ag"(line 75, column 50) - _lhsOcollectedNames = - Set.empty - -- use rule "Transform.ag"(line 136, column 29) - _lhsOcollectedRules = - [] - -- use rule "Transform.ag"(line 74, column 50) - _lhsOcollectedSetNames = - Set.empty - -- use rule "Transform.ag"(line 137, column 29) - _lhsOcollectedSigs = - [] - -- use rule "Transform.ag"(line 620, column 34) - _lhsOctxCollect = - Map.empty - -- use rule "Transform.ag"(line 645, column 33) - _lhsOderivings = - Map.empty - -- use rule "Transform.ag"(line 36, column 19) - _lhsOerrors = - Seq.empty - -- use rule "Transform.ag"(line 787, column 37) - _lhsOmoduleDecl = - mzero - -- use rule "Transform.ag"(line 597, column 37) - _lhsOparamsCollect = - Map.empty - -- use rule "Transform.ag"(line 501, column 34) - _lhsOpragmas = - id - -- use rule "Transform.ag"(line 537, column 56) - _lhsOsemPragmasCollect = - Map.empty - -- use rule "Transform.ag"(line 380, column 32) - _lhsOtypeSyns = - [] - -- use rule "Transform.ag"(line 126, column 15) - _lhsOuseMap = - Map.empty - -- use rule "Transform.ag"(line 492, column 32) - _lhsOwrappers = - Set.empty - -- copy rule (chain) - _lhsOattrDecls = - _lhsIattrDecls - -- copy rule (chain) - _lhsOdefSets = - _lhsIdefSets - in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) --- NontSet ----------------------------------------------------- -{- - visit 0: - inherited attributes: - allFields : DataTypes - allNonterminals : Set NontermIdent - definedSets : DefinedSets - synthesized attributes: - collectedNames : Set Identifier - errors : Seq Error - nontSet : Set NontermIdent - alternatives: - alternative All: - alternative Difference: - child set1 : NontSet - child set2 : NontSet - alternative Intersect: - child set1 : NontSet - child set2 : NontSet - alternative NamedSet: - child name : {NontermIdent} - visit 0: - local _tup4 : _ - local nontSet : _ - local errors : _ - alternative Path: - child from : {NontermIdent} - child to : {NontermIdent} - alternative Union: - child set1 : NontSet - child set2 : NontSet --} --- cata -sem_NontSet :: NontSet -> - T_NontSet -sem_NontSet (All ) = - (sem_NontSet_All ) -sem_NontSet (Difference _set1 _set2) = - (sem_NontSet_Difference (sem_NontSet _set1) (sem_NontSet _set2)) -sem_NontSet (Intersect _set1 _set2) = - (sem_NontSet_Intersect (sem_NontSet _set1) (sem_NontSet _set2)) -sem_NontSet (NamedSet _name) = - (sem_NontSet_NamedSet _name) -sem_NontSet (Path _from _to) = - (sem_NontSet_Path _from _to) -sem_NontSet (Union _set1 _set2) = - (sem_NontSet_Union (sem_NontSet _set1) (sem_NontSet _set2)) --- semantic domain -newtype T_NontSet = T_NontSet (DataTypes -> - (Set NontermIdent) -> - DefinedSets -> - ( (Set Identifier),(Seq Error),(Set NontermIdent))) -data Inh_NontSet = Inh_NontSet {allFields_Inh_NontSet :: DataTypes,allNonterminals_Inh_NontSet :: Set NontermIdent,definedSets_Inh_NontSet :: DefinedSets} -data Syn_NontSet = Syn_NontSet {collectedNames_Syn_NontSet :: Set Identifier,errors_Syn_NontSet :: Seq Error,nontSet_Syn_NontSet :: Set NontermIdent} -wrap_NontSet (T_NontSet sem) (Inh_NontSet _lhsIallFields _lhsIallNonterminals _lhsIdefinedSets) = - (let ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet) = - (sem _lhsIallFields _lhsIallNonterminals _lhsIdefinedSets) - in (Syn_NontSet _lhsOcollectedNames _lhsOerrors _lhsOnontSet)) -sem_NontSet_All :: T_NontSet -sem_NontSet_All = - (T_NontSet (\ _lhsIallFields - _lhsIallNonterminals - _lhsIdefinedSets -> - (let _lhsOnontSet :: (Set NontermIdent) - _lhsOcollectedNames :: (Set Identifier) - _lhsOerrors :: (Seq Error) - -- "Transform.ag"(line 438, column 16) - _lhsOnontSet = - _lhsIallNonterminals - -- use rule "Transform.ag"(line 75, column 50) - _lhsOcollectedNames = - Set.empty - -- use rule "Transform.ag"(line 36, column 19) - _lhsOerrors = - Seq.empty - in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet)))) -sem_NontSet_Difference :: T_NontSet -> - T_NontSet -> - T_NontSet -sem_NontSet_Difference (T_NontSet set1_) (T_NontSet set2_) = - (T_NontSet (\ _lhsIallFields - _lhsIallNonterminals - _lhsIdefinedSets -> - (let _lhsOnontSet :: (Set NontermIdent) - _lhsOcollectedNames :: (Set Identifier) - _lhsOerrors :: (Seq Error) - _set1OallFields :: DataTypes - _set1OallNonterminals :: (Set NontermIdent) - _set1OdefinedSets :: DefinedSets - _set2OallFields :: DataTypes - _set2OallNonterminals :: (Set NontermIdent) - _set2OdefinedSets :: DefinedSets - _set1IcollectedNames :: (Set Identifier) - _set1Ierrors :: (Seq Error) - _set1InontSet :: (Set NontermIdent) - _set2IcollectedNames :: (Set Identifier) - _set2Ierrors :: (Seq Error) - _set2InontSet :: (Set NontermIdent) - -- "Transform.ag"(line 444, column 16) - _lhsOnontSet = - Set.difference _set1InontSet _set2InontSet - -- use rule "Transform.ag"(line 75, column 50) - _lhsOcollectedNames = - _set1IcollectedNames `Set.union` _set2IcollectedNames - -- use rule "Transform.ag"(line 36, column 19) - _lhsOerrors = - _set1Ierrors Seq.<> _set2Ierrors - -- copy rule (down) - _set1OallFields = - _lhsIallFields - -- copy rule (down) - _set1OallNonterminals = - _lhsIallNonterminals - -- copy rule (down) - _set1OdefinedSets = - _lhsIdefinedSets - -- copy rule (down) - _set2OallFields = - _lhsIallFields - -- copy rule (down) - _set2OallNonterminals = - _lhsIallNonterminals - -- copy rule (down) - _set2OdefinedSets = - _lhsIdefinedSets - ( _set1IcollectedNames,_set1Ierrors,_set1InontSet) = - (set1_ _set1OallFields _set1OallNonterminals _set1OdefinedSets) - ( _set2IcollectedNames,_set2Ierrors,_set2InontSet) = - (set2_ _set2OallFields _set2OallNonterminals _set2OdefinedSets) - in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet)))) -sem_NontSet_Intersect :: T_NontSet -> - T_NontSet -> - T_NontSet -sem_NontSet_Intersect (T_NontSet set1_) (T_NontSet set2_) = - (T_NontSet (\ _lhsIallFields - _lhsIallNonterminals - _lhsIdefinedSets -> - (let _lhsOnontSet :: (Set NontermIdent) - _lhsOcollectedNames :: (Set Identifier) - _lhsOerrors :: (Seq Error) - _set1OallFields :: DataTypes - _set1OallNonterminals :: (Set NontermIdent) - _set1OdefinedSets :: DefinedSets - _set2OallFields :: DataTypes - _set2OallNonterminals :: (Set NontermIdent) - _set2OdefinedSets :: DefinedSets - _set1IcollectedNames :: (Set Identifier) - _set1Ierrors :: (Seq Error) - _set1InontSet :: (Set NontermIdent) - _set2IcollectedNames :: (Set Identifier) - _set2Ierrors :: (Seq Error) - _set2InontSet :: (Set NontermIdent) - -- "Transform.ag"(line 443, column 16) - _lhsOnontSet = - Set.intersection _set1InontSet _set2InontSet - -- use rule "Transform.ag"(line 75, column 50) - _lhsOcollectedNames = - _set1IcollectedNames `Set.union` _set2IcollectedNames - -- use rule "Transform.ag"(line 36, column 19) - _lhsOerrors = - _set1Ierrors Seq.<> _set2Ierrors - -- copy rule (down) - _set1OallFields = - _lhsIallFields - -- copy rule (down) - _set1OallNonterminals = - _lhsIallNonterminals - -- copy rule (down) - _set1OdefinedSets = - _lhsIdefinedSets - -- copy rule (down) - _set2OallFields = - _lhsIallFields - -- copy rule (down) - _set2OallNonterminals = - _lhsIallNonterminals - -- copy rule (down) - _set2OdefinedSets = - _lhsIdefinedSets - ( _set1IcollectedNames,_set1Ierrors,_set1InontSet) = - (set1_ _set1OallFields _set1OallNonterminals _set1OdefinedSets) - ( _set2IcollectedNames,_set2Ierrors,_set2InontSet) = - (set2_ _set2OallFields _set2OallNonterminals _set2OdefinedSets) - in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet)))) -sem_NontSet_NamedSet :: NontermIdent -> - T_NontSet -sem_NontSet_NamedSet name_ = - (T_NontSet (\ _lhsIallFields - _lhsIallNonterminals - _lhsIdefinedSets -> - (let _lhsOcollectedNames :: (Set Identifier) - _lhsOerrors :: (Seq Error) - _lhsOnontSet :: (Set NontermIdent) - -- "Transform.ag"(line 342, column 14) - _lhsOcollectedNames = - Set.singleton name_ - -- "Transform.ag"(line 439, column 20) - __tup4 = - case Map.lookup name_ _lhsIdefinedSets of - Nothing -> (Set.empty, Seq.single (UndefNont name_)) - Just set -> (set, Seq.empty) - -- "Transform.ag"(line 439, column 20) - (_nontSet,_) = - __tup4 - -- "Transform.ag"(line 439, column 20) - (_,_errors) = - __tup4 - -- use rule "Transform.ag"(line 36, column 19) - _lhsOerrors = - _errors - -- copy rule (from local) - _lhsOnontSet = - _nontSet - in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet)))) -sem_NontSet_Path :: NontermIdent -> - NontermIdent -> - T_NontSet -sem_NontSet_Path from_ to_ = - (T_NontSet (\ _lhsIallFields - _lhsIallNonterminals - _lhsIdefinedSets -> - (let _lhsOnontSet :: (Set NontermIdent) - _lhsOerrors :: (Seq Error) - _lhsOcollectedNames :: (Set Identifier) - -- "Transform.ag"(line 445, column 16) - _lhsOnontSet = - let table = flattenDatas _lhsIallFields - in path table from_ to_ - -- "Transform.ag"(line 447, column 16) - _lhsOerrors = - let check name | Set.member name _lhsIallNonterminals - = Seq.empty - | otherwise = Seq.single (UndefNont name) - in check from_ <> check to_ - -- use rule "Transform.ag"(line 75, column 50) - _lhsOcollectedNames = - Set.empty - in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet)))) -sem_NontSet_Union :: T_NontSet -> - T_NontSet -> - T_NontSet -sem_NontSet_Union (T_NontSet set1_) (T_NontSet set2_) = - (T_NontSet (\ _lhsIallFields - _lhsIallNonterminals - _lhsIdefinedSets -> - (let _lhsOnontSet :: (Set NontermIdent) - _lhsOcollectedNames :: (Set Identifier) - _lhsOerrors :: (Seq Error) - _set1OallFields :: DataTypes - _set1OallNonterminals :: (Set NontermIdent) - _set1OdefinedSets :: DefinedSets - _set2OallFields :: DataTypes - _set2OallNonterminals :: (Set NontermIdent) - _set2OdefinedSets :: DefinedSets - _set1IcollectedNames :: (Set Identifier) - _set1Ierrors :: (Seq Error) - _set1InontSet :: (Set NontermIdent) - _set2IcollectedNames :: (Set Identifier) - _set2Ierrors :: (Seq Error) - _set2InontSet :: (Set NontermIdent) - -- "Transform.ag"(line 442, column 16) - _lhsOnontSet = - Set.union _set1InontSet _set2InontSet - -- use rule "Transform.ag"(line 75, column 50) - _lhsOcollectedNames = - _set1IcollectedNames `Set.union` _set2IcollectedNames - -- use rule "Transform.ag"(line 36, column 19) - _lhsOerrors = - _set1Ierrors Seq.<> _set2Ierrors - -- copy rule (down) - _set1OallFields = - _lhsIallFields - -- copy rule (down) - _set1OallNonterminals = - _lhsIallNonterminals - -- copy rule (down) - _set1OdefinedSets = - _lhsIdefinedSets - -- copy rule (down) - _set2OallFields = - _lhsIallFields - -- copy rule (down) - _set2OallNonterminals = - _lhsIallNonterminals - -- copy rule (down) - _set2OdefinedSets = - _lhsIdefinedSets - ( _set1IcollectedNames,_set1Ierrors,_set1InontSet) = - (set1_ _set1OallFields _set1OallNonterminals _set1OdefinedSets) - ( _set2IcollectedNames,_set2Ierrors,_set2InontSet) = - (set2_ _set2OallFields _set2OallNonterminals _set2OdefinedSets) - in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet)))) --- Pattern ----------------------------------------------------- -{- - visit 0: - synthesized attributes: - copy : SELF - definedAttrs : [AttrName] - definedInsts : [Identifier] - patunder : [AttrName]->Pattern - stpos : Pos - alternatives: - alternative Alias: - child field : {Identifier} - child attr : {Identifier} - child pat : Pattern - child parts : Patterns - visit 0: - local copy : _ - alternative Constr: - child name : {ConstructorIdent} - child pats : Patterns - visit 0: - local copy : _ - alternative Irrefutable: - child pat : Pattern - visit 0: - local copy : _ - alternative Product: - child pos : {Pos} - child pats : Patterns - visit 0: - local copy : _ - alternative Underscore: - child pos : {Pos} - visit 0: - local copy : _ --} --- 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 (( Pattern,([AttrName]),([Identifier]),([AttrName]->Pattern),Pos)) -data Inh_Pattern = Inh_Pattern {} -data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern,definedAttrs_Syn_Pattern :: [AttrName],definedInsts_Syn_Pattern :: [Identifier],patunder_Syn_Pattern :: [AttrName]->Pattern,stpos_Syn_Pattern :: Pos} -wrap_Pattern (T_Pattern sem) (Inh_Pattern ) = - (let ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos) = - (sem ) - in (Syn_Pattern _lhsOcopy _lhsOdefinedAttrs _lhsOdefinedInsts _lhsOpatunder _lhsOstpos)) -sem_Pattern_Alias :: Identifier -> - Identifier -> - T_Pattern -> - T_Patterns -> - T_Pattern -sem_Pattern_Alias field_ attr_ (T_Pattern pat_) (T_Patterns parts_) = - (T_Pattern (let _lhsOdefinedAttrs :: ([AttrName]) - _lhsOpatunder :: ([AttrName]->Pattern) - _lhsOdefinedInsts :: ([Identifier]) - _lhsOstpos :: Pos - _lhsOcopy :: Pattern - _patIcopy :: Pattern - _patIdefinedAttrs :: ([AttrName]) - _patIdefinedInsts :: ([Identifier]) - _patIpatunder :: ([AttrName]->Pattern) - _patIstpos :: Pos - _partsIcopy :: Patterns - _partsIdefinedAttrs :: ([AttrName]) - _partsIdefinedInsts :: ([Identifier]) - _partsIpatunder :: ([AttrName]->Patterns) - -- "Transform.ag"(line 763, column 11) - _lhsOdefinedAttrs = - (field_, attr_) : _patIdefinedAttrs - -- "Transform.ag"(line 764, column 11) - _lhsOpatunder = - \us -> if ((field_,attr_) `elem` us) then Underscore noPos else _copy - -- "Transform.ag"(line 765, column 11) - _lhsOdefinedInsts = - (if field_ == _INST then [attr_] else []) ++ _patIdefinedInsts - -- "Transform.ag"(line 780, column 16) - _lhsOstpos = - getPos field_ - -- self rule - _copy = - Alias field_ attr_ _patIcopy _partsIcopy - -- self rule - _lhsOcopy = - _copy - ( _patIcopy,_patIdefinedAttrs,_patIdefinedInsts,_patIpatunder,_patIstpos) = - (pat_ ) - ( _partsIcopy,_partsIdefinedAttrs,_partsIdefinedInsts,_partsIpatunder) = - (parts_ ) - in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos))) -sem_Pattern_Constr :: ConstructorIdent -> - T_Patterns -> - T_Pattern -sem_Pattern_Constr name_ (T_Patterns pats_) = - (T_Pattern (let _lhsOpatunder :: ([AttrName]->Pattern) - _lhsOstpos :: Pos - _lhsOdefinedAttrs :: ([AttrName]) - _lhsOdefinedInsts :: ([Identifier]) - _lhsOcopy :: Pattern - _patsIcopy :: Patterns - _patsIdefinedAttrs :: ([AttrName]) - _patsIdefinedInsts :: ([Identifier]) - _patsIpatunder :: ([AttrName]->Patterns) - -- "Transform.ag"(line 767, column 12) - _lhsOpatunder = - \us -> Constr name_ (_patsIpatunder us) - -- "Transform.ag"(line 778, column 16) - _lhsOstpos = - getPos name_ - -- use rule "Transform.ag"(line 758, column 42) - _lhsOdefinedAttrs = - _patsIdefinedAttrs - -- use rule "Transform.ag"(line 757, column 55) - _lhsOdefinedInsts = - _patsIdefinedInsts - -- self rule - _copy = - Constr name_ _patsIcopy - -- self rule - _lhsOcopy = - _copy - ( _patsIcopy,_patsIdefinedAttrs,_patsIdefinedInsts,_patsIpatunder) = - (pats_ ) - in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos))) -sem_Pattern_Irrefutable :: T_Pattern -> - T_Pattern -sem_Pattern_Irrefutable (T_Pattern pat_) = - (T_Pattern (let _lhsOpatunder :: ([AttrName]->Pattern) - _lhsOdefinedAttrs :: ([AttrName]) - _lhsOdefinedInsts :: ([Identifier]) - _lhsOcopy :: Pattern - _lhsOstpos :: Pos - _patIcopy :: Pattern - _patIdefinedAttrs :: ([AttrName]) - _patIdefinedInsts :: ([Identifier]) - _patIpatunder :: ([AttrName]->Pattern) - _patIstpos :: Pos - -- "Transform.ag"(line 769, column 17) - _lhsOpatunder = - \us -> Irrefutable (_patIpatunder us) - -- use rule "Transform.ag"(line 758, column 42) - _lhsOdefinedAttrs = - _patIdefinedAttrs - -- use rule "Transform.ag"(line 757, column 55) - _lhsOdefinedInsts = - _patIdefinedInsts - -- self rule - _copy = - Irrefutable _patIcopy - -- self rule - _lhsOcopy = - _copy - -- copy rule (up) - _lhsOstpos = - _patIstpos - ( _patIcopy,_patIdefinedAttrs,_patIdefinedInsts,_patIpatunder,_patIstpos) = - (pat_ ) - in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos))) -sem_Pattern_Product :: Pos -> - T_Patterns -> - T_Pattern -sem_Pattern_Product pos_ (T_Patterns pats_) = - (T_Pattern (let _lhsOpatunder :: ([AttrName]->Pattern) - _lhsOstpos :: Pos - _lhsOdefinedAttrs :: ([AttrName]) - _lhsOdefinedInsts :: ([Identifier]) - _lhsOcopy :: Pattern - _patsIcopy :: Patterns - _patsIdefinedAttrs :: ([AttrName]) - _patsIdefinedInsts :: ([Identifier]) - _patsIpatunder :: ([AttrName]->Patterns) - -- "Transform.ag"(line 768, column 13) - _lhsOpatunder = - \us -> Product pos_ (_patsIpatunder us) - -- "Transform.ag"(line 779, column 16) - _lhsOstpos = - pos_ - -- use rule "Transform.ag"(line 758, column 42) - _lhsOdefinedAttrs = - _patsIdefinedAttrs - -- use rule "Transform.ag"(line 757, column 55) - _lhsOdefinedInsts = - _patsIdefinedInsts - -- self rule - _copy = - Product pos_ _patsIcopy - -- self rule - _lhsOcopy = - _copy - ( _patsIcopy,_patsIdefinedAttrs,_patsIdefinedInsts,_patsIpatunder) = - (pats_ ) - in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos))) -sem_Pattern_Underscore :: Pos -> - T_Pattern -sem_Pattern_Underscore pos_ = - (T_Pattern (let _lhsOpatunder :: ([AttrName]->Pattern) - _lhsOstpos :: Pos - _lhsOdefinedAttrs :: ([AttrName]) - _lhsOdefinedInsts :: ([Identifier]) - _lhsOcopy :: Pattern - -- "Transform.ag"(line 766, column 16) - _lhsOpatunder = - \us -> _copy - -- "Transform.ag"(line 781, column 16) - _lhsOstpos = - pos_ - -- use rule "Transform.ag"(line 758, column 42) - _lhsOdefinedAttrs = - [] - -- use rule "Transform.ag"(line 757, column 55) - _lhsOdefinedInsts = - [] - -- self rule - _copy = - Underscore pos_ - -- self rule - _lhsOcopy = - _copy - in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos))) --- Patterns ---------------------------------------------------- -{- - visit 0: - synthesized attributes: - copy : SELF - definedAttrs : [AttrName] - definedInsts : [Identifier] - patunder : [AttrName]->Patterns - alternatives: - alternative Cons: - child hd : Pattern - child tl : Patterns - visit 0: - local copy : _ - alternative Nil: - visit 0: - local copy : _ --} --- 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 (( Patterns,([AttrName]),([Identifier]),([AttrName]->Patterns))) -data Inh_Patterns = Inh_Patterns {} -data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns,definedAttrs_Syn_Patterns :: [AttrName],definedInsts_Syn_Patterns :: [Identifier],patunder_Syn_Patterns :: [AttrName]->Patterns} -wrap_Patterns (T_Patterns sem) (Inh_Patterns ) = - (let ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder) = - (sem ) - in (Syn_Patterns _lhsOcopy _lhsOdefinedAttrs _lhsOdefinedInsts _lhsOpatunder)) -sem_Patterns_Cons :: T_Pattern -> - T_Patterns -> - T_Patterns -sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) = - (T_Patterns (let _lhsOpatunder :: ([AttrName]->Patterns) - _lhsOdefinedAttrs :: ([AttrName]) - _lhsOdefinedInsts :: ([Identifier]) - _lhsOcopy :: Patterns - _hdIcopy :: Pattern - _hdIdefinedAttrs :: ([AttrName]) - _hdIdefinedInsts :: ([Identifier]) - _hdIpatunder :: ([AttrName]->Pattern) - _hdIstpos :: Pos - _tlIcopy :: Patterns - _tlIdefinedAttrs :: ([AttrName]) - _tlIdefinedInsts :: ([Identifier]) - _tlIpatunder :: ([AttrName]->Patterns) - -- "Transform.ag"(line 773, column 10) - _lhsOpatunder = - \us -> (_hdIpatunder us) : (_tlIpatunder us) - -- use rule "Transform.ag"(line 758, column 42) - _lhsOdefinedAttrs = - _hdIdefinedAttrs ++ _tlIdefinedAttrs - -- use rule "Transform.ag"(line 757, column 55) - _lhsOdefinedInsts = - _hdIdefinedInsts ++ _tlIdefinedInsts - -- self rule - _copy = - (:) _hdIcopy _tlIcopy - -- self rule - _lhsOcopy = - _copy - ( _hdIcopy,_hdIdefinedAttrs,_hdIdefinedInsts,_hdIpatunder,_hdIstpos) = - (hd_ ) - ( _tlIcopy,_tlIdefinedAttrs,_tlIdefinedInsts,_tlIpatunder) = - (tl_ ) - in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder))) -sem_Patterns_Nil :: T_Patterns -sem_Patterns_Nil = - (T_Patterns (let _lhsOpatunder :: ([AttrName]->Patterns) - _lhsOdefinedAttrs :: ([AttrName]) - _lhsOdefinedInsts :: ([Identifier]) - _lhsOcopy :: Patterns - -- "Transform.ag"(line 772, column 9) - _lhsOpatunder = - \us -> [] - -- use rule "Transform.ag"(line 758, column 42) - _lhsOdefinedAttrs = - [] - -- use rule "Transform.ag"(line 757, column 55) - _lhsOdefinedInsts = - [] - -- self rule - _copy = - [] - -- self rule - _lhsOcopy = - _copy - in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder))) --- SemAlt ------------------------------------------------------ -{- - visit 0: - inherited attributes: - allAttrDecls : Map NontermIdent (Attributes, Attributes) - allFields : DataTypes - nts : Set NontermIdent - synthesized attributes: - attrOrderCollect : AttrOrderMap - collectedInsts : [ (NontermIdent, ConstructorIdent, [Identifier]) ] - collectedRules : [ (NontermIdent, ConstructorIdent, RuleInfo)] - collectedSigs : [ (NontermIdent, ConstructorIdent, SigInfo) ] - errors : Seq Error - semPragmasCollect : PragmaMap - alternatives: - alternative SemAlt: - child pos : {Pos} - child constructorSet : ConstructorSet - child rules : SemDefs - visit 0: - local pragmaNames : _ - local attrOrders : _ - local coninfo : _ --} --- cata -sem_SemAlt :: SemAlt -> - T_SemAlt -sem_SemAlt (SemAlt _pos _constructorSet _rules) = - (sem_SemAlt_SemAlt _pos (sem_ConstructorSet _constructorSet) (sem_SemDefs _rules)) --- semantic domain -newtype T_SemAlt = T_SemAlt ((Map NontermIdent (Attributes, Attributes)) -> - DataTypes -> - (Set NontermIdent) -> - ( AttrOrderMap,([ (NontermIdent, ConstructorIdent, [Identifier]) ]),([ (NontermIdent, ConstructorIdent, RuleInfo)]),([ (NontermIdent, ConstructorIdent, SigInfo) ]),(Seq Error),PragmaMap)) -data Inh_SemAlt = Inh_SemAlt {allAttrDecls_Inh_SemAlt :: Map NontermIdent (Attributes, Attributes),allFields_Inh_SemAlt :: DataTypes,nts_Inh_SemAlt :: Set NontermIdent} -data Syn_SemAlt = Syn_SemAlt {attrOrderCollect_Syn_SemAlt :: AttrOrderMap,collectedInsts_Syn_SemAlt :: [ (NontermIdent, ConstructorIdent, [Identifier]) ],collectedRules_Syn_SemAlt :: [ (NontermIdent, ConstructorIdent, RuleInfo)],collectedSigs_Syn_SemAlt :: [ (NontermIdent, ConstructorIdent, SigInfo) ],errors_Syn_SemAlt :: Seq Error,semPragmasCollect_Syn_SemAlt :: PragmaMap} -wrap_SemAlt (T_SemAlt sem) (Inh_SemAlt _lhsIallAttrDecls _lhsIallFields _lhsInts) = - (let ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOerrors,_lhsOsemPragmasCollect) = - (sem _lhsIallAttrDecls _lhsIallFields _lhsInts) - in (Syn_SemAlt _lhsOattrOrderCollect _lhsOcollectedInsts _lhsOcollectedRules _lhsOcollectedSigs _lhsOerrors _lhsOsemPragmasCollect)) -sem_SemAlt_SemAlt :: Pos -> - T_ConstructorSet -> - T_SemDefs -> - T_SemAlt -sem_SemAlt_SemAlt pos_ (T_ConstructorSet constructorSet_) (T_SemDefs rules_) = - (T_SemAlt (\ _lhsIallAttrDecls - _lhsIallFields - _lhsInts -> - (let _lhsOsemPragmasCollect :: PragmaMap - _lhsOattrOrderCollect :: AttrOrderMap - _lhsOerrors :: (Seq Error) - _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) - _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) - _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _constructorSetIcollectedConstructorNames :: (Set ConstructorIdent) - _constructorSetIconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) - _constructorSetIerrors :: (Seq Error) - _rulesIdefinedInsts :: ([Identifier]) - _rulesIorderDepsCollect :: (Set Dependency) - _rulesIpragmaNamesCollect :: ([Identifier]) - _rulesIruleInfos :: ([RuleInfo]) - _rulesIsigInfos :: ([SigInfo] ) - -- "Transform.ag"(line 541, column 7) - _pragmaNames = - Set.fromList _rulesIpragmaNamesCollect - -- "Transform.ag"(line 542, column 7) - _lhsOsemPragmasCollect = - foldr pragmaMapUnion Map.empty [ pragmaMapSingle nt con _pragmaNames - | (nt, conset, _) <- _coninfo - , con <- Set.toList conset - ] - -- "Transform.ag"(line 570, column 7) - _attrOrders = - [ orderMapSingle nt con _rulesIorderDepsCollect - | (nt, conset, _) <- _coninfo - , con <- Set.toList conset - ] - -- "Transform.ag"(line 576, column 7) - _lhsOattrOrderCollect = - foldr orderMapUnion Map.empty _attrOrders - -- "Transform.ag"(line 718, column 12) - _coninfo = - [ (nt, conset, conkeys) - | nt <- Set.toList _lhsInts - , let conmap = Map.findWithDefault Map.empty nt _lhsIallFields - , let conkeys = Set.fromList (Map.keys conmap) - , let conset = _constructorSetIconstructors conkeys - ] - -- "Transform.ag"(line 725, column 12) - _lhsOerrors = - Seq.fromList - [ UndefAlt nt con - | (nt, conset, conkeys) <- _coninfo - , con <- Set.toList (Set.difference conset conkeys) - ] - -- "Transform.ag"(line 730, column 12) - _lhsOcollectedRules = - [ (nt,con,r) - | (nt, conset, _) <- _coninfo - , con <- Set.toList conset - , r <- _rulesIruleInfos - ] - -- "Transform.ag"(line 736, column 12) - _lhsOcollectedSigs = - [ (nt,con,ts) - | (nt, conset, _) <- _coninfo - , con <- Set.toList conset - , ts <- _rulesIsigInfos - ] - -- "Transform.ag"(line 743, column 12) - _lhsOcollectedInsts = - [ (nt,con,_rulesIdefinedInsts) - | (nt, conset, _) <- _coninfo - , con <- Set.toList conset - ] - ( _constructorSetIcollectedConstructorNames,_constructorSetIconstructors,_constructorSetIerrors) = - (constructorSet_ ) - ( _rulesIdefinedInsts,_rulesIorderDepsCollect,_rulesIpragmaNamesCollect,_rulesIruleInfos,_rulesIsigInfos) = - (rules_ ) - in ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOerrors,_lhsOsemPragmasCollect)))) --- SemAlts ----------------------------------------------------- -{- - visit 0: - inherited attributes: - allAttrDecls : Map NontermIdent (Attributes, Attributes) - allFields : DataTypes - nts : Set NontermIdent - synthesized attributes: - attrOrderCollect : AttrOrderMap - collectedInsts : [ (NontermIdent, ConstructorIdent, [Identifier]) ] - collectedRules : [ (NontermIdent, ConstructorIdent, RuleInfo)] - collectedSigs : [ (NontermIdent, ConstructorIdent, SigInfo) ] - errors : Seq Error - semPragmasCollect : PragmaMap - alternatives: - alternative Cons: - child hd : SemAlt - child tl : SemAlts - alternative Nil: --} --- cata -sem_SemAlts :: SemAlts -> - T_SemAlts -sem_SemAlts list = - (Prelude.foldr sem_SemAlts_Cons sem_SemAlts_Nil (Prelude.map sem_SemAlt list)) --- semantic domain -newtype T_SemAlts = T_SemAlts ((Map NontermIdent (Attributes, Attributes)) -> - DataTypes -> - (Set NontermIdent) -> - ( AttrOrderMap,([ (NontermIdent, ConstructorIdent, [Identifier]) ]),([ (NontermIdent, ConstructorIdent, RuleInfo)]),([ (NontermIdent, ConstructorIdent, SigInfo) ]),(Seq Error),PragmaMap)) -data Inh_SemAlts = Inh_SemAlts {allAttrDecls_Inh_SemAlts :: Map NontermIdent (Attributes, Attributes),allFields_Inh_SemAlts :: DataTypes,nts_Inh_SemAlts :: Set NontermIdent} -data Syn_SemAlts = Syn_SemAlts {attrOrderCollect_Syn_SemAlts :: AttrOrderMap,collectedInsts_Syn_SemAlts :: [ (NontermIdent, ConstructorIdent, [Identifier]) ],collectedRules_Syn_SemAlts :: [ (NontermIdent, ConstructorIdent, RuleInfo)],collectedSigs_Syn_SemAlts :: [ (NontermIdent, ConstructorIdent, SigInfo) ],errors_Syn_SemAlts :: Seq Error,semPragmasCollect_Syn_SemAlts :: PragmaMap} -wrap_SemAlts (T_SemAlts sem) (Inh_SemAlts _lhsIallAttrDecls _lhsIallFields _lhsInts) = - (let ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOerrors,_lhsOsemPragmasCollect) = - (sem _lhsIallAttrDecls _lhsIallFields _lhsInts) - in (Syn_SemAlts _lhsOattrOrderCollect _lhsOcollectedInsts _lhsOcollectedRules _lhsOcollectedSigs _lhsOerrors _lhsOsemPragmasCollect)) -sem_SemAlts_Cons :: T_SemAlt -> - T_SemAlts -> - T_SemAlts -sem_SemAlts_Cons (T_SemAlt hd_) (T_SemAlts tl_) = - (T_SemAlts (\ _lhsIallAttrDecls - _lhsIallFields - _lhsInts -> - (let _lhsOattrOrderCollect :: AttrOrderMap - _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) - _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) - _lhsOerrors :: (Seq Error) - _lhsOsemPragmasCollect :: PragmaMap - _hdOallAttrDecls :: (Map NontermIdent (Attributes, Attributes)) - _hdOallFields :: DataTypes - _hdOnts :: (Set NontermIdent) - _tlOallAttrDecls :: (Map NontermIdent (Attributes, Attributes)) - _tlOallFields :: DataTypes - _tlOnts :: (Set NontermIdent) - _hdIattrOrderCollect :: AttrOrderMap - _hdIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _hdIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) - _hdIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) - _hdIerrors :: (Seq Error) - _hdIsemPragmasCollect :: PragmaMap - _tlIattrOrderCollect :: AttrOrderMap - _tlIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _tlIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) - _tlIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) - _tlIerrors :: (Seq Error) - _tlIsemPragmasCollect :: PragmaMap - -- use rule "Transform.ag"(line 565, column 55) - _lhsOattrOrderCollect = - _hdIattrOrderCollect `orderMapUnion` _tlIattrOrderCollect - -- use rule "Transform.ag"(line 138, column 29) - _lhsOcollectedInsts = - _hdIcollectedInsts ++ _tlIcollectedInsts - -- use rule "Transform.ag"(line 136, column 29) - _lhsOcollectedRules = - _hdIcollectedRules ++ _tlIcollectedRules - -- use rule "Transform.ag"(line 137, column 29) - _lhsOcollectedSigs = - _hdIcollectedSigs ++ _tlIcollectedSigs - -- use rule "Transform.ag"(line 36, column 19) - _lhsOerrors = - _hdIerrors Seq.<> _tlIerrors - -- use rule "Transform.ag"(line 537, column 56) - _lhsOsemPragmasCollect = - _hdIsemPragmasCollect `pragmaMapUnion` _tlIsemPragmasCollect - -- copy rule (down) - _hdOallAttrDecls = - _lhsIallAttrDecls - -- copy rule (down) - _hdOallFields = - _lhsIallFields - -- copy rule (down) - _hdOnts = - _lhsInts - -- copy rule (down) - _tlOallAttrDecls = - _lhsIallAttrDecls - -- copy rule (down) - _tlOallFields = - _lhsIallFields - -- copy rule (down) - _tlOnts = - _lhsInts - ( _hdIattrOrderCollect,_hdIcollectedInsts,_hdIcollectedRules,_hdIcollectedSigs,_hdIerrors,_hdIsemPragmasCollect) = - (hd_ _hdOallAttrDecls _hdOallFields _hdOnts) - ( _tlIattrOrderCollect,_tlIcollectedInsts,_tlIcollectedRules,_tlIcollectedSigs,_tlIerrors,_tlIsemPragmasCollect) = - (tl_ _tlOallAttrDecls _tlOallFields _tlOnts) - in ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOerrors,_lhsOsemPragmasCollect)))) -sem_SemAlts_Nil :: T_SemAlts -sem_SemAlts_Nil = - (T_SemAlts (\ _lhsIallAttrDecls - _lhsIallFields - _lhsInts -> - (let _lhsOattrOrderCollect :: AttrOrderMap - _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) - _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) - _lhsOerrors :: (Seq Error) - _lhsOsemPragmasCollect :: PragmaMap - -- use rule "Transform.ag"(line 565, column 55) - _lhsOattrOrderCollect = - Map.empty - -- use rule "Transform.ag"(line 138, column 29) - _lhsOcollectedInsts = - [] - -- use rule "Transform.ag"(line 136, column 29) - _lhsOcollectedRules = - [] - -- use rule "Transform.ag"(line 137, column 29) - _lhsOcollectedSigs = - [] - -- use rule "Transform.ag"(line 36, column 19) - _lhsOerrors = - Seq.empty - -- use rule "Transform.ag"(line 537, column 56) - _lhsOsemPragmasCollect = - Map.empty - in ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOerrors,_lhsOsemPragmasCollect)))) --- SemDef ------------------------------------------------------ -{- - visit 0: - synthesized attributes: - definedInsts : [Identifier] - orderDepsCollect : Set Dependency - pragmaNamesCollect : [Identifier] - ruleInfos : [RuleInfo] - sigInfos : [SigInfo] - alternatives: - alternative AttrOrderBefore: - child before : {[(Identifier,Identifier)]} - child after : {[(Identifier,Identifier)]} - visit 0: - local dependency : _ - alternative Def: - child pattern : Pattern - child rhs : {Expression} - child owrt : {Bool} - alternative SemPragma: - child names : {[NontermIdent]} - alternative TypeDef: - child ident : {Identifier} - child tp : {Type} --} --- cata -sem_SemDef :: SemDef -> - T_SemDef -sem_SemDef (AttrOrderBefore _before _after) = - (sem_SemDef_AttrOrderBefore _before _after) -sem_SemDef (Def _pattern _rhs _owrt) = - (sem_SemDef_Def (sem_Pattern _pattern) _rhs _owrt) -sem_SemDef (SemPragma _names) = - (sem_SemDef_SemPragma _names) -sem_SemDef (TypeDef _ident _tp) = - (sem_SemDef_TypeDef _ident _tp) --- semantic domain -newtype T_SemDef = T_SemDef (( ([Identifier]),(Set Dependency),([Identifier]),([RuleInfo]),([SigInfo] ))) -data Inh_SemDef = Inh_SemDef {} -data Syn_SemDef = Syn_SemDef {definedInsts_Syn_SemDef :: [Identifier],orderDepsCollect_Syn_SemDef :: Set Dependency,pragmaNamesCollect_Syn_SemDef :: [Identifier],ruleInfos_Syn_SemDef :: [RuleInfo],sigInfos_Syn_SemDef :: [SigInfo] } -wrap_SemDef (T_SemDef sem) (Inh_SemDef ) = - (let ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos) = - (sem ) - in (Syn_SemDef _lhsOdefinedInsts _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos)) -sem_SemDef_AttrOrderBefore :: ([(Identifier,Identifier)]) -> - ([(Identifier,Identifier)]) -> - T_SemDef -sem_SemDef_AttrOrderBefore before_ after_ = - (T_SemDef (let _lhsOorderDepsCollect :: (Set Dependency) - _lhsOdefinedInsts :: ([Identifier]) - _lhsOpragmaNamesCollect :: ([Identifier]) - _lhsOruleInfos :: ([RuleInfo]) - _lhsOsigInfos :: ([SigInfo] ) - -- "Transform.ag"(line 582, column 7) - _dependency = - [ Dependency b a | b <- before_, a <- after_ ] - -- "Transform.ag"(line 583, column 7) - _lhsOorderDepsCollect = - Set.fromList _dependency - -- use rule "Transform.ag"(line 757, column 55) - _lhsOdefinedInsts = - [] - -- use rule "Transform.ag"(line 547, column 46) - _lhsOpragmaNamesCollect = - [] - -- use rule "Transform.ag"(line 712, column 37) - _lhsOruleInfos = - [] - -- use rule "Transform.ag"(line 713, column 37) - _lhsOsigInfos = - [] - in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos))) -sem_SemDef_Def :: T_Pattern -> - Expression -> - Bool -> - T_SemDef -sem_SemDef_Def (T_Pattern pattern_) rhs_ owrt_ = - (T_SemDef (let _lhsOruleInfos :: ([RuleInfo]) - _lhsOdefinedInsts :: ([Identifier]) - _lhsOorderDepsCollect :: (Set Dependency) - _lhsOpragmaNamesCollect :: ([Identifier]) - _lhsOsigInfos :: ([SigInfo] ) - _patternIcopy :: Pattern - _patternIdefinedAttrs :: ([AttrName]) - _patternIdefinedInsts :: ([Identifier]) - _patternIpatunder :: ([AttrName]->Pattern) - _patternIstpos :: Pos - -- "Transform.ag"(line 751, column 10) - _lhsOruleInfos = - [ (_patternIpatunder, rhs_, _patternIdefinedAttrs, owrt_, show _patternIstpos) ] - -- use rule "Transform.ag"(line 757, column 55) - _lhsOdefinedInsts = - _patternIdefinedInsts - -- use rule "Transform.ag"(line 578, column 44) - _lhsOorderDepsCollect = - Set.empty - -- use rule "Transform.ag"(line 547, column 46) - _lhsOpragmaNamesCollect = - [] - -- use rule "Transform.ag"(line 713, column 37) - _lhsOsigInfos = - [] - ( _patternIcopy,_patternIdefinedAttrs,_patternIdefinedInsts,_patternIpatunder,_patternIstpos) = - (pattern_ ) - in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos))) -sem_SemDef_SemPragma :: ([NontermIdent]) -> - T_SemDef -sem_SemDef_SemPragma names_ = - (T_SemDef (let _lhsOpragmaNamesCollect :: ([Identifier]) - _lhsOdefinedInsts :: ([Identifier]) - _lhsOorderDepsCollect :: (Set Dependency) - _lhsOruleInfos :: ([RuleInfo]) - _lhsOsigInfos :: ([SigInfo] ) - -- "Transform.ag"(line 551, column 7) - _lhsOpragmaNamesCollect = - names_ - -- use rule "Transform.ag"(line 757, column 55) - _lhsOdefinedInsts = - [] - -- use rule "Transform.ag"(line 578, column 44) - _lhsOorderDepsCollect = - Set.empty - -- use rule "Transform.ag"(line 712, column 37) - _lhsOruleInfos = - [] - -- use rule "Transform.ag"(line 713, column 37) - _lhsOsigInfos = - [] - in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos))) -sem_SemDef_TypeDef :: Identifier -> - Type -> - T_SemDef -sem_SemDef_TypeDef ident_ tp_ = - (T_SemDef (let _lhsOsigInfos :: ([SigInfo] ) - _lhsOdefinedInsts :: ([Identifier]) - _lhsOorderDepsCollect :: (Set Dependency) - _lhsOpragmaNamesCollect :: ([Identifier]) - _lhsOruleInfos :: ([RuleInfo]) - -- "Transform.ag"(line 754, column 14) - _lhsOsigInfos = - [ (ident_, tp_) ] - -- use rule "Transform.ag"(line 757, column 55) - _lhsOdefinedInsts = - [] - -- use rule "Transform.ag"(line 578, column 44) - _lhsOorderDepsCollect = - Set.empty - -- use rule "Transform.ag"(line 547, column 46) - _lhsOpragmaNamesCollect = - [] - -- use rule "Transform.ag"(line 712, column 37) - _lhsOruleInfos = - [] - in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos))) --- SemDefs ----------------------------------------------------- -{- - visit 0: - synthesized attributes: - definedInsts : [Identifier] - orderDepsCollect : Set Dependency - pragmaNamesCollect : [Identifier] - ruleInfos : [RuleInfo] - sigInfos : [SigInfo] - alternatives: - alternative Cons: - child hd : SemDef - child tl : SemDefs - alternative Nil: --} --- cata -sem_SemDefs :: SemDefs -> - T_SemDefs -sem_SemDefs list = - (Prelude.foldr sem_SemDefs_Cons sem_SemDefs_Nil (Prelude.map sem_SemDef list)) --- semantic domain -newtype T_SemDefs = T_SemDefs (( ([Identifier]),(Set Dependency),([Identifier]),([RuleInfo]),([SigInfo] ))) -data Inh_SemDefs = Inh_SemDefs {} -data Syn_SemDefs = Syn_SemDefs {definedInsts_Syn_SemDefs :: [Identifier],orderDepsCollect_Syn_SemDefs :: Set Dependency,pragmaNamesCollect_Syn_SemDefs :: [Identifier],ruleInfos_Syn_SemDefs :: [RuleInfo],sigInfos_Syn_SemDefs :: [SigInfo] } -wrap_SemDefs (T_SemDefs sem) (Inh_SemDefs ) = - (let ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos) = - (sem ) - in (Syn_SemDefs _lhsOdefinedInsts _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos)) -sem_SemDefs_Cons :: T_SemDef -> - T_SemDefs -> - T_SemDefs -sem_SemDefs_Cons (T_SemDef hd_) (T_SemDefs tl_) = - (T_SemDefs (let _lhsOdefinedInsts :: ([Identifier]) - _lhsOorderDepsCollect :: (Set Dependency) - _lhsOpragmaNamesCollect :: ([Identifier]) - _lhsOruleInfos :: ([RuleInfo]) - _lhsOsigInfos :: ([SigInfo] ) - _hdIdefinedInsts :: ([Identifier]) - _hdIorderDepsCollect :: (Set Dependency) - _hdIpragmaNamesCollect :: ([Identifier]) - _hdIruleInfos :: ([RuleInfo]) - _hdIsigInfos :: ([SigInfo] ) - _tlIdefinedInsts :: ([Identifier]) - _tlIorderDepsCollect :: (Set Dependency) - _tlIpragmaNamesCollect :: ([Identifier]) - _tlIruleInfos :: ([RuleInfo]) - _tlIsigInfos :: ([SigInfo] ) - -- use rule "Transform.ag"(line 757, column 55) - _lhsOdefinedInsts = - _hdIdefinedInsts ++ _tlIdefinedInsts - -- use rule "Transform.ag"(line 578, column 44) - _lhsOorderDepsCollect = - _hdIorderDepsCollect `Set.union` _tlIorderDepsCollect - -- use rule "Transform.ag"(line 547, column 46) - _lhsOpragmaNamesCollect = - _hdIpragmaNamesCollect ++ _tlIpragmaNamesCollect - -- use rule "Transform.ag"(line 712, column 37) - _lhsOruleInfos = - _hdIruleInfos ++ _tlIruleInfos - -- use rule "Transform.ag"(line 713, column 37) - _lhsOsigInfos = - _hdIsigInfos ++ _tlIsigInfos - ( _hdIdefinedInsts,_hdIorderDepsCollect,_hdIpragmaNamesCollect,_hdIruleInfos,_hdIsigInfos) = - (hd_ ) - ( _tlIdefinedInsts,_tlIorderDepsCollect,_tlIpragmaNamesCollect,_tlIruleInfos,_tlIsigInfos) = - (tl_ ) - in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos))) -sem_SemDefs_Nil :: T_SemDefs -sem_SemDefs_Nil = - (T_SemDefs (let _lhsOdefinedInsts :: ([Identifier]) - _lhsOorderDepsCollect :: (Set Dependency) - _lhsOpragmaNamesCollect :: ([Identifier]) - _lhsOruleInfos :: ([RuleInfo]) - _lhsOsigInfos :: ([SigInfo] ) - -- use rule "Transform.ag"(line 757, column 55) - _lhsOdefinedInsts = - [] - -- use rule "Transform.ag"(line 578, column 44) - _lhsOorderDepsCollect = - Set.empty - -- use rule "Transform.ag"(line 547, column 46) - _lhsOpragmaNamesCollect = - [] - -- use rule "Transform.ag"(line 712, column 37) - _lhsOruleInfos = - [] - -- use rule "Transform.ag"(line 713, column 37) - _lhsOsigInfos = - [] - in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos))) +import List (partition, elem, nub,intersperse) +import Data.Maybe +import qualified Data.Map as Map +import Data.Map (Map) +import Data.Set as Set (Set, member, union, toList, fromList, empty, singleton, member, unions, size, fold, intersection, difference, insert) +import UU.DData.Seq as Seq (Seq, empty, (<>), single, cons, toList, fromList) +import UU.Scanner.Position(noPos) + +import ConcreteSyntax +import AbstractSyntax +import ErrorMessages +import Patterns (Patterns(..),Pattern(..)) +import Expression (Expression(..)) +import HsToken + +import Options +import CommonTypes + +import UU.Scanner.Position (Pos) +import Patterns (Pattern) +import Expression (Expression) +import CommonTypes + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +type DefinedSets = Map Identifier (Set NontermIdent) +type FieldMap = [(Identifier, Type)] +type DataTypes = Map.Map NontermIdent (Map.Map ConstructorIdent FieldMap) +type AttrName = (Identifier,Identifier) +type RuleInfo = ([AttrName]->Pattern, Expression, [AttrName], Bool, String) +type SigInfo = (Identifier,Type) +type UniqueInfo = (Identifier,Identifier) + + +checkDuplicate :: (Identifier -> Identifier -> Error) + -> Identifier -> val -> Map Identifier val -> (Map Identifier val,Seq Error) +checkDuplicate dupError key val m + = case Map.lookupIndex key m of + Just ix -> let (key',_) = Map.elemAt ix m + in (m,Seq.single (dupError key key')) + Nothing -> (Map.insert key val m,Seq.empty) + +checkDuplicates :: (Identifier -> Identifier -> Error) + -> [(Identifier, val)] -> Map Identifier val -> (Map Identifier val,Seq Error) +checkDuplicates dupError new m = foldErrors check m new + where check = uncurry (checkDuplicate dupError) + +foldErrors f e xs = foldl g (e,Seq.empty) xs + where g ~(e,es) x = let (e',es') = f x e + in (e', es <> es') + + +checkForDuplicates :: (Identifier -> Identifier -> Error) -> [Identifier] -> [Error] +checkForDuplicates err [] = [] +checkForDuplicates err (x:xs) = let (same,other) = List.partition (equalId x) xs + in map (err x) same ++ checkForDuplicates err other + +equalId :: Identifier -> Identifier -> Bool +equalId x y = getName x == getName y + + +type RulesAndErrors = ([Rule], Seq Error) +type SigsAndErrors = ([TypeSig], Seq Error) +type InstsAndErrors = ([(Identifier, Type)], Seq Error) +type UniquesAndErrors = (Map Identifier Identifier, Seq Error) +type AttrOverwrite = Map AttrName Bool +type AccumRuleCheck = (RulesAndErrors, AttrOverwrite) +type AccumDefiCheck = (Seq Error, AttrOverwrite, [AttrName], [AttrName]) + +checkRules :: Map NontermIdent (Attributes, Attributes) -> Map NontermIdent (Map ConstructorIdent FieldMap) -> + Map NontermIdent (Map ConstructorIdent [Identifier]) -> Map NontermIdent (Map ConstructorIdent [SigInfo]) -> + NontermIdent -> ConstructorIdent -> [RuleInfo] -> RulesAndErrors +checkRules attributes fields allinsts allsigs nt con rs + = let fieldmap :: FieldMap + fieldmap = (_LHS,NT nt undefined) : (_LOC,NT undefined undefined) : (_INST, NT undefined undefined) : (_FIRST, NT undefined undefined) : (_LAST, NT undefined undefined) + : Map.findWithDefault [] con (Map.findWithDefault Map.empty nt fields) + ++ mapMaybe (\instNm -> lookup instNm sigs >>= \tp -> return (instNm, tp)) (Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allinsts)) + + sigs = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allsigs) + + hasAttrib f tp attr = Map.member attr (f (Map.findWithDefault (Map.empty,Map.empty) tp attributes)) + + checkRule :: RuleInfo -> AccumRuleCheck -> AccumRuleCheck + checkRule (pat,exp,as,owrt,str) ((r1,e1),m1) + = let (e2,m2,u2,b2) = foldr (checkDefi owrt) (e1,m1,[],[]) as + in ( (Rule (pat u2) exp owrt str : r1, e2), m2) + + checkDefi :: Bool -> AttrName -> AccumDefiCheck -> AccumDefiCheck + checkDefi owrt fa@(field,attr) (e,m,u,bs) + = case lookup field fieldmap + of Just (NT tp _) -> if field == _LOC || field == _INST || field == _FIRST || field == _LAST + || hasAttrib (if getName field==getName _LHS then snd else fst) tp attr + then case Map.lookupIndex fa m of + Just ix -> let ((_,attr2),b) = Map.elemAt ix m + in if b && not (fa `elem` bs) + then ( e, Map.insert fa owrt m, fa:u, fa:bs) + else (Seq.cons (DupRule nt con field attr2 attr) e, m, fa:u, bs) + Nothing -> ( e, Map.insert fa owrt m, u, fa:bs) + else (Seq.cons (SuperfluousRule nt con field attr) e, m, fa:u, bs) + _ -> (Seq.cons (UndefChild nt con field) e, m, fa:u, bs ) + + in fst (foldr checkRule (([],Seq.empty),Map.empty) rs) + +checkSigs :: NontermIdent -> ConstructorIdent -> [SigInfo] -> SigsAndErrors +checkSigs nt con sis + = let checkSig (ide,typ) (sigs,errs) + = if ide `elem` map (\(TypeSig n t)-> n) sigs + then (sigs, Seq.cons (DupSig nt con ide) errs) + -- else if not (ide `elem` locattrdefs) + -- then (sigs, Seq.cons (SupSig nt con ide) errs) + else (TypeSig ide typ:sigs, errs) + in foldr checkSig ([],Seq.empty) sis + +checkInsts :: Set NontermIdent -> Map NontermIdent (Map ConstructorIdent [SigInfo]) -> NontermIdent -> ConstructorIdent -> [Identifier] -> InstsAndErrors +checkInsts allNts sigMap nt con + = foldr (\inst (insts, errs) -> + maybe (insts, Seq.single (MissingInstSig nt con inst) <> errs) + (\info@(_, NT nm _) -> case nm `Set.member` allNts of + True -> (info : insts, errs) + False | take 2 (getName nm) == "T_" -> let nm' = Ident (drop 2 (getName nm)) (getPos nm) + in case nm' `Set.member` allNts of + True -> (info : insts, errs) + False -> (insts, Seq.single (UndefNont nm') <> errs) + | otherwise -> (insts, Seq.single (UndefNont nm) <> errs) + ) + $ findSig inst + ) ([], Seq.empty) + where + sigs = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt sigMap) + + findSig name + = do tp@(NT _ _) <- lookup name sigs + return (name, tp) + +checkUniques :: Map NontermIdent (Attributes, Attributes) -> NontermIdent -> ConstructorIdent -> [UniqueInfo] -> UniquesAndErrors +checkUniques allAttrs nt con uniques + = let checkUnique (ident,ref) (us,errs) + = if ident `Map.member` us + then (us, Seq.cons (DupUnique nt con ident) errs) + else if Map.member ref inhs && Map.member ref syns + then (Map.insert ident ref us, errs) + else (us, Seq.cons (MissingUnique nt ref) errs) + + (inhs,syns) = Map.findWithDefault (Map.empty,Map.empty) nt allAttrs + in foldr checkUnique (Map.empty, Seq.empty) uniques + +mkUniqueRules :: Options -> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) -> Map NontermIdent (Attributes,Attributes) -> NontermIdent -> ConstructorIdent -> Map Identifier Identifier -> [Rule] +mkUniqueRules opts allFields allAttrDecls nt con usMap + = map apply groups + where + fields = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allFields) + + groups = Map.assocs $ Map.foldWithKey (\i r m -> Map.insertWith (++) r [i] m) Map.empty usMap + apply (ref,us) = mkRule ref (findOutField ref) us + findOutField ref = case [ chld | (chld,NT tp _) <- fields, tp `hasSyn` ref] of + [] -> _LHS + (x:_) -> x + hasSyn tp ref = Map.member ref $ snd $ Map.findWithDefault (Map.empty,Map.empty) tp allAttrDecls + mkRule ref outFld locAttrs + = let pat = Product noPos (attr outFld ref : [attr _LOC u | u <- locAttrs ]) + rhs = Expression noPos $ wrap ref $ foldr gencase (finalout locAttrs) locAttrs + -- [HsToken ("mkUniques" ++ show (length locAttrs) ++ " ") noPos, AGField _LHS ref noPos Nothing] + in Rule pat rhs False "-- generated by the unique rule mechanism." + attr fld a = Alias fld a (Underscore noPos) [] + gencase nm outp + = h ("case " ++ uniqueDispenser opts ++ " __cont of { (__cont, " ++ getName nm ++ ") -> ") ++ outp ++ h "}" + h s = [HsToken s noPos] + finalout us = h ("(__cont, " ++ concat (intersperse "," (map getName us)) ++ ")") + wrap ref inp = h "case " ++ [AGField _LHS ref noPos Nothing] ++ h " of { __cont | __cont `seq` True -> " ++ inp ++ h "}" + +flattenDatas :: DataTypes -> Map NontermIdent (Set NontermIdent) +flattenDatas ds = Map.map flatten ds + where flatten cs = Set.fromList [ nt | (_,NT nt _) <- concatMap snd (Map.toList cs)] + +reachableFrom :: Map NontermIdent (Set NontermIdent) -> Set NontermIdent -> Set NontermIdent +reachableFrom table nts = reach nts + where reach nts = let nts' = Set.unions (nts : [ ns | nt <- Set.toList nts + , let ns = Map.findWithDefault Set.empty nt table ]) + in if Set.size nts' > Set.size nts + then reach nts' + else nts +invert :: Map NontermIdent (Set NontermIdent) -> Map NontermIdent (Set NontermIdent) +invert m = foldr inv Map.empty (Map.toList m) + where inv (x,ns) m = fold (\n m -> Map.insertWith Set.union n (Set.singleton x) m) m ns + +path :: Map NontermIdent (Set NontermIdent) -> NontermIdent -> NontermIdent -> Set NontermIdent +path table from to = let children = Map.findWithDefault Set.empty from table + forward = reachableFrom table children + backward = reachableFrom (invert table) + (Set.singleton to) + in Set.intersection forward backward + +pragmaMapUnion :: PragmaMap -> PragmaMap -> PragmaMap +pragmaMapUnion = Map.unionWith (Map.unionWith Set.union) + +pragmaMapSingle :: NontermIdent -> ConstructorIdent -> Set Identifier -> PragmaMap +pragmaMapSingle nt con nms = Map.singleton nt (Map.singleton con nms) + +orderMapUnion :: AttrOrderMap -> AttrOrderMap -> AttrOrderMap +orderMapUnion = Map.unionWith (Map.unionWith Set.union) + +orderMapSingle :: NontermIdent -> ConstructorIdent -> Set Dependency -> AttrOrderMap +orderMapSingle nt con deps = Map.singleton nt (Map.singleton con deps) + +mergeParams :: ParamMap -> ParamMap -> ParamMap +mergeParams = Map.unionWith (++) + +mergeCtx :: ContextMap -> ContextMap -> ContextMap +mergeCtx + = Map.unionWith nubconcat + where nubconcat a b = nub (a ++ b) + +mergeDerivings m1 m2 = foldr (\(n,cs) m -> Map.insertWith Set.union n cs m) m2 (Map.toList m1) + +merge x y = foldr f y (Map.toList x) + where f ~(k,v) m = Map.insertWith (Map.union) k v m + +checkAttrs allFields nts inherited synthesized decls = foldErrors check decls nts where + check nt decls | not (nt `Map.member` allFields) = (decls,Seq.single(UndefNont nt)) + | otherwise = let (inh,syn) = Map.findWithDefault (Map.empty,Map.empty) nt decls + (inh',einh) = checkDuplicates (DupInhAttr nt) inherited inh + (syn',esyn) = checkDuplicates (DupSynAttr nt) synthesized syn + in (Map.insert nt (inh',syn') decls,einh <> esyn) + +addSelf name atMap = let (eInh,eSyn) = Map.findWithDefault(Map.empty,Map.empty) name atMap + in Map.insert name (eInh, Map.insert (Ident "self" noPos) (NT _SELF []) eSyn)atMap + +makeType :: Set NontermIdent -> Type -> Type +makeType nts tp@(NT x _) | x == _SELF = tp + | Set.member x nts = tp + | otherwise = Haskell (typeToHaskellString Nothing [] tp) +makeType _ tp = tp + +constructGrammar :: Set NontermIdent + -> ParamMap + -> DataTypes + -> Map NontermIdent (Attributes, Attributes) + -> Map NontermIdent (Map Identifier (String, String, String)) + -> Derivings + -> Set NontermIdent + -> Map NontermIdent (Map ConstructorIdent [Rule]) + -> Map NontermIdent (Map ConstructorIdent [TypeSig]) + -> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) + -> TypeSyns + -> PragmaMap + -> AttrOrderMap + -> ContextMap + -> UniqueMap + -> Grammar + +constructGrammar nts ntParams gram attrs uses derivings wrappers allrules tsigs allinsts tsyns pragmaMap orderMap contextMap uniqueMap = + let gr = [ (nt,Map.toList alts) | (nt,alts) <- Map.toList gram] + nonts = map nont gr + nont (nt,alts) = let (inh,syn) = Map.findWithDefault (Map.empty,Map.empty) nt attrs + rmap = Map.findWithDefault Map.empty nt allrules + tsmap = Map.findWithDefault Map.empty nt tsigs + instsmap = Map.findWithDefault Map.empty nt allinsts + params = Map.findWithDefault [] nt ntParams + alt (con,flds) = + let rules = maybe [] id (Map.lookup con rmap) + tsigs = maybe [] id (Map.lookup con tsmap) + insts = maybe [] id (Map.lookup con instsmap) + cldrn = map (child False) flds ++ map (child True) insts + child isVirtual (nm, tp) = + let (inh,syn) = case tp of + NT nt _ -> Map.findWithDefault (Map.empty,Map.empty) nt attrs + _ -> (Map.empty,Map.empty) + in Child nm tp inh syn isVirtual + in Production con cldrn rules tsigs + in Nonterminal nt params inh syn (map alt alts) + in Grammar tsyns uses derivings wrappers nonts pragmaMap orderMap ntParams contextMap uniqueMap + +mapUnionWithSetUnion = Map.unionWith Set.union +mapUnionWithPlusPlus = Map.unionWith (++) +-- AG ---------------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + synthesized attributes: + blocks : Blocks + errors : Seq Error + moduleDecl : Maybe (String,String,String) + output : Grammar + pragmas : Options -> Options + alternatives: + alternative AG: + child elems : Elems + visit 0: + local allFields : _ + local allConstrs : _ + local allRules : _ + local allSigs : _ + local allInsts : _ + local allUniques : _ + local allRulesErrs : _ + local allSigsErrs : _ + local allInstsErrs : _ + local allUniquesErrs : _ + local checkedRulesPre : _ + local checkedSigs : _ + local checkedInsts : _ + local checkedUniques : _ + local checkedRules : _ + local errs1 : _ + local errs2 : _ + local errs3 : _ + local errs4 : _ + local errs5 : _ + local errs6 : _ + local errs7 : _ + local allNonterminals : _ + local allAttrDecls : _ +-} +-- cata +sem_AG :: AG -> + T_AG +sem_AG (AG _elems) = + (sem_AG_AG (sem_Elems _elems)) +-- semantic domain +newtype T_AG = T_AG (Options -> + ( Blocks,(Seq Error),(Maybe (String,String,String)),Grammar,(Options -> Options))) +data Inh_AG = Inh_AG {options_Inh_AG :: !(Options)} +data Syn_AG = Syn_AG {blocks_Syn_AG :: !(Blocks),errors_Syn_AG :: !(Seq Error),moduleDecl_Syn_AG :: !(Maybe (String,String,String)),output_Syn_AG :: !(Grammar),pragmas_Syn_AG :: !(Options -> Options)} +wrap_AG (T_AG sem) (Inh_AG _lhsIoptions) = + (let ( _lhsOblocks,_lhsOerrors,_lhsOmoduleDecl,_lhsOoutput,_lhsOpragmas) = + (sem _lhsIoptions) + in (Syn_AG _lhsOblocks _lhsOerrors _lhsOmoduleDecl _lhsOoutput _lhsOpragmas)) +sem_AG_AG :: T_Elems -> + T_AG +sem_AG_AG (T_Elems elems_) = + (T_AG (\ _lhsIoptions -> + (let _lhsOoutput :: Grammar + _lhsOerrors :: (Seq Error) + _elemsOallConstructors :: (Map NontermIdent (Set ConstructorIdent)) + _elemsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _elemsOdefinedSets :: DefinedSets + _elemsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOblocks :: Blocks + _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOpragmas :: (Options -> Options) + _elemsOallAttrDecls :: (Map NontermIdent (Attributes, Attributes)) + _elemsOallFields :: DataTypes + _elemsOallNonterminals :: (Set NontermIdent) + _elemsIattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _elemsIattrOrderCollect :: AttrOrderMap + _elemsIblocks :: Blocks + _elemsIcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _elemsIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _elemsIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _elemsIcollectedNames :: (Set Identifier) + _elemsIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _elemsIcollectedSetNames :: (Set Identifier) + _elemsIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _elemsIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _elemsIctxCollect :: ContextMap + _elemsIdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _elemsIderivings :: Derivings + _elemsIerrors :: (Seq Error) + _elemsImoduleDecl :: (Maybe (String,String,String)) + _elemsIparamsCollect :: ParamMap + _elemsIpragmas :: (Options -> Options) + _elemsIsemPragmasCollect :: PragmaMap + _elemsItypeSyns :: TypeSyns + _elemsIuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _elemsIwrappers :: (Set NontermIdent) + -- "Transform.ag"(line 49, column 8) + _lhsOoutput = + constructGrammar _allNonterminals + _elemsIparamsCollect + _allFields + _allAttrDecls + _elemsIuseMap + _elemsIderivings + (if wrappers _lhsIoptions then _allNonterminals else _elemsIwrappers) + _checkedRules + _checkedSigs + _checkedInsts + _elemsItypeSyns + _elemsIsemPragmasCollect + _elemsIattrOrderCollect + _elemsIctxCollect + _checkedUniques + -- "Transform.ag"(line 235, column 10) + _allFields = + let f (nt,con,fm) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con fm) + in foldr f (Map.empty) _elemsIcollectedFields + -- "Transform.ag"(line 238, column 10) + _allConstrs = + let f (nt,con,_) = Map.insertWith (++) nt [con] + in foldr f (Map.empty) _elemsIcollectedFields + -- "Transform.ag"(line 241, column 10) + _allRules = + let f (nt,con,r) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con [r]) + in foldr f (Map.empty) _elemsIcollectedRules + -- "Transform.ag"(line 244, column 10) + _allSigs = + let f (nt,con,t) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con [t]) + typeof nt r = Map.findWithDefault (Haskell "") r $ fst $ Map.findWithDefault (Map.empty,Map.empty) nt _allAttrDecls + in foldr f (Map.empty) ( _elemsIcollectedSigs + ++ [ (nt, con, (ident,typeof nt ref)) | (nt, con, us) <- _elemsIcollectedUniques, (ident,ref) <- us ] + ) + -- "Transform.ag"(line 250, column 10) + _allInsts = + let f (nt,con,is) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con is) + in foldr f (Map.empty) _elemsIcollectedInsts + -- "Transform.ag"(line 253, column 10) + _allUniques = + let f (nt,con,us) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con us) + in foldr f (Map.empty) _elemsIcollectedUniques + -- "Transform.ag"(line 256, column 10) + _allRulesErrs = + Map.mapWithKey (Map.mapWithKey . (checkRules _allAttrDecls _allFields _allInsts _allSigs )) _allRules + -- "Transform.ag"(line 257, column 10) + _allSigsErrs = + Map.mapWithKey (Map.mapWithKey . (checkSigs )) _allSigs + -- "Transform.ag"(line 258, column 10) + _allInstsErrs = + Map.mapWithKey (Map.mapWithKey . (checkInsts _allNonterminals _allSigs )) _allInsts + -- "Transform.ag"(line 259, column 10) + _allUniquesErrs = + Map.mapWithKey (Map.mapWithKey . (checkUniques _allAttrDecls )) _allUniques + -- "Transform.ag"(line 261, column 10) + _checkedRulesPre = + Map.map (Map.map fst) _allRulesErrs + -- "Transform.ag"(line 262, column 10) + _checkedSigs = + Map.map (Map.map fst) _allSigsErrs + -- "Transform.ag"(line 263, column 10) + _checkedInsts = + Map.map (Map.map fst) _allInstsErrs + -- "Transform.ag"(line 264, column 10) + _checkedUniques = + Map.map (Map.map fst) _allUniquesErrs + -- "Transform.ag"(line 265, column 10) + _checkedRules = + Map.unionWith (Map.unionWith (++)) _checkedRulesPre (Map.mapWithKey (Map.mapWithKey . (mkUniqueRules _lhsIoptions _allFields _allAttrDecls )) _checkedUniques ) + -- "Transform.ag"(line 267, column 10) + _errs1 = + let f = checkForDuplicates (DupSynonym) + in Seq.fromList . f . map fst $ _elemsItypeSyns + -- "Transform.ag"(line 270, column 10) + _errs2 = + let g nt (con,fm) = checkForDuplicates (DupChild nt con) (map fst fm) + f (nt,cfm) = concat . map (g nt) . Map.toList $ cfm + in Seq.fromList . concat . map f . Map.toList $ _allFields + -- "Transform.ag"(line 274, column 10) + _errs3 = + let f (nt,cons) = checkForDuplicates (DupAlt nt) cons + in Seq.empty + -- "Transform.ag"(line 278, column 10) + _errs4 = + let f m s = Map.fold ((<>) . snd) s m + in Map.fold f Seq.empty _allRulesErrs + -- "Transform.ag"(line 281, column 10) + _errs5 = + let f m s = Map.fold ((<>) . snd) s m + in Map.fold f Seq.empty _allSigsErrs + -- "Transform.ag"(line 284, column 10) + _errs6 = + let f m s = Map.fold ((<>) . snd) s m + in Map.fold f Seq.empty _allInstsErrs + -- "Transform.ag"(line 287, column 10) + _errs7 = + let f m s = Map.fold ((<>) . snd) s m + in Map.fold f Seq.empty _allUniquesErrs + -- "Transform.ag"(line 290, column 10) + _lhsOerrors = + _elemsIerrors <> _errs1 <> _errs2 <> _errs3 <> _errs4 <> _errs5 <> _errs6 <> _errs7 + -- "Transform.ag"(line 423, column 10) + _allNonterminals = + _elemsIcollectedNames `Set.difference` _elemsIcollectedSetNames + -- "Transform.ag"(line 443, column 8) + _elemsOallConstructors = + _elemsIcollectedConstructorsMap + -- "Transform.ag"(line 516, column 8) + _elemsOdefSets = + Map.fromList (map (\x->(x,(Set.singleton x, Set.empty))) (Set.toList _allNonterminals )) + -- "Transform.ag"(line 517, column 8) + _elemsOdefinedSets = + Map.map fst _elemsIdefSets + -- "Transform.ag"(line 761, column 8) + _elemsOattrDecls = + Map.empty + -- "Transform.ag"(line 800, column 9) + _allAttrDecls = + if withSelf _lhsIoptions + then foldr addSelf _elemsIattrDecls (Set.toList _allNonterminals ) + else _elemsIattrDecls + -- use rule "Transform.ag"(line 42, column 19) + _lhsOblocks = + _elemsIblocks + -- use rule "Transform.ag"(line 894, column 37) + _lhsOmoduleDecl = + _elemsImoduleDecl + -- use rule "Transform.ag"(line 598, column 34) + _lhsOpragmas = + _elemsIpragmas + -- copy rule (from local) + _elemsOallAttrDecls = + _allAttrDecls + -- copy rule (from local) + _elemsOallFields = + _allFields + -- copy rule (from local) + _elemsOallNonterminals = + _allNonterminals + ( _elemsIattrDecls,_elemsIattrOrderCollect,_elemsIblocks,_elemsIcollectedConstructorsMap,_elemsIcollectedFields,_elemsIcollectedInsts,_elemsIcollectedNames,_elemsIcollectedRules,_elemsIcollectedSetNames,_elemsIcollectedSigs,_elemsIcollectedUniques,_elemsIctxCollect,_elemsIdefSets,_elemsIderivings,_elemsIerrors,_elemsImoduleDecl,_elemsIparamsCollect,_elemsIpragmas,_elemsIsemPragmasCollect,_elemsItypeSyns,_elemsIuseMap,_elemsIwrappers) = + (elems_ _elemsOallAttrDecls _elemsOallConstructors _elemsOallFields _elemsOallNonterminals _elemsOattrDecls _elemsOdefSets _elemsOdefinedSets) + in ( _lhsOblocks,_lhsOerrors,_lhsOmoduleDecl,_lhsOoutput,_lhsOpragmas)))) +-- Alt --------------------------------------------------------- +{- + visit 0: + inherited attributes: + allConstructors : Map NontermIdent (Set ConstructorIdent) + allNonterminals : Set NontermIdent + nts : Set NontermIdent + synthesized attributes: + collectedConstructorNames : Set ConstructorIdent + collectedFields : [(NontermIdent, ConstructorIdent, FieldMap)] + alternatives: + alternative Alt: + child pos : {Pos} + child names : ConstructorSet + child fields : {Fields} +-} +-- cata +sem_Alt :: Alt -> + T_Alt +sem_Alt (Alt _pos _names _fields) = + (sem_Alt_Alt _pos (sem_ConstructorSet _names) _fields) +-- semantic domain +newtype T_Alt = T_Alt ((Map NontermIdent (Set ConstructorIdent)) -> + (Set NontermIdent) -> + (Set NontermIdent) -> + ( (Set ConstructorIdent),([(NontermIdent, ConstructorIdent, FieldMap)]))) +data Inh_Alt = Inh_Alt {allConstructors_Inh_Alt :: !(Map NontermIdent (Set ConstructorIdent)),allNonterminals_Inh_Alt :: !(Set NontermIdent),nts_Inh_Alt :: !(Set NontermIdent)} +data Syn_Alt = Syn_Alt {collectedConstructorNames_Syn_Alt :: !(Set ConstructorIdent),collectedFields_Syn_Alt :: !([(NontermIdent, ConstructorIdent, FieldMap)])} +wrap_Alt (T_Alt sem) (Inh_Alt _lhsIallConstructors _lhsIallNonterminals _lhsInts) = + (let ( _lhsOcollectedConstructorNames,_lhsOcollectedFields) = + (sem _lhsIallConstructors _lhsIallNonterminals _lhsInts) + in (Syn_Alt _lhsOcollectedConstructorNames _lhsOcollectedFields)) +sem_Alt_Alt :: Pos -> + T_ConstructorSet -> + Fields -> + T_Alt +sem_Alt_Alt pos_ (T_ConstructorSet names_) fields_ = + (T_Alt (\ _lhsIallConstructors + _lhsIallNonterminals + _lhsInts -> + (let _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedConstructorNames :: (Set ConstructorIdent) + _namesIcollectedConstructorNames :: (Set ConstructorIdent) + _namesIconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) + _namesIerrors :: (Seq Error) + -- "Transform.ag"(line 220, column 10) + _lhsOcollectedFields = + let fieldTable = + [ (attr, makeType _lhsIallNonterminals tp) + | (attr, tp) <- fields_ + ] + in [ (nt, con, fieldTable) + | nt <- Set.toList _lhsInts + , con <- Set.toList (_namesIconstructors (Map.findWithDefault Set.empty nt _lhsIallConstructors)) + ] + -- use rule "Transform.ag"(line 87, column 62) + _lhsOcollectedConstructorNames = + _namesIcollectedConstructorNames + ( _namesIcollectedConstructorNames,_namesIconstructors,_namesIerrors) = + (names_ ) + in ( _lhsOcollectedConstructorNames,_lhsOcollectedFields)))) +-- Alts -------------------------------------------------------- +{- + visit 0: + inherited attributes: + allConstructors : Map NontermIdent (Set ConstructorIdent) + allNonterminals : Set NontermIdent + nts : Set NontermIdent + synthesized attributes: + collectedConstructorNames : Set ConstructorIdent + collectedFields : [(NontermIdent, ConstructorIdent, FieldMap)] + alternatives: + alternative Cons: + child hd : Alt + child tl : Alts + alternative Nil: +-} +-- cata +sem_Alts :: Alts -> + T_Alts +sem_Alts list = + (Prelude.foldr sem_Alts_Cons sem_Alts_Nil (Prelude.map sem_Alt list)) +-- semantic domain +newtype T_Alts = T_Alts ((Map NontermIdent (Set ConstructorIdent)) -> + (Set NontermIdent) -> + (Set NontermIdent) -> + ( (Set ConstructorIdent),([(NontermIdent, ConstructorIdent, FieldMap)]))) +data Inh_Alts = Inh_Alts {allConstructors_Inh_Alts :: !(Map NontermIdent (Set ConstructorIdent)),allNonterminals_Inh_Alts :: !(Set NontermIdent),nts_Inh_Alts :: !(Set NontermIdent)} +data Syn_Alts = Syn_Alts {collectedConstructorNames_Syn_Alts :: !(Set ConstructorIdent),collectedFields_Syn_Alts :: !([(NontermIdent, ConstructorIdent, FieldMap)])} +wrap_Alts (T_Alts sem) (Inh_Alts _lhsIallConstructors _lhsIallNonterminals _lhsInts) = + (let ( _lhsOcollectedConstructorNames,_lhsOcollectedFields) = + (sem _lhsIallConstructors _lhsIallNonterminals _lhsInts) + in (Syn_Alts _lhsOcollectedConstructorNames _lhsOcollectedFields)) +sem_Alts_Cons :: T_Alt -> + T_Alts -> + T_Alts +sem_Alts_Cons (T_Alt hd_) (T_Alts tl_) = + (T_Alts (\ _lhsIallConstructors + _lhsIallNonterminals + _lhsInts -> + (let _lhsOcollectedConstructorNames :: (Set ConstructorIdent) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _hdOallConstructors :: (Map NontermIdent (Set ConstructorIdent)) + _hdOallNonterminals :: (Set NontermIdent) + _hdOnts :: (Set NontermIdent) + _tlOallConstructors :: (Map NontermIdent (Set ConstructorIdent)) + _tlOallNonterminals :: (Set NontermIdent) + _tlOnts :: (Set NontermIdent) + _hdIcollectedConstructorNames :: (Set ConstructorIdent) + _hdIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _tlIcollectedConstructorNames :: (Set ConstructorIdent) + _tlIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + -- use rule "Transform.ag"(line 87, column 62) + _lhsOcollectedConstructorNames = + _hdIcollectedConstructorNames `Set.union` _tlIcollectedConstructorNames + -- use rule "Transform.ag"(line 119, column 28) + _lhsOcollectedFields = + _hdIcollectedFields ++ _tlIcollectedFields + -- copy rule (down) + _hdOallConstructors = + _lhsIallConstructors + -- copy rule (down) + _hdOallNonterminals = + _lhsIallNonterminals + -- copy rule (down) + _hdOnts = + _lhsInts + -- copy rule (down) + _tlOallConstructors = + _lhsIallConstructors + -- copy rule (down) + _tlOallNonterminals = + _lhsIallNonterminals + -- copy rule (down) + _tlOnts = + _lhsInts + ( _hdIcollectedConstructorNames,_hdIcollectedFields) = + (hd_ _hdOallConstructors _hdOallNonterminals _hdOnts) + ( _tlIcollectedConstructorNames,_tlIcollectedFields) = + (tl_ _tlOallConstructors _tlOallNonterminals _tlOnts) + in ( _lhsOcollectedConstructorNames,_lhsOcollectedFields)))) +sem_Alts_Nil :: T_Alts +sem_Alts_Nil = + (T_Alts (\ _lhsIallConstructors + _lhsIallNonterminals + _lhsInts -> + (let _lhsOcollectedConstructorNames :: (Set ConstructorIdent) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + -- use rule "Transform.ag"(line 87, column 62) + _lhsOcollectedConstructorNames = + Set.empty + -- use rule "Transform.ag"(line 119, column 28) + _lhsOcollectedFields = + [] + in ( _lhsOcollectedConstructorNames,_lhsOcollectedFields)))) +-- Attrs ------------------------------------------------------- +{- + visit 0: + inherited attributes: + allFields : DataTypes + allNonterminals : Set NontermIdent + nts : Set NontermIdent + chained attribute: + attrDecls : Map NontermIdent (Attributes, Attributes) + synthesized attributes: + errors : Seq Error + useMap : Map NontermIdent (Map Identifier (String,String,String)) + alternatives: + alternative Attrs: + child pos : {Pos} + child inh : {AttrNames} + child chn : {AttrNames} + child syn : {AttrNames} + visit 0: + local _tup1 : _ + local attrDecls : _ + local errors : _ + local _tup2 : _ + local inherited : _ + local synthesized : _ + local useMap : _ +-} +-- cata +sem_Attrs :: Attrs -> + T_Attrs +sem_Attrs (Attrs _pos _inh _chn _syn) = + (sem_Attrs_Attrs _pos _inh _chn _syn) +-- semantic domain +newtype T_Attrs = T_Attrs (DataTypes -> + (Set NontermIdent) -> + (Map NontermIdent (Attributes, Attributes)) -> + (Set NontermIdent) -> + ( (Map NontermIdent (Attributes, Attributes)),(Seq Error),(Map NontermIdent (Map Identifier (String,String,String))))) +data Inh_Attrs = Inh_Attrs {allFields_Inh_Attrs :: !(DataTypes),allNonterminals_Inh_Attrs :: !(Set NontermIdent),attrDecls_Inh_Attrs :: !(Map NontermIdent (Attributes, Attributes)),nts_Inh_Attrs :: !(Set NontermIdent)} +data Syn_Attrs = Syn_Attrs {attrDecls_Syn_Attrs :: !(Map NontermIdent (Attributes, Attributes)),errors_Syn_Attrs :: !(Seq Error),useMap_Syn_Attrs :: !(Map NontermIdent (Map Identifier (String,String,String)))} +wrap_Attrs (T_Attrs sem) (Inh_Attrs _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsInts) = + (let ( _lhsOattrDecls,_lhsOerrors,_lhsOuseMap) = + (sem _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsInts) + in (Syn_Attrs _lhsOattrDecls _lhsOerrors _lhsOuseMap)) +sem_Attrs_Attrs :: Pos -> + AttrNames -> + AttrNames -> + AttrNames -> + T_Attrs +sem_Attrs_Attrs pos_ inh_ chn_ syn_ = + (T_Attrs (\ _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsInts -> + (let _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOerrors :: (Seq Error) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + -- "Transform.ag"(line 769, column 15) + __tup1 = + checkAttrs _lhsIallFields (Set.toList _lhsInts) _inherited _synthesized _lhsIattrDecls + -- "Transform.ag"(line 769, column 15) + (_attrDecls,_) = + __tup1 + -- "Transform.ag"(line 769, column 15) + (_,_errors) = + __tup1 + -- "Transform.ag"(line 771, column 15) + __tup2 = + let splitAttrs xs = unzip [ ((n,makeType _lhsIallNonterminals t),(n,ud)) + | (n,t,ud) <- xs + ] + (inh,_) = splitAttrs inh_ + (chn,uses1) = splitAttrs chn_ + (syn,uses2) = splitAttrs syn_ + isUse (n,(e1,e2,_)) = not (null e1 || null e2) + in (inh++chn,chn++syn, Map.fromList (Prelude.filter isUse (uses1++uses2))) + -- "Transform.ag"(line 771, column 15) + (_inherited,_,_) = + __tup2 + -- "Transform.ag"(line 771, column 15) + (_,_synthesized,_) = + __tup2 + -- "Transform.ag"(line 771, column 15) + (_,_,_useMap) = + __tup2 + -- "Transform.ag"(line 779, column 11) + _lhsOuseMap = + Map.fromList (zip (Set.toList _lhsInts) (repeat _useMap)) + -- use rule "Transform.ag"(line 40, column 19) + _lhsOerrors = + _errors + -- copy rule (from local) + _lhsOattrDecls = + _attrDecls + in ( _lhsOattrDecls,_lhsOerrors,_lhsOuseMap)))) +-- ConstructorSet ---------------------------------------------- +{- + visit 0: + synthesized attributes: + collectedConstructorNames : Set ConstructorIdent + constructors : (Set ConstructorIdent->Set ConstructorIdent) + errors : Seq Error + alternatives: + alternative CAll: + alternative CDifference: + child set1 : ConstructorSet + child set2 : ConstructorSet + alternative CName: + child name : {ConstructorIdent} + alternative CUnion: + child set1 : ConstructorSet + child set2 : ConstructorSet +-} +-- cata +sem_ConstructorSet :: ConstructorSet -> + T_ConstructorSet +sem_ConstructorSet (CAll ) = + (sem_ConstructorSet_CAll ) +sem_ConstructorSet (CDifference _set1 _set2) = + (sem_ConstructorSet_CDifference (sem_ConstructorSet _set1) (sem_ConstructorSet _set2)) +sem_ConstructorSet (CName _name) = + (sem_ConstructorSet_CName _name) +sem_ConstructorSet (CUnion _set1 _set2) = + (sem_ConstructorSet_CUnion (sem_ConstructorSet _set1) (sem_ConstructorSet _set2)) +-- semantic domain +newtype T_ConstructorSet = T_ConstructorSet (( (Set ConstructorIdent),((Set ConstructorIdent->Set ConstructorIdent)),(Seq Error))) +data Inh_ConstructorSet = Inh_ConstructorSet {} +data Syn_ConstructorSet = Syn_ConstructorSet {collectedConstructorNames_Syn_ConstructorSet :: !(Set ConstructorIdent),constructors_Syn_ConstructorSet :: !((Set ConstructorIdent->Set ConstructorIdent)),errors_Syn_ConstructorSet :: !(Seq Error)} +wrap_ConstructorSet (T_ConstructorSet sem) (Inh_ConstructorSet ) = + (let ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors) = + (sem ) + in (Syn_ConstructorSet _lhsOcollectedConstructorNames _lhsOconstructors _lhsOerrors)) +sem_ConstructorSet_CAll :: T_ConstructorSet +sem_ConstructorSet_CAll = + (T_ConstructorSet (let _lhsOconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) + _lhsOcollectedConstructorNames :: (Set ConstructorIdent) + _lhsOerrors :: (Seq Error) + -- "Transform.ag"(line 583, column 17) + _lhsOconstructors = + \ds -> ds + -- use rule "Transform.ag"(line 87, column 62) + _lhsOcollectedConstructorNames = + Set.empty + -- use rule "Transform.ag"(line 40, column 19) + _lhsOerrors = + Seq.empty + in ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors))) +sem_ConstructorSet_CDifference :: T_ConstructorSet -> + T_ConstructorSet -> + T_ConstructorSet +sem_ConstructorSet_CDifference (T_ConstructorSet set1_) (T_ConstructorSet set2_) = + (T_ConstructorSet (let _lhsOconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) + _lhsOcollectedConstructorNames :: (Set ConstructorIdent) + _lhsOerrors :: (Seq Error) + _set1IcollectedConstructorNames :: (Set ConstructorIdent) + _set1Iconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) + _set1Ierrors :: (Seq Error) + _set2IcollectedConstructorNames :: (Set ConstructorIdent) + _set2Iconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) + _set2Ierrors :: (Seq Error) + -- "Transform.ag"(line 582, column 17) + _lhsOconstructors = + \ds -> _set1Iconstructors ds `Set.difference` _set2Iconstructors ds + -- use rule "Transform.ag"(line 87, column 62) + _lhsOcollectedConstructorNames = + _set1IcollectedConstructorNames `Set.union` _set2IcollectedConstructorNames + -- use rule "Transform.ag"(line 40, column 19) + _lhsOerrors = + _set1Ierrors Seq.<> _set2Ierrors + ( _set1IcollectedConstructorNames,_set1Iconstructors,_set1Ierrors) = + (set1_ ) + ( _set2IcollectedConstructorNames,_set2Iconstructors,_set2Ierrors) = + (set2_ ) + in ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors))) +sem_ConstructorSet_CName :: ConstructorIdent -> + T_ConstructorSet +sem_ConstructorSet_CName name_ = + (T_ConstructorSet (let _lhsOcollectedConstructorNames :: (Set ConstructorIdent) + _lhsOconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) + _lhsOerrors :: (Seq Error) + -- "Transform.ag"(line 431, column 11) + _lhsOcollectedConstructorNames = + Set.singleton name_ + -- "Transform.ag"(line 580, column 17) + _lhsOconstructors = + \ds -> Set.singleton name_ + -- use rule "Transform.ag"(line 40, column 19) + _lhsOerrors = + Seq.empty + in ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors))) +sem_ConstructorSet_CUnion :: T_ConstructorSet -> + T_ConstructorSet -> + T_ConstructorSet +sem_ConstructorSet_CUnion (T_ConstructorSet set1_) (T_ConstructorSet set2_) = + (T_ConstructorSet (let _lhsOconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) + _lhsOcollectedConstructorNames :: (Set ConstructorIdent) + _lhsOerrors :: (Seq Error) + _set1IcollectedConstructorNames :: (Set ConstructorIdent) + _set1Iconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) + _set1Ierrors :: (Seq Error) + _set2IcollectedConstructorNames :: (Set ConstructorIdent) + _set2Iconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) + _set2Ierrors :: (Seq Error) + -- "Transform.ag"(line 581, column 17) + _lhsOconstructors = + \ds -> _set1Iconstructors ds `Set.union` _set2Iconstructors ds + -- use rule "Transform.ag"(line 87, column 62) + _lhsOcollectedConstructorNames = + _set1IcollectedConstructorNames `Set.union` _set2IcollectedConstructorNames + -- use rule "Transform.ag"(line 40, column 19) + _lhsOerrors = + _set1Ierrors Seq.<> _set2Ierrors + ( _set1IcollectedConstructorNames,_set1Iconstructors,_set1Ierrors) = + (set1_ ) + ( _set2IcollectedConstructorNames,_set2Iconstructors,_set2Ierrors) = + (set2_ ) + in ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors))) +-- Elem -------------------------------------------------------- +{- + visit 0: + inherited attributes: + allAttrDecls : Map NontermIdent (Attributes, Attributes) + allConstructors : Map NontermIdent (Set ConstructorIdent) + allFields : DataTypes + allNonterminals : Set NontermIdent + definedSets : DefinedSets + chained attributes: + attrDecls : Map NontermIdent (Attributes, Attributes) + defSets : Map Identifier (Set NontermIdent,Set Identifier) + synthesized attributes: + attrOrderCollect : AttrOrderMap + blocks : Blocks + collectedConstructorsMap : Map NontermIdent (Set ConstructorIdent) + collectedFields : [(NontermIdent, ConstructorIdent, FieldMap)] + collectedInsts : [ (NontermIdent, ConstructorIdent, [Identifier]) ] + collectedNames : Set Identifier + collectedRules : [ (NontermIdent, ConstructorIdent, RuleInfo)] + collectedSetNames : Set Identifier + collectedSigs : [ (NontermIdent, ConstructorIdent, SigInfo) ] + collectedUniques : [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ] + ctxCollect : ContextMap + derivings : Derivings + errors : Seq Error + moduleDecl : Maybe (String,String,String) + paramsCollect : ParamMap + pragmas : Options -> Options + semPragmasCollect : PragmaMap + typeSyns : TypeSyns + useMap : Map NontermIdent (Map Identifier (String,String,String)) + wrappers : Set NontermIdent + alternatives: + alternative Attr: + child pos : {Pos} + child ctx : {ClassContext} + child names : NontSet + child attrs : Attrs + alternative Data: + child pos : {Pos} + child ctx : {ClassContext} + child names : NontSet + child params : {[Identifier]} + child attrs : Attrs + child alts : Alts + child ext : {Bool} + alternative Deriving: + child pos : {Pos} + child set : NontSet + child classes : {[NontermIdent]} + alternative Module: + child pos : {Pos} + child name : {String} + child exports : {String} + child imports : {String} + alternative Pragma: + child pos : {Pos} + child names : {[NontermIdent]} + alternative Sem: + child pos : {Pos} + child ctx : {ClassContext} + child names : NontSet + child attrs : Attrs + child alts : SemAlts + alternative Set: + child pos : {Pos} + child name : {NontermIdent} + child set : NontSet + visit 0: + local _tup3 : _ + local defSets2 : _ + local errs : _ + alternative Txt: + child pos : {Pos} + child name : {Identifier} + child mbNt : {Maybe NontermIdent} + child lines : {[String]} + visit 0: + local blockInfo : _ + local blockValue : _ + alternative Type: + child pos : {Pos} + child ctx : {ClassContext} + child name : {NontermIdent} + child params : {[Identifier]} + child type : {ComplexType} + visit 0: + local expanded : _ + local argType : _ + alternative Wrapper: + child pos : {Pos} + child set : NontSet +-} +-- cata +sem_Elem :: Elem -> + T_Elem +sem_Elem (Attr _pos _ctx _names _attrs) = + (sem_Elem_Attr _pos _ctx (sem_NontSet _names) (sem_Attrs _attrs)) +sem_Elem (Data _pos _ctx _names _params _attrs _alts _ext) = + (sem_Elem_Data _pos _ctx (sem_NontSet _names) _params (sem_Attrs _attrs) (sem_Alts _alts) _ext) +sem_Elem (Deriving _pos _set _classes) = + (sem_Elem_Deriving _pos (sem_NontSet _set) _classes) +sem_Elem (Module _pos _name _exports _imports) = + (sem_Elem_Module _pos _name _exports _imports) +sem_Elem (Pragma _pos _names) = + (sem_Elem_Pragma _pos _names) +sem_Elem (Sem _pos _ctx _names _attrs _alts) = + (sem_Elem_Sem _pos _ctx (sem_NontSet _names) (sem_Attrs _attrs) (sem_SemAlts _alts)) +sem_Elem (Set _pos _name _set) = + (sem_Elem_Set _pos _name (sem_NontSet _set)) +sem_Elem (Txt _pos _name _mbNt _lines) = + (sem_Elem_Txt _pos _name _mbNt _lines) +sem_Elem (Type _pos _ctx _name _params _type) = + (sem_Elem_Type _pos _ctx _name _params _type) +sem_Elem (Wrapper _pos _set) = + (sem_Elem_Wrapper _pos (sem_NontSet _set)) +-- semantic domain +newtype T_Elem = T_Elem ((Map NontermIdent (Attributes, Attributes)) -> + (Map NontermIdent (Set ConstructorIdent)) -> + DataTypes -> + (Set NontermIdent) -> + (Map NontermIdent (Attributes, Attributes)) -> + (Map Identifier (Set NontermIdent,Set Identifier)) -> + DefinedSets -> + ( (Map NontermIdent (Attributes, Attributes)),AttrOrderMap,Blocks,(Map NontermIdent (Set ConstructorIdent)),([(NontermIdent, ConstructorIdent, FieldMap)]),([ (NontermIdent, ConstructorIdent, [Identifier]) ]),(Set Identifier),([ (NontermIdent, ConstructorIdent, RuleInfo)]),(Set Identifier),([ (NontermIdent, ConstructorIdent, SigInfo) ]),([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),ContextMap,(Map Identifier (Set NontermIdent,Set Identifier)),Derivings,(Seq Error),(Maybe (String,String,String)),ParamMap,(Options -> Options),PragmaMap,TypeSyns,(Map NontermIdent (Map Identifier (String,String,String))),(Set NontermIdent))) +data Inh_Elem = Inh_Elem {allAttrDecls_Inh_Elem :: !(Map NontermIdent (Attributes, Attributes)),allConstructors_Inh_Elem :: !(Map NontermIdent (Set ConstructorIdent)),allFields_Inh_Elem :: !(DataTypes),allNonterminals_Inh_Elem :: !(Set NontermIdent),attrDecls_Inh_Elem :: !(Map NontermIdent (Attributes, Attributes)),defSets_Inh_Elem :: !(Map Identifier (Set NontermIdent,Set Identifier)),definedSets_Inh_Elem :: !(DefinedSets)} +data Syn_Elem = Syn_Elem {attrDecls_Syn_Elem :: !(Map NontermIdent (Attributes, Attributes)),attrOrderCollect_Syn_Elem :: !(AttrOrderMap),blocks_Syn_Elem :: !(Blocks),collectedConstructorsMap_Syn_Elem :: !(Map NontermIdent (Set ConstructorIdent)),collectedFields_Syn_Elem :: !([(NontermIdent, ConstructorIdent, FieldMap)]),collectedInsts_Syn_Elem :: !([ (NontermIdent, ConstructorIdent, [Identifier]) ]),collectedNames_Syn_Elem :: !(Set Identifier),collectedRules_Syn_Elem :: !([ (NontermIdent, ConstructorIdent, RuleInfo)]),collectedSetNames_Syn_Elem :: !(Set Identifier),collectedSigs_Syn_Elem :: !([ (NontermIdent, ConstructorIdent, SigInfo) ]),collectedUniques_Syn_Elem :: !([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),ctxCollect_Syn_Elem :: !(ContextMap),defSets_Syn_Elem :: !(Map Identifier (Set NontermIdent,Set Identifier)),derivings_Syn_Elem :: !(Derivings),errors_Syn_Elem :: !(Seq Error),moduleDecl_Syn_Elem :: !(Maybe (String,String,String)),paramsCollect_Syn_Elem :: !(ParamMap),pragmas_Syn_Elem :: !(Options -> Options),semPragmasCollect_Syn_Elem :: !(PragmaMap),typeSyns_Syn_Elem :: !(TypeSyns),useMap_Syn_Elem :: !(Map NontermIdent (Map Identifier (String,String,String))),wrappers_Syn_Elem :: !(Set NontermIdent)} +wrap_Elem (T_Elem sem) (Inh_Elem _lhsIallAttrDecls _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIdefSets _lhsIdefinedSets) = + (let ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers) = + (sem _lhsIallAttrDecls _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIdefSets _lhsIdefinedSets) + in (Syn_Elem _lhsOattrDecls _lhsOattrOrderCollect _lhsOblocks _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOcollectedUniques _lhsOctxCollect _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOparamsCollect _lhsOpragmas _lhsOsemPragmasCollect _lhsOtypeSyns _lhsOuseMap _lhsOwrappers)) +sem_Elem_Attr :: Pos -> + ClassContext -> + T_NontSet -> + T_Attrs -> + T_Elem +sem_Elem_Attr pos_ ctx_ (T_NontSet names_) (T_Attrs attrs_) = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIdefSets + _lhsIdefinedSets -> + (let _lhsOctxCollect :: ContextMap + _attrsOnts :: (Set NontermIdent) + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedNames :: (Set Identifier) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSetNames :: (Set Identifier) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOderivings :: Derivings + _lhsOerrors :: (Seq Error) + _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOparamsCollect :: ParamMap + _lhsOpragmas :: (Options -> Options) + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _namesOallFields :: DataTypes + _namesOallNonterminals :: (Set NontermIdent) + _namesOdefinedSets :: DefinedSets + _attrsOallFields :: DataTypes + _attrsOallNonterminals :: (Set NontermIdent) + _attrsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _namesIcollectedNames :: (Set Identifier) + _namesIerrors :: (Seq Error) + _namesInontSet :: (Set NontermIdent) + _attrsIattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _attrsIerrors :: (Seq Error) + _attrsIuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + -- "Transform.ag"(line 721, column 7) + _lhsOctxCollect = + if null ctx_ + then Map.empty + else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet] + -- "Transform.ag"(line 765, column 10) + _attrsOnts = + _namesInontSet + -- use rule "Transform.ag"(line 662, column 55) + _lhsOattrOrderCollect = + Map.empty + -- use rule "Transform.ag"(line 42, column 19) + _lhsOblocks = + Map.empty + -- use rule "Transform.ag"(line 88, column 48) + _lhsOcollectedConstructorsMap = + Map.empty + -- use rule "Transform.ag"(line 119, column 28) + _lhsOcollectedFields = + [] + -- use rule "Transform.ag"(line 144, column 31) + _lhsOcollectedInsts = + [] + -- use rule "Transform.ag"(line 80, column 50) + _lhsOcollectedNames = + _namesIcollectedNames + -- use rule "Transform.ag"(line 142, column 31) + _lhsOcollectedRules = + [] + -- use rule "Transform.ag"(line 79, column 50) + _lhsOcollectedSetNames = + Set.empty + -- use rule "Transform.ag"(line 143, column 31) + _lhsOcollectedSigs = + [] + -- use rule "Transform.ag"(line 145, column 31) + _lhsOcollectedUniques = + [] + -- use rule "Transform.ag"(line 742, column 33) + _lhsOderivings = + Map.empty + -- use rule "Transform.ag"(line 40, column 19) + _lhsOerrors = + _namesIerrors Seq.<> _attrsIerrors + -- use rule "Transform.ag"(line 894, column 37) + _lhsOmoduleDecl = + mzero + -- use rule "Transform.ag"(line 694, column 37) + _lhsOparamsCollect = + Map.empty + -- use rule "Transform.ag"(line 598, column 34) + _lhsOpragmas = + id + -- use rule "Transform.ag"(line 634, column 56) + _lhsOsemPragmasCollect = + Map.empty + -- use rule "Transform.ag"(line 458, column 32) + _lhsOtypeSyns = + [] + -- use rule "Transform.ag"(line 131, column 15) + _lhsOuseMap = + _attrsIuseMap + -- use rule "Transform.ag"(line 589, column 32) + _lhsOwrappers = + Set.empty + -- copy rule (up) + _lhsOattrDecls = + _attrsIattrDecls + -- copy rule (chain) + _lhsOdefSets = + _lhsIdefSets + -- copy rule (down) + _namesOallFields = + _lhsIallFields + -- copy rule (down) + _namesOallNonterminals = + _lhsIallNonterminals + -- copy rule (down) + _namesOdefinedSets = + _lhsIdefinedSets + -- copy rule (down) + _attrsOallFields = + _lhsIallFields + -- copy rule (down) + _attrsOallNonterminals = + _lhsIallNonterminals + -- copy rule (down) + _attrsOattrDecls = + _lhsIattrDecls + ( _namesIcollectedNames,_namesIerrors,_namesInontSet) = + (names_ _namesOallFields _namesOallNonterminals _namesOdefinedSets) + ( _attrsIattrDecls,_attrsIerrors,_attrsIuseMap) = + (attrs_ _attrsOallFields _attrsOallNonterminals _attrsOattrDecls _attrsOnts) + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) +sem_Elem_Data :: Pos -> + ClassContext -> + T_NontSet -> + ([Identifier]) -> + T_Attrs -> + T_Alts -> + Bool -> + T_Elem +sem_Elem_Data pos_ ctx_ (T_NontSet names_) params_ (T_Attrs attrs_) (T_Alts alts_) ext_ = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIdefSets + _lhsIdefinedSets -> + (let _altsOnts :: (Set NontermIdent) + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOparamsCollect :: ParamMap + _lhsOctxCollect :: ContextMap + _attrsOnts :: (Set NontermIdent) + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedNames :: (Set Identifier) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSetNames :: (Set Identifier) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOderivings :: Derivings + _lhsOerrors :: (Seq Error) + _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOpragmas :: (Options -> Options) + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _namesOallFields :: DataTypes + _namesOallNonterminals :: (Set NontermIdent) + _namesOdefinedSets :: DefinedSets + _attrsOallFields :: DataTypes + _attrsOallNonterminals :: (Set NontermIdent) + _attrsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _altsOallConstructors :: (Map NontermIdent (Set ConstructorIdent)) + _altsOallNonterminals :: (Set NontermIdent) + _namesIcollectedNames :: (Set Identifier) + _namesIerrors :: (Seq Error) + _namesInontSet :: (Set NontermIdent) + _attrsIattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _attrsIerrors :: (Seq Error) + _attrsIuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _altsIcollectedConstructorNames :: (Set ConstructorIdent) + _altsIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + -- "Transform.ag"(line 158, column 10) + _altsOnts = + _namesInontSet + -- "Transform.ag"(line 437, column 11) + _lhsOcollectedConstructorsMap = + Map.fromList + [ (n, _altsIcollectedConstructorNames) + | n <- Set.toList _namesInontSet + ] + -- "Transform.ag"(line 698, column 7) + _lhsOparamsCollect = + if null params_ + then Map.empty + else Map.fromList [(nt, params_) | nt <- Set.toList _namesInontSet] + -- "Transform.ag"(line 721, column 7) + _lhsOctxCollect = + if null ctx_ + then Map.empty + else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet] + -- "Transform.ag"(line 764, column 10) + _attrsOnts = + _namesInontSet + -- use rule "Transform.ag"(line 662, column 55) + _lhsOattrOrderCollect = + Map.empty + -- use rule "Transform.ag"(line 42, column 19) + _lhsOblocks = + Map.empty + -- use rule "Transform.ag"(line 119, column 28) + _lhsOcollectedFields = + _altsIcollectedFields + -- use rule "Transform.ag"(line 144, column 31) + _lhsOcollectedInsts = + [] + -- use rule "Transform.ag"(line 80, column 50) + _lhsOcollectedNames = + _namesIcollectedNames + -- use rule "Transform.ag"(line 142, column 31) + _lhsOcollectedRules = + [] + -- use rule "Transform.ag"(line 79, column 50) + _lhsOcollectedSetNames = + Set.empty + -- use rule "Transform.ag"(line 143, column 31) + _lhsOcollectedSigs = + [] + -- use rule "Transform.ag"(line 145, column 31) + _lhsOcollectedUniques = + [] + -- use rule "Transform.ag"(line 742, column 33) + _lhsOderivings = + Map.empty + -- use rule "Transform.ag"(line 40, column 19) + _lhsOerrors = + _namesIerrors Seq.<> _attrsIerrors + -- use rule "Transform.ag"(line 894, column 37) + _lhsOmoduleDecl = + mzero + -- use rule "Transform.ag"(line 598, column 34) + _lhsOpragmas = + id + -- use rule "Transform.ag"(line 634, column 56) + _lhsOsemPragmasCollect = + Map.empty + -- use rule "Transform.ag"(line 458, column 32) + _lhsOtypeSyns = + [] + -- use rule "Transform.ag"(line 131, column 15) + _lhsOuseMap = + _attrsIuseMap + -- use rule "Transform.ag"(line 589, column 32) + _lhsOwrappers = + Set.empty + -- copy rule (up) + _lhsOattrDecls = + _attrsIattrDecls + -- copy rule (chain) + _lhsOdefSets = + _lhsIdefSets + -- copy rule (down) + _namesOallFields = + _lhsIallFields + -- copy rule (down) + _namesOallNonterminals = + _lhsIallNonterminals + -- copy rule (down) + _namesOdefinedSets = + _lhsIdefinedSets + -- copy rule (down) + _attrsOallFields = + _lhsIallFields + -- copy rule (down) + _attrsOallNonterminals = + _lhsIallNonterminals + -- copy rule (down) + _attrsOattrDecls = + _lhsIattrDecls + -- copy rule (down) + _altsOallConstructors = + _lhsIallConstructors + -- copy rule (down) + _altsOallNonterminals = + _lhsIallNonterminals + ( _namesIcollectedNames,_namesIerrors,_namesInontSet) = + (names_ _namesOallFields _namesOallNonterminals _namesOdefinedSets) + ( _attrsIattrDecls,_attrsIerrors,_attrsIuseMap) = + (attrs_ _attrsOallFields _attrsOallNonterminals _attrsOattrDecls _attrsOnts) + ( _altsIcollectedConstructorNames,_altsIcollectedFields) = + (alts_ _altsOallConstructors _altsOallNonterminals _altsOnts) + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) +sem_Elem_Deriving :: Pos -> + T_NontSet -> + ([NontermIdent]) -> + T_Elem +sem_Elem_Deriving pos_ (T_NontSet set_) classes_ = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIdefSets + _lhsIdefinedSets -> + (let _lhsOderivings :: Derivings + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedNames :: (Set Identifier) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSetNames :: (Set Identifier) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOctxCollect :: ContextMap + _lhsOerrors :: (Seq Error) + _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOparamsCollect :: ParamMap + _lhsOpragmas :: (Options -> Options) + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _setOallFields :: DataTypes + _setOallNonterminals :: (Set NontermIdent) + _setOdefinedSets :: DefinedSets + _setIcollectedNames :: (Set Identifier) + _setIerrors :: (Seq Error) + _setInontSet :: (Set NontermIdent) + -- "Transform.ag"(line 749, column 14) + _lhsOderivings = + Map.fromList [(nt,Set.fromList classes_) | nt <- Set.toList _setInontSet] + -- use rule "Transform.ag"(line 662, column 55) + _lhsOattrOrderCollect = + Map.empty + -- use rule "Transform.ag"(line 42, column 19) + _lhsOblocks = + Map.empty + -- use rule "Transform.ag"(line 88, column 48) + _lhsOcollectedConstructorsMap = + Map.empty + -- use rule "Transform.ag"(line 119, column 28) + _lhsOcollectedFields = + [] + -- use rule "Transform.ag"(line 144, column 31) + _lhsOcollectedInsts = + [] + -- use rule "Transform.ag"(line 80, column 50) + _lhsOcollectedNames = + _setIcollectedNames + -- use rule "Transform.ag"(line 142, column 31) + _lhsOcollectedRules = + [] + -- use rule "Transform.ag"(line 79, column 50) + _lhsOcollectedSetNames = + Set.empty + -- use rule "Transform.ag"(line 143, column 31) + _lhsOcollectedSigs = + [] + -- use rule "Transform.ag"(line 145, column 31) + _lhsOcollectedUniques = + [] + -- use rule "Transform.ag"(line 717, column 34) + _lhsOctxCollect = + Map.empty + -- use rule "Transform.ag"(line 40, column 19) + _lhsOerrors = + _setIerrors + -- use rule "Transform.ag"(line 894, column 37) + _lhsOmoduleDecl = + mzero + -- use rule "Transform.ag"(line 694, column 37) + _lhsOparamsCollect = + Map.empty + -- use rule "Transform.ag"(line 598, column 34) + _lhsOpragmas = + id + -- use rule "Transform.ag"(line 634, column 56) + _lhsOsemPragmasCollect = + Map.empty + -- use rule "Transform.ag"(line 458, column 32) + _lhsOtypeSyns = + [] + -- use rule "Transform.ag"(line 131, column 15) + _lhsOuseMap = + Map.empty + -- use rule "Transform.ag"(line 589, column 32) + _lhsOwrappers = + Set.empty + -- copy rule (chain) + _lhsOattrDecls = + _lhsIattrDecls + -- copy rule (chain) + _lhsOdefSets = + _lhsIdefSets + -- copy rule (down) + _setOallFields = + _lhsIallFields + -- copy rule (down) + _setOallNonterminals = + _lhsIallNonterminals + -- copy rule (down) + _setOdefinedSets = + _lhsIdefinedSets + ( _setIcollectedNames,_setIerrors,_setInontSet) = + (set_ _setOallFields _setOallNonterminals _setOdefinedSets) + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) +sem_Elem_Module :: Pos -> + String -> + String -> + String -> + T_Elem +sem_Elem_Module pos_ name_ exports_ imports_ = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIdefSets + _lhsIdefinedSets -> + (let _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedNames :: (Set Identifier) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSetNames :: (Set Identifier) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOctxCollect :: ContextMap + _lhsOderivings :: Derivings + _lhsOerrors :: (Seq Error) + _lhsOparamsCollect :: ParamMap + _lhsOpragmas :: (Options -> Options) + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + -- "Transform.ag"(line 898, column 7) + _lhsOmoduleDecl = + Just (name_, exports_, imports_) + -- use rule "Transform.ag"(line 662, column 55) + _lhsOattrOrderCollect = + Map.empty + -- use rule "Transform.ag"(line 42, column 19) + _lhsOblocks = + Map.empty + -- use rule "Transform.ag"(line 88, column 48) + _lhsOcollectedConstructorsMap = + Map.empty + -- use rule "Transform.ag"(line 119, column 28) + _lhsOcollectedFields = + [] + -- use rule "Transform.ag"(line 144, column 31) + _lhsOcollectedInsts = + [] + -- use rule "Transform.ag"(line 80, column 50) + _lhsOcollectedNames = + Set.empty + -- use rule "Transform.ag"(line 142, column 31) + _lhsOcollectedRules = + [] + -- use rule "Transform.ag"(line 79, column 50) + _lhsOcollectedSetNames = + Set.empty + -- use rule "Transform.ag"(line 143, column 31) + _lhsOcollectedSigs = + [] + -- use rule "Transform.ag"(line 145, column 31) + _lhsOcollectedUniques = + [] + -- use rule "Transform.ag"(line 717, column 34) + _lhsOctxCollect = + Map.empty + -- use rule "Transform.ag"(line 742, column 33) + _lhsOderivings = + Map.empty + -- use rule "Transform.ag"(line 40, column 19) + _lhsOerrors = + Seq.empty + -- use rule "Transform.ag"(line 694, column 37) + _lhsOparamsCollect = + Map.empty + -- use rule "Transform.ag"(line 598, column 34) + _lhsOpragmas = + id + -- use rule "Transform.ag"(line 634, column 56) + _lhsOsemPragmasCollect = + Map.empty + -- use rule "Transform.ag"(line 458, column 32) + _lhsOtypeSyns = + [] + -- use rule "Transform.ag"(line 131, column 15) + _lhsOuseMap = + Map.empty + -- use rule "Transform.ag"(line 589, column 32) + _lhsOwrappers = + Set.empty + -- copy rule (chain) + _lhsOattrDecls = + _lhsIattrDecls + -- copy rule (chain) + _lhsOdefSets = + _lhsIdefSets + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) +sem_Elem_Pragma :: Pos -> + ([NontermIdent]) -> + T_Elem +sem_Elem_Pragma pos_ names_ = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIdefSets + _lhsIdefinedSets -> + (let _lhsOpragmas :: (Options -> Options) + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedNames :: (Set Identifier) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSetNames :: (Set Identifier) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOctxCollect :: ContextMap + _lhsOderivings :: Derivings + _lhsOerrors :: (Seq Error) + _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOparamsCollect :: ParamMap + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + -- "Transform.ag"(line 601, column 13) + _lhsOpragmas = + let mk n o = case getName n of + "nocycle" -> o { withCycle = False } + "cycle" -> o { withCycle = True } + "nostrictdata" -> o { strictData = False } + "strictdata" -> o { strictData = True } + "nostrictcase" -> o { strictCases = False } + "strictcase" -> o { strictCases = True } + "strictercase" -> o { strictCases = True, stricterCases = True } + "nostrictwrap" -> o { strictWrap = False } + "strictwrap" -> o { strictWrap = True } + "novisit" -> o { visit = False } + "visit" -> o { visit = True } + "nocase" -> o { cases = False } + "case" -> o { cases = True } + "noseq" -> o { withSeq = False } + "seq" -> o { withSeq = True } + "nounbox" -> o { unbox = False } + "unbox" -> o { unbox = True } + "bangpats" -> o { bangpats = True } + "nooptimize" -> o { cases = False , visit = False } + "optimize" -> o { cases = True , visit = True } + "strictsem" -> o { strictSems = True } + "gentraces" -> o { genTraces = True } + "genusetraces" -> o { genUseTraces = True } + "splitsems" -> o { splitSems = True } + "gencostcentres" -> o { genCostCentres = True } + "sepsemmods" -> o { sepSemMods = True } + "genlinepragmas" -> o { genLinePragmas = True } + "newtypes" -> o { newtypes = True } + "nonewtypes" -> o { newtypes = False } + _ -> o + in \o -> foldr mk o names_ + -- use rule "Transform.ag"(line 662, column 55) + _lhsOattrOrderCollect = + Map.empty + -- use rule "Transform.ag"(line 42, column 19) + _lhsOblocks = + Map.empty + -- use rule "Transform.ag"(line 88, column 48) + _lhsOcollectedConstructorsMap = + Map.empty + -- use rule "Transform.ag"(line 119, column 28) + _lhsOcollectedFields = + [] + -- use rule "Transform.ag"(line 144, column 31) + _lhsOcollectedInsts = + [] + -- use rule "Transform.ag"(line 80, column 50) + _lhsOcollectedNames = + Set.empty + -- use rule "Transform.ag"(line 142, column 31) + _lhsOcollectedRules = + [] + -- use rule "Transform.ag"(line 79, column 50) + _lhsOcollectedSetNames = + Set.empty + -- use rule "Transform.ag"(line 143, column 31) + _lhsOcollectedSigs = + [] + -- use rule "Transform.ag"(line 145, column 31) + _lhsOcollectedUniques = + [] + -- use rule "Transform.ag"(line 717, column 34) + _lhsOctxCollect = + Map.empty + -- use rule "Transform.ag"(line 742, column 33) + _lhsOderivings = + Map.empty + -- use rule "Transform.ag"(line 40, column 19) + _lhsOerrors = + Seq.empty + -- use rule "Transform.ag"(line 894, column 37) + _lhsOmoduleDecl = + mzero + -- use rule "Transform.ag"(line 694, column 37) + _lhsOparamsCollect = + Map.empty + -- use rule "Transform.ag"(line 634, column 56) + _lhsOsemPragmasCollect = + Map.empty + -- use rule "Transform.ag"(line 458, column 32) + _lhsOtypeSyns = + [] + -- use rule "Transform.ag"(line 131, column 15) + _lhsOuseMap = + Map.empty + -- use rule "Transform.ag"(line 589, column 32) + _lhsOwrappers = + Set.empty + -- copy rule (chain) + _lhsOattrDecls = + _lhsIattrDecls + -- copy rule (chain) + _lhsOdefSets = + _lhsIdefSets + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) +sem_Elem_Sem :: Pos -> + ClassContext -> + T_NontSet -> + T_Attrs -> + T_SemAlts -> + T_Elem +sem_Elem_Sem pos_ ctx_ (T_NontSet names_) (T_Attrs attrs_) (T_SemAlts alts_) = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIdefSets + _lhsIdefinedSets -> + (let _altsOnts :: (Set NontermIdent) + _lhsOctxCollect :: ContextMap + _attrsOnts :: (Set NontermIdent) + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedNames :: (Set Identifier) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSetNames :: (Set Identifier) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOderivings :: Derivings + _lhsOerrors :: (Seq Error) + _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOparamsCollect :: ParamMap + _lhsOpragmas :: (Options -> Options) + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _namesOallFields :: DataTypes + _namesOallNonterminals :: (Set NontermIdent) + _namesOdefinedSets :: DefinedSets + _attrsOallFields :: DataTypes + _attrsOallNonterminals :: (Set NontermIdent) + _attrsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _altsOallAttrDecls :: (Map NontermIdent (Attributes, Attributes)) + _altsOallFields :: DataTypes + _namesIcollectedNames :: (Set Identifier) + _namesIerrors :: (Seq Error) + _namesInontSet :: (Set NontermIdent) + _attrsIattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _attrsIerrors :: (Seq Error) + _attrsIuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _altsIattrOrderCollect :: AttrOrderMap + _altsIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _altsIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _altsIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _altsIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _altsIerrors :: (Seq Error) + _altsIsemPragmasCollect :: PragmaMap + -- "Transform.ag"(line 159, column 10) + _altsOnts = + _namesInontSet + -- "Transform.ag"(line 721, column 7) + _lhsOctxCollect = + if null ctx_ + then Map.empty + else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet] + -- "Transform.ag"(line 766, column 10) + _attrsOnts = + _namesInontSet + -- use rule "Transform.ag"(line 662, column 55) + _lhsOattrOrderCollect = + _altsIattrOrderCollect + -- use rule "Transform.ag"(line 42, column 19) + _lhsOblocks = + Map.empty + -- use rule "Transform.ag"(line 88, column 48) + _lhsOcollectedConstructorsMap = + Map.empty + -- use rule "Transform.ag"(line 119, column 28) + _lhsOcollectedFields = + [] + -- use rule "Transform.ag"(line 144, column 31) + _lhsOcollectedInsts = + _altsIcollectedInsts + -- use rule "Transform.ag"(line 80, column 50) + _lhsOcollectedNames = + _namesIcollectedNames + -- use rule "Transform.ag"(line 142, column 31) + _lhsOcollectedRules = + _altsIcollectedRules + -- use rule "Transform.ag"(line 79, column 50) + _lhsOcollectedSetNames = + Set.empty + -- use rule "Transform.ag"(line 143, column 31) + _lhsOcollectedSigs = + _altsIcollectedSigs + -- use rule "Transform.ag"(line 145, column 31) + _lhsOcollectedUniques = + _altsIcollectedUniques + -- use rule "Transform.ag"(line 742, column 33) + _lhsOderivings = + Map.empty + -- use rule "Transform.ag"(line 40, column 19) + _lhsOerrors = + _namesIerrors Seq.<> _attrsIerrors Seq.<> _altsIerrors + -- use rule "Transform.ag"(line 894, column 37) + _lhsOmoduleDecl = + mzero + -- use rule "Transform.ag"(line 694, column 37) + _lhsOparamsCollect = + Map.empty + -- use rule "Transform.ag"(line 598, column 34) + _lhsOpragmas = + id + -- use rule "Transform.ag"(line 634, column 56) + _lhsOsemPragmasCollect = + _altsIsemPragmasCollect + -- use rule "Transform.ag"(line 458, column 32) + _lhsOtypeSyns = + [] + -- use rule "Transform.ag"(line 131, column 15) + _lhsOuseMap = + _attrsIuseMap + -- use rule "Transform.ag"(line 589, column 32) + _lhsOwrappers = + Set.empty + -- copy rule (up) + _lhsOattrDecls = + _attrsIattrDecls + -- copy rule (chain) + _lhsOdefSets = + _lhsIdefSets + -- copy rule (down) + _namesOallFields = + _lhsIallFields + -- copy rule (down) + _namesOallNonterminals = + _lhsIallNonterminals + -- copy rule (down) + _namesOdefinedSets = + _lhsIdefinedSets + -- copy rule (down) + _attrsOallFields = + _lhsIallFields + -- copy rule (down) + _attrsOallNonterminals = + _lhsIallNonterminals + -- copy rule (down) + _attrsOattrDecls = + _lhsIattrDecls + -- copy rule (down) + _altsOallAttrDecls = + _lhsIallAttrDecls + -- copy rule (down) + _altsOallFields = + _lhsIallFields + ( _namesIcollectedNames,_namesIerrors,_namesInontSet) = + (names_ _namesOallFields _namesOallNonterminals _namesOdefinedSets) + ( _attrsIattrDecls,_attrsIerrors,_attrsIuseMap) = + (attrs_ _attrsOallFields _attrsOallNonterminals _attrsOattrDecls _attrsOnts) + ( _altsIattrOrderCollect,_altsIcollectedInsts,_altsIcollectedRules,_altsIcollectedSigs,_altsIcollectedUniques,_altsIerrors,_altsIsemPragmasCollect) = + (alts_ _altsOallAttrDecls _altsOallFields _altsOnts) + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) +sem_Elem_Set :: Pos -> + NontermIdent -> + T_NontSet -> + T_Elem +sem_Elem_Set pos_ name_ (T_NontSet set_) = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIdefSets + _lhsIdefinedSets -> + (let _lhsOcollectedSetNames :: (Set Identifier) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _lhsOerrors :: (Seq Error) + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedNames :: (Set Identifier) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOctxCollect :: ContextMap + _lhsOderivings :: Derivings + _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOparamsCollect :: ParamMap + _lhsOpragmas :: (Options -> Options) + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _setOallFields :: DataTypes + _setOallNonterminals :: (Set NontermIdent) + _setOdefinedSets :: DefinedSets + _setIcollectedNames :: (Set Identifier) + _setIerrors :: (Seq Error) + _setInontSet :: (Set NontermIdent) + -- "Transform.ag"(line 414, column 10) + _lhsOcollectedSetNames = + Set.singleton name_ + -- "Transform.ag"(line 521, column 13) + __tup3 = + let allUsedNames = Set.unions [ maybe (Set.singleton n) + snd + (Map.lookup n _lhsIdefSets) + | n <- Set.toList _setIcollectedNames + ] + (nontSet,e1) | Set.member name_ allUsedNames + = (Set.empty, Seq.single(CyclicSet name_)) + | otherwise = (_setInontSet, Seq.empty) + (res, e2) = checkDuplicate DupSet name_ (nontSet,Set.insert name_ allUsedNames) _lhsIdefSets + in (res, e1 Seq.<> e2) + -- "Transform.ag"(line 521, column 13) + (_defSets2,_) = + __tup3 + -- "Transform.ag"(line 521, column 13) + (_,_errs) = + __tup3 + -- "Transform.ag"(line 531, column 9) + _lhsOdefSets = + _defSets2 + -- "Transform.ag"(line 531, column 9) + _lhsOerrors = + _errs <> _setIerrors + -- use rule "Transform.ag"(line 662, column 55) + _lhsOattrOrderCollect = + Map.empty + -- use rule "Transform.ag"(line 42, column 19) + _lhsOblocks = + Map.empty + -- use rule "Transform.ag"(line 88, column 48) + _lhsOcollectedConstructorsMap = + Map.empty + -- use rule "Transform.ag"(line 119, column 28) + _lhsOcollectedFields = + [] + -- use rule "Transform.ag"(line 144, column 31) + _lhsOcollectedInsts = + [] + -- use rule "Transform.ag"(line 80, column 50) + _lhsOcollectedNames = + _setIcollectedNames + -- use rule "Transform.ag"(line 142, column 31) + _lhsOcollectedRules = + [] + -- use rule "Transform.ag"(line 143, column 31) + _lhsOcollectedSigs = + [] + -- use rule "Transform.ag"(line 145, column 31) + _lhsOcollectedUniques = + [] + -- use rule "Transform.ag"(line 717, column 34) + _lhsOctxCollect = + Map.empty + -- use rule "Transform.ag"(line 742, column 33) + _lhsOderivings = + Map.empty + -- use rule "Transform.ag"(line 894, column 37) + _lhsOmoduleDecl = + mzero + -- use rule "Transform.ag"(line 694, column 37) + _lhsOparamsCollect = + Map.empty + -- use rule "Transform.ag"(line 598, column 34) + _lhsOpragmas = + id + -- use rule "Transform.ag"(line 634, column 56) + _lhsOsemPragmasCollect = + Map.empty + -- use rule "Transform.ag"(line 458, column 32) + _lhsOtypeSyns = + [] + -- use rule "Transform.ag"(line 131, column 15) + _lhsOuseMap = + Map.empty + -- use rule "Transform.ag"(line 589, column 32) + _lhsOwrappers = + Set.empty + -- copy rule (chain) + _lhsOattrDecls = + _lhsIattrDecls + -- copy rule (down) + _setOallFields = + _lhsIallFields + -- copy rule (down) + _setOallNonterminals = + _lhsIallNonterminals + -- copy rule (down) + _setOdefinedSets = + _lhsIdefinedSets + ( _setIcollectedNames,_setIerrors,_setInontSet) = + (set_ _setOallFields _setOallNonterminals _setOdefinedSets) + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) +sem_Elem_Txt :: Pos -> + Identifier -> + (Maybe NontermIdent) -> + ([String]) -> + T_Elem +sem_Elem_Txt pos_ name_ mbNt_ lines_ = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIdefSets + _lhsIdefinedSets -> + (let _lhsOblocks :: Blocks + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedNames :: (Set Identifier) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSetNames :: (Set Identifier) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOctxCollect :: ContextMap + _lhsOderivings :: Derivings + _lhsOerrors :: (Seq Error) + _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOparamsCollect :: ParamMap + _lhsOpragmas :: (Options -> Options) + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + -- "Transform.ag"(line 168, column 10) + _blockInfo = + ( let nm = getName name_ + in if nm == "imports" + then BlockImport + else if nm == "optpragmas" + then BlockPragma + else BlockOther + , mbNt_ + ) + -- "Transform.ag"(line 176, column 10) + _blockValue = + [(lines_, pos_)] + -- "Transform.ag"(line 177, column 10) + _lhsOblocks = + Map.singleton _blockInfo _blockValue + -- use rule "Transform.ag"(line 662, column 55) + _lhsOattrOrderCollect = + Map.empty + -- use rule "Transform.ag"(line 88, column 48) + _lhsOcollectedConstructorsMap = + Map.empty + -- use rule "Transform.ag"(line 119, column 28) + _lhsOcollectedFields = + [] + -- use rule "Transform.ag"(line 144, column 31) + _lhsOcollectedInsts = + [] + -- use rule "Transform.ag"(line 80, column 50) + _lhsOcollectedNames = + Set.empty + -- use rule "Transform.ag"(line 142, column 31) + _lhsOcollectedRules = + [] + -- use rule "Transform.ag"(line 79, column 50) + _lhsOcollectedSetNames = + Set.empty + -- use rule "Transform.ag"(line 143, column 31) + _lhsOcollectedSigs = + [] + -- use rule "Transform.ag"(line 145, column 31) + _lhsOcollectedUniques = + [] + -- use rule "Transform.ag"(line 717, column 34) + _lhsOctxCollect = + Map.empty + -- use rule "Transform.ag"(line 742, column 33) + _lhsOderivings = + Map.empty + -- use rule "Transform.ag"(line 40, column 19) + _lhsOerrors = + Seq.empty + -- use rule "Transform.ag"(line 894, column 37) + _lhsOmoduleDecl = + mzero + -- use rule "Transform.ag"(line 694, column 37) + _lhsOparamsCollect = + Map.empty + -- use rule "Transform.ag"(line 598, column 34) + _lhsOpragmas = + id + -- use rule "Transform.ag"(line 634, column 56) + _lhsOsemPragmasCollect = + Map.empty + -- use rule "Transform.ag"(line 458, column 32) + _lhsOtypeSyns = + [] + -- use rule "Transform.ag"(line 131, column 15) + _lhsOuseMap = + Map.empty + -- use rule "Transform.ag"(line 589, column 32) + _lhsOwrappers = + Set.empty + -- copy rule (chain) + _lhsOattrDecls = + _lhsIattrDecls + -- copy rule (chain) + _lhsOdefSets = + _lhsIdefSets + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) +sem_Elem_Type :: Pos -> + ClassContext -> + NontermIdent -> + ([Identifier]) -> + ComplexType -> + T_Elem +sem_Elem_Type pos_ ctx_ name_ params_ type_ = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIdefSets + _lhsIdefinedSets -> + (let _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedNames :: (Set Identifier) + _lhsOtypeSyns :: TypeSyns + _lhsOparamsCollect :: ParamMap + _lhsOctxCollect :: ContextMap + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSetNames :: (Set Identifier) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOderivings :: Derivings + _lhsOerrors :: (Seq Error) + _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOpragmas :: (Options -> Options) + _lhsOsemPragmasCollect :: PragmaMap + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + -- "Transform.ag"(line 230, column 10) + _lhsOcollectedFields = + map (\(x,y)->(name_, x, y)) _expanded + -- "Transform.ag"(line 417, column 11) + _lhsOcollectedNames = + Set.singleton name_ + -- "Transform.ag"(line 471, column 11) + _expanded = + case _argType of + List tp -> [(Ident "Cons" pos_, [(Ident "hd" pos_, tp) + ,(Ident "tl" pos_, NT name_ (map getName params_)) + ] + ) + ,(Ident "Nil" pos_, []) + ] + Maybe tp -> [(Ident "Just" pos_, [(Ident "just" pos_, tp) + ] + ) + ,(Ident "Nothing" pos_, []) + ] + Either tp1 tp2 -> [ + (Ident "Left" pos_, [(Ident "left" pos_, tp1) ]) + , (Ident "Right" pos_, [(Ident "right" pos_, tp2) ]) + ] + Map tp1 tp2 -> [ (Ident "Entry" pos_, [ (Ident "key" pos_, tp1) + , (Ident "val" pos_, tp2) + , (Ident "tl" pos_, NT name_ (map getName params_)) + ]) + , (Ident "Nil" pos_, []) + ] + IntMap tp -> [ (Ident "Entry" pos_, [ (Ident "key" pos_, Haskell "Int") + , (Ident "val" pos_, tp) + , (Ident "tl" pos_, NT name_ (map getName params_)) + ]) + , (Ident "Nil" pos_, []) + ] + Tuple xs -> [(Ident "Tuple" pos_, xs)] + -- "Transform.ag"(line 500, column 11) + _argType = + case type_ of + Maybe tp -> Maybe ( makeType _lhsIallNonterminals tp) + Either tp1 tp2 -> Either ( makeType _lhsIallNonterminals tp1) (makeType _lhsIallNonterminals tp2) + List tp -> List ( makeType _lhsIallNonterminals tp) + Tuple xs -> Tuple [(f,makeType _lhsIallNonterminals tp) | (f,tp) <- xs] + Map tp1 tp2 -> Map ( makeType _lhsIallNonterminals tp1) (makeType _lhsIallNonterminals tp2) + IntMap tp -> IntMap ( makeType _lhsIallNonterminals tp) + -- "Transform.ag"(line 507, column 11) + _lhsOtypeSyns = + [(name_,_argType)] + -- "Transform.ag"(line 704, column 7) + _lhsOparamsCollect = + if null params_ + then Map.empty + else Map.singleton name_ params_ + -- "Transform.ag"(line 727, column 7) + _lhsOctxCollect = + if null ctx_ + then Map.empty + else Map.singleton name_ ctx_ + -- use rule "Transform.ag"(line 662, column 55) + _lhsOattrOrderCollect = + Map.empty + -- use rule "Transform.ag"(line 42, column 19) + _lhsOblocks = + Map.empty + -- use rule "Transform.ag"(line 88, column 48) + _lhsOcollectedConstructorsMap = + Map.empty + -- use rule "Transform.ag"(line 144, column 31) + _lhsOcollectedInsts = + [] + -- use rule "Transform.ag"(line 142, column 31) + _lhsOcollectedRules = + [] + -- use rule "Transform.ag"(line 79, column 50) + _lhsOcollectedSetNames = + Set.empty + -- use rule "Transform.ag"(line 143, column 31) + _lhsOcollectedSigs = + [] + -- use rule "Transform.ag"(line 145, column 31) + _lhsOcollectedUniques = + [] + -- use rule "Transform.ag"(line 742, column 33) + _lhsOderivings = + Map.empty + -- use rule "Transform.ag"(line 40, column 19) + _lhsOerrors = + Seq.empty + -- use rule "Transform.ag"(line 894, column 37) + _lhsOmoduleDecl = + mzero + -- use rule "Transform.ag"(line 598, column 34) + _lhsOpragmas = + id + -- use rule "Transform.ag"(line 634, column 56) + _lhsOsemPragmasCollect = + Map.empty + -- use rule "Transform.ag"(line 131, column 15) + _lhsOuseMap = + Map.empty + -- use rule "Transform.ag"(line 589, column 32) + _lhsOwrappers = + Set.empty + -- copy rule (chain) + _lhsOattrDecls = + _lhsIattrDecls + -- copy rule (chain) + _lhsOdefSets = + _lhsIdefSets + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) +sem_Elem_Wrapper :: Pos -> + T_NontSet -> + T_Elem +sem_Elem_Wrapper pos_ (T_NontSet set_) = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIdefSets + _lhsIdefinedSets -> + (let _lhsOwrappers :: (Set NontermIdent) + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedNames :: (Set Identifier) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSetNames :: (Set Identifier) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOctxCollect :: ContextMap + _lhsOderivings :: Derivings + _lhsOerrors :: (Seq Error) + _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOparamsCollect :: ParamMap + _lhsOpragmas :: (Options -> Options) + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _setOallFields :: DataTypes + _setOallNonterminals :: (Set NontermIdent) + _setOdefinedSets :: DefinedSets + _setIcollectedNames :: (Set Identifier) + _setIerrors :: (Seq Error) + _setInontSet :: (Set NontermIdent) + -- "Transform.ag"(line 592, column 13) + _lhsOwrappers = + _setInontSet + -- use rule "Transform.ag"(line 662, column 55) + _lhsOattrOrderCollect = + Map.empty + -- use rule "Transform.ag"(line 42, column 19) + _lhsOblocks = + Map.empty + -- use rule "Transform.ag"(line 88, column 48) + _lhsOcollectedConstructorsMap = + Map.empty + -- use rule "Transform.ag"(line 119, column 28) + _lhsOcollectedFields = + [] + -- use rule "Transform.ag"(line 144, column 31) + _lhsOcollectedInsts = + [] + -- use rule "Transform.ag"(line 80, column 50) + _lhsOcollectedNames = + _setIcollectedNames + -- use rule "Transform.ag"(line 142, column 31) + _lhsOcollectedRules = + [] + -- use rule "Transform.ag"(line 79, column 50) + _lhsOcollectedSetNames = + Set.empty + -- use rule "Transform.ag"(line 143, column 31) + _lhsOcollectedSigs = + [] + -- use rule "Transform.ag"(line 145, column 31) + _lhsOcollectedUniques = + [] + -- use rule "Transform.ag"(line 717, column 34) + _lhsOctxCollect = + Map.empty + -- use rule "Transform.ag"(line 742, column 33) + _lhsOderivings = + Map.empty + -- use rule "Transform.ag"(line 40, column 19) + _lhsOerrors = + _setIerrors + -- use rule "Transform.ag"(line 894, column 37) + _lhsOmoduleDecl = + mzero + -- use rule "Transform.ag"(line 694, column 37) + _lhsOparamsCollect = + Map.empty + -- use rule "Transform.ag"(line 598, column 34) + _lhsOpragmas = + id + -- use rule "Transform.ag"(line 634, column 56) + _lhsOsemPragmasCollect = + Map.empty + -- use rule "Transform.ag"(line 458, column 32) + _lhsOtypeSyns = + [] + -- use rule "Transform.ag"(line 131, column 15) + _lhsOuseMap = + Map.empty + -- copy rule (chain) + _lhsOattrDecls = + _lhsIattrDecls + -- copy rule (chain) + _lhsOdefSets = + _lhsIdefSets + -- copy rule (down) + _setOallFields = + _lhsIallFields + -- copy rule (down) + _setOallNonterminals = + _lhsIallNonterminals + -- copy rule (down) + _setOdefinedSets = + _lhsIdefinedSets + ( _setIcollectedNames,_setIerrors,_setInontSet) = + (set_ _setOallFields _setOallNonterminals _setOdefinedSets) + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) +-- Elems ------------------------------------------------------- +{- + visit 0: + inherited attributes: + allAttrDecls : Map NontermIdent (Attributes, Attributes) + allConstructors : Map NontermIdent (Set ConstructorIdent) + allFields : DataTypes + allNonterminals : Set NontermIdent + definedSets : DefinedSets + chained attributes: + attrDecls : Map NontermIdent (Attributes, Attributes) + defSets : Map Identifier (Set NontermIdent,Set Identifier) + synthesized attributes: + attrOrderCollect : AttrOrderMap + blocks : Blocks + collectedConstructorsMap : Map NontermIdent (Set ConstructorIdent) + collectedFields : [(NontermIdent, ConstructorIdent, FieldMap)] + collectedInsts : [ (NontermIdent, ConstructorIdent, [Identifier]) ] + collectedNames : Set Identifier + collectedRules : [ (NontermIdent, ConstructorIdent, RuleInfo)] + collectedSetNames : Set Identifier + collectedSigs : [ (NontermIdent, ConstructorIdent, SigInfo) ] + collectedUniques : [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ] + ctxCollect : ContextMap + derivings : Derivings + errors : Seq Error + moduleDecl : Maybe (String,String,String) + paramsCollect : ParamMap + pragmas : Options -> Options + semPragmasCollect : PragmaMap + typeSyns : TypeSyns + useMap : Map NontermIdent (Map Identifier (String,String,String)) + wrappers : Set NontermIdent + alternatives: + alternative Cons: + child hd : Elem + child tl : Elems + alternative Nil: +-} +-- cata +sem_Elems :: Elems -> + T_Elems +sem_Elems list = + (Prelude.foldr sem_Elems_Cons sem_Elems_Nil (Prelude.map sem_Elem list)) +-- semantic domain +newtype T_Elems = T_Elems ((Map NontermIdent (Attributes, Attributes)) -> + (Map NontermIdent (Set ConstructorIdent)) -> + DataTypes -> + (Set NontermIdent) -> + (Map NontermIdent (Attributes, Attributes)) -> + (Map Identifier (Set NontermIdent,Set Identifier)) -> + DefinedSets -> + ( (Map NontermIdent (Attributes, Attributes)),AttrOrderMap,Blocks,(Map NontermIdent (Set ConstructorIdent)),([(NontermIdent, ConstructorIdent, FieldMap)]),([ (NontermIdent, ConstructorIdent, [Identifier]) ]),(Set Identifier),([ (NontermIdent, ConstructorIdent, RuleInfo)]),(Set Identifier),([ (NontermIdent, ConstructorIdent, SigInfo) ]),([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),ContextMap,(Map Identifier (Set NontermIdent,Set Identifier)),Derivings,(Seq Error),(Maybe (String,String,String)),ParamMap,(Options -> Options),PragmaMap,TypeSyns,(Map NontermIdent (Map Identifier (String,String,String))),(Set NontermIdent))) +data Inh_Elems = Inh_Elems {allAttrDecls_Inh_Elems :: !(Map NontermIdent (Attributes, Attributes)),allConstructors_Inh_Elems :: !(Map NontermIdent (Set ConstructorIdent)),allFields_Inh_Elems :: !(DataTypes),allNonterminals_Inh_Elems :: !(Set NontermIdent),attrDecls_Inh_Elems :: !(Map NontermIdent (Attributes, Attributes)),defSets_Inh_Elems :: !(Map Identifier (Set NontermIdent,Set Identifier)),definedSets_Inh_Elems :: !(DefinedSets)} +data Syn_Elems = Syn_Elems {attrDecls_Syn_Elems :: !(Map NontermIdent (Attributes, Attributes)),attrOrderCollect_Syn_Elems :: !(AttrOrderMap),blocks_Syn_Elems :: !(Blocks),collectedConstructorsMap_Syn_Elems :: !(Map NontermIdent (Set ConstructorIdent)),collectedFields_Syn_Elems :: !([(NontermIdent, ConstructorIdent, FieldMap)]),collectedInsts_Syn_Elems :: !([ (NontermIdent, ConstructorIdent, [Identifier]) ]),collectedNames_Syn_Elems :: !(Set Identifier),collectedRules_Syn_Elems :: !([ (NontermIdent, ConstructorIdent, RuleInfo)]),collectedSetNames_Syn_Elems :: !(Set Identifier),collectedSigs_Syn_Elems :: !([ (NontermIdent, ConstructorIdent, SigInfo) ]),collectedUniques_Syn_Elems :: !([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),ctxCollect_Syn_Elems :: !(ContextMap),defSets_Syn_Elems :: !(Map Identifier (Set NontermIdent,Set Identifier)),derivings_Syn_Elems :: !(Derivings),errors_Syn_Elems :: !(Seq Error),moduleDecl_Syn_Elems :: !(Maybe (String,String,String)),paramsCollect_Syn_Elems :: !(ParamMap),pragmas_Syn_Elems :: !(Options -> Options),semPragmasCollect_Syn_Elems :: !(PragmaMap),typeSyns_Syn_Elems :: !(TypeSyns),useMap_Syn_Elems :: !(Map NontermIdent (Map Identifier (String,String,String))),wrappers_Syn_Elems :: !(Set NontermIdent)} +wrap_Elems (T_Elems sem) (Inh_Elems _lhsIallAttrDecls _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIdefSets _lhsIdefinedSets) = + (let ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers) = + (sem _lhsIallAttrDecls _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIdefSets _lhsIdefinedSets) + in (Syn_Elems _lhsOattrDecls _lhsOattrOrderCollect _lhsOblocks _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOcollectedUniques _lhsOctxCollect _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOparamsCollect _lhsOpragmas _lhsOsemPragmasCollect _lhsOtypeSyns _lhsOuseMap _lhsOwrappers)) +sem_Elems_Cons :: T_Elem -> + T_Elems -> + T_Elems +sem_Elems_Cons (T_Elem hd_) (T_Elems tl_) = + (T_Elems (\ _lhsIallAttrDecls + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIdefSets + _lhsIdefinedSets -> + (let _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedNames :: (Set Identifier) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSetNames :: (Set Identifier) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOctxCollect :: ContextMap + _lhsOderivings :: Derivings + _lhsOerrors :: (Seq Error) + _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOparamsCollect :: ParamMap + _lhsOpragmas :: (Options -> Options) + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _hdOallAttrDecls :: (Map NontermIdent (Attributes, Attributes)) + _hdOallConstructors :: (Map NontermIdent (Set ConstructorIdent)) + _hdOallFields :: DataTypes + _hdOallNonterminals :: (Set NontermIdent) + _hdOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _hdOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _hdOdefinedSets :: DefinedSets + _tlOallAttrDecls :: (Map NontermIdent (Attributes, Attributes)) + _tlOallConstructors :: (Map NontermIdent (Set ConstructorIdent)) + _tlOallFields :: DataTypes + _tlOallNonterminals :: (Set NontermIdent) + _tlOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _tlOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _tlOdefinedSets :: DefinedSets + _hdIattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _hdIattrOrderCollect :: AttrOrderMap + _hdIblocks :: Blocks + _hdIcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _hdIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _hdIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _hdIcollectedNames :: (Set Identifier) + _hdIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _hdIcollectedSetNames :: (Set Identifier) + _hdIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _hdIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _hdIctxCollect :: ContextMap + _hdIdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _hdIderivings :: Derivings + _hdIerrors :: (Seq Error) + _hdImoduleDecl :: (Maybe (String,String,String)) + _hdIparamsCollect :: ParamMap + _hdIpragmas :: (Options -> Options) + _hdIsemPragmasCollect :: PragmaMap + _hdItypeSyns :: TypeSyns + _hdIuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _hdIwrappers :: (Set NontermIdent) + _tlIattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _tlIattrOrderCollect :: AttrOrderMap + _tlIblocks :: Blocks + _tlIcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _tlIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _tlIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _tlIcollectedNames :: (Set Identifier) + _tlIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _tlIcollectedSetNames :: (Set Identifier) + _tlIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _tlIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _tlIctxCollect :: ContextMap + _tlIdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _tlIderivings :: Derivings + _tlIerrors :: (Seq Error) + _tlImoduleDecl :: (Maybe (String,String,String)) + _tlIparamsCollect :: ParamMap + _tlIpragmas :: (Options -> Options) + _tlIsemPragmasCollect :: PragmaMap + _tlItypeSyns :: TypeSyns + _tlIuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _tlIwrappers :: (Set NontermIdent) + -- use rule "Transform.ag"(line 662, column 55) + _lhsOattrOrderCollect = + _hdIattrOrderCollect `orderMapUnion` _tlIattrOrderCollect + -- use rule "Transform.ag"(line 42, column 19) + _lhsOblocks = + _hdIblocks `mapUnionWithPlusPlus` _tlIblocks + -- use rule "Transform.ag"(line 88, column 48) + _lhsOcollectedConstructorsMap = + _hdIcollectedConstructorsMap `mapUnionWithSetUnion` _tlIcollectedConstructorsMap + -- use rule "Transform.ag"(line 119, column 28) + _lhsOcollectedFields = + _hdIcollectedFields ++ _tlIcollectedFields + -- use rule "Transform.ag"(line 144, column 31) + _lhsOcollectedInsts = + _hdIcollectedInsts ++ _tlIcollectedInsts + -- use rule "Transform.ag"(line 80, column 50) + _lhsOcollectedNames = + _hdIcollectedNames `Set.union` _tlIcollectedNames + -- use rule "Transform.ag"(line 142, column 31) + _lhsOcollectedRules = + _hdIcollectedRules ++ _tlIcollectedRules + -- use rule "Transform.ag"(line 79, column 50) + _lhsOcollectedSetNames = + _hdIcollectedSetNames `Set.union` _tlIcollectedSetNames + -- use rule "Transform.ag"(line 143, column 31) + _lhsOcollectedSigs = + _hdIcollectedSigs ++ _tlIcollectedSigs + -- use rule "Transform.ag"(line 145, column 31) + _lhsOcollectedUniques = + _hdIcollectedUniques ++ _tlIcollectedUniques + -- use rule "Transform.ag"(line 717, column 34) + _lhsOctxCollect = + _hdIctxCollect `mergeCtx` _tlIctxCollect + -- use rule "Transform.ag"(line 742, column 33) + _lhsOderivings = + _hdIderivings `mergeDerivings` _tlIderivings + -- use rule "Transform.ag"(line 40, column 19) + _lhsOerrors = + _hdIerrors Seq.<> _tlIerrors + -- use rule "Transform.ag"(line 894, column 37) + _lhsOmoduleDecl = + _hdImoduleDecl `mplus` _tlImoduleDecl + -- use rule "Transform.ag"(line 694, column 37) + _lhsOparamsCollect = + _hdIparamsCollect `mergeParams` _tlIparamsCollect + -- use rule "Transform.ag"(line 598, column 34) + _lhsOpragmas = + _hdIpragmas . _tlIpragmas + -- use rule "Transform.ag"(line 634, column 56) + _lhsOsemPragmasCollect = + _hdIsemPragmasCollect `pragmaMapUnion` _tlIsemPragmasCollect + -- use rule "Transform.ag"(line 458, column 32) + _lhsOtypeSyns = + _hdItypeSyns ++ _tlItypeSyns + -- use rule "Transform.ag"(line 131, column 15) + _lhsOuseMap = + _hdIuseMap `merge` _tlIuseMap + -- use rule "Transform.ag"(line 589, column 32) + _lhsOwrappers = + _hdIwrappers `Set.union` _tlIwrappers + -- copy rule (up) + _lhsOattrDecls = + _tlIattrDecls + -- copy rule (up) + _lhsOdefSets = + _tlIdefSets + -- copy rule (down) + _hdOallAttrDecls = + _lhsIallAttrDecls + -- copy rule (down) + _hdOallConstructors = + _lhsIallConstructors + -- copy rule (down) + _hdOallFields = + _lhsIallFields + -- copy rule (down) + _hdOallNonterminals = + _lhsIallNonterminals + -- copy rule (down) + _hdOattrDecls = + _lhsIattrDecls + -- copy rule (down) + _hdOdefSets = + _lhsIdefSets + -- copy rule (down) + _hdOdefinedSets = + _lhsIdefinedSets + -- copy rule (down) + _tlOallAttrDecls = + _lhsIallAttrDecls + -- copy rule (down) + _tlOallConstructors = + _lhsIallConstructors + -- copy rule (down) + _tlOallFields = + _lhsIallFields + -- copy rule (down) + _tlOallNonterminals = + _lhsIallNonterminals + -- copy rule (chain) + _tlOattrDecls = + _hdIattrDecls + -- copy rule (chain) + _tlOdefSets = + _hdIdefSets + -- copy rule (down) + _tlOdefinedSets = + _lhsIdefinedSets + ( _hdIattrDecls,_hdIattrOrderCollect,_hdIblocks,_hdIcollectedConstructorsMap,_hdIcollectedFields,_hdIcollectedInsts,_hdIcollectedNames,_hdIcollectedRules,_hdIcollectedSetNames,_hdIcollectedSigs,_hdIcollectedUniques,_hdIctxCollect,_hdIdefSets,_hdIderivings,_hdIerrors,_hdImoduleDecl,_hdIparamsCollect,_hdIpragmas,_hdIsemPragmasCollect,_hdItypeSyns,_hdIuseMap,_hdIwrappers) = + (hd_ _hdOallAttrDecls _hdOallConstructors _hdOallFields _hdOallNonterminals _hdOattrDecls _hdOdefSets _hdOdefinedSets) + ( _tlIattrDecls,_tlIattrOrderCollect,_tlIblocks,_tlIcollectedConstructorsMap,_tlIcollectedFields,_tlIcollectedInsts,_tlIcollectedNames,_tlIcollectedRules,_tlIcollectedSetNames,_tlIcollectedSigs,_tlIcollectedUniques,_tlIctxCollect,_tlIdefSets,_tlIderivings,_tlIerrors,_tlImoduleDecl,_tlIparamsCollect,_tlIpragmas,_tlIsemPragmasCollect,_tlItypeSyns,_tlIuseMap,_tlIwrappers) = + (tl_ _tlOallAttrDecls _tlOallConstructors _tlOallFields _tlOallNonterminals _tlOattrDecls _tlOdefSets _tlOdefinedSets) + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) +sem_Elems_Nil :: T_Elems +sem_Elems_Nil = + (T_Elems (\ _lhsIallAttrDecls + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIdefSets + _lhsIdefinedSets -> + (let _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedNames :: (Set Identifier) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSetNames :: (Set Identifier) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOctxCollect :: ContextMap + _lhsOderivings :: Derivings + _lhsOerrors :: (Seq Error) + _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOparamsCollect :: ParamMap + _lhsOpragmas :: (Options -> Options) + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + -- use rule "Transform.ag"(line 662, column 55) + _lhsOattrOrderCollect = + Map.empty + -- use rule "Transform.ag"(line 42, column 19) + _lhsOblocks = + Map.empty + -- use rule "Transform.ag"(line 88, column 48) + _lhsOcollectedConstructorsMap = + Map.empty + -- use rule "Transform.ag"(line 119, column 28) + _lhsOcollectedFields = + [] + -- use rule "Transform.ag"(line 144, column 31) + _lhsOcollectedInsts = + [] + -- use rule "Transform.ag"(line 80, column 50) + _lhsOcollectedNames = + Set.empty + -- use rule "Transform.ag"(line 142, column 31) + _lhsOcollectedRules = + [] + -- use rule "Transform.ag"(line 79, column 50) + _lhsOcollectedSetNames = + Set.empty + -- use rule "Transform.ag"(line 143, column 31) + _lhsOcollectedSigs = + [] + -- use rule "Transform.ag"(line 145, column 31) + _lhsOcollectedUniques = + [] + -- use rule "Transform.ag"(line 717, column 34) + _lhsOctxCollect = + Map.empty + -- use rule "Transform.ag"(line 742, column 33) + _lhsOderivings = + Map.empty + -- use rule "Transform.ag"(line 40, column 19) + _lhsOerrors = + Seq.empty + -- use rule "Transform.ag"(line 894, column 37) + _lhsOmoduleDecl = + mzero + -- use rule "Transform.ag"(line 694, column 37) + _lhsOparamsCollect = + Map.empty + -- use rule "Transform.ag"(line 598, column 34) + _lhsOpragmas = + id + -- use rule "Transform.ag"(line 634, column 56) + _lhsOsemPragmasCollect = + Map.empty + -- use rule "Transform.ag"(line 458, column 32) + _lhsOtypeSyns = + [] + -- use rule "Transform.ag"(line 131, column 15) + _lhsOuseMap = + Map.empty + -- use rule "Transform.ag"(line 589, column 32) + _lhsOwrappers = + Set.empty + -- copy rule (chain) + _lhsOattrDecls = + _lhsIattrDecls + -- copy rule (chain) + _lhsOdefSets = + _lhsIdefSets + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOblocks,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) +-- NontSet ----------------------------------------------------- +{- + visit 0: + inherited attributes: + allFields : DataTypes + allNonterminals : Set NontermIdent + definedSets : DefinedSets + synthesized attributes: + collectedNames : Set Identifier + errors : Seq Error + nontSet : Set NontermIdent + alternatives: + alternative All: + alternative Difference: + child set1 : NontSet + child set2 : NontSet + alternative Intersect: + child set1 : NontSet + child set2 : NontSet + alternative NamedSet: + child name : {NontermIdent} + visit 0: + local _tup4 : _ + local nontSet : _ + local errors : _ + alternative Path: + child from : {NontermIdent} + child to : {NontermIdent} + alternative Union: + child set1 : NontSet + child set2 : NontSet +-} +-- cata +sem_NontSet :: NontSet -> + T_NontSet +sem_NontSet (All ) = + (sem_NontSet_All ) +sem_NontSet (Difference _set1 _set2) = + (sem_NontSet_Difference (sem_NontSet _set1) (sem_NontSet _set2)) +sem_NontSet (Intersect _set1 _set2) = + (sem_NontSet_Intersect (sem_NontSet _set1) (sem_NontSet _set2)) +sem_NontSet (NamedSet _name) = + (sem_NontSet_NamedSet _name) +sem_NontSet (Path _from _to) = + (sem_NontSet_Path _from _to) +sem_NontSet (Union _set1 _set2) = + (sem_NontSet_Union (sem_NontSet _set1) (sem_NontSet _set2)) +-- semantic domain +newtype T_NontSet = T_NontSet (DataTypes -> + (Set NontermIdent) -> + DefinedSets -> + ( (Set Identifier),(Seq Error),(Set NontermIdent))) +data Inh_NontSet = Inh_NontSet {allFields_Inh_NontSet :: !(DataTypes),allNonterminals_Inh_NontSet :: !(Set NontermIdent),definedSets_Inh_NontSet :: !(DefinedSets)} +data Syn_NontSet = Syn_NontSet {collectedNames_Syn_NontSet :: !(Set Identifier),errors_Syn_NontSet :: !(Seq Error),nontSet_Syn_NontSet :: !(Set NontermIdent)} +wrap_NontSet (T_NontSet sem) (Inh_NontSet _lhsIallFields _lhsIallNonterminals _lhsIdefinedSets) = + (let ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet) = + (sem _lhsIallFields _lhsIallNonterminals _lhsIdefinedSets) + in (Syn_NontSet _lhsOcollectedNames _lhsOerrors _lhsOnontSet)) +sem_NontSet_All :: T_NontSet +sem_NontSet_All = + (T_NontSet (\ _lhsIallFields + _lhsIallNonterminals + _lhsIdefinedSets -> + (let _lhsOnontSet :: (Set NontermIdent) + _lhsOcollectedNames :: (Set Identifier) + _lhsOerrors :: (Seq Error) + -- "Transform.ag"(line 535, column 16) + _lhsOnontSet = + _lhsIallNonterminals + -- use rule "Transform.ag"(line 80, column 50) + _lhsOcollectedNames = + Set.empty + -- use rule "Transform.ag"(line 40, column 19) + _lhsOerrors = + Seq.empty + in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet)))) +sem_NontSet_Difference :: T_NontSet -> + T_NontSet -> + T_NontSet +sem_NontSet_Difference (T_NontSet set1_) (T_NontSet set2_) = + (T_NontSet (\ _lhsIallFields + _lhsIallNonterminals + _lhsIdefinedSets -> + (let _lhsOnontSet :: (Set NontermIdent) + _lhsOcollectedNames :: (Set Identifier) + _lhsOerrors :: (Seq Error) + _set1OallFields :: DataTypes + _set1OallNonterminals :: (Set NontermIdent) + _set1OdefinedSets :: DefinedSets + _set2OallFields :: DataTypes + _set2OallNonterminals :: (Set NontermIdent) + _set2OdefinedSets :: DefinedSets + _set1IcollectedNames :: (Set Identifier) + _set1Ierrors :: (Seq Error) + _set1InontSet :: (Set NontermIdent) + _set2IcollectedNames :: (Set Identifier) + _set2Ierrors :: (Seq Error) + _set2InontSet :: (Set NontermIdent) + -- "Transform.ag"(line 541, column 16) + _lhsOnontSet = + Set.difference _set1InontSet _set2InontSet + -- use rule "Transform.ag"(line 80, column 50) + _lhsOcollectedNames = + _set1IcollectedNames `Set.union` _set2IcollectedNames + -- use rule "Transform.ag"(line 40, column 19) + _lhsOerrors = + _set1Ierrors Seq.<> _set2Ierrors + -- copy rule (down) + _set1OallFields = + _lhsIallFields + -- copy rule (down) + _set1OallNonterminals = + _lhsIallNonterminals + -- copy rule (down) + _set1OdefinedSets = + _lhsIdefinedSets + -- copy rule (down) + _set2OallFields = + _lhsIallFields + -- copy rule (down) + _set2OallNonterminals = + _lhsIallNonterminals + -- copy rule (down) + _set2OdefinedSets = + _lhsIdefinedSets + ( _set1IcollectedNames,_set1Ierrors,_set1InontSet) = + (set1_ _set1OallFields _set1OallNonterminals _set1OdefinedSets) + ( _set2IcollectedNames,_set2Ierrors,_set2InontSet) = + (set2_ _set2OallFields _set2OallNonterminals _set2OdefinedSets) + in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet)))) +sem_NontSet_Intersect :: T_NontSet -> + T_NontSet -> + T_NontSet +sem_NontSet_Intersect (T_NontSet set1_) (T_NontSet set2_) = + (T_NontSet (\ _lhsIallFields + _lhsIallNonterminals + _lhsIdefinedSets -> + (let _lhsOnontSet :: (Set NontermIdent) + _lhsOcollectedNames :: (Set Identifier) + _lhsOerrors :: (Seq Error) + _set1OallFields :: DataTypes + _set1OallNonterminals :: (Set NontermIdent) + _set1OdefinedSets :: DefinedSets + _set2OallFields :: DataTypes + _set2OallNonterminals :: (Set NontermIdent) + _set2OdefinedSets :: DefinedSets + _set1IcollectedNames :: (Set Identifier) + _set1Ierrors :: (Seq Error) + _set1InontSet :: (Set NontermIdent) + _set2IcollectedNames :: (Set Identifier) + _set2Ierrors :: (Seq Error) + _set2InontSet :: (Set NontermIdent) + -- "Transform.ag"(line 540, column 16) + _lhsOnontSet = + Set.intersection _set1InontSet _set2InontSet + -- use rule "Transform.ag"(line 80, column 50) + _lhsOcollectedNames = + _set1IcollectedNames `Set.union` _set2IcollectedNames + -- use rule "Transform.ag"(line 40, column 19) + _lhsOerrors = + _set1Ierrors Seq.<> _set2Ierrors + -- copy rule (down) + _set1OallFields = + _lhsIallFields + -- copy rule (down) + _set1OallNonterminals = + _lhsIallNonterminals + -- copy rule (down) + _set1OdefinedSets = + _lhsIdefinedSets + -- copy rule (down) + _set2OallFields = + _lhsIallFields + -- copy rule (down) + _set2OallNonterminals = + _lhsIallNonterminals + -- copy rule (down) + _set2OdefinedSets = + _lhsIdefinedSets + ( _set1IcollectedNames,_set1Ierrors,_set1InontSet) = + (set1_ _set1OallFields _set1OallNonterminals _set1OdefinedSets) + ( _set2IcollectedNames,_set2Ierrors,_set2InontSet) = + (set2_ _set2OallFields _set2OallNonterminals _set2OdefinedSets) + in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet)))) +sem_NontSet_NamedSet :: NontermIdent -> + T_NontSet +sem_NontSet_NamedSet name_ = + (T_NontSet (\ _lhsIallFields + _lhsIallNonterminals + _lhsIdefinedSets -> + (let _lhsOcollectedNames :: (Set Identifier) + _lhsOerrors :: (Seq Error) + _lhsOnontSet :: (Set NontermIdent) + -- "Transform.ag"(line 420, column 14) + _lhsOcollectedNames = + Set.singleton name_ + -- "Transform.ag"(line 536, column 20) + __tup4 = + case Map.lookup name_ _lhsIdefinedSets of + Nothing -> (Set.empty, Seq.single (UndefNont name_)) + Just set -> (set, Seq.empty) + -- "Transform.ag"(line 536, column 20) + (_nontSet,_) = + __tup4 + -- "Transform.ag"(line 536, column 20) + (_,_errors) = + __tup4 + -- use rule "Transform.ag"(line 40, column 19) + _lhsOerrors = + _errors + -- copy rule (from local) + _lhsOnontSet = + _nontSet + in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet)))) +sem_NontSet_Path :: NontermIdent -> + NontermIdent -> + T_NontSet +sem_NontSet_Path from_ to_ = + (T_NontSet (\ _lhsIallFields + _lhsIallNonterminals + _lhsIdefinedSets -> + (let _lhsOnontSet :: (Set NontermIdent) + _lhsOerrors :: (Seq Error) + _lhsOcollectedNames :: (Set Identifier) + -- "Transform.ag"(line 542, column 16) + _lhsOnontSet = + let table = flattenDatas _lhsIallFields + in path table from_ to_ + -- "Transform.ag"(line 544, column 16) + _lhsOerrors = + let check name | Set.member name _lhsIallNonterminals + = Seq.empty + | otherwise = Seq.single (UndefNont name) + in check from_ <> check to_ + -- use rule "Transform.ag"(line 80, column 50) + _lhsOcollectedNames = + Set.empty + in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet)))) +sem_NontSet_Union :: T_NontSet -> + T_NontSet -> + T_NontSet +sem_NontSet_Union (T_NontSet set1_) (T_NontSet set2_) = + (T_NontSet (\ _lhsIallFields + _lhsIallNonterminals + _lhsIdefinedSets -> + (let _lhsOnontSet :: (Set NontermIdent) + _lhsOcollectedNames :: (Set Identifier) + _lhsOerrors :: (Seq Error) + _set1OallFields :: DataTypes + _set1OallNonterminals :: (Set NontermIdent) + _set1OdefinedSets :: DefinedSets + _set2OallFields :: DataTypes + _set2OallNonterminals :: (Set NontermIdent) + _set2OdefinedSets :: DefinedSets + _set1IcollectedNames :: (Set Identifier) + _set1Ierrors :: (Seq Error) + _set1InontSet :: (Set NontermIdent) + _set2IcollectedNames :: (Set Identifier) + _set2Ierrors :: (Seq Error) + _set2InontSet :: (Set NontermIdent) + -- "Transform.ag"(line 539, column 16) + _lhsOnontSet = + Set.union _set1InontSet _set2InontSet + -- use rule "Transform.ag"(line 80, column 50) + _lhsOcollectedNames = + _set1IcollectedNames `Set.union` _set2IcollectedNames + -- use rule "Transform.ag"(line 40, column 19) + _lhsOerrors = + _set1Ierrors Seq.<> _set2Ierrors + -- copy rule (down) + _set1OallFields = + _lhsIallFields + -- copy rule (down) + _set1OallNonterminals = + _lhsIallNonterminals + -- copy rule (down) + _set1OdefinedSets = + _lhsIdefinedSets + -- copy rule (down) + _set2OallFields = + _lhsIallFields + -- copy rule (down) + _set2OallNonterminals = + _lhsIallNonterminals + -- copy rule (down) + _set2OdefinedSets = + _lhsIdefinedSets + ( _set1IcollectedNames,_set1Ierrors,_set1InontSet) = + (set1_ _set1OallFields _set1OallNonterminals _set1OdefinedSets) + ( _set2IcollectedNames,_set2Ierrors,_set2InontSet) = + (set2_ _set2OallFields _set2OallNonterminals _set2OdefinedSets) + in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet)))) +-- Pattern ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : SELF + definedAttrs : [AttrName] + definedInsts : [Identifier] + patunder : [AttrName]->Pattern + stpos : Pos + alternatives: + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + child parts : Patterns + visit 0: + local copy : _ + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ +-} +-- 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 (( Pattern,([AttrName]),([Identifier]),([AttrName]->Pattern),Pos)) +data Inh_Pattern = Inh_Pattern {} +data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: !(Pattern),definedAttrs_Syn_Pattern :: !([AttrName]),definedInsts_Syn_Pattern :: !([Identifier]),patunder_Syn_Pattern :: !([AttrName]->Pattern),stpos_Syn_Pattern :: !(Pos)} +wrap_Pattern (T_Pattern sem) (Inh_Pattern ) = + (let ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos) = + (sem ) + in (Syn_Pattern _lhsOcopy _lhsOdefinedAttrs _lhsOdefinedInsts _lhsOpatunder _lhsOstpos)) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Patterns -> + T_Pattern +sem_Pattern_Alias field_ attr_ (T_Pattern pat_) (T_Patterns parts_) = + (T_Pattern (let _lhsOdefinedAttrs :: ([AttrName]) + _lhsOpatunder :: ([AttrName]->Pattern) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOstpos :: Pos + _lhsOcopy :: Pattern + _patIcopy :: Pattern + _patIdefinedAttrs :: ([AttrName]) + _patIdefinedInsts :: ([Identifier]) + _patIpatunder :: ([AttrName]->Pattern) + _patIstpos :: Pos + _partsIcopy :: Patterns + _partsIdefinedAttrs :: ([AttrName]) + _partsIdefinedInsts :: ([Identifier]) + _partsIpatunder :: ([AttrName]->Patterns) + -- "Transform.ag"(line 870, column 11) + _lhsOdefinedAttrs = + (field_, attr_) : _patIdefinedAttrs + -- "Transform.ag"(line 871, column 11) + _lhsOpatunder = + \us -> if ((field_,attr_) `elem` us) then Underscore noPos else _copy + -- "Transform.ag"(line 872, column 11) + _lhsOdefinedInsts = + (if field_ == _INST then [attr_] else []) ++ _patIdefinedInsts + -- "Transform.ag"(line 887, column 16) + _lhsOstpos = + getPos field_ + -- self rule + _copy = + Alias field_ attr_ _patIcopy _partsIcopy + -- self rule + _lhsOcopy = + _copy + ( _patIcopy,_patIdefinedAttrs,_patIdefinedInsts,_patIpatunder,_patIstpos) = + (pat_ ) + ( _partsIcopy,_partsIdefinedAttrs,_partsIdefinedInsts,_partsIpatunder) = + (parts_ ) + in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos))) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr name_ (T_Patterns pats_) = + (T_Pattern (let _lhsOpatunder :: ([AttrName]->Pattern) + _lhsOstpos :: Pos + _lhsOdefinedAttrs :: ([AttrName]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOcopy :: Pattern + _patsIcopy :: Patterns + _patsIdefinedAttrs :: ([AttrName]) + _patsIdefinedInsts :: ([Identifier]) + _patsIpatunder :: ([AttrName]->Patterns) + -- "Transform.ag"(line 874, column 12) + _lhsOpatunder = + \us -> Constr name_ (_patsIpatunder us) + -- "Transform.ag"(line 885, column 16) + _lhsOstpos = + getPos name_ + -- use rule "Transform.ag"(line 865, column 42) + _lhsOdefinedAttrs = + _patsIdefinedAttrs + -- use rule "Transform.ag"(line 864, column 55) + _lhsOdefinedInsts = + _patsIdefinedInsts + -- self rule + _copy = + Constr name_ _patsIcopy + -- self rule + _lhsOcopy = + _copy + ( _patsIcopy,_patsIdefinedAttrs,_patsIdefinedInsts,_patsIpatunder) = + (pats_ ) + in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos))) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable (T_Pattern pat_) = + (T_Pattern (let _lhsOpatunder :: ([AttrName]->Pattern) + _lhsOdefinedAttrs :: ([AttrName]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOcopy :: Pattern + _lhsOstpos :: Pos + _patIcopy :: Pattern + _patIdefinedAttrs :: ([AttrName]) + _patIdefinedInsts :: ([Identifier]) + _patIpatunder :: ([AttrName]->Pattern) + _patIstpos :: Pos + -- "Transform.ag"(line 876, column 17) + _lhsOpatunder = + \us -> Irrefutable (_patIpatunder us) + -- use rule "Transform.ag"(line 865, column 42) + _lhsOdefinedAttrs = + _patIdefinedAttrs + -- use rule "Transform.ag"(line 864, column 55) + _lhsOdefinedInsts = + _patIdefinedInsts + -- self rule + _copy = + Irrefutable _patIcopy + -- self rule + _lhsOcopy = + _copy + -- copy rule (up) + _lhsOstpos = + _patIstpos + ( _patIcopy,_patIdefinedAttrs,_patIdefinedInsts,_patIpatunder,_patIstpos) = + (pat_ ) + in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos))) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product pos_ (T_Patterns pats_) = + (T_Pattern (let _lhsOpatunder :: ([AttrName]->Pattern) + _lhsOstpos :: Pos + _lhsOdefinedAttrs :: ([AttrName]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOcopy :: Pattern + _patsIcopy :: Patterns + _patsIdefinedAttrs :: ([AttrName]) + _patsIdefinedInsts :: ([Identifier]) + _patsIpatunder :: ([AttrName]->Patterns) + -- "Transform.ag"(line 875, column 13) + _lhsOpatunder = + \us -> Product pos_ (_patsIpatunder us) + -- "Transform.ag"(line 886, column 16) + _lhsOstpos = + pos_ + -- use rule "Transform.ag"(line 865, column 42) + _lhsOdefinedAttrs = + _patsIdefinedAttrs + -- use rule "Transform.ag"(line 864, column 55) + _lhsOdefinedInsts = + _patsIdefinedInsts + -- self rule + _copy = + Product pos_ _patsIcopy + -- self rule + _lhsOcopy = + _copy + ( _patsIcopy,_patsIdefinedAttrs,_patsIdefinedInsts,_patsIpatunder) = + (pats_ ) + in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos))) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore pos_ = + (T_Pattern (let _lhsOpatunder :: ([AttrName]->Pattern) + _lhsOstpos :: Pos + _lhsOdefinedAttrs :: ([AttrName]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOcopy :: Pattern + -- "Transform.ag"(line 873, column 16) + _lhsOpatunder = + \us -> _copy + -- "Transform.ag"(line 888, column 16) + _lhsOstpos = + pos_ + -- use rule "Transform.ag"(line 865, column 42) + _lhsOdefinedAttrs = + [] + -- use rule "Transform.ag"(line 864, column 55) + _lhsOdefinedInsts = + [] + -- self rule + _copy = + Underscore pos_ + -- self rule + _lhsOcopy = + _copy + in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos))) +-- Patterns ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : SELF + definedAttrs : [AttrName] + definedInsts : [Identifier] + patunder : [AttrName]->Patterns + alternatives: + alternative Cons: + child hd : Pattern + child tl : Patterns + visit 0: + local copy : _ + alternative Nil: + visit 0: + local copy : _ +-} +-- 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 (( Patterns,([AttrName]),([Identifier]),([AttrName]->Patterns))) +data Inh_Patterns = Inh_Patterns {} +data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: !(Patterns),definedAttrs_Syn_Patterns :: !([AttrName]),definedInsts_Syn_Patterns :: !([Identifier]),patunder_Syn_Patterns :: !([AttrName]->Patterns)} +wrap_Patterns (T_Patterns sem) (Inh_Patterns ) = + (let ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder) = + (sem ) + in (Syn_Patterns _lhsOcopy _lhsOdefinedAttrs _lhsOdefinedInsts _lhsOpatunder)) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) = + (T_Patterns (let _lhsOpatunder :: ([AttrName]->Patterns) + _lhsOdefinedAttrs :: ([AttrName]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOcopy :: Patterns + _hdIcopy :: Pattern + _hdIdefinedAttrs :: ([AttrName]) + _hdIdefinedInsts :: ([Identifier]) + _hdIpatunder :: ([AttrName]->Pattern) + _hdIstpos :: Pos + _tlIcopy :: Patterns + _tlIdefinedAttrs :: ([AttrName]) + _tlIdefinedInsts :: ([Identifier]) + _tlIpatunder :: ([AttrName]->Patterns) + -- "Transform.ag"(line 880, column 10) + _lhsOpatunder = + \us -> (_hdIpatunder us) : (_tlIpatunder us) + -- use rule "Transform.ag"(line 865, column 42) + _lhsOdefinedAttrs = + _hdIdefinedAttrs ++ _tlIdefinedAttrs + -- use rule "Transform.ag"(line 864, column 55) + _lhsOdefinedInsts = + _hdIdefinedInsts ++ _tlIdefinedInsts + -- self rule + _copy = + (:) _hdIcopy _tlIcopy + -- self rule + _lhsOcopy = + _copy + ( _hdIcopy,_hdIdefinedAttrs,_hdIdefinedInsts,_hdIpatunder,_hdIstpos) = + (hd_ ) + ( _tlIcopy,_tlIdefinedAttrs,_tlIdefinedInsts,_tlIpatunder) = + (tl_ ) + in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder))) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (let _lhsOpatunder :: ([AttrName]->Patterns) + _lhsOdefinedAttrs :: ([AttrName]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOcopy :: Patterns + -- "Transform.ag"(line 879, column 9) + _lhsOpatunder = + \us -> [] + -- use rule "Transform.ag"(line 865, column 42) + _lhsOdefinedAttrs = + [] + -- use rule "Transform.ag"(line 864, column 55) + _lhsOdefinedInsts = + [] + -- self rule + _copy = + [] + -- self rule + _lhsOcopy = + _copy + in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder))) +-- SemAlt ------------------------------------------------------ +{- + visit 0: + inherited attributes: + allAttrDecls : Map NontermIdent (Attributes, Attributes) + allFields : DataTypes + nts : Set NontermIdent + synthesized attributes: + attrOrderCollect : AttrOrderMap + collectedInsts : [ (NontermIdent, ConstructorIdent, [Identifier]) ] + collectedRules : [ (NontermIdent, ConstructorIdent, RuleInfo)] + collectedSigs : [ (NontermIdent, ConstructorIdent, SigInfo) ] + collectedUniques : [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ] + errors : Seq Error + semPragmasCollect : PragmaMap + alternatives: + alternative SemAlt: + child pos : {Pos} + child constructorSet : ConstructorSet + child rules : SemDefs + visit 0: + local pragmaNames : _ + local attrOrders : _ + local coninfo : _ +-} +-- cata +sem_SemAlt :: SemAlt -> + T_SemAlt +sem_SemAlt (SemAlt _pos _constructorSet _rules) = + (sem_SemAlt_SemAlt _pos (sem_ConstructorSet _constructorSet) (sem_SemDefs _rules)) +-- semantic domain +newtype T_SemAlt = T_SemAlt ((Map NontermIdent (Attributes, Attributes)) -> + DataTypes -> + (Set NontermIdent) -> + ( AttrOrderMap,([ (NontermIdent, ConstructorIdent, [Identifier]) ]),([ (NontermIdent, ConstructorIdent, RuleInfo)]),([ (NontermIdent, ConstructorIdent, SigInfo) ]),([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),(Seq Error),PragmaMap)) +data Inh_SemAlt = Inh_SemAlt {allAttrDecls_Inh_SemAlt :: !(Map NontermIdent (Attributes, Attributes)),allFields_Inh_SemAlt :: !(DataTypes),nts_Inh_SemAlt :: !(Set NontermIdent)} +data Syn_SemAlt = Syn_SemAlt {attrOrderCollect_Syn_SemAlt :: !(AttrOrderMap),collectedInsts_Syn_SemAlt :: !([ (NontermIdent, ConstructorIdent, [Identifier]) ]),collectedRules_Syn_SemAlt :: !([ (NontermIdent, ConstructorIdent, RuleInfo)]),collectedSigs_Syn_SemAlt :: !([ (NontermIdent, ConstructorIdent, SigInfo) ]),collectedUniques_Syn_SemAlt :: !([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),errors_Syn_SemAlt :: !(Seq Error),semPragmasCollect_Syn_SemAlt :: !(PragmaMap)} +wrap_SemAlt (T_SemAlt sem) (Inh_SemAlt _lhsIallAttrDecls _lhsIallFields _lhsInts) = + (let ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOerrors,_lhsOsemPragmasCollect) = + (sem _lhsIallAttrDecls _lhsIallFields _lhsInts) + in (Syn_SemAlt _lhsOattrOrderCollect _lhsOcollectedInsts _lhsOcollectedRules _lhsOcollectedSigs _lhsOcollectedUniques _lhsOerrors _lhsOsemPragmasCollect)) +sem_SemAlt_SemAlt :: Pos -> + T_ConstructorSet -> + T_SemDefs -> + T_SemAlt +sem_SemAlt_SemAlt pos_ (T_ConstructorSet constructorSet_) (T_SemDefs rules_) = + (T_SemAlt (\ _lhsIallAttrDecls + _lhsIallFields + _lhsInts -> + (let _lhsOsemPragmasCollect :: PragmaMap + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOerrors :: (Seq Error) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _constructorSetIcollectedConstructorNames :: (Set ConstructorIdent) + _constructorSetIconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) + _constructorSetIerrors :: (Seq Error) + _rulesIdefinedInsts :: ([Identifier]) + _rulesIorderDepsCollect :: (Set Dependency) + _rulesIpragmaNamesCollect :: ([Identifier]) + _rulesIruleInfos :: ([RuleInfo]) + _rulesIsigInfos :: ([SigInfo]) + _rulesIuniqueInfos :: ([UniqueInfo]) + -- "Transform.ag"(line 638, column 7) + _pragmaNames = + Set.fromList _rulesIpragmaNamesCollect + -- "Transform.ag"(line 639, column 7) + _lhsOsemPragmasCollect = + foldr pragmaMapUnion Map.empty [ pragmaMapSingle nt con _pragmaNames + | (nt, conset, _) <- _coninfo + , con <- Set.toList conset + ] + -- "Transform.ag"(line 667, column 7) + _attrOrders = + [ orderMapSingle nt con _rulesIorderDepsCollect + | (nt, conset, _) <- _coninfo + , con <- Set.toList conset + ] + -- "Transform.ag"(line 673, column 7) + _lhsOattrOrderCollect = + foldr orderMapUnion Map.empty _attrOrders + -- "Transform.ag"(line 816, column 12) + _coninfo = + [ (nt, conset, conkeys) + | nt <- Set.toList _lhsInts + , let conmap = Map.findWithDefault Map.empty nt _lhsIallFields + , let conkeys = Set.fromList (Map.keys conmap) + , let conset = _constructorSetIconstructors conkeys + ] + -- "Transform.ag"(line 823, column 12) + _lhsOerrors = + Seq.fromList + [ UndefAlt nt con + | (nt, conset, conkeys) <- _coninfo + , con <- Set.toList (Set.difference conset conkeys) + ] + -- "Transform.ag"(line 828, column 12) + _lhsOcollectedRules = + [ (nt,con,r) + | (nt, conset, _) <- _coninfo + , con <- Set.toList conset + , r <- _rulesIruleInfos + ] + -- "Transform.ag"(line 834, column 12) + _lhsOcollectedSigs = + [ (nt,con,ts) + | (nt, conset, _) <- _coninfo + , con <- Set.toList conset + , ts <- _rulesIsigInfos + ] + -- "Transform.ag"(line 841, column 12) + _lhsOcollectedInsts = + [ (nt,con,_rulesIdefinedInsts) + | (nt, conset, _) <- _coninfo + , con <- Set.toList conset + ] + -- "Transform.ag"(line 847, column 12) + _lhsOcollectedUniques = + [ (nt,con,_rulesIuniqueInfos) + | (nt, conset, _) <- _coninfo + , con <- Set.toList conset + ] + ( _constructorSetIcollectedConstructorNames,_constructorSetIconstructors,_constructorSetIerrors) = + (constructorSet_ ) + ( _rulesIdefinedInsts,_rulesIorderDepsCollect,_rulesIpragmaNamesCollect,_rulesIruleInfos,_rulesIsigInfos,_rulesIuniqueInfos) = + (rules_ ) + in ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOerrors,_lhsOsemPragmasCollect)))) +-- SemAlts ----------------------------------------------------- +{- + visit 0: + inherited attributes: + allAttrDecls : Map NontermIdent (Attributes, Attributes) + allFields : DataTypes + nts : Set NontermIdent + synthesized attributes: + attrOrderCollect : AttrOrderMap + collectedInsts : [ (NontermIdent, ConstructorIdent, [Identifier]) ] + collectedRules : [ (NontermIdent, ConstructorIdent, RuleInfo)] + collectedSigs : [ (NontermIdent, ConstructorIdent, SigInfo) ] + collectedUniques : [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ] + errors : Seq Error + semPragmasCollect : PragmaMap + alternatives: + alternative Cons: + child hd : SemAlt + child tl : SemAlts + alternative Nil: +-} +-- cata +sem_SemAlts :: SemAlts -> + T_SemAlts +sem_SemAlts list = + (Prelude.foldr sem_SemAlts_Cons sem_SemAlts_Nil (Prelude.map sem_SemAlt list)) +-- semantic domain +newtype T_SemAlts = T_SemAlts ((Map NontermIdent (Attributes, Attributes)) -> + DataTypes -> + (Set NontermIdent) -> + ( AttrOrderMap,([ (NontermIdent, ConstructorIdent, [Identifier]) ]),([ (NontermIdent, ConstructorIdent, RuleInfo)]),([ (NontermIdent, ConstructorIdent, SigInfo) ]),([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),(Seq Error),PragmaMap)) +data Inh_SemAlts = Inh_SemAlts {allAttrDecls_Inh_SemAlts :: !(Map NontermIdent (Attributes, Attributes)),allFields_Inh_SemAlts :: !(DataTypes),nts_Inh_SemAlts :: !(Set NontermIdent)} +data Syn_SemAlts = Syn_SemAlts {attrOrderCollect_Syn_SemAlts :: !(AttrOrderMap),collectedInsts_Syn_SemAlts :: !([ (NontermIdent, ConstructorIdent, [Identifier]) ]),collectedRules_Syn_SemAlts :: !([ (NontermIdent, ConstructorIdent, RuleInfo)]),collectedSigs_Syn_SemAlts :: !([ (NontermIdent, ConstructorIdent, SigInfo) ]),collectedUniques_Syn_SemAlts :: !([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),errors_Syn_SemAlts :: !(Seq Error),semPragmasCollect_Syn_SemAlts :: !(PragmaMap)} +wrap_SemAlts (T_SemAlts sem) (Inh_SemAlts _lhsIallAttrDecls _lhsIallFields _lhsInts) = + (let ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOerrors,_lhsOsemPragmasCollect) = + (sem _lhsIallAttrDecls _lhsIallFields _lhsInts) + in (Syn_SemAlts _lhsOattrOrderCollect _lhsOcollectedInsts _lhsOcollectedRules _lhsOcollectedSigs _lhsOcollectedUniques _lhsOerrors _lhsOsemPragmasCollect)) +sem_SemAlts_Cons :: T_SemAlt -> + T_SemAlts -> + T_SemAlts +sem_SemAlts_Cons (T_SemAlt hd_) (T_SemAlts tl_) = + (T_SemAlts (\ _lhsIallAttrDecls + _lhsIallFields + _lhsInts -> + (let _lhsOattrOrderCollect :: AttrOrderMap + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOerrors :: (Seq Error) + _lhsOsemPragmasCollect :: PragmaMap + _hdOallAttrDecls :: (Map NontermIdent (Attributes, Attributes)) + _hdOallFields :: DataTypes + _hdOnts :: (Set NontermIdent) + _tlOallAttrDecls :: (Map NontermIdent (Attributes, Attributes)) + _tlOallFields :: DataTypes + _tlOnts :: (Set NontermIdent) + _hdIattrOrderCollect :: AttrOrderMap + _hdIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _hdIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _hdIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _hdIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _hdIerrors :: (Seq Error) + _hdIsemPragmasCollect :: PragmaMap + _tlIattrOrderCollect :: AttrOrderMap + _tlIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _tlIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _tlIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _tlIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _tlIerrors :: (Seq Error) + _tlIsemPragmasCollect :: PragmaMap + -- use rule "Transform.ag"(line 662, column 55) + _lhsOattrOrderCollect = + _hdIattrOrderCollect `orderMapUnion` _tlIattrOrderCollect + -- use rule "Transform.ag"(line 144, column 31) + _lhsOcollectedInsts = + _hdIcollectedInsts ++ _tlIcollectedInsts + -- use rule "Transform.ag"(line 142, column 31) + _lhsOcollectedRules = + _hdIcollectedRules ++ _tlIcollectedRules + -- use rule "Transform.ag"(line 143, column 31) + _lhsOcollectedSigs = + _hdIcollectedSigs ++ _tlIcollectedSigs + -- use rule "Transform.ag"(line 145, column 31) + _lhsOcollectedUniques = + _hdIcollectedUniques ++ _tlIcollectedUniques + -- use rule "Transform.ag"(line 40, column 19) + _lhsOerrors = + _hdIerrors Seq.<> _tlIerrors + -- use rule "Transform.ag"(line 634, column 56) + _lhsOsemPragmasCollect = + _hdIsemPragmasCollect `pragmaMapUnion` _tlIsemPragmasCollect + -- copy rule (down) + _hdOallAttrDecls = + _lhsIallAttrDecls + -- copy rule (down) + _hdOallFields = + _lhsIallFields + -- copy rule (down) + _hdOnts = + _lhsInts + -- copy rule (down) + _tlOallAttrDecls = + _lhsIallAttrDecls + -- copy rule (down) + _tlOallFields = + _lhsIallFields + -- copy rule (down) + _tlOnts = + _lhsInts + ( _hdIattrOrderCollect,_hdIcollectedInsts,_hdIcollectedRules,_hdIcollectedSigs,_hdIcollectedUniques,_hdIerrors,_hdIsemPragmasCollect) = + (hd_ _hdOallAttrDecls _hdOallFields _hdOnts) + ( _tlIattrOrderCollect,_tlIcollectedInsts,_tlIcollectedRules,_tlIcollectedSigs,_tlIcollectedUniques,_tlIerrors,_tlIsemPragmasCollect) = + (tl_ _tlOallAttrDecls _tlOallFields _tlOnts) + in ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOerrors,_lhsOsemPragmasCollect)))) +sem_SemAlts_Nil :: T_SemAlts +sem_SemAlts_Nil = + (T_SemAlts (\ _lhsIallAttrDecls + _lhsIallFields + _lhsInts -> + (let _lhsOattrOrderCollect :: AttrOrderMap + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOerrors :: (Seq Error) + _lhsOsemPragmasCollect :: PragmaMap + -- use rule "Transform.ag"(line 662, column 55) + _lhsOattrOrderCollect = + Map.empty + -- use rule "Transform.ag"(line 144, column 31) + _lhsOcollectedInsts = + [] + -- use rule "Transform.ag"(line 142, column 31) + _lhsOcollectedRules = + [] + -- use rule "Transform.ag"(line 143, column 31) + _lhsOcollectedSigs = + [] + -- use rule "Transform.ag"(line 145, column 31) + _lhsOcollectedUniques = + [] + -- use rule "Transform.ag"(line 40, column 19) + _lhsOerrors = + Seq.empty + -- use rule "Transform.ag"(line 634, column 56) + _lhsOsemPragmasCollect = + Map.empty + in ( _lhsOattrOrderCollect,_lhsOcollectedInsts,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOerrors,_lhsOsemPragmasCollect)))) +-- SemDef ------------------------------------------------------ +{- + visit 0: + synthesized attributes: + definedInsts : [Identifier] + orderDepsCollect : Set Dependency + pragmaNamesCollect : [Identifier] + ruleInfos : [RuleInfo] + sigInfos : [SigInfo] + uniqueInfos : [UniqueInfo] + alternatives: + alternative AttrOrderBefore: + child before : {[(Identifier,Identifier)]} + child after : {[(Identifier,Identifier)]} + visit 0: + local dependency : _ + alternative Def: + child pattern : Pattern + child rhs : {Expression} + child owrt : {Bool} + alternative SemPragma: + child names : {[NontermIdent]} + alternative TypeDef: + child ident : {Identifier} + child tp : {Type} + alternative UniqueDef: + child ident : {Identifier} + child ref : {Identifier} +-} +-- cata +sem_SemDef :: SemDef -> + T_SemDef +sem_SemDef (AttrOrderBefore _before _after) = + (sem_SemDef_AttrOrderBefore _before _after) +sem_SemDef (Def _pattern _rhs _owrt) = + (sem_SemDef_Def (sem_Pattern _pattern) _rhs _owrt) +sem_SemDef (SemPragma _names) = + (sem_SemDef_SemPragma _names) +sem_SemDef (TypeDef _ident _tp) = + (sem_SemDef_TypeDef _ident _tp) +sem_SemDef (UniqueDef _ident _ref) = + (sem_SemDef_UniqueDef _ident _ref) +-- semantic domain +newtype T_SemDef = T_SemDef (( ([Identifier]),(Set Dependency),([Identifier]),([RuleInfo]),([SigInfo]),([UniqueInfo]))) +data Inh_SemDef = Inh_SemDef {} +data Syn_SemDef = Syn_SemDef {definedInsts_Syn_SemDef :: !([Identifier]),orderDepsCollect_Syn_SemDef :: !(Set Dependency),pragmaNamesCollect_Syn_SemDef :: !([Identifier]),ruleInfos_Syn_SemDef :: !([RuleInfo]),sigInfos_Syn_SemDef :: !([SigInfo]),uniqueInfos_Syn_SemDef :: !([UniqueInfo])} +wrap_SemDef (T_SemDef sem) (Inh_SemDef ) = + (let ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos) = + (sem ) + in (Syn_SemDef _lhsOdefinedInsts _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos _lhsOuniqueInfos)) +sem_SemDef_AttrOrderBefore :: ([(Identifier,Identifier)]) -> + ([(Identifier,Identifier)]) -> + T_SemDef +sem_SemDef_AttrOrderBefore before_ after_ = + (T_SemDef (let _lhsOorderDepsCollect :: (Set Dependency) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOpragmaNamesCollect :: ([Identifier]) + _lhsOruleInfos :: ([RuleInfo]) + _lhsOsigInfos :: ([SigInfo]) + _lhsOuniqueInfos :: ([UniqueInfo]) + -- "Transform.ag"(line 679, column 7) + _dependency = + [ Dependency b a | b <- before_, a <- after_ ] + -- "Transform.ag"(line 680, column 7) + _lhsOorderDepsCollect = + Set.fromList _dependency + -- use rule "Transform.ag"(line 864, column 55) + _lhsOdefinedInsts = + [] + -- use rule "Transform.ag"(line 644, column 46) + _lhsOpragmaNamesCollect = + [] + -- use rule "Transform.ag"(line 809, column 39) + _lhsOruleInfos = + [] + -- use rule "Transform.ag"(line 810, column 39) + _lhsOsigInfos = + [] + -- use rule "Transform.ag"(line 811, column 39) + _lhsOuniqueInfos = + [] + in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos))) +sem_SemDef_Def :: T_Pattern -> + Expression -> + Bool -> + T_SemDef +sem_SemDef_Def (T_Pattern pattern_) rhs_ owrt_ = + (T_SemDef (let _lhsOruleInfos :: ([RuleInfo]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOorderDepsCollect :: (Set Dependency) + _lhsOpragmaNamesCollect :: ([Identifier]) + _lhsOsigInfos :: ([SigInfo]) + _lhsOuniqueInfos :: ([UniqueInfo]) + _patternIcopy :: Pattern + _patternIdefinedAttrs :: ([AttrName]) + _patternIdefinedInsts :: ([Identifier]) + _patternIpatunder :: ([AttrName]->Pattern) + _patternIstpos :: Pos + -- "Transform.ag"(line 855, column 10) + _lhsOruleInfos = + [ (_patternIpatunder, rhs_, _patternIdefinedAttrs, owrt_, show _patternIstpos) ] + -- use rule "Transform.ag"(line 864, column 55) + _lhsOdefinedInsts = + _patternIdefinedInsts + -- use rule "Transform.ag"(line 675, column 44) + _lhsOorderDepsCollect = + Set.empty + -- use rule "Transform.ag"(line 644, column 46) + _lhsOpragmaNamesCollect = + [] + -- use rule "Transform.ag"(line 810, column 39) + _lhsOsigInfos = + [] + -- use rule "Transform.ag"(line 811, column 39) + _lhsOuniqueInfos = + [] + ( _patternIcopy,_patternIdefinedAttrs,_patternIdefinedInsts,_patternIpatunder,_patternIstpos) = + (pattern_ ) + in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos))) +sem_SemDef_SemPragma :: ([NontermIdent]) -> + T_SemDef +sem_SemDef_SemPragma names_ = + (T_SemDef (let _lhsOpragmaNamesCollect :: ([Identifier]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOorderDepsCollect :: (Set Dependency) + _lhsOruleInfos :: ([RuleInfo]) + _lhsOsigInfos :: ([SigInfo]) + _lhsOuniqueInfos :: ([UniqueInfo]) + -- "Transform.ag"(line 648, column 7) + _lhsOpragmaNamesCollect = + names_ + -- use rule "Transform.ag"(line 864, column 55) + _lhsOdefinedInsts = + [] + -- use rule "Transform.ag"(line 675, column 44) + _lhsOorderDepsCollect = + Set.empty + -- use rule "Transform.ag"(line 809, column 39) + _lhsOruleInfos = + [] + -- use rule "Transform.ag"(line 810, column 39) + _lhsOsigInfos = + [] + -- use rule "Transform.ag"(line 811, column 39) + _lhsOuniqueInfos = + [] + in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos))) +sem_SemDef_TypeDef :: Identifier -> + Type -> + T_SemDef +sem_SemDef_TypeDef ident_ tp_ = + (T_SemDef (let _lhsOsigInfos :: ([SigInfo]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOorderDepsCollect :: (Set Dependency) + _lhsOpragmaNamesCollect :: ([Identifier]) + _lhsOruleInfos :: ([RuleInfo]) + _lhsOuniqueInfos :: ([UniqueInfo]) + -- "Transform.ag"(line 858, column 14) + _lhsOsigInfos = + [ (ident_, tp_) ] + -- use rule "Transform.ag"(line 864, column 55) + _lhsOdefinedInsts = + [] + -- use rule "Transform.ag"(line 675, column 44) + _lhsOorderDepsCollect = + Set.empty + -- use rule "Transform.ag"(line 644, column 46) + _lhsOpragmaNamesCollect = + [] + -- use rule "Transform.ag"(line 809, column 39) + _lhsOruleInfos = + [] + -- use rule "Transform.ag"(line 811, column 39) + _lhsOuniqueInfos = + [] + in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos))) +sem_SemDef_UniqueDef :: Identifier -> + Identifier -> + T_SemDef +sem_SemDef_UniqueDef ident_ ref_ = + (T_SemDef (let _lhsOuniqueInfos :: ([UniqueInfo]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOorderDepsCollect :: (Set Dependency) + _lhsOpragmaNamesCollect :: ([Identifier]) + _lhsOruleInfos :: ([RuleInfo]) + _lhsOsigInfos :: ([SigInfo]) + -- "Transform.ag"(line 861, column 16) + _lhsOuniqueInfos = + [ (ident_, ref_) ] + -- use rule "Transform.ag"(line 864, column 55) + _lhsOdefinedInsts = + [] + -- use rule "Transform.ag"(line 675, column 44) + _lhsOorderDepsCollect = + Set.empty + -- use rule "Transform.ag"(line 644, column 46) + _lhsOpragmaNamesCollect = + [] + -- use rule "Transform.ag"(line 809, column 39) + _lhsOruleInfos = + [] + -- use rule "Transform.ag"(line 810, column 39) + _lhsOsigInfos = + [] + in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos))) +-- SemDefs ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + definedInsts : [Identifier] + orderDepsCollect : Set Dependency + pragmaNamesCollect : [Identifier] + ruleInfos : [RuleInfo] + sigInfos : [SigInfo] + uniqueInfos : [UniqueInfo] + alternatives: + alternative Cons: + child hd : SemDef + child tl : SemDefs + alternative Nil: +-} +-- cata +sem_SemDefs :: SemDefs -> + T_SemDefs +sem_SemDefs list = + (Prelude.foldr sem_SemDefs_Cons sem_SemDefs_Nil (Prelude.map sem_SemDef list)) +-- semantic domain +newtype T_SemDefs = T_SemDefs (( ([Identifier]),(Set Dependency),([Identifier]),([RuleInfo]),([SigInfo]),([UniqueInfo]))) +data Inh_SemDefs = Inh_SemDefs {} +data Syn_SemDefs = Syn_SemDefs {definedInsts_Syn_SemDefs :: !([Identifier]),orderDepsCollect_Syn_SemDefs :: !(Set Dependency),pragmaNamesCollect_Syn_SemDefs :: !([Identifier]),ruleInfos_Syn_SemDefs :: !([RuleInfo]),sigInfos_Syn_SemDefs :: !([SigInfo]),uniqueInfos_Syn_SemDefs :: !([UniqueInfo])} +wrap_SemDefs (T_SemDefs sem) (Inh_SemDefs ) = + (let ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos) = + (sem ) + in (Syn_SemDefs _lhsOdefinedInsts _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos _lhsOuniqueInfos)) +sem_SemDefs_Cons :: T_SemDef -> + T_SemDefs -> + T_SemDefs +sem_SemDefs_Cons (T_SemDef hd_) (T_SemDefs tl_) = + (T_SemDefs (let _lhsOdefinedInsts :: ([Identifier]) + _lhsOorderDepsCollect :: (Set Dependency) + _lhsOpragmaNamesCollect :: ([Identifier]) + _lhsOruleInfos :: ([RuleInfo]) + _lhsOsigInfos :: ([SigInfo]) + _lhsOuniqueInfos :: ([UniqueInfo]) + _hdIdefinedInsts :: ([Identifier]) + _hdIorderDepsCollect :: (Set Dependency) + _hdIpragmaNamesCollect :: ([Identifier]) + _hdIruleInfos :: ([RuleInfo]) + _hdIsigInfos :: ([SigInfo]) + _hdIuniqueInfos :: ([UniqueInfo]) + _tlIdefinedInsts :: ([Identifier]) + _tlIorderDepsCollect :: (Set Dependency) + _tlIpragmaNamesCollect :: ([Identifier]) + _tlIruleInfos :: ([RuleInfo]) + _tlIsigInfos :: ([SigInfo]) + _tlIuniqueInfos :: ([UniqueInfo]) + -- use rule "Transform.ag"(line 864, column 55) + _lhsOdefinedInsts = + _hdIdefinedInsts ++ _tlIdefinedInsts + -- use rule "Transform.ag"(line 675, column 44) + _lhsOorderDepsCollect = + _hdIorderDepsCollect `Set.union` _tlIorderDepsCollect + -- use rule "Transform.ag"(line 644, column 46) + _lhsOpragmaNamesCollect = + _hdIpragmaNamesCollect ++ _tlIpragmaNamesCollect + -- use rule "Transform.ag"(line 809, column 39) + _lhsOruleInfos = + _hdIruleInfos ++ _tlIruleInfos + -- use rule "Transform.ag"(line 810, column 39) + _lhsOsigInfos = + _hdIsigInfos ++ _tlIsigInfos + -- use rule "Transform.ag"(line 811, column 39) + _lhsOuniqueInfos = + _hdIuniqueInfos ++ _tlIuniqueInfos + ( _hdIdefinedInsts,_hdIorderDepsCollect,_hdIpragmaNamesCollect,_hdIruleInfos,_hdIsigInfos,_hdIuniqueInfos) = + (hd_ ) + ( _tlIdefinedInsts,_tlIorderDepsCollect,_tlIpragmaNamesCollect,_tlIruleInfos,_tlIsigInfos,_tlIuniqueInfos) = + (tl_ ) + in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos))) +sem_SemDefs_Nil :: T_SemDefs +sem_SemDefs_Nil = + (T_SemDefs (let _lhsOdefinedInsts :: ([Identifier]) + _lhsOorderDepsCollect :: (Set Dependency) + _lhsOpragmaNamesCollect :: ([Identifier]) + _lhsOruleInfos :: ([RuleInfo]) + _lhsOsigInfos :: ([SigInfo]) + _lhsOuniqueInfos :: ([UniqueInfo]) + -- use rule "Transform.ag"(line 864, column 55) + _lhsOdefinedInsts = + [] + -- use rule "Transform.ag"(line 675, column 44) + _lhsOorderDepsCollect = + Set.empty + -- use rule "Transform.ag"(line 644, column 46) + _lhsOpragmaNamesCollect = + [] + -- use rule "Transform.ag"(line 809, column 39) + _lhsOruleInfos = + [] + -- use rule "Transform.ag"(line 810, column 39) + _lhsOsigInfos = + [] + -- use rule "Transform.ag"(line 811, column 39) + _lhsOuniqueInfos = + [] + in ( _lhsOdefinedInsts,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos))) diff --git a/src-derived/Visage.hs b/src-derived/Visage.hs --- a/src-derived/Visage.hs +++ b/src-derived/Visage.hs @@ -1,4 +1,3 @@ - -- UUAGC 0.9.5 (Visage.ag) module Visage where @@ -13,18 +12,15 @@ import Data.List(intersperse) import TokenDef - import CommonTypes import UU.Pretty import AbstractSyntax import VisagePatterns import Expression - import UU.Scanner.Position(Pos) import CommonTypes - import UU.Scanner.Position(Pos) import HsToken @@ -64,25 +60,25 @@ -- cata sem_Expression :: Expression -> T_Expression -sem_Expression (Expression _pos _tks ) = - (sem_Expression_Expression _pos _tks ) +sem_Expression (Expression _pos _tks) = + (sem_Expression_Expression _pos _tks) -- semantic domain newtype T_Expression = T_Expression (( ATerm)) data Inh_Expression = Inh_Expression {} data Syn_Expression = Syn_Expression {aterm_Syn_Expression :: ATerm} -wrap_Expression (T_Expression sem ) (Inh_Expression ) = +wrap_Expression (T_Expression sem) (Inh_Expression ) = (let ( _lhsOaterm) = (sem ) - in (Syn_Expression _lhsOaterm )) + in (Syn_Expression _lhsOaterm)) sem_Expression_Expression :: Pos -> ([HsToken]) -> T_Expression -sem_Expression_Expression pos_ tks_ = +sem_Expression_Expression pos_ tks_ = (T_Expression (let _lhsOaterm :: ATerm -- "Visage.ag"(line 103, column 17) _lhsOaterm = AAppl "Expression" [AString (sQ (showAGPos pos_)), AString (sQ (unlines . showTokens . tokensToStrings $ tks_))] - in ( _lhsOaterm)) ) + in ( _lhsOaterm))) -- VisageChild ------------------------------------------------- {- visit 0: @@ -94,28 +90,28 @@ child tp : {Type} child inh : {Attributes} child syn : {Attributes} - child rules : VisageRules + child rules : VisageRules -} -- cata sem_VisageChild :: VisageChild -> T_VisageChild -sem_VisageChild (VChild _name _tp _inh _syn _rules ) = - (sem_VisageChild_VChild _name _tp _inh _syn (sem_VisageRules _rules ) ) +sem_VisageChild (VChild _name _tp _inh _syn _rules) = + (sem_VisageChild_VChild _name _tp _inh _syn (sem_VisageRules _rules)) -- semantic domain newtype T_VisageChild = T_VisageChild (( ATerm)) data Inh_VisageChild = Inh_VisageChild {} data Syn_VisageChild = Syn_VisageChild {aterm_Syn_VisageChild :: ATerm} -wrap_VisageChild (T_VisageChild sem ) (Inh_VisageChild ) = +wrap_VisageChild (T_VisageChild sem) (Inh_VisageChild ) = (let ( _lhsOaterm) = (sem ) - in (Syn_VisageChild _lhsOaterm )) + in (Syn_VisageChild _lhsOaterm)) sem_VisageChild_VChild :: Identifier -> Type -> Attributes -> Attributes -> T_VisageRules -> T_VisageChild -sem_VisageChild_VChild name_ tp_ inh_ syn_ (T_VisageRules rules_ ) = +sem_VisageChild_VChild name_ tp_ inh_ syn_ (T_VisageRules rules_) = (T_VisageChild (let _lhsOaterm :: ATerm _rulesOisLoc :: Bool _rulesIaterms :: ([ATerm]) @@ -129,8 +125,8 @@ _rulesOisLoc = False ( _rulesIaterms) = - (rules_ _rulesOisLoc ) - in ( _lhsOaterm)) ) + (rules_ _rulesOisLoc) + in ( _lhsOaterm))) -- VisageChildren ---------------------------------------------- {- visit 0: @@ -138,27 +134,27 @@ aterms : [ATerm] alternatives: alternative Cons: - child hd : VisageChild - child tl : VisageChildren + child hd : VisageChild + child tl : VisageChildren alternative Nil: -} -- cata sem_VisageChildren :: VisageChildren -> T_VisageChildren -sem_VisageChildren list = - (Prelude.foldr sem_VisageChildren_Cons sem_VisageChildren_Nil (Prelude.map sem_VisageChild list) ) +sem_VisageChildren list = + (Prelude.foldr sem_VisageChildren_Cons sem_VisageChildren_Nil (Prelude.map sem_VisageChild list)) -- semantic domain newtype T_VisageChildren = T_VisageChildren (( ([ATerm]))) data Inh_VisageChildren = Inh_VisageChildren {} data Syn_VisageChildren = Syn_VisageChildren {aterms_Syn_VisageChildren :: [ATerm]} -wrap_VisageChildren (T_VisageChildren sem ) (Inh_VisageChildren ) = +wrap_VisageChildren (T_VisageChildren sem) (Inh_VisageChildren ) = (let ( _lhsOaterms) = (sem ) - in (Syn_VisageChildren _lhsOaterms )) + in (Syn_VisageChildren _lhsOaterms)) sem_VisageChildren_Cons :: T_VisageChild -> T_VisageChildren -> T_VisageChildren -sem_VisageChildren_Cons (T_VisageChild hd_ ) (T_VisageChildren tl_ ) = +sem_VisageChildren_Cons (T_VisageChild hd_) (T_VisageChildren tl_) = (T_VisageChildren (let _lhsOaterms :: ([ATerm]) _hdIaterm :: ATerm _tlIaterms :: ([ATerm]) @@ -169,14 +165,14 @@ (hd_ ) ( _tlIaterms) = (tl_ ) - in ( _lhsOaterms)) ) + in ( _lhsOaterms))) sem_VisageChildren_Nil :: T_VisageChildren sem_VisageChildren_Nil = (T_VisageChildren (let _lhsOaterms :: ([ATerm]) -- "Visage.ag"(line 81, column 17) _lhsOaterms = [] - in ( _lhsOaterms)) ) + in ( _lhsOaterms))) -- VisageGrammar ----------------------------------------------- {- visit 0: @@ -184,24 +180,24 @@ aterm : ATerm alternatives: alternative VGrammar: - child nonts : VisageNonterminals + child nonts : VisageNonterminals -} -- cata sem_VisageGrammar :: VisageGrammar -> T_VisageGrammar -sem_VisageGrammar (VGrammar _nonts ) = - (sem_VisageGrammar_VGrammar (sem_VisageNonterminals _nonts ) ) +sem_VisageGrammar (VGrammar _nonts) = + (sem_VisageGrammar_VGrammar (sem_VisageNonterminals _nonts)) -- semantic domain newtype T_VisageGrammar = T_VisageGrammar (( ATerm)) data Inh_VisageGrammar = Inh_VisageGrammar {} data Syn_VisageGrammar = Syn_VisageGrammar {aterm_Syn_VisageGrammar :: ATerm} -wrap_VisageGrammar (T_VisageGrammar sem ) (Inh_VisageGrammar ) = +wrap_VisageGrammar (T_VisageGrammar sem) (Inh_VisageGrammar ) = (let ( _lhsOaterm) = (sem ) - in (Syn_VisageGrammar _lhsOaterm )) + in (Syn_VisageGrammar _lhsOaterm)) sem_VisageGrammar_VGrammar :: T_VisageNonterminals -> T_VisageGrammar -sem_VisageGrammar_VGrammar (T_VisageNonterminals nonts_ ) = +sem_VisageGrammar_VGrammar (T_VisageNonterminals nonts_) = (T_VisageGrammar (let _lhsOaterm :: ATerm _nontsIaterms :: ([ATerm]) -- "Visage.ag"(line 54, column 18) @@ -209,7 +205,7 @@ AAppl "Productions" _nontsIaterms ( _nontsIaterms) = (nonts_ ) - in ( _lhsOaterm)) ) + in ( _lhsOaterm))) -- VisageNonterminal ------------------------------------------- {- visit 0: @@ -220,27 +216,27 @@ child nt : {NontermIdent} child inh : {Attributes} child syn : {Attributes} - child alts : VisageProductions + child alts : VisageProductions -} -- cata sem_VisageNonterminal :: VisageNonterminal -> T_VisageNonterminal -sem_VisageNonterminal (VNonterminal _nt _inh _syn _alts ) = - (sem_VisageNonterminal_VNonterminal _nt _inh _syn (sem_VisageProductions _alts ) ) +sem_VisageNonterminal (VNonterminal _nt _inh _syn _alts) = + (sem_VisageNonterminal_VNonterminal _nt _inh _syn (sem_VisageProductions _alts)) -- semantic domain newtype T_VisageNonterminal = T_VisageNonterminal (( ATerm)) data Inh_VisageNonterminal = Inh_VisageNonterminal {} data Syn_VisageNonterminal = Syn_VisageNonterminal {aterm_Syn_VisageNonterminal :: ATerm} -wrap_VisageNonterminal (T_VisageNonterminal sem ) (Inh_VisageNonterminal ) = +wrap_VisageNonterminal (T_VisageNonterminal sem) (Inh_VisageNonterminal ) = (let ( _lhsOaterm) = (sem ) - in (Syn_VisageNonterminal _lhsOaterm )) + in (Syn_VisageNonterminal _lhsOaterm)) sem_VisageNonterminal_VNonterminal :: NontermIdent -> Attributes -> Attributes -> T_VisageProductions -> T_VisageNonterminal -sem_VisageNonterminal_VNonterminal nt_ inh_ syn_ (T_VisageProductions alts_ ) = +sem_VisageNonterminal_VNonterminal nt_ inh_ syn_ (T_VisageProductions alts_) = (T_VisageNonterminal (let _lhsOaterm :: ATerm _altsIaterms :: ([ATerm]) -- "Visage.ag"(line 63, column 19) @@ -249,7 +245,7 @@ AString (sQ(showMap syn_)), AAppl "Alternatives" _altsIaterms] ( _altsIaterms) = (alts_ ) - in ( _lhsOaterm)) ) + in ( _lhsOaterm))) -- VisageNonterminals ------------------------------------------ {- visit 0: @@ -257,27 +253,27 @@ aterms : [ATerm] alternatives: alternative Cons: - child hd : VisageNonterminal - child tl : VisageNonterminals + child hd : VisageNonterminal + child tl : VisageNonterminals alternative Nil: -} -- cata sem_VisageNonterminals :: VisageNonterminals -> T_VisageNonterminals -sem_VisageNonterminals list = - (Prelude.foldr sem_VisageNonterminals_Cons sem_VisageNonterminals_Nil (Prelude.map sem_VisageNonterminal list) ) +sem_VisageNonterminals list = + (Prelude.foldr sem_VisageNonterminals_Cons sem_VisageNonterminals_Nil (Prelude.map sem_VisageNonterminal list)) -- semantic domain newtype T_VisageNonterminals = T_VisageNonterminals (( ([ATerm]))) data Inh_VisageNonterminals = Inh_VisageNonterminals {} data Syn_VisageNonterminals = Syn_VisageNonterminals {aterms_Syn_VisageNonterminals :: [ATerm]} -wrap_VisageNonterminals (T_VisageNonterminals sem ) (Inh_VisageNonterminals ) = +wrap_VisageNonterminals (T_VisageNonterminals sem) (Inh_VisageNonterminals ) = (let ( _lhsOaterms) = (sem ) - in (Syn_VisageNonterminals _lhsOaterms )) + in (Syn_VisageNonterminals _lhsOaterms)) sem_VisageNonterminals_Cons :: T_VisageNonterminal -> T_VisageNonterminals -> T_VisageNonterminals -sem_VisageNonterminals_Cons (T_VisageNonterminal hd_ ) (T_VisageNonterminals tl_ ) = +sem_VisageNonterminals_Cons (T_VisageNonterminal hd_) (T_VisageNonterminals tl_) = (T_VisageNonterminals (let _lhsOaterms :: ([ATerm]) _hdIaterm :: ATerm _tlIaterms :: ([ATerm]) @@ -288,14 +284,14 @@ (hd_ ) ( _tlIaterms) = (tl_ ) - in ( _lhsOaterms)) ) + in ( _lhsOaterms))) sem_VisageNonterminals_Nil :: T_VisageNonterminals sem_VisageNonterminals_Nil = (T_VisageNonterminals (let _lhsOaterms :: ([ATerm]) -- "Visage.ag"(line 59, column 17) _lhsOaterms = [] - in ( _lhsOaterms)) ) + in ( _lhsOaterms))) -- VisagePattern ----------------------------------------------- {- visit 0: @@ -305,13 +301,13 @@ alternative VAlias: child field : {Identifier} child attr : {Identifier} - child pat : VisagePattern + child pat : VisagePattern alternative VConstr: child name : {ConstructorIdent} - child pats : VisagePatterns + child pats : VisagePatterns alternative VProduct: child pos : {Pos} - child pats : VisagePatterns + child pats : VisagePatterns alternative VUnderscore: child pos : {Pos} alternative VVar: @@ -321,29 +317,29 @@ -- cata sem_VisagePattern :: VisagePattern -> T_VisagePattern -sem_VisagePattern (VAlias _field _attr _pat ) = - (sem_VisagePattern_VAlias _field _attr (sem_VisagePattern _pat ) ) -sem_VisagePattern (VConstr _name _pats ) = - (sem_VisagePattern_VConstr _name (sem_VisagePatterns _pats ) ) -sem_VisagePattern (VProduct _pos _pats ) = - (sem_VisagePattern_VProduct _pos (sem_VisagePatterns _pats ) ) -sem_VisagePattern (VUnderscore _pos ) = - (sem_VisagePattern_VUnderscore _pos ) -sem_VisagePattern (VVar _field _attr ) = - (sem_VisagePattern_VVar _field _attr ) +sem_VisagePattern (VAlias _field _attr _pat) = + (sem_VisagePattern_VAlias _field _attr (sem_VisagePattern _pat)) +sem_VisagePattern (VConstr _name _pats) = + (sem_VisagePattern_VConstr _name (sem_VisagePatterns _pats)) +sem_VisagePattern (VProduct _pos _pats) = + (sem_VisagePattern_VProduct _pos (sem_VisagePatterns _pats)) +sem_VisagePattern (VUnderscore _pos) = + (sem_VisagePattern_VUnderscore _pos) +sem_VisagePattern (VVar _field _attr) = + (sem_VisagePattern_VVar _field _attr) -- semantic domain newtype T_VisagePattern = T_VisagePattern (( ATerm)) data Inh_VisagePattern = Inh_VisagePattern {} data Syn_VisagePattern = Syn_VisagePattern {aterm_Syn_VisagePattern :: ATerm} -wrap_VisagePattern (T_VisagePattern sem ) (Inh_VisagePattern ) = +wrap_VisagePattern (T_VisagePattern sem) (Inh_VisagePattern ) = (let ( _lhsOaterm) = (sem ) - in (Syn_VisagePattern _lhsOaterm )) + in (Syn_VisagePattern _lhsOaterm)) sem_VisagePattern_VAlias :: Identifier -> Identifier -> T_VisagePattern -> T_VisagePattern -sem_VisagePattern_VAlias field_ attr_ (T_VisagePattern pat_ ) = +sem_VisagePattern_VAlias field_ attr_ (T_VisagePattern pat_) = (T_VisagePattern (let _lhsOaterm :: ATerm _patIaterm :: ATerm -- "Visage.ag"(line 119, column 18) @@ -352,11 +348,11 @@ AString (sQ (getName field_ ++ "." ++ getName attr_)), _patIaterm]] ( _patIaterm) = (pat_ ) - in ( _lhsOaterm)) ) + in ( _lhsOaterm))) sem_VisagePattern_VConstr :: ConstructorIdent -> T_VisagePatterns -> T_VisagePattern -sem_VisagePattern_VConstr name_ (T_VisagePatterns pats_ ) = +sem_VisagePattern_VConstr name_ (T_VisagePatterns pats_) = (T_VisagePattern (let _lhsOaterm :: ATerm _patsIaterms :: ([ATerm]) -- "Visage.ag"(line 112, column 18) @@ -366,11 +362,11 @@ AAppl "Patterns" _patsIaterms]] ( _patsIaterms) = (pats_ ) - in ( _lhsOaterm)) ) + in ( _lhsOaterm))) sem_VisagePattern_VProduct :: Pos -> T_VisagePatterns -> T_VisagePattern -sem_VisagePattern_VProduct pos_ (T_VisagePatterns pats_ ) = +sem_VisagePattern_VProduct pos_ (T_VisagePatterns pats_) = (T_VisagePattern (let _lhsOaterm :: ATerm _patsIaterms :: ([ATerm]) -- "Visage.ag"(line 115, column 18) @@ -379,25 +375,25 @@ AAppl "Patterns" _patsIaterms]] ( _patsIaterms) = (pats_ ) - in ( _lhsOaterm)) ) + in ( _lhsOaterm))) sem_VisagePattern_VUnderscore :: Pos -> T_VisagePattern -sem_VisagePattern_VUnderscore pos_ = +sem_VisagePattern_VUnderscore pos_ = (T_VisagePattern (let _lhsOaterm :: ATerm -- "Visage.ag"(line 121, column 18) _lhsOaterm = AAppl "Pattern" [AAppl "Underscore" [AString (sQ (showAGPos pos_))]] - in ( _lhsOaterm)) ) + in ( _lhsOaterm))) sem_VisagePattern_VVar :: Identifier -> Identifier -> T_VisagePattern -sem_VisagePattern_VVar field_ attr_ = +sem_VisagePattern_VVar field_ attr_ = (T_VisagePattern (let _lhsOaterm :: ATerm -- "Visage.ag"(line 117, column 18) _lhsOaterm = AAppl "Pattern" [AAppl "Var" [AString (sQ (showAGPos (getPos field_))), AString (sQ (getName field_ ++ "." ++ getName attr_))]] - in ( _lhsOaterm)) ) + in ( _lhsOaterm))) -- VisagePatterns ---------------------------------------------- {- visit 0: @@ -405,27 +401,27 @@ aterms : [ATerm] alternatives: alternative Cons: - child hd : VisagePattern - child tl : VisagePatterns + child hd : VisagePattern + child tl : VisagePatterns alternative Nil: -} -- cata sem_VisagePatterns :: VisagePatterns -> T_VisagePatterns -sem_VisagePatterns list = - (Prelude.foldr sem_VisagePatterns_Cons sem_VisagePatterns_Nil (Prelude.map sem_VisagePattern list) ) +sem_VisagePatterns list = + (Prelude.foldr sem_VisagePatterns_Cons sem_VisagePatterns_Nil (Prelude.map sem_VisagePattern list)) -- semantic domain newtype T_VisagePatterns = T_VisagePatterns (( ([ATerm]))) data Inh_VisagePatterns = Inh_VisagePatterns {} data Syn_VisagePatterns = Syn_VisagePatterns {aterms_Syn_VisagePatterns :: [ATerm]} -wrap_VisagePatterns (T_VisagePatterns sem ) (Inh_VisagePatterns ) = +wrap_VisagePatterns (T_VisagePatterns sem) (Inh_VisagePatterns ) = (let ( _lhsOaterms) = (sem ) - in (Syn_VisagePatterns _lhsOaterms )) + in (Syn_VisagePatterns _lhsOaterms)) sem_VisagePatterns_Cons :: T_VisagePattern -> T_VisagePatterns -> T_VisagePatterns -sem_VisagePatterns_Cons (T_VisagePattern hd_ ) (T_VisagePatterns tl_ ) = +sem_VisagePatterns_Cons (T_VisagePattern hd_) (T_VisagePatterns tl_) = (T_VisagePatterns (let _lhsOaterms :: ([ATerm]) _hdIaterm :: ATerm _tlIaterms :: ([ATerm]) @@ -436,14 +432,14 @@ (hd_ ) ( _tlIaterms) = (tl_ ) - in ( _lhsOaterms)) ) + in ( _lhsOaterms))) sem_VisagePatterns_Nil :: T_VisagePatterns sem_VisagePatterns_Nil = (T_VisagePatterns (let _lhsOaterms :: ([ATerm]) -- "Visage.ag"(line 108, column 17) _lhsOaterms = [] - in ( _lhsOaterms)) ) + in ( _lhsOaterms))) -- VisageProduction -------------------------------------------- {- visit 0: @@ -452,29 +448,29 @@ alternatives: alternative VProduction: child con : {ConstructorIdent} - child children : VisageChildren - child rules : VisageRules - child locrules : VisageRules + child children : VisageChildren + child rules : VisageRules + child locrules : VisageRules -} -- cata sem_VisageProduction :: VisageProduction -> T_VisageProduction -sem_VisageProduction (VProduction _con _children _rules _locrules ) = - (sem_VisageProduction_VProduction _con (sem_VisageChildren _children ) (sem_VisageRules _rules ) (sem_VisageRules _locrules ) ) +sem_VisageProduction (VProduction _con _children _rules _locrules) = + (sem_VisageProduction_VProduction _con (sem_VisageChildren _children) (sem_VisageRules _rules) (sem_VisageRules _locrules)) -- semantic domain newtype T_VisageProduction = T_VisageProduction (( ATerm)) data Inh_VisageProduction = Inh_VisageProduction {} data Syn_VisageProduction = Syn_VisageProduction {aterm_Syn_VisageProduction :: ATerm} -wrap_VisageProduction (T_VisageProduction sem ) (Inh_VisageProduction ) = +wrap_VisageProduction (T_VisageProduction sem) (Inh_VisageProduction ) = (let ( _lhsOaterm) = (sem ) - in (Syn_VisageProduction _lhsOaterm )) + in (Syn_VisageProduction _lhsOaterm)) sem_VisageProduction_VProduction :: ConstructorIdent -> T_VisageChildren -> T_VisageRules -> T_VisageRules -> T_VisageProduction -sem_VisageProduction_VProduction con_ (T_VisageChildren children_ ) (T_VisageRules rules_ ) (T_VisageRules locrules_ ) = +sem_VisageProduction_VProduction con_ (T_VisageChildren children_) (T_VisageRules rules_) (T_VisageRules locrules_) = (T_VisageProduction (let _lhsOaterm :: ATerm _locrulesOisLoc :: Bool _rulesOisLoc :: Bool @@ -495,10 +491,10 @@ ( _childrenIaterms) = (children_ ) ( _rulesIaterms) = - (rules_ _rulesOisLoc ) + (rules_ _rulesOisLoc) ( _locrulesIaterms) = - (locrules_ _locrulesOisLoc ) - in ( _lhsOaterm)) ) + (locrules_ _locrulesOisLoc) + in ( _lhsOaterm))) -- VisageProductions ------------------------------------------- {- visit 0: @@ -506,27 +502,27 @@ aterms : [ATerm] alternatives: alternative Cons: - child hd : VisageProduction - child tl : VisageProductions + child hd : VisageProduction + child tl : VisageProductions alternative Nil: -} -- cata sem_VisageProductions :: VisageProductions -> T_VisageProductions -sem_VisageProductions list = - (Prelude.foldr sem_VisageProductions_Cons sem_VisageProductions_Nil (Prelude.map sem_VisageProduction list) ) +sem_VisageProductions list = + (Prelude.foldr sem_VisageProductions_Cons sem_VisageProductions_Nil (Prelude.map sem_VisageProduction list)) -- semantic domain newtype T_VisageProductions = T_VisageProductions (( ([ATerm]))) data Inh_VisageProductions = Inh_VisageProductions {} data Syn_VisageProductions = Syn_VisageProductions {aterms_Syn_VisageProductions :: [ATerm]} -wrap_VisageProductions (T_VisageProductions sem ) (Inh_VisageProductions ) = +wrap_VisageProductions (T_VisageProductions sem) (Inh_VisageProductions ) = (let ( _lhsOaterms) = (sem ) - in (Syn_VisageProductions _lhsOaterms )) + in (Syn_VisageProductions _lhsOaterms)) sem_VisageProductions_Cons :: T_VisageProduction -> T_VisageProductions -> T_VisageProductions -sem_VisageProductions_Cons (T_VisageProduction hd_ ) (T_VisageProductions tl_ ) = +sem_VisageProductions_Cons (T_VisageProduction hd_) (T_VisageProductions tl_) = (T_VisageProductions (let _lhsOaterms :: ([ATerm]) _hdIaterm :: ATerm _tlIaterms :: ([ATerm]) @@ -537,14 +533,14 @@ (hd_ ) ( _tlIaterms) = (tl_ ) - in ( _lhsOaterms)) ) + in ( _lhsOaterms))) sem_VisageProductions_Nil :: T_VisageProductions sem_VisageProductions_Nil = (T_VisageProductions (let _lhsOaterms :: ([ATerm]) -- "Visage.ag"(line 69, column 17) _lhsOaterms = [] - in ( _lhsOaterms)) ) + in ( _lhsOaterms))) -- VisageRule -------------------------------------------------- {- visit 0: @@ -556,31 +552,31 @@ alternative VRule: child fieldattrs : {[(Identifier,Identifier)]} child attr : {Identifier} - child pat : VisagePattern - child rhs : Expression + child pat : VisagePattern + child rhs : Expression child owrt : {Bool} -} -- cata sem_VisageRule :: VisageRule -> T_VisageRule -sem_VisageRule (VRule _fieldattrs _attr _pat _rhs _owrt ) = - (sem_VisageRule_VRule _fieldattrs _attr (sem_VisagePattern _pat ) (sem_Expression _rhs ) _owrt ) +sem_VisageRule (VRule _fieldattrs _attr _pat _rhs _owrt) = + (sem_VisageRule_VRule _fieldattrs _attr (sem_VisagePattern _pat) (sem_Expression _rhs) _owrt) -- semantic domain newtype T_VisageRule = T_VisageRule (Bool -> ( ATerm)) data Inh_VisageRule = Inh_VisageRule {isLoc_Inh_VisageRule :: Bool} data Syn_VisageRule = Syn_VisageRule {aterm_Syn_VisageRule :: ATerm} -wrap_VisageRule (T_VisageRule sem ) (Inh_VisageRule _lhsIisLoc ) = +wrap_VisageRule (T_VisageRule sem) (Inh_VisageRule _lhsIisLoc) = (let ( _lhsOaterm) = - (sem _lhsIisLoc ) - in (Syn_VisageRule _lhsOaterm )) + (sem _lhsIisLoc) + in (Syn_VisageRule _lhsOaterm)) sem_VisageRule_VRule :: ([(Identifier,Identifier)]) -> Identifier -> T_VisagePattern -> T_Expression -> Bool -> T_VisageRule -sem_VisageRule_VRule fieldattrs_ attr_ (T_VisagePattern pat_ ) (T_Expression rhs_ ) owrt_ = +sem_VisageRule_VRule fieldattrs_ attr_ (T_VisagePattern pat_) (T_Expression rhs_) owrt_ = (T_VisageRule (\ _lhsIisLoc -> (let _lhsOaterm :: ATerm _patIaterm :: ATerm @@ -593,7 +589,7 @@ (pat_ ) ( _rhsIaterm) = (rhs_ ) - in ( _lhsOaterm))) ) + in ( _lhsOaterm)))) -- VisageRules ------------------------------------------------- {- visit 0: @@ -603,28 +599,28 @@ aterms : [ATerm] alternatives: alternative Cons: - child hd : VisageRule - child tl : VisageRules + child hd : VisageRule + child tl : VisageRules alternative Nil: -} -- cata sem_VisageRules :: VisageRules -> T_VisageRules -sem_VisageRules list = - (Prelude.foldr sem_VisageRules_Cons sem_VisageRules_Nil (Prelude.map sem_VisageRule list) ) +sem_VisageRules list = + (Prelude.foldr sem_VisageRules_Cons sem_VisageRules_Nil (Prelude.map sem_VisageRule list)) -- semantic domain newtype T_VisageRules = T_VisageRules (Bool -> ( ([ATerm]))) data Inh_VisageRules = Inh_VisageRules {isLoc_Inh_VisageRules :: Bool} data Syn_VisageRules = Syn_VisageRules {aterms_Syn_VisageRules :: [ATerm]} -wrap_VisageRules (T_VisageRules sem ) (Inh_VisageRules _lhsIisLoc ) = +wrap_VisageRules (T_VisageRules sem) (Inh_VisageRules _lhsIisLoc) = (let ( _lhsOaterms) = - (sem _lhsIisLoc ) - in (Syn_VisageRules _lhsOaterms )) + (sem _lhsIisLoc) + in (Syn_VisageRules _lhsOaterms)) sem_VisageRules_Cons :: T_VisageRule -> T_VisageRules -> T_VisageRules -sem_VisageRules_Cons (T_VisageRule hd_ ) (T_VisageRules tl_ ) = +sem_VisageRules_Cons (T_VisageRule hd_) (T_VisageRules tl_) = (T_VisageRules (\ _lhsIisLoc -> (let _lhsOaterms :: ([ATerm]) _hdOisLoc :: Bool @@ -641,10 +637,10 @@ _tlOisLoc = _lhsIisLoc ( _hdIaterm) = - (hd_ _hdOisLoc ) + (hd_ _hdOisLoc) ( _tlIaterms) = - (tl_ _tlOisLoc ) - in ( _lhsOaterms))) ) + (tl_ _tlOisLoc) + in ( _lhsOaterms)))) sem_VisageRules_Nil :: T_VisageRules sem_VisageRules_Nil = (T_VisageRules (\ _lhsIisLoc -> @@ -652,4 +648,4 @@ -- "Visage.ag"(line 93, column 17) _lhsOaterms = [] - in ( _lhsOaterms))) ) + in ( _lhsOaterms)))) diff --git a/src-derived/VisagePatterns.hs b/src-derived/VisagePatterns.hs --- a/src-derived/VisagePatterns.hs +++ b/src-derived/VisagePatterns.hs @@ -1,4 +1,3 @@ - -- UUAGC 0.9.5 (VisagePatterns.ag) module VisagePatterns where @@ -10,30 +9,30 @@ alternative VAlias: child field : {Identifier} child attr : {Identifier} - child pat : VisagePattern + child pat : VisagePattern alternative VConstr: child name : {ConstructorIdent} - child pats : VisagePatterns + child pats : VisagePatterns alternative VProduct: child pos : {Pos} - child pats : VisagePatterns + child pats : VisagePatterns alternative VUnderscore: child pos : {Pos} alternative VVar: child field : {Identifier} child attr : {Identifier} -} -data VisagePattern = VAlias (Identifier) (Identifier) (VisagePattern) - | VConstr (ConstructorIdent) (VisagePatterns) - | VProduct (Pos) (VisagePatterns) - | VUnderscore (Pos) - | VVar (Identifier) (Identifier) +data VisagePattern = VAlias (Identifier) (Identifier) (VisagePattern) + | VConstr (ConstructorIdent) (VisagePatterns) + | VProduct (Pos) (VisagePatterns) + | VUnderscore (Pos) + | VVar (Identifier) (Identifier) -- VisagePatterns ---------------------------------------------- {- alternatives: alternative Cons: - child hd : VisagePattern - child tl : VisagePatterns + child hd : VisagePattern + child tl : VisagePatterns alternative Nil: -} type VisagePatterns = [VisagePattern] diff --git a/src-derived/VisageSyntax.hs b/src-derived/VisageSyntax.hs --- a/src-derived/VisageSyntax.hs +++ b/src-derived/VisageSyntax.hs @@ -1,4 +1,3 @@ - -- UUAGC 0.9.5 (VisageSyntax.ag) module VisageSyntax where @@ -15,15 +14,15 @@ child tp : {Type} child inh : {Attributes} child syn : {Attributes} - child rules : VisageRules + child rules : VisageRules -} -data VisageChild = VChild (Identifier) (Type) (Attributes) (Attributes) (VisageRules) +data VisageChild = VChild (Identifier) (Type) (Attributes) (Attributes) (VisageRules) -- VisageChildren ---------------------------------------------- {- alternatives: alternative Cons: - child hd : VisageChild - child tl : VisageChildren + child hd : VisageChild + child tl : VisageChildren alternative Nil: -} type VisageChildren = [VisageChild] @@ -31,9 +30,9 @@ {- alternatives: alternative VGrammar: - child nonts : VisageNonterminals + child nonts : VisageNonterminals -} -data VisageGrammar = VGrammar (VisageNonterminals) +data VisageGrammar = VGrammar (VisageNonterminals) -- VisageNonterminal ------------------------------------------- {- alternatives: @@ -41,15 +40,15 @@ child nt : {NontermIdent} child inh : {Attributes} child syn : {Attributes} - child alts : VisageProductions + child alts : VisageProductions -} -data VisageNonterminal = VNonterminal (NontermIdent) (Attributes) (Attributes) (VisageProductions) +data VisageNonterminal = VNonterminal (NontermIdent) (Attributes) (Attributes) (VisageProductions) -- VisageNonterminals ------------------------------------------ {- alternatives: alternative Cons: - child hd : VisageNonterminal - child tl : VisageNonterminals + child hd : VisageNonterminal + child tl : VisageNonterminals alternative Nil: -} type VisageNonterminals = [VisageNonterminal] @@ -58,17 +57,17 @@ alternatives: alternative VProduction: child con : {ConstructorIdent} - child children : VisageChildren - child rules : VisageRules - child locrules : VisageRules + child children : VisageChildren + child rules : VisageRules + child locrules : VisageRules -} -data VisageProduction = VProduction (ConstructorIdent) (VisageChildren) (VisageRules) (VisageRules) +data VisageProduction = VProduction (ConstructorIdent) (VisageChildren) (VisageRules) (VisageRules) -- VisageProductions ------------------------------------------- {- alternatives: alternative Cons: - child hd : VisageProduction - child tl : VisageProductions + child hd : VisageProduction + child tl : VisageProductions alternative Nil: -} type VisageProductions = [VisageProduction] @@ -82,13 +81,13 @@ child rhs : {Expression} child owrt : {Bool} -} -data VisageRule = VRule ([(Identifier,Identifier)]) (Identifier) (VisagePattern) (Expression) (Bool) +data VisageRule = VRule ([(Identifier,Identifier)]) (Identifier) (VisagePattern) (Expression) (Bool) -- VisageRules ------------------------------------------------- {- alternatives: alternative Cons: - child hd : VisageRule - child tl : VisageRules + child hd : VisageRule + child tl : VisageRules alternative Nil: -} type VisageRules = [VisageRule] diff --git a/src/Ag.hs b/src/Ag.hs --- a/src/Ag.hs +++ b/src/Ag.hs @@ -70,7 +70,7 @@ output3 = Pass3.wrap_Grammar (Pass3.sem_Grammar grammar2 ) Pass3.Inh_Grammar {Pass3.options_Inh_Grammar = flags'} grammar3 = Pass3.output_Syn_Grammar output3 output4 = Pass4.wrap_CGrammar (Pass4.sem_CGrammar(Pass3.output_Syn_Grammar output3)) Pass4.Inh_CGrammar {Pass4.options_Inh_CGrammar = flags'} - output5 = Pass5.wrap_Program (Pass5.sem_Program (Pass4.output_Syn_CGrammar output4)) Pass5.Inh_Program {Pass5.options_Inh_Program = flags', Pass5.pragmaBlocks_Inh_Program = pragmaBlocksTxt, Pass5.importBlocks_Inh_Program = importBlocksTxt, Pass5.textBlocks_Inh_Program = textBlocksDoc, Pass5.optionsLine_Inh_Program = optionsLine, Pass5.mainFile_Inh_Program = mainFile, Pass5.moduleHeader_Inh_Program = mkModuleHeader $ Pass1.moduleDecl_Syn_AG output1, Pass5.mainName_Inh_Program = mkMainName mainName $ Pass1.moduleDecl_Syn_AG output1} + output5 = Pass5.wrap_Program (Pass5.sem_Program (Pass4.output_Syn_CGrammar output4)) Pass5.Inh_Program {Pass5.options_Inh_Program = flags', Pass5.pragmaBlocks_Inh_Program = pragmaBlocksTxt, Pass5.importBlocks_Inh_Program = importBlocksTxt, Pass5.textBlocks_Inh_Program = textBlocksDoc, Pass5.textBlockMap_Inh_Program = textBlockMap, Pass5.optionsLine_Inh_Program = optionsLine, Pass5.mainFile_Inh_Program = mainFile, Pass5.moduleHeader_Inh_Program = mkModuleHeader $ Pass1.moduleDecl_Syn_AG output1, Pass5.mainName_Inh_Program = mkMainName mainName $ Pass1.moduleDecl_Syn_AG output1} output6 = PrErr.wrap_Errors (PrErr.sem_Errors errorsToReport) PrErr.Inh_Errors {PrErr.options_Inh_Errors = flags'} dump1 = GrammarDump.wrap_Grammar (GrammarDump.sem_Grammar grammar1 ) GrammarDump.Inh_Grammar @@ -105,12 +105,13 @@ else fatalErrorList blocks1 = (Pass1.blocks_Syn_AG output1) {-SM `Map.unionWith (++)` (Pass3.blocks_Syn_Grammar output3)-} - (pragmaBlocks, blocks2) = Map.partitionWithKey (\k _->k=="optpragmas") blocks1 - (importBlocks, textBlocks) = Map.partitionWithKey (\k _->k=="imports" ) blocks2 + (pragmaBlocks, blocks2) = Map.partitionWithKey (\(k, at) _->k==BlockPragma && at == Nothing) blocks1 + (importBlocks, textBlocks) = Map.partitionWithKey (\(k, at) _->k==BlockImport && at == Nothing) blocks2 importBlocksTxt = vlist_sep "" . map addLocationPragma . concat . Map.elems $ importBlocks - textBlocksDoc = vlist_sep "" . map addLocationPragma . concat . Map.elems $ textBlocks - pragmaBlocksTxt = unlines . concat . map fst . concat . Map.elems $ pragmaBlocks + textBlocksDoc = vlist_sep "" . map addLocationPragma . Map.findWithDefault [] (BlockOther, Nothing) $ textBlocks + pragmaBlocksTxt = unlines . concat . map fst . concat . Map.elems $ pragmaBlocks + textBlockMap = Map.map (vlist_sep "" . map addLocationPragma) . Map.filterWithKey (\(_, at) _ -> at /= Nothing) $ textBlocks outputfile = if null output then outputFile input else output @@ -139,8 +140,8 @@ pluralS n = if n == 1 then "" else "s" putStr . formatErrors $ PrErr.pp_Syn_Errors output6 - - if additionalErrors > 0 + + if additionalErrors > 0 then putStr $ "\nPlus " ++ show additionalErrors ++ " more error" ++ pluralS additionalErrors ++ if additionalWarnings > 0 then " and " ++ show additionalWarnings ++ " more warning" ++ pluralS additionalWarnings ++ ".\n" diff --git a/src/CommonTypes.hs b/src/CommonTypes.hs --- a/src/CommonTypes.hs +++ b/src/CommonTypes.hs @@ -8,9 +8,15 @@ import qualified Data.Set as Set -type Blocks = Map String [([String], Pos)] +type Blocks = Map BlockInfo [([String], Pos)] +type BlockInfo = (BlockType, Maybe NontermIdent) +data BlockType + = BlockImport + | BlockPragma + | BlockOther + deriving (Eq, Ord, Show) -data Identifier = Ident {getName::String , getPos::Pos} +data Identifier = Ident { getName::String, getPos::Pos } instance Eq Identifier where Ident x _ == Ident y _ = x == y @@ -30,11 +36,17 @@ data ComplexType = List Type | Tuple [(Identifier, Type)] | Maybe Type + | Either Type Type + | Map Type Type + | IntMap Type instance Show ComplexType where - show (List t ) = "[" ++ show t ++ "]" - show (Tuple ts) = "(" ++ showList [ show n ++ ": " ++ show t | (n,t) <- ts ] "" ++ ")" - show (Maybe t ) = "Maybe " ++ show t + show (List t ) = "[" ++ show t ++ "]" + show (Tuple ts) = "(" ++ showList [ show n ++ ": " ++ show t | (n,t) <- ts ] "" ++ ")" + show (Maybe t ) = "Maybe " ++ show t + show (Either t1 t2) = "Either " ++ show t1 ++ " " ++ show t2 + show (Map t1 t2) = "Map " ++ show t1 ++ " " ++ show t2 + show (IntMap t1) = "IntMap " ++ show t1 instance Show Type where show = typeToHaskellString Nothing [] @@ -46,6 +58,7 @@ type UseMap = Map NontermIdent (Map Identifier (String,String,String)) type PragmaMap = Map NontermIdent (Map ConstructorIdent (Set Identifier)) type AttrMap = Map NontermIdent (Map ConstructorIdent (Set (Identifier,Identifier))) +type UniqueMap = Map NontermIdent (Map ConstructorIdent (Map Identifier Identifier)) type Fields = [(Identifier,Type)] type Derivings = Map NontermIdent (Set Identifier) type ClassContext = [(Identifier, [String])] @@ -68,8 +81,8 @@ _INST = identifier "inst" _INST' = identifier "inst'" _FIELD = identifier "field" -_FIRST = identifier "first" -_LAST = identifier "last" +_FIRST = identifier "first__" +_LAST = identifier "last__" sdtype :: NontermIdent -> String sdtype nt = "T_"++getName nt diff --git a/src/Options.hs b/src/Options.hs --- a/src/Options.hs +++ b/src/Options.hs @@ -52,6 +52,7 @@ , Option [] ["genvisage"] (NoArg genVisageOpt) "Generate output for the AG visualizer Visage" , Option [] ["genattrlist"] (NoArg genAttrListOpt) "Generate a list of all explicitly defined attributes (outside irrefutable patterns)" , Option [] ["forceirrefutable"] (OptArg forceIrrefutableOpt "file") "Force a set of explicitly defined attributes to be irrefutable, specify file containing the attribute set" + , Option [] ["uniquedispenser"] (ReqArg uniqueDispenserOpt "name") "The Haskell function to call in the generated code" ] allc = "dcfsprm" @@ -102,6 +103,7 @@ , genvisage :: Bool , genAttributeList :: Bool , forceIrrefutables :: Maybe String + , uniqueDispenser :: String } deriving Show noOptions = Options { moduleName = NoName , dataTypes = False @@ -149,6 +151,7 @@ , genvisage = False , genAttributeList = False , forceIrrefutables = Nothing + , uniqueDispenser = "nextUnique" } @@ -196,6 +199,7 @@ genVisageOpt opts = opts{genvisage = True } genAttrListOpt opts = opts { genAttributeList = True } forceIrrefutableOpt mbNm opts = opts { forceIrrefutables = mbNm } +uniqueDispenserOpt nm opts = opts { uniqueDispenser = nm } outputOpt file opts = opts{outputFiles = file : outputFiles opts} searchPathOpt path opts = opts{searchPath = extract path ++ searchPath opts} diff --git a/src/Parser.hs b/src/Parser.hs --- a/src/Parser.hs +++ b/src/Parser.hs @@ -139,9 +139,12 @@ pElems :: AGParser Elems pElems = pList_ng pElem -pComplexType = List <$> pBracks pTypeEncapsulated - <|> Maybe <$ pMAYBE <*> pType - <|> tuple <$> pParens (pListSep pComma field) +pComplexType = List <$> pBracks pTypeEncapsulated + <|> Maybe <$ pMAYBE <*> pType + <|> Either <$ pEITHER <*> pType <*> pType + <|> Map <$ pMAP <*> pTypePrimitive <*> pType + <|> IntMap <$ pINTMAP <*> pType + <|> tuple <$> pParens (pListSep pComma field) where field = (,) <$> ((Just <$> pIdentifier <* pColon) `opt` Nothing) <*> pTypeEncapsulated tuple xs = Tuple [(fromMaybe (Ident ("x"++show n) noPos) f, t) | (n,(f,t)) <- zip [1..] xs @@ -189,8 +192,8 @@ <*> pCodescrap' <*> pCodescrap' <*> pCodescrap' - <|> codeBlock <$> (pIdentifier <|> pSucceed (Ident "" noPos)) <*> pCodeBlock "a statement" - where codeBlock nm (txt,pos) = Txt pos nm (lines txt) + <|> codeBlock <$> (pIdentifier <|> pSucceed (Ident "" noPos)) <*> ((Just <$ pATTACH <*> pIdentifierU) <|> pSucceed Nothing) <*> pCodeBlock "a statement" + where codeBlock nm mbNt (txt,pos) = Txt pos nm mbNt (lines txt) -- Insertion is expensive for pCodeBlock in order to prevent infinite inserts. @@ -218,8 +221,8 @@ pTypeNt :: AGParser Type pTypeNt - = (\nt -> NT nt []) <$> pIdentifierU - <|> pParens (NT <$> pIdentifierU <*> pList pTypeHaskellAnyAsString) + = ((\nt -> NT nt []) <$> pIdentifierU "nonterminal name (no brackets)") + <|> (pParens (NT <$> pIdentifierU <*> pList pTypeHaskellAnyAsString) "nonterminal name with parameters (using parenthesis)") pTypeHaskellAnyAsString :: AGParser String pTypeHaskellAnyAsString @@ -233,11 +236,15 @@ = pParens pTypeEncapsulated <|> NT <$> pIdentifierU <*> pList pTypeHaskellAnyAsString <|> (Haskell . getName) <$> pIdentifier - <|> Haskell <$> pCodescrap' "a type" + <|> pTypePrimitive + +pTypePrimitive :: AGParser Type +pTypePrimitive + = Haskell <$> pCodescrap' "a type" pType :: AGParser Type pType = pTypeNt - <|> Haskell <$> pCodescrap' "a type" + <|> pTypePrimitive pInhAttrNames :: AGParser AttrNames @@ -321,8 +328,8 @@ nl2sp x = x pLocDecl :: AGParser SemDef -pLocDecl = (\ident tp -> TypeDef ident tp) - <$ pDot <*> pIdentifier <* pColon <*> pLocType +pLocDecl = pDot <**> (pIdentifier <**> (pColon <**> ( (\tp _ ident _ -> TypeDef ident tp) <$> pLocType + <|> (\ref _ ident _ -> UniqueDef ident ref) <$ pUNIQUEREF <*> pIdentifier ))) pLocType = (Haskell . getName) <$> pIdentifierU <|> Haskell <$> pCodescrap' "a type" @@ -372,20 +379,25 @@ pSEM, pATTR, pDATA, pUSE, pLOC,pINCLUDE, pTYPE, pEquals, pColonEquals, pTilde, pBar, pColon, pLHS,pINST,pSET,pDERIVING,pMinus,pIntersect,pDoubleArrow,pArrow, - pDot, pUScore, pEXT,pAt,pStar, pSmaller, pWRAPPER, pPRAGMA, pMAYBE, pMODULE + pDot, pUScore, pEXT,pAt,pStar, pSmaller, pWRAPPER, pPRAGMA, pMAYBE, pEITHER, pMAP, pINTMAP, + pMODULE, pATTACH, pUNIQUEREF :: AGParser Pos pSET = pCostReserved 90 "SET" "SET" pDERIVING = pCostReserved 90 "DERIVING" "DERIVING" pWRAPPER = pCostReserved 90 "WRAPPER" "WRAPPER" pPRAGMA = pCostReserved 90 "PRAGMA" "PRAGMA" -pSEMPRAGMA = pCostReserved 90 "SEMPRAGMA" "SEMPRAGMA" +pSEMPRAGMA = pCostReserved 90 "SEMPRAGMA" "SEMPRAGMA" +pATTACH = pCostReserved 90 "ATTACH" "ATTACH" pDATA = pCostReserved 90 "DATA" "DATA" pEXT = pCostReserved 90 "EXT" "EXT" pATTR = pCostReserved 90 "ATTR" "ATTR" pSEM = pCostReserved 90 "SEM" "SEM" pINCLUDE = pCostReserved 90 "INCLUDE" "INCLUDE" pTYPE = pCostReserved 90 "TYPE" "TYPE" -pMAYBE = pCostReserved 5 "MAYBE" "MAYBE" +pMAYBE = pCostReserved 5 "MAYBE" "MAYBE" +pEITHER = pCostReserved 5 "EITHER" "EITHER" +pMAP = pCostReserved 5 "MAP" "MAP" +pINTMAP = pCostReserved 5 "INTMAP" "INTMAP" pUSE = pCostReserved 5 "USE" "USE" pLOC = pCostReserved 5 "loc" "loc" pLHS = pCostReserved 5 "lhs" "loc" @@ -405,4 +417,5 @@ pStar = pCostReserved 5 "*" "*" pSmaller = pCostReserved 5 "<" "<" pMODULE = pCostReserved 5 "MODULE" "MODULE" +pUNIQUEREF = pCostReserved 5 "UNIQUEREF" "UNIQUEREF" diff --git a/src/Pretty.hs b/src/Pretty.hs --- a/src/Pretty.hs +++ b/src/Pretty.hs @@ -1,120 +1,94 @@ -{-# OPTIONS_GHC -fglasgow-exts #-} --- Layer on top of the original UU.Pretty class +------------------------------------------------------------------------- +-- Subset of UU.Pretty, based on very simple pretty printing +-- Extended with line-nr tracking +------------------------------------------------------------------------- + module Pretty - ( (>|<) - , (>-<) + ( PP_Doc, PP(..) + , disp + + , (>|<), (>-<) , (>#<) - , text - , empty + , ppWithLineNr + , hlist, vlist, hv + , fill , indent + , pp_block - , hlist - , vlist , vlist_sep - , fill , pp_parens , hv_sp - , ppWithLineNr - , disp - , PP_Doc - , PP (..) - ) where -import qualified UU.Pretty as U -import Data.List(intersperse) - - --- --- Type classes and data types that mimic UU.Pretty --- - -class Show a => PP a where - pp :: a -> PP_Doc - pp = text . show - - ppList :: [a] -> PP_Doc - ppList as = if null as - then empty - else foldr (>|<) empty . map pp $ as - -instance PP PP_Doc where - pp = id - -instance Show PP_Doc where - show (PP_Doc f) = let (doc, _, _) = f 1 - in show doc - -instance PP String where - pp = text - -instance PP Char where - pp = text . (\c -> [c]) - + , empty, text + ) + where -newtype PP_Doc = PP_Doc (Int -> (U.PP_Doc, Int, Bool)) +import Data.List(intersperse) + +------------------------------------------------------------------------- +-- Doc structure +------------------------------------------------------------------------- -fromInternal :: PP a => a -> Int -> (U.PP_Doc, Int, Bool) -fromInternal x l - = let (PP_Doc f) = pp x - in f l +data Doc + = Emp + | Str !String -- basic string + | Hor Doc !Doc -- horizontal positioning + | Ver Doc !Doc -- vertical positioning + | Ind !Int Doc -- indent + | Line (Int -> Doc) -- line nr +type PP_Doc = Doc --- --- Layer on top of primitive combinators --- +------------------------------------------------------------------------- +-- Basic combinators +------------------------------------------------------------------------- -infixr 3 >|< -infixr 2 >-< -infixr 3 >#< +infixr 3 >|<, >#< +infixr 2 >-< (>|<) :: (PP a, PP b) => a -> b -> PP_Doc -x >|< y - = PP_Doc $ - \l -> let (p, n, s) = fromInternal x l - (q, m, t) = fromInternal y n - in (p U.>|< q, m, s && t) +l >|< r = pp l `Hor` pp r (>-<) :: (PP a, PP b) => a -> b -> PP_Doc -x >-< y - = PP_Doc $ - \l -> let (p, n, s) = fromInternal x l - (q, m, t) = fromInternal y (if s then n else n+1) - in (p U.>-< q, if t then m-1 else m, s && t) +l >-< r = pp l `Ver` pp r +(>#<) :: (PP a, PP b) => a -> b -> PP_Doc +l >#< r = l >|< " " >|< r + +indent :: PP a => Int -> a -> PP_Doc +indent i d = Ind i $ pp d + text :: String -> PP_Doc text s = let ls = lines s ls' | null ls = [""] | otherwise = ls - in vlist (map ppLine ls') - where - ppLine txt - = PP_Doc $ - \l -> (U.text txt, l, False) + in vlist (map Str ls') empty :: PP_Doc -empty - = PP_Doc $ - \l -> (U.empty, l, True) +empty = Emp +ppWithLineNr :: PP a => (Int -> a) -> PP_Doc +ppWithLineNr f = Line (pp . f) --- --- Layer on top of the higher-level combinators --- (shameless copy of their definition) --- +------------------------------------------------------------------------- +-- Derived combinators +------------------------------------------------------------------------- -(>#<) :: (PP a, PP b) => a -> b -> PP_Doc -l >#< r = l >|< " " >|< r +hlist, vlist :: PP a => [a] -> PP_Doc +vlist [] = empty +vlist as = foldr (>-<) empty as +hlist [] = empty +hlist as = foldr (>|<) empty as -hlist :: PP a => [a] -> PP_Doc -hlist = foldr (>|<) empty +hv :: PP a => [a] -> PP_Doc +hv = vlist -vlist :: PP a => [a] -> PP_Doc -vlist = foldr (>-<) empty +hv_sp :: PP a => [a] -> PP_Doc +hv_sp = foldr (>#<) empty -vlist_sep :: (PP a, PP b) => a -> [b] -> PP_Doc -vlist_sep sep lst - = vlist (intersperse (pp sep) (map pp lst)) +fill :: PP a => [a] -> PP_Doc +fill = hlist pp_block:: (PP a, PP b, PP c) => a -> b -> c -> [PP_Doc] -> PP_Doc pp_block o c s as = pp o >|< hlist (intersperse (pp s) as) >|< pp c @@ -122,30 +96,77 @@ pp_parens :: PP a => a -> PP_Doc pp_parens p = '(' >|< p >|< ')' +vlist_sep :: (PP a, PP b) => a -> [b] -> PP_Doc +vlist_sep sep lst + = vlist (intersperse (pp sep) (map pp lst)) --- --- Layer on top of the higher-level "smart" combinators --- (dump alternative implementation) --- +------------------------------------------------------------------------- +-- PP class +------------------------------------------------------------------------- -indent :: PP a => Int -> a -> PP_Doc -indent n p = foldr (>#<) (pp p) (replicate n empty) +class Show a => PP a where + pp :: a -> PP_Doc + pp = text . show -fill :: PP a => [a] -> PP_Doc -fill = foldr (>#<) empty + ppList :: [a] -> PP_Doc + ppList as = hlist as -hv_sp :: PP a => [a] -> PP_Doc -hv_sp = foldr (>#<) empty +instance PP Doc where + pp = id +instance PP Char where + pp c = text [c] + ppList = text --- Special combinator that exposes the line number -ppWithLineNr :: (Int -> PP_Doc) -> PP_Doc -ppWithLineNr f - = PP_Doc $ - \l -> fromInternal (f l) l +instance PP a => PP [a] where + pp = ppList --- Render function -disp :: PP a => a -> Int -> String -> String -disp p n = let (doc, _, _) = fromInternal (pp p) 1 - in U.disp doc n +instance Show Doc where + show p = disp p 200 "" + +instance PP Int where + pp = text . show + +instance PP Float where + pp = text . show + +------------------------------------------------------------------------- +-- Observation +------------------------------------------------------------------------- + +isEmpty :: PP_Doc -> Bool +isEmpty Emp = True +isEmpty (Ver d1 d2) = isEmpty d1 && isEmpty d2 +isEmpty (Hor d1 d2) = isEmpty d1 && isEmpty d2 +isEmpty (Ind _ d ) = isEmpty d +isEmpty _ = False + +------------------------------------------------------------------------- +-- Rendering +------------------------------------------------------------------------- + +disp :: PP_Doc -> Int -> ShowS +disp d _ s + = r + where (r,_,_) = put 0 1 d s + put p l d s + = case d of + Emp -> (s,p,l) + Str s' -> (s' ++ s,p + length s',l) + Ind i d -> (ind ++ r,p', l') + where (r,p',l') = put (p+i) l d s + ind = replicate i ' ' + Hor d1 d2 -> (r1,p2,l2) + where (r1,p1,l1) = put p l d1 r2 + (r2,p2,l2) = put p1 l1 d2 s + Ver d1 d2 | isEmpty d1 + -> put p l d2 s + Ver d1 d2 | isEmpty d2 + -> put p l d1 s + Ver d1 d2 -> (r1,p2,l2) + where (r1,p1,l1) = put p l d1 $ "\n" ++ ind ++ r2 + (r2,p2,l2) = put p (l1+1) d2 s + ind = replicate p ' ' + Line f -> (r,p',l') + where (r,p',l') = put p l (f l) s diff --git a/src/Scanner.hs b/src/Scanner.hs --- a/src/Scanner.hs +++ b/src/Scanner.hs @@ -1,4 +1,3 @@ - module Scanner where import TokenDef import UU.Scanner.Position @@ -114,8 +113,8 @@ ident = span isValid where isValid x = isAlphaNum x || x =='_' || x == '\'' keywords = [ "DATA", "EXT", "ATTR", "SEM","TYPE", "USE", "loc","lhs", "inst", "INCLUDE" - , "SET","DERIVING","FOR", "WRAPPER", "MAYBE" - , "PRAGMA", "SEMPRAGMA", "MODULE" + , "SET","DERIVING","FOR", "WRAPPER", "MAYBE", "EITHER", "MAP", "INTMAP" + , "PRAGMA", "SEMPRAGMA", "MODULE", "ATTACH", "UNIQUEREF" ] ncomment c p ('-':'}':xs) = advc' 2 p c xs 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.6" +banner = "Attribute Grammar compiler / HUT project. Version 0.9.7" 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.6 +version: 0.9.7 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.6 +version: 0.9.7 license: GPL license-file: LICENSE maintainer: Arie Middelkoop